packages feed

polysemy-process 0.9.0.0 → 0.10.0.0

raw patch · 20 files changed

+741/−271 lines, 20 files

Files

+ changelog.md view
@@ -0,0 +1,44 @@+# Unreleased++* Add `oneshot` variants of `Process` interpreters that send `Stop` to the individual actions inside the scope, modeling+  a process that is expected to terminate.+* Refactor interpreters to use `Scoped` as the basis and specialize unparameterized ones.+  Don't provide loads of specializations for I/O types, rather offer interpreters that handle `ProcessOutput` and+  `ProcessInput` only.+* Add constructors for `SysProcConf` that use `Path` and `Text`.+* Add the newtype `Pid` for `SystemProcess`.+* Add `currentPid`.+* Catch exceptions when starting a system process and send them to the scope.+* Change the process config constructor expected by `interpretSystemProcessNative` to return `Either Text SysProcConf`,+  throwing the error as `SystemProcessScopeError`.++# 0.9.0.0++* Remove stderr from the `Process` abstraction so that stdout and stderr must be unified after parsing (potentially as+  `Either` to emulate the previous behaviour).+* Make default `ProcessOutput` interpreters discard all stderr output.+* Add re-interpreter from `Input`/`Output` to `Process`.+* Add `interpretProcessOutputIncremental`, a stateful interpreter using a supplied parser that may produce partial+  results.+* Add `interpretProcessCurrent` et al, treating the program's process's stdio as the (mirrored) stdio of an external+  process.+* Add `interpretProcessOutputLeft` and `interpretProcessOutputRight`, lifting results of another interpreter into+  `Either`.++# 0.8.0.0++* Add `ProcessOptions`, replacing the primitive parameters of `Process` interpreters.+* Add an option for `Process` that determines whether to kill the process after exiting the scope.++# 0.6.0.0++* Allow `Process` to emit custom chunks constructed by an interpreter of `ProcessOutput` instead of `ByteString`s+  containing whatever the `Handle` produced.+* Rename stdio interpreters.+* Add helper `resolveExecutable` that looks up names in `$PATH` and ensures the files are executable.+* Add effect `Pty` for interacting with pseudo terminals.+* Add low-level process abstraction effect, `SystemProcess`.++# 0.5.0.0++* Add the effect `Process`, wrapping `System.Process.Typed` using `Scoped`.
lib/Polysemy/Process.hs view
@@ -9,8 +9,12 @@   recv,   send,   withProcess,+  withProcess_,+  withProcessOneshot,+  withProcessOneshot_,   ProcessOptions (ProcessOptions),   ProcessKill (..),+  ProcessError (..),    -- ** ProcessOutput   ProcessOutput,@@ -23,6 +27,9 @@   -- ** SystemProcess   SystemProcess,   withSystemProcess,+  withSystemProcess_,+  Pid (..),+  currentPid,    -- ** Pty   Pty,@@ -30,15 +37,14 @@    -- * Interpreters   -- ** Process-  interpretProcessByteStringNative,-  interpretProcessByteStringLinesNative,-  interpretProcessTextNative,-  interpretProcessTextLinesNative,   interpretProcess,-  interpretProcessByteString,-  interpretProcessByteStringLines,-  interpretProcessText,-  interpretProcessTextLines,+  interpretProcessOneshot,+  interpretProcessNative,+  interpretProcessOneshotNative,+  interpretProcess_,+  interpretProcessOneshot_,+  interpretProcessNative_,+  interpretProcessOneshotNative_,   interpretInputOutputProcess,   interpretInputHandleBuffered,   interpretInputHandle,@@ -48,6 +54,13 @@   interpretProcessHandles,   interpretProcessCurrent, +  -- ** ProcessIO+  ProcessIO,+  interpretProcessByteString,+  interpretProcessByteStringLines,+  interpretProcessText,+  interpretProcessTextLines,+   -- ** ProcessOutput   interpretProcessOutputIgnore,   interpretProcessOutputId,@@ -63,9 +76,15 @@   interpretProcessInputText,    -- ** SystemProcess+  SysProcConf,+  PipesProcess,+  SystemProcessError,+  SystemProcessScopeError,+  interpretSystemProcessNative,+  interpretSystemProcessNative_,   interpretSystemProcessWithProcess,+  handleSystemProcessWithProcess,   interpretSystemProcessNativeSingle,-  interpretSystemProcessNative,   interpretSystemProcessWithProcessOpaque,   interpretSystemProcessNativeOpaqueSingle,   interpretSystemProcessNativeOpaque,@@ -79,14 +98,25 @@  import Prelude hiding (send) +import Polysemy.Process.Data.Pid (Pid (..))+import Polysemy.Process.Data.ProcessError (ProcessError (..)) import Polysemy.Process.Data.ProcessKill (ProcessKill (..)) import Polysemy.Process.Data.ProcessOptions (ProcessOptions (ProcessOptions)) import Polysemy.Process.Data.ProcessOutputParseResult (ProcessOutputParseResult (..))-import Polysemy.Process.Effect.Process (Process (..), recv, send, withProcess)+import Polysemy.Process.Data.SystemProcessError (SystemProcessError, SystemProcessScopeError)+import Polysemy.Process.Effect.Process (+  Process (..),+  recv,+  send,+  withProcess,+  withProcessOneshot,+  withProcessOneshot_,+  withProcess_,+  ) import Polysemy.Process.Effect.ProcessInput (ProcessInput) import Polysemy.Process.Effect.ProcessOutput (OutputPipe (Stderr, Stdout), ProcessOutput) import Polysemy.Process.Effect.Pty (Pty, withPty)-import Polysemy.Process.Effect.SystemProcess (SystemProcess, withSystemProcess)+import Polysemy.Process.Effect.SystemProcess (SystemProcess, withSystemProcess, withSystemProcess_) import Polysemy.Process.Executable (resolveExecutable) import Polysemy.Process.Interpreter.Process (   interpretInputHandle,@@ -95,15 +125,27 @@   interpretOutputHandle,   interpretOutputHandleBuffered,   interpretProcess,-  interpretProcessByteString,-  interpretProcessByteStringLines,   interpretProcessCurrent,   interpretProcessHandles,   interpretProcessIO,+  interpretProcessNative,+  interpretProcessNative_,+  interpretProcess_,+  )+import Polysemy.Process.Interpreter.ProcessIO (+  ProcessIO,+  interpretProcessByteString,+  interpretProcessByteStringLines,   interpretProcessText,   interpretProcessTextLines,   ) import Polysemy.Process.Interpreter.ProcessInput (interpretProcessInputId, interpretProcessInputText)+import Polysemy.Process.Interpreter.ProcessOneshot (+  interpretProcessOneshot,+  interpretProcessOneshotNative,+  interpretProcessOneshotNative_,+  interpretProcessOneshot_,+  ) import Polysemy.Process.Interpreter.ProcessOutput (   interpretProcessOutputId,   interpretProcessOutputIgnore,@@ -114,21 +156,20 @@   interpretProcessOutputText,   interpretProcessOutputTextLines,   )-import Polysemy.Process.Interpreter.ProcessStdio (-  interpretProcessByteStringLinesNative,-  interpretProcessByteStringNative,-  interpretProcessTextLinesNative,-  interpretProcessTextNative,-  ) import Polysemy.Process.Interpreter.Pty (interpretPty) import Polysemy.Process.Interpreter.SystemProcess (+  PipesProcess,+  SysProcConf,+  handleSystemProcessWithProcess,   interpretSystemProcessNative,   interpretSystemProcessNativeOpaque,   interpretSystemProcessNativeOpaqueSingle,   interpretSystemProcessNativeSingle,+  interpretSystemProcessNative_,   interpretSystemProcessWithProcess,   interpretSystemProcessWithProcessOpaque,   )+import Polysemy.Process.SystemProcess (currentPid)  -- $intro -- This library provides an abstraction of a system process in the effect 'Process', whose constructors represent the
+ lib/Polysemy/Process/Data/Pid.hs view
@@ -0,0 +1,8 @@+-- |Pid data type, Internal+module Polysemy.Process.Data.Pid where++-- |A process ID.+newtype Pid =+  Pid { unPid :: Int }+  deriving stock (Eq, Show, Read)+  deriving newtype (Num, Real, Enum, Integral, Ord)
lib/Polysemy/Process/Data/ProcessError.hs view
@@ -1,9 +1,20 @@ {-# options_haddock prune #-}+ -- |Description: ProcessError, Internal module Polysemy.Process.Data.ProcessError where +import System.Exit (ExitCode)++import Polysemy.Process.Data.SystemProcessError (SystemProcessScopeError)+ -- |Signal error for 'Polysemy.Process.Process'. data ProcessError =-  -- |The process terminated.-  Terminated Text+  -- |Something broke.+  Unknown Text+  |+  -- |The process failed to start.+  StartFailed SystemProcessScopeError+  |+  -- |The process terminated with exit code.+  Exit ExitCode   deriving stock (Eq, Show)
lib/Polysemy/Process/Data/SystemProcessError.hs view
@@ -3,10 +3,17 @@ -- |Description: SystemProcessError, Internal module Polysemy.Process.Data.SystemProcessError where --- |Signal error for 'Polysemy.Process.SystemProcess'.+-- |Error for 'Polysemy.Process.SystemProcess'. data SystemProcessError =   -- |The process terminated.   Terminated Text   |+  -- |Stdio was requested, but the process was started without pipes.   NoPipes+  deriving stock (Eq, Show)++-- |Error for the scope of 'Polysemy.Process.SystemProcess'.+data SystemProcessScopeError =+  -- |The process couldn't start.+  StartFailed Text   deriving stock (Eq, Show)
lib/Polysemy/Process/Effect/Process.hs view
@@ -3,7 +3,7 @@ -- |Description: Process Effect, Internal module Polysemy.Process.Effect.Process where -import Polysemy.Conc.Effect.Scoped (Scoped, scoped)+import Polysemy.Conc.Effect.Scoped (Scoped, Scoped_, scoped, scoped_) import Polysemy.Input (Input (Input)) import Polysemy.Output (Output (Output)) import Polysemy.Resume (interpretResumable, restop, type (!!))@@ -11,7 +11,7 @@  -- |Abstraction of a process with input and output. ----- This effect is intended to be used in a scoped manner:+-- This effect is intended to be used in a scoped_ manner: -- -- @ -- import Polysemy.Resume@@ -19,7 +19,7 @@ -- import Polysemy.Process -- import qualified System.Process.Typed as System ----- prog :: Member (Scoped resource (Process Text Text !! err)) r => Sem r Text+-- prog :: Member (Scoped_ (Process Text Text !! err)) r => Sem r Text -- prog = --  resumeAs "failed" do --    withProcess do@@ -50,20 +50,72 @@   i ->   Sem r () --- |Create a scoped resource for 'Process'.+-- |Create a scoped_ resource for 'Process'.+-- The process configuration may depend on the provided value of type @param@.+-- This variant models daemon processes that are expected to run forever, with 'Polysemy.Resume.Stop' being sent to this+-- function, if at all. withProcess ::-  ∀ resource i o r .-  Member (Scoped resource (Process i o)) r =>+  ∀ param i o r .+  Member (Scoped param (Process i o)) r =>+  param ->   InterpreterFor (Process i o) r withProcess =-  scoped @resource+  scoped @param --- |Convert 'Output' and 'Input' to 'Process'.+-- |Create a scoped_ resource for 'Process'.+-- The process configuration may depend on the provided value of type @param@.+-- This variant models processes that are expected to terminate, with 'Polysemy.Resume.Stop' being sent to individual+-- actions within the scope.+withProcessOneshot ::+  ∀ param i o err r .+  Member (Scoped param (Process i o !! err)) r =>+  param ->+  InterpreterFor (Process i o !! err) r+withProcessOneshot =+  scoped @param++-- |Create a scoped_ resource for 'Process'.+-- The process configuration is provided to the interpreter statically.+-- This variant models daemon processes that are expected to run forever, with 'Polysemy.Resume.Stop' being sent to this+-- function, if at all.+withProcess_ ::+  ∀ i o r .+  Member (Scoped_ (Process i o)) r =>+  InterpreterFor (Process i o) r+withProcess_ =+  scoped_++-- |Create a scoped_ resource for 'Process'.+-- The process configuration is provided to the interpreter statically.+-- This variant models processes that are expected to terminate, with 'Polysemy.Resume.Stop' being sent to individual+-- actions within the scope.+withProcessOneshot_ ::+  ∀ i o err r .+  Member (Scoped_ (Process i o !! err)) r =>+  InterpreterFor (Process i o !! err) r+withProcessOneshot_ =+  scoped_++-- |Convert 'Output' and 'Input' to 'Process' for a daemon process. runProcessIO ::+  ∀ i o r .+  Member (Process i o) r =>+  InterpretersFor [Output i, Input o] r+runProcessIO =+  interpret \case+    Input ->+      recv @i @o+  .+  interpret \case+    Output o ->+      send @i @o o++-- |Convert 'Output' and 'Input' to 'Process' for a oneshot process.+runProcessOneshotIO ::   ∀ i o err r .   Member (Process i o !! err) r =>   InterpretersFor [Output i !! err, Input o !! err] r-runProcessIO =+runProcessOneshotIO =   interpretResumable \case     Input ->       restop @err @(Process i o) (recv @i @o)
lib/Polysemy/Process/Effect/Pty.hs view
@@ -3,7 +3,7 @@ -- |Description: Pty Effect, Internal module Polysemy.Process.Effect.Pty where -import Polysemy.Conc.Effect.Scoped (Scoped, scoped)+import Polysemy.Conc.Effect.Scoped (Scoped_, scoped_) import System.IO (Handle)  -- |Horizontal size of a pseudo terminal in characters.@@ -31,8 +31,7 @@  -- |Bracket an action with the creation and destruction of a pseudo terminal. withPty ::-  ∀ resource r .-  Member (Scoped resource Pty) r =>+  Member (Scoped_ Pty) r =>   InterpreterFor Pty r withPty =-  scoped @resource+  scoped_
lib/Polysemy/Process/Effect/SystemProcess.hs view
@@ -3,13 +3,14 @@ -- |Description: SystemProcess Effect, Internal module Polysemy.Process.Effect.SystemProcess where -import Polysemy.Conc.Effect.Scoped (Scoped, scoped)+import Polysemy.Conc.Effect.Scoped (Scoped, Scoped_, scoped, scoped_) import Polysemy.Resume (type (!!)) import System.Exit (ExitCode) import qualified System.Posix as Signal import System.Posix (Signal)-import System.Process (Pid) +import Polysemy.Process.Data.Pid (Pid)+ -- |Low-level interface for a process, operating on raw chunks of bytes. -- Interface is modeled after "System.Process". data SystemProcess :: Effect where@@ -29,13 +30,24 @@ makeSem ''SystemProcess  -- |Create a scoped resource for 'SystemProcess'.+-- The process configuration may depend on the provided value of type @param@. withSystemProcess ::-  ∀ resource err r .-  Member (Scoped resource (SystemProcess !! err)) r =>+  ∀ param err r .+  Member (Scoped param (SystemProcess !! err)) r =>+  param ->   InterpreterFor (SystemProcess !! err) r withSystemProcess =-  scoped @resource+  scoped @param +-- |Create a scoped resource for 'SystemProcess'.+-- The process configuration is provided to the interpreter statically.+withSystemProcess_ ::+  ∀ err r .+  Member (Scoped_ (SystemProcess !! err)) r =>+  InterpreterFor (SystemProcess !! err) r+withSystemProcess_ =+  scoped_+ -- |Send signal INT(2) to the process. interrupt ::   Member SystemProcess r =>@@ -43,14 +55,14 @@ interrupt =   signal Signal.sigINT --- |Send signal INT(15) to the process.+-- |Send signal TERM(15) to the process. term ::   Member SystemProcess r =>   Sem r () term =   signal Signal.sigTERM --- |Send signal INT(9) to the process.+-- |Send signal KILL(9) to the process. kill ::   Member SystemProcess r =>   Sem r ()
lib/Polysemy/Process/Executable.hs view
@@ -13,7 +13,7 @@   Path Abs File ->   Sem r (Either Text (Path Abs File)) checkExecutable name path =-  tryAny (getPermissions path) <&> \case+  tryIOError (getPermissions path) <&> \case     Right (executable -> True) ->       Right path     Right _ ->@@ -38,7 +38,7 @@   Just path ->     checkExecutable name path   Nothing ->-    tryAny (Path.findExecutable exe) <&> \case+    tryIOError (Path.findExecutable exe) <&> \case       Right (Just path) ->         Right path       _ ->
lib/Polysemy/Process/Interpreter/Process.hs view
@@ -5,24 +5,41 @@  import Control.Concurrent.STM.TBMQueue (TBMQueue) import Data.ByteString (hGetSome, hPut)-import qualified Polysemy.Conc as Conc 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.Effect.Scoped (Scoped, Scoped_)+import qualified Polysemy.Conc.Effect.Sync as Sync+import Polysemy.Conc.Effect.Sync (Sync) import Polysemy.Conc.Interpreter.Queue.TBM (interpretQueueTBMWith, withTBMQueue) import Polysemy.Conc.Interpreter.Scoped (interpretScopedResumableWith_)+import Polysemy.Conc.Interpreter.Sync (interpretSync)+import qualified Polysemy.Conc.Race as Conc (timeout_) import Polysemy.Input (Input (Input)) import Polysemy.Output (Output (Output))-import Polysemy.Resume (Stop, interpretResumable, resumeOr, resume_, stop, stopNote, type (!!))+import Polysemy.Resume (+  Stop,+  interpretResumable,+  mapStop,+  restop,+  resumeHoist,+  resumeOr,+  resume_,+  stop,+  stopNote,+  type (!!),+  ) import Prelude hiding (fromException) import System.IO (BufferMode (NoBuffering), Handle, hSetBuffering, stdin, stdout) -import Polysemy.Process.Data.ProcessError (ProcessError (Terminated))+import qualified Polysemy.Process.Data.ProcessError as ProcessError+import Polysemy.Process.Data.ProcessError (ProcessError (Exit, Unknown)) import Polysemy.Process.Data.ProcessKill (ProcessKill (KillAfter, KillImmediately, KillNever)) import Polysemy.Process.Data.ProcessOptions (ProcessOptions (ProcessOptions))+import qualified Polysemy.Process.Data.SystemProcessError as SystemProcessError+import Polysemy.Process.Data.SystemProcessError (SystemProcessError, SystemProcessScopeError) import qualified Polysemy.Process.Effect.Process as Process import Polysemy.Process.Effect.Process (Process) import qualified Polysemy.Process.Effect.ProcessInput as ProcessInput@@ -30,14 +47,12 @@ import qualified Polysemy.Process.Effect.ProcessOutput as ProcessOutput import Polysemy.Process.Effect.ProcessOutput (OutputPipe (Stderr, Stdout), ProcessOutput) import qualified Polysemy.Process.Effect.SystemProcess as SystemProcess-import Polysemy.Process.Effect.SystemProcess (SystemProcess, withSystemProcess)-import Polysemy.Process.Interpreter.ProcessInput (interpretProcessInputId, interpretProcessInputText)-import Polysemy.Process.Interpreter.ProcessOutput (-  interpretProcessOutputId,-  interpretProcessOutputIgnore,-  interpretProcessOutputLines,-  interpretProcessOutputText,-  interpretProcessOutputTextLines,+import Polysemy.Process.Effect.SystemProcess (SystemProcess, withSystemProcess, withSystemProcess_)+import Polysemy.Process.Interpreter.ProcessIO (ProcessIO)+import Polysemy.Process.Interpreter.SystemProcess (+  SysProcConf,+  interpretSystemProcessNative,+  interpretSystemProcessNative_,   )  newtype In a =@@ -58,6 +73,19 @@     pqOut :: TBMQueue (Out o)   } +terminated ::+  Members [SystemProcess !! SystemProcessError, Stop ProcessError] r =>+  Text ->+  Sem r a+terminated site =+  stop . Exit =<< resumeHoist @_ @SystemProcess fatal SystemProcess.wait+  where+    fatal = \case+      SystemProcessError.Terminated reason ->+        Unknown (site <> ": wait failed (" <> reason <> ")")+      SystemProcessError.NoPipes ->+        Unknown (site <> ": no pipes")+ interpretQueues ::   Members [Resource, Race, Embed IO] r =>   ProcessQueues i o ->@@ -69,19 +97,20 @@ handleProcessWithQueues ::   ∀ i o m r a .   Members [Queue (In i), Queue (Out o), Stop ProcessError] r =>+  (∀ x . Text -> Sem r x) ->   Process i o m a ->   Sem r a-handleProcessWithQueues = \case+handleProcessWithQueues onError = \case   Process.Recv ->     Queue.read >>= \case       QueueResult.Closed ->-        stop (Terminated "closed")+        onError "recv: closed"       QueueResult.NotAvailable ->-        stop (Terminated "impossible: empty")+        onError "recv: impossible: empty"       QueueResult.Success (Out msg) ->         pure msg   Process.Send msg -> do-    whenM (Queue.closed @(In i)) (stop (Terminated "closed"))+    whenM (Queue.closed @(In i)) (onError "send: closed")     Queue.write (In msg)  withSTMResources ::@@ -103,22 +132,32 @@ withQueues qSize action =   withSTMResources qSize \ qs -> interpretQueues qs action +-- |Call a chunk reading action repeatedly, pass the bytes to 'ProcessOutput' and enqueue its results.+-- As soon as an empty chunk is encountered, the queue is closed if the gating action returns 'False'.+-- The conditional closing is for the purpose of keeping the queue alive until the last producer has written all+-- received chunks – this is important when both stdout and stderr are written to the same queue.+-- When a process writes to stdout and terminates, the stderr reader will immediately receive an empty chunk and close+-- the queue while the stdout reader calls 'ProcessOutput', after which 'Queue.write' will fail and the consumer won't+-- receive the output. outputQueue ::   ∀ p chunk err eff r .   Members [eff !! err, ProcessOutput p chunk, Queue (Out chunk), Embed IO] r =>   Bool ->+  Sem r Bool ->   Sem (eff : r) ByteString ->   Sem r ()-outputQueue discardWhenFull readChunk = do+outputQueue discardWhenFull dontClose readChunk = do   spin ""   where     spin buffer =-      resumeOr @err readChunk (write buffer) (const (Queue.close @(Out chunk)))+      resumeOr @err readChunk (write buffer) (const close)     write buffer msg = do       (chunks, newBuffer) <- ProcessOutput.chunk @p @chunk buffer msg       for_ chunks \ (Out -> c) ->         if discardWhenFull then void (Queue.tryWrite c) else Queue.write c       spin newBuffer+    close =+      unlessM dontClose (Queue.close @(Out chunk))  inputQueue ::   ∀ i err eff r .@@ -160,92 +199,134 @@     handleKill kill  type ScopeEffects i o err =-  [Queue (In i), Queue (Out o), SystemProcess !! err]+  [Queue (In i), Queue (Out o), Sync (), SystemProcess !! err] -scope ::-  ∀ i o resource err r .-  Member (Scoped resource (SystemProcess !! err)) r =>+queues ::+  ∀ err i o r .+  Member (SystemProcess !! err) r =>   Members [ProcessInput i, ProcessOutput 'Stdout o, ProcessOutput 'Stderr o, Resource, Race, Async, Embed IO] r =>   ProcessOptions ->-  InterpretersFor (ScopeEffects i o err) r-scope (ProcessOptions discard qSize kill) =-  withSystemProcess @resource .+  InterpretersFor [Queue (In i), Queue (Out o), Sync ()] r+queues (ProcessOptions discard qSize kill) =+  interpretSync .   withQueues qSize .-  withAsync_ (outputQueue @'Stderr @o @err @SystemProcess discard SystemProcess.readStderr) .-  withAsync_ (outputQueue @'Stdout @o @err @SystemProcess discard SystemProcess.readStdout) .+  withAsync_ (outputQueue @'Stderr @o @err @SystemProcess discard (Sync.putTry ()) SystemProcess.readStderr) .+  withAsync_ (outputQueue @'Stdout @o @err @SystemProcess discard (Sync.putTry ()) SystemProcess.readStdout) .   withAsync_ (inputQueue @i @err @SystemProcess SystemProcess.writeStdin) .   withKill @err kill +scope ::+  ∀ serr err i o r .+  Members [Scoped_ (SystemProcess !! err) !! serr, Stop serr] r =>+  Members [ProcessInput i, ProcessOutput 'Stdout o, ProcessOutput 'Stderr o, Resource, Race, Async, Embed IO] r =>+  ProcessOptions ->+  InterpretersFor (ScopeEffects i o err) r+scope options =+  restop @serr @(Scoped_ (SystemProcess !! err)) .+  withSystemProcess_ .+  raiseUnder .+  queues @err options++pscope ::+  ∀ serr i o param proc err r .+  Members [Scoped proc (SystemProcess !! err) !! serr, Stop serr] r =>+  Members [ProcessInput i, ProcessOutput 'Stdout o, ProcessOutput 'Stderr o, Resource, Race, Async, Embed IO] r =>+  ProcessOptions ->+  (param -> Sem r proc) ->+  param ->+  InterpretersFor (ScopeEffects i o err) r+pscope options consResource param sem =+  consResource param >>= \ proc ->+    restop @serr @(Scoped proc (SystemProcess !! err)) $+    withSystemProcess @proc proc $+    raiseUnder $+    queues @err options sem+ -- |Interpret 'Process' with a system process resource whose file descriptors are connected to three 'TBMQueue's, -- deferring decoding of stdout and stderr to the interpreters of two 'ProcessOutput' effects.+-- This variant:+-- - Models a daemon process that is not expected to terminate, causing 'Stop' to be sent to the scope callsite instead+--   of individual 'Process' actions.+-- - Is for parameterized scopes, meaning that a value of arbitrary type may be passed to+--   'Polysemy.Process.withProcessOneshotParam' which is then passed to the supplied function to produce a 'SysProcConf'+--   for the native process. interpretProcess ::-  ∀ 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-interpretProcess options =-  interpretScopedResumableWith_ @(ScopeEffects i o err) (scope @i @o @resource options) handleProcessWithQueues---- |Interpret 'Process' with a system process resource whose stdin/stdout are connected to two 'TBMQueue's,--- producing 'ByteString's.--- Silently discards stderr.-interpretProcessByteString ::-  ∀ resource err r .-  Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r =>+  ∀ param proc i o r .+  Members (ProcessIO i o) r =>+  Member (Scoped proc (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r =>+  Members [Resource, Race, Async, Embed IO] r =>   ProcessOptions ->-  InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r-interpretProcessByteString options =-  interpretProcessOutputIgnore @'Stderr @ByteString .-  interpretProcessOutputId @'Stdout .-  interpretProcessInputId .-  interpretProcess @resource @err options .-  raiseUnder3+  (param -> Sem (Stop ProcessError : r) proc) ->+  InterpreterFor (Scoped param (Process i o) !! ProcessError) r+interpretProcess options proc =+  interpretScopedResumableWith_ @(ScopeEffects i o SystemProcessError) acq (handleProcessWithQueues terminated)+  where+    acq ::+      param ->+      Sem (ScopeEffects i o SystemProcessError ++ Stop ProcessError : r) a ->+      Sem (Stop ProcessError : r) a+    acq p sem =+      mapStop ProcessError.StartFailed do+        pscope @SystemProcessScopeError options (raise . proc) p (insertAt @4 sem) --- |Interpret 'Process' with a system process resource whose stdin/stdout are connected to two 'TBMQueue's,--- producing chunks of lines of 'ByteString's.--- Silently discards stderr.-interpretProcessByteStringLines ::-  ∀ resource err r .-  Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r =>+-- |Interpret 'Process' with a system process resource whose file descriptors are connected to three 'TBMQueue's,+-- deferring decoding of stdout and stderr to the interpreters of two 'ProcessOutput' effects.+-- This variant:+-- - Models a daemon process that is not expected to terminate, causing 'Stop' to be sent to the scope callsite instead+--   of individual 'Process' actions.+-- - Defers process config to 'SystemProcess'.+interpretProcess_ ::+  ∀ i o r .+  Member (Scoped_ (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r =>+  Members [ProcessOutput 'Stdout o, ProcessOutput 'Stderr o, ProcessInput i, Resource, Race, Async, Embed IO] r =>   ProcessOptions ->-  InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r-interpretProcessByteStringLines options =-  interpretProcessOutputIgnore @'Stderr @ByteString .-  interpretProcessOutputLines @'Stdout .-  interpretProcessInputId .-  interpretProcess @resource @err options .-  raiseUnder3+  InterpreterFor (Scoped_ (Process i o) !! ProcessError) r+interpretProcess_ options =+  interpretScopedResumableWith_ @(ScopeEffects i o SystemProcessError) acq (handleProcessWithQueues terminated)+  where+    acq ::+      () ->+      Sem (ScopeEffects i o SystemProcessError ++ Stop ProcessError : r) a ->+      Sem (Stop ProcessError : r) a+    acq () sem =+      mapStop ProcessError.StartFailed do+        scope @SystemProcessScopeError options (insertAt @4 sem) --- |Interpret 'Process' with a system process resource whose stdin/stdout are connected to two 'TBMQueue's,--- producing 'Text's.--- Silently discards stderr.-interpretProcessText ::-  ∀ resource err r .-  Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r =>+-- |Interpret 'Process' as a native 'Polysemy.Process.SystemProcess'.+-- This variant:+-- - Models a daemon process that is not expected to terminate, causing 'Stop' to be sent to the scope callsite instead+--   of individual 'Process' actions.+-- - Is for parameterized scopes, meaning that a value of arbitrary type may be passed to+--   'Polysemy.Process.withProcessOneshotParam' which is then passed to the supplied function to produce a 'SysProcConf'+--   for the native process.+interpretProcessNative ::+  ∀ param i o r .+  Members (ProcessIO i o) r =>+  Members [Resource, Race, Async, Embed IO] r =>   ProcessOptions ->-  InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r-interpretProcessText options =-  interpretProcessOutputIgnore @'Stderr @Text .-  interpretProcessOutputText @'Stdout .-  interpretProcessInputText .-  interpretProcess @resource @err options .-  raiseUnder3+  (param -> Sem r (Either Text SysProcConf)) ->+  InterpreterFor (Scoped param (Process i o) !! ProcessError) r+interpretProcessNative options proc =+  interpretSystemProcessNative pure .+  interpretProcess options (insertAt @0 . proc) .+  raiseUnder --- |Interpret 'Process' with a system process resource whose stdin/stdout are connected to two 'TBMQueue's,--- producing chunks of lines of 'Text's.--- Silently discards stderr.-interpretProcessTextLines ::-  ∀ resource err r .-  Members [Scoped resource (SystemProcess !! err), Resource, Race, Async, Embed IO] r =>+-- |Interpret 'Process' as a native 'Polysemy.Process.SystemProcess'.+-- This variant:+-- - Models a daemon process that is not expected to terminate, causing 'Stop' to be sent to the scope callsite instead+--   of individual 'Process' actions.+-- - Defers process config to 'SystemProcess'.+interpretProcessNative_ ::+  ∀ i o r .+  Members (ProcessIO i o) r =>+  Members [Resource, Race, Async, Embed IO] r =>   ProcessOptions ->-  InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r-interpretProcessTextLines options =-  interpretProcessOutputIgnore @'Stderr @Text .-  interpretProcessOutputTextLines @'Stdout .-  interpretProcessInputText .-  interpretProcess @resource @err options .-  raiseUnder3+  SysProcConf ->+  InterpreterFor (Scoped_ (Process i o) !! ProcessError) r+interpretProcessNative_ options conf =+  interpretSystemProcessNative_ conf .+  interpretProcess_ options .+  raiseUnder  -- |Reinterpret 'Input' and 'Output' as 'Process'. interpretInputOutputProcess ::@@ -264,7 +345,7 @@ interpretInputHandleBuffered handle =   interpretResumable \case     Input ->-      stopNote (Terminated "handle closed") =<< tryMaybe (hGetSome handle 4096)+      stopNote (Unknown "handle closed") =<< tryMaybe (hGetSome handle 4096)  -- |Interpret 'Input ByteString' by polling a 'Handle' and stopping with 'ProcessError' when it fails. -- This variant deactivates buffering for the 'Handle'.@@ -284,7 +365,7 @@ interpretOutputHandleBuffered handle =   interpretResumable \case     Output o ->-      stopNote (Terminated "handle closed") =<< tryMaybe (hPut handle o)+      stopNote (Unknown "handle closed") =<< tryMaybe (hPut handle o)  -- |Interpret 'Output ByteString' by writing to a 'Handle' and stopping with 'ProcessError' when it fails. -- This variant deactivates buffering for the 'Handle'.@@ -308,9 +389,9 @@   InterpreterFor (Process i o !! ProcessError) r interpretProcessIO (ProcessOptions discard qSize _) =   withQueues @i @o qSize .-  withAsync_ (outputQueue @'Stdout @o @ie @(Input ByteString) discard input) .+  withAsync_ (outputQueue @'Stdout @o @ie @(Input ByteString) discard (pure False) input) .   withAsync_ (inputQueue @i @oe @(Output ByteString) output) .-  interpretResumable handleProcessWithQueues .+  interpretResumable (handleProcessWithQueues (stop . Unknown)) .   raiseUnder2  -- |Interpret 'Process' in terms of two 'Handle's.
+ lib/Polysemy/Process/Interpreter/ProcessIO.hs view
@@ -0,0 +1,57 @@+-- |Interpreters for 'ProcessOutput' and 'ProcessInput', Internal+module Polysemy.Process.Interpreter.ProcessIO where++import Polysemy.Process.Effect.ProcessInput (ProcessInput)+import Polysemy.Process.Effect.ProcessOutput (OutputPipe (Stderr, Stdout), ProcessOutput)+import Polysemy.Process.Interpreter.ProcessInput (interpretProcessInputId, interpretProcessInputText)+import Polysemy.Process.Interpreter.ProcessOutput (+  interpretProcessOutputId,+  interpretProcessOutputIgnore,+  interpretProcessOutputLines,+  interpretProcessOutputText,+  interpretProcessOutputTextLines,+  )++-- |The effects used by 'Polysemy.Process.Process' to send and receive chunks of bytes to and from a process.+type ProcessIO i o =+  [+    ProcessInput i,+    ProcessOutput 'Stdout o,+    ProcessOutput 'Stderr o+  ]++-- |Interpret 'ProcessIO' with plain 'ByteString's without chunking.+-- Silently discards stderr.+interpretProcessByteString ::+  InterpretersFor (ProcessIO ByteString ByteString) r+interpretProcessByteString =+  interpretProcessOutputIgnore @'Stderr .+  interpretProcessOutputId @'Stdout .+  interpretProcessInputId++-- |Interpret 'ProcessIO' with 'ByteString's chunked as lines.+-- Silently discards stderr.+interpretProcessByteStringLines ::+  InterpretersFor (ProcessIO ByteString ByteString) r+interpretProcessByteStringLines =+  interpretProcessOutputIgnore @'Stderr .+  interpretProcessOutputLines @'Stdout .+  interpretProcessInputId++-- |Interpret 'ProcessIO' with plain 'Text's without chunking.+-- Silently discards stderr.+interpretProcessText ::+  InterpretersFor (ProcessIO Text Text) r+interpretProcessText =+  interpretProcessOutputIgnore @'Stderr .+  interpretProcessOutputText @'Stdout .+  interpretProcessInputText++-- |Interpret 'ProcessIO' with 'Text's chunked as lines.+-- Silently discards stderr.+interpretProcessTextLines ::+  InterpretersFor (ProcessIO Text Text) r+interpretProcessTextLines =+  interpretProcessOutputIgnore @'Stderr .+  interpretProcessOutputTextLines @'Stdout .+  interpretProcessInputText
+ lib/Polysemy/Process/Interpreter/ProcessOneshot.hs view
@@ -0,0 +1,79 @@+-- |Description: Process Interpreters, Internal+module Polysemy.Process.Interpreter.ProcessOneshot where++import Polysemy.Conc.Effect.Race (Race)+import Polysemy.Conc.Effect.Scoped (Scoped, Scoped_)+import Polysemy.Conc.Interpreter.Scoped (interpretScopedRWith_)+import Polysemy.Resume (Stop, type (!!))++import Polysemy.Process.Data.ProcessError (ProcessError)+import Polysemy.Process.Data.ProcessOptions (ProcessOptions)+import Polysemy.Process.Data.SystemProcessError (SystemProcessError, SystemProcessScopeError)+import Polysemy.Process.Effect.Process (Process)+import Polysemy.Process.Effect.SystemProcess (SystemProcess)+import Polysemy.Process.Interpreter.Process (ScopeEffects, handleProcessWithQueues, pscope, terminated)+import Polysemy.Process.Interpreter.ProcessIO (ProcessIO)+import Polysemy.Process.Interpreter.SystemProcess (SysProcConf, interpretSystemProcessNative)++-- |Interpret 'Process' with a system process resource whose file descriptors are connected to three+-- 'Control.Concurrent.STM.TBMQueue.TBMQueue's, deferring decoding of stdout and stderr to the interpreters of two+-- 'Polysemy.Process.ProcessOutput' effects.+-- Unlike 'Polysemy.Process.interpretProcess', this variant sends errors inside the scope to the individual 'Process'+-- actions.+-- This variant is for parameterized scopes, meaning that a value of arbitrary type may be passed to+-- 'Polysemy.Process.withProcessOneshotParam' which is then passed to the supplied function to produce a 'SysProcConf'+-- for the native process.+interpretProcessOneshot ::+  ∀ param proc i o r .+  Members (ProcessIO i o) r =>+  Member (Scoped proc (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r =>+  Members [Resource, Race, Async, Embed IO] r =>+  ProcessOptions ->+  (param -> Sem (Stop SystemProcessScopeError : r) proc) ->+  InterpreterFor (Scoped param (Process i o !! ProcessError) !! SystemProcessScopeError) r+interpretProcessOneshot options proc =+  interpretScopedRWith_ @(ScopeEffects i o SystemProcessError)+  (\ p -> pscope @SystemProcessScopeError options proc p)+  (handleProcessWithQueues terminated)++-- |Variant of 'interpretProcessOneshot' that takes a static 'SysProcConf'.+interpretProcessOneshot_ ::+  ∀ proc i o r .+  Members (ProcessIO i o) r =>+  Member (Scoped proc (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r =>+  Members [Resource, Race, Async, Embed IO] r =>+  ProcessOptions ->+  proc ->+  InterpreterFor (Scoped_ (Process i o !! ProcessError) !! SystemProcessScopeError) r+interpretProcessOneshot_ options proc =+  interpretProcessOneshot options (const (pure proc))++-- |Interpret 'Process' as a native 'Polysemy.Process.SystemProcess'.+-- This variant is for parameterized scopes, meaning that a value of arbitrary type may be passed to+-- 'Polysemy.Process.withProcessOneshotParam' which is then passed to the supplied function to produce a 'SysProcConf'+-- for the native process.+interpretProcessOneshotNative ::+  ∀ param i o r .+  Members (ProcessIO i o) r =>+  Members [Resource, Race, Async, Embed IO] r =>+  ProcessOptions ->+  (param -> Sem r (Either Text SysProcConf)) ->+  InterpreterFor (Scoped param (Process i o !! ProcessError) !! SystemProcessScopeError) r+interpretProcessOneshotNative options proc =+  interpretSystemProcessNative pure .+  interpretProcessOneshot options (insertAt @0 . proc) .+  raiseUnder++-- |Interpret 'Process' as a native 'Polysemy.Process.SystemProcess'.+-- This variant takes a static 'SysProcConf'.+interpretProcessOneshotNative_ ::+  ∀ i o r .+  Members (ProcessIO i o) r =>+  Members [Resource, Race, Async, Embed IO] r =>+  ProcessOptions ->+  SysProcConf ->+  InterpreterFor (Scoped_ (Process i o !! ProcessError) !! SystemProcessScopeError) r+interpretProcessOneshotNative_ options proc =+  interpretSystemProcessNative (pure . Right) .+  interpretProcessOneshot options (const (pure proc)) .+  raiseUnder
− lib/Polysemy/Process/Interpreter/ProcessStdio.hs 
@@ -1,73 +0,0 @@-{-# options_haddock prune #-}---- |Description: Process Interpreters for stdio, Internal-module Polysemy.Process.Interpreter.ProcessStdio where--import Polysemy.Conc.Effect.Race (Race)-import Polysemy.Conc.Effect.Scoped (Scoped)-import Polysemy.Resume (type (!!))-import System.Process.Typed (ProcessConfig)--import Polysemy.Process.Data.ProcessError (ProcessError)-import Polysemy.Process.Data.ProcessOptions (ProcessOptions)-import Polysemy.Process.Data.SystemProcessError (SystemProcessError)-import Polysemy.Process.Effect.Process (Process)-import Polysemy.Process.Interpreter.Process (-  interpretProcessByteString,-  interpretProcessByteStringLines,-  interpretProcessText,-  interpretProcessTextLines,-  )-import Polysemy.Process.Interpreter.SystemProcess (PipesProcess, interpretSystemProcessNative)---- |Interpret 'Process' as a native 'Polysemy.Process.SystemProcess', producing unaccumulated chunks of 'ByteString'.--- Silently discards stderr.-interpretProcessByteStringNative ::-  Members [Resource, Race, Async, Embed IO] r =>-  ProcessOptions ->-  -- |Basic config. The pipes will be changed to 'System.IO.Handle' by the interpreter.-  ProcessConfig () () () ->-  InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r-interpretProcessByteStringNative options conf =-  interpretSystemProcessNative conf .-  interpretProcessByteString @PipesProcess @SystemProcessError options .-  raiseUnder---- |Interpret 'Process' as a native 'Polysemy.Process.SystemProcess', producing lines of 'ByteString'.--- Silently discards stderr.-interpretProcessByteStringLinesNative ::-  Members [Resource, Race, Async, Embed IO] r =>-  ProcessOptions ->-  -- |Basic config. The pipes will be changed to 'System.IO.Handle' by the interpreter.-  ProcessConfig () () () ->-  InterpreterFor (Scoped () (Process ByteString ByteString) !! ProcessError) r-interpretProcessByteStringLinesNative options conf =-  interpretSystemProcessNative conf .-  interpretProcessByteStringLines @PipesProcess @SystemProcessError options .-  raiseUnder---- |Interpret 'Process' as a native 'Polysemy.Process.SystemProcess', producing unaccumulated chunks of 'Text'.--- Silently discards stderr.-interpretProcessTextNative ::-  Members [Resource, Race, Async, Embed IO] r =>-  ProcessOptions ->-  -- |Basic config. The pipes will be changed to 'System.IO.Handle' by the interpreter.-  ProcessConfig () () () ->-  InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r-interpretProcessTextNative options conf =-  interpretSystemProcessNative conf .-  interpretProcessText @PipesProcess @SystemProcessError options .-  raiseUnder---- |Interpret 'Process' as a native 'Polysemy.Process.SystemProcess', producing lines of 'Text'.--- Silently discards stderr.-interpretProcessTextLinesNative ::-  Members [Resource, Race, Async, Embed IO] r =>-  ProcessOptions ->-  -- |Basic config. The pipes will be changed to 'System.IO.Handle' by the interpreter.-  ProcessConfig () () () ->-  InterpreterFor (Scoped () (Process Text Text) !! ProcessError) r-interpretProcessTextLinesNative options conf =-  interpretSystemProcessNative conf .-  interpretProcessTextLines @PipesProcess @SystemProcessError options .-  raiseUnder
lib/Polysemy/Process/Interpreter/Pty.hs view
@@ -3,7 +3,7 @@ -- |Description: Pty Interpreters, Internal module Polysemy.Process.Interpreter.Pty where -import Polysemy.Conc.Effect.Scoped (Scoped)+import Polysemy.Conc.Effect.Scoped (Scoped_) import Polysemy.Conc.Interpreter.Scoped (interpretScopedResumable) import Polysemy.Resume (Stop, stopEitherWith, stopNote, type (!!)) import System.Posix (closeFd, fdToHandle, openPseudoTerminal)@@ -18,7 +18,7 @@   IO a ->   Sem r a tryStop =-  stopEitherWith PtyError <=< tryAny+  stopEitherWith PtyError <=< tryIOError  acquirePty ::   Member (Embed IO) r =>@@ -47,9 +47,9 @@ -- |Interpret Pty as a 'System.Posix.Pty'. interpretPty ::   Members [Resource, Embed IO] r =>-  InterpreterFor (Scoped PtyResources Pty !! PtyError) r+  InterpreterFor (Scoped_ Pty !! PtyError) r interpretPty =-  interpretScopedResumable withPty \ PtyResources {..} -> \case+  interpretScopedResumable (const withPty) \ PtyResources {..} -> \case     Handle ->       pure handle     Resize rows cols -> do
lib/Polysemy/Process/Interpreter/SystemProcess.hs view
@@ -4,9 +4,9 @@ module Polysemy.Process.Interpreter.SystemProcess where  import Data.ByteString (hGetSome, hPut)-import Polysemy.Conc.Effect.Scoped (Scoped)-import Polysemy.Conc.Interpreter.Scoped (runScoped)-import Polysemy.Resume (Stop, interpretResumable, stop, stopNote, type (!!))+import Polysemy.Conc.Effect.Scoped (Scoped, Scoped_)+import Polysemy.Conc.Interpreter.Scoped (interpretScopedR, runScoped)+import Polysemy.Resume (Stop, interpretResumable, stop, stopNote, stopTryIOError, type (!!)) import Prelude hiding (fromException) import System.IO (BufferMode (NoBuffering), Handle, hSetBuffering) import qualified System.Posix as Signal@@ -28,33 +28,40 @@   )  import qualified Polysemy.Process.Data.SystemProcessError as SystemProcessError-import Polysemy.Process.Data.SystemProcessError (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 :: ProcessConfig () () () -> ProcessConfig Handle Handle Handle+processWithPipes :: SysProcConf -> ProcessConfig Handle Handle Handle processWithPipes =   setStdin createPipe .   setStdout createPipe .   setStderr createPipe  start ::-  Member (Embed IO) r =>-  ProcessConfig () () () ->+  Members [Stop SystemProcessScopeError, Embed IO] r =>+  SysProcConf ->   Sem r PipesProcess start =-  startProcess . processWithPipes+  stopTryIOError SystemProcessError.StartFailed .+  startProcess .+  processWithPipes  withProcess ::-  Members [Resource, Embed IO] r =>-  ProcessConfig () () () ->+  Members [Resource, Stop SystemProcessScopeError, Embed IO] r =>+  SysProcConf ->   (PipesProcess -> Sem r a) ->   Sem r a withProcess config use =-  bracket (start config) (tryAny . stopProcess) \ p -> do+  bracket (start config) (tryIOError . stopProcess) \ p -> do     unbuffer (getStdin p)     unbuffer (getStdout p)     unbuffer (getStderr p)@@ -63,20 +70,13 @@     unbuffer h =       void $ tryMaybe (hSetBuffering h NoBuffering) -startOpaque ::-  Member (Embed IO) r =>-  ProcessConfig i o e ->-  Sem r (Process i o e)-startOpaque =-  startProcess- withProcessOpaque ::   Members [Resource, Embed IO] r =>   ProcessConfig i o e ->   (Process i o e -> Sem r a) ->   Sem r a withProcessOpaque config =-  bracket (startOpaque config) (tryAny . stopProcess)+  bracket (startProcess config) (tryIOError . stopProcess)  terminate ::   Member (Stop SystemProcessError) r =>@@ -111,6 +111,28 @@   b ->     pure 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 process = \case+  SystemProcess.Pid ->+    fromIntegral <$> processId process+  SystemProcess.Signal sig -> do+    pid <- processId process+    tryStop "signal failed" (Signal.signalProcess sig pid)+  SystemProcess.ReadStdout ->+    checkEof =<< tryStop "stdout failed" (hGetSome (getStdout process) 4096)+  SystemProcess.ReadStderr ->+    checkEof =<< tryStop "stderr failed" (hGetSome (getStderr process) 4096)+  SystemProcess.WriteStdin msg ->+    tryStop "stdin failed" (hPut (getStdin process) msg)+  SystemProcess.Wait ->+    tryStop "wait failed" (waitExitCode process)+ -- |Interpret 'SystemProcess' with a concrete 'System.Process' with connected pipes. interpretSystemProcessWithProcess ::   ∀ r .@@ -118,42 +140,54 @@   Process Handle Handle Handle ->   InterpreterFor (SystemProcess !! SystemProcessError) r interpretSystemProcessWithProcess process =-  interpretResumable \case-    SystemProcess.Pid ->-      processId process-    SystemProcess.Signal sig -> do-      pid <- processId process-      tryStop "signal failed" (Signal.signalProcess sig pid)-    SystemProcess.ReadStdout ->-      checkEof =<< tryStop "stdout failed" (hGetSome (getStdout process) 4096)-    SystemProcess.ReadStderr ->-      checkEof =<< tryStop "stderr failed" (hGetSome (getStderr process) 4096)-    SystemProcess.WriteStdin msg ->-      tryStop "stdin failed" (hPut (getStdin process) msg)-    SystemProcess.Wait ->-      tryStop "wait failed" (waitExitCode process)+  interpretResumable (handleSystemProcessWithProcess process)  -- |Interpret 'SystemProcess' as a single global 'System.Process' that's started immediately. interpretSystemProcessNativeSingle ::   ∀ r .-  Members [Resource, Embed IO] r =>-  ProcessConfig () () () ->+  Members [Stop SystemProcessScopeError, Resource, Embed IO] r =>+  SysProcConf ->   InterpreterFor (SystemProcess !! SystemProcessError) r interpretSystemProcessNativeSingle config sem =   withProcess config \ process ->     interpretSystemProcessWithProcess process sem +withProcConf ::+  Members [Stop SystemProcessScopeError, Resource, Embed IO] r =>+  (PipesProcess -> Sem r a) ->+  Either Text SysProcConf ->+  Sem r a+withProcConf use = \case+  Right conf ->+    withProcess conf use+  Left err ->+    stop (StartFailed 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 ::-  ∀ r .+  ∀ param r .   Members [Resource, Embed IO] r =>-  ProcessConfig () () () ->-  InterpreterFor (Scoped PipesProcess (SystemProcess !! SystemProcessError)) r+  (param -> Sem r (Either Text SysProcConf)) ->+  InterpreterFor (Scoped param (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r interpretSystemProcessNative config =-  runScoped (withProcess config) interpretSystemProcessWithProcess+  interpretScopedR (\ p u -> raise (config p) >>= withProcConf u) handleSystemProcessWithProcess --- |Interpret 'SystemProcess' with a concrete 'System.Process' with connected pipes.+-- |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_ config =+  interpretScopedR (const (withProcess config)) handleSystemProcessWithProcess++-- |Interpret 'SystemProcess' with a concrete 'System.Process' with no connection to stdio. interpretSystemProcessWithProcessOpaque ::   ∀ i o e r .   Member (Embed IO) r =>@@ -162,7 +196,7 @@ interpretSystemProcessWithProcessOpaque process =   interpretResumable \case     SystemProcess.Pid ->-      processId process+      fromIntegral <$> processId process     SystemProcess.Signal sig -> do       pid <- processId process       tryStop "signal failed" (Signal.signalProcess sig pid)@@ -191,6 +225,6 @@   ∀ i o e r .   Members [Resource, Embed IO] r =>   ProcessConfig i o e ->-  InterpreterFor (Scoped (Process i o e) (SystemProcess !! SystemProcessError)) r+  InterpreterFor (Scoped_ (SystemProcess !! SystemProcessError)) r interpretSystemProcessNativeOpaque config =-  runScoped (withProcessOpaque config) interpretSystemProcessWithProcessOpaque+  runScoped (const (withProcessOpaque config)) interpretSystemProcessWithProcessOpaque
+ lib/Polysemy/Process/SysProcConf.hs view
@@ -0,0 +1,30 @@+-- |Constructors for 'SysProcConf', Internal+module Polysemy.Process.SysProcConf where++import Path (Abs, File, Path, Rel, toFilePath)+import Path.IO (findExecutable)+import System.Process.Typed (proc, shell)++import Polysemy.Process.Interpreter.SystemProcess (SysProcConf)++-- |Create a 'SysProcConf' from an executable path and a list of arguments.+processConfig :: Path Abs File -> [Text] -> SysProcConf+processConfig exe args =+  proc (toFilePath exe) (toString <$> args)+{-# inline processConfig #-}++-- |Create a 'SysProcConf' from an shell command line.+shellConfig :: Text -> SysProcConf+shellConfig cmd =+  shell (toString cmd)+{-# inline shellConfig #-}++-- |Create a 'SysProcConf' by looking up an executable in the path, and using the supplied arguments.+which ::+  Member (Embed IO) r =>+  Path Rel File ->+  [Text] ->+  Sem r (Maybe SysProcConf)+which exeName args =+  fmap (flip processConfig args) . join <$> tryIOErrorMaybe (findExecutable exeName)+{-# inline which #-}
lib/Polysemy/Process/SystemProcess.hs view
@@ -4,10 +4,15 @@ module Polysemy.Process.SystemProcess (   module Polysemy.Process.Effect.SystemProcess,   module Polysemy.Process.Interpreter.SystemProcess,+  module Polysemy.Process.SysProcConf,+  currentPid, ) where +import System.Posix (getProcessID)++import Polysemy.Process.Data.Pid (Pid) import Polysemy.Process.Effect.SystemProcess (-  SystemProcess (..),+  SystemProcess,   interrupt,   pid,   readStderr,@@ -18,7 +23,16 @@   writeStdin,   ) import Polysemy.Process.Interpreter.SystemProcess (+  SysProcConf,   interpretSystemProcessNative,   interpretSystemProcessNativeSingle,   interpretSystemProcessWithProcess,   )+import Polysemy.Process.SysProcConf++-- |Obtain the current process's 'Pid'.+currentPid ::+  Member (Embed IO) r =>+  Sem r Pid+currentPid =+  fromIntegral <$> embed getProcessID
polysemy-process.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-process-version:        0.9.0.0+version:        0.10.0.0 synopsis:       Polysemy effects for system processes description:    See https://hackage.haskell.org/package/polysemy-process/docs/Polysemy-Process.html category:       Concurrency@@ -17,6 +17,9 @@ license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple+extra-source-files:+    changelog.md+    readme.md  source-repository head   type: git@@ -25,6 +28,7 @@ library   exposed-modules:       Polysemy.Process+      Polysemy.Process.Data.Pid       Polysemy.Process.Data.ProcessError       Polysemy.Process.Data.ProcessKill       Polysemy.Process.Data.ProcessOptions@@ -40,12 +44,14 @@       Polysemy.Process.Executable       Polysemy.Process.Interpreter.Process       Polysemy.Process.Interpreter.ProcessInput+      Polysemy.Process.Interpreter.ProcessIO+      Polysemy.Process.Interpreter.ProcessOneshot       Polysemy.Process.Interpreter.ProcessOutput-      Polysemy.Process.Interpreter.ProcessStdio       Polysemy.Process.Interpreter.Pty       Polysemy.Process.Interpreter.SystemProcess       Polysemy.Process.ProcessOutput       Polysemy.Process.Pty+      Polysemy.Process.SysProcConf       Polysemy.Process.SystemProcess   hs-source-dirs:       lib
+ readme.md view
@@ -0,0 +1,8 @@+# About++This library provides [Polysemy] effects for system processes and pseudo terminals.++Please visit [Hackage] for documentation.++[Polysemy]: https://hackage.haskell.org/package/polysemy+[Hackage]: https://hackage.haskell.org/package/polysemy-process/docs/Polysemy-Process.html
test/Polysemy/Process/Test/ProcessTest.hs view
@@ -3,26 +3,35 @@ module Polysemy.Process.Test.ProcessTest where  import qualified Data.ByteString as ByteString-import qualified Polysemy.Conc as Conc+import qualified Polysemy.Conc.Effect.Race as Conc (timeout)+import Polysemy.Conc.Effect.Race (Race) import Polysemy.Conc.Effect.Scoped (Scoped) import Polysemy.Conc.Interpreter.Race (interpretRace) import qualified Polysemy.Conc.Race as Race-import Polysemy.Resume (resumeHoistError)-import Polysemy.Test (UnitTest, assertLeft, runTestAuto, unitTest, (===))+import Polysemy.Resume (resumeEither, resumeHoistAs, resumeHoistError, resuming, runStop, type (!!), (<!))+import Polysemy.Test (TestError (TestError), UnitTest, assertJust, assertLeft, evalLeft, runTestAuto, unitTest, (===)) import Polysemy.Time (MilliSeconds (MilliSeconds), Seconds (Seconds))+import System.Exit (ExitCode (ExitSuccess)) import qualified System.Process.Typed as Process import System.Process.Typed (ProcessConfig) import Test.Tasty (TestTree, testGroup) import Test.Tasty.ExpectedFailure (ignoreTest) +import qualified Polysemy.Process.Data.ProcessError as ProcessError import Polysemy.Process.Data.ProcessError (ProcessError) import Polysemy.Process.Data.ProcessKill (ProcessKill (KillNever)) import Polysemy.Process.Data.ProcessOptions (ProcessOptions (kill))+import Polysemy.Process.Data.ProcessOutputParseResult (ProcessOutputParseResult (Done, Partial))+import Polysemy.Process.Data.SystemProcessError (SystemProcessScopeError (StartFailed)) import qualified Polysemy.Process.Effect.Process as Process-import Polysemy.Process.Effect.Process (withProcess)+import Polysemy.Process.Effect.Process (Process, withProcessOneshot, withProcess_)+import qualified Polysemy.Process.Effect.SystemProcess as SystemProcess+import Polysemy.Process.Effect.SystemProcess (withSystemProcess_)+import Polysemy.Process.Interpreter.Process (interpretProcessNative_)+import Polysemy.Process.Interpreter.ProcessIO (ProcessIO, interpretProcessByteString, interpretProcessTextLines)+import Polysemy.Process.Interpreter.ProcessOneshot (interpretProcessOneshotNative) import Polysemy.Process.Interpreter.ProcessOutput (parseMany)-import Polysemy.Process.Interpreter.ProcessStdio (interpretProcessByteStringNative, interpretProcessTextLinesNative)-import Polysemy.Process.Data.ProcessOutputParseResult (ProcessOutputParseResult(Done, Partial))+import Polysemy.Process.Interpreter.SystemProcess (SysProcConf, interpretSystemProcessNative_)  config :: ProcessConfig () () () config =@@ -38,28 +47,28 @@  test_process :: UnitTest test_process =-  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretProcessByteStringNative def config do+  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretProcessByteString $ interpretProcessNative_ def config do     response <- resumeHoistError @ProcessError @(Scoped _ _) show do-      withProcess do+      withProcess_ do         Process.send (encodeUtf8 message)         Race.timeout_ (throw "timed out") (Seconds 5) Process.recv     message === decodeUtf8 response  test_processLines :: UnitTest test_processLines =-  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretProcessTextLinesNative def config do+  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretProcessTextLines $ interpretProcessNative_ def config do     response <- resumeHoistError @ProcessError @(Scoped _ _) show do-      withProcess do+      withProcess_ do         Process.send message         Race.timeout_ (throw "timed out") (Seconds 5) (replicateM 4 Process.recv)     messageLines === response  test_processKillNever :: UnitTest test_processKillNever =-  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretProcessTextLinesNative def { kill = KillNever } config do+  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretProcessTextLines $ interpretProcessNative_ def { kill = KillNever } config do     result <- resumeHoistError @ProcessError @(Scoped _ _) show do       Conc.timeout unit (MilliSeconds 100) do-        withProcess do+        withProcess_ do           Process.send message           Process.recv     -- This does not succeed. It should be 'Left', but apparently the `timeout` causes the `SystemProcess` scope to stop@@ -88,10 +97,61 @@       | otherwise =         Done (ByteString.take 2 b) (ByteString.drop 2 b) +interpretOneshot ::+  Members [Error TestError, Resource, Race, Async, Embed IO] r =>+  (Text -> SysProcConf) ->+  InterpretersFor (Scoped Text (Process Text Text !! ProcessError) : ProcessIO Text Text) r+interpretOneshot conf =+  interpretProcessTextLines .+  interpretProcessOneshotNative def (pure . Right . conf) .+  resumeHoistError (TestError . show @Text @SystemProcessScopeError) .+  insertAt @1++test_processOneshot :: UnitTest+test_processOneshot =+  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretOneshot conf do+    num <- runStop @Int $ withProcessOneshot message do+      Race.timeout_ (throw "timed out") (Seconds 5) do+        for_ @[] [1..5] \ i ->+          resumeHoistAs i Process.recv+        unit+    assertLeft 5 num+  where+    conf msg =+      Process.proc "echo" ["-n", toString msg]++test_exit :: UnitTest+test_exit =+  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretProcessByteString $ interpretProcessNative_ def conf do+    response <- resuming @_ @(Scoped _ _) (pure . Just) $ withProcess_ do+      Race.timeout_ (throw (TestError "timed out")) (Seconds 5) do+        void Process.recv+        void Process.recv+      pure Nothing+    assertJust (ProcessError.Exit ExitSuccess) response+  where+    conf =+      Process.proc "echo" ["-n", "text"]++test_startFailed :: UnitTest+test_startFailed =+  runTestAuto $ interpretRace $ asyncToIOFinal $ interpretSystemProcessNative_ conf do+    result <- resumeEither $ withSystemProcess_ do+      Nothing <! (Just <$> SystemProcess.wait)+    evalLeft result >>= \case+      StartFailed _ ->+        unit+  where+    conf =+      Process.proc "fnord-detector" []+ test_processAll :: TestTree test_processAll =   testGroup "process" [     unitTest "read raw chunks" test_process,     unitTest "read lines" test_processLines,-    ignoreTest (unitTest "don't kill the process at the end of the scope" test_processKillNever)+    ignoreTest (unitTest "don't kill the process at the end of the scope" test_processKillNever),+    unitTest "expect termination" test_processOneshot,+    unitTest "daemon exit code" test_exit,+    unitTest "system process start error" test_startFailed   ]