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 :: FIO (Process Handle () ())
startXmobar = do startXmobar = do
logInfo "starting xmobar child process"
p <- proc "xmobar" [] start p <- proc "xmobar" [] start
io $ hSetBuffering (getStdin p) LineBuffering io $ hSetBuffering (getStdin p) LineBuffering
return p return p
@ -225,19 +226,35 @@ stopXmobar p = do
logInfo "stopping xmobar child process" logInfo "stopping xmobar child process"
io $ killNoWait p io $ killNoWait p
withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a withChildDaemons
:: FeatureSet
-> ([(Utf8Builder, Process () () ())] -> FIO a)
-> FIO a
withChildDaemons fs = bracket (startChildDaemons fs) stopChildDaemons withChildDaemons fs = bracket (startChildDaemons fs) stopChildDaemons
startChildDaemons :: FeatureSet -> FIO [Process () () ()] startChildDaemons :: FeatureSet -> FIO [(Utf8Builder, Process () () ())]
startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs) 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 stopChildDaemons
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m) :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
=> [Process () () ()] => [(Utf8Builder, Process () () ())]
-> m () -> m ()
stopChildDaemons ps = do stopChildDaemons = mapM_ stop
logInfo "stopping child processes" where
mapM_ (liftIO . killNoWait) ps stop (n, p) = do
logInfo $ "stopping child process: " <> n
liftIO $ killNoWait p
printDeps :: FIO () printDeps :: FIO ()
printDeps = withDBus_ $ \db -> do printDeps = withDBus_ $ \db -> do
@ -267,7 +284,7 @@ printDeps = withDBus_ $ \db -> do
-- Concurrency configuration -- Concurrency configuration
data Cleanup = Cleanup data Cleanup = Cleanup
{ clChildren :: [Process () () ()] { clChildren :: [(Utf8Builder, Process () () ())]
, clXmobar :: Maybe (Process Handle () ()) , clXmobar :: Maybe (Process Handle () ())
, clDBusUnexporters :: [FIO ()] , clDBusUnexporters :: [FIO ()]
} }