Fix multi source directories (#1577)

* Add failing test-cases for #1576

* Handle multiple source directories correctly

Change existing behaviour to find all source directories
which are a prefix of the given filepath.

* Relax base constraints on c-h testdata

There was probably no reason to have the constraints in the first
pace

* Lower cabal constraint for testdata

* Avoid load checks as long as AZURE CI chokes on it

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

hie-plugin-api/Haskell/Ide/Engine/Cradle.hs

@@ -684,11 +684,8 @@ partOfComponent ::
   -- | Component to check whether the given FilePath is part of it.
   ChComponentInfo ->
   Bool
-partOfComponent fp' comp
-  | inTargets (ciSourceDirs comp) fp' (getTargets comp fp')
-  = True
-  | otherwise
-  = False
+partOfComponent fp' comp =
+  inTargets (ciSourceDirs comp) fp' (getTargets comp fp')
   where
     -- Check if the FilePath is in an executable or setup's main-is field
     inMainIs :: FilePath -> Bool
@@ -698,11 +695,15 @@ partOfComponent fp' comp
       | otherwise = False
 
     inTargets :: [FilePath] -> FilePath -> [String] -> Bool
-    inTargets sourceDirs fp targets
-      | Just relative <- relativeTo fp sourceDirs
-      = any (`elem` targets) [getModuleName relative, fp] || inMainIs relative
-      | otherwise
-      = False
+    inTargets sourceDirs fp targets =
+      let candidates = relativeTo fp sourceDirs
+      in any (existsInTargets targets fp) candidates
+
+    existsInTargets :: [String] -> FilePath -> FilePath -> Bool
+    existsInTargets targets absFp relFp = or
+        [ any (`elem` targets) [getModuleName relFp, absFp]
+        , inMainIs relFp
+        ]
 
     getModuleName :: FilePath -> String
     getModuleName fp = map
@@ -846,24 +847,23 @@ ancestors dir
     subdir = takeDirectory dir
 
 -- | Assuming a FilePath @"src\/Lib\/Lib.hs"@ and a list of directories
--- such as @["src", "app"]@, returns either the given FilePath
+-- such as @["src", "app"]@, returns the given FilePath
 -- with a matching directory stripped away.
 -- If there are multiple matches, e.g. multiple directories are a prefix
--- of the given FilePath, return the first match in the list.
--- Returns Nothing, if not a single
--- given directory is a prefix of the FilePath.
+-- of the given FilePath we return all matches.
+-- Returns an empty list if no prefix matches the given FilePath.
 --
 -- >>> relativeTo "src/Lib/Lib.hs" ["src"]
--- Just "Lib/Lib.hs"
+-- ["Lib/Lib.hs"]
 --
 -- >>> relativeTo "src/Lib/Lib.hs" ["app"]
--- Nothing
+-- []
 --
 -- >>> relativeTo "src/Lib/Lib.hs" ["src", "src/Lib"]
--- Just "Lib/Lib.hs"
-relativeTo :: FilePath -> [FilePath] -> Maybe FilePath
-relativeTo file sourceDirs = listToMaybe
-  $ mapMaybe (`stripFilePath` file) sourceDirs
+-- ["Lib/Lib.hs", "Lib.hs"]
+relativeTo :: FilePath -> [FilePath] -> [FilePath]
+relativeTo file sourceDirs =
+  mapMaybe (`stripFilePath` file) sourceDirs
 
 -- | Returns a user facing display name for the cradle type,
 -- e.g. "Stack project" or "GHC session"

test/testdata/cabal-helper/implicit-exe/implicit-exe.cabal

@@ -7,11 +7,11 @@ build-type:          Simple
 library
   exposed-modules:     Lib
   hs-source-dirs:      src
-  build-depends:       base >=4.8 && <4.14
+  build-depends:       base
   default-language:    Haskell2010
 
 
 executable implicit-exe
   main-is:             src/Exe.hs
-  build-depends:       base >=4.8 && <4.14, implicit-exe
+  build-depends:       base, implicit-exe
   default-language:    Haskell2010

test/testdata/cabal-helper/mono-repo/A/A.cabal

@@ -1,15 +1,15 @@
-cabal-version:       >=2.0
+cabal-version:       >=1.10
 name:                A
 version:             0.1.0.0
 build-type:          Simple
 
 library
   exposed-modules:     MyLib
-  build-depends:       base >=4.9 && < 5
+  build-depends:       base
   default-language:    Haskell2010
 
 executable A
   main-is:             Main.hs
   other-modules:       MyLib
-  build-depends:       base >= 4.9 && < 5, A
+  build-depends:       base, A
   default-language:    Haskell2010

test/testdata/cabal-helper/mono-repo/B/B.cabal

@@ -1,15 +1,15 @@
-cabal-version:       >=2.0
+cabal-version:       >=1.10
 name:                B
 version:             0.1.0.0
 build-type:          Simple
 
 library
   exposed-modules:     MyLib
