{-|
Module: Reflex.Process
Description: Run processes and interact with them in reflex
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Reflex.Process
  ( createProcess
  , createProcessBufferingInput
  , defProcessConfig
  , unsafeCreateProcessWithHandles
  , Process(..)
  , ProcessConfig(..)
  , SendPipe (..)

  -- Deprecations
  , createRedirectedProcess
  ) where

import Control.Concurrent.Async (Async, async, waitBoth)
import Control.Concurrent.Chan (newChan, readChan, writeChan)
import Control.Exception (finally)
import Control.Monad (void, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Default (Default, def)
import Data.Function (fix)
import Data.Traversable (for)
import GHC.IO.Handle (Handle)
import qualified GHC.IO.Handle as H
import System.Exit (ExitCode)
import qualified System.Posix.Signals as P
import System.Process hiding (createProcess)
import qualified System.Process as P

import Reflex

data SendPipe i
  = SendPipe_Message i
  -- ^ A message that's sent to the underlying process
  | SendPipe_EOF
  -- ^ Send an EOF to the underlying process
  | SendPipe_LastMessage i
  -- ^ Send the last message (an EOF will be added). This option is offered for
  -- convenience, because it has the same effect of sending a Message and then
  -- the EOF signal

-- | The inputs to a process
data ProcessConfig t i = ProcessConfig
  { ProcessConfig t i -> Event t i
_processConfig_stdin :: Event t i
  -- ^ @stdin@ input to be fed to the process
  , ProcessConfig t i -> Event t Signal
_processConfig_signal :: Event t P.Signal
  -- ^ Signals to send to the process
  }
instance Reflex t => Default (ProcessConfig t i) where
  -- | An alias for 'defProcessConfig'.
  def :: ProcessConfig t i
def = ProcessConfig t i
forall t i. Reflex t => ProcessConfig t i
defProcessConfig

-- | A default 'ProcessConfig' where @stdin@ and signals are never sent.
--
-- You can also use 'Data.Default.def'.
defProcessConfig :: Reflex t => ProcessConfig t i
defProcessConfig :: ProcessConfig t i
defProcessConfig = Event t i -> Event t Signal -> ProcessConfig t i
forall t i. Event t i -> Event t Signal -> ProcessConfig t i
ProcessConfig Event t i
forall k (t :: k) a. Reflex t => Event t a
never Event t Signal
forall k (t :: k) a. Reflex t => Event t a
never


-- | The output of a process
data Process t o e = Process
  { Process t o e -> ProcessHandle
_process_handle :: P.ProcessHandle
  , Process t o e -> Event t o
_process_stdout :: Event t o
  -- ^ Fires whenever there's some new stdout output. Depending on the buffering strategy of the implementation, this could be anything from whole lines to individual characters.
  , Process t o e -> Event t e
_process_stderr :: Event t e
  -- ^ Fires whenever there's some new stderr output. See note on '_process_stdout'.
  , Process t o e -> Event t ExitCode
_process_exit :: Event t ExitCode
  -- ^ Fires when the process is over and no @stdout@ or @stderr@ data is left.
  -- Once this fires, no other 'Event's for the process will fire again.
  , Process t o e -> Event t Signal
_process_signal :: Event t P.Signal
  -- ^ Fires when a signal has actually been sent to the process (via '_processConfig_signal').
  }

-- | Create a process feeding it input using an 'Event' and exposing its output
-- 'Event's representing the process exit code, stdout, and stderr.
--
-- The @stdout@ and @stderr@ 'Handle's are line-buffered.
--
-- N.B. The process input is buffered with an unbounded channel! For more control of this,
-- use 'createProcessBufferingInput' directly.
--
-- N.B.: The 'std_in', 'std_out', and 'std_err' parameters of the
-- provided 'CreateProcess' are replaced with new pipes and all output is redirected
-- to those pipes.
createProcess
  :: (MonadIO m, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => P.CreateProcess -- ^ Specification of process to create
  -> ProcessConfig t (SendPipe ByteString) -- ^ Reflex-level configuration for the process
  -> m (Process t ByteString ByteString)
createProcess :: CreateProcess
-> ProcessConfig t (SendPipe ByteString)
-> m (Process t ByteString ByteString)
createProcess p :: CreateProcess
p procConfig :: ProcessConfig t (SendPipe ByteString)
procConfig = do
  Chan (SendPipe ByteString)
channel <- IO (Chan (SendPipe ByteString)) -> m (Chan (SendPipe ByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Chan (SendPipe ByteString))
forall a. IO (Chan a)
newChan
  IO (SendPipe ByteString)
-> (SendPipe ByteString -> IO ())
-> CreateProcess
-> ProcessConfig t (SendPipe ByteString)
-> m (Process t ByteString ByteString)
forall (m :: * -> *) t.
(MonadIO m, TriggerEvent t m, PerformEvent t m,
 MonadIO (Performable m)) =>
IO (SendPipe ByteString)
-> (SendPipe ByteString -> IO ())
-> CreateProcess
-> ProcessConfig t (SendPipe ByteString)
-> m (Process t ByteString ByteString)
createProcessBufferingInput (Chan (SendPipe ByteString) -> IO (SendPipe ByteString)
forall a. Chan a -> IO a
readChan Chan (SendPipe ByteString)
channel) (Chan (SendPipe ByteString) -> SendPipe ByteString -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan (SendPipe ByteString)
channel) CreateProcess
p ProcessConfig t (SendPipe ByteString)
procConfig

-- | Create a process feeding it input using an 'Event' and exposing its output with 'Event's
-- for its exit code, @stdout@, and @stderr@. The input is fed via a buffer represented by a
-- reading action and a writing action.
--
-- The @stdout@ and @stderr@ 'Handle's are line-buffered.
--
-- For example, you may use 'Chan' for an unbounded buffer (like 'createProcess' does) like this:
-- >  channel <- liftIO newChan
-- >  createProcessBufferingInput (readChan channel) (writeChan channel) myConfig
--
-- Similarly you could use 'TChan'.
--
-- Bounded buffers may cause the Reflex network to block when you trigger an 'Event' that would
-- cause more data to be sent to a process whose @stdin@ is blocked.
--
-- If an unbounded channel would lead to too much memory usage you will want to consider
--   * speeding up the consuming process.
--   * buffering with the file system or another persistent storage to reduce memory usage.
--   * if your usa case allows, dropping 'Event's or messages that aren't important.
--
-- N.B.: The 'std_in', 'std_out', and 'std_err' parameters of the
-- provided 'CreateProcess' are replaced with new pipes and all output is redirected
-- to those pipes.
createProcessBufferingInput
  :: (MonadIO m, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => IO (SendPipe ByteString)
  -- ^ An action that reads a value from the input stream buffer.
  -- This must block when the buffer is empty or not ready.
  -> (SendPipe ByteString -> IO ())
  -- ^ An action that writes a value to the input stream buffer.
  -> P.CreateProcess -- ^ Specification of process to create
  -> ProcessConfig t (SendPipe ByteString) -- ^ Reflex-level configuration for the process
  -> m (Process t ByteString ByteString)
createProcessBufferingInput :: IO (SendPipe ByteString)
-> (SendPipe ByteString -> IO ())
-> CreateProcess
-> ProcessConfig t (SendPipe ByteString)
-> m (Process t ByteString ByteString)
createProcessBufferingInput readBuffer :: IO (SendPipe ByteString)
readBuffer writeBuffer :: SendPipe ByteString -> IO ()
writeBuffer = (Handle -> IO (SendPipe ByteString -> IO ()))
-> (Handle -> (ByteString -> IO ()) -> IO (IO ()))
-> (Handle -> (ByteString -> IO ()) -> IO (IO ()))
-> CreateProcess
-> ProcessConfig t (SendPipe ByteString)
-> m (Process t ByteString ByteString)
forall t (m :: * -> *) i o e.
(MonadIO m, TriggerEvent t m, PerformEvent t m,
 MonadIO (Performable m)) =>
(Handle -> IO (i -> IO ()))
-> (Handle -> (o -> IO ()) -> IO (IO ()))
-> (Handle -> (e -> IO ()) -> IO (IO ()))
-> CreateProcess
-> ProcessConfig t i
-> m (Process t o e)
unsafeCreateProcessWithHandles Handle -> IO (SendPipe ByteString -> IO ())
input Handle -> (ByteString -> IO ()) -> IO (IO ())
forall a. Handle -> (ByteString -> IO a) -> IO (IO ())
output Handle -> (ByteString -> IO ()) -> IO (IO ())
forall a. Handle -> (ByteString -> IO a) -> IO (IO ())
output
  where
    input :: Handle -> IO (SendPipe ByteString -> IO ())
    input :: Handle -> IO (SendPipe ByteString -> IO ())
input h :: Handle
h = do
      Handle -> BufferMode -> IO ()
H.hSetBuffering Handle
h BufferMode
H.NoBuffering
      IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ()) -> IO (Async ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO (Async ()) -> IO (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> IO (Async ())) -> IO (Async ()) -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \loop :: IO ()
loop -> do
        SendPipe ByteString
newMessage <- IO (SendPipe ByteString)
readBuffer
        Bool
open <- Handle -> IO Bool
H.hIsOpen Handle
h
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
open (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Bool
writable <- Handle -> IO Bool
H.hIsWritable Handle
h
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
writable (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            case SendPipe ByteString
newMessage of
              SendPipe_Message m :: ByteString
m -> Handle -> ByteString -> IO ()
BS.hPutStr Handle
h ByteString
m
              SendPipe_LastMessage m :: ByteString
m -> Handle -> ByteString -> IO ()
BS.hPutStr Handle
h ByteString
m IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
H.hClose Handle
h
              SendPipe_EOF -> Handle -> IO ()
H.hClose Handle
h
            IO ()
loop
      (SendPipe ByteString -> IO ()) -> IO (SendPipe ByteString -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return SendPipe ByteString -> IO ()
writeBuffer
    output :: Handle -> (ByteString -> IO a) -> IO (IO ())
output h :: Handle
h trigger :: ByteString -> IO a
trigger = do
      Handle -> BufferMode -> IO ()
H.hSetBuffering Handle
h BufferMode
H.LineBuffering
      IO () -> IO (IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \go :: IO ()
go -> do
        Bool
open <- Handle -> IO Bool
H.hIsOpen Handle
h
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
open (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Bool
readable <- Handle -> IO Bool
H.hIsReadable Handle
h
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
readable (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            ByteString
out <- Handle -> Int -> IO ByteString
BS.hGetSome Handle
h 32768
            if ByteString -> Bool
BS.null ByteString
out
              then Handle -> IO ()
H.hClose Handle
h
              else IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> IO a
trigger ByteString
out) IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ()
go

-- | Runs a process and uses the given input and output handler functions to
-- interact with the process via the standard streams. Used to implement
-- 'createProcess'.
--
-- N.B.: The 'std_in', 'std_out', and 'std_err' parameters of the
-- provided 'CreateProcess' are replaced with new pipes and all output is redirected
-- to those pipes.
unsafeCreateProcessWithHandles
  :: forall t m i o e. (MonadIO m, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => (Handle -> IO (i -> IO ()))
  -- ^ Builder for the standard input handler. The 'Handle' is the write end of the process' @stdin@ and
  -- the resulting @i -> IO ()@ is a function that writes each input 'Event t i' to into 'Handle'.
  -- This functios must not block or the entire Reflex network will block.
  -> (Handle -> (o -> IO ()) -> IO (IO ()))
  -- ^ Builder for the standard output handler. The 'Handle' is the read end of the process' @stdout@ and
  -- the @o -> IO ()@ is a function that will trigger the output @Event t o@ when called. The resulting
  -- @IO ()@ will be run in a separate thread and must block until there is no more data in the 'Handle' to
  -- process.
  -> (Handle -> (e -> IO ()) -> IO (IO ()))
  -- ^ Builder for the standard error handler. The 'Handle' is the read end of the process' @stderr@ and
  -- the @e -> IO ()@ is a function that will trigger the output @Event t e@ when called. The resulting
  -- @IO ()@ will be run in a separate thread and must block until there is no more data in the 'Handle' to
  -- process.
  -> P.CreateProcess -- ^ Specification of process to create
  -> ProcessConfig t i -- ^ Reflex-level configuration for the process
  -> m (Process t o e)
unsafeCreateProcessWithHandles :: (Handle -> IO (i -> IO ()))
-> (Handle -> (o -> IO ()) -> IO (IO ()))
-> (Handle -> (e -> IO ()) -> IO (IO ()))
-> CreateProcess
-> ProcessConfig t i
-> m (Process t o e)
unsafeCreateProcessWithHandles mkWriteStdInput :: Handle -> IO (i -> IO ())
mkWriteStdInput mkReadStdOutput :: Handle -> (o -> IO ()) -> IO (IO ())
mkReadStdOutput mkReadStdError :: Handle -> (e -> IO ()) -> IO (IO ())
mkReadStdError p :: CreateProcess
p (ProcessConfig input :: Event t i
input signal :: Event t Signal
signal) = do
  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
po <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
P.createProcess CreateProcess
p { std_in :: StdStream
std_in = StdStream
P.CreatePipe, std_out :: StdStream
std_out = StdStream
P.CreatePipe, std_err :: StdStream
std_err = StdStream
P.CreatePipe }
  (hIn :: Handle
hIn, hOut :: Handle
hOut, hErr :: Handle
hErr, ph :: ProcessHandle
ph) <- case (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
po of
    (Just hIn :: Handle
hIn, Just hOut :: Handle
hOut, Just hErr :: Handle
hErr, ph :: ProcessHandle
ph) -> (Handle, Handle, Handle, ProcessHandle)
-> m (Handle, Handle, Handle, ProcessHandle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph)
    _ -> [Char] -> m (Handle, Handle, Handle, ProcessHandle)
forall a. HasCallStack => [Char] -> a
error "Reflex.Process.unsafeCreateProcessWithHandles: Created pipes were not returned by System.Process.createProcess."
  i -> IO ()
writeInput :: i -> IO () <- IO (i -> IO ()) -> m (i -> IO ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (i -> IO ()) -> m (i -> IO ()))
-> IO (i -> IO ()) -> m (i -> IO ())
forall a b. (a -> b) -> a -> b
$ Handle -> IO (i -> IO ())
mkWriteStdInput Handle
hIn
  Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ (Event t (Performable m ()) -> m ())
-> Event t (Performable m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Performable m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Performable m ())
-> (i -> IO ()) -> i -> Performable m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> IO ()
writeInput (i -> Performable m ()) -> Event t i -> Event t (Performable m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t i
input
  Event t (Maybe Signal)
sigOut :: Event t (Maybe P.Signal) <- Event t (Performable m (Maybe Signal))
-> m (Event t (Maybe Signal))
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent (Event t (Performable m (Maybe Signal))
 -> m (Event t (Maybe Signal)))
-> Event t (Performable m (Maybe Signal))
-> m (Event t (Maybe Signal))
forall a b. (a -> b) -> a -> b
$ Event t Signal
-> (Signal -> Performable m (Maybe Signal))
-> Event t (Performable m (Maybe Signal))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Signal
signal ((Signal -> Performable m (Maybe Signal))
 -> Event t (Performable m (Maybe Signal)))
-> (Signal -> Performable m (Maybe Signal))
-> Event t (Performable m (Maybe Signal))
forall a b. (a -> b) -> a -> b
$ \sig :: Signal
sig -> IO (Maybe Signal) -> Performable m (Maybe Signal)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Signal) -> Performable m (Maybe Signal))
-> IO (Maybe Signal) -> Performable m (Maybe Signal)
forall a b. (a -> b) -> a -> b
$ do
    Maybe Pid
mpid <- ProcessHandle -> IO (Maybe Pid)
P.getPid ProcessHandle
ph
    Maybe Pid -> (Pid -> IO Signal) -> IO (Maybe Signal)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe Pid
mpid ((Pid -> IO Signal) -> IO (Maybe Signal))
-> (Pid -> IO Signal) -> IO (Maybe Signal)
forall a b. (a -> b) -> a -> b
$ \pid :: Pid
pid -> Signal
sig Signal -> IO () -> IO Signal
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Signal -> Pid -> IO ()
P.signalProcess Signal
sig Pid
pid
  let
    output :: Handle -> m (Event t o, Async ())
    output :: Handle -> m (Event t o, Async ())
output h :: Handle
h = do
      (e :: Event t o
e, trigger :: o -> IO ()
trigger) <- m (Event t o, o -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
      IO ()
reader <- IO (IO ()) -> m (IO ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IO ()) -> m (IO ())) -> IO (IO ()) -> m (IO ())
forall a b. (a -> b) -> a -> b
$ Handle -> (o -> IO ()) -> IO (IO ())
mkReadStdOutput Handle
h o -> IO ()
trigger
      Async ()
t <- IO (Async ()) -> m (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> m (Async ())) -> IO (Async ()) -> m (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IO ()
reader
      (Event t o, Async ()) -> m (Event t o, Async ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t o
e, Async ()
t)

    errOutput :: Handle -> m (Event t e, Async ())
    errOutput :: Handle -> m (Event t e, Async ())
errOutput h :: Handle
h = do
      (e :: Event t e
e, trigger :: e -> IO ()
trigger) <- m (Event t e, e -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
      IO ()
reader <- IO (IO ()) -> m (IO ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IO ()) -> m (IO ())) -> IO (IO ()) -> m (IO ())
forall a b. (a -> b) -> a -> b
$ Handle -> (e -> IO ()) -> IO (IO ())
mkReadStdError Handle
h e -> IO ()
trigger
      Async ()
t <- IO (Async ()) -> m (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> m (Async ())) -> IO (Async ()) -> m (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IO ()
reader
      (Event t e, Async ()) -> m (Event t e, Async ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t e
e, Async ()
t)

  (out :: Event t o
out, outThread :: Async ()
outThread) <- Handle -> m (Event t o, Async ())
output Handle
hOut
  (err :: Event t e
err, errThread :: Async ()
errThread) <- Handle -> m (Event t e, Async ())
errOutput Handle
hErr
  (ecOut :: Event t ExitCode
ecOut, ecTrigger :: ExitCode -> IO ()
ecTrigger) <- m (Event t ExitCode, ExitCode -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  m (Async ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Async ()) -> m ()) -> m (Async ()) -> m ()
forall a b. (a -> b) -> a -> b
$ IO (Async ()) -> m (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> m (Async ())) -> IO (Async ()) -> m (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
P.cleanupProcess (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
hIn, Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
hOut, Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
hErr, ProcessHandle
ph)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ExitCode
waited <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
    ((), ())
_ <- Async () -> Async () -> IO ((), ())
forall a b. Async a -> Async b -> IO (a, b)
waitBoth Async ()
outThread Async ()
errThread
    ExitCode -> IO ()
ecTrigger ExitCode
waited -- Output events should never fire after process completion
  Process t o e -> m (Process t o e)
forall (m :: * -> *) a. Monad m => a -> m a
return (Process t o e -> m (Process t o e))
-> Process t o e -> m (Process t o e)
forall a b. (a -> b) -> a -> b
$ Process :: forall t o e.
ProcessHandle
-> Event t o
-> Event t e
-> Event t ExitCode
-> Event t Signal
-> Process t o e
Process
    { _process_exit :: Event t ExitCode
_process_exit = Event t ExitCode
ecOut
    , _process_stdout :: Event t o
_process_stdout = Event t o
out
    , _process_stderr :: Event t e
_process_stderr = Event t e
err
    , _process_signal :: Event t Signal
_process_signal = (Maybe Signal -> Maybe Signal)
-> Event t (Maybe Signal) -> Event t Signal
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe Signal -> Maybe Signal
forall a. a -> a
id Event t (Maybe Signal)
sigOut
    , _process_handle :: ProcessHandle
_process_handle = ProcessHandle
ph
    }

{-# DEPRECATED createRedirectedProcess "Use unsafeCreateProcessWithHandles instead." #-}
createRedirectedProcess
  :: forall t m i o e. (MonadIO m, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => (Handle -> IO (i -> IO ()))
  -> (Handle -> (o -> IO ()) -> IO (IO ()))
  -> (Handle -> (e -> IO ()) -> IO (IO ()))
  -> P.CreateProcess
  -> ProcessConfig t i
  -> m (Process t o e)
createRedirectedProcess :: (Handle -> IO (i -> IO ()))
-> (Handle -> (o -> IO ()) -> IO (IO ()))
-> (Handle -> (e -> IO ()) -> IO (IO ()))
-> CreateProcess
-> ProcessConfig t i
-> m (Process t o e)
createRedirectedProcess = (Handle -> IO (i -> IO ()))
-> (Handle -> (o -> IO ()) -> IO (IO ()))
-> (Handle -> (e -> IO ()) -> IO (IO ()))
-> CreateProcess
-> ProcessConfig t i
-> m (Process t o e)
forall t (m :: * -> *) i o e.
(MonadIO m, TriggerEvent t m, PerformEvent t m,
 MonadIO (Performable m)) =>
(Handle -> IO (i -> IO ()))
-> (Handle -> (o -> IO ()) -> IO (IO ()))
-> (Handle -> (e -> IO ()) -> IO (IO ()))
-> CreateProcess
-> ProcessConfig t i
-> m (Process t o e)
unsafeCreateProcessWithHandles