-- |
-- Module      : Streamly.Internal.System.Process
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : Apache-2.0
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--

{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- TODO:
--
-- Remove dependency on the "process" package. We do not need a lot of it or
-- need to reimplement significantly.
--
-- Interactive processes:
--
-- To understand process groups and sessions, see the "General Terminal
-- Interface" section in the [POSIX
-- standard](https://pubs.opengroup.org/onlinepubs/9699919799/).
--
-- For running processes interactively we need to make a new process group for
-- the new process and make it the foreground process group. When the process
-- is done we can make the parent process group as the foreground process group
-- again. We need to ensure that this works properly under exceptions. We can
-- provide an "interact" function to do so.
--
-- - Need a way to specify additional parameters for process creation.
-- Possibly use something like @processBytesWith spec@ etc.
--
-- - Need a way to access the pid and manage the processes and process groups.
-- We can treat the processes in the same way as we treat threads. We can
-- compose processes in parallel, and cleanup can happen in the same way as
-- tids are cleaned up. But do we need this when we have threads anyway?
--
-- - Use unfolds for generation?
--
-- - Folds for composing process sinks? Input may be taken as input of the
-- fold and the output of the process can be consumed by another fold.
--
-- - Replace FilePath with a typed path.
--
{-# LANGUAGE FlexibleContexts #-}

module Streamly.Internal.System.Process
    (
    -- * Process Configuration
      Config

    -- ** Common Config Options
    -- | These options apply to both POSIX and Windows.
    , setCwd
    , setEnv
    {-
    , setStdin
    , setStdout
    , setStderr
    -}
    , closeFiles
    , newProcessGroup
    , setSession

    -- * Posix Only Options
    -- | These options have no effect on Windows.
    , parentIgnoresInterrupt
    , setUserId
    , setGroupId

    -- * Windows Only Options
    -- | These options have no effect on Posix.
    , waitForChildTree

    -- * Internal
    , inheritStdin
    , inheritStdout
    , pipeStdErr

    -- * Exceptions
    , ProcessFailure (..)

    -- * Generation
    -- | stdout of the process is redirected to output stream.
    , toBytes
    , toChunks
    , toChunksWith
    , toChars
    , toLines
    , toString
    , toStdout
    , toNull

    -- * Transformation
    -- | The input stream is redirected to the stdin of the process, stdout of
    -- the process is redirected to the output stream.
    , pipeBytes
    , pipeChunks
    , pipeChunksWith
    , pipeChars

    -- * Stderr
    -- | Like other "Generation" routines but along with stdout, stderr is also
    -- included in the output stream. stdout is converted to 'Right' values in
    -- the output stream and stderr is converted to 'Left' values.
    , toBytesEither
    , toChunksEither
    , toChunksEitherWith
    , pipeBytesEither
    , pipeChunksEither
    , pipeChunksEitherWith

    -- * Standalone Processes
    , standalone
    , interactive
    , daemon

    -- * Deprecated
    , 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

-- Internal imports
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)

-- $setup
-- >>> :set -XFlexibleContexts
-- >>> import Data.Char (toUpper)
-- >>> import Data.Function ((&))
-- >>> import qualified Streamly.Internal.Console.Stdio as Stdio
-- >>> import qualified Streamly.Data.Fold as Fold
-- >>> import qualified Streamly.Data.Stream.Prelude as Stream
-- >>> import qualified Streamly.Internal.System.Process as Process
-- >>> import qualified Streamly.Unicode.Stream as Unicode
-- >>> import qualified Streamly.Internal.Data.Stream as Stream
-- >>> import qualified Streamly.Internal.Unicode.Stream as Unicode

-------------------------------------------------------------------------------
-- Config
-------------------------------------------------------------------------------

-- | Process configuration used for creating a new process.
--
-- By default the process config is setup to inherit the following attributes
-- from the parent process:
--
-- * Current working directory
-- * Environment variables
-- * Open file descriptors
-- * Process group
-- * Terminal session
--
-- On POSIX:
--
-- * Process uid and gid
-- * Signal handlers
--
-- On Windows by default the parent process waits for the entire child process
-- tree to finish.
--
#ifdef USE_NATIVE

type ProcessHandle = Process

-- XXX After the fork specify what code to run in parent and in child before
-- exec. Also, use config to control whether to search the binary in the PATH
-- or not.
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

-- | Create a default process configuration from an executable file path and
-- an argument list.
--
mkConfig :: FilePath -> [String] -> Config
mkConfig :: FilePath -> [FilePath] -> Config
mkConfig FilePath
path [FilePath]
args = CreateProcess -> Config
Config forall a b. (a -> b) -> a -> b
$ CreateProcess
    { cmdspec :: CmdSpec
cmdspec = FilePath -> [FilePath] -> CmdSpec
RawCommand FilePath
path [FilePath]
args
    , cwd :: Maybe FilePath
cwd = forall a. Maybe a
Nothing -- inherit
    , env :: Maybe [(FilePath, FilePath)]
env = forall a. Maybe a
Nothing -- inherit

    -- File descriptors
    , 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

    -- Session/group/setuid/setgid
    , create_group :: Bool
create_group = Bool
False
    , child_user :: Maybe UserID
child_user = forall a. Maybe a
Nothing  -- Posix only
    , child_group :: Maybe GroupID
child_group = forall a. Maybe a
Nothing  -- Posix only

    -- Signals (Posix only) behavior
    -- Ignore SIGINT (Ctrl-C) and SIGQUIT (Ctrl-\) in the parent process until
    -- the child exits i.e. let the child handle it. See
    -- https://www.cons.org/cracauer/sigint.html .
    , delegate_ctlc :: Bool
delegate_ctlc = Bool
False

    -- Terminal behavior
    , new_session :: Bool
new_session = Bool
False  -- Posix only
    , detach_console :: Bool
detach_console = Bool
False -- Windows only
    , create_new_console :: Bool
create_new_console = Bool
False -- Windows Only

    -- Added by commit 6b8ffe2ec3d115df9ccc047599545ca55c393005
    , use_process_jobs :: Bool
use_process_jobs = Bool
True -- Windows only
    }

-- XXX use osPath

-- | Set the current working directory of the new process. When 'Nothing', the
-- working directory is inherited from the parent process.
--
-- Default is 'Nothing' - inherited from the parent process.
setCwd :: Maybe (FilePath) -> Config -> Config
setCwd :: Maybe FilePath -> Config -> Config
setCwd Maybe FilePath
path (Config CreateProcess
cfg) = CreateProcess -> Config
Config forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { cwd :: Maybe FilePath
cwd = Maybe FilePath
path }

-- | Set the environment variables for the new process. When 'Nothing', the
-- environment is inherited from the parent process.
--
-- Default is 'Nothing' - inherited from the parent process.
setEnv :: Maybe [(String, String)] -> Config -> Config
setEnv :: Maybe [(FilePath, FilePath)] -> Config -> Config
setEnv Maybe [(FilePath, FilePath)]
e (Config CreateProcess
cfg) = CreateProcess -> Config
Config forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { env :: Maybe [(FilePath, FilePath)]
env = Maybe [(FilePath, FilePath)]
e }

{-
-- XXX We should allow setting only those stdio streams which are not used for
-- piping. We can either close those or inherit from parent.
--
-- * In a source we have to close stdin and use stdout
-- * In a pipe we have to use both
-- * In a sink we have to close stdout and use stdin.
--
-- Only stderr may be left for setting - either pipe it to merge it with stdout
-- or inherit or close. Closing may lead to bad behavior in most cases. So it
-- is either inherit or merge with stdout. Merge with stdout can be achieved by
-- using the either combinators. So there is nothing really left to set here
-- for any std stream.

-- UseProc, UsePipe?
-- | What to do with the stdin, stdout, stderr streams of the process.
data Stdio =
      ToHaskell -- ^ Pipe to Haskell Streamly
    | ToProcess -- ^ Connect to the parent process

toStdStream :: Stdio -> StdStream
toStdStream x =
    case x of
        ToProcess -> Inherit
        ToHaskell -> CreatePipe

-- | What to do with the @stdin@ stream of the process.
setStdin :: Stdio -> Config -> Config
setStdin x (Config cfg) = Config $ cfg { std_in = toStdStream x }

-- | What to do with the @stdout@ stream of the process.
setStdout :: Stdio -> Config -> Config
setStdout x (Config cfg) = Config $ cfg { std_out = toStdStream x }

-- | What to do with the @stderr@ stream of the process.
setStderr :: Stdio -> Config -> Config
setStderr x (Config cfg) = Config $ cfg { std_err = toStdStream x }
-}

-- | Close all open file descriptors inherited from the parent process. Note,
-- this does not apply to stdio descriptors - the behavior of those is determined
-- by other configuration settings.
--
-- Default is 'False'.
--
-- Note: if the number of open descriptors is large, it may take a while
-- closing them.
closeFiles :: Bool -> Config -> Config
closeFiles :: Bool -> Config -> Config
closeFiles Bool
x (Config CreateProcess
cfg) = CreateProcess -> Config
Config forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { close_fds :: Bool
close_fds = Bool
x }

-- XXX Do these details apply to Windows as well?

-- | If 'True' the new process starts a new process group, becomes a process
-- group leader, its pid becoming the process group id.
--
-- See the POSIX @setpgid@ man page.
--
-- Default is 'False', the new process belongs to the parent's process group.
newProcessGroup :: Bool -> Config -> Config
newProcessGroup :: Bool -> Config -> Config
newProcessGroup Bool
x (Config CreateProcess
cfg) = CreateProcess -> Config
Config forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { create_group :: Bool
create_group = Bool
x }

-- | 'InheritSession' makes the new process inherit the terminal session from the
-- parent process. This is the default.
--
-- 'NewSession' makes the new process start with a new session without a
-- controlling terminal. On POSIX, @setsid@ is used to create a new process
-- group and session, the pid of the new process is the session id and process
-- group id as well. On Windows @DETACHED_PROCESS@ flag is used to detach the
-- process from inherited console session.
--
-- 'NewConsole' creates a new terminal and attaches the process to the new
-- terminal on Windows, using the CREATE_NEW_CONSOLE flag. On POSIX this does
-- nothing.
--
-- For Windows see
-- * https://learn.microsoft.com/en-us/windows/win32/procthread/process-creation-flags
-- * https://learn.microsoft.com/en-us/windows/console/creation-of-a-console .
--
-- For POSIX see, @setsid@ man page.
data Session =
      InheritSession -- ^ Inherit the parent session
    | NewSession -- ^ Detach process from the current session
    | NewConsole -- ^ Windows only, CREATE_NEW_CONSOLE flag

-- | Define the terminal session behavior for the new process.
--
-- Default is 'InheritSession'.
setSession :: Session -> Config -> Config
setSession :: Session -> Config -> Config
setSession Session
x (Config CreateProcess
cfg) =
    CreateProcess -> Config
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}

-- | Use the POSIX @setuid@ call to set the user id of the new process before
-- executing the command. The parent process must have sufficient privileges to
-- set the user id.
--
-- POSIX only. See the POSIX @setuid@ man page.
--
-- Default is 'Nothing' - inherit from the parent.
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 forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { child_user :: Maybe UserID
child_user = Word32 -> UserID
CUid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word32
x }
#endif

-- | Use the POSIX @setgid@ call to set the group id of the new process before
-- executing the command. The parent process must have sufficient privileges to
-- set the group id.
--
-- POSIX only. See the POSIX @setgid@ man page.
--
-- Default is 'Nothing' - inherit from the parent.
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 forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { child_group :: Maybe GroupID
child_group = Word32 -> GroupID
CGid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word32
x }
#endif

-- See https://www.cons.org/cracauer/sigint.html for more details on signal
-- handling by interactive processes.

-- | When this is 'True', the parent process ignores user interrupt signals
-- @SIGINT@ and @SIGQUIT@ delivered to it until the child process exits. If
-- multiple child processes are started then the default handling in the parent
-- is restored only after the last one exits.
--
-- When a user presses CTRL-C or CTRL-\ on the terminal, a SIGINT or SIGQUIT is
-- sent to all the foreground processes in the terminal session, this includes
-- both the child and the parent. By default, on receiving these signals, the
-- parent process would cleanup and exit, to avoid that and let the child
-- handle these signals we can choose to ignore these signals in the parent
-- until the child exits.
--
-- POSIX only. Default is 'False'.
parentIgnoresInterrupt :: Bool -> Config -> Config
parentIgnoresInterrupt :: Bool -> Config -> Config
parentIgnoresInterrupt Bool
x (Config CreateProcess
cfg) = CreateProcess -> Config
Config forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { delegate_ctlc :: Bool
delegate_ctlc = Bool
x }

-- | On Windows, the parent waits for the entire tree of process i.e. including
-- processes that are spawned by the child process.
--
-- Default is 'True'.
waitForChildTree :: Bool -> Config -> Config
waitForChildTree :: Bool -> Config -> Config
waitForChildTree Bool
x (Config CreateProcess
cfg) = CreateProcess -> Config
Config forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { use_process_jobs :: Bool
use_process_jobs = Bool
x }

pipeStdErr :: Config -> Config
pipeStdErr :: Config -> Config
pipeStdErr (Config CreateProcess
cfg) = CreateProcess -> Config
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 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 forall a b. (a -> b) -> a -> b
$ CreateProcess
cfg { std_out :: StdStream
std_out = StdStream
Inherit }
#endif

-------------------------------------------------------------------------------
-- Exceptions
-------------------------------------------------------------------------------
--
-- TODO Add the path of the executable and the PID of the process to the
-- exception info to aid debugging.

-- | An exception that is raised when a process fails.
--
-- @since 0.1.0
newtype ProcessFailure = ProcessFailure Int -- ^ The exit code of the process.
    deriving Int -> ProcessFailure -> ShowS
[ProcessFailure] -> ShowS
ProcessFailure -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProcessFailure] -> ShowS
$cshowList :: [ProcessFailure] -> ShowS
show :: ProcessFailure -> FilePath
$cshow :: ProcessFailure -> FilePath
showsPrec :: Int -> ProcessFailure -> ShowS
$cshowsPrec :: Int -> ProcessFailure -> ShowS
Show

