REF undo homegrown pipe command
This commit is contained in:
parent
f0451891b8
commit
f95079ba5e
|
@ -22,13 +22,9 @@ 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.
|
||||||
--
|
--
|
||||||
|
@ -93,30 +89,30 @@ spawnPipe
|
||||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> T.Text
|
=> T.Text
|
||||||
-> m Handle
|
-> m Handle
|
||||||
spawnPipe = spawnPipeRW
|
spawnPipe = liftIO . XR.spawnPipe . T.unpack
|
||||||
|
|
||||||
spawnPipeRW
|
-- spawnPipeRW
|
||||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
-- :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
=> T.Text
|
-- => T.Text
|
||||||
-> m Handle
|
-- -> m Handle
|
||||||
spawnPipeRW x = do
|
-- spawnPipeRW x = do
|
||||||
(r, h) <- liftIO mkPipe
|
-- (r, h) <- liftIO mkPipe
|
||||||
child r
|
-- child r
|
||||||
liftIO $ closeFd r
|
-- liftIO $ closeFd r
|
||||||
return h
|
-- return h
|
||||||
where
|
-- where
|
||||||
mkPipe = do
|
-- mkPipe = do
|
||||||
(r, w) <- createPipe
|
-- (r, w) <- createPipe
|
||||||
setFdOption w CloseOnExec True
|
-- setFdOption w CloseOnExec True
|
||||||
h <- fdToHandle w
|
-- h <- fdToHandle w
|
||||||
-- ASSUME we are using utf8 everywhere
|
-- -- ASSUME we are using utf8 everywhere
|
||||||
hSetEncoding h utf8
|
-- hSetEncoding h utf8
|
||||||
hSetBuffering h LineBuffering
|
-- hSetBuffering h LineBuffering
|
||||||
return (r, h)
|
-- return (r, h)
|
||||||
child r = void $ withRunInIO $ \runIO -> do
|
-- child r = void $ withRunInIO $ \runIO -> do
|
||||||
X.xfork $ runIO $ do
|
-- X.xfork $ runIO $ do
|
||||||
void $ liftIO $ dupTo r stdInput
|
-- void $ liftIO $ dupTo r stdInput
|
||||||
liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
|
-- liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
|
||||||
|
|
||||||
-- | 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 ()
|
||||||
|
|
Loading…
Reference in New Issue