WIP log output from child processes
This commit is contained in:
parent
6891238793
commit
774fba0c71
|
@ -22,9 +22,13 @@ where
|
|||
|
||||
import RIO
|
||||
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 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.
|
||||
--
|
||||
|
@ -89,7 +93,33 @@ spawnPipe
|
|||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> T.Text
|
||||
-> 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
|
||||
spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
|
||||
|
|
Loading…
Reference in New Issue