{-# 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
, mkStreamSpec
, inherit
, nullStream
, closed
, byteStringInput
, byteStringOutput
, createPipe
, useHandleOpen
, useHandleClose
, 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 pc :: 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 s :: FilePath
s -> "Shell command: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
s
P.RawCommand x :: FilePath
x xs :: [FilePath]
xs -> "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))
, "\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
Nothing -> ""
Just wd :: FilePath
wd -> [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "Run from: "
, FilePath
wd
, "\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
Nothing -> ""
Just e :: [(FilePath, FilePath)]
e -> [FilePath] -> FilePath
unlines
([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ "Modified environment:"
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: FilePath
k, v :: FilePath
v) -> [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
k, "=", FilePath
v]) [(FilePath, FilePath)]
e
]
where
escape :: ShowS
escape x :: 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
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 s :: 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
== ' ') 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 x :: 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 f :: IO (a -> b, IO ())
f <*> :: Cleanup (a -> b) -> Cleanup a -> Cleanup b
<*> Cleanup x :: 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
(f' :: a -> b
f', c1 :: 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
(x' :: a
x', c2 :: 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 p :: Process stdin stdout stderr
p = "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 = $WProcessConfig :: 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 ""
, 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 cmd :: FilePath
cmd args :: [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 cmd :: FilePath
cmd args :: [FilePath]
args p :: 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 cmd :: 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 cmd :: FilePath
cmd p :: 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 spec :: StreamSpec 'STInput stdin
spec pc :: 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 spec :: StreamSpec 'STOutput stdout
spec pc :: 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 spec :: StreamSpec 'STOutput stderr
spec pc :: 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 dir :: FilePath
dir pc :: 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 pc :: 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 env :: [(FilePath, FilePath)]
env pc :: 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 pc :: 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 x :: Bool
x pc :: 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 x :: Bool
x pc :: 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 x :: Bool
x pc :: 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 x :: Bool
x pc :: 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 x :: Bool
x pc :: 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 x :: Bool
x pc :: 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 x :: GroupID
x pc :: 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 pc :: 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 x :: UserID
x pc :: 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 pc :: 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 ss :: StdStream
ss f :: 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 ss :: forall b. (StdStream -> IO b) -> IO b
ss f :: 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 (\pc :: ProcessConfig () () ()
pc mh :: 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 (\_ 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 f :: 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
handle ->
StdStream -> IO r
f (Handle -> StdStream
P.UseHandle Handle
handle)
cleanup :: p -> p -> f ((), m ())
cleanup _ _ =
((), 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 (\_ 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 lbs :: 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
$ \_ (Just h :: 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
$ \pc :: ProcessConfig () () ()
pc (Just h :: 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 pc :: ProcessConfig () () ()
pc h :: 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 front :: [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` \e :: 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
$ \_ (Just h :: 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 h :: 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
$ \_ 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 h :: 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
$ \_ 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 {..} = 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
$ \realStdin :: 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
$ \realStdout :: 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
$ \realStderr :: StdStream
realStderr -> do
let cp0 :: CreateProcess
cp0 =
case CmdSpec
pcCmdSpec of
P.ShellCommand cmd :: FilePath
cmd -> FilePath -> CreateProcess
P.shell FilePath
cmd
P.RawCommand cmd :: FilePath
cmd args :: [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
}
(minH :: Maybe Handle
minH, moutH :: Maybe Handle
moutH, merrH :: Maybe Handle
merrH, pHandle :: ProcessHandle
pHandle) <- FilePath
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
P.createProcess_ "startProcess" CreateProcess
cp
((pStdin :: stdin
pStdin, pStdout :: stdout
pStdout, pStderr :: stderr
pStderr), pCleanup1 :: 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
$ \unmask :: 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` 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 = 1
maxDelay :: Int
maxDelay = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minDelay Int
switchTime
loop :: Int -> IO ExitCode
loop delay :: Int
delay = do
Int -> IO ()
threadDelay Int
delay
Maybe ExitCode
mec <- ProcessHandle -> IO (Maybe ExitCode)
P.getProcessExitCode ProcessHandle
pHandle
case Maybe ExitCode
mec of
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
* 2)
Just ec :: 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 _ec :: ExitCode
_ec -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left _ -> 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 e :: 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 $WProcess :: forall stdin stdout stderr.
ProcessConfig () () ()
-> IO ()
-> stdin
-> stdout
-> stderr
-> ProcessHandle
-> TMVar ExitCode
-> Process stdin stdout stderr
Process {..}
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 config :: 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 config :: ProcessConfig stdin stdout stderr
config f :: 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
(\p :: 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_ config :: 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)
(\p :: 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_ config :: ProcessConfig stdin stdout stderr
config f :: 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
(\p :: 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 pc :: 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
$ \p :: 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_ pc :: 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
$ \p :: 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` \ece :: 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 pc :: 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
$ \p :: 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_ pc :: 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
$ \p :: 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` \ece :: 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 pc :: 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
$ \p :: 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_ pc :: 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
$ \p :: 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` \ece :: 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 pc :: ProcessConfig stdin stdoutIgnored stderrIgnored
pc inner :: 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 (\(r :: Handle
r, w :: 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
$ \(readEnd :: Handle
readEnd, writeEnd :: 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) (\pc'' :: ProcessConfig () () ()
pc'' 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
$ \p :: 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 pc :: 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
$ \p :: 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_ pc :: 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
$ \p :: 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` \ece :: 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 pc :: 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_ pc :: 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 p :: 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
ExitSuccess -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 pc :: 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 ece :: ExitCodeException
ece = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "Received "
, ExitCode -> FilePath
forall a. Show a => a -> FilePath
show (ExitCodeException -> ExitCode
eceExitCode ExitCodeException
ece)
, " 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 ""
else "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 ""
else "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 before :: IO a
before after :: a -> IO b
after thing :: 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
$ \run :: 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 thing :: m a
thing after :: 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
$ \run :: 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