Fix findCabalFile

This commit is contained in:
Daniel Gröber 2014-11-03 00:45:27 +01:00
parent 506cf18885
commit 9a8a3651d0
4 changed files with 16 additions and 11 deletions

View File

@ -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

View File

@ -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

View File

@ -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 {

View File

@ -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"