Merge pull request #415 from fendor/enhance/find-cradle-dir

Accept directories in 'findCradle'

Author: michaelpj

src/HIE/Bios/Cradle.hs

@@ -77,10 +77,17 @@ import Text.ParserCombinators.ReadP (readP_to_S)
 
 ----------------------------------------------------------------
 
--- | Given root\/foo\/bar.hs, return root\/hie.yaml, or wherever the yaml file was found.
+-- | Given @root\/foo\/bar.hs@, return @root\/hie.yaml@, or wherever the yaml file was found.
+--
+-- Note, 'findCradle' used to **not** work for directories and required a Haskell file.
+-- This has been fixed since @0.14.0@.
+-- However, 'loadCradle' and 'loadImplicitCradle' still require a Haskell
+-- source file and won't work properly with a directory parameter.
 findCradle :: FilePath -> IO (Maybe FilePath)
 findCradle wfile = do
-    let wdir = takeDirectory wfile
+    wdir <- doesDirectoryExist wfile >>= \case
+      True ->  pure wfile
+      False -> pure (takeDirectory wfile)
     runMaybeT (yamlConfig wdir)
 
 -- | Given root\/hie.yaml load the Cradle.

tests/BiosTests.hs

@@ -19,7 +19,7 @@ import Control.Monad ( forM_ )
 import Data.List ( sort, isPrefixOf )
 import Data.Typeable
 import System.Directory
-import System.FilePath ((</>) )
+import System.FilePath ((</>))
 import System.Exit (ExitCode(ExitSuccess, ExitFailure))
 import Control.Monad.Extra (unlessM)
 import qualified HIE.Bios.Ghc.Gap as Gap
@@ -48,17 +48,7 @@ main = do
 
   defaultMainWithIngredients (ignoreToolTests:defaultIngredients) $
     testGroup "Bios-tests"
-      [ testGroup "Find cradle"
-        [ testCaseSteps "simple-cabal" $
-            runTestEnvLocal "./simple-cabal" $ do
-              findCradleForModuleM "B.hs" (Just "hie.yaml")
-
-        -- Checks if we can find a hie.yaml even when the given filepath
-        -- is unknown. This functionality is required by Haskell IDE Engine.
-        , testCaseSteps "simple-cabal-unknown-path" $
-            runTestEnvLocal "./simple-cabal" $ do
-              findCradleForModuleM "Foo.hs" (Just "hie.yaml")
-        ]
+      [ testGroup "Find cradle" findCradleTests
       , testGroup "Symlink" symbolicLinkTests
       , testGroup "Loading tests"
         [ testGroup "bios" biosTestCases
@@ -301,6 +291,26 @@ directTestCases =
       testDirectoryM isMultiCradle "B.hs"
   ]
 
+findCradleTests :: [TestTree]
+findCradleTests =
+  [ cradleFileTest "Simple Existing File" "./simple-cabal"  "B.hs" (Just "hie.yaml")
+  -- Checks if we can find a hie.yaml even when the given filepath
+  -- is unknown. This functionality is required by Haskell IDE Engine.
+  , cradleFileTest "Existing File" "cabal-with-ghc" "src/MyLib.hs" (Just "hie.yaml")
+  , cradleFileTest "Non-existing file" "cabal-with-ghc" "src/MyLib2.hs" (Just "hie.yaml")
+  , cradleFileTest "Non-existing file 2" "cabal-with-ghc" "MyLib2.hs" (Just "hie.yaml")
+  , cradleFileTest "Directory 1" "cabal-with-ghc" "src/" (Just "hie.yaml")
+  , cradleFileTest "Directory 2" "simple-cabal" "" (Just "hie.yaml")
+  -- Unknown directory in a project, ought to work as well.
+  , cradleFileTest "Directory 3" "simple-cabal" "src/" (Just "hie.yaml")
+  , cradleFileTest "Directory does not exist" "doesnotexist" "A.hs" Nothing
+  ]
+  where
+    cradleFileTest :: String -> FilePath -> FilePath -> Maybe FilePath -> TestTree
+    cradleFileTest testName dir fpTarget result = testCaseSteps testName $ do
+      runTestEnv dir $ do
+        findCradleForModuleM fpTarget result
+
 -- ------------------------------------------------------------------
 -- Unit-test Helper functions
 -- ------------------------------------------------------------------

tests/Utils.hs

@@ -427,7 +427,9 @@ findCradleForModuleM fp expected' = do
 withTempCopy :: FilePath -> (FilePath -> IO a) -> IO a
 withTempCopy srcDir f =
   withSystemTempDirectory "hie-bios-test" $ \newDir -> do
-    copyDir srcDir newDir
+    exists <- doesDirectoryExist srcDir
+    when exists $ do
+      copyDir srcDir newDir
     f newDir
 
 copyDir :: FilePath -> FilePath -> IO ()