diff --git a/bin/xmonad.hs b/bin/xmonad.hs index b23c2e1..1ee95a2 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -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 diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs index 2acde87..4e3a712 100644 --- a/lib/XMonad/Internal/IO.hs +++ b/lib/XMonad/Internal/IO.hs @@ -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