{-# options_haddock prune #-}
-- |Description: Process Interpreters for stdpipes, Internal
module Polysemy.Process.Interpreter.ProcessIOE where

import Control.Concurrent.STM.TBMQueue (TBMQueue)
import Data.ByteString (hGetSome, hPut)
import Polysemy (InterpretersFor, insertAt)
import Polysemy.Async (Async)
import Polysemy.Conc.Async (withAsync_)
import qualified Polysemy.Conc.Data.QueueResult as QueueResult
import qualified Polysemy.Conc.Effect.Queue as Queue
import Polysemy.Conc.Effect.Queue (Queue)
import Polysemy.Conc.Effect.Race (Race)
import Polysemy.Conc.Effect.Scoped (Scoped)
import Polysemy.Conc.Interpreter.Queue.TBM (interpretQueueTBMWith, withTBMQueue)
import Polysemy.Resource (Resource)
import Polysemy.Resume (interpretResumable, stop, type (!!))
import Prelude hiding (fromException)
import qualified System.Process.Typed as System
import System.Process.Typed (
  ProcessConfig,
  createPipe,
  getStderr,
  getStdin,
  getStdout,
  setStderr,
  setStdin,
  setStdout,
  )

import Polysemy.Process.Data.ProcessError (ProcessError (Terminated))
import qualified Polysemy.Process.Effect.Process as Process
import Polysemy.Process.Effect.Process (Process)
import Polysemy.Process.Interpreter.Process (interpretProcessNative)

newtype In a =
  In { In a -> a
unIn :: a }
  deriving (In a -> In a -> Bool
(In a -> In a -> Bool) -> (In a -> In a -> Bool) -> Eq (In a)
forall a. Eq a => In a -> In a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: In a -> In a -> Bool
$c/= :: forall a. Eq a => In a -> In a -> Bool
== :: In a -> In a -> Bool
$c== :: forall a. Eq a => In a -> In a -> Bool
Eq, Int -> In a -> ShowS
[In a] -> ShowS
In a -> String
(Int -> In a -> ShowS)
-> (In a -> String) -> ([In a] -> ShowS) -> Show (In a)
forall a. Show a => Int -> In a -> ShowS
forall a. Show a => [In a] -> ShowS
forall a. Show a => In a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [In a] -> ShowS
$cshowList :: forall a. Show a => [In a] -> ShowS
show :: In a -> String
$cshow :: forall a. Show a => In a -> String
showsPrec :: Int -> In a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> In a -> ShowS
Show)

newtype Out a =
  Out { Out a -> a
unOut :: a }
  deriving (Out a -> Out a -> Bool
(Out a -> Out a -> Bool) -> (Out a -> Out a -> Bool) -> Eq (Out a)
forall a. Eq a => Out a -> Out a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Out a -> Out a -> Bool
$c/= :: forall a. Eq a => Out a -> Out a -> Bool
== :: Out a -> Out a -> Bool
$c== :: forall a. Eq a => Out a -> Out a -> Bool
Eq, Int -> Out a -> ShowS
[Out a] -> ShowS
Out a -> String
(Int -> Out a -> ShowS)
-> (Out a -> String) -> ([Out a] -> ShowS) -> Show (Out a)
forall a. Show a => Int -> Out a -> ShowS
forall a. Show a => [Out a] -> ShowS
forall a. Show a => Out a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Out a] -> ShowS
$cshowList :: forall a. Show a => [Out a] -> ShowS
show :: Out a -> String
$cshow :: forall a. Show a => Out a -> String
showsPrec :: Int -> Out a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Out a -> ShowS
Show)

newtype Err a =
  Err { Err a -> a
unErr :: a }
  deriving (Err a -> Err a -> Bool
(Err a -> Err a -> Bool) -> (Err a -> Err a -> Bool) -> Eq (Err a)
forall a. Eq a => Err a -> Err a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Err a -> Err a -> Bool
$c/= :: forall a. Eq a => Err a -> Err a -> Bool
== :: Err a -> Err a -> Bool
$c== :: forall a. Eq a => Err a -> Err a -> Bool
Eq, Int -> Err a -> ShowS
[Err a] -> ShowS
Err a -> String
(Int -> Err a -> ShowS)
-> (Err a -> String) -> ([Err a] -> ShowS) -> Show (Err a)
forall a. Show a => Int -> Err a -> ShowS
forall a. Show a => [Err a] -> ShowS
forall a. Show a => Err a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Err a] -> ShowS
$cshowList :: forall a. Show a => [Err a] -> ShowS
show :: Err a -> String
$cshow :: forall a. Show a => Err a -> String
showsPrec :: Int -> Err a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Err a -> ShowS
Show)

data ProcessQueues =
  ProcessQueues {
    ProcessQueues -> TBMQueue (In ByteString)
pqIn :: TBMQueue (In ByteString),
    ProcessQueues -> TBMQueue (Out ByteString)
pqOut :: TBMQueue (Out ByteString),
    ProcessQueues -> TBMQueue (Err ByteString)
pqErr :: TBMQueue (Err ByteString)
  }

processWithQueues :: ProcessConfig () () () -> ProcessConfig Handle Handle Handle
processWithQueues :: ProcessConfig () () () -> ProcessConfig Handle Handle Handle
processWithQueues =
  StreamSpec 'STInput Handle
-> ProcessConfig () Handle Handle
-> ProcessConfig Handle Handle Handle
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin StreamSpec 'STInput Handle
forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe (ProcessConfig () Handle Handle
 -> ProcessConfig Handle Handle Handle)
-> (ProcessConfig () () () -> ProcessConfig () Handle Handle)
-> ProcessConfig () () ()
-> ProcessConfig Handle Handle Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput Handle
-> ProcessConfig () () Handle -> ProcessConfig () Handle Handle
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput Handle
forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe (ProcessConfig () () Handle -> ProcessConfig () Handle Handle)
-> (ProcessConfig () () () -> ProcessConfig () () Handle)
-> ProcessConfig () () ()
-> ProcessConfig () Handle Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput Handle
-> ProcessConfig () () () -> ProcessConfig () () Handle
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput Handle
forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe

readQueue ::
  ∀ r .
  Members [Queue (In ByteString), Embed IO] r =>
  Bool ->
  Handle ->
  Sem r ()
readQueue :: Bool -> Handle -> Sem r ()
readQueue Bool
discardWhenFull Handle
handle = do
  IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed @IO (Handle -> BufferMode -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> BufferMode -> m ()
hSetBuffering Handle
handle BufferMode
NoBuffering)
  IO ByteString -> Sem r (Either Text ByteString)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (Handle -> Int -> IO ByteString
hGetSome Handle
handle Int
4096) Sem r (Either Text ByteString)
-> (Either Text ByteString -> Sem r ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> Sem r ()) -> Either Text ByteString -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \ ByteString
msg -> do
      if Bool
discardWhenFull then Sem r (QueueResult ()) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (In ByteString -> Sem r (QueueResult ())
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Queue d) r =>
d -> Sem r (QueueResult ())
Queue.tryWrite (ByteString -> In ByteString
forall a. a -> In a
In ByteString
msg)) else In ByteString -> Sem r ()
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Queue d) r =>
d -> Sem r ()
Queue.write (ByteString -> In ByteString
forall a. a -> In a
In ByteString
msg)
      Bool -> Handle -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members '[Queue (In ByteString), Embed IO] r =>
Bool -> Handle -> Sem r ()
readQueue Bool
discardWhenFull Handle
handle

writeQueue ::
  ∀ r .
  Members [Queue (Out ByteString), Embed IO] r =>
  Handle ->
  Sem r ()
writeQueue :: Handle -> Sem r ()
writeQueue Handle
handle = do
  IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed @IO (Handle -> BufferMode -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> BufferMode -> m ()
hSetBuffering Handle
handle BufferMode
NoBuffering)
  Sem r ()
spin
  where
    spin :: Sem r ()
spin =
      Sem r (QueueResult (Out ByteString))
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Queue d) r =>
Sem r (QueueResult d)
Queue.read Sem r (QueueResult (Out ByteString))
-> (QueueResult (Out ByteString) -> Sem r ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        QueueResult.Success (Out ByteString
msg) ->
          (() -> Sem r ()) -> Either Text () -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Sem r () -> () -> Sem r ()
forall a b. a -> b -> a
const Sem r ()
spin) (Either Text () -> Sem r ()) -> Sem r (Either Text ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO () -> Sem r (Either Text ())
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (Handle -> ByteString -> IO ()
hPut Handle
handle ByteString
msg)
        QueueResult (Out ByteString)
_ ->
          Sem r ()
forall (f :: * -> *). Applicative f => f ()
pass

interpretQueues ::
  Members [Resource, Race, Embed IO] r =>
  ProcessQueues ->
  InterpretersFor [Queue (In ByteString), Queue (Out ByteString), Queue (Err ByteString)] r
interpretQueues :: ProcessQueues
-> InterpretersFor
     '[Queue (In ByteString), Queue (Out ByteString),
       Queue (Err ByteString)]
     r
