FIX properly kill processes after xmonad has started

bin/xmonad.hs

@@ -28,7 +28,11 @@ import qualified RIO.Text                                       as T
 
 import           System.Environment
 import           System.Posix.Signals
-import           System.Process                                 (getPid)
+import           System.Process
+    ( getPid
+    , getProcessExitCode
+    )
+import           System.Process.Typed                           (nullStream)
 
 import           XMonad
 import           XMonad.Actions.CopyWindow
@@ -189,9 +193,13 @@ features cl = FeatureSet
 
 startXmobar :: FIO (Process Handle () ())
 startXmobar = do
-  p <- proc "xmobar" [] (startProcess . setStdin createPipe . setCreateGroup True)
+  p <- proc "xmobar" [] start
   io $ hSetBuffering (getStdin p) LineBuffering
   return p
+  where
+    start = startProcess
+      . setStdin createPipe
+      . setCreateGroup True
 
 startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
@@ -208,14 +216,14 @@ withChildDaemons fs = bracket (startChildDaemons fs) cleanup
   where
     cleanup ps = do
       logInfo "stopping child processes"
-      mapM_ stopProcess ps
+      mapM_ (io . killNoWait) ps
 
 withXmobar :: (Process Handle () () -> FIO a) -> FIO a
 withXmobar = bracket startXmobar cleanup
   where
     cleanup p = do
       logInfo "stopping xmobar child process"
-      stopProcess p
+      io $ killNoWait p
 
 printDeps :: FIO ()
 printDeps = do
@@ -256,15 +264,35 @@ data ThreadState = ThreadState
 runCleanup :: ThreadState -> DBusState -> X ()
 runCleanup ts db = io $ do
   mapM_ killNoWait $ tsXmobar ts
-  finally (mapM_ killNoWait $ tsChildPIDs ts) $
+  mapM_ killNoWait $ tsChildPIDs ts
-    disconnectDBusX db
+  disconnectDBusX db
-  where
+
-    stopNoWait p = handleIO (\_ -> return ()) $ stopProcess p
+-- | Kill a process (group) after xmonad has already started
-    killNoWait p = do
+-- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
-      let ph = unsafeProcessHandle p
+-- sets the handler for sigCHLD to Ignore which breaks 'waitForProcess' (which
-      i <- getPid ph
+-- in turn will break 'stopProcess') and b) because I want to kill off entire
-      forM_ i $ signalProcessGroup sigTERM
+-- process groups since they may spawn child processes themselves. NOTE:
-      stopNoWait p
+-- for reasons unknown I cannot just turn off/on the signal handlers here.
+killNoWait :: Process a () () -> IO ()
+killNoWait p = do
+  -- this strategy is outlined/sanctioned in RIO.Process under
+  -- 'unsafeProcessHandle':
+  --
+  -- get the handle (unsafely, since it breaks the semantics of RIO)
+  let ph = unsafeProcessHandle p
+  -- check if the process has already exited (if so, do nothing since trying
+  -- to kill it will open wormholes
+  ec <- getProcessExitCode ph
+  unless (isJust ec) $ do
+    -- send SIGTERM to the entire group (NOTE: 'System.Process.terminateProcess'
+    -- does not actually do this despite what the docs say)
+    i <- getPid ph
+    forM_ i $ signalProcessGroup sigTERM
+    -- actually call 'stopProcess' which will clean up associated data and
+    -- then try to wait for the exit, which will fail because we are assuming
+    -- this function is called when the handler for SIGCHLD is Ignore. Ignore
+    -- the failure and move on with life.
+    handleIO (\_ -> return ()) $ stopProcess p
 
 --------------------------------------------------------------------------------
 -- | Startuphook configuration