diff options
author | tv <tv@krebsco.de> | 2023-09-11 18:24:28 +0200 |
---|---|---|
committer | tv <tv@krebsco.de> | 2023-09-13 18:07:11 +0200 |
commit | 0c4f3acb281be6290c55a6e96bc29fab5b5c7a11 (patch) | |
tree | dadaec00477a095273475ac345b2066b4748c399 /tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs | |
parent | ab1d0479e90f11806d4703ec6fffed3d5f782914 (diff) |
stockholm -> hrm
Diffstat (limited to 'tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs')
-rw-r--r-- | tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs | 113 |
1 files changed, 0 insertions, 113 deletions
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs b/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs deleted file mode 100644 index d4a4d93..0000000 --- a/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -module 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 |