ENH fork env in child process (duh)

lib/XMonad/Internal/Shell.hs

@@ -93,32 +93,29 @@ spawnPipe
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => T.Text
   -> m Handle
-spawnPipe = liftIO . spawnPipeRW
+spawnPipe = spawnPipeRW
 
-spawnPipeRW :: T.Text -> IO Handle
+spawnPipeRW
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => T.Text
+  -> m Handle
 spawnPipeRW x = 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
-  err <- dup stdError
-  forM_ [wI, err] $ \fd -> setFdOption fd CloseOnExec True
-  h <- mkHandle wI
-  void $ X.xfork $ do
-    void $ dupTo rI stdInput
-    void $ dupTo err stdOutput
-    void $ dupTo err stdError
-    executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
-  closeFd rI
+  (r, h) <- liftIO mkPipe
+  void $ withRunInIO $ \runIO -> do
+    X.xfork $ runIO $ do
+      void $ liftIO $ dupTo r stdInput
+      liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
+  liftIO $ closeFd r
   return h
   where
-    mkHandle fd = do
-      h <- fdToHandle fd
+    mkPipe = do
+      (r, w) <- createPipe
+      setFdOption w CloseOnExec True
+      h <- fdToHandle w
       -- ASSUME we are using utf8 everywhere
       hSetEncoding h utf8
       hSetBuffering h LineBuffering
-      return h
+      return (r, h)
 
 -- | Run 'XMonad.Core.spawn' with a command and arguments
 spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()