{-# 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
, startProcess
, stopProcess
, withProcessWait
, withProcessWait_
, withProcessTerm
, withProcessTerm_
, withProcess
, withProcess_
, readProcess
, readProcess_
, runProcess
, runProcess_
, readProcessStdout
, readProcessStdout_
, readProcessStderr
, readProcessStderr_
, readProcessInterleaved
, readProcessInterleaved_
, waitExitCode
, waitExitCodeSTM
, getExitCode
, getExitCodeSTM
, checkExitCode
, checkExitCodeSTM
, getStdin
, getStdout
, getStderr
, ExitCodeException (..)
, ByteStringOutputException (..)
, unsafeProcessHandle
) where
import qualified Data.ByteString as S
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import qualified Control.Exception as E
import Control.Exception hiding (bracket, finally)
import Control.Monad (void)
import Control.Monad.IO.Class
import qualified System.Process as P
import Data.Typeable (Typeable)
import System.IO (Handle, hClose, IOMode(ReadWriteMode), withBinaryFile)
import System.IO.Error (isPermissionError)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (async, asyncWithUnmask, cancel, waitCatch)
import Control.Concurrent.STM (newEmptyTMVarIO, atomically, putTMVar, TMVar, readTMVar, tryReadTMVar, STM, tryPutTMVar, throwSTM, catchSTM)
import System.Exit (ExitCode (ExitSuccess))
import System.Process.Typed.Internal
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.String (IsString (fromString))
import GHC.RTS.Flags (getConcFlags, ctxtSwitchTime)
import Control.Monad.IO.Unlift
#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
import System.Posix.Types (GroupID, UserID)
#endif
#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 ProcessConfig stdin stdout stderr = ProcessConfig
{ ProcessConfig stdin stdout stderr -> CmdSpec
pcCmdSpec :: !P.CmdSpec
, ProcessConfig stdin stdout stderr -> StreamSpec 'STInput stdin
pcStdin :: !(StreamSpec 'STInput stdin)
, ProcessConfig stdin stdout stderr -> StreamSpec 'STOutput stdout
pcStdout :: !(StreamSpec 'STOutput stdout)
, ProcessConfig stdin stdout stderr -> StreamSpec 'STOutput stderr
pcStderr :: !(StreamSpec 'STOutput stderr)
, ProcessConfig stdin stdout stderr -> Maybe FilePath
pcWorkingDir :: !(Maybe FilePath)
, ProcessConfig stdin stdout stderr -> Maybe [(FilePath, FilePath)]
pcEnv :: !(Maybe [(String, String)])
, ProcessConfig stdin stdout stderr -> Bool
pcCloseFds :: !Bool
, ProcessConfig stdin stdout stderr -> Bool
pcCreateGroup :: !Bool
, ProcessConfig stdin stdout stderr -> Bool
pcDelegateCtlc :: !Bool
#if MIN_VERSION_process(1, 3, 0)
, ProcessConfig stdin stdout stderr -> Bool
pcDetachConsole :: !Bool
, ProcessConfig stdin stdout stderr -> Bool
pcCreateNewConsole :: !Bool
, ProcessConfig stdin stdout stderr -> Bool
pcNewSession :: !Bool
#endif
#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
, ProcessConfig stdin stdout stderr -> Maybe GroupID
pcChildGroup :: !(Maybe GroupID)
, ProcessConfig stdin stdout stderr -> Maybe UserID
pcChildUser :: !(Maybe UserID)
#endif
}
instance Show (ProcessConfig stdin stdout stderr) where
show :: ProcessConfig stdin stdout stderr -> FilePath
show ProcessConfig stdin stdout stderr
pc = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ case ProcessConfig stdin stdout stderr -> CmdSpec
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> CmdSpec
pcCmdSpec ProcessConfig stdin stdout stderr
pc of
P.ShellCommand FilePath
s -> FilePath
"Shell command: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
s
P.RawCommand FilePath
x [FilePath]
xs -> FilePath
"Raw command: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
escape (FilePath
xFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs))
, FilePath
"\n"
, case ProcessConfig stdin stdout stderr -> Maybe FilePath
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe FilePath
pcWorkingDir ProcessConfig stdin stdout stderr
pc of
Maybe FilePath
Nothing -> FilePath
""
Just FilePath
wd -> [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath
"Run from: "
, FilePath
wd
, FilePath
"\n"
]
, case ProcessConfig stdin stdout stderr -> Maybe [(FilePath, FilePath)]
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe [(FilePath, FilePath)]
pcEnv ProcessConfig stdin stdout stderr
pc of
Maybe [(FilePath, FilePath)]
Nothing -> FilePath
""
Just [(FilePath, FilePath)]
e -> [FilePath] -> FilePath
unlines
([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Modified environment:"
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
k, FilePath
v) -> [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
k, FilePath
"=", FilePath
v]) [(FilePath, FilePath)]
e
]
where
escape :: ShowS
escape FilePath
x
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
" \\\"'") FilePath
x = ShowS
forall a. Show a => a -> FilePath
show FilePath
x
| Bool
otherwise = FilePath
x
instance (stdin ~ (), stdout ~ (), stderr ~ ())
=> IsString (ProcessConfig stdin stdout stderr) where
fromString :: FilePath -> ProcessConfig stdin stdout stderr
fromString FilePath
s
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') FilePath
s = FilePath -> ProcessConfig () () ()
shell FilePath
s
| Bool
otherwise = FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
s []
data StreamType = STInput | STOutput
data StreamSpec (streamType :: StreamType) a = StreamSpec
{ StreamSpec streamType a -> forall b. (StdStream -> IO b) -> IO b
ssStream :: !(forall b. (P.StdStream -> IO b) -> IO b)
, StreamSpec streamType a
-> ProcessConfig () () () -> Maybe Handle -> Cleanup a
ssCreate :: !(ProcessConfig () () () -> Maybe Handle -> Cleanup a)
}
deriving a -> StreamSpec streamType b -> StreamSpec streamType a
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
(forall a b.
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b)
-> (forall a b.
a -> StreamSpec streamType b -> StreamSpec streamType a)
-> Functor (StreamSpec streamType)
forall a b. a -> StreamSpec streamType b -> StreamSpec streamType a
forall a b.
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
forall (streamType :: StreamType) a b.
a -> StreamSpec streamType b -> StreamSpec streamType a
forall (streamType :: StreamType) a b.
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StreamSpec streamType b -> StreamSpec streamType a
$c<$ :: forall (streamType :: StreamType) a b.
a -> StreamSpec streamType b -> StreamSpec streamType a
fmap :: (a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
$cfmap :: forall (streamType :: StreamType) a b.
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
Functor
instance (streamType ~ 'STInput, res ~ ())
=> IsString (StreamSpec streamType res) where
fromString :: FilePath -> StreamSpec streamType res
fromString = ByteString -> StreamSpec 'STInput ()
byteStringInput (ByteString -> StreamSpec 'STInput ())
-> (FilePath -> ByteString) -> FilePath -> StreamSpec 'STInput ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString
newtype Cleanup a = Cleanup { Cleanup a -> IO (a, IO ())
runCleanup :: IO (a, IO ()) }
deriving a -> Cleanup b -> Cleanup a
(a -> b) -> Cleanup a -> Cleanup b
(forall a b. (a -> b) -> Cleanup a -> Cleanup b)
-> (forall a b. a -> Cleanup b -> Cleanup a) -> Functor Cleanup
forall a b. a -> Cleanup b -> Cleanup a
forall a b. (a -> b) -> Cleanup a -> Cleanup b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Cleanup b -> Cleanup a
$c<$ :: forall a b. a -> Cleanup b -> Cleanup a
fmap :: (a -> b) -> Cleanup a -> Cleanup b
$cfmap :: forall a b. (a -> b) -> Cleanup a -> Cleanup b
Functor
instance Applicative Cleanup where
pure :: a -> Cleanup a
pure a
x = IO (a, IO ()) -> Cleanup a
forall a. IO (a, IO ()) -> Cleanup a
Cleanup ((a, IO ()) -> IO (a, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
Cleanup IO (a -> b, IO ())
f <*> :: Cleanup (a -> b) -> Cleanup a -> Cleanup b
<*> Cleanup IO (a, IO ())
x = IO (b, IO ()) -> Cleanup b
forall a. IO (a, IO ()) -> Cleanup a
Cleanup (IO (b, IO ()) -> Cleanup b) -> IO (b, IO ()) -> Cleanup b
forall a b. (a -> b) -> a -> b
$ do
(a -> b
f', IO ()
c1) <- IO (a -> b, IO ())
f
(IO (b, IO ()) -> IO () -> IO (b, IO ())
forall a b. IO a -> IO b -> IO a
`onException` IO ()
c1) (IO (b, IO ()) -> IO (b, IO ())) -> IO (b, IO ()) -> IO (b, IO ())
forall a b. (a -> b) -> a -> b
$ do
(a
x', IO ()
c2) <- IO (a, IO ())
x
(b, IO ()) -> IO (b, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f' a
x', IO ()
c1 IO () -> IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => m a -> IO () -> m a
`finally` IO ()
c2)
data Process stdin stdout stderr = Process
{ Process stdin stdout stderr -> ProcessConfig () () ()
pConfig :: !(ProcessConfig () () ())
, Process stdin stdout stderr -> IO ()
pCleanup :: !(IO ())
, Process stdin stdout stderr -> stdin
pStdin :: !stdin
, Process stdin stdout stderr -> stdout
pStdout :: !stdout
, Process stdin stdout stderr -> stderr
pStderr :: !stderr
, Process stdin stdout stderr -> ProcessHandle
pHandle :: !P.ProcessHandle
, Process stdin stdout stderr -> TMVar ExitCode
pExitCode :: !(TMVar ExitCode)
}
instance Show (Process stdin stdout stderr) where
show :: Process stdin stdout stderr -> FilePath
show Process stdin stdout stderr
p = FilePath
"Running process: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessConfig () () () -> FilePath
forall a. Show a => a -> FilePath
show (Process stdin stdout stderr -> ProcessConfig () () ()
forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessConfig () () ()
pConfig Process stdin stdout stderr
p)
defaultProcessConfig :: ProcessConfig () () ()
defaultProcessConfig :: ProcessConfig () () ()
defaultProcessConfig = ProcessConfig :: forall stdin stdout stderr.
CmdSpec
-> StreamSpec 'STInput stdin
-> StreamSpec 'STOutput stdout
-> StreamSpec 'STOutput stderr
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe GroupID
-> Maybe UserID
-> ProcessConfig stdin stdout stderr
ProcessConfig
{ pcCmdSpec :: CmdSpec
pcCmdSpec = FilePath -> CmdSpec
P.ShellCommand FilePath
""
, pcStdin :: StreamSpec 'STInput ()
pcStdin = StreamSpec 'STInput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
, pcStdout :: StreamSpec 'STOutput ()
pcStdout = StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
, pcStderr :: StreamSpec 'STOutput ()
pcStderr = StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
, pcWorkingDir :: Maybe FilePath
pcWorkingDir = Maybe FilePath
forall a. Maybe a
Nothing
, pcEnv :: Maybe [(FilePath, FilePath)]
pcEnv = Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
, pcCloseFds :: Bool
pcCloseFds = Bool
False
, pcCreateGroup :: Bool
pcCreateGroup = Bool
False
, pcDelegateCtlc :: Bool
pcDelegateCtlc = Bool
False
#if MIN_VERSION_process(1, 3, 0)
, pcDetachConsole :: Bool
pcDetachConsole = Bool
False
, pcCreateNewConsole :: Bool
pcCreateNewConsole = Bool
False
, pcNewSession :: Bool
pcNewSession = Bool
False
#endif
#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
, pcChildGroup :: Maybe GroupID
pcChildGroup = Maybe GroupID
forall a. Maybe a
Nothing
, pcChildUser :: Maybe UserID
pcChildUser = Maybe UserID
forall a. Maybe a
Nothing
#endif
}
proc :: FilePath -> [String] -> ProcessConfig () () ()
proc :: FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
cmd [FilePath]
args = FilePath
-> [FilePath] -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
FilePath
-> [FilePath]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setProc FilePath
cmd [FilePath]
args ProcessConfig () () ()
defaultProcessConfig
setProc :: FilePath -> [String]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setProc :: FilePath
-> [FilePath]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setProc FilePath
cmd [FilePath]
args ProcessConfig stdin stdout stderr
p = ProcessConfig stdin stdout stderr
p { pcCmdSpec :: CmdSpec
pcCmdSpec = FilePath -> [FilePath] -> CmdSpec
P.RawCommand FilePath
cmd [FilePath]
args }
shell :: String -> ProcessConfig () () ()
shell :: FilePath -> ProcessConfig () () ()
shell FilePath
cmd = FilePath -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setShell FilePath
cmd ProcessConfig () () ()
defaultProcessConfig
setShell :: String
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setShell :: FilePath
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setShell FilePath
cmd ProcessConfig stdin stdout stderr
p = ProcessConfig stdin stdout stderr
p { pcCmdSpec :: CmdSpec
pcCmdSpec = FilePath -> CmdSpec
P.ShellCommand FilePath
cmd }
setStdin :: StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin :: StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin StreamSpec 'STInput stdin
spec ProcessConfig stdin0 stdout stderr
pc = ProcessConfig stdin0 stdout stderr
pc { pcStdin :: StreamSpec 'STInput stdin
pcStdin = StreamSpec 'STInput stdin
spec }
setStdout :: StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout :: StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput stdout
spec ProcessConfig stdin stdout0 stderr
pc = ProcessConfig stdin stdout0 stderr
pc { pcStdout :: StreamSpec 'STOutput stdout
pcStdout = StreamSpec 'STOutput stdout
spec }
setStderr :: StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr :: StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput stderr
spec ProcessConfig stdin stdout stderr0
pc = ProcessConfig stdin stdout stderr0
pc { pcStderr :: StreamSpec 'STOutput stderr
pcStderr = StreamSpec 'STOutput stderr
spec }
setWorkingDir :: FilePath
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir :: FilePath
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir FilePath
dir ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcWorkingDir :: Maybe FilePath
pcWorkingDir = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir }
setWorkingDirInherit
:: ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDirInherit :: ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDirInherit ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcWorkingDir :: Maybe FilePath
pcWorkingDir = Maybe FilePath
forall a. Maybe a
Nothing }
setEnv :: [(String, String)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv :: [(FilePath, FilePath)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(FilePath, FilePath)]
env ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcEnv :: Maybe [(FilePath, FilePath)]
pcEnv = [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
env }
setEnvInherit
:: ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnvInherit :: ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnvInherit ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcEnv :: Maybe [(FilePath, FilePath)]
pcEnv = Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing }
setCloseFds
:: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCloseFds :: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCloseFds Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcCloseFds :: Bool
pcCloseFds = Bool
x }
setCreateGroup
:: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCreateGroup :: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCreateGroup Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcCreateGroup :: Bool
pcCreateGroup = Bool
x }
setDelegateCtlc
:: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setDelegateCtlc :: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setDelegateCtlc Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcDelegateCtlc :: Bool
pcDelegateCtlc = Bool
x }
#if MIN_VERSION_process(1, 3, 0)
setDetachConsole
:: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setDetachConsole :: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setDetachConsole Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcDetachConsole :: Bool
pcDetachConsole = Bool
x }
setCreateNewConsole
:: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCreateNewConsole :: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCreateNewConsole Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcCreateNewConsole :: Bool
pcCreateNewConsole = Bool
x }
setNewSession
:: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setNewSession :: Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setNewSession Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcNewSession :: Bool
pcNewSession = Bool
x }
#endif
#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
setChildGroup
:: GroupID
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildGroup :: GroupID
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildGroup GroupID
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcChildGroup :: Maybe GroupID
pcChildGroup = GroupID -> Maybe GroupID
forall a. a -> Maybe a
Just GroupID
x }
setChildGroupInherit
:: ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildGroupInherit :: ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildGroupInherit ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcChildGroup :: Maybe GroupID
pcChildGroup = Maybe GroupID
forall a. Maybe a
Nothing }
setChildUser
:: UserID
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildUser :: UserID
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildUser UserID
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcChildUser :: Maybe UserID
pcChildUser = UserID -> Maybe UserID
forall a. a -> Maybe a
Just UserID
x }
setChildUserInherit
:: ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildUserInherit :: ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildUserInherit ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcChildUser :: Maybe UserID
pcChildUser = Maybe UserID
forall a. Maybe a
Nothing }
#endif
mkStreamSpec :: P.StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec :: StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
ss ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())
f = (forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
forall a (streamType :: StreamType).
(forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkManagedStreamSpec ((StdStream -> IO b) -> StdStream -> IO b
forall a b. (a -> b) -> a -> b
$ StdStream
ss) ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())
f
mkManagedStreamSpec :: (forall b. (P.StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkManagedStreamSpec :: (forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkManagedStreamSpec forall b. (StdStream -> IO b) -> IO b
ss ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())
f = (forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> Cleanup a)
-> StreamSpec streamType a
forall (streamType :: StreamType) a.
(forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> Cleanup a)
-> StreamSpec streamType a
StreamSpec forall b. (StdStream -> IO b) -> IO b
ss (\ProcessConfig () () ()
pc Maybe Handle
mh -> IO (a, IO ()) -> Cleanup a
forall a. IO (a, IO ()) -> Cleanup a
Cleanup (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())
f ProcessConfig () () ()
pc Maybe Handle
mh))
inherit :: StreamSpec anyStreamType ()
inherit :: StreamSpec anyStreamType ()
inherit = StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ()
forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
P.Inherit (\ProcessConfig () () ()
_ Maybe Handle
Nothing -> ((), IO ()) -> IO ((), IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
nullStream :: StreamSpec anyStreamType ()
nullStream :: StreamSpec anyStreamType ()
nullStream = (forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ()
forall a (streamType :: StreamType).
(forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkManagedStreamSpec forall b. (StdStream -> IO b) -> IO b
opener ProcessConfig () () () -> Maybe Handle -> IO ((), IO ())
forall (m :: * -> *) (f :: * -> *) p p.
(Monad m, Applicative f) =>
p -> p -> f ((), m ())
cleanup
where
opener :: (StdStream -> IO r) -> IO r
opener StdStream -> IO r
f =
FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
nullDevice IOMode
ReadWriteMode ((Handle -> IO r) -> IO r) -> (Handle -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
StdStream -> IO r
f (Handle -> StdStream
P.UseHandle Handle
handle)
cleanup :: p -> p -> f ((), m ())
cleanup p
_ p
_ =
((), m ()) -> f ((), m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
closed :: StreamSpec anyStreamType ()
#if MIN_VERSION_process(1, 4, 0)
closed :: StreamSpec anyStreamType ()
closed = StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ()
forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
P.NoStream (\ProcessConfig () () ()
_ Maybe Handle
Nothing -> ((), IO ()) -> IO ((), IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
#else
closed = mkStreamSpec P.CreatePipe (\_ (Just h) -> ((), return ()) <$ hClose h)
#endif
byteStringInput :: L.ByteString -> StreamSpec 'STInput ()
byteStringInput :: ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
lbs = StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec 'STInput ()
forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
P.CreatePipe ((ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec 'STInput ())
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec 'STInput ()
forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
_ (Just Handle
h) -> do
IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ()) -> IO (Async ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ do
Handle -> ByteString -> IO ()
L.hPut Handle
h ByteString
lbs
Handle -> IO ()
hClose Handle
h
((), IO ()) -> IO ((), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((), Handle -> IO ()
hClose Handle
h)
byteStringOutput :: StreamSpec 'STOutput (STM L.ByteString)
byteStringOutput :: StreamSpec 'STOutput (STM ByteString)
byteStringOutput = StdStream
-> (ProcessConfig () () ()
-> Maybe Handle -> IO (STM ByteString, IO ()))
-> StreamSpec 'STOutput (STM ByteString)
forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
P.CreatePipe ((ProcessConfig () () ()
-> Maybe Handle -> IO (STM ByteString, IO ()))
-> StreamSpec 'STOutput (STM ByteString))
-> (ProcessConfig () () ()
-> Maybe Handle -> IO (STM ByteString, IO ()))
-> StreamSpec 'STOutput (STM ByteString)
forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc (Just Handle
h) -> ProcessConfig () () () -> Handle -> IO (STM ByteString, IO ())
byteStringFromHandle ProcessConfig () () ()
pc Handle
h
byteStringFromHandle
:: ProcessConfig () () ()
-> Handle
-> IO (STM L.ByteString, IO ())
byteStringFromHandle :: ProcessConfig () () () -> Handle -> IO (STM ByteString, IO ())
byteStringFromHandle ProcessConfig () () ()
pc Handle
h = do
TMVar (Either ByteStringOutputException ByteString)
mvar <- IO (TMVar (Either ByteStringOutputException ByteString))
forall a. IO (TMVar a)
newEmptyTMVarIO
IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ()) -> IO (Async ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ do
let loop :: ([ByteString] -> [ByteString]) -> IO ()
loop [ByteString] -> [ByteString]
front = do
ByteString
bs <- Handle -> Int -> IO ByteString
S.hGetSome Handle
h Int
defaultChunkSize
if ByteString -> Bool
S.null ByteString
bs
then STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar (Either ByteStringOutputException ByteString)
-> Either ByteStringOutputException ByteString -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either ByteStringOutputException ByteString)
mvar (Either ByteStringOutputException ByteString -> STM ())
-> Either ByteStringOutputException ByteString -> STM ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteStringOutputException ByteString
forall a b. b -> Either a b
Right (ByteString -> Either ByteStringOutputException ByteString)
-> ByteString -> Either ByteStringOutputException ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
else ([ByteString] -> [ByteString]) -> IO ()
loop (([ByteString] -> [ByteString]) -> IO ())
-> ([ByteString] -> [ByteString]) -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
([ByteString] -> [ByteString]) -> IO ()
loop [ByteString] -> [ByteString]
forall a. a -> a
id IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ STM Bool -> STM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (STM Bool -> STM ()) -> STM Bool -> STM ()
forall a b. (a -> b) -> a -> b
$ TMVar (Either ByteStringOutputException ByteString)
-> Either ByteStringOutputException ByteString -> STM Bool
forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar (Either ByteStringOutputException ByteString)
mvar (Either ByteStringOutputException ByteString -> STM Bool)
-> Either ByteStringOutputException ByteString -> STM Bool
forall a b. (a -> b) -> a -> b
$ ByteStringOutputException
-> Either ByteStringOutputException ByteString
forall a b. a -> Either a b
Left (ByteStringOutputException
-> Either ByteStringOutputException ByteString)
-> ByteStringOutputException
-> Either ByteStringOutputException ByteString
forall a b. (a -> b) -> a -> b
$ SomeException
-> ProcessConfig () () () -> ByteStringOutputException
ByteStringOutputException SomeException
e ProcessConfig () () ()
pc
SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
e
(STM ByteString, IO ()) -> IO (STM ByteString, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (TMVar (Either ByteStringOutputException ByteString)
-> STM (Either ByteStringOutputException ByteString)
forall a. TMVar a -> STM a
readTMVar TMVar (Either ByteStringOutputException ByteString)
mvar STM (Either ByteStringOutputException ByteString)
-> (Either ByteStringOutputException ByteString -> STM ByteString)
-> STM ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteStringOutputException -> STM ByteString)
-> (ByteString -> STM ByteString)
-> Either ByteStringOutputException ByteString
-> STM ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ByteStringOutputException -> STM ByteString
forall e a. Exception e => e -> STM a
throwSTM ByteString -> STM ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return, Handle -> IO ()
hClose Handle
h)
createPipe :: StreamSpec anyStreamType Handle
createPipe :: StreamSpec anyStreamType Handle
createPipe = StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (Handle, IO ()))
-> StreamSpec anyStreamType Handle
forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
P.CreatePipe ((ProcessConfig () () () -> Maybe Handle -> IO (Handle, IO ()))
-> StreamSpec anyStreamType Handle)
-> (ProcessConfig () () () -> Maybe Handle -> IO (Handle, IO ()))
-> StreamSpec anyStreamType Handle
forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
_ (Just Handle
h) -> (Handle, IO ()) -> IO (Handle, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
h, Handle -> IO ()
hClose Handle
h)
useHandleOpen :: Handle -> StreamSpec anyStreamType ()
useHandleOpen :: Handle -> StreamSpec anyStreamType ()
useHandleOpen Handle
h = StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ()
forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec (Handle -> StdStream
P.UseHandle Handle
h) ((ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ())
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ()
forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
_ Maybe Handle
Nothing -> ((), IO ()) -> IO ((), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
useHandleClose :: Handle -> StreamSpec anyStreamType ()
useHandleClose :: Handle -> StreamSpec anyStreamType ()
useHandleClose Handle
h = StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ()
forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec (Handle -> StdStream
P.UseHandle Handle
h) ((ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ())
-> (ProcessConfig () () () -> Maybe Handle -> IO ((), IO ()))
-> StreamSpec anyStreamType ()
forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
_ Maybe Handle
Nothing -> ((), IO ()) -> IO ((), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((), Handle -> IO ()
hClose Handle
h)
startProcess :: MonadIO m
=> ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess :: ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess pConfig' :: ProcessConfig stdin stdout stderr
pConfig'@ProcessConfig {Bool
Maybe FilePath
Maybe [(FilePath, FilePath)]
Maybe GroupID
Maybe UserID
CmdSpec
StreamSpec 'STInput stdin
StreamSpec 'STOutput stdout
StreamSpec 'STOutput stderr
pcChildUser :: Maybe UserID
pcChildGroup :: Maybe GroupID
pcNewSession :: Bool
pcCreateNewConsole :: Bool
pcDetachConsole :: Bool
pcDelegateCtlc :: Bool
pcCreateGroup :: Bool
pcCloseFds :: Bool
pcEnv :: Maybe [(FilePath, FilePath)]
pcWorkingDir :: Maybe FilePath
pcStderr :: StreamSpec 'STOutput stderr
pcStdout :: StreamSpec 'STOutput stdout
pcStdin :: StreamSpec 'STInput stdin
pcCmdSpec :: CmdSpec
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 [(FilePath, FilePath)]
pcWorkingDir :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe FilePath
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
..} = IO (Process stdin stdout stderr) -> m (Process stdin stdout stderr)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Process stdin stdout stderr)
-> m (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
-> m (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ do
StreamSpec 'STInput stdin -> forall b. (StdStream -> IO b) -> IO b
forall (streamType :: StreamType) a.
StreamSpec streamType a -> forall b. (StdStream -> IO b) -> IO b
ssStream StreamSpec 'STInput stdin
pcStdin ((StdStream -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (StdStream -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \StdStream
realStdin ->
StreamSpec 'STOutput stdout
-> forall b. (StdStream -> IO b) -> IO b
forall (streamType :: StreamType) a.
StreamSpec streamType a -> forall b. (StdStream -> IO b) -> IO b
ssStream StreamSpec 'STOutput stdout
pcStdout ((StdStream -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (StdStream -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \StdStream
realStdout ->
StreamSpec 'STOutput stderr
-> forall b. (StdStream -> IO b) -> IO b
forall (streamType :: StreamType) a.
StreamSpec streamType a -> forall b. (StdStream -> IO b) -> IO b
ssStream StreamSpec 'STOutput stderr
pcStderr ((StdStream -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (StdStream -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \StdStream
realStderr -> do
let cp0 :: CreateProcess
cp0 =
case CmdSpec
pcCmdSpec of
P.ShellCommand FilePath
cmd -> FilePath -> CreateProcess
P.shell FilePath
cmd
P.RawCommand FilePath
cmd [FilePath]
args -> FilePath -> [FilePath] -> CreateProcess
P.proc FilePath
cmd [FilePath]
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 FilePath
P.cwd = Maybe FilePath
pcWorkingDir
, env :: Maybe [(FilePath, FilePath)]
P.env = Maybe [(FilePath, FilePath)]
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) <- FilePath
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
P.createProcess_ FilePath
"startProcess" CreateProcess
cp
((stdin
pStdin, stdout
pStdout, stderr
pStderr), IO ()
pCleanup1) <- Cleanup (stdin, stdout, stderr)
-> IO ((stdin, stdout, stderr), IO ())
forall a. Cleanup a -> IO (a, IO ())
runCleanup (Cleanup (stdin, stdout, stderr)
-> IO ((stdin, stdout, stderr), IO ()))
-> Cleanup (stdin, stdout, stderr)
-> IO ((stdin, stdout, stderr), IO ())
forall a b. (a -> b) -> a -> b
$ (,,)
(stdin -> stdout -> stderr -> (stdin, stdout, stderr))
-> Cleanup stdin
-> Cleanup (stdout -> stderr -> (stdin, stdout, stderr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StreamSpec 'STInput stdin
-> ProcessConfig () () () -> Maybe Handle -> Cleanup stdin
forall (streamType :: StreamType) a.
StreamSpec streamType a
-> ProcessConfig () () () -> Maybe Handle -> Cleanup a
ssCreate StreamSpec 'STInput stdin
pcStdin ProcessConfig () () ()
pConfig Maybe Handle
minH
Cleanup (stdout -> stderr -> (stdin, stdout, stderr))
-> Cleanup stdout -> Cleanup (stderr -> (stdin, stdout, stderr))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StreamSpec 'STOutput stdout
-> ProcessConfig () () () -> Maybe Handle -> Cleanup stdout
forall (streamType :: StreamType) a.
StreamSpec streamType a
-> ProcessConfig () () () -> Maybe Handle -> Cleanup a
ssCreate StreamSpec 'STOutput stdout
pcStdout ProcessConfig () () ()
pConfig Maybe Handle
moutH
Cleanup (stderr -> (stdin, stdout, stderr))
-> Cleanup stderr -> Cleanup (stdin, stdout, stderr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StreamSpec 'STOutput stderr
-> ProcessConfig () () () -> Maybe Handle -> Cleanup stderr
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 <- IO (TMVar ExitCode)
forall a. IO (TMVar a)
newEmptyTMVarIO
Async ExitCode
waitingThread <- ((forall b. IO b -> IO b) -> IO ExitCode) -> IO (Async ExitCode)
forall a. ((forall b. IO b -> IO b) -> IO a) -> IO (Async a)
asyncWithUnmask (((forall b. IO b -> IO b) -> IO ExitCode) -> IO (Async ExitCode))
-> ((forall b. IO b -> IO b) -> IO ExitCode) -> IO (Async ExitCode)
forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
unmask -> do
ExitCode
ec <- IO ExitCode -> IO ExitCode
forall b. IO b -> IO b
unmask (IO ExitCode -> IO ExitCode) -> IO ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$
if Bool
multiThreadedRuntime
then ProcessHandle -> IO ExitCode
P.waitForProcess ProcessHandle
pHandle
else do
Int
switchTime <- RtsTime -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (RtsTime -> Int) -> (ConcFlags -> RtsTime) -> ConcFlags -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RtsTime -> RtsTime -> RtsTime
forall a. Integral a => a -> a -> a
`div` RtsTime
1000) (RtsTime -> RtsTime)
-> (ConcFlags -> RtsTime) -> ConcFlags -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConcFlags -> RtsTime
ctxtSwitchTime
(ConcFlags -> Int) -> IO ConcFlags -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ConcFlags
getConcFlags
let minDelay :: Int
minDelay = Int
1
maxDelay :: Int
maxDelay = Int -> Int -> Int
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 (Int -> IO ExitCode) -> Int -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxDelay (Int
delay Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
Just ExitCode
ec -> ExitCode -> IO ExitCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ec
Int -> IO ExitCode
loop Int
minDelay
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar ExitCode -> ExitCode -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ExitCode
pExitCode ExitCode
ec
ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ec
let pCleanup :: IO ()
pCleanup = IO ()
pCleanup1 IO () -> IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => m a -> IO () -> m a
`finally` do
Async ExitCode -> IO ()
forall a. Async a -> IO ()
cancel Async ExitCode
waitingThread
Either SomeException ExitCode
eec <- Async ExitCode -> IO (Either SomeException ExitCode)
forall a. Async a -> IO (Either SomeException a)
waitCatch Async ExitCode
waitingThread
case Either SomeException ExitCode
eec of
Right ExitCode
_ec -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left SomeException
_ -> do
Either IOError ()
eres <- IO () -> IO (Either IOError ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either IOError ()))
-> IO () -> IO (Either IOError ())
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 -> IOError -> IO ExitCode
forall e a. Exception e => e -> IO a
throwIO IOError
e
Right () -> ProcessHandle -> IO ExitCode
P.waitForProcess ProcessHandle
pHandle
Bool
success <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TMVar ExitCode -> ExitCode -> STM Bool
forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar ExitCode
pExitCode ExitCode
ec
() -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
success ()
Process stdin stdout stderr -> IO (Process stdin stdout stderr)
forall (m :: * -> *) a. Monad m => a -> m a
return Process :: forall stdin stdout stderr.
ProcessConfig () () ()
-> IO ()
-> stdin
-> stdout
-> stderr
-> ProcessHandle
-> TMVar ExitCode
-> Process stdin stdout stderr
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 = ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
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 :: Process stdin stdout stderr -> m ()
stopProcess = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (Process stdin stdout stderr -> IO ())
-> Process stdin stdout stderr
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> IO ()
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 :: ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm ProcessConfig stdin stdout stderr
config = IO (Process stdin stdout stderr)
-> (Process stdin stdout stderr -> IO ())
-> (Process stdin stdout stderr -> m a)
-> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket (ProcessConfig stdin stdout stderr
-> IO (Process stdin stdout stderr)
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 -> IO ()
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 :: 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 =
IO (Process stdin stdout stderr)
-> (Process stdin stdout stderr -> IO ())
-> (Process stdin stdout stderr -> m a)
-> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket
(ProcessConfig stdin stdout stderr
-> IO (Process stdin stdout stderr)
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 -> IO ()
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 m a -> m ExitCode -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Process stdin stdout stderr -> m ExitCode
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 :: ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess = ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
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_ :: ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm_ ProcessConfig stdin stdout stderr
config = IO (Process stdin stdout stderr)
-> (Process stdin stdout stderr -> IO ())
-> (Process stdin stdout stderr -> m a)
-> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket
(ProcessConfig stdin stdout stderr
-> IO (Process stdin stdout stderr)
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 -> Process stdin stdout stderr -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess Process stdin stdout stderr
p IO () -> IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => m a -> IO () -> m a
`finally` Process stdin stdout stderr -> IO ()
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_ :: 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 = IO (Process stdin stdout stderr)
-> (Process stdin stdout stderr -> IO ())
-> (Process stdin stdout stderr -> m a)
-> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket
(ProcessConfig stdin stdout stderr
-> IO (Process stdin stdout stderr)
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 -> IO ()
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 m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Process stdin stdout stderr -> m ()
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_ :: ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess_ = ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
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 :: ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess ProcessConfig stdin stdoutIgnored stderrIgnored
pc =
IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin (STM ByteString) (STM ByteString)
-> (Process stdin (STM ByteString) (STM ByteString)
-> IO (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString)
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' ((Process stdin (STM ByteString) (STM ByteString)
-> IO (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString))
-> (Process stdin (STM ByteString) (STM ByteString)
-> IO (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) (STM ByteString)
p -> STM (ExitCode, ByteString, ByteString)
-> IO (ExitCode, ByteString, ByteString)
forall a. STM a -> IO a
atomically (STM (ExitCode, ByteString, ByteString)
-> IO (ExitCode, ByteString, ByteString))
-> STM (ExitCode, ByteString, ByteString)
-> IO (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (,,)
(ExitCode
-> ByteString -> ByteString -> (ExitCode, ByteString, ByteString))
-> STM ExitCode
-> STM
(ByteString -> ByteString -> (ExitCode, ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process stdin (STM ByteString) (STM ByteString) -> STM ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM Process stdin (STM ByteString) (STM ByteString)
p
STM
(ByteString -> ByteString -> (ExitCode, ByteString, ByteString))
-> STM ByteString
-> STM (ByteString -> (ExitCode, ByteString, ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Process stdin (STM ByteString) (STM ByteString) -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) (STM ByteString)
p
STM (ByteString -> (ExitCode, ByteString, ByteString))
-> STM ByteString -> STM (ExitCode, ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Process stdin (STM ByteString) (STM ByteString) -> STM ByteString
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' = StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdoutIgnored (STM ByteString)
-> ProcessConfig stdin (STM ByteString) (STM ByteString)
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 (STM ByteString)
-> ProcessConfig stdin (STM ByteString) (STM ByteString))
-> ProcessConfig stdin stdoutIgnored (STM ByteString)
-> ProcessConfig stdin (STM ByteString) (STM ByteString)
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> ProcessConfig stdin stdoutIgnored (STM ByteString)
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_ :: ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_ ProcessConfig stdin stdoutIgnored stderrIgnored
pc =
IO (ByteString, ByteString) -> m (ByteString, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ByteString, ByteString) -> m (ByteString, ByteString))
-> IO (ByteString, ByteString) -> m (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin (STM ByteString) (STM ByteString)
-> (Process stdin (STM ByteString) (STM ByteString)
-> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
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' ((Process stdin (STM ByteString) (STM ByteString)
-> IO (ByteString, ByteString))
-> IO (ByteString, ByteString))
-> (Process stdin (STM ByteString) (STM ByteString)
-> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) (STM ByteString)
p -> STM (ByteString, ByteString) -> IO (ByteString, ByteString)
forall a. STM a -> IO a
atomically (STM (ByteString, ByteString) -> IO (ByteString, ByteString))
-> STM (ByteString, ByteString) -> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ do
ByteString
stdout <- Process stdin (STM ByteString) (STM ByteString) -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) (STM ByteString)
p
ByteString
stderr <- Process stdin (STM ByteString) (STM ByteString) -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process stdin (STM ByteString) (STM ByteString)
p
Process stdin (STM ByteString) (STM ByteString) -> STM ()
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin (STM ByteString) (STM ByteString)
p STM () -> (ExitCodeException -> STM ()) -> STM ()
forall e a. Exception e => STM a -> (e -> STM a) -> STM a
`catchSTM` \ExitCodeException
ece -> ExitCodeException -> STM ()
forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
ece
{ eceStdout :: ByteString
eceStdout = ByteString
stdout
, eceStderr :: ByteString
eceStderr = ByteString
stderr
}
(ByteString, ByteString) -> STM (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
stdout, ByteString
stderr)
where
pc' :: ProcessConfig stdin (STM ByteString) (STM ByteString)
pc' = StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdoutIgnored (STM ByteString)
-> ProcessConfig stdin (STM ByteString) (STM ByteString)
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 (STM ByteString)
-> ProcessConfig stdin (STM ByteString) (STM ByteString))
-> ProcessConfig stdin stdoutIgnored (STM ByteString)
-> ProcessConfig stdin (STM ByteString) (STM ByteString)
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> ProcessConfig stdin stdoutIgnored (STM ByteString)
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 :: ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessStdout ProcessConfig stdin stdoutIgnored stderr
pc =
IO (ExitCode, ByteString) -> m (ExitCode, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, ByteString) -> m (ExitCode, ByteString))
-> IO (ExitCode, ByteString) -> m (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin (STM ByteString) stderr
-> (Process stdin (STM ByteString) stderr
-> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
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' ((Process stdin (STM ByteString) stderr
-> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString))
-> (Process stdin (STM ByteString) stderr
-> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) stderr
p -> STM (ExitCode, ByteString) -> IO (ExitCode, ByteString)
forall a. STM a -> IO a
atomically (STM (ExitCode, ByteString) -> IO (ExitCode, ByteString))
-> STM (ExitCode, ByteString) -> IO (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ (,)
(ExitCode -> ByteString -> (ExitCode, ByteString))
-> STM ExitCode -> STM (ByteString -> (ExitCode, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process stdin (STM ByteString) stderr -> STM ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM Process stdin (STM ByteString) stderr
p
STM (ByteString -> (ExitCode, ByteString))
-> STM ByteString -> STM (ExitCode, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Process stdin (STM ByteString) stderr -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) stderr
p
where
pc' :: ProcessConfig stdin (STM ByteString) stderr
pc' = StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdoutIgnored stderr
-> ProcessConfig stdin (STM ByteString) stderr
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_ :: ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ ProcessConfig stdin stdoutIgnored stderr
pc =
IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin (STM ByteString) stderr
-> (Process stdin (STM ByteString) stderr -> IO ByteString)
-> IO ByteString
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' ((Process stdin (STM ByteString) stderr -> IO ByteString)
-> IO ByteString)
-> (Process stdin (STM ByteString) stderr -> IO ByteString)
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) stderr
p -> STM ByteString -> IO ByteString
forall a. STM a -> IO a
atomically (STM ByteString -> IO ByteString)
-> STM ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString
stdout <- Process stdin (STM ByteString) stderr -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) stderr
p
Process stdin (STM ByteString) stderr -> STM ()
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin (STM ByteString) stderr
p STM () -> (ExitCodeException -> STM ()) -> STM ()
forall e a. Exception e => STM a -> (e -> STM a) -> STM a
`catchSTM` \ExitCodeException
ece -> ExitCodeException -> STM ()
forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
ece
{ eceStdout :: ByteString
eceStdout = ByteString
stdout
}
ByteString -> STM ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
stdout
where
pc' :: ProcessConfig stdin (STM ByteString) stderr
pc' = StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdoutIgnored stderr
-> ProcessConfig stdin (STM ByteString) stderr
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 :: ProcessConfig stdin stdout stderrIgnored
-> m (ExitCode, ByteString)
readProcessStderr ProcessConfig stdin stdout stderrIgnored
pc =
IO (ExitCode, ByteString) -> m (ExitCode, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, ByteString) -> m (ExitCode, ByteString))
-> IO (ExitCode, ByteString) -> m (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin stdout (STM ByteString)
-> (Process stdin stdout (STM ByteString)
-> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
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' ((Process stdin stdout (STM ByteString)
-> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString))
-> (Process stdin stdout (STM ByteString)
-> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ \Process stdin stdout (STM ByteString)
p -> STM (ExitCode, ByteString) -> IO (ExitCode, ByteString)
forall a. STM a -> IO a
atomically (STM (ExitCode, ByteString) -> IO (ExitCode, ByteString))
-> STM (ExitCode, ByteString) -> IO (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ (,)
(ExitCode -> ByteString -> (ExitCode, ByteString))
-> STM ExitCode -> STM (ByteString -> (ExitCode, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process stdin stdout (STM ByteString) -> STM ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM Process stdin stdout (STM ByteString)
p
STM (ByteString -> (ExitCode, ByteString))
-> STM ByteString -> STM (ExitCode, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Process stdin stdout (STM ByteString) -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process stdin stdout (STM ByteString)
p
where
pc' :: ProcessConfig stdin stdout (STM ByteString)
pc' = StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdout stderrIgnored
-> ProcessConfig stdin stdout (STM ByteString)
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_ :: ProcessConfig stdin stdout stderrIgnored -> m ByteString
readProcessStderr_ ProcessConfig stdin stdout stderrIgnored
pc =
IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin stdout (STM ByteString)
-> (Process stdin stdout (STM ByteString) -> IO ByteString)
-> IO ByteString
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' ((Process stdin stdout (STM ByteString) -> IO ByteString)
-> IO ByteString)
-> (Process stdin stdout (STM ByteString) -> IO ByteString)
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Process stdin stdout (STM ByteString)
p -> STM ByteString -> IO ByteString
forall a. STM a -> IO a
atomically (STM ByteString -> IO ByteString)
-> STM ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString
stderr <- Process stdin stdout (STM ByteString) -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process stdin stdout (STM ByteString)
p
Process stdin stdout (STM ByteString) -> STM ()
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin stdout (STM ByteString)
p STM () -> (ExitCodeException -> STM ()) -> STM ()
forall e a. Exception e => STM a -> (e -> STM a) -> STM a
`catchSTM` \ExitCodeException
ece -> ExitCodeException -> STM ()
forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
ece
{ eceStderr :: ByteString
eceStderr = ByteString
stderr
}
ByteString -> STM ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
stderr
where
pc' :: ProcessConfig stdin stdout (STM ByteString)
pc' = StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdout stderrIgnored
-> ProcessConfig stdin stdout (STM ByteString)
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 :: 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 =
IO (Handle, Handle)
-> ((Handle, Handle) -> IO ()) -> ((Handle, Handle) -> m a) -> m a
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 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
w) (((Handle, Handle) -> m a) -> m a)
-> ((Handle, Handle) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \(Handle
readEnd, Handle
writeEnd) -> do
let pc' :: ProcessConfig stdin (STM ByteString) ()
pc' = StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig stdin stdoutIgnored ()
-> ProcessConfig stdin (STM ByteString) ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout (StdStream
-> (ProcessConfig () () ()
-> Maybe Handle -> IO (STM ByteString, IO ()))
-> StreamSpec 'STOutput (STM ByteString)
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
Nothing -> ProcessConfig () () () -> Handle -> IO (STM ByteString, IO ())
byteStringFromHandle ProcessConfig () () ()
pc'' Handle
readEnd))
(ProcessConfig stdin stdoutIgnored ()
-> ProcessConfig stdin (STM ByteString) ())
-> ProcessConfig stdin stdoutIgnored ()
-> ProcessConfig stdin (STM ByteString) ()
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STOutput ()
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> ProcessConfig stdin stdoutIgnored ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr (Handle -> StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType).
Handle -> StreamSpec anyStreamType ()
useHandleOpen Handle
writeEnd)
ProcessConfig stdin stdoutIgnored stderrIgnored
pc
ProcessConfig stdin (STM ByteString) ()
-> (Process stdin (STM ByteString) () -> m a) -> m a
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' ((Process stdin (STM ByteString) () -> m a) -> m a)
-> (Process stdin (STM ByteString) () -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) ()
p -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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 :: ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString)
readProcessInterleaved ProcessConfig stdin stdoutIgnored stderrIgnored
pc =
IO (ExitCode, ByteString) -> m (ExitCode, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, ByteString) -> m (ExitCode, ByteString))
-> IO (ExitCode, ByteString) -> m (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$
ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process stdin (STM ByteString) () -> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
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) () -> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString))
-> (Process stdin (STM ByteString) () -> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) ()
p ->
STM (ExitCode, ByteString) -> IO (ExitCode, ByteString)
forall a. STM a -> IO a
atomically (STM (ExitCode, ByteString) -> IO (ExitCode, ByteString))
-> STM (ExitCode, ByteString) -> IO (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ (,)
(ExitCode -> ByteString -> (ExitCode, ByteString))
-> STM ExitCode -> STM (ByteString -> (ExitCode, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process stdin (STM ByteString) () -> STM ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM Process stdin (STM ByteString) ()
p
STM (ByteString -> (ExitCode, ByteString))
-> STM ByteString -> STM (ExitCode, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Process stdin (STM ByteString) () -> STM ByteString
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_ :: ProcessConfig stdin stdoutIgnored stderrIgnored -> m ByteString
readProcessInterleaved_ ProcessConfig stdin stdoutIgnored stderrIgnored
pc =
IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$
ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process stdin (STM ByteString) () -> IO ByteString)
-> IO ByteString
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) () -> IO ByteString)
-> IO ByteString)
-> (Process stdin (STM ByteString) () -> IO ByteString)
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Process stdin (STM ByteString) ()
p -> STM ByteString -> IO ByteString
forall a. STM a -> IO a
atomically (STM ByteString -> IO ByteString)
-> STM ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString
stdout' <- Process stdin (STM ByteString) () -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) ()
p
Process stdin (STM ByteString) () -> STM ()
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin (STM ByteString) ()
p STM () -> (ExitCodeException -> STM ()) -> STM ()
forall e a. Exception e => STM a -> (e -> STM a) -> STM a
`catchSTM` \ExitCodeException
ece -> ExitCodeException -> STM ()
forall e a. Exception e => e -> STM a
throwSTM ExitCodeException
ece
{ eceStdout :: ByteString
eceStdout = ByteString
stdout'
}
ByteString -> STM ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
stdout'
runProcess :: MonadIO m
=> ProcessConfig stdin stdout stderr
-> m ExitCode
runProcess :: ProcessConfig stdin stdout stderr -> m ExitCode
runProcess ProcessConfig stdin stdout stderr
pc = IO ExitCode -> m ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> m ExitCode) -> IO ExitCode -> m ExitCode
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> IO ExitCode) -> IO ExitCode
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 Process stdin stdout stderr -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode
runProcess_ :: MonadIO m
=> ProcessConfig stdin stdout stderr
-> m ()
runProcess_ :: ProcessConfig stdin stdout stderr -> m ()
runProcess_ ProcessConfig stdin stdout stderr
pc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> IO ()) -> IO ()
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 Process stdin stdout stderr -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
checkExitCode
waitExitCode :: MonadIO m => Process stdin stdout stderr -> m ExitCode
waitExitCode :: Process stdin stdout stderr -> m ExitCode
waitExitCode = IO ExitCode -> m ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> m ExitCode)
-> (Process stdin stdout stderr -> IO ExitCode)
-> Process stdin stdout stderr
-> m ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM ExitCode -> IO ExitCode
forall a. STM a -> IO a
atomically (STM ExitCode -> IO ExitCode)
-> (Process stdin stdout stderr -> STM ExitCode)
-> Process stdin stdout stderr
-> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> STM ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM
waitExitCodeSTM :: Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM :: Process stdin stdout stderr -> STM ExitCode
waitExitCodeSTM = TMVar ExitCode -> STM ExitCode
forall a. TMVar a -> STM a
readTMVar (TMVar ExitCode -> STM ExitCode)
-> (Process stdin stdout stderr -> TMVar ExitCode)
-> Process stdin stdout stderr
-> STM ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> TMVar ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> TMVar ExitCode
pExitCode
getExitCode :: MonadIO m => Process stdin stdout stderr -> m (Maybe ExitCode)
getExitCode :: Process stdin stdout stderr -> m (Maybe ExitCode)
getExitCode = IO (Maybe ExitCode) -> m (Maybe ExitCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ExitCode) -> m (Maybe ExitCode))
-> (Process stdin stdout stderr -> IO (Maybe ExitCode))
-> Process stdin stdout stderr
-> m (Maybe ExitCode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM (Maybe ExitCode) -> IO (Maybe ExitCode)
forall a. STM a -> IO a
atomically (STM (Maybe ExitCode) -> IO (Maybe ExitCode))
-> (Process stdin stdout stderr -> STM (Maybe ExitCode))
-> Process stdin stdout stderr
-> IO (Maybe ExitCode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> STM (Maybe ExitCode)
forall stdin stdout stderr.
Process stdin stdout stderr -> STM (Maybe ExitCode)
getExitCodeSTM
getExitCodeSTM :: Process stdin stdout stderr -> STM (Maybe ExitCode)
getExitCodeSTM :: Process stdin stdout stderr -> STM (Maybe ExitCode)
getExitCodeSTM = TMVar ExitCode -> STM (Maybe ExitCode)
forall a. TMVar a -> STM (Maybe a)
tryReadTMVar (TMVar ExitCode -> STM (Maybe ExitCode))
-> (Process stdin stdout stderr -> TMVar ExitCode)
-> Process stdin stdout stderr
-> STM (Maybe ExitCode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> TMVar ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> TMVar ExitCode
pExitCode
checkExitCode :: MonadIO m => Process stdin stdout stderr -> m ()
checkExitCode :: Process stdin stdout stderr -> m ()
checkExitCode = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (Process stdin stdout stderr -> IO ())
-> Process stdin stdout stderr
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ())
-> (Process stdin stdout stderr -> STM ())
-> Process stdin stdout stderr
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> STM ()
forall stdin stdout stderr. Process stdin stdout stderr -> STM ()
checkExitCodeSTM
checkExitCodeSTM :: Process stdin stdout stderr -> STM ()
checkExitCodeSTM :: Process stdin stdout stderr -> STM ()
checkExitCodeSTM Process stdin stdout stderr
p = do
ExitCode
ec <- TMVar ExitCode -> STM ExitCode
forall a. TMVar a -> STM a
readTMVar (Process stdin stdout stderr -> TMVar ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> TMVar ExitCode
pExitCode Process stdin stdout stderr
p)
case ExitCode
ec of
ExitCode
ExitSuccess -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitCode
_ -> ExitCodeException -> STM ()
forall e a. Exception e => e -> STM a
throwSTM ExitCodeException :: ExitCode
-> ProcessConfig () () ()
-> ByteString
-> ByteString
-> ExitCodeException
ExitCodeException
{ eceExitCode :: ExitCode
eceExitCode = ExitCode
ec
, eceProcessConfig :: ProcessConfig () () ()
eceProcessConfig = ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
clearStreams (Process stdin stdout stderr -> ProcessConfig () () ()
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 :: ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
clearStreams ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc
{ pcStdin :: StreamSpec 'STInput ()
pcStdin = StreamSpec 'STInput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
, pcStdout :: StreamSpec 'STOutput ()
pcStdout = StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
, pcStderr :: StreamSpec 'STOutput ()
pcStderr = StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
}
getStdin :: Process stdin stdout stderr -> stdin
getStdin :: Process stdin stdout stderr -> stdin
getStdin = Process stdin stdout stderr -> stdin
forall stdin stdout stderr. Process stdin stdout stderr -> stdin
pStdin
getStdout :: Process stdin stdout stderr -> stdout
getStdout :: Process stdin stdout stderr -> stdout
getStdout = Process stdin stdout stderr -> stdout
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
pStdout
getStderr :: Process stdin stdout stderr -> stderr
getStderr :: Process stdin stdout stderr -> stderr
getStderr = Process stdin stdout stderr -> stderr
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
pStderr
data ExitCodeException = ExitCodeException
{ ExitCodeException -> ExitCode
eceExitCode :: ExitCode
, ExitCodeException -> ProcessConfig () () ()
eceProcessConfig :: ProcessConfig () () ()
, ExitCodeException -> ByteString
eceStdout :: L.ByteString
, ExitCodeException -> ByteString
eceStderr :: L.ByteString
}
deriving Typeable
instance Exception ExitCodeException
instance Show ExitCodeException where
show :: ExitCodeException -> FilePath
show ExitCodeException
ece = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath
"Received "
, ExitCode -> FilePath
forall a. Show a => a -> FilePath
show (ExitCodeException -> ExitCode
eceExitCode ExitCodeException
ece)
, FilePath
" when running\n"
, ProcessConfig () () () -> FilePath
forall a. Show a => a -> FilePath
show (ExitCodeException -> ProcessConfig () () ()
eceProcessConfig ExitCodeException
ece) { pcEnv :: Maybe [(FilePath, FilePath)]
pcEnv = Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing }
, if ByteString -> Bool
L.null (ExitCodeException -> ByteString
eceStdout ExitCodeException
ece)
then FilePath
""
else FilePath
"Standard output:\n\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
L8.unpack (ExitCodeException -> ByteString
eceStdout ExitCodeException
ece)
, if ByteString -> Bool
L.null (ExitCodeException -> ByteString
eceStderr ExitCodeException
ece)
then FilePath
""
else FilePath
"Standard error:\n\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
L8.unpack (ExitCodeException -> ByteString
eceStderr ExitCodeException
ece)
]
data ByteStringOutputException = ByteStringOutputException SomeException (ProcessConfig () () ())
deriving (Int -> ByteStringOutputException -> ShowS
[ByteStringOutputException] -> ShowS
ByteStringOutputException -> FilePath
(Int -> ByteStringOutputException -> ShowS)
-> (ByteStringOutputException -> FilePath)
-> ([ByteStringOutputException] -> ShowS)
-> Show ByteStringOutputException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ByteStringOutputException] -> ShowS
$cshowList :: [ByteStringOutputException] -> ShowS
show :: ByteStringOutputException -> FilePath
$cshow :: ByteStringOutputException -> FilePath
showsPrec :: Int -> ByteStringOutputException -> ShowS
$cshowsPrec :: Int -> ByteStringOutputException -> ShowS
Show, Typeable)
instance Exception ByteStringOutputException
unsafeProcessHandle :: Process stdin stdout stderr -> P.ProcessHandle
unsafeProcessHandle :: Process stdin stdout stderr -> ProcessHandle
unsafeProcessHandle = Process stdin stdout stderr -> ProcessHandle
forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessHandle
pHandle
bracket :: MonadUnliftIO m => IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket :: IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket IO a
before a -> IO b
after a -> m c
thing = ((forall a. m a -> IO a) -> IO c) -> m c
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO c) -> m c)
-> ((forall a. m a -> IO a) -> IO c) -> m c
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO a -> (a -> IO b) -> (a -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO a
before a -> IO b
after (m c -> IO c
forall a. m a -> IO a
run (m c -> IO c) -> (a -> m c) -> a -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m c
thing)
finally :: MonadUnliftIO m => m a -> IO () -> m a
finally :: m a -> IO () -> m a
finally m a
thing IO ()
after = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
E.finally (m a -> IO a
forall a. m a -> IO a
run m a
thing) IO ()
after