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

    waitSecondsForProcess,
    waitSecondsForProcessOk,

  ) where

import           Data.Monoid                                     (Last (..))
import           GHC.Stack                                       (callStack)
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
  { $sel:execConfigEnv:ExecConfig :: Last [(String, String)]
execConfigEnv = Last [(String, String)]
forall a. Monoid a => a
mempty
  , $sel:execConfigCwd:ExecConfig :: 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 :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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).
(HasCallStack, 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' :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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).
(HasCallStack, 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) s.
(Member Hedgehog r, HasCallStack, ToString s) =>
s -> 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 :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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).
(HasCallStack, 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) s.
(Member Hedgehog r, HasCallStack, ToString s) =>
s -> Sem r ()
jot_ (String -> Sem r ()) -> ShowS -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"━━━━ command ━━━━\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (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
""

execDetailFlex :: ()
  => HasCallStack
  => Member (Embed IO) r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Hedgehog r
  => Member Log r
  => ExecConfig
  -> String
  -> String
  -> [String]
  -> Sem r (ExitCode, String, String)
execDetailFlex :: forall (r :: EffectRow).
(HasCallStack, Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Hedgehog r, Member Log r) =>
ExecConfig
-> String -> String -> [String] -> Sem r (ExitCode, String, String)
execDetailFlex 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).
(HasCallStack, 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) s.
(Member Hedgehog r, HasCallStack, ToString s) =>
s -> Sem r ()
jot_ (String -> Sem r ()) -> ShowS -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Command: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (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 [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_ :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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).
(HasCallStack, 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 :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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).
(HasCallStack, 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 :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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) s.
(Member Hedgehog r, HasCallStack, ToString s) =>
s -> Sem r ()
jot_ (String -> Sem r ()) -> ShowS -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( String
"━━━━ command ━━━━\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (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
""

-- | Wait a maximum of 'seconds' secons for process to exit.
waitSecondsForProcessOk :: ()
  => HasCallStack
  => Member Hedgehog r
  => Member (Embed IO) r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => Int
  -> ProcessHandle
  -> Sem r ExitCode
waitSecondsForProcessOk :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
 Member (Error GenericError) r, Member (Error IOException) r,
 Member Log r) =>
Int -> ProcessHandle -> Sem r ExitCode
waitSecondsForProcessOk Int
seconds ProcessHandle
hProcess = (HasCallStack => Sem r ExitCode) -> Sem r ExitCode
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ExitCode) -> Sem r ExitCode)
-> (HasCallStack => Sem r ExitCode) -> Sem r ExitCode
forall a b. (a -> b) -> a -> b
$ do
  Maybe ExitCode
maybeExitCode <- Int -> ProcessHandle -> Sem (Error TimedOut : r) (Maybe ExitCode)
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member (Error TimedOut) r,
 Member Log r) =>
Int -> ProcessHandle -> Sem r (Maybe ExitCode)
waitSecondsForProcess Int
seconds ProcessHandle
hProcess
    Sem (Error TimedOut : r) (Maybe ExitCode)
-> (Sem (Error TimedOut : r) (Maybe ExitCode)
    -> Sem r (Maybe ExitCode))
-> Sem r (Maybe ExitCode)
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show e) =>
Sem (Error e : r) a -> Sem r a
trapFail @TimedOut

  case Maybe ExitCode
maybeExitCode of
    Maybe ExitCode
Nothing -> CallStack -> String -> Sem r 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) s.
(Member Hedgehog r, HasCallStack, ToString s) =>
s -> 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
      ExitCode -> Sem r ExitCode
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
exitCode

-- | Compute the path to the binary given a package name or an environment variable override.
binFlex :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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 :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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).
(HasCallStack, 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' :: ()
  => HasCallStack
  => 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).
(HasCallStack, 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).
(HasCallStack, 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
    }