From 4eeec6125111e81def6d1521243791d974ec3c52 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 11 Oct 2024 13:10:43 +0200 Subject: [PATCH] Improve error reporting when calling binaries from plan.json --- src/Hedgehog/Extras/Test/Process.hs | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/Hedgehog/Extras/Test/Process.hs b/src/Hedgehog/Extras/Test/Process.hs index a273a31b..e2a8f457 100644 --- a/src/Hedgehog/Extras/Test/Process.hs +++ b/src/Hedgehog/Extras/Test/Process.hs @@ -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) @@ -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. @@ -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 @@ -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