tv xmonad: wait for shutdown to complete

1 files changed, 24 insertions, 2 deletions

diff --git a/tv/5pkgs/simple/xmonad-tv/default.nix b/tv/5pkgs/simple/xmonad-tv/default.nix
index 97cc29917..ab4be91f3 100644
--- a/tv/5pkgs/simple/xmonad-tv/default.nix
+++ b/tv/5pkgs/simple/xmonad-tv/default.nix
@@ -19,6 +19,11 @@ pkgs.writeHaskellPackage "xmonad-tv" {
 
 module Main where
 
+import System.IO.Error (isDoesNotExistError, tryIOError)
+import System.Exit (exitFailure)
+import Control.Monad (forever)
+import Control.Concurrent (threadDelay)
+
 import Control.Exception
 import Control.Monad.Extra (whenJustM)
 import Graphics.X11.ExtraTypes.XF86
@@ -27,6 +32,8 @@ import XMonad
 import System.IO (hPutStrLn, stderr)
 import System.Environment (getArgs, getEnv, getEnvironment, lookupEnv)
 import System.Posix.Process (executeFile)
+import System.Posix.Signals (nullSignal, signalProcess)
+import System.Posix.Types (ProcessID)
 import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace
                                         , removeEmptyWorkspace)
 import XMonad.Actions.GridSelect
@@ -57,8 +64,23 @@ myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*"
 
 main :: IO ()
 main = getArgs >>= \case
-    ["--shutdown"] -> sendShutdownEvent
-    _ -> mainNoArgs
+    [] -> mainNoArgs
+    ["--shutdown", pidArg] -> mainShutdown (read pidArg)
+    args -> hPutStrLn stderr ("bad arguments: " <> show args) >> exitFailure
+
+mainShutdown :: ProcessID -> IO ()
+mainShutdown pid = do
+    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)
 
 mainNoArgs :: IO ()
 mainNoArgs = do