Add test-cases for cradle load failures

hie-bios.cabal

@@ -52,6 +52,17 @@ Extra-Source-Files:     ChangeLog
                         tests/projects/multi-stack/hie.yaml
                         tests/projects/multi-stack/multi-stack.cabal
                         tests/projects/multi-stack/src/Lib.hs
+                        tests/projects/failing-bios/A.hs
+                        tests/projects/failing-bios/B.cabal
+                        tests/projects/failing-bios/hie.yaml
+                        tests/projects/failing-cabal/failing-cabal.cabal
+                        tests/projects/failing-cabal/hie.yaml
+                        tests/projects/failing-cabal/MyLib.hs
+                        tests/projects/failing-cabal/Setup.hs
+                        tests/projects/failing-stack/failing-stack.cabal
+                        tests/projects/failing-stack/hie.yaml
+                        tests/projects/failing-stack/src/Lib.hs
+                        tests/projects/failing-stack/Setup.hs
                         tests/projects/simple-bios/A.hs
                         tests/projects/simple-bios/B.hs
                         tests/projects/simple-bios/hie-bios.sh
@@ -183,6 +194,7 @@ test-suite bios-tests
       extra,
       tasty,
       tasty-hunit,
+      tasty-expected-failure,
       hspec-expectations,
       hie-bios,
       filepath,

