WIP log output from child processes

This commit is contained in:
Nathan Dwarshuis 2023-01-02 20:36:38 -05:00
parent 6891238793
commit 774fba0c71
1 changed files with 32 additions and 2 deletions

View File

@ -22,9 +22,13 @@ where
import RIO import RIO
import qualified RIO.Text as T import qualified RIO.Text as T
import System.IO hiding (hSetBuffering)
import System.Posix.IO
import System.Posix.Process
import qualified System.Process.Typed as P import qualified System.Process.Typed as P
import qualified XMonad.Core as X import qualified XMonad.Core as X
import qualified XMonad.Util.Run as XR
-- import qualified XMonad.Util.Run as XR
-- | Fork a new process and wait for its exit code. -- | Fork a new process and wait for its exit code.
-- --
@ -89,7 +93,33 @@ spawnPipe
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m) :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
=> T.Text => T.Text
-> m Handle -> m Handle
spawnPipe = XR.spawnPipe . T.unpack spawnPipe = fmap fst . spawnPipeRW
spawnPipeRW :: MonadIO m => T.Text -> m (Handle, Handle)
spawnPipeRW x = liftIO $ do
(rI, wI) <- createPipe
(rO, wO) <- createPipe
-- I'm assuming the only place this matters is when xmonad is restarted (which
-- calls exec); since these are the ends of the pipe that xmonad will be
-- using, this ensures they will be closed when restarting
forM_ [wI, rO] $ \fd -> setFdOption fd CloseOnExec True
hI <- mkHandle wI
hO <- mkHandle rO
void $ X.xfork $ do
void $ dupTo rI stdInput
void $ dupTo wO stdOutput
void $ dupTo wO stdError
executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
closeFd rI
closeFd wO
return (hI, hO)
where
mkHandle fd = do
h <- fdToHandle fd
-- ASSUME we are using utf8 everywhere
hSetEncoding h utf8
hSetBuffering h LineBuffering
return h
-- | Run 'XMonad.Core.spawn' with a command and arguments -- | Run 'XMonad.Core.spawn' with a command and arguments
spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m () spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()