summaryrefslogtreecommitdiffstats
path: root/XMonad/Stockholm/Shutdown.hs
diff options
context:
space:
mode:
Diffstat (limited to 'XMonad/Stockholm/Shutdown.hs')
-rw-r--r--XMonad/Stockholm/Shutdown.hs75
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