{-# LANGUAGE CPP #-}

import System.Directory
import Control.Monad
import System.Posix.Signals
import System.Posix.Types
import System.Posix.Process
import Data.Maybe

import System.INotify
#ifndef NOUTMP
import UTmp
#endif
import FGConsole
import XMPPServer
import Data.HList
import Network.Socket (sClose)
import Control.Exception

jid user host rsrc = user ++ "@" ++ host ++ "/" ++ rsrc

toJabberId :: String -> (String,String,t) -> Maybe String
toJabberId host (user,tty,_) = 
    if take 3 tty == "tty"
      then Just (jid user host tty)
      else Nothing

#ifndef NOUTMP
utmp_event e = do
    -- print e
    putStrLn "---"
    us <- users
    let ids = mapMaybe (toJabberId "localhost") us
        ids :: [String]
    forM_ ids putStrLn
#endif

on_chvt vtnum = do
    putStrLn $ "changed vt to "++ show vtnum

start :: IO ()
start = do
#ifndef NOUTMP
    installHandler sigUSR1 (Catch (utmp_event (userError "signaled"))) Nothing
#endif
    -- installHandler sigTERM (CatchOnce (utmp_event (userError "term signaled"))) Nothing
    inotify <- initINotify
    print inotify
#ifndef NOUTMP
    wd <- addWatch
            inotify
            [CloseWrite] -- [Open,Close,Access,Modify,Move]
            utmp_file
            utmp_event
    print wd
#endif
    mtty <- monitorTTY on_chvt
    sock <- listenForXmppClients 5222 HNil
    putStrLn "Hit enter to terminate..."
    getLine
    {-
    let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n")
    handle doException $ do
    -}
    sClose sock
    -- threadDelay 1000
    putStrLn "closed listener."
    unmonitorTTY mtty
    putStrLn "unhooked tty monitor."
#ifndef NOUTMP
    removeWatch wd
#endif
    putStrLn "Normal termination."

sendUSR1 pid = do
    signalProcess sigUSR1 pid

getStartupAction []     = throw (userError "pid file?") >> return (Right "")
getStartupAction (p:ps) = do
    handle onEr $
        ( do
            pid <- fmap CPid (readFile p >>= readIO)
            -- signal pid
            return (Left pid) )
 where
    onEr (SomeException _) = do
        pid <- getProcessID
        putStrLn $ "starting pid = "++show pid
        handle (\(SomeException _) -> getStartupAction ps)
            (do 
                writeFile p (show pid)
                putStrLn $ "writing "++show p
                -- start daemon
                return (Right p) )

runOnce ps run notify = getStartupAction ps >>= doit
 where
    doit (Left pid      ) = notify pid
    doit (Right pidfile ) = do 
        run
        removeFile pidfile


main = do
    runOnce ["/var/run/presence.pid","/tmp/presence.pid"] start sendUSR1