{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Hedgehog.Extras.Test.Process
  ( createProcess
  , execFlex
  , procFlex
  , getProjectBase
  , waitForProcess
  , maybeWaitForProcess
  , getPid
  , waitSecondsForProcess
  ) where

import           Control.Monad
import           Control.Monad.Catch hiding (catch)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Monad.Trans.Resource (MonadResource, ReleaseKey, register)
import           Data.Aeson (eitherDecode)
import           Data.Bool
import           Data.Either
import           Data.Eq
import           Data.Function
import           Data.Int
import           Data.Maybe (Maybe (..))
import           Data.Semigroup ((<>))
import           Data.String (String)
import           GHC.Stack (HasCallStack)
import           Hedgehog (MonadTest)
import           Hedgehog.Extras.Internal.Cli (argQuote)
import           Hedgehog.Extras.Internal.Plan
import           Hedgehog.Extras.Stock.IO.Process (TimedOut (..))
import           Prelude (error)
import           System.Exit (ExitCode)
import           System.FilePath.Posix ((</>))
import           System.IO (Handle)
import           System.Process (CmdSpec (..), CreateProcess (..), Pid, ProcessHandle)
import           Text.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

planJsonFile :: String
planJsonFile :: String
planJsonFile = IO String -> String
forall a. IO a -> a
IO.unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
  Maybe String
maybeBuildDir <- IO (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
IO.lookupEnv String
"CABAL_BUILDDIR"
  case Maybe String
maybeBuildDir of
    Just String
buildDir -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
".." String -> String -> String
</> String
buildDir String -> String -> String
</> String
"cache/plan.json"
    Maybe String
Nothing -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"../dist-newstyle/cache/plan.json"
{-# NOINLINE planJsonFile #-}

exeSuffix :: String
exeSuffix :: String
exeSuffix = if Bool
OS.isWin32 then String
".exe" else String
""

-- | Create a process returning handles to stdin, stdout, and stderr as well as the process handle.
createProcess
  :: (MonadTest m, MonadResource m, HasCallStack)
  => CreateProcess
  -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle, ReleaseKey)
createProcess :: CreateProcess
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
      ReleaseKey)
createProcess CreateProcess
cp = (HasCallStack =>
 m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
    ReleaseKey))
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
      ReleaseKey)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack =>
  m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
     ReleaseKey))
 -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
       ReleaseKey))
-> (HasCallStack =>
    m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
       ReleaseKey))
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
      ReleaseKey)
forall a b. (a -> b) -> a -> b
$ do
  String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.annotate (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"CWD: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe String -> String
forall a. Show a => a -> String
show (CreateProcess -> Maybe String
IO.cwd CreateProcess
cp)
  case CreateProcess -> CmdSpec
IO.cmdspec CreateProcess
cp of
    RawCommand String
cmd [String]
args -> String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.annotate (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Command line: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
L.unwords [String]
args
    ShellCommand String
cmd -> String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.annotate (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Command line: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cmd
  (Maybe Handle
mhStdin, Maybe Handle
mhStdout, Maybe Handle
mhStderr, ProcessHandle
hProcess) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
IO.createProcess CreateProcess
cp
  ReleaseKey
releaseKey <- IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register (IO () -> m ReleaseKey) -> IO () -> m ReleaseKey
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)

  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
 ReleaseKey)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle,
      ReleaseKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle
mhStdin, Maybe Handle
mhStdout, Maybe Handle
mhStderr, ProcessHandle
hProcess, ReleaseKey
releaseKey)

-- | Get the process ID.
getPid
  :: (MonadTest m, MonadIO m, HasCallStack)
  => ProcessHandle
  -> m (Maybe Pid)
getPid :: ProcessHandle -> m (Maybe Pid)
getPid ProcessHandle
hProcess = m (Maybe Pid) -> m (Maybe Pid)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack (m (Maybe Pid) -> m (Maybe Pid))
-> (IO (Maybe Pid) -> m (Maybe Pid))
-> IO (Maybe Pid)
-> m (Maybe Pid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe Pid) -> m (Maybe Pid)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO (Maybe Pid) -> m (Maybe Pid))
-> IO (Maybe Pid) -> m (Maybe Pid)
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO (Maybe Pid)
IO.getPid ProcessHandle
hProcess

-- | 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.
execFlex
  :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
  => String
  -> String
  -> [String]
  -> m String
execFlex :: String -> String -> [String] -> m String
execFlex String
pkgBin String
envBin [String]
arguments = (HasCallStack => m String) -> m String
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m String) -> m String)
-> (HasCallStack => m String) -> m String
forall a b. (a -> b) -> a -> b
$ do
  CreateProcess
cp <- String -> String -> [String] -> m CreateProcess
forall (m :: * -> *).
(MonadTest m, MonadCatch m, MonadIO m, HasCallStack) =>
String -> String -> [String] -> m CreateProcess
procFlex String
pkgBin String
envBin [String]
arguments
  String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.annotate (String -> m ()) -> (String -> String) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Command: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ case CreateProcess -> CmdSpec
IO.cmdspec CreateProcess
cp of
    IO.ShellCommand String
cmd -> String
cmd
    IO.RawCommand String
cmd [String]
args -> String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
L.unwords [String]
args
  (ExitCode
exitResult, String
stdout, String
stderr) <- IO (ExitCode, String, String) -> m (ExitCode, String, String)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO (ExitCode, String, String) -> m (ExitCode, String, String))
-> IO (ExitCode, String, String) -> m (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
IO.readCreateProcessWithExitCode CreateProcess
cp String
""
  case ExitCode
exitResult of
    IO.ExitFailure Int
exitCode -> CallStack -> String -> m String
forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
H.failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String -> m String)
-> ([String] -> String) -> [String] -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
L.unlines ([String] -> m String) -> [String] -> m String
forall a b. (a -> b) -> a -> b
$
      [ String
"Process exited with non-zero exit-code"
      , String
"━━━━ command ━━━━"
      , String
pkgBin String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
L.unwords ((String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
argQuote [String]
arguments)
      , String
"━━━━ stdout ━━━━"
      , String
stdout
      , String
"━━━━ stderr ━━━━"
      , String
stderr
      , String
"━━━━ exit code ━━━━"
      , Int -> String
forall a. Show a => a -> String
show @Int Int
exitCode
      ]
    ExitCode
IO.ExitSuccess -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
stdout

-- | Wait for process to exit.
waitForProcess
  :: (MonadTest m, MonadIO m, HasCallStack)
  => ProcessHandle
  -> m ExitCode
waitForProcess :: ProcessHandle -> m ExitCode
waitForProcess ProcessHandle
hProcess = (HasCallStack => m ExitCode) -> m ExitCode
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ExitCode) -> m ExitCode)
-> (HasCallStack => m ExitCode) -> m ExitCode
forall a b. (a -> b) -> a -> b
$
  IO ExitCode -> m ExitCode
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO ExitCode -> m ExitCode) -> IO ExitCode -> m ExitCode
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
IO.waitForProcess ProcessHandle
hProcess

-- | Wait for process to exit or return 'Nothing' if interrupted by an asynchronous exception.
maybeWaitForProcess
  :: (MonadTest m, MonadIO m, HasCallStack)
  => ProcessHandle
  -> m (Maybe ExitCode)
maybeWaitForProcess :: ProcessHandle -> m (Maybe ExitCode)
maybeWaitForProcess ProcessHandle
hProcess = (HasCallStack => m (Maybe ExitCode)) -> m (Maybe ExitCode)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m (Maybe ExitCode)) -> m (Maybe ExitCode))
-> (HasCallStack => m (Maybe ExitCode)) -> m (Maybe ExitCode)
forall a b. (a -> b) -> a -> b
$
  IO (Maybe ExitCode) -> m (Maybe ExitCode)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO (Maybe ExitCode) -> m (Maybe ExitCode))
-> IO (Maybe ExitCode) -> m (Maybe ExitCode)
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO (Maybe ExitCode)
IO.maybeWaitForProcess ProcessHandle
hProcess

-- | Wait a maximum of 'seconds' secons for process to exit.
waitSecondsForProcess
  :: (MonadTest m, MonadIO m, HasCallStack)
  => Int
  -> ProcessHandle
  -> m (Either TimedOut ExitCode)
waitSecondsForProcess :: Int -> ProcessHandle -> m (Either TimedOut ExitCode)
waitSecondsForProcess Int
seconds ProcessHandle
hProcess = (HasCallStack => m (Either TimedOut ExitCode))
-> m (Either TimedOut ExitCode)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m (Either TimedOut ExitCode))
 -> m (Either TimedOut ExitCode))
-> (HasCallStack => m (Either TimedOut ExitCode))
-> m (Either TimedOut ExitCode)
forall a b. (a -> b) -> a -> b
$ do
  Either TimedOut (Maybe ExitCode)
result <- IO (Either TimedOut (Maybe ExitCode))
-> m (Either TimedOut (Maybe ExitCode))
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO (Either TimedOut (Maybe ExitCode))
 -> m (Either TimedOut (Maybe ExitCode)))
-> IO (Either TimedOut (Maybe ExitCode))
-> m (Either TimedOut (Maybe ExitCode))
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
      String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.annotate String
"Timed out waiting for process to exit"
      Either TimedOut ExitCode -> m (Either TimedOut ExitCode)
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 -> m (Either TimedOut ExitCode)
forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
H.failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"No exit code for process"
        Just ExitCode
