ENH clean up xmobar properly

This commit is contained in:
Nathan Dwarshuis 2022-12-28 00:04:33 -05:00
parent 780c600d47
commit 59c483785a
3 changed files with 10 additions and 6 deletions

View File

@ -20,7 +20,10 @@ import Graphics.X11.Types
import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import RIO (async) import RIO
( async
, handleIO
)
import RIO.Process import RIO.Process
import qualified RIO.Text as T import qualified RIO.Text as T
@ -186,11 +189,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
$ fsDBusExporters fs $ fsDBusExporters fs
startChildDaemons fs = do startChildDaemons fs = do
p <- proc "xmobar" [] (startProcess . setStdin createPipe) p <- proc "xmobar" [] (startProcess . setStdin createPipe)
-- (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
io $ hSetBuffering (getStdin p) LineBuffering io $ hSetBuffering (getStdin p) LineBuffering
-- io $ case h of
-- Just h' -> hSetBuffering h' LineBuffering
-- Nothing -> return ()
ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs) ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
return $ ThreadState ps $ Just p return $ ThreadState ps $ Just p
startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
@ -240,8 +239,11 @@ data ThreadState = ThreadState
-- TODO shouldn't this be run by a signal handler? -- TODO shouldn't this be run by a signal handler?
runCleanup :: ThreadState -> DBusState -> X () runCleanup :: ThreadState -> DBusState -> X ()
runCleanup ts db = io $ do runCleanup ts db = io $ do
mapM_ stopNoWait $ tsXmobar ts
mapM_ killHandle $ tsChildPIDs ts mapM_ killHandle $ tsChildPIDs ts
disconnectDBusX db disconnectDBusX db
where
stopNoWait p = handleIO (\_ -> return ()) $ stopProcess p
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Startuphook configuration -- | Startuphook configuration

View File

@ -133,6 +133,7 @@ import System.Directory
import System.Environment import System.Environment
import System.IO.Error import System.IO.Error
import System.Posix.Files import System.Posix.Files
import System.Process.Typed (nullStream)
import XMonad.Core (X, io) import XMonad.Core (X, io)
import XMonad.Internal.IO import XMonad.Internal.IO
@ -685,7 +686,7 @@ testSysDependency (AccessiblePath p r w) = io $ permMsg <$> getPermissionsSafe p
shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg) shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg)
shellTest cmd args msg = do shellTest cmd args msg = do
rc <- proc cmd (T.unpack <$> args) runProcess rc <- proc cmd (T.unpack <$> args) (runProcess . setStdout nullStream)
return $ case rc of return $ case rc of
ExitSuccess -> Nothing ExitSuccess -> Nothing
_ -> Just $ Msg LevelError msg _ -> Just $ Msg LevelError msg

View File

@ -41,6 +41,7 @@ dependencies:
- xml >= 1.3.14 - xml >= 1.3.14
- lifted-base >= 0.2.3.12 - lifted-base >= 0.2.3.12
- utf8-string >= 1.0.2 - utf8-string >= 1.0.2
- typed-process >= 0.2.8.0
library: library:
source-dirs: lib/ source-dirs: lib/