Fix `findCabalFile`

Language/Haskell/GhcMod/Cradle.hs

@@ -32,7 +32,7 @@ cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl
 
 cabalCradle :: FilePath -> IO Cradle
 cabalCradle wdir = do
-    Just cabalFile <- findCabalFiles wdir
+    Just cabalFile <- findCabalFile wdir
     let cabalDir = takeDirectory cabalFile
     pkgDbStack <- getPackageDbStack cabalDir
     tmpDir <- newTempDir cabalDir

Language/Haskell/GhcMod/PathsAndFiles.hs

@@ -28,16 +28,19 @@ type FileName = String
 -- is assumed to be the project directory. If only one cabal file exists in this
 -- directory it is returned otherwise @findCabalFiles@ throws 'GMENoCabalFile'
 -- or 'GMETooManyCabalFiles'
-findCabalFiles :: FilePath -> IO (Maybe FilePath)
-findCabalFiles directory = do
+findCabalFile :: FilePath -> IO (Maybe FilePath)
+findCabalFile directory = do
     -- Look for cabal files in @dir@ and all it's parent directories
     dcs <- getCabalFiles `zipMapM` parents directory
     -- Extract first non-empty list, which represents a directory with cabal
     -- files.
-    case find (not . null) $ uncurry makeAbsolute `map` dcs of
+    case find (not . null) $ uncurry appendDir `map` dcs of
       Just []          -> throw $ GMENoCabalFile
       Just cfs@(_:_:_) -> throw $ GMETooManyCabalFiles cfs
       a  -> return $ head <$> a
+ where
+   appendDir :: DirPath -> [FileName] -> [FilePath]
+   appendDir dir fs = (dir </>) `map` fs
 
 -- | @getCabalFiles dir@. Find all files ending in @.cabal@ in @dir@.
 getCabalFiles :: DirPath -> IO [FileName]
@@ -45,17 +48,13 @@ getCabalFiles dir =
     filterM isCabalFile =<< getDirectoryContents dir
  where
    isCabalFile f = do
-     exists <- doesFileExist f
+     exists <- doesFileExist $ dir </> f
      return (exists && takeExtension' f == ".cabal")
 
    takeExtension' p = if takeFileName p == takeExtension p
                         then ""
                         else takeExtension p
 
-
-makeAbsolute :: DirPath -> [FileName] -> [FilePath]
-makeAbsolute dir fs = (dir </>) `map` fs
-
 zipMapM :: Monad m => (a -> m c) -> [a] -> m [(a,c)]
 zipMapM f as = mapM (\a -> liftM (a,) $ f a) as
 

test/CabalApiSpec.hs

@@ -3,7 +3,6 @@
 module CabalApiSpec where
 
 import Control.Applicative
-import Data.Maybe
 import Language.Haskell.GhcMod.CabalApi
 import Language.Haskell.GhcMod.Cradle
 import Language.Haskell.GhcMod.Types
@@ -35,7 +34,7 @@ spec = do
             cwd <- getCurrentDirectory
             withDirectory "test/data/subdir1/subdir2" $ \dir -> do
                 crdl <- findCradle
-                let cabalFile = cradleCabalFile crdl
+                let Just cabalFile = cradleCabalFile crdl
                 pkgDesc <- runD $ parseCabalFile crdl cabalFile
                 res <- runD $ getCompilerOptions [] crdl pkgDesc
                 let res' = res {

test/PathsAndFilesSpec.hs

@@ -33,3 +33,10 @@ spec = do
     describe "getCabalFiles" $ do
         it "doesn't think $HOME/.cabal is a cabal file" $ do
             (getCabalFiles =<< getEnv "HOME") `shouldReturn` []
+
+    describe "findCabalFile" $ do
+        it "works" $ do
+            findCabalFile "test/data" `shouldReturn` Just "test/data/cabalapi.cabal"
+
+        it "finds cabal files in parent directories" $ do
+            findCabalFile "test/data/subdir1/subdir2" `shouldReturn` Just "test/data/cabalapi.cabal"