exitCode -> do
          String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.annotate (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Process exited " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ExitCode -> String
forall a. Show a => a -> String
show ExitCode
exitCode
          Either TimedOut ExitCode -> m (Either TimedOut ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Either TimedOut ExitCode
forall a b. b -> Either a b
Right ExitCode
exitCode)

-- | Create a 'CreateProcess' describing how to start a process given the Cabal package name
-- corresponding to the executable and an argument list.
--
-- The actual executable will be found by consulting the "plan.json" generated by cabal.  It
-- is assumed that the proused ject has already been configured and the executable has been
-- built.
procDist
  :: (MonadTest m, MonadIO m)
  => String
  -- ^ Package name
  -> [String]
  -- ^ Arguments to the CLI command
  -> m CreateProcess
  -- ^ Captured stdout
procDist :: String -> [String] -> m CreateProcess
procDist String
pkg [String]
arguments = do
  ByteString
contents <- IO ByteString -> m ByteString
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO ByteString -> m ByteString)
-> (String -> IO ByteString) -> String -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
LBS.readFile (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String
planJsonFile

  case ByteString -> Either String Plan
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
contents of
    Right Plan
plan -> case (Component -> Bool) -> [Component] -> [Component]
forall a. (a -> Bool) -> [a] -> [a]
L.filter Component -> Bool
matching (Plan
plan Plan -> (Plan -> [Component]) -> [Component]
forall a b. a -> (a -> b) -> b
& Plan -> [Component]
installPlan) of
      (Component
component:[Component]
_) -> case Component
component Component -> (Component -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
& Component -> Maybe Text
binFile of
        Just Text
bin -> CreateProcess -> m CreateProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (CreateProcess -> m CreateProcess)
-> CreateProcess -> m CreateProcess
forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
IO.proc (Text -> String
T.unpack Text
bin String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
exeSuffix) [String]
arguments
        Maybe Text
Nothing -> String -> m CreateProcess
forall a. HasCallStack => String -> a
error (String -> m CreateProcess) -> String -> m CreateProcess
forall a b. (a -> b) -> a -> b
$ String
"missing bin-file in: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Component -> String
forall a. Show a => a -> String
show Component
component
      [] -> String -> m CreateProcess
forall a. HasCallStack => String -> a
error (String -> m CreateProcess) -> String -> m CreateProcess
forall a b. (a -> b) -> a -> b
$ String
"Cannot find exe:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pkg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in plan"
    Left String
message -> String -> m CreateProcess
forall a. HasCallStack => String -> a
error (String -> m CreateProcess) -> String -> m CreateProcess
forall a b. (a -> b) -> a -> b
$ String
"Cannot decode plan: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message
  where matching :: Component -> Bool
        matching :: Component -> Bool
matching Component
component = case Component -> Maybe Text
componentName Component
component of
          Just Text
name -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"exe:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
pkg
          Maybe Text
Nothing -> Bool
False

-- | 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
  :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
  => String
  -- ^ Cabal package name corresponding to the executable
  -> String
  -- ^ Environment variable pointing to the binary to run
  -> [String]
  -- ^ Arguments to the CLI command
  -> m CreateProcess
  -- ^ Captured stdout
procFlex :: String -> String -> [String] -> m CreateProcess
procFlex String
pkg String
binaryEnv [String]
arguments = m CreateProcess -> m CreateProcess
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack (m CreateProcess -> m CreateProcess)
-> (m CreateProcess -> m CreateProcess)
-> m CreateProcess
-> m CreateProcess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m CreateProcess -> m CreateProcess
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
H.evalM (m CreateProcess -> m CreateProcess)
-> m CreateProcess -> m CreateProcess
forall a b. (a -> b) -> a -> b
$ do
  Maybe String
maybeEnvBin <- IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
IO.lookupEnv String
binaryEnv
  case Maybe String
maybeEnvBin of
    Just String
envBin -> CreateProcess -> m CreateProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (CreateProcess -> m CreateProcess)
-> CreateProcess -> m CreateProcess
forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
IO.proc String
envBin [String]
arguments
    Maybe String
Nothing -> String -> [String] -> m CreateProcess
forall (m :: * -> *).
(MonadTest m, MonadIO m) =>
String -> [String] -> m CreateProcess
procDist String
pkg [String]
arguments

-- | Compute the project base.  This will be based on either the "CARDANO_NODE_SRC"
-- environment variable or the parent directory.  Both should point to the
-- root directory of the Github project checkout.
getProjectBase
  :: (MonadTest m, MonadIO m)
  => m String
getProjectBase :: m String
getProjectBase = do
  Maybe String
maybeNodeSrc <- IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
IO.lookupEnv String
"CARDANO_NODE_SRC"
  case Maybe String
maybeNodeSrc of
    Just String
path -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
    Maybe String
Nothing -> do
      Bool
atBase <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
IO.doesFileExist String
"cabal.project"
      if Bool
atBase
        then String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"."
        else String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
".."