ENH be more precise when logging child processes

This commit is contained in:
Nathan Dwarshuis 2023-01-01 14:57:23 -05:00
parent ac743daa32
commit 00f899ed9a
1 changed files with 25 additions and 8 deletions

View File

@ -208,6 +208,7 @@ withXmobar = bracket startXmobar stopXmobar
startXmobar :: FIO (Process Handle () ())
startXmobar = do
logInfo "starting xmobar child process"
p <- proc "xmobar" [] start
io $ hSetBuffering (getStdin p) LineBuffering
return p
@ -225,19 +226,35 @@ stopXmobar p = do
logInfo "stopping xmobar child process"
io $ killNoWait p
withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
withChildDaemons
:: FeatureSet
-> ([(Utf8Builder, Process () () ())] -> FIO a)
-> FIO a
withChildDaemons fs = bracket (startChildDaemons fs) stopChildDaemons
startChildDaemons :: FeatureSet -> FIO [Process () () ()]
startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
startChildDaemons :: FeatureSet -> FIO [(Utf8Builder, Process () () ())]
startChildDaemons fs = catMaybes <$> mapM start (fsDaemons fs)
where
start s@(Sometimes sname _ _) = do
let sname_ = Utf8Builder $ encodeUtf8Builder sname
res <- executeSometimes s
case res of
Just p -> do
logInfo $ "starting child process: " <> sname_
return $ Just (sname_, p)
-- don't log anything here since presumably the feature itself will log
-- an error if it fails during execution
_ -> return Nothing
stopChildDaemons
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
=> [Process () () ()]
=> [(Utf8Builder, Process () () ())]
-> m ()
stopChildDaemons ps = do
logInfo "stopping child processes"
mapM_ (liftIO . killNoWait) ps
stopChildDaemons = mapM_ stop
where
stop (n, p) = do
logInfo $ "stopping child process: " <> n
liftIO $ killNoWait p
printDeps :: FIO ()
printDeps = withDBus_ $ \db -> do
@ -267,7 +284,7 @@ printDeps = withDBus_ $ \db -> do
-- Concurrency configuration
data Cleanup = Cleanup
{ clChildren :: [Process () () ()]
{ clChildren :: [(Utf8Builder, Process () () ())]
, clXmobar :: Maybe (Process Handle () ())
, clDBusUnexporters :: [FIO ()]
}