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

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

  -- Deprecations
  , createRedirectedProcess
  ) where

import Control.Concurrent.Async (Async, async, race_, 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 Control.Monad.Fix (MonadFix)
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. This does NOT include a trailing newline when sending your message.
  | SendPipe_EOF
  -- ^ Send an EOF to the underlying process. Once this is sent no further messages will be processed.
  | SendPipe_LastMessage i
  -- ^ Send the last message along with an EOF. Once this is sent no further messages will be processed.

-- | 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), MonadFix 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 CreateProcess
p 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), MonadFix 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), MonadFix m)
  => IO (SendPipe ByteString)
  -- ^ An action that reads a value from the input stream buffer.
  -- This will run in a separate thread and 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 IO (SendPipe ByteString)
readBuffer SendPipe ByteString -> IO ()
writeBuffer CreateProcess
spec ProcessConfig t (SendPipe ByteString)
config = do
  rec Process t ByteString ByteString
p <- (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 (ProcessHandle -> Handle -> IO (SendPipe ByteString -> IO ())
input (ProcessHandle -> Handle -> IO (SendPipe ByteString -> IO ()))
-> ProcessHandle -> Handle -> IO (SendPipe ByteString -> IO ())
forall a b. (a -> b) -> a -> b
$ Process t ByteString ByteString -> ProcessHandle
forall t o e. Process t o e -> ProcessHandle
_process_handle Process t ByteString ByteString
p) 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 CreateProcess
spec ProcessConfig t (SendPipe ByteString)
config
  Process t ByteString ByteString
-> m (Process t ByteString ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Process t ByteString ByteString
p
  where
    input :: ProcessHandle -> Handle -> IO (SendPipe ByteString -> IO ())
    input :: ProcessHandle -> Handle -> IO (SendPipe ByteString -> IO ())
input ProcessHandle
ph 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 ExitCode -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
race_ (ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph) (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
$ \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 ByteString
m -> Handle -> ByteString -> IO ()
BS.hPutStr Handle
h ByteString
m IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ()
loop
              SendPipe_LastMessage ByteString
m -> Handle -> ByteString -> IO ()
BS.hPutStr Handle
h ByteString
m IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> IO ()
H.hClose Handle
h
              SendPipe ByteString
SendPipe_EOF -> Handle -> IO ()
H.hClose Handle
h
      (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 Handle
h 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
$ \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 Int
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.
  -- This is provided so you can link any new threads to this one to avoid leaking threads.
  -- 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 function 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 Handle -> IO (i -> IO ())
mkWriteStdInput Handle -> (o -> IO ()) -> IO (IO ())
mkReadStdOutput Handle -> (e -> IO ()) -> IO (IO ())
mkReadStdError CreateProcess
p (ProcessConfig Event t i
input 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 }
  (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph) <- case (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
po of
    (Just Handle
hIn, Just Handle
hOut, Just Handle
hErr, 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)
    (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
_ -> [Char] -> m (Handle, Handle, Handle, ProcessHandle)
forall a. HasCallStack => [Char] -> a
error [Char]
"Reflex.Process.unsafeCreateProcessWithHandles: Created pipes were not returned by System.Process.createProcess."
  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
$ \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 -> 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 Handle
h = do
      (Event t o
e, 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 Handle
h = do
      (Event t e
e, 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)

  (Event t o
out, Async ()
outThread) <- Handle -> m (Event t o, Async ())
output Handle
hOut
  (Event t e
err, Async ()
errThread) <- Handle -> m (Event t e, Async ())
errOutput Handle
hErr
  (Event t ExitCode
ecOut, 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

  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

  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