{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | This module is __internal__ and its contents may change without a warning
-- or announcement. It is not subject to the PVP.
module System.Process.Typed.Internal where

import qualified Data.ByteString as S
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import qualified Control.Exception as E
import Control.Exception hiding (bracket, finally, handle)
import Control.Monad (void)
import qualified System.Process as P
import Data.Typeable (Typeable)
import System.IO (Handle, hClose, IOMode(ReadWriteMode), withBinaryFile)
import Control.Concurrent.Async (async)
import Control.Concurrent.STM (newEmptyTMVarIO, atomically, putTMVar, readTMVar, STM, tryPutTMVar, throwSTM)
import System.Exit (ExitCode)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.String (IsString (fromString))
import Control.Monad.IO.Unlift

#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
import System.Posix.Types (GroupID, UserID)
#endif

#if !MIN_VERSION_base(4, 8, 0)
import Control.Applicative (Applicative (..), (<$>), (<$))
#endif

#if !MIN_VERSION_process(1, 3, 0)
import qualified System.Process.Internals as P (createProcess_)
#endif

-- | An abstract configuration for a process, which can then be
-- launched into an actual running 'Process'. Takes three type
-- parameters, providing the types of standard input, standard output,
-- and standard error, respectively.
--
-- There are three ways to construct a value of this type:
--
-- * With the 'proc' smart constructor, which takes a command name and
-- a list of arguments.
--
-- * With the 'shell' smart constructor, which takes a shell string
--
-- * With the 'IsString' instance via OverloadedStrings. If you
-- provide it a string with no spaces (e.g., @"date"@), it will
-- treat it as a raw command with no arguments (e.g., @proc "date"
-- []@). If it has spaces, it will use @shell@.
--
-- In all cases, the default for all three streams is to inherit the
-- streams from the parent process. For other settings, see the
-- [setters below](#processconfigsetters) for default values.
--
-- Once you have a @ProcessConfig@ you can launch a process from it
-- using the functions in the section [Launch a
-- process](#launchaprocess).
--
-- @since 0.1.0.0
data ProcessConfig stdin stdout stderr = ProcessConfig
    { forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> CmdSpec
pcCmdSpec :: !P.CmdSpec
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> StreamSpec 'STInput stdin
pcStdin :: !(StreamSpec 'STInput stdin)
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> StreamSpec 'STOutput stdout
pcStdout :: !(StreamSpec 'STOutput stdout)
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> StreamSpec 'STOutput stderr
pcStderr :: !(StreamSpec 'STOutput stderr)
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe FilePath
pcWorkingDir :: !(Maybe FilePath)
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe [(FilePath, FilePath)]
pcEnv :: !(Maybe [(String, String)])
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcCloseFds :: !Bool
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcCreateGroup :: !Bool
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcDelegateCtlc :: !Bool

#if MIN_VERSION_process(1, 3, 0)
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcDetachConsole :: !Bool
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcCreateNewConsole :: !Bool
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Bool
pcNewSession :: !Bool
#endif

#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe GroupID
pcChildGroup :: !(Maybe GroupID)
    , forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe UserID
pcChildUser :: !(Maybe UserID)
#endif
    }
instance Show (ProcessConfig stdin stdout stderr) where
    show :: ProcessConfig stdin stdout stderr -> FilePath
show ProcessConfig stdin stdout stderr
pc = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ case forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> CmdSpec
pcCmdSpec ProcessConfig stdin stdout stderr
pc of
            P.ShellCommand FilePath
s -> FilePath
"Shell command: " forall a. [a] -> [a] -> [a]
++ FilePath
s
            P.RawCommand FilePath
x [FilePath]
xs -> FilePath
"Raw command: " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map ShowS
escape (FilePath
xforall a. a -> [a] -> [a]
:[FilePath]
xs))
        , FilePath
"\n"
        , case forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe FilePath
pcWorkingDir ProcessConfig stdin stdout stderr
pc of
            Maybe FilePath
Nothing -> FilePath
""
            Just FilePath
wd -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ FilePath
"Run from: "
                , FilePath
wd
                , FilePath
"\n"
                ]
        , case forall stdin stdout stderr.
ProcessConfig stdin stdout stderr -> Maybe [(FilePath, FilePath)]
pcEnv ProcessConfig stdin stdout stderr
pc of
            Maybe [(FilePath, FilePath)]
Nothing -> FilePath
""
            Just [(FilePath, FilePath)]
e -> [FilePath] -> FilePath
unlines
                forall a b. (a -> b) -> a -> b
$ FilePath
"Modified environment:"
                forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
k, FilePath
v) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
k, FilePath
"=", FilePath
v]) [(FilePath, FilePath)]
e
        ]
      where
        escape :: ShowS
