module RawFilePath.Process.Common (
  Process (..),
  ProcessConf (..),
  proc,
  processStdin,
  processStdout,
  processStderr,
  StreamType,
  mbFd,
  willCreateHandle,
  CreatePipe (..),
  Inherit (..),
  NoStream (..),
  UseHandle (..),
  setStdin,
  setStdout,
  setStderr,
  UnknownStream,
  untypeProcess,
  untypeProcessStdin,
  untypeProcessStdout,
  untypeProcessStderr,
  processStdinUnknown,
  processStdoutUnknown,
  processStderrUnknown,
  PHANDLE,
  ProcessHandle__ (..),
  modifyProcessHandle,
  withProcessHandle,
  fdStdin,
  fdStdout,
  fdStderr,
  mbPipe,
) where

-- extra modules

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


-- Original declarations

-- | Represents a stream whose creation information is unknown; We don't have
-- any type system guarantee of the t'System.IO.Handle'\'s existence.
--
-- @since 1.1.1
data UnknownStream


-- | 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 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
args
    , cwd :: Maybe ByteString
cwd = Maybe ByteString
forall a. Maybe a
Nothing
    , env :: Maybe [(ByteString, ByteString)]
env = Maybe [(ByteString, ByteString)]
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 = Maybe GroupID
forall a. Maybe a
Nothing
    , childUser :: Maybe UserID
childUser = Maybe UserID
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}


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}


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}


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__
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
procStdin :: Maybe Handle
procStdout :: Maybe Handle
procStderr :: Maybe Handle
phandle :: MVar ProcessHandle__
mbDelegateCtlc :: Bool
waitpidLock :: MVar ()
..} = Handle -> Maybe Handle -> Handle
forall a. a -> Maybe a -> a
fromMaybe Handle
forall {a}. a
err Maybe Handle
procStdin
 where
  err :: a
err = [Char] -> a
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__
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
procStdin :: Maybe Handle
procStdout :: Maybe Handle
procStderr :: Maybe Handle
phandle :: MVar ProcessHandle__
mbDelegateCtlc :: Bool
waitpidLock :: MVar ()
..} = Handle -> Maybe Handle -> Handle
forall a. a -> Maybe a -> a
fromMaybe Handle
forall {a}. a
err Maybe Handle
procStdout
 where
  err :: a
err = [Char] -> a
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__
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
procStdin :: Maybe Handle
procStdout :: Maybe Handle
procStderr :: Maybe Handle
phandle :: MVar ProcessHandle__
mbDelegateCtlc :: Bool
waitpidLock :: MVar ()
..} = Handle -> Maybe Handle -> Handle
forall a. a -> Maybe a -> a
fromMaybe Handle
forall {a}. a
err Maybe Handle
procStderr
 where
  err :: a
err = [Char] -> a
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 t'System.IO.Handle'.
data CreatePipe = CreatePipe deriving (Int -> CreatePipe -> ShowS
[CreatePipe] -> ShowS
CreatePipe -> [Char]
(Int -> CreatePipe -> ShowS)
-> (CreatePipe -> [Char])
-> ([CreatePipe] -> ShowS)
-> Show CreatePipe
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatePipe -> ShowS
showsPrec :: Int -> CreatePipe -> ShowS
$cshow :: CreatePipe -> [Char]
show :: CreatePipe -> [Char]
$cshowList :: [CreatePipe] -> ShowS
showList :: [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]
(Int -> Inherit -> ShowS)
-> (Inherit -> [Char]) -> ([Inherit] -> ShowS) -> Show Inherit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inherit -> ShowS
showsPrec :: Int -> Inherit -> ShowS
$cshow :: Inherit -> [Char]
show :: Inherit -> [Char]
$cshowList :: [Inherit] -> ShowS
showList :: [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]
(Int -> NoStream -> ShowS)
-> (NoStream -> [Char]) -> ([NoStream] -> ShowS) -> Show NoStream
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoStream -> ShowS
showsPrec :: Int -> NoStream -> ShowS
$cshow :: NoStream -> [Char]
show :: NoStream -> [Char]
$cshowList :: [NoStream] -> ShowS
showList :: [NoStream] -> ShowS
Show)


