Add failing test-cases for #1576

Author: fendor

haskell-ide-engine.cabal

@@ -220,6 +220,7 @@ test-suite unit-test
                      , ghc
                      , haskell-ide-engine
                      , haskell-lsp-types == 0.19.*
+                     , hie-bios
                      , hie-test-utils
                      , hie-plugin-api
                      , hoogle > 5.0.11

test/testdata/cabal-helper/multi-source-dirs/Setup.hs

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

test/testdata/cabal-helper/multi-source-dirs/multi-source-dirs.cabal

@@ -0,0 +1,11 @@
+cabal-version:       >=1.10
+name:                multi-source-dirs
+version:             0.1.0.0
+license-file:        LICENSE
+build-type:          Simple
+
+library
+  exposed-modules:     Lib, BetterLib
+  hs-source-dirs:      src, src/input
+  build-depends:       base >=4.12 && <5
+  default-language:    Haskell2010

test/testdata/cabal-helper/multi-source-dirs/src/BetterLib.hs

@@ -0,0 +1,5 @@
+module BetterLib where
+
+
+foo = 3
+bar = "String"

test/testdata/cabal-helper/multi-source-dirs/src/input/Lib.hs

@@ -0,0 +1,6 @@
+module Lib where
+
+foobar = 15
+
+fizbuzz :: Int -> String
+fizbuzz n = "Fizz"

test/unit/CabalHelperSpec.hs

@@ -3,6 +3,7 @@ module CabalHelperSpec where
 
 import Data.Maybe (isJust)
 import Haskell.Ide.Engine.Cradle
+import HIE.Bios.Types (runCradle, cradleOptsProg, Cradle, CradleLoadResult(..))
 import Test.Hspec
 import System.FilePath
 import System.Directory (findExecutable, getCurrentDirectory, removeFile)
@@ -26,6 +27,9 @@ simpleCabalPath cwd = rootPath cwd </> "simple-cabal"
 simpleStackPath :: FilePath -> FilePath
 simpleStackPath cwd = rootPath cwd </> "simple-stack"
 
+multiSourceDirsPath :: FilePath -> FilePath
+multiSourceDirsPath cwd = rootPath cwd </> "multi-source-dirs"
+
 spec :: Spec
 spec = beforeAll_ setupStackFiles $ do
   describe "stack and cabal executables should be accesible" $ do
@@ -36,88 +40,124 @@ spec = beforeAll_ setupStackFiles $ do
       cabal <- findExecutable "stack"
       cabal `shouldSatisfy` isJust
   describe "cabal-helper spec" $ do
-    describe "find cabal entry point spec" findCabalHelperEntryPointSpec
-    describe "cradle discovery" cabalHelperCradleSpec
+    describe "find entry point" findCabalHelperEntryPointSpec
+    describe "cradle discovery and loading" cabalHelperCradleSpec
 
 cabalHelperCradleSpec :: Spec
 cabalHelperCradleSpec = do
   cwd <- runIO getCurrentDirectory
   describe "dummy filepath, finds none-cradle" $ do
-    it "implicit exe, dummy filepath" $ do
+    it "implicit exe" $ do
       crdl <- cabalHelperCradle (implicitExePath cwd </> "File.hs")
       crdl `shouldSatisfy` isCabalCradle
-    it "mono repo, dummy filepath" $ do
+    it "mono repo" $ do
       crdl <- cabalHelperCradle (monoRepoPath cwd </> "File.hs")
       crdl `shouldSatisfy` isCabalCradle
-    it "stack repo, dummy filepath" $ do
+    it "stack repo" $ do
       crdl <- cabalHelperCradle (simpleStackPath cwd </> "File.hs")
       crdl `shouldSatisfy` isStackCradle
-    it "cabal repo, dummy filepath" $
+    it "cabal repo" $
       pendingWith "Can not work because of global `cabal.project`"
       -- crdl <- cabalHelperCradle (simpleCabalPath cwd </> "File.hs")
       -- crdl `shouldSatisfy` isCabalCradle
-    it "sub package, dummy filepath" $ do
+    it "sub package" $ do
       crdl <- cabalHelperCradle (subPackagePath cwd </> "File.hs")
       crdl `shouldSatisfy` isStackCradle
+    it "multi-source-dirs" $ do
+      crdl <- cabalHelperCradle (multiSourceDirsPath cwd </> "File.hs")
+      crdl `shouldSatisfy` isStackCradle
 
-  describe "Existing projects" $ do
+  describe "existing projects" $ do
     it "implicit exe" $ do
-      crdl <- cabalHelperCradle (implicitExePath cwd </> "src" </> "Exe.hs")
-      crdl `shouldSatisfy` isCabalCradle
+      let fp = implicitExePath cwd </> "src" </> "Exe.hs"
+      componentTest fp isCabalCradle
     it "mono repo" $ do
-      crdl <- cabalHelperCradle (monoRepoPath cwd </> "A" </> "Main.hs")
-      crdl `shouldSatisfy` isCabalCradle
+      let fp = monoRepoPath cwd </> "A" </> "Main.hs"
+      componentTest fp isCabalCradle
     it "stack repo" $ do
-      crdl <- cabalHelperCradle (simpleStackPath cwd </> "MyLib.hs")
-      crdl `shouldSatisfy` isStackCradle
+      let fp = simpleStackPath cwd </> "MyLib.hs"
+      componentTest fp isStackCradle
     it "cabal repo" $
       pendingWith "Can not work because of global `cabal.project`"
-      -- crdl <- cabalHelperCradle (simpleCabalPath cwd </> "MyLib.hs")
-      -- crdl `shouldSatisfy` isCabalCradle
+      -- let fp = (simpleCabalPath cwd </> "MyLib.hs")
+      -- componentTest fp isStackCradle
     it "sub package" $ do