-- Exception instance of ProcessFailure
instance Exception ProcessFailure where

    displayException :: ProcessFailure -> FilePath
displayException (ProcessFailure Int
exitCode) =
        FilePath
"Process failed with exit code: " forall a. [a] -> [a] -> [a]
++ 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 = 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]

-------------------------------------------------------------------------------
-- Transformation
-------------------------------------------------------------------------------
--
-- | On normal cleanup we do not need to close the pipe handles as they are
-- already guaranteed to be closed (we can assert that) by the time we reach
-- here. We should not kill the process, rather wait for it to terminate
-- normally.
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
    -- liftIO $ putStrLn "cleanupNormal waiting"
    status <- wait procHandle
    -- liftIO $ putStrLn "cleanupNormal done"
    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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitFailure Int
code -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Int -> ProcessFailure
ProcessFailure Int
code
#endif

-- | On an exception or if the process is getting garbage collected we need to
-- close the pipe handles, and send a SIGTERM to the process to clean it up.
-- Since we are using SIGTERM to kill the process, it may block forever. We can
-- possibly use a timer and send a SIGKILL after the timeout if the process is
-- still hanging around.
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
    -- Send a SIGTERM to the process
#ifdef USE_NATIVE
    terminate ph
#else
    ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph
#endif

    -- Ideally we should be closing the handle without flushing the buffers so
    -- that we cannot get a SIGPIPE. But there seems to be no way to do that as
    -- of now so we just ignore the SIGPIPE.
    Handle -> IO ()