escape FilePath
x
            | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
" \\\"'") FilePath
x = forall a. Show a => a -> FilePath
show FilePath
x
            | FilePath
x forall a. Eq a => a -> a -> Bool
== FilePath
"" = FilePath
"\"\""
            | Bool
otherwise = FilePath
x
instance (stdin ~ (), stdout ~ (), stderr ~ ())
  => IsString (ProcessConfig stdin stdout stderr) where
    fromString :: FilePath -> ProcessConfig stdin stdout stderr
fromString FilePath
s
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
' ') FilePath
s = FilePath -> ProcessConfig () () ()
shell FilePath
s
        | Bool
otherwise = FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
s []

-- | Whether a stream is an input stream or output stream. Note that
-- this is from the perspective of the /child process/, so that a
-- child's standard input stream is an @STInput@, even though the
-- parent process will be writing to it.
--
-- @since 0.1.0.0
data StreamType = STInput | STOutput

-- | A specification for how to create one of the three standard child
-- streams, @stdin@, @stdout@ and @stderr@. A 'StreamSpec' can be
-- thought of as containing
--
-- 1. A type safe version of 'P.StdStream' from "System.Process".
-- This determines whether the stream should be inherited from the
-- parent process, piped to or from a 'Handle', etc.
--
-- 2. A means of accessing the stream as a value of type @a@
--
-- 3. A cleanup action which will be run on the stream once the
-- process terminates
--
-- To create a @StreamSpec@ see the section [Stream
-- specs](#streamspecs).
--
-- @since 0.1.0.0
data StreamSpec (streamType :: StreamType) a = StreamSpec
    { forall (streamType :: StreamType) a.
StreamSpec streamType a -> forall b. (StdStream -> IO b) -> IO b
ssStream :: !(forall b. (P.StdStream -> IO b) -> IO b)
    , forall (streamType :: StreamType) a.
StreamSpec streamType a
-> ProcessConfig () () () -> Maybe Handle -> Cleanup a
ssCreate :: !(ProcessConfig () () () -> Maybe Handle -> Cleanup a)
    }
    deriving forall a b. a -> StreamSpec streamType b -> StreamSpec streamType a
forall a b.
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
forall (streamType :: StreamType) a b.
a -> StreamSpec streamType b -> StreamSpec streamType a
forall (streamType :: StreamType) a b.
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> StreamSpec streamType b -> StreamSpec streamType a
$c<$ :: forall (streamType :: StreamType) a b.
a -> StreamSpec streamType b -> StreamSpec streamType a
fmap :: forall a b.
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
$cfmap :: forall (streamType :: StreamType) a b.
(a -> b) -> StreamSpec streamType a -> StreamSpec streamType b
Functor

-- | This instance uses 'byteStringInput' to convert a raw string into
-- a stream of input for a child process.
--
-- @since 0.1.0.0
instance (streamType ~ 'STInput, res ~ ())
  => IsString (StreamSpec streamType res) where
    fromString :: FilePath -> StreamSpec streamType res
fromString = ByteString -> StreamSpec 'STInput ()
byteStringInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => FilePath -> a
fromString

-- | Internal type, to make for easier composition of cleanup actions.
--
-- @since 0.1.0.0
newtype Cleanup a = Cleanup { forall a. Cleanup a -> IO (a, IO ())
runCleanup :: IO (a, IO ()) }
    deriving forall a b. a -> Cleanup b -> Cleanup a
forall a b. (a -> b) -> Cleanup a -> Cleanup b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Cleanup b -> Cleanup a
$c<$ :: forall a b. a -> Cleanup b -> Cleanup a
fmap :: forall a b. (a -> b) -> Cleanup a -> Cleanup b
$cfmap :: forall a b. (a -> b) -> Cleanup a -> Cleanup b
Functor
instance Applicative Cleanup where
    pure :: forall a. a -> Cleanup a
pure a
x = forall a. IO (a, IO ()) -> Cleanup a
Cleanup (forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, forall (m :: * -> *) a. Monad m => a -> m a
return ()))
    Cleanup IO (a -> b, IO ())
f <*> :: forall a b. Cleanup (a -> b) -> Cleanup a -> Cleanup b
<*> Cleanup IO (a, IO ())
x = forall a. IO (a, IO ()) -> Cleanup a
Cleanup forall a b. (a -> b) -> a -> b
$ do
        (a -> b
f', IO ()
c1) <- IO (a -> b, IO ())
f
        (forall a b. IO a -> IO b -> IO a
`onException` IO ()
c1) forall a b. (a -> b) -> a -> b
$ do
            (a
x', IO ()
c2) <- IO (a, IO ())
x
            forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f' a
x', IO ()
c1 forall (m :: * -> *) a. MonadUnliftIO m => m a -> IO () -> m a
`finally` IO ()
c2)