-      crdl <- cabalHelperCradle (subPackagePath cwd </> "plugins-api" </> "PluginLib.hs")
-      crdl `shouldSatisfy` isStackCradle
+      let fp = subPackagePath cwd </> "plugins-api" </> "PluginLib.hs"
+      componentTest fp isStackCradle
+    it "multi-source-dirs, nested dir" $ do
+      let fp = multiSourceDirsPath cwd </> "src" </> "input" </> "Lib.hs"
+      componentTest fp isStackCradle
+    it "multi-source-dirs" $ do
+      let fp = multiSourceDirsPath cwd </> "src" </> "BetterLib.hs"
+      componentTest fp isStackCradle
+
+componentTest :: FilePath -> (Cradle -> Bool) -> Expectation
+componentTest fp testCradleType = do
+  crdl <- cabalHelperCradle  fp
+  crdl `shouldSatisfy` testCradleType
+  loadComponent crdl fp
+
+loadComponent :: Cradle -> FilePath -> Expectation
+loadComponent crdl fp = do
+  result <- runCradle (cradleOptsProg crdl) (\_ -> return ()) fp
+  case result of
+    CradleFail err -> expectationFailure $ "Loading should not have failed: " ++ show err
+    _ -> return ()
+  return ()
 
 findCabalHelperEntryPointSpec :: Spec
 findCabalHelperEntryPointSpec = do
     cwd <- runIO getCurrentDirectory
     describe "implicit exe" $ do
-      it "Find project root with dummy filepath" $ do
+      it "dummy filepath" $ do
         let dummyFile = implicitExePath cwd </> "File.hs"
         cabalTest dummyFile
-      it "Find project root from source component" $ do
+      it "source component" $ do
         let libFile = implicitExePath cwd </> "src" </> "Lib.hs"
         cabalTest libFile
-      it "Find project root from executable component" $ do
+      it "executable component" $ do
         let mainFile = implicitExePath cwd </> "src" </> "Exe.hs"
         cabalTest mainFile
 
     describe "mono repo" $ do
-      it "Find project root with dummy filepath" $ do
+      it "dummy filepath" $ do
         let dummyFile = monoRepoPath cwd </> "File.hs"
         cabalTest dummyFile
-      it "Find project root with existing executable" $ do
+      it "existing executable" $ do
         let mainFile = monoRepoPath cwd </> "A" </> "Main.hs"
         cabalTest mainFile
 
     describe "sub package repo" $ do
-      it "Find project root with dummy filepath" $ do
+      it "dummy filepath" $ do
         let dummyFile = subPackagePath cwd </> "File.hs"
         stackTest dummyFile
-      it "Find project root with existing executable" $ do
+      it "existing executable" $ do
         let mainFile = subPackagePath cwd </> "plugins-api" </> "PluginLib.hs"
         stackTest mainFile
 
     describe "stack repo" $ do
-      it "Find project root with dummy filepath" $ do
+      it "dummy filepath" $ do
         let dummyFile = simpleStackPath cwd </> "File.hs"
         stackTest dummyFile
-      it "Find project root with real filepath" $ do
+      it "real filepath" $ do
         let dummyFile = simpleStackPath cwd </> "MyLib.hs"
         stackTest dummyFile
 
+    describe "multi-source-dirs" $ do
+      it "dummy filepath" $ do
+        let dummyFile = multiSourceDirsPath cwd </> "File.hs"
+        stackTest dummyFile
+
+      it "real filepath" $ do
+        let dummyFile = multiSourceDirsPath cwd </> "src" </> "BetterLib.hs"
+        stackTest dummyFile
+
+      it "nested filpath" $ do
+        let dummyFile = multiSourceDirsPath cwd </> "src" </> "input" </> "Lib.hs"
+        stackTest dummyFile
+
     describe "simple cabal repo" $
-      it "Find porject root with dummy filepath" $
+      it "Find project root with dummy filepath" $
         pendingWith "Change test-setup, we will always find `cabal.project` in root dir"
 
 -- -------------------------------------------------------------
@@ -141,20 +181,23 @@ stackTest fp = do
 setupStackFiles :: IO ()
 setupStackFiles = do
   resolver <- readResolver
-  cwd <- getCurrentDirectory
+  cwd      <- getCurrentDirectory
   writeFile (implicitExePath cwd </> "stack.yaml") (standardStackYaml resolver)
-  writeFile (monoRepoPath cwd    </> "stack.yaml") (monoRepoStackYaml resolver)
-  writeFile (subPackagePath cwd  </> "stack.yaml") (subPackageStackYaml resolver)
+  writeFile (monoRepoPath cwd </> "stack.yaml")    (monoRepoStackYaml resolver)
+  writeFile (subPackagePath cwd </> "stack.yaml") (subPackageStackYaml resolver)
   writeFile (simpleStackPath cwd </> "stack.yaml") (standardStackYaml resolver)
+  writeFile (multiSourceDirsPath cwd </> "stack.yaml")
+            (standardStackYaml resolver)
 
 
 cleanupStackFiles :: IO ()
 cleanupStackFiles = do
-  cwd  <- getCurrentDirectory
+  cwd <- getCurrentDirectory
   removeFile (implicitExePath cwd </> "stack.yaml")
-  removeFile (monoRepoPath cwd    </> "stack.yaml")
-  removeFile (subPackagePath cwd  </> "stack.yaml")
+  removeFile (monoRepoPath cwd </> "stack.yaml")
+  removeFile (subPackagePath cwd </> "stack.yaml")
   removeFile (simpleStackPath cwd </> "stack.yaml")
+  removeFile (multiSourceDirsPath cwd </> "stack.yaml")
 
 -- -------------------------------------------------------------