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 :: 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 ()]
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue