module HaskellWorks.Polysemy.Hedgehog.Process
  ( defaultExecConfig
  , execFlex
  , execFlexOk
  , execFlexOk'
  , execOk
  , execOk_
  , exec
  , procFlex
  , procFlex'
  , binFlex

  , waitSecondsForProcess
  , waitSecondsForProcessOk

  ) where

import qualified Control.Concurrent                              as IO
import qualified Control.Concurrent.Async                        as IO
import           Data.Monoid                                     (Last (..))
import           GHC.Stack                                       (callStack)
import qualified HaskellWorks.IO.Process                         as IO
import           HaskellWorks.Polysemy.Cabal
import           HaskellWorks.Polysemy.Error.Types
import           HaskellWorks.Polysemy.Hedgehog.Assert
import           HaskellWorks.Polysemy.Hedgehog.Jot
import           HaskellWorks.Polysemy.Hedgehog.Process.Internal
import           HaskellWorks.Polysemy.Prelude
import           HaskellWorks.Polysemy.System.Environment
import           HaskellWorks.Polysemy.System.Process

import qualified Data.List                                       as L
import           Polysemy
import           Polysemy.Error
import           Polysemy.Log

-- | Configuration for starting a new process.  This is a subset of 'IO.CreateProcess'.
data ExecConfig = ExecConfig
  { ExecConfig -> Last [(String, String)]
execConfigEnv :: Last [(String, String)]
  , ExecConfig -> Last String
execConfigCwd :: Last FilePath
  } deriving (ExecConfig -> ExecConfig -> Bool
(ExecConfig -> ExecConfig -> Bool)
-> (ExecConfig -> ExecConfig -> Bool) -> Eq ExecConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecConfig -> ExecConfig -> Bool
== :: ExecConfig -> ExecConfig -> Bool
$c/= :: ExecConfig -> ExecConfig -> Bool
/= :: ExecConfig -> ExecConfig -> Bool
Eq, (forall x. ExecConfig -> Rep ExecConfig x)
-> (forall x. Rep ExecConfig x -> ExecConfig) -> Generic ExecConfig
forall x. Rep ExecConfig x -> ExecConfig
forall x. ExecConfig -> Rep ExecConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecConfig -> Rep ExecConfig x
from :: forall x. ExecConfig -> Rep ExecConfig x
$cto :: forall x. Rep ExecConfig x -> ExecConfig
to :: forall x. Rep ExecConfig x -> ExecConfig
Generic, Int -> ExecConfig -> ShowS
[ExecConfig] -> ShowS
ExecConfig -> String
(Int -> ExecConfig -> ShowS)
-> (ExecConfig -> String)
-> ([ExecConfig] -> ShowS)
-> Show ExecConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecConfig -> ShowS
showsPrec :: Int -> ExecConfig -> ShowS
$cshow :: ExecConfig -> String
show :: ExecConfig -> String
$cshowList :: [ExecConfig] -> ShowS
showList :: [ExecConfig] -> ShowS
Show)

defaultExecConfig :: ExecConfig
defaultExecConfig :: ExecConfig
defaultExecConfig = ExecConfig
  { execConfigEnv :: Last [(String, String)]
execConfigEnv = Last [(String, String)]
forall a. Monoid a => a
mempty
  , execConfigCwd :: Last String
execConfigCwd = Last String
forall a. Monoid a => a
mempty
  }

-- | Create a process returning its stdout.
--
-- Being a 'flex' function means that the environment determines how the process is launched.
--
-- When running in a nix environment, the 'envBin' argument describes the environment variable
-- that defines the binary to use to launch the process.
--
-- When running outside a nix environment, the `pkgBin` describes the name of the binary
-- to launch via cabal exec.
execFlexOk :: ()
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => String
  -> String
  -> [String]
  -> Sem r String
execFlexOk :: forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
String -> String -> [String] -> Sem r String
execFlexOk = ExecConfig -> String -> String -> [String] -> Sem r String
forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig -> String -> String -> [String] -> Sem r String
execFlexOk' ExecConfig
defaultExecConfig

execFlexOk' :: ()
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => ExecConfig
  -> String
  -> String
  -> [String]
  -> Sem r String
execFlexOk' :: forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig -> String -> String -> [String] -> Sem r String
execFlexOk' ExecConfig
execConfig String
pkgBin String
envBin [String]
arguments = (HasCallStack => Sem r String) -> Sem r String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r String) -> Sem r String)
-> (HasCallStack => Sem r String) -> Sem r String
forall a b. (a -> b) -> a -> b
$ do
  (ExitCode
exitResult, String
stdout, String
stderr) <- ExecConfig
-> String -> String -> [String] -> Sem r (ExitCode, String, String)
forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig
-> String -> String -> [String] -> Sem r (ExitCode, String, String)
execFlex ExecConfig
execConfig String
pkgBin String
envBin [String]
arguments
  case ExitCode
exitResult of
    ExitFailure Int
exitCode -> do
      String -> Sem r ()
forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
String -> Sem r ()
jot_ (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
L.unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        [ String
"Process exited with non-zero exit-code: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show @Int Int
exitCode ]
        [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
stdout then [] else [String
"━━━━ stdout ━━━━" , String
stdout])
        [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
stderr then [] else [String
"━━━━ stderr ━━━━" , String
stderr])
      CallStack -> String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
callStack String
"Execute process failed"
    ExitCode
ExitSuccess -> String -> Sem r String
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return String
stdout

-- | Run a process, returning its exit code, its stdout, and its stderr.
-- Contrary to @execFlexOk'@, this function doesn't fail if the call fails.
-- So, if you want to test something negative, this is the function to use.
execFlex :: ()
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => ExecConfig
  -> String -- ^ @pkgBin@: name of the binary to launch via 'cabal exec'
  -> String -- ^ @envBin@: environment variable defining the binary to launch the process, when in Nix
  -> [String]
  -> Sem r (ExitCode, String, String) -- ^ exit code, stdout, stderr
execFlex :: forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig
-> String -> String -> [String] -> Sem r (ExitCode, String, String)
execFlex ExecConfig
execConfig String
pkgBin String
envBin [String]
arguments = (HasCallStack => Sem r (ExitCode, String, String))
-> Sem r (ExitCode, String, String)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r (ExitCode, String, String))
 -> Sem r (ExitCode, String, String))
-> (HasCallStack => Sem r (ExitCode, String, String))
-> Sem r (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ do
  CreateProcess
cp <- ExecConfig -> String -> String -> [String] -> Sem r CreateProcess
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
ExecConfig -> String -> String -> [String] -> Sem r CreateProcess
procFlex' ExecConfig
execConfig String
pkgBin String
envBin [String]
arguments
  String -> Sem r ()
forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
String -> Sem r ()
jot_ (String -> Sem r ()) -> ShowS -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"━━━━ command ━━━━\n" <>) (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ case CreateProcess -> CmdSpec
cmdspec CreateProcess
cp of
    ShellCommand String
cmd    -> String
cmd
    RawCommand String
cmd [String]
args -> String
cmd String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
L.unwords (ShowS
argQuote ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
args)

  CreateProcess -> String -> Sem r (ExitCode, String, String)
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r) =>
CreateProcess -> String -> Sem r (ExitCode, String, String)
readCreateProcessWithExitCode CreateProcess
cp String
""

-- | Execute a process, returning '()'.
execOk_ :: ()
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => ExecConfig
  -> String
  -> [String]
  -> Sem r ()
execOk_ :: forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig -> String -> [String] -> Sem r ()
execOk_ ExecConfig
execConfig String
bin [String]
arguments = Sem r String -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r String -> Sem r ()) -> Sem r String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ ExecConfig -> String -> [String] -> Sem r String
forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig -> String -> [String] -> Sem r String
execOk ExecConfig
execConfig String
bin [String]
arguments

-- | Execute a process, returning the stdout. Fail if the call returns
-- with a non-zero exit code. For a version that doesn't fail upon receiving
-- a non-zero exit code, see 'execAny'.
execOk :: ()
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => ExecConfig
  -> String
  -> [String]
  -> Sem r String
execOk :: forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig -> String -> [String] -> Sem r String
execOk ExecConfig
execConfig String
bin [String]
arguments = (HasCallStack => Sem r String) -> Sem r String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r String) -> Sem r String)
-> (HasCallStack => Sem r String) -> Sem r String
forall a b. (a -> b) -> a -> b
$ do
  (ExitCode
exitResult, String
stdout, String
stderr) <- ExecConfig
-> String -> [String] -> Sem r (ExitCode, String, String)
forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig
-> String -> [String] -> Sem r (ExitCode, String, String)
exec ExecConfig
execConfig String
bin [String]
arguments
  case ExitCode
exitResult of
    ExitFailure Int
exitCode ->CallStack -> String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
callStack (String -> Sem r String)
-> ([String] -> String) -> [String] -> Sem r String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
L.unlines ([String] -> Sem r String) -> [String] -> Sem r String
forall a b. (a -> b) -> a -> b
$
      [ String
"Process exited with non-zero exit-code: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show @Int Int
exitCode ]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
stdout then [] else [String
"━━━━ stdout ━━━━" , String
stdout])
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
stderr then [] else [String
"━━━━ stderr ━━━━" , String
stderr])
    ExitCode
ExitSuccess -> String -> Sem r String
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return String
stdout

-- | Execute a process, returning the error code, the stdout, and the stderr.
exec :: ()
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => ExecConfig
  -> String -- ^ The binary to launch
  -> [String] -- ^ The binary's arguments
  -> Sem r (ExitCode, String, String) -- ^ exit code, stdout, stderr
exec :: forall (r :: EffectRow).
(Member (Embed IO) r, Member Hedgehog r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
ExecConfig
-> String -> [String] -> Sem r (ExitCode, String, String)
exec ExecConfig
execConfig String
bin [String]
arguments = (HasCallStack => Sem r (ExitCode, String, String))
-> Sem r (ExitCode, String, String)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r (ExitCode, String, String))
 -> Sem r (ExitCode, String, String))
-> (HasCallStack => Sem r (ExitCode, String, String))
-> Sem r (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ do
  let cp :: CreateProcess
cp = (String -> [String] -> CreateProcess
proc String
bin [String]
arguments)
        { env = getLast $ execConfigEnv execConfig
        , cwd = getLast $ execConfigCwd execConfig
        }
  String -> Sem r ()
forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
String -> Sem r ()
jot_ (String -> Sem r ()) -> ShowS -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( String
"━━━━ command ━━━━\n" <>) (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ String
bin String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
L.unwords (ShowS
argQuote ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
arguments)
  CreateProcess -> String -> Sem r (ExitCode, String, String)
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r) =>
CreateProcess -> String -> Sem r (ExitCode, String, String)
readCreateProcessWithExitCode CreateProcess
cp String
""

waitSecondsForProcess :: ()
  => Member (Embed IO) r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => Int
  -> ProcessHandle
  -> Sem r (Either TimedOut (Maybe ExitCode))
waitSecondsForProcess :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
Int -> ProcessHandle -> Sem r (Either TimedOut (Maybe ExitCode))
waitSecondsForProcess Int
seconds ProcessHandle
hProcess = IO (Either TimedOut (Maybe ExitCode))
-> Sem r (Either TimedOut (Maybe ExitCode))
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either TimedOut (Maybe ExitCode))
 -> Sem r (Either TimedOut (Maybe ExitCode)))
-> IO (Either TimedOut (Maybe ExitCode))
-> Sem r (Either TimedOut (Maybe ExitCode))
forall a b. (a -> b) -> a -> b
$
  IO TimedOut
-> IO (Maybe ExitCode) -> IO (Either TimedOut (Maybe ExitCode))
forall a b. IO a -> IO b -> IO (Either a b)
IO.race
    (Int -> IO ()
IO.threadDelay (Int
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) IO () -> IO TimedOut -> IO TimedOut
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimedOut -> IO TimedOut
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TimedOut
TimedOut)
    (ProcessHandle -> IO (Maybe ExitCode)
IO.maybeWaitForProcess ProcessHandle
hProcess)

-- | Wait a maximum of 'seconds' secons for process to exit.
waitSecondsForProcessOk :: ()
  => Member Hedgehog r
  => Member (Embed IO) r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => Int
  -> ProcessHandle
  -> Sem r (Either TimedOut ExitCode)
waitSecondsForProcessOk :: forall (r :: EffectRow).
(Member Hedgehog r, Member (Embed IO) r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
Int -> ProcessHandle -> Sem r (Either TimedOut ExitCode)
waitSecondsForProcessOk Int
seconds ProcessHandle
hProcess = (HasCallStack => Sem r (Either TimedOut ExitCode))
-> Sem r (Either TimedOut ExitCode)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r (Either TimedOut ExitCode))
 -> Sem r (Either TimedOut ExitCode))
-> (HasCallStack => Sem r (Either TimedOut ExitCode))
-> Sem r (Either TimedOut ExitCode)
forall a b. (a -> b) -> a -> b
$ do
  Either TimedOut (Maybe ExitCode)
result <- Int -> ProcessHandle -> Sem r (Either TimedOut (Maybe ExitCode))
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
Int -> ProcessHandle -> Sem r (Either TimedOut (Maybe ExitCode))
waitSecondsForProcess Int
seconds ProcessHandle
hProcess
  case Either TimedOut (Maybe ExitCode)
result of
    Left TimedOut
TimedOut -> do
      String -> Sem r ()
forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
String -> Sem r ()
jot_ String
"Timed out waiting for process to exit"
      Either TimedOut ExitCode -> Sem r (Either TimedOut ExitCode)
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimedOut -> Either TimedOut ExitCode
forall a b. a -> Either a b
Left TimedOut
TimedOut)
    Right Maybe ExitCode
maybeExitCode -> do
      case Maybe ExitCode
maybeExitCode of
        Maybe ExitCode
Nothing -> CallStack -> String -> Sem r (Either TimedOut ExitCode)
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
callStack String
"No exit code for process"
        Just ExitCode
exitCode -> do
          String -> Sem r ()
forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
String -> Sem r ()
jot_ (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ String
"Process exited " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ExitCode -> String
forall a. Show a => a -> String
show ExitCode
exitCode
          Either TimedOut ExitCode -> Sem r (Either TimedOut ExitCode)
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Either TimedOut ExitCode
forall a b. b -> Either a b
Right ExitCode
exitCode)

-- | Compute the path to the binary given a package name or an environment variable override.
binFlex :: ()
  => Member (Embed IO) r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => String
  -- ^ Package name
  -> String
  -- ^ Environment variable pointing to the binary to run
  -> Sem r FilePath
  -- ^ Path to executable
binFlex :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
String -> String -> Sem r String
binFlex String
pkg String
binaryEnv = do
  Maybe String
maybeEnvBin <- String -> Sem r (Maybe String)
forall (r :: EffectRow).
(HasCallStack, Member (Embed IO) r) =>
String -> Sem r (Maybe String)
lookupEnv String
binaryEnv
  case Maybe String
maybeEnvBin of
    Just String
envBin -> String -> Sem r String
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return String
envBin
    Maybe String
Nothing     -> String -> Sem r String
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
String -> Sem r String
binDist String
pkg

-- | Create a 'CreateProcess' describing how to start a process given the Cabal package name
-- corresponding to the executable, an environment variable pointing to the executable,
-- and an argument list.
--
-- The actual executable used will the one specified by the environment variable, but if
-- the environment variable is not defined, it will be found instead by consulting the
-- "plan.json" generated by cabal.  It is assumed that the project has already been
-- configured and the executable has been built.
procFlex :: ()
  => Member (Embed IO) r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => String
  -- ^ Cabal package name corresponding to the executable
  -> String
  -- ^ Environment variable pointing to the binary to run
  -> [String]
  -- ^ Arguments to the CLI command
  -> Sem r CreateProcess
  -- ^ Captured stdout
procFlex :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
String -> String -> [String] -> Sem r CreateProcess
procFlex = ExecConfig -> String -> String -> [String] -> Sem r CreateProcess
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
ExecConfig -> String -> String -> [String] -> Sem r CreateProcess
procFlex' ExecConfig
defaultExecConfig

procFlex' :: ()
  => Member (Embed IO) r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => ExecConfig
  -> String
  -- ^ Cabal package name corresponding to the executable
  -> String
  -- ^ Environment variable pointing to the binary to run
  -> [String]
  -- ^ Arguments to the CLI command
  -> Sem r CreateProcess
  -- ^ Captured stdout
procFlex' :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
ExecConfig -> String -> String -> [String] -> Sem r CreateProcess
procFlex' ExecConfig
execConfig String
pkg String
binaryEnv [String]
arguments = (HasCallStack => Sem r CreateProcess) -> Sem r CreateProcess
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r CreateProcess) -> Sem r CreateProcess)
-> (HasCallStack => Sem r CreateProcess) -> Sem r CreateProcess
forall a b. (a -> b) -> a -> b
$ do
  String
bin <- String -> String -> Sem r String
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
String -> String -> Sem r String
binFlex String
pkg String
binaryEnv
  CreateProcess -> Sem r CreateProcess
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String] -> CreateProcess
proc String
bin [String]
arguments)
    { env = getLast $ execConfigEnv execConfig
    , cwd = getLast $ execConfigCwd execConfig
    -- this allows sending signals to the created processes, without killing the test-suite process
    , create_group = True
    }