shutdown: wait for process to exit

1 files changed, 58 insertions, 17 deletions

diff --git a/XMonad/Stockholm/Shutdown.hs b/XMonad/Stockholm/Shutdown.hs
index 6786c7c..373214e 100644
--- a/XMonad/Stockholm/Shutdown.hs
+++ b/XMonad/Stockholm/Shutdown.hs
@@ -1,17 +1,40 @@
 {-# LANGUAGE LambdaCase #-}
 
 module XMonad.Stockholm.Shutdown
-    ( sendShutdownEvent
-    , handleShutdownEvent
+    ( newShutdownEventHandler
     , shutdown
     )
   where
 
-import Control.Monad
-import Data.Monoid
+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 ""
@@ -23,17 +46,35 @@ sendShutdownEvent = do
         sendEvent dpy rw False structureNotifyMask e
     sync dpy False
 
-handleShutdownEvent :: Event -> X All
-handleShutdownEvent = \case
-  ClientMessageEvent { ev_message_type = mt } -> do
-    c <- (mt ==) <$> getAtom "XMONAD_SHUTDOWN"
-    when c shutdown
-    return (All c)
-  _ ->
-    return (All True)
-
-shutdown :: X ()
+shutdown :: IO ()
 shutdown = do
-  broadcastMessage ReleaseResources
-  writeStateToFile
-  io exitSuccess >> return ()
+    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