{-# LANGUAGE LambdaCase #-} module XMonad.Stockholm.Shutdown ( newShutdownEventHandler , shutdown ) where import Control.Applicative ((<|>), empty) import Control.Concurrent (threadDelay) import Control.Monad (forever, guard, when) import Data.Monoid (All(All)) import System.Directory (XdgDirectory(XdgData), createDirectoryIfMissing, doesFileExist, getAppUserDataDirectory, getXdgDirectory) import System.Exit (exitSuccess) import System.Environment (lookupEnv) 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 hiding (getXMonadDataDir) -- XXX this is for compatibility with both xmonad<0.17 and xmonad>=0.17 getXMonadDataDir :: IO String getXMonadDataDir = xmEnvDir <|> xmDir <|> xdgDir where -- | Check for xmonad's environment variables first xmEnvDir :: IO String xmEnvDir = maybe empty pure =<< lookupEnv "XMONAD_DATA_DIR" -- | Check whether the config file or a build script is in the -- @~\/.xmonad@ directory xmDir :: IO String xmDir = do d <- getAppUserDataDirectory "xmonad" conf <- doesFileExist $ d </> "xmonad.hs" build <- doesFileExist $ d </> "build" pid <- doesFileExist $ d </> "xmonad.pid" -- Place *everything* in ~/.xmonad if yes guard $ conf || build || pid pure d -- | Use XDG directories as a fallback xdgDir :: IO String xdgDir = do d <- getXdgDirectory XdgData "xmonad" d <$ createDirectoryIfMissing True d 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 :: IO 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