WIP log output from child processes

lib/XMonad/Internal/Shell.hs

@@ -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 ()