diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs index d59adc9..b8fa339 100644 --- a/lib/XMonad/Internal/Shell.hs +++ b/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 ()