hClose Handle
stdinH forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOException -> IO ()
eatSIGPIPE
    Handle -> IO ()
hClose Handle
stdoutH
    forall {f :: * -> *} {a}.
Applicative f =>
(a -> f ()) -> Maybe a -> f ()
whenJust Handle -> IO ()
hClose Maybe Handle
stderrMaybe

    -- Non-blocking wait for the process to go away
#ifdef USE_NATIVE
    void $ forkIO (void $ wait ph)
#else
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 forall a. Eq a => a -> a -> Bool
== Errno
ePIPE
            IOException
_ -> Bool
False

    eatSIGPIPE :: IOException -> IO ()
eatSIGPIPE IOException
e = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IOException -> Bool
isSIGPIPE IOException
e) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO IOException
e
cleanupException (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"cleanupProcess: Not reachable"

-- | Creates a system process from an executable path and arguments. For the
-- default attributes used to create the process see 'mkConfig'.
--
createProc' ::
       (Config -> Config) -- ^ Process attribute modifier
    -> FilePath                         -- ^ Executable path
    -> [String]                         -- ^ Arguments
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -- ^ (Input Handle, Output Handle, Error Handle, Process Handle)
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
    -- XXX Pass the exChild handle to the child process action
    proc <- newProcess child path args Nothing
              `catch` (\(e :: SomeException) -> failure >> throwIO e)
    -- XXX Read the exception channel and reap the process if it failed before
    -- exec.
    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 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 =
    forall (m :: * -> *) b a.
Monad m =>
m b -> Stream m a -> Stream m a
Stream.before
        (forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array a) -> m ()
Handle.putChunks Handle
h Stream m (Array Word8)
input forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
h))
        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 = forall (m :: * -> *) b a.