src/HIE/Bios/Cradle.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE BangPatterns #-}
@@ -118,8 +119,16 @@ addCradleDeps deps c =
     addActionDeps :: CradleAction a -> CradleAction a
     addActionDeps ca =
       ca { runCradle = \l fp ->
-            (fmap (\(ComponentOptions os' dir ds) -> ComponentOptions os' dir (ds `union` deps)))
-              <$> runCradle ca l fp }
+            runCradle ca l fp
+              >>= \case
+                CradleSuccess (ComponentOptions os' dir ds) ->
+                  pure $ CradleSuccess (ComponentOptions os' dir (ds `union` deps))
+                CradleFail err ->
+                  pure $ CradleFail
+                    (err { cradleErrorDependencies = cradleErrorDependencies err `union` deps })
+                CradleNone -> pure CradleNone
+         }
+
 
 implicitConfig :: FilePath -> MaybeT IO (CradleConfig a, FilePath)
 implicitConfig fp = do

tests/BiosTests.hs

@@ -1,8 +1,10 @@
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE CPP #-}
 module Main where
 
 import Test.Tasty
+import Test.Tasty.ExpectedFailure
 import Test.Tasty.HUnit
 import Test.Hspec.Expectations
 import HIE.Bios
@@ -16,6 +18,7 @@ import Data.Void
 import System.Directory
 import System.FilePath ( makeRelative, (</>) )
 import System.Info.Extra ( isWindows )
+import System.Exit (ExitCode(ExitFailure))
 
 main :: IO ()
 main = do
@@ -40,7 +43,15 @@ main = do
       , testGroup "Loading tests"
         $ linuxExlusiveTestCases
         ++
-           [ testCaseSteps "simple-bios-shell" $ testDirectory isBiosCradle "./tests/projects/simple-bios-shell/B.hs"
+           [ testCaseSteps "failing-cabal" $ testDirectoryFail isCabalCradle "./tests/projects/failing-cabal/MyLib.hs"
+              (\CradleError {..} -> do
+                  cradleErrorExitCode `shouldBe` ExitFailure 1
+                  cradleErrorDependencies `shouldMatchList` ["failing-cabal.cabal", "cabal.project", "cabal.project.local"])
+           , testCaseSteps "failing-bios" $ testDirectoryFail isBiosCradle "./tests/projects/failing-bios/B.hs"
+              (\CradleError {..} -> do
+                  cradleErrorExitCode `shouldBe` ExitFailure 1
+                  cradleErrorDependencies `shouldMatchList` ["hie.yaml"])
+           , testCaseSteps "simple-bios-shell" $ testDirectory isBiosCradle "./tests/projects/simple-bios-shell/B.hs"
            , testCaseSteps "simple-cabal" $ testDirectory isCabalCradle "./tests/projects/simple-cabal/B.hs"
            , testCaseSteps "simple-direct" $ testDirectory isDirectCradle "./tests/projects/simple-direct/B.hs"
            , testCaseSteps "multi-direct" {- tests if both components can be loaded -}
@@ -52,7 +63,12 @@ main = do
            ]
 -- TODO: Remove once there's a stackage snapshot for ghc 8.10
 #if __GLASGOW_HASKELL__ < 810
-       ++ [ testCaseSteps "simple-stack" $ testDirectory isStackCradle "./tests/projects/simple-stack/B.hs"
+       ++ [ expectFailBecause "stack repl does not fail on an invalid cabal file" $
+              testCaseSteps "failing-stack" $ testDirectoryFail isStackCradle "./tests/projects/failing-stack/src/Lib.hs"
+                (\CradleError {..} -> do
+                    cradleErrorExitCode `shouldBe` ExitFailure 1
+                    cradleErrorDependencies `shouldMatchList` ["failing-stack.cabal", "stack.yaml", "package.yaml"])
+          , testCaseSteps "simple-stack" $ testDirectory isStackCradle "./tests/projects/simple-stack/B.hs"
           , testCaseSteps "multi-stack" {- tests if both components can be loaded -}
                         $  testDirectory isStackCradle "./tests/projects/multi-stack/app/Main.hs"
                         >> testDirectory isStackCradle "./tests/projects/multi-stack/src/Lib.hs"
@@ -83,15 +99,27 @@ linuxExlusiveTestCases =
 testDirectory :: (Cradle Void -> Bool) -> FilePath -> (String -> IO ()) -> IO ()
 testDirectory cradlePred fp step = do
   a_fp <- canonicalizePath fp
+  crd <- initialiseCradle cradlePred a_fp step
+  step "Initialise Flags"
+  testLoadFile crd a_fp step
+
+testDirectoryFail :: (Cradle Void -> Bool) -> FilePath -> (CradleError -> Expectation) -> (String -> IO ()) -> IO ()
+testDirectoryFail cradlePred fp cradleFailPred step = do
+  a_fp <- canonicalizePath fp
+  crd <- initialiseCradle cradlePred a_fp step
+  step "Initialise Flags"
+  testLoadFileCradleFail crd a_fp cradleFailPred step
+
+initialiseCradle :: (Cradle Void -> Bool) -> FilePath -> (String -> IO ()) -> IO (Cradle Void)
+initialiseCradle cradlePred a_fp step = do
   step $ "Finding Cradle for: " ++ a_fp
   mcfg <- findCradle a_fp
   step $ "Loading Cradle: " ++ show mcfg
   crd <- case mcfg of
           Just cfg -> loadCradle cfg
           Nothing -> loadImplicitCradle a_fp
   crd `shouldSatisfy` cradlePred
-  step "Initialise Flags"
-  testLoadFile crd a_fp step
+  pure crd
 
 testLoadFile :: Cradle a -> FilePath -> (String -> IO ()) -> IO ()
 testLoadFile crd fp step = do
@@ -111,16 +139,17 @@ testLoadFile crd fp step = do
         CradleNone -> liftIO $ expectationFailure "None"
         CradleFail (CradleError _deps _ex stde) -> liftIO $ expectationFailure (unlines stde)
 
-testLoadFileCradleFail :: Cradle a -> FilePath -> (CradleError -> Bool) -> (String -> IO ()) -> IO ()
-testLoadFileCradleFail crd fp cradleFailPred step = do
+testLoadFileCradleFail :: Cradle a -> FilePath -> (CradleError -> Expectation) -> (String -> IO ()) -> IO ()
+testLoadFileCradleFail crd fp cradleErrorExpectation step = do
   a_fp <- canonicalizePath fp
   withCurrentDirectory (cradleRootDir crd) $
     withGHC' $ do
       let relFp = makeRelative (cradleRootDir crd) a_fp
       res <- initializeFlagsWithCradleWithMessage (Just (\_ n _ _ -> step (show n))) relFp crd
       case res of
         CradleSuccess _ -> liftIO $ expectationFailure "Cradle loaded successfully"
-        CradleFail crdlFail -> liftIO $ crdlFail `shouldSatisfy` cradleFailPred
+        CradleNone -> liftIO $ expectationFailure "Unexpected none-Cradle"
+        CradleFail crdlFail -> liftIO $ cradleErrorExpectation crdlFail
 
 findCradleForModule :: FilePath -> Maybe FilePath -> (String -> IO ()) -> IO ()
 findCradleForModule fp expected' step = do
@@ -147,6 +176,7 @@ writeStackYamlFiles = do
 stackProjects :: [FilePath]
 stackProjects =
   [ "tests" </> "projects" </> "multi-stack"
+  , "tests" </> "projects" </> "failing-stack"
   , "tests" </> "projects" </> "simple-stack"
   , "tests" </> "projects" </> "space stack"
   , "tests" </> "projects" </> "implicit-stack"

tests/projects/failing-bios/A.hs

@@ -0,0 +1 @@
+module A where

tests/projects/failing-bios/B.hs

@@ -0,0 +1,3 @@
+module B where
+
+import A

tests/projects/failing-bios/hie.yaml

@@ -0,0 +1,5 @@
+cradle:
+  bios:
+    shell: "exit 1"
+dependencies:
+- hie.yaml

tests/projects/failing-cabal/MyLib.hs

@@ -0,0 +1,4 @@
+module MyLib (someFunc) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"

tests/projects/failing-cabal/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

tests/projects/failing-cabal/failing-cabal.cabal

@@ -0,0 +1,13 @@
+cabal-version:       >=1.10
+name:                failing-cabal
+version:             0.1.0.0
+license-file:        LICENSE
+author:              fendor
+build-type:          Simple
+
+library
+  exposed-modules:     MyLib
+  build-depends:       base >=4.13 && <4.14,
+                       containers < 1 && > 1
+                       --         ^^^^^^^^^^ <<< Invalid constraint
+  default-language:    Haskell2010

tests/projects/failing-cabal/hie.yaml

@@ -0,0 +1,2 @@
+cradle:
+  cabal:

tests/projects/failing-stack/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

tests/projects/failing-stack/failing-stack.cabal

@@ -0,0 +1,16 @@
+cabal-version: 1.12
+name:           failing-stack
+version:        0.1.0.0
+description:    None
+build-type:     Simple
+
+library
+  exposed-modules:
+      Lib
+  hs-source-dirs:
+      src
+  build-depends:
+      base >=4.7 && <5,
+      containes < 1 && > 1
+      --         ^^^^^^^^^^ <<< Invalid constraint
+  default-language: Haskell2010

tests/projects/failing-stack/hie.yaml

@@ -0,0 +1,2 @@
+cradle:
+  stack:

tests/projects/failing-stack/src/Lib.hs

@@ -0,0 +1,6 @@
+module Lib
+    ( someFunc
+    ) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"