polysemy-process-0.9.0.0: Polysemy effects for system processes
Safe HaskellSafe-Inferred
LanguageHaskell2010

Polysemy.Process

Description

 
Synopsis

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

Instances details
type DefiningModule Process Source # 
Instance details

Defined in Polysemy.Process.Effect.Process

type DefiningModule Process = "Polysemy.Process.Effect.Process"

recv :: forall i o r. Member (Process i o) r => Sem r o Source #

Obtain a chunk of output.

send :: forall i o r. Member (Process i o) r => i -> Sem r () Source #

Send data to stdin.

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 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

Instances details
Show ProcessKill Source # 
Instance details

Defined in Polysemy.Process.Data.ProcessKill

Eq ProcessKill Source # 
Instance details

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

Instances details
type DefiningModule ProcessOutput Source # 
Instance details

Defined in Polysemy.Process.Effect.ProcessOutput

type DefiningModule ProcessOutput = "Polysemy.Process.Effect.ProcessOutput"

data OutputPipe Source #

Kind tag for selecting the ProcessOutput handler for stdout/stderr.

Constructors

Stdout

Tag for stdout.

Stderr

Tag for stderr.

Instances

Instances details
Show OutputPipe Source # 
Instance details

Defined in Polysemy.Process.Effect.ProcessOutput

Eq OutputPipe Source # 
Instance details

Defined in Polysemy.Process.Effect.ProcessOutput

type DefiningModule ProcessOutput Source # 
Instance details

Defined in Polysemy.Process.Effect.ProcessOutput

type DefiningModule ProcessOutput = "Polysemy.Process.Effect.ProcessOutput"

data ProcessOutputParseResult a Source #

An incremental parse result, potentially a partial result containing a continuation function.

Constructors

Done 

Fields

Partial 
Fail 

Fields

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

Instances details
type DefiningModule ProcessInput Source # 
Instance details

Defined in Polysemy.Process.Effect.ProcessInput

type DefiningModule ProcessInput = "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

Instances details
type DefiningModule SystemProcess Source # 
Instance details

Defined in Polysemy.Process.Effect.SystemProcess

type DefiningModule SystemProcess = "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

data Pty :: Effect Source #

A pseudo terminal, to be scoped with withPty.

Instances

Instances details
type DefiningModule Pty Source # 
Instance details

Defined in Polysemy.Process.Effect.Pty

type DefiningModule Pty = "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 Handle by the interpreter.

-> 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 Handle by the interpreter.

-> 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 Handle by the interpreter.

-> 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 Handle by the interpreter.

-> 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 #

Interpret Process with a system process resource whose stdin/stdout are connected to two TBMQueues, producing Texts. Silently discards stderr.

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 #

Interpret Process with a system process resource whose stdin/stdout are connected to two TBMQueues, producing chunks of lines of Texts. Silently discards stderr.

interpretInputOutputProcess :: forall i o r. Member (Process i o) r => InterpretersFor [Input o, Output i] r Source #

Reinterpret Input and Output as Process.

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

SystemProcess

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

Tools

resolveExecutable Source #

Arguments

:: Member (Embed IO) r 
=> Path Rel File

Executable name, for $PATH lookup and error messages

-> Maybe (Path Abs File)

Explicit override to be checked for adequate permissions

-> Sem r (Either Text (Path Abs File)) 

Find a file in $PATH, verifying that it is executable by this process.