interpretQueues (ProcessQueues TBMQueue (In ByteString)
inQ TBMQueue (Out ByteString)
outQ TBMQueue (Err ByteString)
errQ) =
  TBMQueue (Err ByteString)
-> InterpreterFor (Queue (Err ByteString)) r
forall d (r :: [(* -> *) -> * -> *]).
Members '[Race, Embed IO] r =>
TBMQueue d -> InterpreterFor (Queue d) r
interpretQueueTBMWith TBMQueue (Err ByteString)
errQ (Sem (Queue (Err ByteString) : r) a -> Sem r a)
-> (Sem
      (Queue (In ByteString)
         : Queue (Out ByteString) : Queue (Err ByteString) : r)
      a
    -> Sem (Queue (Err ByteString) : r) a)
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  TBMQueue (Out ByteString)
-> InterpreterFor
     (Queue (Out ByteString)) (Queue (Err ByteString) : r)
forall d (r :: [(* -> *) -> * -> *]).
Members '[Race, Embed IO] r =>
TBMQueue d -> InterpreterFor (Queue d) r
interpretQueueTBMWith TBMQueue (Out ByteString)
outQ (Sem (Queue (Out ByteString) : Queue (Err ByteString) : r) a
 -> Sem (Queue (Err ByteString) : r) a)
-> (Sem
      (Queue (In ByteString)
         : Queue (Out ByteString) : Queue (Err ByteString) : r)
      a
    -> Sem (Queue (Out ByteString) : Queue (Err ByteString) : r) a)
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
-> Sem (Queue (Err ByteString) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  TBMQueue (In ByteString)
-> InterpreterFor
     (Queue (In ByteString))
     (Queue (Out ByteString) : Queue (Err ByteString) : r)
forall d (r :: [(* -> *) -> * -> *]).
Members '[Race, Embed IO] r =>
TBMQueue d -> InterpreterFor (Queue d) r
interpretQueueTBMWith TBMQueue (In ByteString)
inQ

interpretProcessWithQueues ::
  Members [Queue (In ByteString), Queue (Out ByteString), Queue (Err ByteString)] r =>
  InterpreterFor (Process ByteString ByteString ByteString !! ProcessError) r
interpretProcessWithQueues :: InterpreterFor
  (Process ByteString ByteString ByteString !! ProcessError) r
interpretProcessWithQueues =
  (forall x (r0 :: [(* -> *) -> * -> *]).
 Process ByteString ByteString ByteString (Sem r0) x
 -> Sem (Stop ProcessError : r) x)
-> InterpreterFor
     (Process ByteString ByteString ByteString !! ProcessError) r
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [(* -> *) -> * -> *]).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Process ByteString ByteString ByteString (Sem r0) x
Process.Recv ->
      Sem (Stop ProcessError : r) (QueueResult (In x))
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Queue d) r =>
Sem r (QueueResult d)
Queue.read Sem (Stop ProcessError : r) (QueueResult (In x))
-> (QueueResult (In x) -> Sem (Stop ProcessError : r) x)
-> Sem (Stop ProcessError : r) x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        QueueResult (In x)
QueueResult.Closed ->
          ProcessError -> Sem (Stop ProcessError : r) x
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop (Text -> ProcessError
Terminated Text
"closed")
        QueueResult (In x)
QueueResult.NotAvailable ->
          ProcessError -> Sem (Stop ProcessError : r) x
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop (Text -> ProcessError
Terminated Text
"impossible: empty")
        QueueResult.Success (In x
msg) ->
          x -> Sem (Stop ProcessError : r) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
msg
    Process ByteString ByteString ByteString (Sem r0) x
Process.RecvError ->
      Sem (Stop ProcessError : r) (QueueResult (Err x))
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Queue d) r =>
Sem r (QueueResult d)
Queue.read Sem (Stop ProcessError : r) (QueueResult (Err x))
-> (QueueResult (Err x) -> Sem (Stop ProcessError : r) x)
-> Sem (Stop ProcessError : r) x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        QueueResult (Err x)
QueueResult.Closed ->
          ProcessError -> Sem (Stop ProcessError : r) x
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop (Text -> ProcessError
Terminated Text
"closed")
        QueueResult (Err x)
QueueResult.NotAvailable ->
          ProcessError -> Sem (Stop ProcessError : r) x
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop (Text -> ProcessError
Terminated Text
"impossible: empty")
        QueueResult.Success (Err x
msg) ->
          x -> Sem (Stop ProcessError : r) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
msg
    Process.Send msg -> do
      Sem (Stop ProcessError : r) Bool
-> Sem (Stop ProcessError : r) () -> Sem (Stop ProcessError : r) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Queue (Out ByteString)) r =>
Sem r Bool
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Queue d) r =>
Sem r Bool
Queue.closed @(Out ByteString)) (ProcessError -> Sem (Stop ProcessError : r) ()
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop (Text -> ProcessError
Terminated Text
"closed"))
      Out ByteString -> Sem (Stop ProcessError : r) ()
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Queue d) r =>
d -> Sem r ()
Queue.write (ByteString -> Out ByteString
forall a. a -> Out a
Out ByteString
msg)

withSTMResources ::
  ∀ r a .
  Members [Resource, Embed IO] r =>
  Int ->
  (ProcessQueues -> Sem r a) ->
  Sem r a
withSTMResources :: Int -> (ProcessQueues -> Sem r a) -> Sem r a
withSTMResources Int
qSize ProcessQueues -> Sem r a
action = do
  Int -> (TBMQueue (In ByteString) -> Sem r a) -> Sem r a
forall d (r :: [(* -> *) -> * -> *]) a.
Members '[Resource, Embed IO] r =>
Int -> (TBMQueue d -> Sem r a) -> Sem r a
withTBMQueue Int
qSize \ TBMQueue (In ByteString)
inQ ->
    Int -> (TBMQueue (Out ByteString) -> Sem r a) -> Sem r a
forall d (r :: [(* -> *) -> * -> *]) a.
Members '[Resource, Embed IO] r =>
Int -> (TBMQueue d -> Sem r a) -> Sem r a
withTBMQueue Int
qSize \ TBMQueue (Out ByteString)
outQ ->
      Int -> (TBMQueue (Err ByteString) -> Sem r a) -> Sem r a
forall d (r :: [(* -> *) -> * -> *]) a.
Members '[Resource, Embed IO] r =>
Int -> (TBMQueue d -> Sem r a) -> Sem r a
withTBMQueue Int
qSize \ TBMQueue (Err ByteString)
errQ ->
        ProcessQueues -> Sem r a
action (TBMQueue (In ByteString)
-> TBMQueue (Out ByteString)
-> TBMQueue (Err ByteString)
-> ProcessQueues
ProcessQueues TBMQueue (In ByteString)
inQ TBMQueue (Out ByteString)
outQ TBMQueue (Err ByteString)
errQ)

withProcessResources ::
  Members [Resource, Race, Async, Embed IO] r =>
  Bool ->
  Int ->
  System.Process Handle Handle Handle ->
  (ProcessQueues -> Sem r a) ->
  Sem r a
withProcessResources :: Bool
-> Int
-> Process Handle Handle Handle
-> (ProcessQueues -> Sem r a)
-> Sem r a
withProcessResources Bool
discardWhenFull Int
qSize Process Handle Handle Handle
prc ProcessQueues -> Sem r a
f =
  Int -> (ProcessQueues -> Sem r a) -> Sem r a
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Resource, Embed IO] r =>
Int -> (ProcessQueues -> Sem r a) -> Sem r a
withSTMResources Int
qSize \ ProcessQueues
qs ->
    ProcessQueues
-> InterpretersFor
     '[Queue (In ByteString), Queue (Out ByteString),
       Queue (Err ByteString)]
     r
forall (r :: [(* -> *) -> * -> *]).
Members '[Resource, Race, Embed IO] r =>
ProcessQueues
-> InterpretersFor
     '[Queue (In ByteString), Queue (Out ByteString),
       Queue (Err ByteString)]
     r
interpretQueues ProcessQueues
qs (Sem
   (Append
      '[Queue (In ByteString), Queue (Out ByteString),
        Queue (Err ByteString)]
      r)
   a
 -> Sem r a)
