summaryrefslogtreecommitdiffstats
path: root/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs
diff options
context:
space:
mode:
authorlassulus <lassulus@lassul.us>2022-12-05 21:32:08 +0100
committerlassulus <lassulus@lassul.us>2022-12-05 21:32:08 +0100
commit0447cf6a5fd3435a0acb68d077b0380da12f104d (patch)
treebb3644b84ce81b64443efd8e767a121a741bb008 /tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs
parent5d0d1993b6207c283189a2c81c8c76f549d44b2a (diff)
parent8e32364d6299b5f5816d886653349794aadc1ec9 (diff)
Merge remote-tracking branch 'ni/master' into 22.11
Diffstat (limited to 'tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs')
-rw-r--r--tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs113
1 files changed, 113 insertions, 0 deletions
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs b/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs
new file mode 100644
index 000000000..d4a4d93cf
--- /dev/null
+++ b/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs
@@ -0,0 +1,113 @@
+{-# 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