-- | Use the supplied t'System.IO.Handle'.
data UseHandle = UseHandle Handle deriving (Int -> UseHandle -> ShowS
[UseHandle] -> ShowS
UseHandle -> [Char]
(Int -> UseHandle -> ShowS)
-> (UseHandle -> [Char])
-> ([UseHandle] -> ShowS)
-> Show UseHandle
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UseHandle -> ShowS
showsPrec :: Int -> UseHandle -> ShowS
$cshow :: UseHandle -> [Char]
show :: UseHandle -> [Char]
$cshowList :: [UseHandle] -> ShowS
showList :: [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
  mbFd = FD -> c -> IO FD
forall a. HasCallStack => a
undefined
  willCreateHandle = c -> Bool
forall a. HasCallStack => a
undefined
  {-# MINIMAL #-}


instance StreamType CreatePipe where
  mbFd :: FD -> CreatePipe -> IO FD
mbFd FD
_ CreatePipe
_ = FD -> IO FD
forall a. a -> IO a
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
_ = FD -> IO FD
forall a. a -> IO a
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
_ = FD -> IO FD
forall a. a -> IO a
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) =
    [Char] -> Handle -> (Handle__ -> IO (Handle__, FD)) -> IO FD
forall a.
[Char] -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle [Char]
"" Handle
hdl ((Handle__ -> IO (Handle__, FD)) -> IO FD)
-> (Handle__ -> IO (Handle__, FD)) -> IO FD
forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice = dev
dev, Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haInputNL :: Handle__ -> Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
..} -> case dev -> Maybe FD
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
        (Handle__, FD) -> IO (Handle__, FD)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__{haDevice :: FD
haDevice = FD
fd', Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..}, FD -> FD
FD.fdFD FD
fd')
      Maybe FD
Nothing ->
        IOError -> IO (Handle__, FD)
forall a. IOError -> IO a
ioError (IOError -> IO (Handle__, FD)) -> IOError -> IO (Handle__, FD)
forall a b. (a -> b) -> a -> b
$
          IOErrorType -> [Char] -> Maybe Handle -> Maybe [Char] -> IOError
mkIOError
            IOErrorType
illegalOperationErrorType
            [Char]
"createProcess"
            (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
hdl)
            Maybe [Char]
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 = MVar ProcessHandle__
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Process stdin stdout stderr -> MVar ProcessHandle__
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 = MVar ProcessHandle__ -> (ProcessHandle__ -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Process stdin stdout stderr -> MVar ProcessHandle__
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 c -> Bool
forall c. StreamType c => c -> Bool
willCreateHandle c
streamConf
    then (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Handle -> Maybe Handle
forall a. a -> Maybe a
Just (Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode)
    else Maybe Handle -> IO (Maybe Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
forall a. Maybe a
Nothing


-- | Deliberately "un-type" all three type parameters of a process. Then, the
-- three standard streams will be available as 'Maybe' t'System.IO.Handle'.
-- Obtain them using
--
--  * 'processStdinUnknown'
--
--  * 'processStdoutUnknown'
--
--  * 'processStderrUnknown'
--
-- @since 1.1.1
untypeProcess
  :: Process stdin stdout stderr
  -> Process UnknownStream UnknownStream UnknownStream
untypeProcess :: forall stdin stdout stderr.
Process stdin stdout stderr
-> Process UnknownStream UnknownStream UnknownStream
untypeProcess Process stdin stdout stderr
p = Process stdin stdout stderr
p{phandle = phandle p}


-- | Deliberately "un-type" the standard input stream (stdin) type parameter of
-- a process. After this, use 'processStdinUnknown' to access 'Maybe'
-- t'System.IO.Handle'.
--
-- @since 1.1.1
untypeProcessStdin
  :: Process stdin stdout stderr
  -> Process UnknownStream stdout stderr
untypeProcessStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Process UnknownStream stdout stderr
untypeProcessStdin Process stdin stdout stderr
p = Process stdin stdout stderr
p{procStdin = procStdin p}


-- | Deliberately "un-type" the standard output stream (stdout) type parameter of
-- a process. After this, use 'processStdinUnknown' to access 'Maybe'
-- t'System.IO.Handle'.
--
-- @since 1.1.1
untypeProcessStdout
  :: Process stdin stdout stderr
  -> Process stdin UnknownStream stderr
untypeProcessStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Process stdin UnknownStream stderr
untypeProcessStdout Process stdin stdout stderr
p = Process stdin stdout stderr
p{procStdout = procStdout p}


-- | Deliberately "un-type" the standard error stream (stderr) type parameter
-- of a process. After this, use 'processStdinUnknown' to access 'Maybe'
-- t'System.IO.Handle'.
--
-- @since 1.1.1
untypeProcessStderr
  :: Process stdin stdout stderr
  -> Process stdin stdout UnknownStream
untypeProcessStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Process stdin stdout UnknownStream
untypeProcessStderr Process stdin stdout stderr
p = Process stdin stdout stderr
p{procStderr = procStderr p}


-- | Obtain the stdin t'System.IO.Handle' from a process. The result could be
-- 'Nothing', so dealing with that is the caller's responsibility.
--
-- @since 1.1.1
processStdinUnknown :: Process UnknownStream stdout stderr -> Maybe Handle
processStdinUnknown :: forall stdout stderr.
Process UnknownStream stdout stderr -> Maybe Handle
processStdinUnknown = Process UnknownStream stdout stderr -> Maybe Handle
forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin


-- | Obtain the stdout t'System.IO.Handle' from a process. There is no
-- guarantee; It may return 'Nothing', and dealing with it is a runtime
-- responsibility.
--
-- @since 1.1.1
processStdoutUnknown :: Process stdin UnknownStream stderr -> Maybe Handle
processStdoutUnknown :: forall stdin stderr.
Process stdin UnknownStream stderr -> Maybe Handle
processStdoutUnknown = Process stdin UnknownStream stderr -> Maybe Handle
forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout


-- | Obtain the stderr t'System.IO.Handle' from a process. There is no
-- guarantee; It may return 'Nothing', and dealing with it is a runtime
-- responsibility.
--
-- @since 1.1.1
processStderrUnknown :: Process stdin stdout UnknownStream -> Maybe Handle
processStderrUnknown :: forall stdin stdout.
Process stdin stdout UnknownStream -> Maybe Handle
processStderrUnknown = Process stdin stdout UnknownStream -> Maybe Handle
forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStderr


pfdToHandle :: Ptr FD -> IOMode -> IO Handle
pfdToHandle :: Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode = do
  FD
fd <- Ptr FD -> IO FD
forall a. Storable a => Ptr a -> IO a
peek Ptr FD
pfd
  let filepath :: [Char]
filepath = [Char]
"fd:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FD -> [Char]
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
      (FD -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral FD
fd)
      IOMode
mode
      ((IODeviceType, CDev, CIno) -> Maybe (IODeviceType, CDev, CIno)
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
  TextEncoding
enc <- IO TextEncoding
getLocaleEncoding
  FD
-> IODeviceType
-> [Char]
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fD' IODeviceType
fd_type [Char]
filepath IOMode
mode Bool
False {-is_socket-} (TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just TextEncoding
enc)