module RawFilePath.Process.Common
    ( Process(..)
    , ProcessConf(..)
    , proc
    , processStdin
    , processStdout
    , processStderr
    , StreamType
    , mbFd
    , willCreateHandle
    , CreatePipe(..)
    , Inherit(..)
    , NoStream(..)
    , UseHandle(..)
    , setStdin
    , setStdout
    , setStderr

    , PHANDLE
    , ProcessHandle__(..)
    , modifyProcessHandle
    , withProcessHandle
    , fdStdin
    , fdStdout
    , fdStderr
    , mbPipe
    ) where

import RawFilePath.Import

-- extra modules

import GHC.IO.Handle.FD as Module (mkHandleFromFD)
import System.Posix.Internals (FD)
import qualified GHC.IO.FD as FD

-- Original declarations

-- | The process configuration that is needed for creating new processes. Use
-- 'proc' to make one.
data ProcessConf stdin stdout stderr = ProcessConf
    { forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> [ByteString]
cmdargs :: [ByteString]
    -- ^ Executable & arguments, or shell command
    , forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe ByteString
cwd :: Maybe RawFilePath
    -- ^ Optional path to the working directory for the new process
    , forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe [(ByteString, ByteString)]
env :: Maybe [(ByteString, ByteString)]
    -- ^ Optional environment (otherwise inherit from the current process)
    , forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stdin
cfgStdin :: stdin
    -- ^ How to determine stdin
    , forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stdout
cfgStdout :: stdout
    -- ^ How to determine stdout
    , forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stderr
cfgStderr :: stderr
    -- ^ How to determine stderr
    , forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
closeFds :: Bool
    -- ^ Close all file descriptors except stdin, stdout and stderr in the new
    -- process
    , forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
createGroup :: Bool
    -- ^ Create a new process group
    , forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
delegateCtlc :: Bool
    -- ^ Delegate control-C handling. Use this for interactive console
    -- processes to let them handle control-C themselves (see below for
    -- details).
    , forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
createNewConsole :: Bool
    -- ^ Use the windows CREATE_NEW_CONSOLE flag when creating the process;
    -- does nothing on other platforms.
    --
    -- Default: @False@
    , forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
newSession :: Bool
    -- ^ Use posix setsid to start the new process in a new session; does nothing on other platforms.
    , forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe GroupID
childGroup :: Maybe GroupID
    -- ^ Use posix setgid to set child process's group id.
    --
    -- Default: @Nothing@
    , forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe UserID
childUser :: Maybe UserID
    -- ^ Use posix setuid to set child process's user id.
    --
    -- Default: @Nothing@
    }

-- | Create a process configuration with the default settings.
proc
    :: RawFilePath -- ^ Command to run
    -> [ByteString] -- ^ Arguments to the command
    -> ProcessConf Inherit Inherit Inherit
proc :: ByteString -> [ByteString] -> ProcessConf Inherit Inherit Inherit
proc ByteString
cmd [ByteString]
args = ProcessConf
    { cmdargs :: [ByteString]
cmdargs = ByteString
cmd forall a. a -> [a] -> [a]
: [ByteString]
args
    , cwd :: Maybe ByteString
cwd = forall a. Maybe a
Nothing
    , env :: Maybe [(ByteString, ByteString)]
env = forall a. Maybe a
Nothing
    , cfgStdin :: Inherit
cfgStdin = Inherit
Inherit
    , cfgStdout :: Inherit
cfgStdout = Inherit
Inherit
    , cfgStderr :: Inherit
cfgStderr = Inherit
Inherit
    , closeFds :: Bool
closeFds = Bool
False
    , createGroup :: Bool
createGroup = Bool
False
    , delegateCtlc :: Bool
delegateCtlc = Bool
False
    , createNewConsole :: Bool
createNewConsole = Bool
False
    , newSession :: Bool
newSession = Bool
False
    , childGroup :: Maybe GroupID
childGroup = forall a. Maybe a
Nothing
    , childUser :: Maybe UserID
childUser = forall a. Maybe a
Nothing
    }

-- | Control how the standard input of the process will be initialized.
setStdin
    :: (StreamType newStdin)
    => ProcessConf oldStdin stdout stderr
    -> newStdin
    -> ProcessConf newStdin stdout stderr
setStdin :: forall newStdin oldStdin stdout stderr.
StreamType newStdin =>
ProcessConf oldStdin stdout stderr
-> newStdin -> ProcessConf newStdin stdout stderr
setStdin ProcessConf oldStdin stdout stderr
p newStdin
newStdin = ProcessConf oldStdin stdout stderr
p { cfgStdin :: newStdin
cfgStdin = newStdin
newStdin }
infixl 4 `setStdin`

-- | Control how the standard output of the process will be initialized.
setStdout
    :: (StreamType newStdout)
    => ProcessConf stdin oldStdout stderr
    -> newStdout
    -> ProcessConf stdin newStdout stderr
setStdout :: forall newStdout stdin oldStdout stderr.
StreamType newStdout =>
ProcessConf stdin oldStdout stderr
-> newStdout -> ProcessConf stdin newStdout stderr
setStdout ProcessConf stdin oldStdout stderr
p newStdout
newStdout = ProcessConf stdin oldStdout stderr
p { cfgStdout :: newStdout
cfgStdout = newStdout
newStdout }
infixl 4 `setStdout`

-- | Control how the standard error of the process will be initialized.
setStderr
    :: (StreamType newStderr)
    => ProcessConf stdin stdout oldStderr
    -> newStderr
    -> ProcessConf stdin stdout newStderr
setStderr :: forall newStderr stdin stdout oldStderr.
StreamType newStderr =>
ProcessConf stdin stdout oldStderr
-> newStderr -> ProcessConf stdin stdout newStderr
setStderr ProcessConf stdin stdout oldStderr
p newStderr
newStderr = ProcessConf stdin stdout oldStderr
p { cfgStderr :: newStderr
cfgStderr = newStderr
newStderr }
infixl 4 `setStderr`

-- | The process type. The three type variables denote how its standard
-- streams were initialized.
data Process stdin stdout stderr = Process
    { forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin         :: Maybe Handle
    , forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout        :: Maybe Handle
    , forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStderr        :: Maybe Handle
    , forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
phandle           :: !(MVar ProcessHandle__)
    , forall stdin stdout stderr. Process stdin stdout stderr -> Bool
mbDelegateCtlc    :: !Bool
    , forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
waitpidLock       :: !(MVar ())
    }

-- | Take a process and return its standard input handle.
processStdin :: Process CreatePipe stdout stderr -> Handle
processStdin :: forall stdout stderr. Process CreatePipe stdout stderr -> Handle
processStdin Process{Bool
Maybe Handle
MVar ()
MVar ProcessHandle__
waitpidLock :: MVar ()
mbDelegateCtlc :: Bool
phandle :: MVar ProcessHandle__
procStderr :: Maybe Handle
procStdout :: Maybe Handle
procStdin :: Maybe Handle
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
..} = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err Maybe Handle
procStdin
  where
    err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"This can't happen: stdin is CreatePipe but missing"

-- | Take a process and return its standard output handle.
processStdout :: Process stdin CreatePipe stderr -> Handle
processStdout :: forall stdin stderr. Process stdin CreatePipe stderr -> Handle
processStdout Process{Bool
Maybe Handle
MVar ()
MVar ProcessHandle__
waitpidLock :: MVar ()
mbDelegateCtlc :: Bool
phandle :: MVar ProcessHandle__
procStderr :: Maybe Handle
procStdout :: Maybe Handle
procStdin :: Maybe Handle
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
..} = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err Maybe Handle
procStdout
  where
    err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"This can't happen: stdout is CreatePipe but missing"

-- | Take a process and return its standard error handle.
processStderr :: Process stdin stdout CreatePipe -> Handle
processStderr :: forall stdin stdout. Process stdin stdout CreatePipe -> Handle
processStderr Process{Bool
Maybe Handle
MVar ()
MVar ProcessHandle__
waitpidLock :: MVar ()
mbDelegateCtlc :: Bool
phandle :: MVar ProcessHandle__
procStderr :: Maybe Handle
procStdout :: Maybe Handle
procStdin :: Maybe Handle
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
..} = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err Maybe Handle
procStderr
  where
    err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"This can't happen: stderr is CreatePipe but missing"

-- | Create a new pipe for the stream. You get a new 'Handle'.
data CreatePipe = CreatePipe deriving Int -> CreatePipe -> ShowS
[CreatePipe] -> ShowS
CreatePipe -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CreatePipe] -> ShowS
$cshowList :: [CreatePipe] -> ShowS
show :: CreatePipe -> [Char]
$cshow :: CreatePipe -> [Char]
showsPrec :: Int -> CreatePipe -> ShowS
$cshowsPrec :: Int -> CreatePipe -> ShowS
Show
-- | Inherit the parent (current) process handle. The child will share the
-- stream. For example, if the child writes anything to stdout, it will all go
-- to the parent's stdout.
data Inherit = Inherit deriving Int -> Inherit -> ShowS
[Inherit] -> ShowS
Inherit -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Inherit] -> ShowS
$cshowList :: [Inherit] -> ShowS
show :: Inherit -> [Char]
$cshow :: Inherit -> [Char]
showsPrec :: Int -> Inherit -> ShowS
$cshowsPrec :: Int -> Inherit -> ShowS
Show
-- | No stream handle will be passed. Use when you don't want to communicate
-- with a stream. For example, to run something silently.
data NoStream = NoStream deriving Int -> NoStream -> ShowS
[NoStream] -> ShowS
NoStream -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NoStream] -> ShowS
$cshowList :: [NoStream] -> ShowS
show :: NoStream -> [Char]
$cshow :: NoStream -> [Char]
showsPrec :: Int -> NoStream -> ShowS
$cshowsPrec :: Int -> NoStream -> ShowS
Show
-- | Use the supplied 'Handle'.
data UseHandle = UseHandle Handle deriving Int -> UseHandle -> ShowS
[UseHandle] -> ShowS
UseHandle -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UseHandle] -> ShowS
$cshowList :: [UseHandle] -> ShowS
show :: UseHandle -> [Char]
$cshow :: UseHandle -> [Char]
showsPrec :: Int -> UseHandle -> ShowS
$cshowsPrec :: Int -> UseHandle -> ShowS
Show

-- | The class of types that determine the standard stream of a sub-process.
-- You can decide how to initialize the standard streams (stdin, stdout, and
-- stderr) of a sub-process with the instances of this class.
class StreamType c where
    mbFd :: FD -> c -> IO FD
    willCreateHandle :: c -> Bool
#if __GLASGOW_HASKELL__ >= 780
    mbFd = forall a. HasCallStack => a
undefined
    willCreateHandle = forall a. HasCallStack => a
undefined
    {-# MINIMAL #-}
#endif
instance StreamType CreatePipe where
    mbFd :: FD -> CreatePipe -> IO FD
mbFd FD
_ CreatePipe
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (-FD
1)
    willCreateHandle :: CreatePipe -> Bool
willCreateHandle CreatePipe
_ = Bool
True
instance StreamType Inherit where
    mbFd :: FD -> Inherit -> IO FD
mbFd FD
std Inherit
_ = forall (m :: * -> *) a. Monad m => a -> m a
return FD
std
    willCreateHandle :: Inherit -> Bool
willCreateHandle Inherit
_ = Bool
False
instance StreamType NoStream where
    mbFd :: FD -> NoStream -> IO FD
mbFd FD
_ NoStream
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (-FD
2)
    willCreateHandle :: NoStream -> Bool
willCreateHandle NoStream
_ = Bool
False
instance StreamType UseHandle where
    mbFd :: FD -> UseHandle -> IO FD
mbFd FD
_std (UseHandle Handle
hdl) =
        forall a.
[Char] -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle [Char]
"" Handle
hdl forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice=dev
dev,Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
IORef (dec_state, Buffer Word8)
IORef (BufferList Char)
IORef (Buffer Char)
IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList Char)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haType :: Handle__ -> HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList Char)
haCharBuffer :: IORef (Buffer Char)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
..} -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
dev of
            Just FD
