{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
module Streamly.Internal.System.Process
(
Config
, setCwd
, setEnv
, closeFiles
, newProcessGroup
, Session (..)
, setSession
, interruptChildOnly
, setUserId
, setGroupId
, waitForDescendants
, inheritStdin
, inheritStdout
, pipeStdErr
, ProcessFailure (..)
, toBytes
, toChunks
, toChunksWith
, toChars
, toLines
, toString
, toStdout
, toNull
, pipeBytes
, pipeChunks
, pipeChunksWith
, pipeChars
, toBytesEither
, toChunksEither
, toChunksEitherWith
, pipeBytesEither
, pipeChunksEither
, pipeChunksEitherWith
, foreground
, daemon
, standalone
, parentIgnoresInterrupt
, waitForChildTree
, interactive
, processBytes
, processChunks
)
where
import Control.Concurrent (forkIO)
import Control.Exception (Exception(..), catch, throwIO)
import Control.Monad (void, unless)
import Control.Monad.Catch (MonadCatch, throwM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Function ((&))
import Data.Word (Word8, Word32)
import Foreign.C.Error (Errno(..), ePIPE)
import GHC.IO.Exception (IOException(..), IOErrorType(..))
import Streamly.Data.Array (Array)
import Streamly.Data.Fold (Fold)
import Streamly.Data.Stream.Prelude (MonadAsync, Stream)
import System.Exit (ExitCode(..))
import System.IO (hClose, Handle)
#if !defined(mingw32_HOST_OS)
import System.Posix.Types (CUid (..), CGid (..))
#endif
#ifdef USE_NATIVE
import Control.Exception (SomeException)
import System.Posix.Process (ProcessStatus(..))
import Streamly.Internal.System.Process.Posix
#else
import System.Process
( ProcessHandle
, CreateProcess(..)
, StdStream (..)
, createProcess
, waitForProcess
, CmdSpec(..)
, terminateProcess
, withCreateProcess
)
#endif
import qualified Streamly.Data.Array as Array
import qualified Streamly.Data.Fold as Fold
import Streamly.Internal.System.IO (defaultChunkSize)
import qualified Streamly.Internal.Console.Stdio as Stdio (putChunks)
import qualified Streamly.Data.Stream.Prelude as Stream
import qualified Streamly.Internal.Data.Unfold as Unfold (either)
import qualified Streamly.Internal.FileSystem.Handle
as Handle (readChunks, putChunks)
import qualified Streamly.Unicode.Stream as Unicode
import qualified Streamly.Internal.Unicode.Stream as Unicode (lines)
#include "DocTestProcess.hs"
#ifdef USE_NATIVE
type ProcessHandle = Process
newtype Config = Config Bool
mkConfig :: FilePath -> [String] -> Config
mkConfig _ _ = Config False
pipeStdErr :: Config -> Config
pipeStdErr (Config _) = Config True
inheritStdin :: Config -> Config
inheritStdin (Config _) = Config True
inheritStdout :: Config -> Config
inheritStdout (Config _) = Config True
#else
newtype Config = Config CreateProcess
mkConfig :: FilePath -> [String] -> Config
mkConfig :: FilePath -> [FilePath] -> Config
mkConfig FilePath
path [FilePath]
args = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
{ cmdspec :: CmdSpec
cmdspec = FilePath -> [FilePath] -> CmdSpec
RawCommand FilePath
path [FilePath]
args
, cwd :: Maybe FilePath
cwd = Maybe FilePath
forall a. Maybe a
Nothing
, env :: Maybe [(FilePath, FilePath)]
env = Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
, std_in :: StdStream
std_in = StdStream
CreatePipe
, std_out :: StdStream
std_out = StdStream
CreatePipe
, std_err :: StdStream
std_err = StdStream
Inherit
, close_fds :: Bool
close_fds = Bool
False
, create_group :: Bool
create_group = Bool
False
, child_user :: Maybe UserID
child_user = Maybe UserID
forall a. Maybe a
Nothing
, child_group :: Maybe GroupID
child_group = Maybe GroupID
forall a. Maybe a
Nothing
, delegate_ctlc :: Bool
delegate_ctlc = Bool
False
, new_session :: Bool
new_session = Bool
False
, detach_console :: Bool
detach_console = Bool
False
, create_new_console :: Bool
create_new_console = Bool
False
, use_process_jobs :: Bool
use_process_jobs = Bool
True
}
setCwd :: Maybe FilePath -> Config -> Config
setCwd :: Maybe FilePath -> Config -> Config
setCwd Maybe FilePath
path (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { cwd :: Maybe FilePath
cwd = Maybe FilePath
path }
setEnv :: Maybe [(String, String)] -> Config -> Config
setEnv :: Maybe [(FilePath, FilePath)] -> Config -> Config
setEnv Maybe [(FilePath, FilePath)]
e (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { env :: Maybe [(FilePath, FilePath)]
env = Maybe [(FilePath, FilePath)]
e }
closeFiles :: Bool -> Config -> Config
closeFiles :: Bool -> Config -> Config
closeFiles Bool
x (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { close_fds :: Bool
close_fds = Bool
x }
newProcessGroup :: Bool -> Config -> Config
newProcessGroup :: Bool -> Config -> Config
newProcessGroup Bool
x (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { create_group :: Bool
create_group = Bool
x }
data Session =
InheritSession
| NewSession
| NewConsole
setSession :: Session -> Config -> Config
setSession :: Session -> Config -> Config
setSession Session
x (Config CreateProcess
cfg) =
CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$
case Session
x of
Session
InheritSession -> CreateProcess
cfg
Session
NewSession -> CreateProcess
cfg { new_session :: Bool
new_session = Bool
True}
Session
NewConsole -> CreateProcess
cfg {create_new_console :: Bool
create_new_console = Bool
True}
setUserId :: Maybe Word32 -> Config -> Config
#if defined(mingw32_HOST_OS)
setUserId _ (Config cfg) =
Config cfg
#else
setUserId :: Maybe Word32 -> Config -> Config
setUserId Maybe Word32
x (Config CreateProcess
cfg) =
CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { child_user :: Maybe UserID
child_user = Word32 -> UserID
CUid (Word32 -> UserID) -> Maybe Word32 -> Maybe UserID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word32
x }
#endif
setGroupId :: Maybe Word32 -> Config -> Config
#if defined(mingw32_HOST_OS)
setGroupId _ (Config cfg) =
Config cfg
#else
setGroupId :: Maybe Word32 -> Config -> Config
setGroupId Maybe Word32
x (Config CreateProcess
cfg) =
CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { child_group :: Maybe GroupID
child_group = Word32 -> GroupID
CGid (Word32 -> GroupID) -> Maybe Word32 -> Maybe GroupID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word32
x }
#endif
interruptChildOnly :: Bool -> Config -> Config
interruptChildOnly :: Bool -> Config -> Config
interruptChildOnly Bool
x (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { delegate_ctlc :: Bool
delegate_ctlc = Bool
x }
{-# DEPRECATED parentIgnoresInterrupt "Use interruptChildOnly instead." #-}
parentIgnoresInterrupt :: Bool -> Config -> Config
parentIgnoresInterrupt :: Bool -> Config -> Config
parentIgnoresInterrupt = Bool -> Config -> Config
interruptChildOnly
waitForDescendants :: Bool -> Config -> Config
waitForDescendants :: Bool -> Config -> Config
waitForDescendants Bool
x (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { use_process_jobs :: Bool
use_process_jobs = Bool
x }
{-# DEPRECATED waitForChildTree "Use waitForDescendants instead." #-}
waitForChildTree :: Bool -> Config -> Config
waitForChildTree :: Bool -> Config -> Config
waitForChildTree = Bool -> Config -> Config
waitForDescendants
pipeStdErr :: Config -> Config
pipeStdErr :: Config -> Config
pipeStdErr (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { std_err :: StdStream
std_err = StdStream
CreatePipe }
inheritStdin :: Config -> Config
inheritStdin :: Config -> Config
inheritStdin (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { std_in :: StdStream
std_in = StdStream
Inherit }
inheritStdout :: Config -> Config
inheritStdout :: Config -> Config
inheritStdout (Config CreateProcess
cfg) = CreateProcess -> Config
Config (CreateProcess -> Config) -> CreateProcess -> Config
forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { std_out :: StdStream
std_out = StdStream
Inherit }
#endif
newtype ProcessFailure = ProcessFailure Int
deriving Int -> ProcessFailure -> ShowS
[ProcessFailure] -> ShowS
ProcessFailure -> FilePath
(Int -> ProcessFailure -> ShowS)
-> (ProcessFailure -> FilePath)
-> ([ProcessFailure] -> ShowS)
-> Show ProcessFailure
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessFailure -> ShowS
showsPrec :: Int -> ProcessFailure -> ShowS
$cshow :: ProcessFailure -> FilePath
show :: ProcessFailure -> FilePath
$cshowList :: [ProcessFailure] -> ShowS
showList :: [ProcessFailure] -> ShowS
Show
instance Exception ProcessFailure where
displayException :: ProcessFailure -> FilePath
displayException (ProcessFailure Int
exitCode) =
FilePath
"Process failed with exit code: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
exitCode
parallel :: MonadAsync m => Stream m a -> Stream m a -> Stream m a
parallel :: forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
parallel Stream m a
s1 Stream m a
s2 = (Config -> Config) -> [Stream m a] -> Stream m a
forall (m :: * -> *) a.
MonadAsync m =>
(Config -> Config) -> [Stream m a] -> Stream m a
Stream.parList (Bool -> Config -> Config
Stream.eager Bool
True) [Stream m a
s1, Stream m a
s2]
cleanupNormal ::
(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupNormal :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupNormal (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
procHandle) = do
#ifdef USE_NATIVE
status <- wait procHandle
case status of
Exited ExitSuccess -> return ()
Exited (ExitFailure code) -> throwM $ ProcessFailure code
Terminated signal _ ->
throwM $ ProcessFailure (negate $ fromIntegral signal)
Stopped signal ->
throwM $ ProcessFailure (negate $ fromIntegral signal)
#else
ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
procHandle
case ExitCode
exitCode of
ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure Int
code -> ProcessFailure -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ProcessFailure -> IO ()) -> ProcessFailure -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ProcessFailure
ProcessFailure Int
code
#endif
cleanupException ::
(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupException :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupException (Just Handle
stdinH, Just Handle
stdoutH, Maybe Handle
stderrMaybe, ProcessHandle
ph) = do
#ifdef USE_NATIVE
terminate ph
#else
ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph
#endif
Handle -> IO ()
hClose Handle
stdinH IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOException -> IO ()
eatSIGPIPE
Handle -> IO ()
hClose Handle
stdoutH
(Handle -> IO ()) -> Maybe Handle -> IO ()
forall {f :: * -> *} {a}.
Applicative f =>
(a -> f ()) -> Maybe a -> f ()
whenJust Handle -> IO ()
hClose Maybe Handle
stderrMaybe
#ifdef USE_NATIVE
void $ forkIO (void $ wait ph)
#else
IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)
#endif
where
whenJust :: (a -> f ()) -> Maybe a -> f ()
whenJust a -> f ()
action Maybe a
mb = f () -> (a -> f ()) -> Maybe a -> f ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> f ()
action Maybe a
mb
isSIGPIPE :: IOException -> Bool
isSIGPIPE IOException
e =
case IOException
e of
IOError
{ ioe_type :: IOException -> IOErrorType
ioe_type = IOErrorType
ResourceVanished
, ioe_errno :: IOException -> Maybe CInt
ioe_errno = Just CInt
ioe
} -> CInt -> Errno
Errno CInt
ioe Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
ePIPE
IOException
_ -> Bool
False
eatSIGPIPE :: IOException -> IO ()
eatSIGPIPE IOException
e = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IOException -> Bool
isSIGPIPE IOException
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
cleanupException (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
_ = FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"cleanupProcess: Not reachable"
createProc' ::
(Config -> Config)
-> FilePath
-> [String]
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProc' :: (Config -> Config)
-> FilePath
-> [FilePath]
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProc' Config -> Config
modCfg FilePath
path [FilePath]
args = do
#ifdef USE_NATIVE
((inp, out, err, _excParent, _excChild), parent, child, failure) <-
mkStdioPipes cfg
proc <- newProcess child path args Nothing
`catch` (\(e :: SomeException) -> failure >> throwIO e)
parent
return (Just inp, Just out, err, proc)
#else
CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
cfg
#endif
where
Config CreateProcess
cfg = Config -> Config
modCfg (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> Config
mkConfig FilePath
path [FilePath]
args
{-# INLINE putChunksClose #-}
putChunksClose :: MonadIO m =>
Handle -> Stream m (Array Word8) -> Stream m a
putChunksClose :: forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array Word8) -> Stream m a
putChunksClose Handle
h Stream m (Array Word8)
input =
m () -> Stream m a -> Stream m a
forall (m :: * -> *) b a.
Monad m =>
m b -> Stream m a -> Stream m a
Stream.before
(Handle -> Stream m (Array Word8) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array a) -> m ()
Handle.putChunks Handle
h Stream m (Array Word8)
input m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
h))
Stream m a
forall (m :: * -> *) a. Applicative m => Stream m a
Stream.nil
{-# INLINE toChunksClose #-}
toChunksClose :: MonadAsync m => Handle -> Stream m (Array Word8)
toChunksClose :: forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
h = IO () -> Stream m (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *) b a.
MonadIO m =>
IO b -> Stream m a -> Stream m a
Stream.afterIO (Handle -> IO ()
hClose Handle
h) (Handle -> Stream m (Array Word8)
forall (m :: * -> *). MonadIO m => Handle -> Stream m (Array Word8)
Handle.readChunks Handle
h)
{-# INLINE pipeChunksWithAction #-}
pipeChunksWithAction ::
(MonadCatch m, MonadAsync m)
=> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Stream m a)
-> (Config -> Config)
-> FilePath
-> [String]
-> Stream m a
pipeChunksWithAction :: forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m a)
-> (Config -> Config) -> FilePath -> [FilePath] -> Stream m a
pipeChunksWithAction (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m a
run Config -> Config
modCfg FilePath
path [FilePath]
args =
IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m a)
-> Stream m a
forall (m :: * -> *) b c d e a.
(MonadIO m, MonadCatch m) =>
IO b
-> (b -> IO c)
-> (b -> IO d)
-> (b -> IO e)
-> (b -> Stream m a)
-> Stream m a
Stream.bracketIO3
IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
alloc (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupNormal (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupException (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupException (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m a
run
where
alloc :: IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
alloc = (Config -> Config)
-> FilePath
-> [FilePath]
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProc' Config -> Config
modCfg FilePath
path [FilePath]
args
{-# INLINE pipeChunksEitherWith #-}
pipeChunksEitherWith ::
(MonadCatch m, MonadAsync m)
=> (Config -> Config)
-> FilePath
-> [String]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
pipeChunksEitherWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
pipeChunksEitherWith Config -> Config
modifier FilePath
path [FilePath]
args Stream m (Array Word8)
input =
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m (Either (Array Word8) (Array Word8)))
-> (Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m a)
-> (Config -> Config) -> FilePath -> [FilePath] -> Stream m a
pipeChunksWithAction (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m (Either (Array Word8) (Array Word8))
forall {d}.
(Maybe Handle, Maybe Handle, Maybe Handle, d)
-> Stream m (Either (Array Word8) (Array Word8))
run (Config -> Config
modifier (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
pipeStdErr) FilePath
path [FilePath]
args
where
run :: (Maybe Handle, Maybe Handle, Maybe Handle, d)
-> Stream m (Either (Array Word8) (Array Word8))
run (Just Handle
stdinH, Just Handle
stdoutH, Just Handle
stderrH, d
_) =
Handle
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array Word8) -> Stream m a
putChunksClose Handle
stdinH Stream m (Array Word8)
input
Stream m (Either (Array Word8) (Array Word8))
-> Stream m (Either (Array Word8) (Array Word8))
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
`parallel` (Array Word8 -> Either (Array Word8) (Array Word8))
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Word8 -> Either (Array Word8) (Array Word8)
forall a b. a -> Either a b
Left (Handle -> Stream m (Array Word8)
forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stderrH)
Stream m (Either (Array Word8) (Array Word8))
-> Stream m (Either (Array Word8) (Array Word8))
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
`parallel` (Array Word8 -> Either (Array Word8) (Array Word8))
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Word8 -> Either (Array Word8) (Array Word8)
forall a b. b -> Either a b
Right (Handle -> Stream m (Array Word8)
forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stdoutH)
run (Maybe Handle, Maybe Handle, Maybe Handle, d)
_ = FilePath -> Stream m (Either (Array Word8) (Array Word8))
forall a. HasCallStack => FilePath -> a
error FilePath
"pipeChunksEitherWith: Not reachable"
{-# INLINE pipeChunksEither #-}
pipeChunksEither ::
(MonadCatch m, MonadAsync m)
=> FilePath
-> [String]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
pipeChunksEither :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
pipeChunksEither = (Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
pipeChunksEitherWith Config -> Config
forall a. a -> a
id
{-# INLINE pipeBytesEither #-}
pipeBytesEither ::
(MonadCatch m, MonadAsync m)
=> FilePath
-> [String]
-> Stream m Word8
-> Stream m (Either Word8 Word8)
pipeBytesEither :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath] -> Stream m Word8 -> Stream m (Either Word8 Word8)
pipeBytesEither FilePath
path [FilePath]
args Stream m Word8
input =
let input1 :: Stream m (Array Word8)
input1 = Int -> Stream m Word8 -> Stream m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> Stream m (Array a)
Stream.chunksOf Int
defaultChunkSize Stream m Word8
input
output :: Stream m (Either (Array Word8) (Array Word8))
output = FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
pipeChunksEither FilePath
path [FilePath]
args Stream m (Array Word8)
input1
leftRdr :: Unfold m (Array Word8) (Either Word8 b)
leftRdr = (Word8 -> Either Word8 b)
-> Unfold m (Array Word8) Word8
-> Unfold m (Array Word8) (Either Word8 b)
forall a b.
(a -> b) -> Unfold m (Array Word8) a -> Unfold m (Array Word8) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Either Word8 b
forall a b. a -> Either a b
Left Unfold m (Array Word8) Word8
forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader
rightRdr :: Unfold m (Array Word8) (Either a Word8)
rightRdr = (Word8 -> Either a Word8)
-> Unfold m (Array Word8) Word8
-> Unfold m (Array Word8) (Either a Word8)
forall a b.
(a -> b) -> Unfold m (Array Word8) a -> Unfold m (Array Word8) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Either a Word8
forall a b. b -> Either a b
Right Unfold m (Array Word8) Word8
forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader
in Unfold m (Either (Array Word8) (Array Word8)) (Either Word8 Word8)
-> Stream m (Either (Array Word8) (Array Word8))
-> Stream m (Either Word8 Word8)
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
Stream.unfoldMany (Unfold m (Array Word8) (Either Word8 Word8)
-> Unfold m (Array Word8) (Either Word8 Word8)
-> Unfold
m (Either (Array Word8) (Array Word8)) (Either Word8 Word8)
forall (m :: * -> *) a c b.
Applicative m =>
Unfold m a c -> Unfold m b c -> Unfold m (Either a b) c
Unfold.either Unfold m (Array Word8) (Either Word8 Word8)
forall {b}. Unfold m (Array Word8) (Either Word8 b)
leftRdr Unfold m (Array Word8) (Either Word8 Word8)
forall {a}. Unfold m (Array Word8) (Either a Word8)
rightRdr) Stream m (Either (Array Word8) (Array Word8))
output
{-# INLINE pipeChunksWith #-}
pipeChunksWith ::
(MonadCatch m, MonadAsync m)
=> (Config -> Config)
-> FilePath
-> [String]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
pipeChunksWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
pipeChunksWith Config -> Config
modifier FilePath
path [FilePath]
args Stream m (Array Word8)
input =
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m (Array Word8))
-> (Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m a)
-> (Config -> Config) -> FilePath -> [FilePath] -> Stream m a
pipeChunksWithAction (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m (Array Word8)
forall {c} {d}.
(Maybe Handle, Maybe Handle, c, d) -> Stream m (Array Word8)
run Config -> Config
modifier FilePath
path [FilePath]
args
where
run :: (Maybe Handle, Maybe Handle, c, d) -> Stream m (Array Word8)
run (Just Handle
stdinH, Just Handle
stdoutH, c
_, d
_) =
Handle -> Stream m (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array Word8) -> Stream m a
putChunksClose Handle
stdinH Stream m (Array Word8)
input Stream m (Array Word8)
-> Stream m (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
`parallel` Handle -> Stream m (Array Word8)
forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stdoutH
run (Maybe Handle, Maybe Handle, c, d)
_ = FilePath -> Stream m (Array Word8)
forall a. HasCallStack => FilePath -> a
error FilePath
"pipeChunksWith: Not reachable"
{-# INLINE pipeChunks #-}
pipeChunks ::
(MonadCatch m, MonadAsync m)
=> FilePath
-> [String]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
pipeChunks :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath] -> Stream m (Array Word8) -> Stream m (Array Word8)
pipeChunks = (Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
pipeChunksWith Config -> Config
forall a. a -> a
id
{-# DEPRECATED processChunks "Please use pipeChunks instead." #-}
{-# INLINE processChunks #-}
processChunks ::
(MonadCatch m, MonadAsync m)
=> FilePath
-> [String]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
processChunks :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath] -> Stream m (Array Word8) -> Stream m (Array Word8)
processChunks = FilePath
-> [FilePath] -> Stream m (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath] -> Stream m (Array Word8) -> Stream m (Array Word8)
pipeChunks
{-# INLINE pipeBytes #-}
pipeBytes ::
(MonadCatch m, MonadAsync m)
=> FilePath
-> [String]
-> Stream m Word8
-> Stream m Word8
pipeBytes :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
pipeBytes FilePath
path [FilePath]
args Stream m Word8
input =
let input1 :: Stream m (Array Word8)
input1 = Int -> Stream m Word8 -> Stream m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> Stream m (Array a)
Stream.chunksOf Int
defaultChunkSize Stream m Word8
input
output :: Stream m (Array Word8)
output = FilePath
-> [FilePath] -> Stream m (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath] -> Stream m (Array Word8) -> Stream m (Array Word8)
pipeChunks FilePath
path [FilePath]
args Stream m (Array Word8)
input1
in Unfold m (Array Word8) Word8
-> Stream m (Array Word8) -> Stream m Word8
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
Stream.unfoldMany Unfold m (Array Word8) Word8
forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader Stream m (Array Word8)
output
{-# DEPRECATED processBytes "Please use pipeBytes instead." #-}
{-# INLINE processBytes #-}
processBytes ::
(MonadCatch m, MonadAsync m)
=> FilePath
-> [String]
-> Stream m Word8
-> Stream m Word8
processBytes :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
processBytes = FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
pipeBytes
{-# INLINE pipeChars #-}
pipeChars ::
(MonadCatch m, MonadAsync m)
=> FilePath
-> [String]
-> Stream m Char
-> Stream m Char
pipeChars :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Char -> Stream m Char
pipeChars FilePath
path [FilePath]
args Stream m Char
input =
Stream m Char -> Stream m Word8
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
Unicode.encodeUtf8 Stream m Char
input
Stream m Word8
-> (Stream m Word8 -> Stream m Word8) -> Stream m Word8
forall a b. a -> (a -> b) -> b
& FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
pipeBytes FilePath
path [FilePath]
args
Stream m Word8
-> (Stream m Word8 -> Stream m Char) -> Stream m Char
forall a b. a -> (a -> b) -> b
& Stream m Word8 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
Unicode.decodeUtf8
{-# INLINE toChunksEitherWith #-}
toChunksEitherWith ::
(MonadCatch m, MonadAsync m)
=> (Config -> Config)
-> FilePath
-> [String]
-> Stream m (Either (Array Word8) (Array Word8))
toChunksEitherWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Either (Array Word8) (Array Word8))
toChunksEitherWith Config -> Config
modifier FilePath
path [FilePath]
args =
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m (Either (Array Word8) (Array Word8)))
-> (Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m a)
-> (Config -> Config) -> FilePath -> [FilePath] -> Stream m a
pipeChunksWithAction (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m (Either (Array Word8) (Array Word8))
forall {m :: * -> *} {a} {d}.
(MonadIO m, MonadBaseControl IO m, MonadThrow m) =>
(a, Maybe Handle, Maybe Handle, d)
-> Stream m (Either (Array Word8) (Array Word8))
run (Config -> Config
modifier (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
inheritStdin (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
pipeStdErr) FilePath
path [FilePath]
args
where
run :: (a, Maybe Handle, Maybe Handle, d)
-> Stream m (Either (Array Word8) (Array Word8))
run (a
_, Just Handle
stdoutH, Just Handle
stderrH, d
_) =
(Array Word8 -> Either (Array Word8) (Array Word8))
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Word8 -> Either (Array Word8) (Array Word8)
forall a b. a -> Either a b
Left (Handle -> Stream m (Array Word8)
forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stderrH)
Stream m (Either (Array Word8) (Array Word8))
-> Stream m (Either (Array Word8) (Array Word8))
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
`parallel` (Array Word8 -> Either (Array Word8) (Array Word8))
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Word8 -> Either (Array Word8) (Array Word8)
forall a b. b -> Either a b
Right (Handle -> Stream m (Array Word8)
forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stdoutH)
run (a, Maybe Handle, Maybe Handle, d)
_ = FilePath -> Stream m (Either (Array Word8) (Array Word8))
forall a. HasCallStack => FilePath -> a
error FilePath
"toChunksEitherWith: Not reachable"
{-# INLINE toChunksWith #-}
toChunksWith ::
(MonadCatch m, MonadAsync m)
=> (Config -> Config)
-> FilePath
-> [String]
-> Stream m (Array Word8)
toChunksWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath -> [FilePath] -> Stream m (Array Word8)
toChunksWith Config -> Config
modifier FilePath
path [FilePath]
args =
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m (Array Word8))
-> (Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m a)
-> (Config -> Config) -> FilePath -> [FilePath] -> Stream m a
pipeChunksWithAction (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Stream m (Array Word8)
forall {m :: * -> *} {a} {c} {d}.
(MonadIO m, MonadBaseControl IO m, MonadThrow m) =>
(a, Maybe Handle, c, d) -> Stream m (Array Word8)
run (Config -> Config
modifier (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
inheritStdin) FilePath
path [FilePath]
args
where
run :: (a, Maybe Handle, c, d) -> Stream m (Array Word8)
run (a
_, Just Handle
stdoutH, c
_, d
_) = Handle -> Stream m (Array Word8)
forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stdoutH
run (a, Maybe Handle, c, d)
_ = FilePath -> Stream m (Array Word8)
forall a. HasCallStack => FilePath -> a
error FilePath
"toChunksWith: Not reachable"
{-# INLINE toBytesEither #-}
toBytesEither ::
(MonadAsync m, MonadCatch m)
=> FilePath
-> [String]
-> Stream m (Either Word8 Word8)
toBytesEither :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Either Word8 Word8)
toBytesEither FilePath
path [FilePath]
args =
let output :: Stream m (Either (Array Word8) (Array Word8))
output = FilePath
-> [FilePath] -> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath
-> [FilePath] -> Stream m (Either (Array Word8) (Array Word8))
toChunksEither FilePath
path [FilePath]
args
leftRdr :: Unfold m (Array Word8) (Either Word8 b)
leftRdr = (Word8 -> Either Word8 b)
-> Unfold m (Array Word8) Word8
-> Unfold m (Array Word8) (Either Word8 b)
forall a b.
(a -> b) -> Unfold m (Array Word8) a -> Unfold m (Array Word8) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Either Word8 b
forall a b. a -> Either a b
Left Unfold m (Array Word8) Word8
forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader
rightRdr :: Unfold m (Array Word8) (Either a Word8)
rightRdr = (Word8 -> Either a Word8)
-> Unfold m (Array Word8) Word8
-> Unfold m (Array Word8) (Either a Word8)
forall a b.
(a -> b) -> Unfold m (Array Word8) a -> Unfold m (Array Word8) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Either a Word8
forall a b. b -> Either a b
Right Unfold m (Array Word8) Word8
forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader
in Unfold m (Either (Array Word8) (Array Word8)) (Either Word8 Word8)
-> Stream m (Either (Array Word8) (Array Word8))
-> Stream m (Either Word8 Word8)
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
Stream.unfoldMany (Unfold m (Array Word8) (Either Word8 Word8)
-> Unfold m (Array Word8) (Either Word8 Word8)
-> Unfold
m (Either (Array Word8) (Array Word8)) (Either Word8 Word8)
forall (m :: * -> *) a c b.
Applicative m =>
Unfold m a c -> Unfold m b c -> Unfold m (Either a b) c
Unfold.either Unfold m (Array Word8) (Either Word8 Word8)
forall {b}. Unfold m (Array Word8) (Either Word8 b)
leftRdr Unfold m (Array Word8) (Either Word8 Word8)
forall {a}. Unfold m (Array Word8) (Either a Word8)
rightRdr) Stream m (Either (Array Word8) (Array Word8))
output
{-# INLINE toBytes #-}
toBytes ::
(MonadAsync m, MonadCatch m)
=> FilePath
-> [String]
-> Stream m Word8
toBytes :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Word8
toBytes FilePath
path [FilePath]
args =
let output :: Stream m (Array Word8)
output = FilePath -> [FilePath] -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Array Word8)
toChunks FilePath
path [FilePath]
args
in Unfold m (Array Word8) Word8
-> Stream m (Array Word8) -> Stream m Word8
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
Stream.unfoldMany Unfold m (Array Word8) Word8
forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader Stream m (Array Word8)
output
{-# INLINE toChunksEither #-}
toChunksEither ::
(MonadAsync m, MonadCatch m)
=> FilePath
-> [String]
-> Stream m (Either (Array Word8) (Array Word8))
toChunksEither :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath
-> [FilePath] -> Stream m (Either (Array Word8) (Array Word8))
toChunksEither = (Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Either (Array Word8) (Array Word8))
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Either (Array Word8) (Array Word8))
toChunksEitherWith Config -> Config
forall a. a -> a
id
{-# INLINE toChunks #-}
toChunks ::
(MonadAsync m, MonadCatch m)
=> FilePath
-> [String]
-> Stream m (Array Word8)
toChunks :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Array Word8)
toChunks = (Config -> Config)
-> FilePath -> [FilePath] -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath -> [FilePath] -> Stream m (Array Word8)
toChunksWith Config -> Config
forall a. a -> a
id
{-# INLINE toChars #-}
toChars ::
(MonadAsync m, MonadCatch m)
=> FilePath
-> [String]
-> Stream m Char
toChars :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Char
toChars FilePath
path [FilePath]
args = FilePath -> [FilePath] -> Stream m Word8
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Word8
toBytes FilePath
path [FilePath]
args Stream m Word8
-> (Stream m Word8 -> Stream m Char) -> Stream m Char
forall a b. a -> (a -> b) -> b
& Stream m Word8 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
Unicode.decodeUtf8
{-# INLINE toLines #-}
toLines ::
(MonadAsync m, MonadCatch m)
=> Fold m Char a
-> FilePath
-> [String]
-> Stream m a
toLines :: forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m) =>
Fold m Char a -> FilePath -> [FilePath] -> Stream m a
toLines Fold m Char a
f FilePath
path [FilePath]
args = FilePath -> [FilePath] -> Stream m Char
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Char
toChars FilePath
path [FilePath]
args Stream m Char -> (Stream m Char -> Stream m a) -> Stream m a
forall a b. a -> (a -> b) -> b
& Fold m Char a -> Stream m Char -> Stream m a
forall (m :: * -> *) b.
Monad m =>
Fold m Char b -> Stream m Char -> Stream m b
Unicode.lines Fold m Char a
f
{-# INLINE toString #-}
toString ::
(MonadAsync m, MonadCatch m)
=> FilePath
-> [String]
-> m String
toString :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> m FilePath
toString FilePath
path [FilePath]
args = FilePath -> [FilePath] -> Stream m Char
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Char
toChars FilePath
path [FilePath]
args Stream m Char -> (Stream m Char -> m FilePath) -> m FilePath
forall a b. a -> (a -> b) -> b
& Fold m Char FilePath -> Stream m Char -> m FilePath
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold Fold m Char FilePath
forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList
{-# INLINE toStdout #-}
toStdout ::
(MonadAsync m, MonadCatch m)
=> FilePath
-> [String]
-> m ()
toStdout :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> m ()
toStdout FilePath
path [FilePath]
args = FilePath -> [FilePath] -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Array Word8)
toChunks FilePath
path [FilePath]
args Stream m (Array Word8) -> (Stream m (Array Word8) -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& Stream m (Array Word8) -> m ()
forall (m :: * -> *). MonadIO m => Stream m (Array Word8) -> m ()
Stdio.putChunks
{-# INLINE toNull #-}
toNull ::
(MonadAsync m, MonadCatch m)
=> FilePath
-> [String]
-> m ()
toNull :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> m ()
toNull FilePath
path [FilePath]
args = FilePath -> [FilePath] -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Array Word8)
toChunks FilePath
path [FilePath]
args Stream m (Array Word8) -> (Stream m (Array Word8) -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& Fold m (Array Word8) () -> Stream m (Array Word8) -> m ()
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold Fold m (Array Word8) ()
forall (m :: * -> *) a. Monad m => Fold m a ()
Fold.drain
{-# INLINE standalone #-}
standalone ::
Bool
-> (Bool, Bool, Bool)
-> (Config -> Config)
-> FilePath
-> [String]
-> IO (Either ExitCode ProcessHandle)
standalone :: Bool
-> (Bool, Bool, Bool)
-> (Config -> Config)
-> FilePath
-> [FilePath]
-> IO (Either ExitCode ProcessHandle)
standalone Bool
wait (Bool
close_stdin, Bool
close_stdout, Bool
close_stderr) Config -> Config
modCfg FilePath
path [FilePath]
args =
CreateProcess
-> (Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (Either ExitCode ProcessHandle))
-> IO (Either ExitCode ProcessHandle)
forall a.
CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
cfg Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (Either ExitCode ProcessHandle)
forall {p} {p} {p}.
p -> p -> p -> ProcessHandle -> IO (Either ExitCode ProcessHandle)
postCreate
where
postCreate :: p -> p -> p -> ProcessHandle -> IO (Either ExitCode ProcessHandle)
postCreate p
_ p
_ p
_ ProcessHandle
procHandle =
if Bool
wait
then ExitCode -> Either ExitCode ProcessHandle
forall a b. a -> Either a b
Left (ExitCode -> Either ExitCode ProcessHandle)
-> IO ExitCode -> IO (Either ExitCode ProcessHandle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
procHandle
else Either ExitCode ProcessHandle -> IO (Either ExitCode ProcessHandle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ExitCode ProcessHandle
-> IO (Either ExitCode ProcessHandle))
-> Either ExitCode ProcessHandle
-> IO (Either ExitCode ProcessHandle)
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> Either ExitCode ProcessHandle
forall a b. b -> Either a b
Right ProcessHandle
procHandle
cfg :: CreateProcess
cfg =
let Config CreateProcess
c = Config -> Config
modCfg (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> Config
mkConfig FilePath
path [FilePath]
args
s_in :: StdStream
s_in = if Bool
close_stdin then StdStream
NoStream else StdStream
Inherit
s_out :: StdStream
s_out = if Bool
close_stdout then StdStream
NoStream else StdStream
Inherit
s_err :: StdStream
s_err = if Bool
close_stderr then StdStream
NoStream else StdStream
Inherit
in CreateProcess
c {std_in :: StdStream
std_in = StdStream
s_in, std_out :: StdStream
std_out = StdStream
s_out, std_err :: StdStream
std_err = StdStream
s_err}
{-# INLINE foreground #-}
foreground ::
(Config -> Config)
-> FilePath
-> [String]
-> IO ExitCode
foreground :: (Config -> Config) -> FilePath -> [FilePath] -> IO ExitCode
foreground Config -> Config
modCfg FilePath
path [FilePath]
args =
let r :: IO (Either ExitCode ProcessHandle)
r =
Bool
-> (Bool, Bool, Bool)
-> (Config -> Config)
-> FilePath
-> [FilePath]
-> IO (Either ExitCode ProcessHandle)
standalone
Bool
True
(Bool
False, Bool
False, Bool
False)
(Bool -> Config -> Config
parentIgnoresInterrupt Bool
True (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
modCfg)
FilePath
path [FilePath]
args
in (Either ExitCode ProcessHandle -> ExitCode)
-> IO (Either ExitCode ProcessHandle) -> IO ExitCode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ExitCode -> ExitCode)
-> (ProcessHandle -> ExitCode)
-> Either ExitCode ProcessHandle
-> ExitCode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExitCode -> ExitCode
forall a. a -> a
id ProcessHandle -> ExitCode
forall a. HasCallStack => a
undefined) IO (Either ExitCode ProcessHandle)
r
{-# DEPRECATED interactive "Use foreground instead." #-}
{-# INLINE interactive #-}
interactive ::
(Config -> Config)
-> FilePath
-> [String]
-> IO ExitCode
interactive :: (Config -> Config) -> FilePath -> [FilePath] -> IO ExitCode
interactive = (Config -> Config) -> FilePath -> [FilePath] -> IO ExitCode
foreground
{-# INLINE daemon #-}
daemon ::
(Config -> Config)
-> FilePath
-> [String]
-> IO ProcessHandle
daemon :: (Config -> Config) -> FilePath -> [FilePath] -> IO ProcessHandle
daemon Config -> Config
modCfg FilePath
path [FilePath]
args =
let r :: IO (Either ExitCode ProcessHandle)
r =
Bool
-> (Bool, Bool, Bool)
-> (Config -> Config)
-> FilePath
-> [FilePath]
-> IO (Either ExitCode ProcessHandle)
standalone
Bool
False
(Bool
True, Bool
True, Bool
True)
(Session -> Config -> Config
setSession Session
NewSession (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
modCfg)
FilePath
path [FilePath]
args
in (Either ExitCode ProcessHandle -> ProcessHandle)
-> IO (Either ExitCode ProcessHandle) -> IO ProcessHandle
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ExitCode -> ProcessHandle)
-> (ProcessHandle -> ProcessHandle)
-> Either ExitCode ProcessHandle
-> ProcessHandle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExitCode -> ProcessHandle
forall a. HasCallStack => a
undefined ProcessHandle -> ProcessHandle
forall a. a -> a
id) IO (Either ExitCode ProcessHandle)
r