Skip to content

Commit

Permalink
Improve error reporting when calling binaries from plan.json
Browse files Browse the repository at this point in the history
  • Loading branch information
carbolymer committed Oct 14, 2024
1 parent 424c32b commit 4eeec61
Showing 1 changed file with 13 additions and 8 deletions.
21 changes: 13 additions & 8 deletions src/Hedgehog/Extras/Test/Process.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ module Hedgehog.Extras.Test.Process
, defaultExecConfig
) where

import Control.Monad (Monad (..), MonadFail (fail), void)
import Control.Monad (Monad (..), MonadFail (fail), void, unless)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Resource (MonadResource, ReleaseKey, register)
Expand Down Expand Up @@ -84,14 +84,15 @@ findDefaultPlanJsonFile :: IO FilePath
findDefaultPlanJsonFile = IO.getCurrentDirectory >>= go
where go :: FilePath -> IO FilePath
go d = do
let file = d </> "dist-newstyle/cache/plan.json"
let planRelPath = "dist-newstyle/cache/plan.json"
file = d </> planRelPath
exists <- IO.doesFileExist file
if exists
then return file
else do
let parent = takeDirectory d
if parent == d
then return "dist-newstyle/cache/plan.json"
then return planRelPath
else go parent

-- | Discover the location of the plan.json file.
Expand Down Expand Up @@ -272,7 +273,7 @@ waitSecondsForProcess seconds hProcess = GHC.withFrozenCallStack $ do

-- | Compute the path to the binary given a package name or an environment variable override.
binFlex
:: (MonadTest m, MonadIO m)
:: (HasCallStack, MonadTest m, MonadIO m)
=> String
-- ^ Package name
-> String
Expand All @@ -288,22 +289,26 @@ binFlex pkg binaryEnv = do
-- | Consult the "plan.json" generated by cabal to get the path to the executable corresponding.
-- to a haskell package. It is assumed that the project has already been configured and the
-- executable has been built.
-- Throws an exception on failure.
binDist
:: (MonadTest m, MonadIO m)
:: (HasCallStack, MonadTest m, MonadIO m)
=> String
-- ^ Package name
-> m FilePath
-- ^ Path to executable
binDist pkg = do
doesPlanExist <- liftIO $ IO.doesFileExist planJsonFile
unless doesPlanExist $
error $ "Could not find plan.json in the path: " <> planJsonFile
contents <- H.evalIO . LBS.readFile $ planJsonFile

case eitherDecode contents of
Right plan -> case L.filter matching (plan & installPlan) of
(component:_) -> case component & binFile of
Just bin -> return $ addExeSuffix (T.unpack bin)
Nothing -> error $ "missing bin-file in: " <> show component
[] -> error $ "Cannot find exe:" <> pkg <> " in plan"
Left message -> error $ "Cannot decode plan: " <> message
Nothing -> error $ "missing \"bin-file\" key in plan component: " <> show component <> " in the plan in: " <> planJsonFile
[] -> error $ "Cannot find \"component-name\" key with the value \"exe:" <> pkg <> "\" in the plan in: " <> planJsonFile
Left message -> error $ "Cannot decode plan in " <> planJsonFile <> ": " <> message
where matching :: Component -> Bool
matching component = case componentName component of
Just name -> name == "exe:" <> T.pack pkg
Expand Down

0 comments on commit 4eeec61

Please sign in to comment.