-- | Internal helper
defaultProcessConfig :: ProcessConfig () () ()
defaultProcessConfig :: ProcessConfig () () ()
defaultProcessConfig = ProcessConfig
    { pcCmdSpec :: CmdSpec
pcCmdSpec = FilePath -> CmdSpec
P.ShellCommand FilePath
""
    , pcStdin :: StreamSpec 'STInput ()
pcStdin = forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
    , pcStdout :: StreamSpec 'STOutput ()
pcStdout = forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
    , pcStderr :: StreamSpec 'STOutput ()
pcStderr = forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit
    , pcWorkingDir :: Maybe FilePath
pcWorkingDir = forall a. Maybe a
Nothing
    , pcEnv :: Maybe [(FilePath, FilePath)]
pcEnv = forall a. Maybe a
Nothing
    , pcCloseFds :: Bool
pcCloseFds = Bool
False
    , pcCreateGroup :: Bool
pcCreateGroup = Bool
False
    , pcDelegateCtlc :: Bool
pcDelegateCtlc = Bool
False

#if MIN_VERSION_process(1, 3, 0)
    , pcDetachConsole :: Bool
pcDetachConsole = Bool
False
    , pcCreateNewConsole :: Bool
pcCreateNewConsole = Bool
False
    , pcNewSession :: Bool
pcNewSession = Bool
False
#endif

#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
    , pcChildGroup :: Maybe GroupID
pcChildGroup = forall a. Maybe a
Nothing
    , pcChildUser :: Maybe UserID
pcChildUser = forall a. Maybe a
Nothing
#endif
    }

-- | Create a 'ProcessConfig' from the given command and arguments.
--
-- @since 0.1.0.0
proc :: FilePath -> [String] -> ProcessConfig () () ()
proc :: FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
cmd [FilePath]
args = forall stdin stdout stderr.
FilePath
-> [FilePath]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setProc FilePath
cmd [FilePath]
args ProcessConfig () () ()
defaultProcessConfig

-- | Internal helper
setProc :: FilePath -> [String]
        -> ProcessConfig stdin stdout stderr
        -> ProcessConfig stdin stdout stderr
setProc :: forall stdin stdout stderr.
FilePath
-> [FilePath]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setProc FilePath
cmd [FilePath]
args ProcessConfig stdin stdout stderr
p = ProcessConfig stdin stdout stderr
p { pcCmdSpec :: CmdSpec
pcCmdSpec = FilePath -> [FilePath] -> CmdSpec
P.RawCommand FilePath
cmd [FilePath]
args }

-- | Create a 'ProcessConfig' from the given shell command.
--
-- @since 0.1.0.0
shell :: String -> ProcessConfig () () ()
shell :: FilePath -> ProcessConfig () () ()
shell FilePath
cmd = forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setShell FilePath
cmd ProcessConfig () () ()
defaultProcessConfig

-- | Internal helper
setShell :: String
         -> ProcessConfig stdin stdout stderr
         -> ProcessConfig stdin stdout stderr
setShell :: forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setShell FilePath
cmd ProcessConfig stdin stdout stderr
p = ProcessConfig stdin stdout stderr
p { pcCmdSpec :: CmdSpec
pcCmdSpec = FilePath -> CmdSpec
P.ShellCommand FilePath
cmd }

-- | Set the child's standard input stream to the given 'StreamSpec'.
--
-- Default: 'inherit'
--
-- @since 0.1.0.0
setStdin :: StreamSpec 'STInput stdin
         -- ^ 
         -> ProcessConfig stdin0 stdout stderr
         -- ^ 
         -> ProcessConfig stdin stdout stderr
