diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index b5606b4..94ee836 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/PathsAndFiles.hs b/Language/Haskell/GhcMod/PathsAndFiles.hs index ccd0acf..064d39e 100644 --- a/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/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 diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index a23c5f6..67aa9f4 100644 --- a/test/CabalApiSpec.hs +++ b/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 { diff --git a/test/PathsAndFilesSpec.hs b/test/PathsAndFilesSpec.hs index aa2a253..c1b5143 100644 --- a/test/PathsAndFilesSpec.hs +++ b/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"