| Safe Haskell | Safe-Inferred |
|---|---|
| Language | Haskell2010 |
Polysemy.Process
Description
Synopsis
- data Process i o :: Effect
- recv :: forall i o r. Member (Process i o) r => Sem r o
- send :: forall i o r. Member (Process i o) r => i -> Sem r ()
- withProcess :: forall resource i o r. Member (Scoped resource (Process i o)) r => InterpreterFor (Process i o) r
- data ProcessOptions = ProcessOptions Bool Int ProcessKill
- data ProcessKill
- data ProcessOutput (p :: OutputPipe) a :: Effect
- data OutputPipe
- data ProcessOutputParseResult a
- data ProcessInput a :: Effect
- data SystemProcess :: Effect
- withSystemProcess :: forall resource err r. Member (Scoped resource (SystemProcess !! err)) r => InterpreterFor (SystemProcess !! err) r
- data Pty :: Effect
- withPty :: forall resource r. Member (Scoped resource Pty) r => InterpreterFor Pty r
- interpretProcessByteStringNative :: Members [Resource, Race, Async, Embed IO] r => ProcessOptions -> ProcessConfig () () () -> InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r
- interpretProcessByteStringLinesNative :: Members [Resource, Race, Async, Embed IO] r => ProcessOptions -> ProcessConfig () () () -> InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r
- interpretProcessTextNative :: Members [Resource, Race, Async, Embed IO] r => ProcessOptions -> ProcessConfig () () () -> InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r
- interpretProcessTextLinesNative :: Members [Resource, Race, Async, Embed IO] r => ProcessOptions -> ProcessConfig () () () -> InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r
- interpretProcess :: forall resource err i o r. Member (Scoped resource (SystemProcess !! err)) r => Members [ProcessOutput 'Stdout o, ProcessOutput 'Stderr o, ProcessInput i, Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process i o) !! ProcessError) r
- interpretProcessByteString :: forall resource err r. Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r
- interpretProcessByteStringLines :: forall resource err r. Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r
- interpretProcessText :: forall resource err r. Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r
- interpretProcessTextLines :: forall resource err r. Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r
- interpretInputOutputProcess :: forall i o r. Member (Process i o) r => InterpretersFor [Input o, Output i] r
- interpretInputHandleBuffered :: Member (Embed IO) r => Handle -> InterpreterFor (Input ByteString !! ProcessError) r
- interpretInputHandle :: Member (Embed IO) r => Handle -> InterpreterFor (Input ByteString !! ProcessError) r
- interpretOutputHandleBuffered :: Member (Embed IO) r => Handle -> InterpreterFor (Output ByteString !! ProcessError) r
- interpretOutputHandle :: Member (Embed IO) r => Handle -> InterpreterFor (Output ByteString !! ProcessError) r
- interpretProcessIO :: forall i o ie oe r. Members [Input ByteString !! ie, Output ByteString !! oe] r => Members [ProcessInput i, ProcessOutput 'Stdout o, Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Process i o !! ProcessError) r
- interpretProcessHandles :: forall i o r. Members [ProcessInput i, ProcessOutput 'Stdout o, Resource, Race, Async, Embed IO] r => ProcessOptions -> Handle -> Handle -> InterpreterFor (Process i o !! ProcessError) r
- interpretProcessCurrent :: Members [ProcessInput i, ProcessOutput 'Stdout o, Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Process i o !! ProcessError) r
- interpretProcessOutputIgnore :: forall p a r. InterpreterFor (ProcessOutput p a) r
- interpretProcessOutputId :: forall p r. InterpreterFor (ProcessOutput p ByteString) r
- interpretProcessOutputLeft :: forall p a b r. Member (ProcessOutput p a) r => InterpreterFor (ProcessOutput p (Either a b)) r
- interpretProcessOutputRight :: forall p a b r. Member (ProcessOutput p b) r => InterpreterFor (ProcessOutput p (Either a b)) r
- interpretProcessOutputLines :: forall p r. InterpreterFor (ProcessOutput p ByteString) r
- interpretProcessOutputText :: forall p r. InterpreterFor (ProcessOutput p Text) r
- interpretProcessOutputTextLines :: forall p r. InterpreterFor (ProcessOutput p Text) r
- interpretProcessOutputIncremental :: forall p a r. (ByteString -> ProcessOutputParseResult a) -> InterpreterFor (ProcessOutput p (Either Text a)) r
- interpretProcessInputId :: InterpreterFor (ProcessInput ByteString) r
- interpretProcessInputText :: InterpreterFor (ProcessInput Text) r
- interpretSystemProcessWithProcess :: forall r. Member (Embed IO) r => Process Handle Handle Handle -> InterpreterFor (SystemProcess !! SystemProcessError) r
- interpretSystemProcessNativeSingle :: forall r. Members [Resource, Embed IO] r => ProcessConfig () () () -> InterpreterFor (SystemProcess !! SystemProcessError) r
- interpretSystemProcessNative :: forall r. Members [Resource, Embed IO] r => ProcessConfig () () () -> InterpreterFor (Scoped PipesProcess (SystemProcess !! SystemProcessError)) r
- interpretSystemProcessWithProcessOpaque :: forall i o e r. Member (Embed IO) r => Process i o e -> InterpreterFor (SystemProcess !! SystemProcessError) r
- interpretSystemProcessNativeOpaqueSingle :: forall i o e r. Members [Resource, Embed IO] r => ProcessConfig i o e -> InterpreterFor (SystemProcess !! SystemProcessError) r
- interpretSystemProcessNativeOpaque :: forall i o e r. Members [Resource, Embed IO] r => ProcessConfig i o e -> InterpreterFor (Scoped (Process i o e) (SystemProcess !! SystemProcessError)) r
- interpretPty :: Members [Resource, Embed IO] r => InterpreterFor (Scoped PtyResources Pty !! PtyError) r
- resolveExecutable :: Member (Embed IO) r => Path Rel File -> Maybe (Path Abs File) -> Sem r (Either Text (Path Abs File))
Introduction
This library provides an abstraction of a system process in the effect Process, whose constructors represent the
three standard file descriptors.
An intermediate effect, SystemProcess, is more concretely tied to the functionality of the System.Process
library.
See Polysemy.Process.SystemProcess for its constructors.
The utility effect ProcessOutput takes care of decoding the process output, getting called by the Process
interpreters whenever a chunk was read, while accumulating chunks until they were decoded successfully.
See Polysemy.Process.ProcessOutput for its constructors.
The effect Pty abstracts pseudo terminals.
See Polysemy.Process.Pty for its constructors.
Effects
Process
data Process i o :: Effect Source #
Abstraction of a process with input and output.
This effect is intended to be used in a scoped manner:
import Polysemy.Resume
import Polysemy.Conc
import Polysemy.Process
import qualified System.Process.Typed as System
prog :: Member (Scoped resource (Process Text Text !! err)) r => Sem r Text
prog =
resumeAs "failed" do
withProcess do
send "input"
recv
main :: IO ()
main = do
out <- runConc $ interpretProcessNative (System.proc "cat" []) prog
putStrLn out
Instances
| type DefiningModule Process Source # | |
Defined in Polysemy.Process.Effect.Process | |
withProcess :: forall resource i o r. Member (Scoped resource (Process i o)) r => InterpreterFor (Process i o) r Source #
Create a scoped resource for Process.
data ProcessOptions Source #
Controls the behaviour of Process interpreters.
Constructors
| ProcessOptions Bool Int ProcessKill |
Instances
| Show ProcessOptions Source # | |
Defined in Polysemy.Process.Data.ProcessOptions Methods showsPrec :: Int -> ProcessOptions -> ShowS # show :: ProcessOptions -> String # showList :: [ProcessOptions] -> ShowS # | |
| Default ProcessOptions Source # | |
Defined in Polysemy.Process.Data.ProcessOptions Methods def :: ProcessOptions # | |
| Eq ProcessOptions Source # | |
Defined in Polysemy.Process.Data.ProcessOptions Methods (==) :: ProcessOptions -> ProcessOptions -> Bool # (/=) :: ProcessOptions -> ProcessOptions -> Bool # | |
data ProcessKill Source #
Indicate whether to kill a process after exiting the scope in which it was used, if it hasn't terminated.
Constructors
| KillAfter NanoSeconds | Wait for the specified interval, then kill. |
| KillImmediately | Kill immediately. |
| KillNever | Wait indefinitely for the process to terminate. |
Instances
| Show ProcessKill Source # | |
Defined in Polysemy.Process.Data.ProcessKill Methods showsPrec :: Int -> ProcessKill -> ShowS # show :: ProcessKill -> String # showList :: [ProcessKill] -> ShowS # | |
| Eq ProcessKill Source # | |
Defined in Polysemy.Process.Data.ProcessKill | |
ProcessOutput
data ProcessOutput (p :: OutputPipe) a :: Effect Source #
This effect is used by the effect Process to accumulate and decode chunks of ByteStrings, for
example using a parser.
The interpreter may be stateful or stateless, since the constructor Chunk is expected to be called with both the
accumulated unprocessed output as well as the new chunk.
Instances
| type DefiningModule ProcessOutput Source # | |
Defined in Polysemy.Process.Effect.ProcessOutput | |
data OutputPipe Source #
Kind tag for selecting the ProcessOutput handler for stdout/stderr.
Instances
| Show OutputPipe Source # | |
Defined in Polysemy.Process.Effect.ProcessOutput Methods showsPrec :: Int -> OutputPipe -> ShowS # show :: OutputPipe -> String # showList :: [OutputPipe] -> ShowS # | |
| Eq OutputPipe Source # | |
Defined in Polysemy.Process.Effect.ProcessOutput | |
| type DefiningModule ProcessOutput Source # | |
Defined in Polysemy.Process.Effect.ProcessOutput | |
data ProcessOutputParseResult a Source #
An incremental parse result, potentially a partial result containing a continuation function.
Instances
| Show a => Show (ProcessOutputParseResult a) Source # | |
Defined in Polysemy.Process.Data.ProcessOutputParseResult Methods showsPrec :: Int -> ProcessOutputParseResult a -> ShowS # show :: ProcessOutputParseResult a -> String # showList :: [ProcessOutputParseResult a] -> ShowS # | |
ProcessInput
data ProcessInput a :: Effect Source #
This effect is used by the effect Process to encode values for process input.
example using a parser.
Instances
| type DefiningModule ProcessInput Source # | |
Defined in Polysemy.Process.Effect.ProcessInput | |
SystemProcess
data SystemProcess :: Effect Source #
Low-level interface for a process, operating on raw chunks of bytes. Interface is modeled after System.Process.
Instances
| type DefiningModule SystemProcess Source # | |
Defined in Polysemy.Process.Effect.SystemProcess | |
withSystemProcess :: forall resource err r. Member (Scoped resource (SystemProcess !! err)) r => InterpreterFor (SystemProcess !! err) r Source #
Create a scoped resource for SystemProcess.
Pty
A pseudo terminal, to be scoped with withPty.
Instances
| type DefiningModule Pty Source # | |
Defined in Polysemy.Process.Effect.Pty | |
withPty :: forall resource r. Member (Scoped resource Pty) r => InterpreterFor Pty r Source #
Bracket an action with the creation and destruction of a pseudo terminal.
Interpreters
Process
interpretProcessByteStringNative Source #
Arguments
| :: Members [Resource, Race, Async, Embed IO] r | |
| => ProcessOptions | |
| -> ProcessConfig () () () | Basic config. The pipes will be changed to |
| -> InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r |
Interpret Process as a native SystemProcess, producing unaccumulated chunks of ByteString.
Silently discards stderr.
interpretProcessByteStringLinesNative Source #
Arguments
| :: Members [Resource, Race, Async, Embed IO] r | |
| => ProcessOptions | |
| -> ProcessConfig () () () | Basic config. The pipes will be changed to |
| -> InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r |
Interpret Process as a native SystemProcess, producing lines of ByteString.
Silently discards stderr.
interpretProcessTextNative Source #
Arguments
| :: Members [Resource, Race, Async, Embed IO] r | |
| => ProcessOptions | |
| -> ProcessConfig () () () | Basic config. The pipes will be changed to |
| -> InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r |
Interpret Process as a native SystemProcess, producing unaccumulated chunks of Text.
Silently discards stderr.
interpretProcessTextLinesNative Source #
Arguments
| :: Members [Resource, Race, Async, Embed IO] r | |
| => ProcessOptions | |
| -> ProcessConfig () () () | Basic config. The pipes will be changed to |
| -> InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r |
Interpret Process as a native SystemProcess, producing lines of Text.
Silently discards stderr.
interpretProcess :: forall resource err i o r. Member (Scoped resource (SystemProcess !! err)) r => Members [ProcessOutput 'Stdout o, ProcessOutput 'Stderr o, ProcessInput i, Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process i o) !! ProcessError) r Source #
Interpret Process with a system process resource whose file descriptors are connected to three TBMQueues,
deferring decoding of stdout and stderr to the interpreters of two ProcessOutput effects.
interpretProcessByteString :: forall resource err r. Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r Source #
Interpret Process with a system process resource whose stdin/stdout are connected to two TBMQueues,
producing ByteStrings.
Silently discards stderr.
interpretProcessByteStringLines :: forall resource err r. Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r Source #
Interpret Process with a system process resource whose stdin/stdout are connected to two TBMQueues,
producing chunks of lines of ByteStrings.
Silently discards stderr.
interpretProcessText :: forall resource err r. Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r Source #
interpretProcessTextLines :: forall resource err r. Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r Source #
interpretInputOutputProcess :: forall i o r. Member (Process i o) r => InterpretersFor [Input o, Output i] r Source #
interpretInputHandleBuffered :: Member (Embed IO) r => Handle -> InterpreterFor (Input ByteString !! ProcessError) r Source #
Interpret 'Input ByteString' by polling a Handle and stopping with ProcessError when it fails.
interpretInputHandle :: Member (Embed IO) r => Handle -> InterpreterFor (Input ByteString !! ProcessError) r Source #
Interpret 'Input ByteString' by polling a Handle and stopping with ProcessError when it fails.
This variant deactivates buffering for the Handle.
interpretOutputHandleBuffered :: Member (Embed IO) r => Handle -> InterpreterFor (Output ByteString !! ProcessError) r Source #
Interpret 'Output ByteString' by writing to a Handle and stopping with ProcessError when it fails.
interpretOutputHandle :: Member (Embed IO) r => Handle -> InterpreterFor (Output ByteString !! ProcessError) r Source #
Interpret 'Output ByteString' by writing to a Handle and stopping with ProcessError when it fails.
This variant deactivates buffering for the Handle.
interpretProcessIO :: forall i o ie oe r. Members [Input ByteString !! ie, Output ByteString !! oe] r => Members [ProcessInput i, ProcessOutput 'Stdout o, Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Process i o !! ProcessError) r Source #
Interpret Process in terms of Input and Output.
Since the i and o parameters correspond to the abstraction of stdio fds of an external system process, i is
written by Output and o is read from Input.
This is useful to abstract the current process's stdio as an external process, with input and output swapped.
interpretProcessHandles :: forall i o r. Members [ProcessInput i, ProcessOutput 'Stdout o, Resource, Race, Async, Embed IO] r => ProcessOptions -> Handle -> Handle -> InterpreterFor (Process i o !! ProcessError) r Source #
Interpret Process in terms of two Handles.
This is useful to abstract the current process's stdio as an external process, with input and output swapped.
The first Handle argument corresponds to the o parameter, the second one to i, despite the first one usually
being the current process's stdin.
This is due to Process abstracting an external process to whose stdin would be written, while the current one's
is read.
interpretProcessCurrent :: Members [ProcessInput i, ProcessOutput 'Stdout o, Resource, Race, Async, Embed IO] r => ProcessOptions -> InterpreterFor (Process i o !! ProcessError) r Source #
Interpret Process using the current process's stdin and stdout.
This mirrors the usual abstraction of an external process, to whose stdin would be written, while the current one's
is read.
ProcessOutput
interpretProcessOutputIgnore :: forall p a r. InterpreterFor (ProcessOutput p a) r Source #
Interpret ProcessOutput by discarding any output.
interpretProcessOutputId :: forall p r. InterpreterFor (ProcessOutput p ByteString) r Source #
Interpret ProcessOutput by immediately emitting raw ByteStrings without accumulation.
interpretProcessOutputLeft :: forall p a b r. Member (ProcessOutput p a) r => InterpreterFor (ProcessOutput p (Either a b)) r Source #
Transformer for ProcessOutput that lifts results into Left, creating 'ProcessOutput p (Either a b)' from
'ProcessOutput p a'.
interpretProcessOutputRight :: forall p a b r. Member (ProcessOutput p b) r => InterpreterFor (ProcessOutput p (Either a b)) r Source #
Transformer for ProcessOutput that lifts results into Right, creating 'ProcessOutput p (Either a b)' from
'ProcessOutput p b'.
interpretProcessOutputLines :: forall p r. InterpreterFor (ProcessOutput p ByteString) r Source #
Interpret ProcessOutput by emitting individual ByteString lines of output.
interpretProcessOutputText :: forall p r. InterpreterFor (ProcessOutput p Text) r Source #
Interpret ProcessOutput by immediately emitting Text without accumulation.
interpretProcessOutputTextLines :: forall p r. InterpreterFor (ProcessOutput p Text) r Source #
Interpret ProcessOutput by emitting individual Text lines of output.
interpretProcessOutputIncremental :: forall p a r. (ByteString -> ProcessOutputParseResult a) -> InterpreterFor (ProcessOutput p (Either Text a)) r Source #
Whenever a chunk of output arrives, call the supplied incremental parser whose result must be converted to
ProcessOutputParseResult.
If a partial parse result is produced, it is stored in the state and resumed when the next chunk is available.
If parsing an a succeeds, the parser recurses until it fails.
ProcessInput
interpretProcessInputId :: InterpreterFor (ProcessInput ByteString) r Source #
Interpret ProcessInput by passing ByteString through.
interpretProcessInputText :: InterpreterFor (ProcessInput Text) r Source #
Interpret ProcessInput by UTF-8-encoding Text.
SystemProcess
interpretSystemProcessWithProcess :: forall r. Member (Embed IO) r => Process Handle Handle Handle -> InterpreterFor (SystemProcess !! SystemProcessError) r Source #
Interpret SystemProcess with a concrete Process with connected pipes.
interpretSystemProcessNativeSingle :: forall r. Members [Resource, Embed IO] r => ProcessConfig () () () -> InterpreterFor (SystemProcess !! SystemProcessError) r Source #
Interpret SystemProcess as a single global Process that's started immediately.
interpretSystemProcessNative :: forall r. Members [Resource, Embed IO] r => ProcessConfig () () () -> InterpreterFor (Scoped PipesProcess (SystemProcess !! SystemProcessError)) r Source #
Interpret SystemProcess as a scoped Process that's started wherever withSystemProcess
is called and terminated when the wrapped action finishes.
interpretSystemProcessWithProcessOpaque :: forall i o e r. Member (Embed IO) r => Process i o e -> InterpreterFor (SystemProcess !! SystemProcessError) r Source #
Interpret SystemProcess with a concrete Process with connected pipes.
interpretSystemProcessNativeOpaqueSingle :: forall i o e r. Members [Resource, Embed IO] r => ProcessConfig i o e -> InterpreterFor (SystemProcess !! SystemProcessError) r Source #
Interpret SystemProcess as a single global Process that's started immediately.
interpretSystemProcessNativeOpaque :: forall i o e r. Members [Resource, Embed IO] r => ProcessConfig i o e -> InterpreterFor (Scoped (Process i o e) (SystemProcess !! SystemProcessError)) r Source #
Interpret SystemProcess as a scoped Process that's started wherever withSystemProcess
is called and terminated when the wrapped action finishes.
Pty
interpretPty :: Members [Resource, Embed IO] r => InterpreterFor (Scoped PtyResources Pty !! PtyError) r Source #
Interpret Pty as a Pty.