MonadIO m =>
IO b -> Stream m a -> Stream m a
Stream.afterIO (Handle -> IO ()
hClose Handle
h) (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             -- ^ Path to Executable
    -> [String]             -- ^ Arguments
    -> Stream m a     -- ^ Output stream
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 =
    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)   -- ^ Config modifier
    -> FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Array Word8)    -- ^ Input stream
    -> Stream m (Either (Array Word8) (Array Word8))     -- ^ Output stream
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 =
    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 forall {d}.
(Maybe Handle, Maybe Handle, Maybe Handle, d)
-> Stream m (Either (Array Word8) (Array Word8))
run (Config -> Config
modifier 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
_) =
        forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array Word8) -> Stream m a
putChunksClose Handle
stdinH Stream m (Array Word8)
input
            forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
`parallel` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left (forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stderrH)
            forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
`parallel` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right (forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stdoutH)
    run (Maybe Handle, Maybe Handle, Maybe Handle, d)
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"pipeChunksEitherWith: Not reachable"

{-# INLINE pipeChunksEither #-}
pipeChunksEither ::
    (MonadCatch m, MonadAsync m)
    => FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Array Word8)    -- ^ Input stream
    -> Stream m (Either (Array Word8) (Array Word8))     -- ^ Output stream
pipeChunksEither :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
pipeChunksEither = forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Either (Array Word8) (Array Word8))
pipeChunksEitherWith forall a. a -> a
id

