{-# LANGUAGE LambdaCase #-}

module XMonad.Stockholm.Shutdown
    ( newShutdownEventHandler
    , shutdown
    )
  where

import Control.Concurrent (threadDelay)
import Control.Monad (forever, when)
import Data.Monoid (All(All))
import System.Exit (exitSuccess)
import System.FilePath ((</>))
import System.IO.Error (isDoesNotExistError, tryIOError)
import System.IO (hPutStrLn, stderr)
import System.Posix.Process (getProcessID)
import System.Posix.Signals (nullSignal, signalProcess)
import System.Posix.Types (ProcessID)
import XMonad

newShutdownEventHandler :: IO (Event -> X All)
newShutdownEventHandler = do
    writeProcessIDToFile
    return handleShutdownEvent

handleShutdownEvent :: Event -> X All
handleShutdownEvent = \case
  ClientMessageEvent { ev_message_type = mt } -> do
    isShutdownEvent <- (mt ==) <$> getAtom "XMONAD_SHUTDOWN"
    when isShutdownEvent $ do
      broadcastMessage ReleaseResources
      writeStateToFile
      io exitSuccess >> return ()
    return (All (not isShutdownEvent))
  _ ->
    return (All True)

sendShutdownEvent :: IO ()
sendShutdownEvent = do
    dpy <- openDisplay ""
    rw <- rootWindow dpy $ defaultScreen dpy
    a <- internAtom dpy "XMONAD_SHUTDOWN" False
    allocaXEvent $ \e -> do
        setEventType e clientMessage
        setClientMessageEvent e rw a 32 0 currentTime
        sendEvent dpy rw False structureNotifyMask e
    sync dpy False

shutdown :: IO ()
shutdown = do
    pid <- readProcessIDFromFile
    sendShutdownEvent
    hPutStrLn stderr ("waiting for: " <> show pid)
    result <- tryIOError (waitProcess pid)
    if isSuccess result
      then hPutStrLn stderr ("result: " <> show result <> " [AKA success^_^]")
      else hPutStrLn stderr ("result: " <> show result)
  where
    isSuccess = either isDoesNotExistError (const False)

waitProcess :: ProcessID -> IO ()
waitProcess pid = forever (signalProcess nullSignal pid >> threadDelay 10000)

--
-- PID file stuff
--

getProcessIDFileName :: (Functor m, MonadIO m) => m FilePath
getProcessIDFileName = (</> "xmonad.pid") <$> getXMonadDataDir

writeProcessIDToFile :: IO ()
writeProcessIDToFile = do
    pidFileName <- getProcessIDFileName
    pid <- getProcessID
    writeFile pidFileName (show pid)

readProcessIDFromFile :: IO ProcessID
readProcessIDFromFile = do
    pidFileName <- getProcessIDFileName
    read <$> readFile pidFileName