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]
|
, fsDaemons = [runNetAppDaemon cl, runAutolock]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
withXmobar :: (Process Handle () () -> FIO a) -> FIO a
|
||||||
|
withXmobar = bracket startXmobar stopXmobar
|
||||||
|
|
||||||
startXmobar :: FIO (Process Handle () ())
|
startXmobar :: FIO (Process Handle () ())
|
||||||
startXmobar = do
|
startXmobar = do
|
||||||
p <- proc "xmobar" [] start
|
p <- proc "xmobar" [] start
|
||||||
|
@ -219,22 +222,27 @@ startXmobar = do
|
||||||
. setStdin createPipe
|
. setStdin createPipe
|
||||||
. setCreateGroup True
|
. 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 :: FeatureSet -> FIO [Process () () ()]
|
||||||
startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
|
startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
|
||||||
|
|
||||||
withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
|
stopChildDaemons
|
||||||
withChildDaemons fs = bracket (startChildDaemons fs) cleanup
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
where
|
=> [Process () () ()]
|
||||||
cleanup ps = do
|
-> m ()
|
||||||
logInfo "stopping child processes"
|
stopChildDaemons ps = do
|
||||||
mapM_ (io . killNoWait) ps
|
logInfo "stopping child processes"
|
||||||
|
mapM_ (liftIO . 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
|
|
||||||
|
|
||||||
printDeps :: FIO ()
|
printDeps :: FIO ()
|
||||||
printDeps = withDBus_ $ \db -> do
|
printDeps = withDBus_ $ \db -> do
|
||||||
|
@ -273,10 +281,10 @@ runCleanup
|
||||||
-> ThreadState
|
-> ThreadState
|
||||||
-> DBusState
|
-> DBusState
|
||||||
-> X ()
|
-> X ()
|
||||||
runCleanup runIO ts db = io $ do
|
runCleanup runIO ts db = liftIO $ runIO $ do
|
||||||
mapM_ killNoWait $ tsXmobar ts
|
mapM_ stopXmobar $ tsXmobar ts
|
||||||
mapM_ killNoWait $ tsChildPIDs ts
|
stopChildDaemons $ tsChildPIDs ts
|
||||||
liftIO $ runIO $ disconnectDBusX db
|
disconnectDBusX db
|
||||||
|
|
||||||
-- | Kill a process (group) after xmonad has already started
|
-- | Kill a process (group) after xmonad has already started
|
||||||
-- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
|
-- 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.
|
-- | Block until a PID has exited.
|
||||||
-- Use this to control flow based on a process that was not explicitly started
|
-- 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.
|
-- 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
|
waitUntilExit pid = do
|
||||||
res <- doesDirectoryExist $ "/proc" </> show pid
|
res <- doesDirectoryExist $ "/proc" </> show pid
|
||||||
when res $ do
|
when res $ do
|
||||||
|
|
Loading…
Reference in New Issue