-- | @pipeBytesEither path args input@ runs the executable at @path@ using @args@
-- as arguments and @input@ stream as its standard input.  The error stream of
-- the executable is presented as 'Left' values in the resulting stream and
-- output stream as 'Right' values.
--
-- Raises 'ProcessFailure' exception in case of failure.
--
-- For example, the following is equivalent to the shell command @echo "hello
-- world" | tr [:lower:] [:upper:]@:
--
-- >>> :{
--    pipeBytesEither "echo" ["hello world"] Stream.nil
--  & Stream.catRights
--  & pipeBytesEither "tr" ["[:lower:]", "[:upper:]"]
--  & Stream.catRights
--  & Stream.fold Stdio.write
--  :}
--HELLO WORLD
--
-- @since 0.1.0
{-# INLINE pipeBytesEither #-}
pipeBytesEither ::
    (MonadCatch m, MonadAsync m)
    => FilePath         -- ^ Executable name or path
    -> [String]         -- ^ Arguments
    -> Stream m Word8        -- ^ Input Stream
    -> Stream m (Either Word8 Word8) -- ^ Output Stream
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 = 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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader
        rightRdr :: Unfold m (Array Word8) (Either a Word8)
rightRdr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader
     in forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
Stream.unfoldMany (forall (m :: * -> *) a c b.
Applicative m =>
Unfold m a c -> Unfold m b c -> Unfold m (Either a b) c
Unfold.either forall {b}. Unfold m (Array Word8) (Either Word8 b)
leftRdr 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)   -- ^ Config modifier
    -> FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Array Word8)    -- ^ Input stream
    -> Stream m (Array Word8)    -- ^ Output stream
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 =
    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 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
_) =
        forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array Word8) -> Stream m a
putChunksClose Handle
stdinH Stream m (Array Word8)
input forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
`parallel` forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stdoutH
    run (Maybe Handle, Maybe Handle, c, d)
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"pipeChunksWith: Not reachable"

-- | @pipeChunks file args input@ runs the executable @file@ specified by
-- its name or path using @args@ as arguments and @input@ stream as its
-- standard input.  Returns the standard output of the executable as a stream.
--
-- If only the name of an executable file is specified instead of its path then
-- the file name is searched in the directories specified by the PATH
-- environment variable.
--
-- If the input stream throws an exception or if the output stream is garbage
-- collected before it could finish then the process is terminated with SIGTERM.
--
-- If the process terminates with a non-zero exit code then a 'ProcessFailure'
-- exception is raised.
--
-- The following code is equivalent to the shell command @echo "hello world" |
-- tr [a-z] [A-Z]@:
--
-- >>> :{
--    Process.toChunks "echo" ["hello world"]
--  & Process.pipeChunks "tr" ["[a-z]", "[A-Z]"]
--  & Stream.fold Stdio.writeChunks
--  :}
--HELLO WORLD
--
-- /pre-release/
{-# INLINE pipeChunks #-}
pipeChunks ::
    (MonadCatch m, MonadAsync m)
    => FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Array Word8)    -- ^ Input stream
    -> Stream m (Array Word8)    -- ^ Output stream
pipeChunks :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath] -> Stream m (Array Word8) -> Stream m (Array Word8)
pipeChunks = forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
pipeChunksWith forall a. a -> a
id

{-# DEPRECATED processChunks "Please use pipeChunks instead." #-}
{-# INLINE processChunks #-}
processChunks ::
    (MonadCatch m, MonadAsync m)
    => FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Array Word8)    -- ^ Input stream
    -> Stream m (Array Word8)    -- ^ Output stream
processChunks :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath
-> [FilePath] -> 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)
pipeChunks