setStdin :: forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin StreamSpec 'STInput stdin
spec ProcessConfig stdin0 stdout stderr
pc = ProcessConfig stdin0 stdout stderr
pc { pcStdin :: StreamSpec 'STInput stdin
pcStdin = StreamSpec 'STInput stdin
spec }

-- | Set the child's standard output stream to the given 'StreamSpec'.
--
-- Default: 'inherit'
--
-- @since 0.1.0.0
setStdout :: StreamSpec 'STOutput stdout
          -- ^ 
          -> ProcessConfig stdin stdout0 stderr
          -- ^ 
          -> ProcessConfig stdin stdout stderr
setStdout :: forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput stdout
spec ProcessConfig stdin stdout0 stderr
pc = ProcessConfig stdin stdout0 stderr
pc { pcStdout :: StreamSpec 'STOutput stdout
pcStdout = StreamSpec 'STOutput stdout
spec }

-- | Set the child's standard error stream to the given 'StreamSpec'.
--
-- Default: 'inherit'
--
-- @since 0.1.0.0
setStderr :: StreamSpec 'STOutput stderr
          -- ^ 
          -> ProcessConfig stdin stdout stderr0
          -- ^ 
          -> ProcessConfig stdin stdout stderr
setStderr :: forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput stderr
spec ProcessConfig stdin stdout stderr0
pc = ProcessConfig stdin stdout stderr0
pc { pcStderr :: StreamSpec 'STOutput stderr
pcStderr = StreamSpec 'STOutput stderr
spec }

-- | Set the working directory of the child process.
--
-- Default: current process's working directory.
--
-- @since 0.1.0.0
setWorkingDir :: FilePath
              -- ^ 
              -> ProcessConfig stdin stdout stderr
              -- ^ 
              -> ProcessConfig stdin stdout stderr
setWorkingDir :: forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir FilePath
dir ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcWorkingDir :: Maybe FilePath
pcWorkingDir = forall a. a -> Maybe a
Just FilePath
dir }

-- | Inherit the working directory from the parent process.
--
-- @since 0.2.2.0
setWorkingDirInherit
  :: ProcessConfig stdin stdout stderr
  -- ^ 
  -> ProcessConfig stdin stdout stderr
setWorkingDirInherit :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDirInherit ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcWorkingDir :: Maybe FilePath
pcWorkingDir = forall a. Maybe a
Nothing }

-- | Set the environment variables of the child process.
--
-- Default: current process's environment.
--
-- @since 0.1.0.0
setEnv :: [(String, String)]
       -- ^ 
       -> ProcessConfig stdin stdout stderr
       -- ^ 
       -> ProcessConfig stdin stdout stderr
setEnv :: forall stdin stdout stderr.
[(FilePath, FilePath)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(FilePath, FilePath)]
env ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcEnv :: Maybe [(FilePath, FilePath)]
pcEnv = forall a. a -> Maybe a
Just [(FilePath, FilePath)]
env }

-- | Inherit the environment variables from the parent process.
--
-- @since 0.2.2.0
setEnvInherit
  :: ProcessConfig stdin stdout stderr
  -- ^ 
  -> ProcessConfig stdin stdout stderr
setEnvInherit :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnvInherit ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcEnv :: Maybe [(FilePath, FilePath)]
pcEnv = forall a. Maybe a
Nothing }

-- | Should we close all file descriptors besides stdin, stdout, and
-- stderr? See 'P.close_fds' for more information.
--
-- Default: False
--
-- @since 0.1.0.0
setCloseFds
    :: Bool
    -- ^ 
    -> ProcessConfig stdin stdout stderr
    -- ^ 
    -> ProcessConfig stdin stdout stderr
setCloseFds :: forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCloseFds Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcCloseFds :: Bool
pcCloseFds = Bool
x }

-- | Should we create a new process group?
--
-- Default: False
--
-- @since 0.1.0.0
setCreateGroup
    :: Bool
    -- ^ 
    -> ProcessConfig stdin stdout stderr
    -- ^ 
    -> ProcessConfig stdin stdout stderr
setCreateGroup :: forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCreateGroup Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcCreateGroup :: Bool
pcCreateGroup = Bool
x }

-- | Delegate handling of Ctrl-C to the child. For more information,
-- see 'P.delegate_ctlc'.
--
-- Default: False
--
-- @since 0.1.0.0
setDelegateCtlc
    :: Bool
    -- ^ 
    -> ProcessConfig stdin stdout stderr
    -- ^ 
    -> ProcessConfig stdin stdout stderr
setDelegateCtlc :: forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setDelegateCtlc Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcDelegateCtlc :: Bool
pcDelegateCtlc = Bool
x }

#if MIN_VERSION_process(1, 3, 0)

-- | Detach console on Windows, see 'P.detach_console'.
--
-- Default: False
--
-- @since 0.1.0.0
setDetachConsole
    :: Bool
    -- ^ 
    -> ProcessConfig stdin stdout stderr
    -- ^ 
    -> ProcessConfig stdin stdout stderr
setDetachConsole :: forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setDetachConsole Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcDetachConsole :: Bool
pcDetachConsole = Bool
x }

-- | Create new console on Windows, see 'P.create_new_console'.
--
-- Default: False
--
-- @since 0.1.0.0
setCreateNewConsole
    :: Bool
    -- ^ 
    -> ProcessConfig stdin stdout stderr
    -- ^ 
    -> ProcessConfig stdin stdout stderr
setCreateNewConsole :: forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setCreateNewConsole Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcCreateNewConsole :: Bool
pcCreateNewConsole = Bool
x }

-- | Set a new session with the POSIX @setsid@ syscall, does nothing
-- on non-POSIX. See 'P.new_session'.
--
-- Default: False
--
-- @since 0.1.0.0
setNewSession
    :: Bool
    -- ^ 
    -> ProcessConfig stdin stdout stderr
    -- ^ 
    -> ProcessConfig stdin stdout stderr
setNewSession :: forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setNewSession Bool
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcNewSession :: Bool
pcNewSession = Bool
x }
#endif

#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
-- | Set the child process's group ID with the POSIX @setgid@ syscall,
-- does nothing on non-POSIX. See 'P.child_group'.
--
-- Default: False
--
-- @since 0.1.0.0
setChildGroup
    :: GroupID
    -- ^ 
    -> ProcessConfig stdin stdout stderr
    -- ^ 
    -> ProcessConfig stdin stdout stderr
setChildGroup :: forall stdin stdout stderr.
GroupID
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildGroup GroupID
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcChildGroup :: Maybe GroupID
pcChildGroup = forall a. a -> Maybe a
Just GroupID
x }

-- | Inherit the group from the parent process.
--
-- @since 0.2.2.0
setChildGroupInherit
  :: ProcessConfig stdin stdout stderr
  -- ^ 
  -> ProcessConfig stdin stdout stderr
setChildGroupInherit :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildGroupInherit ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcChildGroup :: Maybe GroupID
pcChildGroup = forall a. Maybe a
Nothing }

-- | Set the child process's user ID with the POSIX @setuid@ syscall,
-- does nothing on non-POSIX. See 'P.child_user'.
--
-- Default: False
--
-- @since 0.1.0.0
setChildUser
    :: UserID
    -- ^ 
    -> ProcessConfig stdin stdout stderr
    -- ^ 
    -> ProcessConfig stdin stdout stderr
setChildUser :: forall stdin stdout stderr.
UserID
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildUser UserID
x ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcChildUser :: Maybe UserID
pcChildUser = forall a. a -> Maybe a
Just UserID
x }

-- | Inherit the user from the parent process.
--
-- @since 0.2.2.0
setChildUserInherit
  :: ProcessConfig stdin stdout stderr
  -- ^ 
  -> ProcessConfig stdin stdout stderr
setChildUserInherit :: forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildUserInherit ProcessConfig stdin stdout stderr
pc = ProcessConfig stdin stdout stderr
pc { pcChildUser :: Maybe UserID
pcChildUser = forall a. Maybe a
Nothing }
#endif

-- | Create a new 'StreamSpec' from the given 'P.StdStream' and a
-- helper function. This function:
--
-- * Takes as input the raw @Maybe Handle@ returned by the
-- 'P.createProcess' function. The handle will be @Just@ 'Handle' if the
-- 'P.StdStream' argument is 'P.CreatePipe' and @Nothing@ otherwise.
-- See 'P.createProcess' for more details.
--
-- * Returns the actual stream value @a@, as well as a cleanup
-- function to be run when calling 'stopProcess'.
--
-- If making a 'StreamSpec' with 'P.CreatePipe', prefer 'mkPipeStreamSpec',
-- which encodes the invariant that a 'Handle' is created.
--
-- @since 0.1.0.0
mkStreamSpec :: P.StdStream
             -- ^ 
             -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
             -- ^ 
             -> StreamSpec streamType a