-> Sem
     (Append
        '[Queue (In ByteString), Queue (Out ByteString),
          Queue (Err ByteString)]
        r)
     a
-> Sem r a
forall a b. (a -> b) -> a -> b
$
    Sem
  (Queue (In ByteString)
     : Queue (Out ByteString) : Queue (Err ByteString) : r)
  ()
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall (r :: [(* -> *) -> * -> *]) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ (Bool
-> Handle
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     ()
forall (r :: [(* -> *) -> * -> *]).
Members '[Queue (In ByteString), Embed IO] r =>
Bool -> Handle -> Sem r ()
readQueue Bool
discardWhenFull (Process Handle Handle Handle -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process Handle Handle Handle
prc)) (Sem
   (Queue (In ByteString)
      : Queue (Out ByteString) : Queue (Err ByteString) : r)
   a
 -> Sem
      (Queue (In ByteString)
         : Queue (Out ByteString) : Queue (Err ByteString) : r)
      a)
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall a b. (a -> b) -> a -> b
$
    Sem
  (Queue (In ByteString)
     : Queue (Out ByteString) : Queue (Err ByteString) : r)
  ()
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall (r :: [(* -> *) -> * -> *]) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ (Bool
-> Handle
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     ()
forall (r :: [(* -> *) -> * -> *]).
Members '[Queue (In ByteString), Embed IO] r =>
Bool -> Handle -> Sem r ()
readQueue Bool
discardWhenFull (Process Handle Handle Handle -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process Handle Handle Handle
prc)) (Sem
   (Queue (In ByteString)
      : Queue (Out ByteString) : Queue (Err ByteString) : r)
   a
 -> Sem
      (Queue (In ByteString)
         : Queue (Out ByteString) : Queue (Err ByteString) : r)
      a)
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall a b. (a -> b) -> a -> b
$
    Sem
  (Queue (In ByteString)
     : Queue (Out ByteString) : Queue (Err ByteString) : r)
  ()
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall (r :: [(* -> *) -> * -> *]) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ (Handle
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     ()
forall (r :: [(* -> *) -> * -> *]).
Members '[Queue (Out ByteString), Embed IO] r =>
Handle -> Sem r ()
writeQueue (Process Handle Handle Handle -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin Process Handle Handle Handle
prc)) (Sem
   (Queue (In ByteString)
      : Queue (Out ByteString) : Queue (Err ByteString) : r)
   a
 -> Sem
      (Queue (In ByteString)
         : Queue (Out ByteString) : Queue (Err ByteString) : r)
      a)
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall a b. (a -> b) -> a -> b
$
    Sem r a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall (index :: Nat) (inserted :: [(* -> *) -> * -> *])
       (head :: [(* -> *) -> * -> *]) (oldTail :: [(* -> *) -> * -> *])
       (tail :: [(* -> *) -> * -> *]) (old :: [(* -> *) -> * -> *])
       (full :: [(* -> *) -> * -> *]) a.
(ListOfLength index head, WhenStuck index InsertAtUnprovidedIndex,
 old ~ Append head oldTail, tail ~ Append inserted oldTail,
 full ~ Append head tail,
 InsertAtIndex index head tail oldTail full inserted) =>
Sem old a -> Sem full a
insertAt @0 (ProcessQueues -> Sem r a
f ProcessQueues
qs)

interpretProcessQueues ::
  Members [Resource, Race, Async, Embed IO] r =>
  ProcessQueues ->
  InterpreterFor (Process ByteString ByteString ByteString !! ProcessError) r
interpretProcessQueues :: ProcessQueues
-> InterpreterFor
     (Process ByteString ByteString ByteString !! ProcessError) r
interpretProcessQueues ProcessQueues
qs =
  ProcessQueues
-> InterpretersFor
     '[Queue (In ByteString), Queue (Out ByteString),
       Queue (Err ByteString)]
     r
forall (r :: [(* -> *) -> * -> *]).
Members '[Resource, Race, Embed IO] r =>
ProcessQueues
-> InterpretersFor
     '[Queue (In ByteString), Queue (Out ByteString),
       Queue (Err ByteString)]
     r
interpretQueues ProcessQueues
qs (Sem
   (Queue (In ByteString)
      : Queue (Out ByteString) : Queue (Err ByteString) : r)
   a
 -> Sem r a)