-- | Like 'pipeChunks' except that it works on a stream of bytes instead of
-- a stream of chunks.
--
-- We can write the example in 'pipeChunks' as follows.
--
-- >>> :{
--    Process.toBytes "echo" ["hello world"]
--  & Process.pipeBytes "tr" ["[a-z]", "[A-Z]"]
--  & Stream.fold Stdio.write
--  :}
--HELLO WORLD
--
-- /pre-release/
{-# INLINE pipeBytes #-}
pipeBytes ::
    (MonadCatch m, MonadAsync m)
    => FilePath     -- ^ Executable name or path
    -> [String]     -- ^ Arguments
    -> Stream m Word8    -- ^ Input Stream
    -> Stream m Word8    -- ^ Output Stream
pipeBytes :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
pipeBytes FilePath
path [FilePath]
args Stream m Word8
input = -- rights . pipeBytesEither path args
    let input1 :: Stream m (Array Word8)
input1 = 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 = 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 forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
Stream.unfoldMany 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     -- ^ Executable name or path
    -> [String]     -- ^ Arguments
    -> Stream m Word8    -- ^ Input Stream
    -> Stream m Word8    -- ^ Output Stream
processBytes :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
processBytes = forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
pipeBytes

-- | Like 'pipeChunks' except that it works on a stream of chars instead of
-- a stream of chunks.
--
-- >>> :{
--    Process.toChars "echo" ["hello world"]
--  & Process.pipeChars "tr" ["[a-z]", "[A-Z]"]
--  & Stdio.putChars
--  :}
--HELLO WORLD
--
-- We can seamlessly replace the @tr@ process with the Haskell @toUpper@
-- function:
--
-- >>> :{
--    Process.toChars "echo" ["hello world"]
--  & fmap toUpper
--  & Stdio.putChars
--  :}
--HELLO WORLD
--
-- /pre-release/
{-# INLINE pipeChars #-}
pipeChars ::
    (MonadCatch m, MonadAsync m)
    => FilePath     -- ^ Executable name or path
    -> [String]     -- ^ Arguments
    -> Stream m Char    -- ^ Input Stream
    -> Stream m Char    -- ^ Output Stream
pipeChars :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Char -> Stream m Char
pipeChars FilePath
path [FilePath]
args Stream m Char
input =
    forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
Unicode.encodeUtf8 Stream m Char
input
        forall a b. a -> (a -> b) -> b
& forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
FilePath -> [FilePath] -> Stream m Word8 -> Stream m Word8
pipeBytes FilePath
path [FilePath]
args
        forall a b. a -> (a -> b) -> b
& forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
Unicode.decodeUtf8

-------------------------------------------------------------------------------
-- Generation
-------------------------------------------------------------------------------

{-# INLINE toChunksEitherWith #-}
toChunksEitherWith ::
    (MonadCatch m, MonadAsync m)
    => (Config -> Config)   -- ^ Config modifier
    -> FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Either (Array Word8) (Array Word8))     -- ^ Output stream
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 =
    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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
inheritStdin 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
_) =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left (forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stderrH)
            forall (m :: * -> *) a.
MonadAsync m =>
Stream m a -> Stream m a -> Stream m a
`parallel` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right (forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stdoutH)
    run (a, Maybe Handle, Maybe Handle, d)
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"toChunksEitherWith: Not reachable"

{-# INLINE toChunksWith #-}
toChunksWith ::
    (MonadCatch m, MonadAsync m)
    => (Config -> Config)   -- ^ Config modifier
    -> FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Array Word8)    -- ^ Output stream
toChunksWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath -> [FilePath] -> Stream m (Array Word8)
toChunksWith Config -> Config
modifier FilePath
path [FilePath]
args =
    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 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 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
_) = forall (m :: * -> *).
MonadAsync m =>
Handle -> Stream m (Array Word8)
toChunksClose Handle
stdoutH
    run (a, Maybe Handle, c, d)
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"toChunksWith: Not reachable"

