{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Hedgehog.Extras.Test.Process
( createProcess
, exec
, exec_
, execFlex
, execFlex'
, procFlex
, binFlex
, getProjectBase
, waitForProcess
, maybeWaitForProcess
, getPid
, waitSecondsForProcess
, ExecConfig(..)
, defaultExecConfig
) where
import Control.Monad (Monad(..), MonadFail(fail), void)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Resource (MonadResource, ReleaseKey, register)
import Data.Aeson (eitherDecode)
import Data.Bool (Bool(..))
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function (($), (&), (.))
import Data.Functor (Functor(..))
import Data.Int (Int)
import Data.Maybe (Maybe (..))
import Data.Monoid (Last (..), mempty, (<>))
import Data.String (String)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Hedgehog (MonadTest)
import Hedgehog.Extras.Internal.Cli (argQuote)
import Hedgehog.Extras.Internal.Plan (Component(..), Plan(..))
import Hedgehog.Extras.Stock.IO.Process (TimedOut (..))
import Prelude (error)
import System.Exit (ExitCode)
import System.FilePath (takeDirectory)
import System.FilePath.Posix ((</>))
import System.IO (FilePath, Handle, IO)
import System.Process (CmdSpec (..), CreateProcess (..), Pid, ProcessHandle)
import Text.Show (Show(show))
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List as L
import qualified Data.Text as T
import qualified GHC.Stack as GHC
import qualified Hedgehog as H
import qualified Hedgehog.Extras.Stock.IO.Process as IO
import qualified Hedgehog.Extras.Stock.OS as OS
import qualified Hedgehog.Extras.Test.Base as H
import qualified System.Directory as IO
import qualified System.Environment as IO
import qualified System.Exit as IO
import qualified System.IO.Unsafe as IO
import qualified System.Process as IO
data ExecConfig = ExecConfig
{ ExecConfig -> Last [([Char], [Char])]
execConfigEnv :: Last [(String, String)]
, ExecConfig -> Last [Char]
execConfigCwd :: Last FilePath
} deriving (ExecConfig -> ExecConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecConfig -> ExecConfig -> Bool
$c/= :: ExecConfig -> ExecConfig -> Bool
== :: ExecConfig -> ExecConfig -> Bool
$c== :: ExecConfig -> ExecConfig -> Bool
Eq, 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
$cto :: forall x. Rep ExecConfig x -> ExecConfig
$cfrom :: forall x. ExecConfig -> Rep ExecConfig x
Generic, Int -> ExecConfig -> ShowS
[ExecConfig] -> ShowS
ExecConfig -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ExecConfig] -> ShowS
$cshowList :: [ExecConfig] -> ShowS
show :: ExecConfig -> [Char]
$cshow :: ExecConfig -> [Char]
showsPrec :: Int -> ExecConfig -> ShowS
$cshowsPrec :: Int -> ExecConfig -> ShowS
Show)
defaultExecConfig :: ExecConfig
defaultExecConfig :: ExecConfig
defaultExecConfig = ExecConfig
{ execConfigEnv :: Last [([Char], [Char])]
execConfigEnv = forall a. Monoid a => a
mempty
, execConfigCwd :: Last [Char]
execConfigCwd = forall a. Monoid a => a
mempty
}
findDefaultPlanJsonFile :: IO FilePath
findDefaultPlanJsonFile :: IO [Char]
findDefaultPlanJsonFile = IO [Char]
IO.getCurrentDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO [Char]
go
where go :: FilePath -> IO FilePath
go :: [Char] -> IO [Char]
go [Char]
d = do
let file :: [Char]
file = [Char]
d [Char] -> ShowS
</> [Char]
"dist-newstyle/cache/plan.json"
Bool
exists <- [Char] -> IO Bool
IO.doesFileExist [Char]
file
if Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
file
else do
let parent :: [Char]
parent = ShowS
takeDirectory [Char]
d
if [Char]
parent forall a. Eq a => a -> a -> Bool
== [Char]
d
then forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"dist-newstyle/cache/plan.json"
else [Char] -> IO [Char]
go [Char]
parent
planJsonFile :: String
planJsonFile :: [Char]
planJsonFile = forall a. IO a -> a
IO.unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
Maybe [Char]
maybeBuildDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
IO.lookupEnv [Char]
"CABAL_BUILDDIR"
case Maybe [Char]
maybeBuildDir of
Just [Char]
buildDir -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char]
".." [Char] -> ShowS
</> [Char]
buildDir [Char] -> ShowS
</> [Char]
"cache/plan.json"
Maybe [Char]
Nothing -> IO [Char]
findDefaultPlanJsonFile
{-# NOINLINE planJsonFile #-}
exeSuffix :: String
exeSuffix :: [Char]
exeSuffix = if Bool
OS.isWin32 then [Char]
".exe" else [Char]
""
addExeSuffix :: String -> String
addExeSuffix :: ShowS
addExeSuffix [Char]
s = if [Char]
".exe" forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` [Char]
s
then [Char]
s
else [Char]
s forall a. Semigroup a => a -> a -> a
<> [Char]
exeSuffix
createProcess
:: (MonadTest m, MonadResource m, HasCallStack)
=> CreateProcess
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle, ReleaseKey)
createProcess :: forall (m :: * -> *).
(MonadTest m, MonadResource m, HasCallStack) =>
CreateProcess
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
ReleaseKey)
createProcess CreateProcess
cp = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ [Char]
"CWD: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (CreateProcess -> Maybe [Char]
IO.cwd CreateProcess
cp)
case CreateProcess -> CmdSpec
IO.cmdspec CreateProcess
cp of
RawCommand [Char]
cmd [[Char]]
args -> forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ [Char]
"Command line: " forall a. Semigroup a => a -> a -> a
<> [Char]
cmd forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
L.unwords [[Char]]
args
ShellCommand [Char]
cmd -> forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ [Char]
"Command line: " forall a. Semigroup a => a -> a -> a
<> [Char]
cmd
(Maybe Handle
mhStdin, Maybe Handle
mhStdout, Maybe Handle
mhStderr, ProcessHandle
hProcess) <- forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
IO.createProcess CreateProcess
cp
ReleaseKey
releaseKey <- forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register forall a b. (a -> b) -> a -> b
$ (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
IO.cleanupProcess (Maybe Handle
mhStdin, Maybe Handle
mhStdout, Maybe Handle
mhStderr, ProcessHandle
hProcess)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle
mhStdin, Maybe Handle
mhStdout, Maybe Handle
mhStderr, ProcessHandle
hProcess, ReleaseKey
releaseKey)
getPid
:: (MonadTest m, MonadIO m, HasCallStack)
=> ProcessHandle
-> m (Maybe Pid)
getPid :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
ProcessHandle -> m (Maybe Pid)
getPid ProcessHandle
hProcess = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO (Maybe Pid)
IO.getPid ProcessHandle
hProcess
execFlex
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
=> String
-> String
-> [String]
-> m String
execFlex :: forall (m :: * -> *).
(MonadTest m, MonadCatch m, MonadIO m, HasCallStack) =>
[Char] -> [Char] -> [[Char]] -> m [Char]
execFlex = forall (m :: * -> *).
(MonadTest m, MonadCatch m, MonadIO m, HasCallStack) =>
ExecConfig -> [Char] -> [Char] -> [[Char]] -> m [Char]
execFlex' ExecConfig
defaultExecConfig
execFlex'
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
=> ExecConfig
-> String
-> String
-> [String]
-> m String
execFlex' :: forall (m :: * -> *).
(MonadTest m, MonadCatch m, MonadIO m, HasCallStack) =>
ExecConfig -> [Char] -> [Char] -> [[Char]] -> m [Char]
execFlex' ExecConfig
execConfig [Char]
pkgBin [Char]
envBin [[Char]]
arguments = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
CreateProcess
cp <- forall (m :: * -> *).
(MonadTest m, MonadCatch m, MonadIO m, HasCallStack) =>
ExecConfig -> [Char] -> [Char] -> [[Char]] -> m CreateProcess
procFlex' ExecConfig
execConfig [Char]
pkgBin [Char]
envBin [[Char]]
arguments
forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
H.annotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Command: " forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ case CreateProcess -> CmdSpec
IO.cmdspec CreateProcess
cp of
IO.ShellCommand [Char]
cmd -> [Char]
cmd
IO.RawCommand [Char]
cmd [[Char]]
args -> [Char]
cmd forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
L.unwords [[Char]]
args
(ExitCode
exitResult, [Char]
stdout, [Char]
stderr) <- forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> [Char] -> IO (ExitCode, [Char], [Char])
IO.readCreateProcessWithExitCode CreateProcess
cp [Char]
""
case ExitCode
exitResult of
IO.ExitFailure Int
exitCode -> do
forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
L.unlines forall a b. (a -> b) -> a -> b
$
[ [Char]
"Process exited with non-zero exit-code"
, [Char]
"━━━━ command ━━━━"
, [Char]
pkgBin forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
L.unwords (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
argQuote [[Char]]
arguments)
, [Char]
"━━━━ stdout ━━━━"
, [Char]
stdout
, [Char]
"━━━━ stderr ━━━━"
, [Char]
stderr
, [Char]
"━━━━ exit code ━━━━"
, forall a. Show a => a -> [Char]
show @Int Int
exitCode
]
forall (m :: * -> *) a. MonadTest m => CallStack -> [Char] -> m a
H.failMessage HasCallStack => CallStack
GHC.callStack [Char]
"Execute process failed"
ExitCode
IO.ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
stdout
exec_
:: (MonadTest m, MonadIO m, HasCallStack)
=> ExecConfig
-> String
-> [String]
-> m ()
exec_ :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
ExecConfig -> [Char] -> [[Char]] -> m ()
exec_ ExecConfig
execConfig [Char]
bin [[Char]]
arguments = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
ExecConfig -> [Char] -> [[Char]] -> m [Char]
exec ExecConfig
execConfig [Char]
bin [[Char]]
arguments
exec
:: (MonadTest m, MonadIO m, HasCallStack)
=> ExecConfig
-> String
-> [String]
-> m String
exec :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
ExecConfig -> [Char] -> [[Char]] -> m [Char]
exec ExecConfig
execConfig [Char]
bin [[Char]]
arguments = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
let cp :: CreateProcess
cp = ([Char] -> [[Char]] -> CreateProcess
IO.proc [Char]
bin [[Char]]
arguments)
{ env :: Maybe [([Char], [Char])]
IO.env = forall a. Last a -> Maybe a
getLast forall a b. (a -> b) -> a -> b
$ ExecConfig -> Last [([Char], [Char])]
execConfigEnv ExecConfig
execConfig
, cwd :: Maybe [Char]
IO.cwd = forall a. Last a -> Maybe a
getLast forall a b. (a -> b) -> a -> b
$ ExecConfig -> Last [Char]
execConfigCwd ExecConfig
execConfig
}
forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
H.annotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Command: " forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ [Char]
bin forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
L.unwords [[Char]]
arguments
(ExitCode
exitResult, [Char]
stdout, [Char]
stderr) <- forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> [Char] -> IO (ExitCode, [Char], [Char])
IO.readCreateProcessWithExitCode CreateProcess
cp [Char]
""
case ExitCode
exitResult of
IO.ExitFailure Int
exitCode -> forall (m :: * -> *) a. MonadTest m => CallStack -> [Char] -> m a
H.failMessage HasCallStack => CallStack
GHC.callStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
L.unlines forall a b. (a -> b) -> a -> b
$
[ [Char]
"Process exited with non-zero exit-code"
, [Char]
"━━━━ command ━━━━"
, [Char]
bin forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
L.unwords (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
argQuote [[Char]]
arguments)
, [Char]
"━━━━ stdout ━━━━"
, [Char]
stdout
, [Char]
"━━━━ stderr ━━━━"
, [Char]
stderr
, [Char]
"━━━━ exit code ━━━━"
, forall a. Show a => a -> [Char]
show @Int Int
exitCode
]
ExitCode
IO.ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
stdout
waitForProcess
:: (MonadTest m, MonadIO m, HasCallStack)
=> ProcessHandle
-> m ExitCode
waitForProcess :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
ProcessHandle -> m ExitCode
waitForProcess ProcessHandle
hProcess = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
IO.waitForProcess ProcessHandle
hProcess
maybeWaitForProcess
:: (MonadTest m, MonadIO m, HasCallStack)
=> ProcessHandle
-> m (Maybe ExitCode)
maybeWaitForProcess :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
ProcessHandle -> m (Maybe ExitCode)
maybeWaitForProcess ProcessHandle
hProcess = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO (Maybe ExitCode)
IO.maybeWaitForProcess ProcessHandle
hProcess
waitSecondsForProcess
:: (MonadTest m, MonadIO m, HasCallStack)
=> Int
-> ProcessHandle
-> m (Either TimedOut ExitCode)
waitSecondsForProcess :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
Int -> ProcessHandle -> m (Either TimedOut ExitCode)
waitSecondsForProcess Int
seconds ProcessHandle
hProcess = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
Either TimedOut (Maybe ExitCode)
result <- forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ Int -> ProcessHandle -> IO (Either TimedOut (Maybe ExitCode))
IO.waitSecondsForProcess Int
seconds ProcessHandle
hProcess
case Either TimedOut (Maybe ExitCode)
result of
Left TimedOut
TimedOut -> do
forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
H.annotate [Char]
"Timed out waiting for process to exit"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left TimedOut
TimedOut)
Right Maybe ExitCode
maybeExitCode -> do
case Maybe ExitCode
maybeExitCode of
Maybe ExitCode
Nothing -> forall (m :: * -> *) a. MonadTest m => CallStack -> [Char] -> m a
H.failMessage HasCallStack => CallStack
GHC.callStack [Char]
"No exit code for process"
Just ExitCode
exitCode -> do
forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ [Char]
"Process exited " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show ExitCode
exitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ExitCode
exitCode)
binFlex
:: (MonadTest m, MonadIO m)
=> String
-> String
-> m FilePath
binFlex :: forall (m :: * -> *).
(MonadTest m, MonadIO m) =>
[Char] -> [Char] -> m [Char]
binFlex [Char]
pkg [Char]
binaryEnv = do
Maybe [Char]
maybeEnvBin <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
IO.lookupEnv [Char]
binaryEnv
case Maybe [Char]
maybeEnvBin of
Just [Char]
envBin -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
envBin
Maybe [Char]
Nothing -> forall (m :: * -> *).
(MonadTest m, MonadIO m) =>
[Char] -> m [Char]
binDist [Char]
pkg
binDist
:: (MonadTest m, MonadIO m)
=> String
-> m FilePath
binDist :: forall (m :: * -> *).
(MonadTest m, MonadIO m) =>
[Char] -> m [Char]
binDist [Char]
pkg = do
ByteString
contents <- forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ByteString
LBS.readFile forall a b. (a -> b) -> a -> b
$ [Char]
planJsonFile
case forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
contents of
Right Plan
plan -> case forall a. (a -> Bool) -> [a] -> [a]
L.filter Component -> Bool
matching (Plan
plan forall a b. a -> (a -> b) -> b
& Plan -> [Component]
installPlan) of
(Component
component:[Component]
_) -> case Component
component forall a b. a -> (a -> b) -> b
& Component -> Maybe Text
binFile of
Just Text
bin -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ShowS
addExeSuffix (Text -> [Char]
T.unpack Text
bin)
Maybe Text
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"missing bin-file in: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Component
component
[] -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot find exe:" forall a. Semigroup a => a -> a -> a
<> [Char]
pkg forall a. Semigroup a => a -> a -> a
<> [Char]
" in plan"
Left [Char]
message -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot decode plan: " forall a. Semigroup a => a -> a -> a
<> [Char]
message
where matching :: Component -> Bool
matching :: Component -> Bool
matching Component
component = case Component -> Maybe Text
componentName Component
component of
Just Text
name -> Text
name forall a. Eq a => a -> a -> Bool
== Text
"exe:" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
pkg
Maybe Text
Nothing -> Bool
False
procFlex
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
=> String
-> String
-> [String]
-> m CreateProcess
procFlex :: forall (m :: * -> *).
(MonadTest m, MonadCatch m, MonadIO m, HasCallStack) =>
[Char] -> [Char] -> [[Char]] -> m CreateProcess
procFlex = forall (m :: * -> *).
(MonadTest m, MonadCatch m, MonadIO m, HasCallStack) =>
ExecConfig -> [Char] -> [Char] -> [[Char]] -> m CreateProcess
procFlex' ExecConfig
defaultExecConfig
procFlex'
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
=> ExecConfig
-> String
-> String
-> [String]
-> m CreateProcess
procFlex' :: forall (m :: * -> *).
(MonadTest m, MonadCatch m, MonadIO m, HasCallStack) =>
ExecConfig -> [Char] -> [Char] -> [[Char]] -> m CreateProcess
procFlex' ExecConfig
execConfig [Char]
pkg [Char]
binaryEnv [[Char]]
arguments = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
H.evalM forall a b. (a -> b) -> a -> b
$ do
[Char]
bin <- forall (m :: * -> *).
(MonadTest m, MonadIO m) =>
[Char] -> [Char] -> m [Char]
binFlex [Char]
pkg [Char]
binaryEnv
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [[Char]] -> CreateProcess
IO.proc [Char]
bin [[Char]]
arguments)
{ env :: Maybe [([Char], [Char])]
IO.env = forall a. Last a -> Maybe a
getLast forall a b. (a -> b) -> a -> b
$ ExecConfig -> Last [([Char], [Char])]
execConfigEnv ExecConfig
execConfig
, cwd :: Maybe [Char]
IO.cwd = forall a. Last a -> Maybe a
getLast forall a b. (a -> b) -> a -> b
$ ExecConfig -> Last [Char]
execConfigCwd ExecConfig
execConfig
}
getProjectBase
:: (MonadTest m, MonadIO m)
=> m String
getProjectBase :: forall (m :: * -> *). (MonadTest m, MonadIO m) => m [Char]
getProjectBase = do
let
findUp :: [Char] -> m [Char]
findUp [Char]
dir = do
Bool
atBase <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
IO.doesFileExist ([Char]
dir forall a. Semigroup a => a -> a -> a
<> [Char]
"/cabal.project")
if Bool
atBase
then forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
dir
else do
let up :: [Char]
up = [Char]
dir forall a. Semigroup a => a -> a -> a
<> [Char]
"/.."
Bool
upExist <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
IO.doesDirectoryExist [Char]
up
if Bool
upExist
then [Char] -> m [Char]
findUp [Char]
up
else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Could not detect project base directory (containing cabal.project)"
Maybe [Char]
maybeNodeSrc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
IO.lookupEnv [Char]
"CARDANO_NODE_SRC"
case Maybe [Char]
maybeNodeSrc of
Just [Char]
path -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
path
Maybe [Char]
Nothing -> forall {m :: * -> *}. MonadIO m => [Char] -> m [Char]
findUp [Char]
"."