{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.Process.Typed
(
ProcessConfig
, StreamSpec
, StreamType (..)
, Process
, proc
, shell
, setStdin
, setStdout
, setStderr
, setWorkingDir
, setWorkingDirInherit
, setEnv
, setEnvInherit
, setCloseFds
, setCreateGroup
, setDelegateCtlc
#if MIN_VERSION_process(1, 3, 0)
, setDetachConsole
, setCreateNewConsole
, setNewSession
#endif
#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
, setChildGroup
, setChildGroupInherit
, setChildUser
, setChildUserInherit
#endif
, inherit
, nullStream
, closed
, byteStringInput
, byteStringOutput
, createPipe
, useHandleOpen
, useHandleClose
, mkStreamSpec
, mkPipeStreamSpec
, runProcess
, readProcess
, readProcessStdout
, readProcessStderr
, readProcessInterleaved
, withProcessWait
, withProcessTerm
, startProcess
, stopProcess
, runProcess_
, readProcess_
, readProcessStdout_
, readProcessStderr_
, readProcessInterleaved_
, withProcessWait_
, withProcessTerm_
, waitExitCode
, waitExitCodeSTM
, getExitCode
, getExitCodeSTM
, checkExitCode
, checkExitCodeSTM
, getStdin
, getStdout
, getStderr
, ExitCodeException (..)
, ByteStringOutputException (..)
, ExitCode (..)
, P.StdStream (..)
, unsafeProcessHandle
, withProcess
, withProcess_
) where
import Control.Exception hiding (bracket, finally)
import Control.Monad.IO.Class
import qualified System.Process as P
import System.IO (hClose)
import System.IO.Error (isPermissionError)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (asyncWithUnmask, cancel, waitCatch)
import Control.Concurrent.STM (newEmptyTMVarIO, atomically, putTMVar, TMVar, readTMVar, tryReadTMVar, STM, tryPutTMVar, throwSTM, catchSTM)
import System.Exit (ExitCode (ExitSuccess, ExitFailure))
import System.Process.Typed.Internal
import qualified Data.ByteString.Lazy as L
import GHC.RTS.Flags (getConcFlags, ctxtSwitchTime)
import Control.Monad.IO.Unlift
#if !MIN_VERSION_base(4, 8, 0)
import Control.Applicative (Applicative (..), (<$>), (<$))
#endif
#if !MIN_VERSION_process(1, 3, 0)
import qualified System.Process.Internals as P (createProcess_)
#endif
data Process stdin stdout stderr = Process
{ forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessConfig () () ()
pConfig :: !(ProcessConfig () () ())
, forall stdin stdout stderr. Process stdin stdout stderr -> IO ()
pCleanup :: !(IO ())
, forall stdin stdout stderr. Process stdin stdout stderr -> stdin
pStdin :: !stdin
, forall stdin stdout stderr. Process stdin stdout stderr -> stdout
pStdout :: !stdout
, forall stdin stdout stderr. Process stdin stdout stderr -> stderr
pStderr :: !stderr
, forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessHandle
pHandle :: !P.ProcessHandle
, forall stdin stdout stderr.
Process stdin stdout stderr -> TMVar ExitCode
pExitCode :: !(TMVar ExitCode)
}
instance Show (Process stdin stdout stderr) where
show :: Process stdin stdout stderr -> String
show Process stdin stdout stderr
p = String
"Running process: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessConfig () () ()
pConfig Process stdin stdout stderr
p)
startProcess :: MonadIO m
=> ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess :: forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess pConfig' :: ProcessConfig stdin stdout stderr
pConfig'@ProcessConfig {Bool
Maybe String
Maybe [(String, String)]
Maybe UserID
Maybe GroupID
CmdSpec
StreamSpec 'STInput stdin
StreamSpec 'STOutput stdout
StreamSpec 'STOutput stderr
pcChildUser :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe UserID
pcChildGroup :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe GroupID
pcNewSession :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcCreateNewConsole :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcDetachConsole :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcDelegateCtlc :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcCreateGroup :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcCloseFds :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcEnv :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe [(String, String)]
pcWorkingDir :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe String
pcStderr :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> StreamSpec 'STOutput stderr
pcStdout :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> StreamSpec 'STOutput stdout
pcStdin :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> StreamSpec 'STInput stdin
pcCmdSpec :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> CmdSpec
pcChildUser :: Maybe UserID
pcChildGroup :: Maybe GroupID
pcNewSession :: Bool
pcCreateNewConsole :: Bool
pcDetachConsole :: Bool
pcDelegateCtlc :: Bool
pcCreateGroup :: Bool
pcCloseFds :: Bool
pcEnv :: Maybe [(String, String)]
pcWorkingDir :: Maybe String
pcStderr :: StreamSpec 'STOutput stderr
pcStdout :: StreamSpec 'STOutput stdout
pcStdin :: StreamSpec 'STInput stdin
pcCmdSpec :: CmdSpec
..} = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall (streamType :: StreamType) a.
StreamSpec streamType a -> forall b. (StdStream -> IO b) -> IO b
ssStream StreamSpec 'STInput stdin
pcStdin forall a b. (a -> b) -> a -> b
$ \StdStream
realStdin ->
forall (streamType :: StreamType) a.
StreamSpec streamType a -> forall b. (StdStream -> IO b) -> IO b
ssStream StreamSpec 'STOutput stdout
pcStdout forall a b. (a -> b) -> a -> b
$ \StdStream
realStdout ->
forall (streamType :: StreamType) a.
StreamSpec streamType a -> forall b. (StdStream -> IO b) -> IO b
ssStream StreamSpec 'STOutput stderr
pcStderr forall a b. (a -> b) -> a -> b
$ \StdStream
realStderr -> do
let cp0 :: CreateProcess
cp0 =
case CmdSpec
pcCmdSpec of
P.ShellCommand String
cmd -> String -> CreateProcess
P.shell String
cmd
P.RawCommand String
cmd [String]
args -> String -> [String] -> CreateProcess
P.proc String
cmd [String]
args
cp :: CreateProcess
cp = CreateProcess
cp0
{ std_in :: StdStream
P.std_in = StdStream
realStdin
, std_out :: StdStream
P.std_out = StdStream
realStdout
, std_err :: StdStream
P.std_err = StdStream
realStderr
, cwd :: Maybe String
P.cwd = Maybe String
pcWorkingDir
, env :: Maybe [(String, String)]
P.env = Maybe [(String, String)]
pcEnv
, close_fds :: Bool
P.close_fds = Bool
pcCloseFds
, create_group :: Bool
P.create_group = Bool
pcCreateGroup
, delegate_ctlc :: Bool
P.delegate_ctlc = Bool
pcDelegateCtlc
#if MIN_VERSION_process(1, 3, 0)
, detach_console :: Bool
P.detach_console = Bool
pcDetachConsole
, create_new_console :: Bool
P.create_new_console = Bool
pcCreateNewConsole
, new_session :: Bool
P.new_session = Bool
pcNewSession
#endif
#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
, child_group :: Maybe GroupID
P.child_group = Maybe GroupID
pcChildGroup
, child_user :: Maybe UserID
P.child_user = Maybe UserID
pcChildUser
#endif
}
(Maybe Handle
minH, Maybe Handle
moutH, Maybe Handle
merrH, ProcessHandle
pHandle) <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
P.createProcess_ String
"startProcess" CreateProcess
cp
((stdin
pStdin, stdout
pStdout, stderr
pStderr), IO ()
pCleanup1) <- forall a. Cleanup a -> IO (a, IO ())
runCleanup forall a b. (a -> b) -> a -> b
$ (,,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (streamType :: StreamType) a.
StreamSpec streamType a
-> ProcessConfig () () () -> Maybe Handle -> Cleanup a
ssCreate StreamSpec 'STInput stdin
pcStdin ProcessConfig () () ()
pConfig Maybe Handle
minH
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (streamType :: StreamType) a.
StreamSpec streamType a
-> ProcessConfig () () () -> Maybe Handle -> Cleanup a
ssCreate StreamSpec 'STOutput stdout
pcStdout ProcessConfig () () ()
pConfig Maybe Handle
moutH
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (streamType :: StreamType) a.
StreamSpec streamType a
-> ProcessConfig () () () -> Maybe Handle -> Cleanup a
ssCreate StreamSpec 'STOutput stderr
pcStderr ProcessConfig () () ()
pConfig Maybe Handle
merrH
TMVar ExitCode
pExitCode <- forall a. IO (TMVar a)
newEmptyTMVarIO
Async ExitCode
waitingThread <- forall a. ((forall b. IO b -> IO b) -> IO a) -> IO (Async a)
asyncWithUnmask forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
unmask -> do
ExitCode
ec <- forall b. IO b -> IO b
unmask forall a b. (a -> b) -> a -> b
$
if Bool
multiThreadedRuntime
then ProcessHandle -> IO ExitCode
P.waitForProcess ProcessHandle
pHandle
else do
Int
switchTime <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`div` RtsTime
1000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConcFlags -> RtsTime
ctxtSwitchTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ConcFlags
getConcFlags
let minDelay :: Int
minDelay = Int
1
maxDelay :: Int
maxDelay = forall a. Ord a => a -> a -> a
max Int
minDelay Int
switchTime
loop :: Int -> IO ExitCode
loop Int
delay = do
Int -> IO ()
threadDelay Int
delay
Maybe ExitCode
mec <- ProcessHandle -> IO (Maybe ExitCode)
P.getProcessExitCode ProcessHandle
pHandle
case Maybe ExitCode
mec of
Maybe ExitCode
Nothing -> Int -> IO ExitCode
loop forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Int
maxDelay (Int
delay forall a. Num a => a -> a -> a
* Int
2)
Just ExitCode
ec -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ec
Int -> IO ExitCode
loop Int
minDelay
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM ()
putTMVar TMVar ExitCode
pExitCode ExitCode
ec
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ec
let pCleanup :: IO ()
pCleanup = IO ()
pCleanup1 forall (m :: * -> *) a. MonadUnliftIO m => m a -> IO () -> m a
`finally` do
forall a. Async a -> IO ()
cancel Async ExitCode
waitingThread
Either SomeException ExitCode
eec <- forall a. Async a -> IO (Either SomeException a)
waitCatch Async ExitCode
waitingThread
case Either SomeException ExitCode
eec of
Right ExitCode
_ec -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left SomeException
_ -> do
Either IOError ()
eres <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ()
P.terminateProcess ProcessHandle
pHandle
ExitCode
ec <-
case Either IOError ()
eres of
Left IOError
e
| IOError -> Bool
isPermissionError IOError
e Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
multiThreadedRuntime Bool -> Bool -> Bool
&& Bool
isWindows ->
ProcessHandle -> IO ExitCode
P.waitForProcess ProcessHandle
pHandle
| Bool
otherwise -> forall e a. Exception e => e -> IO a
throwIO IOError
e
Right () -> ProcessHandle -> IO ExitCode
P.waitForProcess ProcessHandle
pHandle
Bool
success <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar ExitCode
pExitCode ExitCode
ec
forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
success ()
forall (m :: * -> *) a. Monad m => a -> m a
return Process {stdin
stdout
stderr
IO ()
ProcessHandle
TMVar ExitCode
ProcessConfig () () ()
pCleanup :: IO ()
pExitCode :: TMVar ExitCode
pConfig :: ProcessConfig () () ()
pStderr :: stderr
pStdout :: stdout
pStdin :: stdin
pHandle :: ProcessHandle
pExitCode :: TMVar ExitCode
pHandle :: ProcessHandle
pStderr :: stderr
pStdout :: stdout
pStdin :: stdin
pCleanup :: IO ()
pConfig :: ProcessConfig () () ()
..}
where
pConfig :: ProcessConfig () () ()
pConfig = forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
clearStreams ProcessConfig stdin stdout stderr
pConfig'
foreign import ccall unsafe "rtsSupportsBoundThreads"
multiThreadedRuntime :: Bool
isWindows :: Bool
#if WINDOWS
isWindows = True
#else
isWindows :: Bool
isWindows = Bool
False
#endif
stopProcess :: MonadIO m
=> Process stdin stdout stderr
-> m ()
stopProcess :: forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stdin stdout stderr. Process stdin stdout stderr -> IO ()
pCleanup
withProcessTerm :: (MonadUnliftIO m)
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcessTerm :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm ProcessConfig stdin stdout stderr
config = forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket (forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess ProcessConfig stdin stdout stderr
config) forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess
withProcessWait :: (MonadUnliftIO m)
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcessWait :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait ProcessConfig stdin stdout stderr
config Process stdin stdout stderr -> m a
f =
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket
(forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess ProcessConfig stdin stdout stderr
config)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess
(\Process stdin stdout stderr
p -> Process stdin stdout stderr -> m a
f Process stdin stdout stderr
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode Process stdin stdout stderr
p)
withProcess :: (MonadUnliftIO m)
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcess :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess = forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm
{-# DEPRECATED withProcess "Please consider using withProcessWait, or instead use withProcessTerm" #-}
withProcessTerm_ :: (MonadUnliftIO m)
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcessTerm_ :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm_ ProcessConfig stdin stdout stderr
config = forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket
(forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess ProcessConfig stdin stdout stderr
config)
(\Process stdin stdout stderr
p -> forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess Process stdin stdout stderr
p forall (m :: * -> *) a. MonadUnliftIO m => m a -> IO () -> m a
`finally` forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
checkExitCode Process stdin stdout stderr
p)
withProcessWait_ :: (MonadUnliftIO m)
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcessWait_ :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait_ ProcessConfig stdin stdout stderr
config Process stdin stdout stderr -> m a
f = forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket
(forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess ProcessConfig stdin stdout stderr
config)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess
(\Process stdin stdout stderr
p -> Process stdin stdout stderr -> m a
f Process stdin stdout stderr
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
checkExitCode Process stdin stdout stderr
p)
withProcess_ :: (MonadUnliftIO m)
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcess_ :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess_ = forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm_
{-# DEPRECATED withProcess_ "Please consider using withProcessWait_, or instead use withProcessTerm_" #-}
readProcess :: MonadIO m
=> ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, L.ByteString, L.ByteString)
readProcess :: forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess ProcessConfig stdin stdoutIgnored stderrIgnored
pc =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin (STM ByteString) (STM ByteString)
pc' forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) (STM ByteString)
p -> forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ (,,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM Process stdin (STM ByteString) (STM ByteString)
p
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) (STM ByteString)
p
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process stdin (STM ByteString) (STM ByteString)
p
where
pc' :: ProcessConfig stdin (STM ByteString) (STM ByteString)
pc' = forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput (STM ByteString)
byteStringOutput
forall a b. (a -> b) -> a -> b
$ forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput (STM ByteString)
byteStringOutput ProcessConfig stdin stdoutIgnored stderrIgnored
pc
readProcess_ :: MonadIO m
=> ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (L.ByteString, L.ByteString)
readProcess_ :: forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_ ProcessConfig stdin stdoutIgnored stderrIgnored
pc =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin (STM ByteString) (STM ByteString)
pc' forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) (STM ByteString)
p -> forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
ByteString
stdout <- forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) (STM ByteString)
p
ByteString
stderr <- forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process stdin (STM ByteString) (STM ByteString)
p
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin (STM ByteString) (STM ByteString)
p forall e a. Exception e => STM a -> (e -> STM a) -> STM a
`catchSTM` \ExitCodeException
ece -> forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
ece
{ eceStdout :: ByteString
eceStdout = ByteString
stdout
, eceStderr :: ByteString
eceStderr = ByteString
stderr
}
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
stdout, ByteString
stderr)
where
pc' :: ProcessConfig stdin (STM ByteString) (STM ByteString)
pc' = forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput (STM ByteString)
byteStringOutput
forall a b. (a -> b) -> a -> b
$ forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput (STM ByteString)
byteStringOutput ProcessConfig stdin stdoutIgnored stderrIgnored
pc
readProcessStdout
:: MonadIO m
=> ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, L.ByteString)
readProcessStdout :: forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessStdout ProcessConfig stdin stdoutIgnored stderr
pc =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin (STM ByteString) stderr
pc' forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) stderr
p -> forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM Process stdin (STM ByteString) stderr
p
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) stderr
p
where
pc' :: ProcessConfig stdin (STM ByteString) stderr
pc' = forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput (STM ByteString)
byteStringOutput ProcessConfig stdin stdoutIgnored stderr
pc
readProcessStdout_
:: MonadIO m
=> ProcessConfig stdin stdoutIgnored stderr
-> m L.ByteString
readProcessStdout_ :: forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ ProcessConfig stdin stdoutIgnored stderr
pc =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin (STM ByteString) stderr
pc' forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) stderr
p -> forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
ByteString
stdout <- forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) stderr
p
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin (STM ByteString) stderr
p forall e a. Exception e => STM a -> (e -> STM a) -> STM a
`catchSTM` \ExitCodeException
ece -> forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
ece
{ eceStdout :: ByteString
eceStdout = ByteString
stdout
}
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
stdout
where
pc' :: ProcessConfig stdin (STM ByteString) stderr
pc' = forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput (STM ByteString)
byteStringOutput ProcessConfig stdin stdoutIgnored stderr
pc
readProcessStderr
:: MonadIO m
=> ProcessConfig stdin stdout stderrIgnored
-> m (ExitCode, L.ByteString)
readProcessStderr :: forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessStderr ProcessConfig stdin stdout stderrIgnored
pc =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin stdout (STM ByteString)
pc' forall a b. (a -> b) -> a -> b
$ \Process stdin stdout (STM ByteString)
p -> forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM Process stdin stdout (STM ByteString)
p
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process stdin stdout (STM ByteString)
p
where
pc' :: ProcessConfig stdin stdout (STM ByteString)
pc' = forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput (STM ByteString)
byteStringOutput ProcessConfig stdin stdout stderrIgnored
pc
readProcessStderr_
:: MonadIO m
=> ProcessConfig stdin stdout stderrIgnored
-> m L.ByteString
readProcessStderr_ :: forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStderr_ ProcessConfig stdin stdout stderrIgnored
pc =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin stdout (STM ByteString)
pc' forall a b. (a -> b) -> a -> b
$ \Process stdin stdout (STM ByteString)
p -> forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
ByteString
stderr <- forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process stdin stdout (STM ByteString)
p
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin stdout (STM ByteString)
p forall e a. Exception e => STM a -> (e -> STM a) -> STM a
`catchSTM` \ExitCodeException
ece -> forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
ece
{ eceStderr :: ByteString
eceStderr = ByteString
stderr
}
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
stderr
where
pc' :: ProcessConfig stdin stdout (STM ByteString)
pc' = forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput (STM ByteString)
byteStringOutput ProcessConfig stdin stdout stderrIgnored
pc
withProcessInterleave :: (MonadUnliftIO m)
=> ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process stdin (STM L.ByteString) () -> m a)
-> m a
withProcessInterleave :: forall (m :: * -> *) stdin stdoutIgnored stderrIgnored a.
MonadUnliftIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process stdin (STM ByteString) () -> m a) -> m a
withProcessInterleave ProcessConfig stdin stdoutIgnored stderrIgnored
pc Process stdin (STM ByteString) () -> m a
inner =
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket IO (Handle, Handle)
P.createPipe (\(Handle
r, Handle
w) -> Handle -> IO ()
hClose Handle
r forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
w) forall a b. (a -> b) -> a -> b
$ \(Handle
readEnd, Handle
writeEnd) -> do
let pc' :: ProcessConfig stdin (STM ByteString) ()
pc' = forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout (forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec (Handle -> StdStream
P.UseHandle Handle
writeEnd) (\ProcessConfig () () ()
pc'' Maybe Handle
_ -> ProcessConfig () () () -> Handle -> IO (STM ByteString, IO ())
byteStringFromHandle ProcessConfig () () ()
pc'' Handle
readEnd))
forall a b. (a -> b) -> a -> b
$ forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr (forall (anyStreamType :: StreamType).
Handle -> StreamSpec anyStreamType ()
useHandleOpen Handle
writeEnd)
ProcessConfig stdin stdoutIgnored stderrIgnored
pc
forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin (STM ByteString) ()
pc' forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) ()
p -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
writeEnd
Process stdin (STM ByteString) () -> m a
inner Process stdin (STM ByteString) ()
p
readProcessInterleaved
:: MonadIO m
=> ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, L.ByteString)
readProcessInterleaved :: forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessInterleaved ProcessConfig stdin stdoutIgnored stderrIgnored
pc =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored a.
MonadUnliftIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process stdin (STM ByteString) () -> m a) -> m a
withProcessInterleave ProcessConfig stdin stdoutIgnored stderrIgnored
pc forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) ()
p ->
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM Process stdin (STM ByteString) ()
p
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) ()
p
readProcessInterleaved_
:: MonadIO m
=> ProcessConfig stdin stdoutIgnored stderrIgnored
-> m L.ByteString
readProcessInterleaved_ :: forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessInterleaved_ ProcessConfig stdin stdoutIgnored stderrIgnored
pc =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored a.
MonadUnliftIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process stdin (STM ByteString) () -> m a) -> m a
withProcessInterleave ProcessConfig stdin stdoutIgnored stderrIgnored
pc forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) ()
p -> forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
ByteString
stdout' <- forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) ()
p
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin (STM ByteString) ()
p forall e a. Exception e => STM a -> (e -> STM a) -> STM a
`catchSTM` \ExitCodeException
ece -> forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
ece
{ eceStdout :: ByteString
eceStdout = ByteString
stdout'
}
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
stdout'
runProcess :: MonadIO m
=> ProcessConfig stdin stdout stderr
-> m ExitCode
runProcess :: forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess ProcessConfig stdin stdout stderr
pc = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin stdout stderr
pc forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode
runProcess_ :: MonadIO m
=> ProcessConfig stdin stdout stderr
-> m ()
runProcess_ :: forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ ProcessConfig stdin stdout stderr
pc = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin stdout stderr
pc forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
checkExitCode
waitExitCode :: MonadIO m => Process stdin stdout stderr -> m ExitCode
waitExitCode :: forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM
waitExitCodeSTM :: Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM :: forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM = forall a. TMVar a -> STM a
readTMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stdin stdout stderr.
Process stdin stdout stderr -> TMVar ExitCode
pExitCode
getExitCode :: MonadIO m => Process stdin stdout stderr -> m (Maybe ExitCode)
getExitCode :: forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m (Maybe ExitCode)
getExitCode = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stdin stdout stderr.
Process stdin stdout stderr -> STM (Maybe ExitCode)
getExitCodeSTM
getExitCodeSTM :: Process stdin stdout stderr -> STM (Maybe ExitCode)
getExitCodeSTM :: forall stdin stdout stderr.
Process stdin stdout stderr -> STM (Maybe ExitCode)
getExitCodeSTM = forall a. TMVar a -> STM (Maybe a)
tryReadTMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stdin stdout stderr.
Process stdin stdout stderr -> TMVar ExitCode
pExitCode
checkExitCode :: MonadIO m => Process stdin stdout stderr -> m ()
checkExitCode :: forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
checkExitCode = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM
checkExitCodeSTM :: Process stdin stdout stderr -> STM ()
checkExitCodeSTM :: forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin stdout stderr
p = do
ExitCode
ec <- forall a. TMVar a -> STM a
readTMVar (forall stdin stdout stderr.
Process stdin stdout stderr -> TMVar ExitCode
pExitCode Process stdin stdout stderr
p)
case ExitCode
ec of
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitCode
_ -> forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
{ eceExitCode :: ExitCode
eceExitCode = ExitCode
ec
, eceProcessConfig :: ProcessConfig () () ()
eceProcessConfig = forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
clearStreams (forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessConfig () () ()
pConfig Process stdin stdout stderr
p)
, eceStdout :: ByteString
eceStdout = ByteString
L.empty
, eceStderr :: ByteString
eceStderr = ByteString
L.empty
}
clearStreams :: ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
clearStreams :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
clearStreams ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc
{ pcStdin :: StreamSpec 'STInput ()
pcStdin = forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
, pcStdout :: StreamSpec 'STOutput ()
pcStdout = forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
, pcStderr :: StreamSpec 'STOutput ()
pcStderr = forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
}
getStdin :: Process stdin stdout stderr -> stdin
getStdin :: forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin = forall stdin stdout stderr. Process stdin stdout stderr -> stdin
pStdin
getStdout :: Process stdin stdout stderr -> stdout
getStdout :: forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout = forall stdin stdout stderr. Process stdin stdout stderr -> stdout
pStdout
getStderr :: Process stdin stdout stderr -> stderr
getStderr :: forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr = forall stdin stdout stderr. Process stdin stdout stderr -> stderr
pStderr
unsafeProcessHandle :: Process stdin stdout stderr -> P.ProcessHandle
unsafeProcessHandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessHandle
unsafeProcessHandle = forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessHandle
pHandle