ENH be more precise when logging child processes
This commit is contained in:
parent
ac743daa32
commit
00f899ed9a
|
@ -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 ()]
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue