ENH log cleanup for xmobar and child processes

This commit is contained in:
Nathan Dwarshuis 2023-01-01 12:07:43 -05:00
parent 89eacd63aa
commit 4afaf9af10
2 changed files with 26 additions and 18 deletions

View File

@ -208,6 +208,9 @@ features cl =
, fsDaemons = [runNetAppDaemon cl, runAutolock]
}
withXmobar :: (Process Handle () () -> FIO a) -> FIO a
withXmobar = bracket startXmobar stopXmobar
startXmobar :: FIO (Process Handle () ())
startXmobar = do
p <- proc "xmobar" [] start
@ -219,22 +222,27 @@ startXmobar = do
. setStdin createPipe
. setCreateGroup True
stopXmobar
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
=> Process Handle () ()
-> m ()
stopXmobar p = do
logInfo "stopping xmobar child process"
io $ killNoWait p
withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
withChildDaemons fs = bracket (startChildDaemons fs) stopChildDaemons
startChildDaemons :: FeatureSet -> FIO [Process () () ()]
startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
withChildDaemons fs = bracket (startChildDaemons fs) cleanup
where
cleanup ps = do
stopChildDaemons
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
=> [Process () () ()]
-> m ()
stopChildDaemons ps = do
logInfo "stopping child processes"
mapM_ (io . killNoWait) ps
withXmobar :: (Process Handle () () -> FIO a) -> FIO a
withXmobar = bracket startXmobar cleanup
where
cleanup p = do
logInfo "stopping xmobar child process"
io $ killNoWait p
mapM_ (liftIO . killNoWait) ps
printDeps :: FIO ()
printDeps = withDBus_ $ \db -> do
@ -273,10 +281,10 @@ runCleanup
-> ThreadState
-> DBusState
-> X ()
runCleanup runIO ts db = io $ do
mapM_ killNoWait $ tsXmobar ts
mapM_ killNoWait $ tsChildPIDs ts
liftIO $ runIO $ disconnectDBusX db
runCleanup runIO ts db = liftIO $ runIO $ do
mapM_ stopXmobar $ tsXmobar ts
stopChildDaemons $ tsChildPIDs ts
disconnectDBusX db
-- | Kill a process (group) after xmonad has already started
-- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad

View File

@ -166,7 +166,7 @@ getPermissionsSafe f = do
-- | Block until a PID has exited.
-- Use this to control flow based on a process that was not explicitly started
-- by the Haskell runtime itself, and thus has no data structures to query.
waitUntilExit :: (MonadIO m) => Pid -> m ()
waitUntilExit :: (MonadUnliftIO m) => Pid -> m ()
waitUntilExit pid = do
res <- doesDirectoryExist $ "/proc" </> show pid
when res $ do