-> (Sem
      ((Process ByteString ByteString ByteString !! ProcessError) : r) a
    -> Sem
         (Queue (In ByteString)
            : Queue (Out ByteString) : Queue (Err ByteString) : r)
         a)
-> Sem
     ((Process ByteString ByteString ByteString !! ProcessError) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  ((Process ByteString ByteString ByteString !! ProcessError)
     : Queue (In ByteString) : Queue (Out ByteString)
     : Queue (Err ByteString) : r)
  a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall (r :: [(* -> *) -> * -> *]).
Members
  '[Queue (In ByteString), Queue (Out ByteString),
    Queue (Err ByteString)]
  r =>
InterpreterFor
  (Process ByteString ByteString ByteString !! ProcessError) r
interpretProcessWithQueues (Sem
   ((Process ByteString ByteString ByteString !! ProcessError)
      : Queue (In ByteString) : Queue (Out ByteString)
      : Queue (Err ByteString) : r)
   a
 -> Sem
      (Queue (In ByteString)
         : Queue (Out ByteString) : Queue (Err ByteString) : r)
      a)
-> (Sem
      ((Process ByteString ByteString ByteString !! ProcessError) : r) a
    -> Sem
         ((Process ByteString ByteString ByteString !! ProcessError)
            : Queue (In ByteString) : Queue (Out ByteString)
            : Queue (Err ByteString) : r)
         a)
-> Sem
     ((Process ByteString ByteString ByteString !! ProcessError) : r) a
-> Sem
     (Queue (In ByteString)
        : Queue (Out ByteString) : Queue (Err ByteString) : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  ((Process ByteString ByteString ByteString !! ProcessError) : r) a
-> Sem
     ((Process ByteString ByteString ByteString !! ProcessError)
        : Queue (In ByteString) : Queue (Out ByteString)
        : Queue (Err ByteString) : r)
     a
forall (e2 :: (* -> *) -> * -> *) (e3 :: (* -> *) -> * -> *)
       (e4 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
raiseUnder3

-- |Interpret 'Process' with a system process resource whose file descriptors are connected to three 'TBMQueue's,
-- producing 'ByteString's.
interpretProcessIOE ::
  Members [Resource, Race, Async, Embed IO] r =>
  Bool ->
  Int ->
  ProcessConfig () () () ->
  InterpreterFor (Scoped ProcessQueues (Process ByteString ByteString ByteString !! ProcessError)) r
interpretProcessIOE :: Bool
-> Int
-> ProcessConfig () () ()
-> InterpreterFor
     (Scoped
        ProcessQueues
        (Process ByteString ByteString ByteString !! ProcessError))
     r
interpretProcessIOE Bool
discardWhenFull Int
qSize ProcessConfig () () ()
config =
  ProcessConfig Handle Handle Handle
-> (forall x.
    Process Handle Handle Handle
    -> (ProcessQueues -> Sem r x) -> Sem r x)
-> (ProcessQueues
    -> InterpreterFor
         (Process ByteString ByteString ByteString !! ProcessError) r)
-> InterpreterFor
     (Scoped
        ProcessQueues
        (Process ByteString ByteString ByteString !! ProcessError))
     r
forall resource i o e err stdin stdout stderr
       (r :: [(* -> *) -> * -> *]).
Members '[Resource, Race, Async, Embed IO] r =>
ProcessConfig stdin stdout stderr
-> (forall x.
    Process stdin stdout stderr -> (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor (Process i o e !! err) r)
-> InterpreterFor (Scoped resource (Process i o e !! err)) r
interpretProcessNative (ProcessConfig () () () -> ProcessConfig Handle Handle Handle
processWithQueues ProcessConfig () () ()
config) (Bool
-> Int
-> Process Handle Handle Handle
-> (ProcessQueues -> Sem r x)
-> Sem r x
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Resource, Race, Async, Embed IO] r =>
Bool
-> Int
-> Process Handle Handle Handle
-> (ProcessQueues -> Sem r a)
-> Sem r a
withProcessResources Bool
discardWhenFull Int
qSize) ProcessQueues
-> InterpreterFor
     (Process ByteString ByteString ByteString !! ProcessError) r
forall (r :: [(* -> *) -> * -> *]).
Members '[Resource, Race, Async, Embed IO] r =>
ProcessQueues
-> InterpreterFor
     (Process ByteString ByteString ByteString !! ProcessError) r
interpretProcessQueues