mkStreamSpec :: forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
ss ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())
f = forall a (streamType :: StreamType).
(forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkManagedStreamSpec (forall a b. (a -> b) -> a -> b
$ StdStream
ss) ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())
f

-- | Create a new 'P.CreatePipe' 'StreamSpec' from the given function.
-- This function:
--
-- * Takes as input the @Handle@ returned by the 'P.createProcess' function.
-- See 'P.createProcess' for more details.
--
-- * Returns the actual stream value @a@, as well as a cleanup
-- function to be run when calling 'stopProcess'.
--
-- @since 0.2.10.0
mkPipeStreamSpec :: (ProcessConfig () () () -> Handle -> IO (a, IO ()))
                 -- ^ 
                 -> StreamSpec streamType a
                 -- ^ 
mkPipeStreamSpec :: forall a (streamType :: StreamType).
(ProcessConfig () () () -> Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkPipeStreamSpec ProcessConfig () () () -> Handle -> IO (a, IO ())
f = forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
P.CreatePipe forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc Maybe Handle
mh ->
    case Maybe Handle
mh of
        Just Handle
h -> ProcessConfig () () () -> Handle -> IO (a, IO ())
f ProcessConfig () () ()
pc Handle
h
        Maybe Handle
Nothing -> forall a. HasCallStack => FilePath -> a
error FilePath
"Invariant violation: making StreamSpec with CreatePipe unexpectedly did not return a Handle"

-- | Create a new 'StreamSpec' from a function that accepts a
-- 'P.StdStream' and a helper function.  This function is the same as
-- the helper in 'mkStreamSpec'
mkManagedStreamSpec :: (forall b. (P.StdStream -> IO b) -> IO b)
                    -- ^ 
                    -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
                    -- ^ 
                    -> StreamSpec streamType a
mkManagedStreamSpec :: forall a (streamType :: StreamType).
(forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkManagedStreamSpec forall b. (StdStream -> IO b) -> IO b
ss ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())
f = forall (streamType :: StreamType) a.
(forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> Cleanup a)
-> StreamSpec streamType a
StreamSpec forall b. (StdStream -> IO b) -> IO b
ss (\ProcessConfig () () ()
pc Maybe Handle
mh -> forall a. IO (a, IO ()) -> Cleanup a
Cleanup (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())
f ProcessConfig () () ()
pc Maybe Handle
mh))

-- | A stream spec which simply inherits the stream of the parent
-- process.
--
-- @since 0.1.0.0
inherit :: StreamSpec anyStreamType ()
inherit :: forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit = forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
P.Inherit (\ProcessConfig () () ()
_ Maybe Handle
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), forall (m :: * -> *) a. Monad m => a -> m a
return ()))

-- | A stream spec which is empty when used for for input and discards
-- output.  Note this requires your platform's null device to be
-- available when the process is started.
--
-- @since 0.2.5.0
nullStream :: StreamSpec anyStreamType ()
nullStream :: forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream = forall a (streamType :: StreamType).
(forall b. (StdStream -> IO b) -> IO b)
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkManagedStreamSpec forall b. (StdStream -> IO b) -> IO b
opener forall {m :: * -> *} {f :: * -> *} {p} {p}.
(Monad m, Applicative f) =>
p -> p -> f ((), m ())
cleanup
  where
    opener :: (StdStream -> IO r) -> IO r
opener StdStream -> IO r
f =
      forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
nullDevice IOMode
ReadWriteMode forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
        StdStream -> IO r
f (Handle -> StdStream
P.UseHandle Handle
handle)
    cleanup :: p -> p -> f ((), m ())
cleanup p
_ p
_ =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | A stream spec which will close the stream for the child process.
-- You usually do not want to use this, as it will leave the
-- corresponding file descriptor unassigned and hence available for
-- re-use in the child process.  Prefer 'nullStream' unless you're
-- certain you want this behavior.
--
-- @since 0.1.0.0
closed :: StreamSpec anyStreamType ()
#if MIN_VERSION_process(1, 4, 0)
closed :: forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed = forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec StdStream
P.NoStream (\ProcessConfig () () ()
_ Maybe Handle
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), forall (m :: * -> *) a. Monad m => a -> m a
return ()))
#else
closed = mkPipeStreamSpec (\_ h -> ((), return ()) <$ hClose h)
#endif