fd -> do
                -- clear the O_NONBLOCK flag on this FD, if it is set, since
                -- we're exposing it externally (see #3316 of 'process')
                FD
fd' <- FD -> Bool -> IO FD
FD.setNonBlockingMode FD
fd Bool
False
                forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__{haDevice :: FD
haDevice=FD
fd',Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
IORef (dec_state, Buffer Word8)
IORef (BufferList Char)
IORef (Buffer Char)
IORef (Buffer Word8)
haBufferMode :: BufferMode
haBuffers :: IORef (BufferList Char)
haByteBuffer :: IORef (Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haInputNL :: Newline
haLastDecode :: IORef (dec_state, Buffer Word8)
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haType :: HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList Char)
haCharBuffer :: IORef (Buffer Char)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
..}, FD -> FD
FD.fdFD FD
fd')
            Maybe FD
Nothing -> forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ IOErrorType -> [Char] -> Maybe Handle -> Maybe [Char] -> IOError
mkIOError IOErrorType
illegalOperationErrorType
                [Char]
"createProcess" (forall a. a -> Maybe a
Just Handle
hdl) forall a. Maybe a
Nothing
                IOError -> [Char] -> IOError
`ioeSetErrorString` [Char]
"handle is not a file descriptor"
    willCreateHandle :: UseHandle -> Bool
willCreateHandle UseHandle
_ = Bool
False

-- Declarations from the process package (modified)

type PHANDLE = CPid

data ProcessHandle__ = OpenHandle PHANDLE
                     | OpenExtHandle PHANDLE PHANDLE PHANDLE
                     | ClosedHandle ExitCode

modifyProcessHandle
    :: Process stdin stdout stderr
    -> (ProcessHandle__ -> IO (ProcessHandle__, a))
    -> IO a
modifyProcessHandle :: forall stdin stdout stderr a.
Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle Process stdin stdout stderr
p = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
phandle Process stdin stdout stderr
p)

withProcessHandle
    :: Process stdin stdout stderr -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle :: forall stdin stdout stderr a.
Process stdin stdout stderr -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle Process stdin stdout stderr
p = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
phandle Process stdin stdout stderr
p)

fdStdin, fdStdout, fdStderr :: FD
fdStdin :: FD
fdStdin  = FD
0
fdStdout :: FD
fdStdout = FD
1
fdStderr :: FD
fdStderr = FD
2

mbPipe :: StreamType c => c -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe :: forall c.
StreamType c =>
c -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe c
streamConf Ptr FD
pfd  IOMode
mode = if forall c. StreamType c => c -> Bool
willCreateHandle c
streamConf
    then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode)
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

pfdToHandle :: Ptr FD -> IOMode -> IO Handle
pfdToHandle :: Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode = do
  FD
fd <- forall a. Storable a => Ptr a -> IO a
peek Ptr FD
pfd
  let filepath :: [Char]
filepath = [Char]
"fd:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FD
fd
  (FD
fD,IODeviceType
fd_type) <- FD
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD (forall a b. (Integral a, Num b) => a -> b
fromIntegral FD
fd) IOMode
mode
                       (forall a. a -> Maybe a
Just (IODeviceType
Stream,CDev
0,CIno
0)) -- avoid calling fstat()
                       Bool
False {-is_socket-}
                       Bool
False {-non-blocking-}
  FD
fD' <- FD -> Bool -> IO FD
FD.setNonBlockingMode FD
fD Bool
True -- see #3316
#if __GLASGOW_HASKELL__ >= 704
  TextEncoding
enc <- IO TextEncoding
getLocaleEncoding
#else
  let enc = localeEncoding
#endif
  FD
-> IODeviceType
-> [Char]
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fD' IODeviceType
fd_type [Char]
filepath IOMode
mode Bool
False {-is_socket-} (forall a. a -> Maybe a
Just TextEncoding
enc)