Improve error reporting when calling binaries from plan.json

Author: carbolymer

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