-- | An input stream spec which sets the input to the given
-- 'L.ByteString'. A separate thread will be forked to write the
-- contents to the child process.
--
-- @since 0.1.0.0
byteStringInput :: L.ByteString -> StreamSpec 'STInput ()
byteStringInput :: ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
lbs = forall a (streamType :: StreamType).
(ProcessConfig () () () -> Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkPipeStreamSpec forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
_ Handle
h -> do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ do
        Handle -> ByteString -> IO ()
L.hPut Handle
h ByteString
lbs
        Handle -> IO ()
hClose Handle
h
    forall (m :: * -> *) a. Monad m => a -> m a
return ((), Handle -> IO ()
hClose Handle
h)

-- | Capture the output of a process in a 'L.ByteString'.
--
-- This function will fork a separate thread to consume all input from
-- the process, and will only make the results available when the
-- underlying 'Handle' is closed. As this is provided as an 'STM'
-- action, you can either check if the result is available, or block
-- until it's ready.
--
-- In the event of any exception occurring when reading from the
-- 'Handle', the 'STM' action will throw a
-- 'ByteStringOutputException'.
--
-- @since 0.1.0.0
byteStringOutput :: StreamSpec 'STOutput (STM L.ByteString)
byteStringOutput :: StreamSpec 'STOutput (STM ByteString)
byteStringOutput = forall a (streamType :: StreamType).
(ProcessConfig () () () -> Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkPipeStreamSpec forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc Handle
h -> ProcessConfig () () () -> Handle -> IO (STM ByteString, IO ())
byteStringFromHandle ProcessConfig () () ()
pc Handle
h

-- | Helper function (not exposed) for both 'byteStringOutput' and
-- 'withProcessInterleave'. This will consume all of the output from
-- the given 'Handle' in a separate thread and provide access to the
-- resulting 'L.ByteString' via STM. Second action will close the
-- reader handle.
byteStringFromHandle
  :: ProcessConfig () () ()
  -> Handle -- ^ reader handle
  -> IO (STM L.ByteString, IO ())
byteStringFromHandle :: ProcessConfig () () () -> Handle -> IO (STM ByteString, IO ())
byteStringFromHandle ProcessConfig () () ()
pc Handle
h = do
    TMVar (Either ByteStringOutputException ByteString)
mvar <- forall a. IO (TMVar a)
newEmptyTMVarIO

    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ do
        let loop :: ([ByteString] -> [ByteString]) -> IO ()
loop [ByteString] -> [ByteString]
front = do
                ByteString
bs <- Handle -> Int -> IO ByteString
S.hGetSome Handle
h Int
defaultChunkSize
                if ByteString -> Bool
S.null ByteString
bs
                    then forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either ByteStringOutputException ByteString)
mvar forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
                    else ([ByteString] -> [ByteString]) -> IO ()
loop forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bsforall a. a -> [a] -> [a]
:)
        ([ByteString] -> [ByteString]) -> IO ()
loop forall a. a -> a
id forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do
            forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar (Either ByteStringOutputException ByteString)
mvar forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException
-> ProcessConfig () () () -> ByteStringOutputException
ByteStringOutputException SomeException
e ProcessConfig () () ()
pc
            forall e a. Exception e => e -> IO a
throwIO SomeException
e

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TMVar a -> STM a
readTMVar TMVar (Either ByteStringOutputException ByteString)
mvar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> STM a
throwSTM forall (m :: * -> *) a. Monad m => a -> m a
return, Handle -> IO ()
hClose Handle
h)

-- | Create a new pipe between this process and the child, and return
-- a 'Handle' to communicate with the child.
--
-- @since 0.1.0.0
createPipe :: StreamSpec anyStreamType Handle
createPipe :: forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe = forall a (streamType :: StreamType).
(ProcessConfig () () () -> Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkPipeStreamSpec forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
_ Handle
h -> forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
h, Handle -> IO ()
hClose Handle
h)

-- | Use the provided 'Handle' for the child process, and when the
-- process exits, do /not/ close it. This is useful if, for example,
-- you want to have multiple processes write to the same log file
-- sequentially.
--
-- @since 0.1.0.0
useHandleOpen :: Handle -> StreamSpec anyStreamType ()
useHandleOpen :: forall (anyStreamType :: StreamType).
Handle -> StreamSpec anyStreamType ()
useHandleOpen Handle
h = forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec (Handle -> StdStream
P.UseHandle Handle
h) forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
_ Maybe Handle
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ((), forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Use the provided 'Handle' for the child process, and when the
-- process exits, close it. If you have no reason to keep the 'Handle'
-- open, you should use this over 'useHandleOpen'.
--
-- @since 0.1.0.0
useHandleClose :: Handle -> StreamSpec anyStreamType ()
useHandleClose :: forall (anyStreamType :: StreamType).
Handle -> StreamSpec anyStreamType ()
useHandleClose Handle
h = forall a (streamType :: StreamType).
StdStream
-> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))
-> StreamSpec streamType a
mkStreamSpec (Handle -> StdStream
P.UseHandle Handle
h) forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
_ Maybe Handle
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ((), Handle -> IO ()
hClose Handle
h)

-- | Exception thrown by 'checkExitCode' in the event of a non-success
-- exit code. Note that 'checkExitCode' is called by other functions
-- as well, like 'runProcess_' or 'readProcess_'.
--
-- Note that several functions that throw an 'ExitCodeException' intentionally do not populate 'eceStdout' or 'eceStderr'.
-- This prevents unbounded memory usage for large stdout and stderrs.
--
-- @since 0.1.0.0
data ExitCodeException = ExitCodeException
    { ExitCodeException -> ExitCode
eceExitCode :: ExitCode
    , ExitCodeException -> ProcessConfig () () ()
eceProcessConfig :: ProcessConfig () () ()
    , ExitCodeException -> ByteString
eceStdout :: L.ByteString
    , ExitCodeException -> ByteString
eceStderr :: L.ByteString
    }
    deriving Typeable
instance Exception ExitCodeException
instance Show ExitCodeException where
    show :: ExitCodeException -> FilePath
show ExitCodeException
ece = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ FilePath
"Received "
        , forall a. Show a => a -> FilePath
show (ExitCodeException -> ExitCode
eceExitCode ExitCodeException
ece)
        , FilePath
" when running\n"
        -- Too much output for an exception if we show the modified
        -- environment, so hide it
        , forall a. Show a => a -> FilePath
show (ExitCodeException -> ProcessConfig () () ()
eceProcessConfig ExitCodeException
ece) { pcEnv :: Maybe [(FilePath, FilePath)]
pcEnv = forall a. Maybe a
Nothing }
        , if ByteString -> Bool
L.null (ExitCodeException -> ByteString
eceStdout ExitCodeException
ece)
            then FilePath
""
            else FilePath
"Standard output:\n\n" forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
L8.unpack (ExitCodeException -> ByteString
eceStdout ExitCodeException
ece)
        , if ByteString -> Bool
L.null (ExitCodeException -> ByteString
eceStderr ExitCodeException
ece)
            then FilePath
""
            else FilePath
"Standard error:\n\n" forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
L8.unpack (ExitCodeException -> ByteString
eceStderr ExitCodeException
ece)
        ]

-- | Wrapper for when an exception is thrown when reading from a child
-- process, used by 'byteStringOutput'.
--
-- @since 0.1.0.0
data ByteStringOutputException = ByteStringOutputException SomeException (ProcessConfig () () ())
    deriving (Int -> ByteStringOutputException -> ShowS
[ByteStringOutputException] -> ShowS
ByteStringOutputException -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ByteStringOutputException] -> ShowS
$cshowList :: [ByteStringOutputException] -> ShowS
show :: ByteStringOutputException -> FilePath
$cshow :: ByteStringOutputException -> FilePath
showsPrec :: Int -> ByteStringOutputException -> ShowS
$cshowsPrec :: Int -> ByteStringOutputException -> ShowS
Show, Typeable)
instance Exception ByteStringOutputException

bracket :: MonadUnliftIO m => IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket :: forall (m :: * -> *) a b c.
MonadUnliftIO m =>
IO a -> (a -> IO b) -> (a -> m c) -> m c
bracket IO a
before a -> IO b
after a -> m c
thing = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO a
before a -> IO b
after (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m c
thing)

finally :: MonadUnliftIO m => m a -> IO () -> m a
finally :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> IO () -> m a
finally m a
thing IO ()
after = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b. IO a -> IO b -> IO a
E.finally (forall a. m a -> IO a
run m a
thing) IO ()
after

-- | The name of the system null device
nullDevice :: FilePath
#if WINDOWS
nullDevice = "\\\\.\\NUL"
#else
nullDevice :: FilePath
nullDevice = FilePath
"/dev/null"
#endif