-  build-depends:       base >= 4.9 && < 5
+  build-depends:       base
   default-language:    Haskell2010
 
 executable B
   main-is:             Main.hs
   other-modules:       MyLib
-  build-depends:       base >= 4.9 && < 5, B
+  build-depends:       base, B
   default-language:    Haskell2010

test/testdata/cabal-helper/mono-repo/C/C.cabal

@@ -1,9 +1,9 @@
-cabal-version:       >=2.0
+cabal-version:       >=1.10
 name:                C
 version:             0.1.0.0
 build-type:          Simple
 
 library
   exposed-modules:     MyLib
-  build-depends:       base>= 4.9 && < 5
+  build-depends:       base
   default-language:    Haskell2010

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
+  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/testdata/cabal-helper/simple-cabal/simple-cabal-test.cabal

@@ -6,5 +6,5 @@ build-type:          Simple
 
 library
   exposed-modules:     MyLib
-  build-depends:       base >=4.12 && <4.13
+  build-depends:       base
   default-language:    Haskell2010

test/testdata/cabal-helper/simple-stack/simple-stack-test.cabal

@@ -6,5 +6,5 @@ build-type:          Simple
 
 library
   exposed-modules:     MyLib
-  build-depends:       base >=4.12 && <4.13
+  build-depends:       base
   default-language:    Haskell2010

test/testdata/cabal-helper/sub-package/plugins-api/plugins-api.cabal

@@ -6,5 +6,5 @@ build-type:          Simple
 
 library
   exposed-modules:     PluginLib
-  build-depends:       base >=4.12 && <4.13
+  build-depends:       base
   default-language:    Haskell2010

test/testdata/cabal-helper/sub-package/sub-package.cabal

@@ -6,12 +6,12 @@ build-type:          Simple
 
 library
   exposed-modules:     MyLib
-  build-depends:       base >=4.12 && <4.13, plugins-api
+  build-depends:       base, plugins-api
   hs-source-dirs:      src
   default-language:    Haskell2010
 
 executable sub-package
   main-is:             Main.hs
-  build-depends:       base >=4.12 && <4.13, sub-package
+  build-depends:       base, sub-package
   hs-source-dirs:      app
   default-language:    Haskell2010

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,125 @@ 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
-      crdl <- cabalHelperCradle (simpleStackPath cwd </> "File.hs")
-      crdl `shouldSatisfy` isStackCradle
-    it "cabal repo, dummy filepath" $
-      pendingWith "Can not work because of global `cabal.project`"
-      -- crdl <- cabalHelperCradle (simpleCabalPath cwd </> "File.hs")
-      -- crdl `shouldSatisfy` isCabalCradle
-    it "sub package, dummy filepath" $ do
-      crdl <- cabalHelperCradle (subPackagePath cwd </> "File.hs")
-      crdl `shouldSatisfy` isStackCradle
-
-  describe "Existing projects" $ do
-    it "implicit exe" $ do
-      crdl <- cabalHelperCradle (implicitExePath cwd </> "src" </> "Exe.hs")
-      crdl `shouldSatisfy` isCabalCradle
-    it "mono repo" $ do
-      crdl <- cabalHelperCradle (monoRepoPath cwd </> "A" </> "Main.hs")
-      crdl `shouldSatisfy` isCabalCradle
     it "stack repo" $ do
-      crdl <- cabalHelperCradle (simpleStackPath cwd </> "MyLib.hs")
+      crdl <- cabalHelperCradle (simpleStackPath cwd </> "File.hs")
       crdl `shouldSatisfy` isStackCradle
     it "cabal repo" $
       pendingWith "Can not work because of global `cabal.project`"
-      -- crdl <- cabalHelperCradle (simpleCabalPath cwd </> "MyLib.hs")
+      -- crdl <- cabalHelperCradle (simpleCabalPath cwd </> "File.hs")
       -- crdl `shouldSatisfy` isCabalCradle
     it "sub package" $ do
-      crdl <- cabalHelperCradle (subPackagePath cwd </> "plugins-api" </> "PluginLib.hs")
+      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
+    it "implicit exe" $ do
+      let fp = implicitExePath cwd </> "src" </> "Exe.hs"
+      componentTest fp isCabalCradle
+    it "mono repo" $ do
+      let fp = monoRepoPath cwd </> "A" </> "Main.hs"
+      componentTest fp isCabalCradle
+    it "stack repo" $ do
+      let fp = simpleStackPath cwd </> "MyLib.hs"
+      componentTest fp isStackCradle
+    it "cabal repo" $
+      pendingWith "Can not work because of global `cabal.project`"
+      -- let fp = (simpleCabalPath cwd </> "MyLib.hs")
+      -- componentTest fp isStackCradle
+    it "sub package" $ do
+      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
+  -- TODO: this works but CI crashes
+  -- 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 +182,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")
 
 -- -------------------------------------------------------------