{-# options_haddock prune #-}

-- |Description: SystemProcess Interpreters, Internal
module Polysemy.Process.Interpreter.SystemProcess where

import Data.ByteString (hGetSome, hPut)
import Polysemy.Resume (Stop, interpretResumable, interpretScopedR, stop, stopNote, stopTryIOError, type (!!))
import Prelude hiding (fromException)
import System.IO (BufferMode (NoBuffering), Handle, hSetBuffering)
import qualified System.Posix as Signal
import System.Process (Pid, getPid)
import System.Process.Typed (
  Process,
  ProcessConfig,
  createPipe,
  getStderr,
  getStdin,
  getStdout,
  setStderr,
  setStdin,
  setStdout,
  startProcess,
  stopProcess,
  unsafeProcessHandle,
  waitExitCode,
  )

import qualified Polysemy.Process.Data.SystemProcessError as SystemProcessError
import Polysemy.Process.Data.SystemProcessError (SystemProcessError, SystemProcessScopeError (StartFailed))
import qualified Polysemy.Process.Effect.SystemProcess as SystemProcess
import Polysemy.Process.Effect.SystemProcess (SystemProcess)

-- |Convenience alias for a vanilla 'ProcessConfig', which will usually be transformed by interpreters to use 'Handle's.
type SysProcConf =
  ProcessConfig () () ()

-- |Convenience alias for the 'Process' type used by native interpreters.
type PipesProcess =
  Process Handle Handle Handle

processWithPipes :: SysProcConf -> ProcessConfig Handle Handle Handle
processWithPipes :: SysProcConf -> ProcessConfig Handle Handle Handle
processWithPipes =
  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)
-> (SysProcConf -> ProcessConfig () Handle Handle)
-> SysProcConf
-> 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)
-> (SysProcConf -> ProcessConfig () () Handle)
-> SysProcConf
-> ProcessConfig () Handle Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  StreamSpec 'STOutput Handle
-> SysProcConf -> 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

start ::
  Members [Stop SystemProcessScopeError, Embed IO] r =>
  SysProcConf ->
  Sem r PipesProcess
start :: forall (r :: EffectRow).
Members '[Stop SystemProcessScopeError, Embed IO] r =>
SysProcConf -> Sem r PipesProcess
start =
  (Text -> SystemProcessScopeError)
-> IO PipesProcess -> Sem r PipesProcess
forall err (r :: EffectRow) a.
Members '[Stop err, Embed IO] r =>
(Text -> err) -> IO a -> Sem r a
stopTryIOError Text -> SystemProcessScopeError
SystemProcessError.StartFailed (IO PipesProcess -> Sem r PipesProcess)
-> (SysProcConf -> IO PipesProcess)
-> SysProcConf
-> Sem r PipesProcess
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ProcessConfig Handle Handle Handle -> IO PipesProcess
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess (ProcessConfig Handle Handle Handle -> IO PipesProcess)
-> (SysProcConf -> ProcessConfig Handle Handle Handle)
-> SysProcConf
-> IO PipesProcess
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  SysProcConf -> ProcessConfig Handle Handle Handle
processWithPipes

withProcess ::
  Members [Resource, Stop SystemProcessScopeError, Embed IO] r =>
  SysProcConf ->
  (PipesProcess -> Sem r a) ->
  Sem r a
withProcess :: forall (r :: EffectRow) a.
Members '[Resource, Stop SystemProcessScopeError, Embed IO] r =>
SysProcConf -> (PipesProcess -> Sem r a) -> Sem r a
withProcess SysProcConf
config PipesProcess -> Sem r a
use =
  Sem r PipesProcess
-> (PipesProcess -> Sem r (Either Text ()))
-> (PipesProcess -> Sem r a)
-> Sem r a
forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket (SysProcConf -> Sem r PipesProcess
forall (r :: EffectRow).
Members '[Stop SystemProcessScopeError, Embed IO] r =>
SysProcConf -> Sem r PipesProcess
start SysProcConf
config) (IO () -> Sem r (Either Text ())
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryIOError (IO () -> Sem r (Either Text ()))
-> (PipesProcess -> IO ())
-> PipesProcess
-> Sem r (Either Text ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipesProcess -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess) \ PipesProcess
p -> do
    Handle -> Sem r ()
forall {r :: EffectRow}. Member (Embed IO) r => Handle -> Sem r ()
unbuffer (PipesProcess -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin PipesProcess
p)
    Handle -> Sem r ()
forall {r :: EffectRow}. Member (Embed IO) r => Handle -> Sem r ()
unbuffer (PipesProcess -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout PipesProcess
p)
    Handle -> Sem r ()
forall {r :: EffectRow}. Member (Embed IO) r => Handle -> Sem r ()
unbuffer (PipesProcess -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr PipesProcess
p)
    PipesProcess -> Sem r a
use PipesProcess
p
  where
    unbuffer :: Handle -> Sem r ()
unbuffer Handle
h =
      Sem r (Maybe ()) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Maybe ()) -> Sem r ()) -> Sem r (Maybe ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ IO () -> Sem r (Maybe ())
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Maybe a)
tryMaybe (Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
NoBuffering)

withProcessOpaque ::
  Members [Resource, Embed IO] r =>
  ProcessConfig i o e ->
  (Process i o e -> Sem r a) ->
  Sem r a
withProcessOpaque :: forall (r :: EffectRow) i o e a.
Members '[Resource, Embed IO] r =>
ProcessConfig i o e -> (Process i o e -> Sem r a) -> Sem r a
withProcessOpaque ProcessConfig i o e
config =
  Sem r (Process i o e)
-> (Process i o e -> Sem r (Either Text ()))
-> (Process i o e -> Sem r a)
-> Sem r a
forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket (ProcessConfig i o e -> Sem r (Process i o e)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess ProcessConfig i o e
config) (IO () -> Sem r (Either Text ())
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryIOError (IO () -> Sem r (Either Text ()))
-> (Process i o e -> IO ())
-> Process i o e
-> Sem r (Either Text ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process i o e -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess)

terminate ::
  Member (Stop SystemProcessError) r =>
  Text ->
  Maybe a ->
  Sem r a
terminate :: forall (r :: EffectRow) a.
Member (Stop SystemProcessError) r =>
Text -> Maybe a -> Sem r a
terminate Text
msg =
  SystemProcessError -> Maybe a -> Sem r a
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (Text -> SystemProcessError
SystemProcessError.Terminated Text
msg)

tryStop ::
  Members [Stop SystemProcessError, Embed IO] r =>
  Text ->
  IO a ->
  Sem r a
tryStop :: forall (r :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
Text -> IO a -> Sem r a
tryStop Text
msg =
  Text -> Maybe a -> Sem r a
forall (r :: EffectRow) a.
Member (Stop SystemProcessError) r =>
Text -> Maybe a -> Sem r a
terminate Text
msg (Maybe a -> Sem r a)
-> (IO a -> Sem r (Maybe a)) -> IO a -> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO a -> Sem r (Maybe a)
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Maybe a)
tryMaybe

processId ::
  Members [Stop SystemProcessError, Embed IO] r =>
  Process i o e ->
  Sem r Pid
processId :: forall (r :: EffectRow) i o e.
Members '[Stop SystemProcessError, Embed IO] r =>
Process i o e -> Sem r Pid
processId Process i o e
process =
  Text -> Maybe Pid -> Sem r Pid
forall (r :: EffectRow) a.
Member (Stop SystemProcessError) r =>
Text -> Maybe a -> Sem r a
terminate Text
"getPid returned Nothing" (Maybe Pid -> Sem r Pid) -> Sem r (Maybe Pid) -> Sem r Pid
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe Pid) -> Sem r (Maybe Pid)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (ProcessHandle -> IO (Maybe Pid)
getPid (Process i o e -> ProcessHandle
forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessHandle
unsafeProcessHandle Process i o e
process))

checkEof ::
  Member (Stop SystemProcessError) r =>
  ByteString ->
  Sem r ByteString
checkEof :: forall (r :: EffectRow).
Member (Stop SystemProcessError) r =>
ByteString -> Sem r ByteString
checkEof = \case
  ByteString
"" ->
    SystemProcessError -> Sem r ByteString
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (Text -> SystemProcessError
SystemProcessError.Terminated Text
"Process terminated, empty ByteString read from handle")
  ByteString
b ->
    ByteString -> Sem r ByteString
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
b

-- |Handle 'SystemProcess' with a concrete 'System.Process' with connected pipes.
handleSystemProcessWithProcess ::
  ∀ r r0 a .
  Members [Stop SystemProcessError, Embed IO] r =>
  Process Handle Handle Handle ->
  SystemProcess (Sem r0) a ->
  Sem r a
handleSystemProcessWithProcess :: forall (r :: EffectRow) (r0 :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
PipesProcess -> SystemProcess (Sem r0) a -> Sem r a
handleSystemProcessWithProcess PipesProcess
process = \case
  SystemProcess (Sem r0) a
SystemProcess.Pid ->
    Pid -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pid -> a) -> Sem r Pid -> Sem r a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PipesProcess -> Sem r Pid
forall (r :: EffectRow) i o e.
Members '[Stop SystemProcessError, Embed IO] r =>
Process i o e -> Sem r Pid
processId PipesProcess
process
  SystemProcess.Signal Signal
sig -> do
    Pid
pid <- PipesProcess -> Sem r Pid
forall (r :: EffectRow) i o e.
Members '[Stop SystemProcessError, Embed IO] r =>
Process i o e -> Sem r Pid
processId PipesProcess
process
    Text -> IO a -> Sem r a
forall (r :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
Text -> IO a -> Sem r a
tryStop Text
"signal failed" (Signal -> Pid -> IO ()
Signal.signalProcess Signal
sig Pid
pid)
  SystemProcess (Sem r0) a
SystemProcess.ReadStdout ->
    ByteString -> Sem r a
ByteString -> Sem r ByteString
forall (r :: EffectRow).
Member (Stop SystemProcessError) r =>
ByteString -> Sem r ByteString
checkEof (ByteString -> Sem r a) -> Sem r ByteString -> Sem r a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> IO ByteString -> Sem r ByteString
forall (r :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
Text -> IO a -> Sem r a
tryStop Text
"stdout failed" (Handle -> Int -> IO ByteString
hGetSome (PipesProcess -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout PipesProcess
process) Int
4096)
  SystemProcess (Sem r0) a
SystemProcess.ReadStderr ->
    ByteString -> Sem r a
ByteString -> Sem r ByteString
forall (r :: EffectRow).
Member (Stop SystemProcessError) r =>
ByteString -> Sem r ByteString
checkEof (ByteString -> Sem r a) -> Sem r ByteString -> Sem r a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> IO ByteString -> Sem r ByteString
forall (r :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
Text -> IO a -> Sem r a
tryStop Text
"stderr failed" (Handle -> Int -> IO ByteString
hGetSome (PipesProcess -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr PipesProcess
process) Int
4096)
  SystemProcess.WriteStdin ByteString
msg ->
    Text -> IO a -> Sem r a
forall (r :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
Text -> IO a -> Sem r a
tryStop Text
"stdin failed" (Handle -> ByteString -> IO ()
hPut (PipesProcess -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin PipesProcess
process) ByteString
msg)
  SystemProcess (Sem r0) a
SystemProcess.Wait ->
    Text -> IO a -> Sem r a
forall (r :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
Text -> IO a -> Sem r a
tryStop Text
"wait failed" (PipesProcess -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode PipesProcess
process)

-- |Interpret 'SystemProcess' with a concrete 'System.Process' with connected pipes.
interpretSystemProcessWithProcess ::
  ∀ r .
  Member (Embed IO) r =>
  Process Handle Handle Handle ->
  InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessWithProcess :: forall (r :: EffectRow).
Member (Embed IO) r =>
PipesProcess
-> InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessWithProcess PipesProcess
process =
  (forall x (r0 :: EffectRow).
 SystemProcess (Sem r0) x -> Sem (Stop SystemProcessError : r) x)
-> InterpreterFor (SystemProcess !! SystemProcessError) r
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable (PipesProcess
-> SystemProcess (Sem r0) x -> Sem (Stop SystemProcessError : r) x
forall (r :: EffectRow) (r0 :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
PipesProcess -> SystemProcess (Sem r0) a -> Sem r a
handleSystemProcessWithProcess PipesProcess
process)

-- |Interpret 'SystemProcess' as a single global 'System.Process' that's started immediately.
interpretSystemProcessNativeSingle ::
  ∀ r .
  Members [Stop SystemProcessScopeError, Resource, Embed IO] r =>
  SysProcConf ->
  InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessNativeSingle :: forall (r :: EffectRow).
Members '[Stop SystemProcessScopeError, Resource, Embed IO] r =>
SysProcConf
-> InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessNativeSingle SysProcConf
config Sem ((SystemProcess !! SystemProcessError) : r) a
sem =
  SysProcConf -> (PipesProcess -> Sem r a) -> Sem r a
forall (r :: EffectRow) a.
Members '[Resource, Stop SystemProcessScopeError, Embed IO] r =>
SysProcConf -> (PipesProcess -> Sem r a) -> Sem r a
withProcess SysProcConf
config \ PipesProcess
process ->
    PipesProcess
-> InterpreterFor (SystemProcess !! SystemProcessError) r
forall (r :: EffectRow).
Member (Embed IO) r =>
PipesProcess
-> InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessWithProcess PipesProcess
process Sem ((SystemProcess !! SystemProcessError) : r) a
sem

withProcConf ::
  Members [Stop SystemProcessScopeError, Resource, Embed IO] r =>
  (PipesProcess -> Sem r a) ->
  Either Text SysProcConf ->
  Sem r a
withProcConf :: forall (r :: EffectRow) a.
Members '[Stop SystemProcessScopeError, Resource, Embed IO] r =>
(PipesProcess -> Sem r a) -> Either Text SysProcConf -> Sem r a
withProcConf PipesProcess -> Sem r a
use = \case
  Right SysProcConf
conf ->
    SysProcConf -> (PipesProcess -> Sem r a) -> Sem r a
forall (r :: EffectRow) a.
Members '[Resource, Stop SystemProcessScopeError, Embed IO] r =>
SysProcConf -> (PipesProcess -> Sem r a) -> Sem r a
withProcess SysProcConf
conf PipesProcess -> Sem r a
use
  Left Text
err ->
    SystemProcessScopeError -> Sem r a
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (Text -> SystemProcessScopeError
StartFailed Text
err)
{-# inline withProcConf #-}

-- |Interpret 'SystemProcess' as a scoped 'System.Process' that's started wherever 'Polysemy.Process.withSystemProcess'
-- is called and terminated when the wrapped action finishes.
-- This variant is for parameterized scopes, allowing the consumer to supply a value of type @param@ to create the
-- process config.
interpretSystemProcessNative ::
  ∀ param r .
  Members [Resource, Embed IO] r =>
  (param -> Sem r (Either Text SysProcConf)) ->
  InterpreterFor (Scoped param (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r
interpretSystemProcessNative :: forall param (r :: EffectRow).
Members '[Resource, Embed IO] r =>
(param -> Sem r (Either Text SysProcConf))
-> InterpreterFor
     (Scoped param (SystemProcess !! SystemProcessError)
      !! SystemProcessScopeError)
     r
interpretSystemProcessNative param -> Sem r (Either Text SysProcConf)
config =
  (forall (q :: (* -> *) -> * -> *) x.
 param
 -> (PipesProcess
     -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
 -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
-> (forall (q :: (* -> *) -> * -> *) (r0 :: EffectRow) x.
    PipesProcess
    -> SystemProcess (Sem r0) x
    -> Sem
         (Stop SystemProcessError
            : Stop SystemProcessScopeError : Opaque q : r)
         x)
-> InterpreterFor
     (Scoped param (SystemProcess !! SystemProcessError)
      !! SystemProcessScopeError)
     r
forall param resource (effect :: (* -> *) -> * -> *) eo ei
       (r :: EffectRow).
(forall (q :: (* -> *) -> * -> *) x.
 param
 -> (resource -> Sem (Stop eo : Opaque q : r) x)
 -> Sem (Stop eo : Opaque q : r) x)
-> (forall (q :: (* -> *) -> * -> *) (r0 :: EffectRow) x.
    resource
    -> effect (Sem r0) x -> Sem (Stop ei : Stop eo : Opaque q : r) x)
-> InterpreterFor (Scoped param (effect !! ei) !! eo) r
interpretScopedR (\ param
p PipesProcess -> Sem (Stop SystemProcessScopeError : Opaque q : r) x
u -> Sem (Opaque q : r) (Either Text SysProcConf)
-> Sem
     (Stop SystemProcessScopeError : Opaque q : r)
     (Either Text SysProcConf)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r (Either Text SysProcConf)
-> Sem (Opaque q : r) (Either Text SysProcConf)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (param -> Sem r (Either Text SysProcConf)
config param
p)) Sem
  (Stop SystemProcessScopeError : Opaque q : r)
  (Either Text SysProcConf)
-> (Either Text SysProcConf
    -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
-> Sem (Stop SystemProcessScopeError : Opaque q : r) x
forall a b.
Sem (Stop SystemProcessScopeError : Opaque q : r) a
-> (a -> Sem (Stop SystemProcessScopeError : Opaque q : r) b)
-> Sem (Stop SystemProcessScopeError : Opaque q : r) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PipesProcess
 -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
-> Either Text SysProcConf
-> Sem (Stop SystemProcessScopeError : Opaque q : r) x
forall (r :: EffectRow) a.
Members '[Stop SystemProcessScopeError, Resource, Embed IO] r =>
(PipesProcess -> Sem r a) -> Either Text SysProcConf -> Sem r a
withProcConf PipesProcess -> Sem (Stop SystemProcessScopeError : Opaque q : r) x
u) PipesProcess
-> SystemProcess (Sem r0) x
-> Sem
     (Stop SystemProcessError
        : Stop SystemProcessScopeError : Opaque q : r)
     x
forall (r :: EffectRow) (r0 :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
PipesProcess -> SystemProcess (Sem r0) a -> Sem r a
forall (q :: (* -> *) -> * -> *) (r0 :: EffectRow) x.
PipesProcess
-> SystemProcess (Sem r0) x
-> Sem
     (Stop SystemProcessError
        : Stop SystemProcessScopeError : Opaque q : r)
     x
handleSystemProcessWithProcess

-- |Interpret 'SystemProcess' as a scoped 'System.Process' that's started wherever 'Polysemy.Process.withSystemProcess'
-- is called and terminated when the wrapped action finishes.
-- This variant takes a static 'SysProcConf'.
interpretSystemProcessNative_ ::
  ∀ r .
  Members [Resource, Embed IO] r =>
  SysProcConf ->
  InterpreterFor (Scoped_ (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r
interpretSystemProcessNative_ :: forall (r :: EffectRow).
Members '[Resource, Embed IO] r =>
SysProcConf
-> InterpreterFor
     (Scoped_ (SystemProcess !! SystemProcessError)
      !! SystemProcessScopeError)
     r
interpretSystemProcessNative_ SysProcConf
config =
  (forall (q :: (* -> *) -> * -> *) x.
 ()
 -> (PipesProcess
     -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
 -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
-> (forall (q :: (* -> *) -> * -> *) (r0 :: EffectRow) x.
    PipesProcess
    -> SystemProcess (Sem r0) x
    -> Sem
         (Stop SystemProcessError
            : Stop SystemProcessScopeError : Opaque q : r)
         x)
-> InterpreterFor
     (Scoped_ (SystemProcess !! SystemProcessError)
      !! SystemProcessScopeError)
     r
forall param resource (effect :: (* -> *) -> * -> *) eo ei
       (r :: EffectRow).
(forall (q :: (* -> *) -> * -> *) x.
 param
 -> (resource -> Sem (Stop eo : Opaque q : r) x)
 -> Sem (Stop eo : Opaque q : r) x)
-> (forall (q :: (* -> *) -> * -> *) (r0 :: EffectRow) x.
    resource
    -> effect (Sem r0) x -> Sem (Stop ei : Stop eo : Opaque q : r) x)
-> InterpreterFor (Scoped param (effect !! ei) !! eo) r
interpretScopedR (((PipesProcess
  -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
 -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
-> ()
-> (PipesProcess
    -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
-> Sem (Stop SystemProcessScopeError : Opaque q : r) x
forall a b. a -> b -> a
const (SysProcConf
-> (PipesProcess
    -> Sem (Stop SystemProcessScopeError : Opaque q : r) x)
-> Sem (Stop SystemProcessScopeError : Opaque q : r) x
forall (r :: EffectRow) a.
Members '[Resource, Stop SystemProcessScopeError, Embed IO] r =>
SysProcConf -> (PipesProcess -> Sem r a) -> Sem r a
withProcess SysProcConf
config)) PipesProcess
-> SystemProcess (Sem r0) x
-> Sem
     (Stop SystemProcessError
        : Stop SystemProcessScopeError : Opaque q : r)
     x
forall (r :: EffectRow) (r0 :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
PipesProcess -> SystemProcess (Sem r0) a -> Sem r a
forall (q :: (* -> *) -> * -> *) (r0 :: EffectRow) x.
PipesProcess
-> SystemProcess (Sem r0) x
-> Sem
     (Stop SystemProcessError
        : Stop SystemProcessScopeError : Opaque q : r)
     x
handleSystemProcessWithProcess

-- |Interpret 'SystemProcess' with a concrete 'System.Process' with no connection to stdio.
interpretSystemProcessWithProcessOpaque ::
  ∀ i o e r .
  Member (Embed IO) r =>
  Process i o e ->
  InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessWithProcessOpaque :: forall i o e (r :: EffectRow).
Member (Embed IO) r =>
Process i o e
-> InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessWithProcessOpaque Process i o e
process =
  (forall x (r0 :: EffectRow).
 SystemProcess (Sem r0) x -> Sem (Stop SystemProcessError : r) x)
-> InterpreterFor (SystemProcess !! SystemProcessError) r
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    SystemProcess (Sem r0) x
SystemProcess.Pid ->
      Pid -> x
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pid -> x)
-> Sem (Stop SystemProcessError : r) Pid
-> Sem (Stop SystemProcessError : r) x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process i o e -> Sem (Stop SystemProcessError : r) Pid
forall (r :: EffectRow) i o e.
Members '[Stop SystemProcessError, Embed IO] r =>
Process i o e -> Sem r Pid
processId Process i o e
process
    SystemProcess.Signal Signal
sig -> do
      Pid
pid <- Process i o e -> Sem (Stop SystemProcessError : r) Pid
forall (r :: EffectRow) i o e.
Members '[Stop SystemProcessError, Embed IO] r =>
Process i o e -> Sem r Pid
processId Process i o e
process
      Text -> IO x -> Sem (Stop SystemProcessError : r) x
forall (r :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
Text -> IO a -> Sem r a
tryStop Text
"signal failed" (Signal -> Pid -> IO ()
Signal.signalProcess Signal
sig Pid
pid)
    SystemProcess (Sem r0) x
SystemProcess.ReadStdout ->
      SystemProcessError -> Sem (Stop SystemProcessError : r) x
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop SystemProcessError
SystemProcessError.NoPipes
    SystemProcess (Sem r0) x
SystemProcess.ReadStderr ->
      SystemProcessError -> Sem (Stop SystemProcessError : r) x
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop SystemProcessError
SystemProcessError.NoPipes
    SystemProcess.WriteStdin ByteString
_ ->
      SystemProcessError -> Sem (Stop SystemProcessError : r) x
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop SystemProcessError
SystemProcessError.NoPipes
    SystemProcess (Sem r0) x
SystemProcess.Wait ->
      Text -> IO x -> Sem (Stop SystemProcessError : r) x
forall (r :: EffectRow) a.
Members '[Stop SystemProcessError, Embed IO] r =>
Text -> IO a -> Sem r a
tryStop Text
"wait failed" (Process i o e -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode Process i o e
process)

-- |Interpret 'SystemProcess' as a single global 'System.Process' that's started immediately.
interpretSystemProcessNativeOpaqueSingle ::
  ∀ i o e r .
  Members [Resource, Embed IO] r =>
  ProcessConfig i o e ->
  InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessNativeOpaqueSingle :: forall i o e (r :: EffectRow).
Members '[Resource, Embed IO] r =>
ProcessConfig i o e
-> InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessNativeOpaqueSingle ProcessConfig i o e
config Sem ((SystemProcess !! SystemProcessError) : r) a
sem =
  ProcessConfig i o e -> (Process i o e -> Sem r a) -> Sem r a
forall (r :: EffectRow) i o e a.
Members '[Resource, Embed IO] r =>
ProcessConfig i o e -> (Process i o e -> Sem r a) -> Sem r a
withProcessOpaque ProcessConfig i o e
config \ Process i o e
process ->
    Process i o e
-> InterpreterFor (SystemProcess !! SystemProcessError) r
forall i o e (r :: EffectRow).
Member (Embed IO) r =>
Process i o e
-> InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessWithProcessOpaque Process i o e
process Sem ((SystemProcess !! SystemProcessError) : r) a
sem

-- |Interpret 'SystemProcess' as a scoped 'System.Process' that's started wherever 'Polysemy.Process.withSystemProcess'
-- is called and terminated when the wrapped action finishes.
interpretSystemProcessNativeOpaque ::
  ∀ i o e r .
  Members [Resource, Embed IO] r =>
  ProcessConfig i o e ->
  InterpreterFor (Scoped_ (SystemProcess !! SystemProcessError)) r
interpretSystemProcessNativeOpaque :: forall i o e (r :: EffectRow).
Members '[Resource, Embed IO] r =>
ProcessConfig i o e
-> InterpreterFor (Scoped_ (SystemProcess !! SystemProcessError)) r
interpretSystemProcessNativeOpaque ProcessConfig i o e
config =
  (forall (q :: (* -> *) -> * -> *).
 ()
 -> InterpreterFor
      (SystemProcess !! SystemProcessError) (Opaque q : r))
-> InterpreterFor (Scoped_ (SystemProcess !! SystemProcessError)) r
forall param (effect :: (* -> *) -> * -> *) (r :: EffectRow).
(forall (q :: (* -> *) -> * -> *).
 param -> InterpreterFor effect (Opaque q : r))
-> InterpreterFor (Scoped param effect) r
runScopedNew \ () -> ProcessConfig i o e
-> forall {a}.
   Sem ((SystemProcess !! SystemProcessError) : Opaque q : r) a
   -> Sem (Opaque q : r) a
forall i o e (r :: EffectRow).
Members '[Resource, Embed IO] r =>
ProcessConfig i o e
-> InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessNativeOpaqueSingle ProcessConfig i o e
config