ENH log cleanup for xmobar and child processes
This commit is contained in:
parent
89eacd63aa
commit
4afaf9af10
|
@ -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
|
||||
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
|
||||
stopChildDaemons
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> [Process () () ()]
|
||||
-> m ()
|
||||
stopChildDaemons ps = do
|
||||
logInfo "stopping child processes"
|
||||
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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue