-- |Data type containing options for processes.
module Polysemy.Process.Data.ProcessOptions where

import qualified Polysemy.Process.Data.ProcessKill as ProcessKill
import Polysemy.Process.Data.ProcessKill (ProcessKill)

-- |Controls the behaviour of 'Polysemy.Process.Process' interpreters.
data ProcessOptions =
  ProcessOptions {
    -- |Whether to discard output chunks if the queue is full.
    ProcessOptions -> Bool
discard :: Bool,
    -- |Maximum number of chunks allowed to be queued for each of the three standard pipes.
    ProcessOptions -> Int
qsize :: Int,
    -- |What to do if the process hasn't terminated when exiting the scope.
    ProcessOptions -> ProcessKill
kill :: ProcessKill
  }
  deriving stock (ProcessOptions -> ProcessOptions -> Bool
(ProcessOptions -> ProcessOptions -> Bool)
-> (ProcessOptions -> ProcessOptions -> Bool) -> Eq ProcessOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessOptions -> ProcessOptions -> Bool
$c/= :: ProcessOptions -> ProcessOptions -> Bool
== :: ProcessOptions -> ProcessOptions -> Bool
$c== :: ProcessOptions -> ProcessOptions -> Bool
Eq, Int -> ProcessOptions -> ShowS
[ProcessOptions] -> ShowS
ProcessOptions -> String
(Int -> ProcessOptions -> ShowS)
-> (ProcessOptions -> String)
-> ([ProcessOptions] -> ShowS)
-> Show ProcessOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessOptions] -> ShowS
$cshowList :: [ProcessOptions] -> ShowS
show :: ProcessOptions -> String
$cshow :: ProcessOptions -> String
showsPrec :: Int -> ProcessOptions -> ShowS
$cshowsPrec :: Int -> ProcessOptions -> ShowS
Show)

instance Default ProcessOptions where
  def :: ProcessOptions
def =
    Bool -> Int -> ProcessKill -> ProcessOptions
ProcessOptions Bool
True Int
1024 ProcessKill
ProcessKill.KillImmediately