{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
import System.Environment
import System.Posix.Signals
import Control.Concurrent (threadDelay,forkIO,forkOS,killThread,throwTo)
import Control.Concurrent.STM
import Control.Concurrent.STM.TMVar
import Control.Monad.Trans.Resource (runResourceT)
import Control.Monad.Trans
import Control.Monad.IO.Class (MonadIO, liftIO)
import Network.Socket ( SockAddr(..) )
import System.Endian (fromBE32)
import Data.List (nub, (\\), intersect, groupBy, sort, sortBy )
import Data.Ord (comparing )
import Data.Monoid ( (<>), Sum(..), getSum )
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Encoding as Text
import Control.Monad
import Control.Monad.Fix
import qualified Network.BSD as BSD
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.Map as Map
import Data.Map (Map)
import Control.Exception ({-evaluate,-}handle,SomeException(..),bracketOnError,ErrorCall(..))
import System.IO.Error (isDoesNotExistError)
import System.Posix.User (getUserEntryForID,userName)
import qualified Data.ByteString.Lazy.Char8 as L
import qualified ConfigFiles
import Data.Maybe (maybeToList,listToMaybe,mapMaybe)
import Data.Bits
import Data.Int (Int8)
import Data.XML.Types (Event)
import System.Posix.Types (UserID,CPid)
import Control.Applicative

import LockedChan (LockedChan)
import TraversableT
import UTmp (ProcessID,users)
import LocalPeerCred
import XMPPServer
import PeerResolve
import ConsoleWriter
import ClientState
import Presence

main :: IO ()
main = runResourceT $ do
    args <- liftIO getArgs
    let verbosity = getSum $ flip foldMap args $ \case
            ('-':xs) -> Sum $ length (filter (=='-') xs)
            _        -> mempty
    cw    <- liftIO newConsoleWriter
    state <- liftIO $ newPresenceState cw
    sv    <- xmppServer (presenceHooks state verbosity)
    liftIO $ do
    atomically $ putTMVar (server state) sv

    quitVar <- newEmptyTMVarIO
    installHandler sigTERM (CatchOnce (atomically $ putTMVar quitVar True)) Nothing
    installHandler sigINT (CatchOnce (atomically $ putTMVar quitVar True)) Nothing

    forkIO $ do
        let console = cwPresenceChan $ consoleWriter state
        fix $ \loop -> do
        what <- atomically
            $ orElse (do (client,stanza) <- takeTMVar console
                         return $ do informClientPresence0 state Nothing client stanza
                                     loop)
                     (do readTMVar quitVar
                         return $ return ())
        what

    quitMessage <- atomically $ takeTMVar quitVar

    putStrLn "goodbye."
    return ()