From 2c2e7782d297f7e33697a5b15ecb0e626d168f3f Mon Sep 17 00:00:00 2001 From: Rob Everest Date: Wed, 10 Sep 2014 22:23:36 +1000 Subject: [PATCH] Use the cabal configuration flags where possible when finalizing the PackageDescription. --- Language/Haskell/GhcMod/CabalApi.hs | 16 ++++++++------- Language/Haskell/GhcMod/CabalConfig.hs | 16 +++++++++++++++ Language/Haskell/GhcMod/Debug.hs | 2 +- Language/Haskell/GhcMod/Error.hs | 2 ++ Language/Haskell/GhcMod/Monad.hs | 2 +- ghc-mod.cabal | 1 + src/GHCMod.hs | 2 ++ test/CabalApiSpec.hs | 27 ++++++++++++++++++------- test/data/cabal-flags/cabal-flags.cabal | 14 +++++++++++++ 9 files changed, 66 insertions(+), 16 deletions(-) create mode 100644 test/data/cabal-flags/cabal-flags.cabal diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index 7ac7a46..3fd8576 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -17,7 +17,7 @@ import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets, import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Types -import MonadUtils (MonadIO, liftIO) +import MonadUtils (liftIO) import Control.Applicative ((<$>)) import qualified Control.Exception as E import Control.Monad (filterM) @@ -73,20 +73,22 @@ includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir]) ---------------------------------------------------------------- -- | Parse a cabal file and return a 'PackageDescription'. -parseCabalFile :: (MonadIO m, Error e, MonadError e m) - => FilePath +parseCabalFile :: (IOish m, MonadError GhcModError m) + => Cradle + -> FilePath -> m PackageDescription -parseCabalFile file = do +parseCabalFile cradle file = do cid <- liftIO getGHCId epgd <- liftIO $ readPackageDescription silent file - case toPkgDesc cid epgd of + flags <- cabalConfigFlags cradle + case toPkgDesc cid flags epgd of Left deps -> fail $ show deps ++ " are not installed" Right (pd,_) -> if nullPkg pd then fail $ file ++ " is broken" else return pd where - toPkgDesc cid = - finalizePackageDescription [] (const True) buildPlatform cid [] + toPkgDesc cid flags = + finalizePackageDescription flags (const True) buildPlatform cid [] nullPkg pd = name == "" where PackageName name = C.pkgName (P.package pd) diff --git a/Language/Haskell/GhcMod/CabalConfig.hs b/Language/Haskell/GhcMod/CabalConfig.hs index 2adcd4a..2ca473f 100644 --- a/Language/Haskell/GhcMod/CabalConfig.hs +++ b/Language/Haskell/GhcMod/CabalConfig.hs @@ -5,6 +5,7 @@ module Language.Haskell.GhcMod.CabalConfig ( CabalConfig , cabalConfigDependencies + , cabalConfigFlags ) where import Language.Haskell.GhcMod.Error @@ -32,6 +33,7 @@ import Data.Set () import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix) import Distribution.Package (InstalledPackageId(..) , PackageIdentifier) +import Distribution.PackageDescription (FlagAssignment) import Distribution.Simple.BuildPaths (defaultDistPref) import Distribution.Simple.Configure (localBuildInfoFile) import Distribution.Simple.LocalBuildInfo (ComponentName) @@ -130,6 +132,20 @@ configDependencies thisPkg config = map fromInstalledPackageId deps Right x -> x Left msg -> error $ "reading config " ++ f ++ " failed ("++msg++")" +-- | Get the flag assignment from the local build info of the given cradle +cabalConfigFlags :: (IOish m, MonadError GhcModError m) + => Cradle + -> m FlagAssignment +cabalConfigFlags cradle = do + config <- getConfig cradle + case configFlags config of + Right x -> return x + Left msg -> throwError (GMECabalFlags (GMEString msg)) + +-- | Extract the cabal flags from the 'CabalConfig' +configFlags :: CabalConfig -> Either String FlagAssignment +configFlags config = readEither =<< flip extractField "configConfigurationsFlags" =<< extractField config "configFlags" + -- | Find @field@ in 'CabalConfig'. Returns 'Left' containing a user readable -- error message with lots of context on failure. extractField :: CabalConfig -> String -> Either String String diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index c429bf2..f1382ce 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -31,7 +31,7 @@ debugInfo = cradle >>= \c -> convert' =<< do simpleCompilerOption = options >>= \op -> return $ CompilerOptions (ghcUserOptions op) [] [] fromCabalFile c = options >>= \opts -> do - pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile c + pkgDesc <- parseCabalFile c $ fromJust $ cradleCabalFile c getCompilerOptions (ghcUserOptions opts) c pkgDesc ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Error.hs b/Language/Haskell/GhcMod/Error.hs index 760f8b9..55a666d 100644 --- a/Language/Haskell/GhcMod/Error.hs +++ b/Language/Haskell/GhcMod/Error.hs @@ -18,6 +18,8 @@ data GhcModError = GMENoMsg -- 'fail' calls on GhcModT. | GMECabalConfigure GhcModError -- ^ Configuring a cabal project failed. + | GMECabalFlags GhcModError + -- ^ Retrieval of the cabal configuration flags failed. | GMEProcess [String] GhcModError -- ^ Launching an operating system process failed. The first -- field is the command. diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 18ba9d6..b9b8fe4 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -204,7 +204,7 @@ initializeFlagsWithCradle opt c cabal = isJust mCradleFile ghcopts = ghcUserOptions opt withCabal = do - pkgDesc <- parseCabalFile $ fromJust mCradleFile + pkgDesc <- parseCabalFile c $ fromJust mCradleFile compOpts <- getCompilerOptions ghcopts c pkgDesc initSession CabalPkg opt compOpts withSandbox = initSession SingleFile opt compOpts diff --git a/ghc-mod.cabal b/ghc-mod.cabal index c01e19d..94dbc8f 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -34,6 +34,7 @@ Extra-Source-Files: ChangeLog test/data/broken-cabal/cabal.sandbox.config.in test/data/broken-sandbox/*.cabal test/data/broken-sandbox/cabal.sandbox.config + test/data/cabal-flags/*.cabal test/data/check-test-subdir/*.cabal test/data/check-test-subdir/src/Check/Test/*.hs test/data/check-test-subdir/test/*.hs diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 36ce1cc..2707573 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -149,6 +149,8 @@ main = flip E.catches handlers $ do hPutStrLn stderr msg Left (GMECabalConfigure msg) -> hPutStrLn stderr $ "cabal configure failed: " ++ show msg + Left (GMECabalFlags msg) -> + hPutStrLn stderr $ "retrieval of the cabal configuration flags failed: " ++ show msg Left (GMEProcess cmd msg) -> hPutStrLn stderr $ "launching operating system process `"++c++"` failed: " ++ show msg diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index 855e4df..7f8e24f 100644 --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -10,6 +10,7 @@ import Language.Haskell.GhcMod.Types import Test.Hspec import System.Directory import System.FilePath +import System.Process (readProcess) import Dir import TestUtils @@ -23,8 +24,10 @@ spec :: Spec spec = do describe "parseCabalFile" $ do it "throws an exception if the cabal file is broken" $ do - shouldReturnError $ - runD' $ parseCabalFile "test/data/broken-cabal/broken.cabal" + shouldReturnError $ do + withDirectory_ "test/data/broken-cabal" $ do + crdl <- findCradle + runD' $ parseCabalFile crdl "broken.cabal" describe "getCompilerOptions" $ do @@ -32,7 +35,7 @@ spec = do cwd <- getCurrentDirectory withDirectory "test/data/subdir1/subdir2" $ \dir -> do crdl <- findCradle - pkgDesc <- runD $ parseCabalFile $ fromJust $ cradleCabalFile crdl + pkgDesc <- runD $ parseCabalFile crdl $ fromJust $ cradleCabalFile crdl res <- runD $ getCompilerOptions [] crdl pkgDesc let res' = res { ghcOptions = ghcOptions res @@ -47,18 +50,28 @@ spec = do describe "cabalDependPackages" $ do it "extracts dependent packages" $ do - pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal") + crdl <- findCradle' "test/data/" + pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/cabalapi.cabal") pkgs `shouldBe` ["Cabal","base","template-haskell"] + it "uses non default flags" $ do + withDirectory_ "test/data/cabal-flags" $ do + crdl <- findCradle + _ <- readProcess "cabal" ["configure", "-ftest-flag"] "" + pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile crdl "cabal-flags.cabal") + pkgs `shouldBe` ["Cabal","base"] describe "cabalSourceDirs" $ do it "extracts all hs-source-dirs" $ do - dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal") + crdl <- findCradle' "test/data/check-test-subdir" + dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/check-test-subdir/check-test-subdir.cabal") dirs `shouldBe` ["src", "test"] it "extracts all hs-source-dirs including \".\"" $ do - dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal") + crdl <- findCradle' "test/data/" + dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/cabalapi.cabal") dirs `shouldBe` [".", "test"] describe "cabalAllBuildInfo" $ do it "extracts build info" $ do - info <- cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal") + crdl <- findCradle' "test/data/" + info <- cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/cabalapi.cabal") show info `shouldBe` "[BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\".\"], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]" diff --git a/test/data/cabal-flags/cabal-flags.cabal b/test/data/cabal-flags/cabal-flags.cabal new file mode 100644 index 0000000..d133d5b --- /dev/null +++ b/test/data/cabal-flags/cabal-flags.cabal @@ -0,0 +1,14 @@ +name: cabal-flags +version: 0.1.0 +build-type: Simple +cabal-version: >= 1.8 + +flag test-flag + default: False + +library + build-depends: base == 4.* + + if flag(test-flag) + build-depends: Cabal >= 1.10 +