-- | @toBytesEither path args@ runs the executable at @path@ using @args@ as
-- arguments and returns a stream of 'Either' bytes. The 'Left' values are from
-- @stderr@ and the 'Right' values are from @stdout@ of the executable.
--
-- Raises 'ProcessFailure' exception in case of failure.
--
-- The following example uses @echo@ to write @hello@ to @stdout@ and @world@
-- to @stderr@, then uses folds from "Streamly.Console.Stdio" to write them
-- back to @stdout@ and @stderr@ respectively:
--
-- >>> :{
--   Process.toBytesEither "/bin/bash" ["-c", "echo 'hello'; echo 'world' 1>&2"]
-- & Stream.fold (Fold.partition Stdio.writeErr Stdio.write)
-- :}
-- world
-- hello
-- ((),())
--
-- @since 0.1.0
{-# INLINE toBytesEither #-}
toBytesEither ::
    (MonadAsync m, MonadCatch m)
    => FilePath     -- ^ Executable name or path
    -> [String]     -- ^ Arguments
    -> Stream m (Either Word8 Word8)    -- ^ Output Stream
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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader
        rightRdr :: Unfold m (Array Word8) (Either a Word8)
rightRdr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader
     in forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
Stream.unfoldMany (forall (m :: * -> *) a c b.
Applicative m =>
Unfold m a c -> Unfold m b c -> Unfold m (Either a b) c
Unfold.either forall {b}. Unfold m (Array Word8) (Either Word8 b)
leftRdr forall {a}. Unfold m (Array Word8) (Either a Word8)
rightRdr) Stream m (Either (Array Word8) (Array Word8))
output

-- | The following code is equivalent to the shell command @echo "hello
-- world"@:
--
-- >>> :{
--    Process.toBytes "echo" ["hello world"]
--  & Stream.fold Stdio.write
--  :}
--hello world
--
-- @since 0.1.0
{-# INLINE toBytes #-}
toBytes ::
    (MonadAsync m, MonadCatch m)
    => FilePath     -- ^ Executable name or path
    -> [String]     -- ^ Arguments
    -> Stream m Word8    -- ^ Output Stream
toBytes :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Word8
toBytes FilePath
path [FilePath]
args =
    let output :: Stream m (Array Word8)
output = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Array Word8)
toChunks FilePath
path [FilePath]
args
     in forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
Stream.unfoldMany forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
Array.reader Stream m (Array Word8)
output

-- | Like 'toBytes' but generates a stream of @Array Word8@ instead of a stream
-- of @Word8@.
--
-- >>> :{
--   toChunksEither "bash" ["-c", "echo 'hello'; echo 'world' 1>&2"]
-- & Stream.fold (Fold.partition Stdio.writeErrChunks Stdio.writeChunks)
-- :}
-- world
-- hello
-- ((),())
--
-- >>> toChunksEither = toChunksEitherWith id
--
-- Prefer 'toChunksEither over 'toBytesEither when performance matters.
--
-- /Pre-release/
{-# INLINE toChunksEither #-}
toChunksEither ::
    (MonadAsync m, MonadCatch m)
    => FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Either (Array Word8) (Array Word8))    -- ^ Output Stream
toChunksEither :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath
-> [FilePath] -> Stream m (Either (Array Word8) (Array Word8))
toChunksEither = forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath
-> [FilePath]
-> Stream m (Either (Array Word8) (Array Word8))
toChunksEitherWith forall a. a -> a
id

-- | The following code is equivalent to the shell command @echo "hello
-- world"@:
--
-- >>> :{
--    Process.toChunks "echo" ["hello world"]
--  & Stream.fold Stdio.writeChunks
--  :}
--hello world
--
-- >>> toChunks = toChunksWith id
--
-- @since 0.1.0
{-# INLINE toChunks #-}
toChunks ::
    (MonadAsync m, MonadCatch m)
    => FilePath             -- ^ Executable name or path
    -> [String]             -- ^ Arguments
    -> Stream m (Array Word8)    -- ^ Output Stream
toChunks :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Array Word8)
toChunks = forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> FilePath -> [FilePath] -> Stream m (Array Word8)
toChunksWith forall a. a -> a
id

-- |
-- >>> toChars path args = toBytes path args & Unicode.decodeUtf8
--
{-# INLINE toChars #-}
toChars ::
    (MonadAsync m, MonadCatch m)
    => FilePath       -- ^ Executable name or path
    -> [String]       -- ^ Arguments
    -> Stream m Char -- ^ Output Stream
toChars :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Char
toChars FilePath
path [FilePath]
args = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Word8
toBytes FilePath
path [FilePath]
args forall a b. a -> (a -> b) -> b
& forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
Unicode.decodeUtf8

-- |
-- >>> toLines path args f = toChars path args & Unicode.lines f
--
{-# INLINE toLines #-}
toLines ::
    (MonadAsync m, MonadCatch m)
    => Fold m Char a
    -> FilePath       -- ^ Executable name or path
    -> [String]       -- ^ Arguments
    -> Stream m a -- ^ Output Stream
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 = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Char
toChars FilePath
path [FilePath]
args forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) b.
Monad m =>
Fold m Char b -> Stream m Char -> Stream m b
Unicode.lines Fold m Char a
f

-- |
-- >>> toString path args = toChars path args & Stream.fold Fold.toList
--
{-# INLINE toString #-}
toString ::
    (MonadAsync m, MonadCatch m)
    => FilePath -- ^ Executable name or path
    -> [String] -- ^ Arguments
    -> m String
toString :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> m FilePath
toString FilePath
path [FilePath]
args = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m Char
toChars FilePath
path [FilePath]
args forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList

-- |
-- >>> toStdout path args = toChunks path args & Stdio.putChunks
--
{-# INLINE toStdout #-}
toStdout ::
    (MonadAsync m, MonadCatch m)
    => FilePath -- ^ Executable name or path
    -> [String] -- ^ Arguments
    -> m ()
toStdout :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> m ()
toStdout FilePath
path [FilePath]
args = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Array Word8)
toChunks FilePath
path [FilePath]
args forall a b. a -> (a -> b) -> b
& forall (m :: * -> *). MonadIO m => Stream m (Array Word8) -> m ()
Stdio.putChunks
{-
-- Directly inherits stdout instead.
toStdout path args = do
    _ <- liftIO $ createProc' (inheritStdin . inheritStdout) path args
    return ()
-}

-- |
-- >>> toNull path args = toChunks path args & Stream.fold Fold.drain
--
{-# INLINE toNull #-}
toNull ::
    (MonadAsync m, MonadCatch m)
    => FilePath -- ^ Executable name or path
    -> [String] -- ^ Arguments
    -> m ()
toNull :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> m ()
toNull FilePath
path [FilePath]
args = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> [FilePath] -> Stream m (Array Word8)
toChunks FilePath
path [FilePath]
args forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold forall (m :: * -> *) a. Monad m => Fold m a ()
Fold.drain

-------------------------------------------------------------------------------
-- Process not interacting with the parent process
-------------------------------------------------------------------------------

{-# INLINE standalone #-}
standalone ::
       Bool -- ^ Wait for process to finish?
    -> (Bool, Bool, Bool) -- ^ close (stdin, stdout, stderr)
    -> (Config -> Config)
    -> FilePath -- ^ Executable name or path
    -> [String] -- ^ Arguments
    -> 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 =
    forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
cfg 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
procHandle
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ProcessHandle
procHandle

    cfg :: CreateProcess
cfg =
        let Config CreateProcess
c = Config -> Config
modCfg 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}

-- | Inherits stdin, stdout, and stderr from the parent, so that the user can
-- interact with the process, user interrupts are handled by the child process,
-- the parent waits for the child process to exit.
--
-- This is same as the common @system@ function found in other libraries used
-- to execute commands.
--
-- On Windows you can pass @setSession NewConsole@ to create a new console.
--
{-# INLINE interactive #-}
interactive ::
       (Config -> Config)
    -> FilePath -- ^ Executable name or path
    -> [String] -- ^ Arguments
    -> IO ExitCode
interactive :: (Config -> Config) -> FilePath -> [FilePath] -> IO ExitCode
interactive Config -> Config
modCfg FilePath
path [FilePath]
args =
    forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
cfg (\Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ ProcessHandle
p -> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p)

    where

    -- let child handle SIGINT/QUIT
    modCfg1 :: Config -> Config
modCfg1 = (Bool -> Config -> Config
parentIgnoresInterrupt Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
modCfg)

    cfg :: CreateProcess
cfg =
        let Config CreateProcess
c = Config -> Config
modCfg1 forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> Config
mkConfig FilePath
path [FilePath]
args
        in CreateProcess
c {std_in :: StdStream
std_in = StdStream
Inherit, std_out :: StdStream
std_out = StdStream
Inherit, std_err :: StdStream
std_err = StdStream
Inherit}

-- XXX ProcessHandle can be used to terminate the process. re-export
-- terminateProcess?

-- | Closes stdin, stdout and stderr, creates a new session, detached from the
-- terminal, the parent does not wait for the process to finish.
--
{-# INLINE daemon #-}
daemon ::
       (Config -> Config)
    -> FilePath -- ^ Executable name or path
    -> [String] -- ^ Arguments
    -> IO ProcessHandle
daemon :: (Config -> Config) -> FilePath -> [FilePath] -> IO ProcessHandle
daemon Config -> Config
modCfg FilePath
path [FilePath]
args = forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
cfg (\Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ ProcessHandle
p -> forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
p)

    where

    -- Detach terminal
    modCfg1 :: Config -> Config
modCfg1 = (Session -> Config -> Config
setSession Session
NewSession forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
modCfg)

    cfg :: CreateProcess
cfg =
        let Config CreateProcess
c = Config -> Config
modCfg1 forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> Config
mkConfig FilePath
path [FilePath]
args
        in CreateProcess
c {std_in :: StdStream
std_in = StdStream
NoStream, std_out :: StdStream
std_out = StdStream
NoStream, std_err :: StdStream
std_err = StdStream
NoStream}