From b8f9498f839c318ae94ceb11988c47e057f42d52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 9 May 2014 20:35:13 +0200 Subject: [PATCH 1/6] Fix reading of older Cabal `setup-config`s --- Language/Haskell/GhcMod/Cabal16.hs | 13 +++ Language/Haskell/GhcMod/Cabal18.hs | 7 ++ Language/Haskell/GhcMod/CabalApi.hs | 93 +------------------ Language/Haskell/GhcMod/CabalConfig.hs | 118 +++++++++++++++++++++++++ ghc-mod.cabal | 3 + test/CabalApiSpec.hs | 7 -- 6 files changed, 145 insertions(+), 96 deletions(-) create mode 100644 Language/Haskell/GhcMod/Cabal16.hs create mode 100644 Language/Haskell/GhcMod/Cabal18.hs create mode 100644 Language/Haskell/GhcMod/CabalConfig.hs diff --git a/Language/Haskell/GhcMod/Cabal16.hs b/Language/Haskell/GhcMod/Cabal16.hs new file mode 100644 index 0000000..e2a65e6 --- /dev/null +++ b/Language/Haskell/GhcMod/Cabal16.hs @@ -0,0 +1,13 @@ +-- | ComponentLocalBuildInfo for Cabal <= 1.16 +module Language.Haskell.GhcMod.Cabal16 ( + ComponentLocalBuildInfo + , componentPackageDeps + ) where + +import Distribution.Package (InstalledPackageId, PackageIdentifier) + +-- From Cabal <= 1.16 +data ComponentLocalBuildInfo = ComponentLocalBuildInfo { + componentPackageDeps :: [(InstalledPackageId, PackageIdentifier)] + } + deriving (Read, Show) diff --git a/Language/Haskell/GhcMod/Cabal18.hs b/Language/Haskell/GhcMod/Cabal18.hs new file mode 100644 index 0000000..e30433a --- /dev/null +++ b/Language/Haskell/GhcMod/Cabal18.hs @@ -0,0 +1,7 @@ +-- | ComponentLocalBuildInfo for Cabal >= 1.18 +module Language.Haskell.GhcMod.Cabal18 ( + ComponentLocalBuildInfo + , componentPackageDeps + ) where + +import Distribution.Simple.LocalBuildInfo (ComponentLocalBuildInfo(..)) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index 96b8508..ef44e8f 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -7,13 +7,12 @@ module Language.Haskell.GhcMod.CabalApi ( , cabalDependPackages , cabalSourceDirs , cabalAllTargets - , cabalGetConfig - , cabalConfigPath , cabalConfigDependencies ) where import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.GhcPkg +import Language.Haskell.GhcMod.CabalConfig import Language.Haskell.GhcMod.Utils import Control.Applicative ((<$>)) @@ -39,13 +38,14 @@ import Distribution.Simple.Program (ghcProgram) import Distribution.Simple.Program.Types (programName, programFindVersion) import Distribution.Simple.BuildPaths (defaultDistPref) import Distribution.Simple.Configure (localBuildInfoFile) -import Distribution.Simple.LocalBuildInfo (ComponentLocalBuildInfo(..), ComponentName) +import Distribution.Simple.LocalBuildInfo (ComponentName) import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity (silent) import Distribution.Version (Version) import System.Directory (doesFileExist) import System.FilePath (()) +import Text.Read (readMaybe) ---------------------------------------------------------------- -- | Getting necessary 'CompilerOptions' from three information sources. @@ -55,7 +55,7 @@ getCompilerOptions :: [GHCOption] -> IO CompilerOptions getCompilerOptions ghcopts cradle pkgDesc = do gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos - depPkgs <- cabalConfigDependencies (C.packageId pkgDesc) <$> cabalGetConfig cradle + depPkgs <- cabalConfigDependencies cradle (C.packageId pkgDesc) return $ CompilerOptions gopts idirs depPkgs where wdir = cradleCurrentDir cradle @@ -205,88 +205,3 @@ cabalAllTargets pd = do getExecutableTarget exe = do let maybeExes = [p e | p <- P.hsSourceDirs $ P.buildInfo exe, e <- [P.modulePath exe]] liftIO $ filterM doesFileExist maybeExes - ----------------------------------------------------------------- - -type CabalConfig = String - --- | Get file containing 'LocalBuildInfo' data. If it doesn't exist run @cabal --- configure@ i.e. configure with default options like @cabal build@ would do. -cabalGetConfig :: Cradle -> IO CabalConfig -cabalGetConfig cradle = - readFile path `E.catch` (\(SomeException _) -> configure >> readFile path) - where - prjDir = cradleRootDir cradle - path = prjDir cabalConfigPath - configure = - withDirectory_ prjDir $ readProcess' "cabal" ["configure"] - - --- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@ -cabalConfigPath :: FilePath -cabalConfigPath = localBuildInfoFile defaultDistPref - -cabalConfigDependencies :: PackageIdentifier -> CabalConfig -> [Package] -cabalConfigDependencies thisPkg config = cfgDepends - where - pids :: [InstalledPackageId] - pids = let - mps = map fst <$> (components18 thisPkg `mplus` components16 thisPkg) - in case mps of - Just ps -> ps - Nothing -> errorExtract - cfgDepends = filter (("inplace" /=) . pkgId) - $ fromInstalledPackageId <$> pids - - errorExtract = error $ - "cabalConfigDependencies: Error extracting dependencies from setup-config" - - -- Cabal 1.18 - components18 :: PackageIdentifier - -> Maybe [(InstalledPackageId,PackageIdentifier)] - components18 _ = - concatMap (componentPackageDeps . lbi) - <$> extractCabalSetupConfig config "componentsConfigs" - - lbi :: (ComponentName, ComponentLocalBuildInfo, [ComponentName]) - -> ComponentLocalBuildInfo - lbi (_,i,_) = i - - -- Cabal 1.16 and below - components16 :: PackageIdentifier - -> Maybe [(InstalledPackageId,PackageIdentifier)] - components16 thisPkg' = filter (not . internal . snd) . nub <$> do - cbi <- concat <$> sequence [ extract "executableConfigs" - , extract "testSuiteConfigs" - , extract "benchmarkConfigs" ] - :: Maybe [(String, ComponentLocalBuildInfo)] - - return $ maybe [] componentPackageDeps libraryConfig - ++ concatMap (componentPackageDeps . snd) cbi - where - -- True if this dependency is an internal one (depends on the library - -- defined in the same package). - internal pkgid = pkgid == thisPkg' - - libraryConfig :: Maybe ComponentLocalBuildInfo - libraryConfig = do - field <- find ("libraryConfig" `isPrefixOf`) (tails config) - clbi <- stripPrefix " = " field - if "Nothing" `isPrefixOf` clbi - then Nothing - else read <$> stripPrefix "Just " clbi - - extract :: Read r => String -> Maybe r - extract field = extractCabalSetupConfig config field - --- | Extract part of cabal's @setup-config@, this is done with a mix of manual --- string processing and use of 'read'. This way we can extract a field from --- 'LocalBuildInfo' without having to parse the whole thing which would mean --- depending on the exact version of Cabal used to configure the project as it --- is rather likley that some part of 'LocalBuildInfo' changed. --- --- Right now 'extractCabalSetupConfig' can only deal with Lists and Tuples in --- the field! -extractCabalSetupConfig :: (Read r) => CabalConfig -> String -> Maybe r -extractCabalSetupConfig config field = do - read <$> extractParens <$> find (field `isPrefixOf`) (tails config) diff --git a/Language/Haskell/GhcMod/CabalConfig.hs b/Language/Haskell/GhcMod/CabalConfig.hs new file mode 100644 index 0000000..f22b4df --- /dev/null +++ b/Language/Haskell/GhcMod/CabalConfig.hs @@ -0,0 +1,118 @@ +-- | Reading cabal @dist/setup-config@ +module Language.Haskell.GhcMod.CabalConfig ( + CabalConfig + , cabalConfigDependencies + ) where + +import Language.Haskell.GhcMod.GhcPkg +import Language.Haskell.GhcMod.Utils +import Language.Haskell.GhcMod.Types + +import qualified Language.Haskell.GhcMod.Cabal16 as C16 +import qualified Language.Haskell.GhcMod.Cabal18 as C18 + +import qualified Control.Exception as E +import Control.Applicative ((<$>)) +import Control.Monad (filterM,mplus) +import Control.Monad.Error () +import Data.Maybe () +import Data.Set () +import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix) +import Distribution.Package (PackageName(PackageName) + , InstalledPackageId(..) + , PackageIdentifier) +import qualified Distribution.Package as C +import Distribution.Simple.BuildPaths (defaultDistPref) +import Distribution.Simple.Configure (localBuildInfoFile) +import Distribution.Simple.LocalBuildInfo (ComponentName) +import System.FilePath (()) +import Text.Read (readMaybe) +---------------------------------------------------------------- + +type CabalConfig = String + +-- | Get file containing 'LocalBuildInfo' data. If it doesn't exist run @cabal +-- configure@ i.e. configure with default options like @cabal build@ would do. +getConfig :: Cradle -> IO CabalConfig +getConfig cradle = + readFile path `E.catch` (\(E.SomeException _) -> configure >> readFile path) + where + prjDir = cradleRootDir cradle + path = prjDir configPath + configure = + withDirectory_ prjDir $ readProcess' "cabal" ["configure"] + + +-- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@ +configPath :: FilePath +configPath = localBuildInfoFile defaultDistPref + +cabalConfigDependencies :: Cradle -> PackageIdentifier -> IO [Package] +cabalConfigDependencies cradle thisPkg = + configDependencies thisPkg <$> getConfig cradle + +configDependencies :: PackageIdentifier -> CabalConfig -> [Package] +configDependencies thisPkg config = map fromInstalledPackageId deps + where + deps :: [InstalledPackageId] + deps = case (deps18 `mplus` deps16) of + Right ps -> ps + Left msg -> error msg + +-- errorExtract = error $ +-- "cabalConfigDependencies: Error extracting dependencies from setup-config" + + -- Cabal >= 1.18 + deps18 :: Either String [InstalledPackageId] + deps18 = + concatMap (map fst . C18.componentPackageDeps . lbi) + <$> (readEither =<< extractField config "componentsConfigs") + + lbi :: (ComponentName, C18.ComponentLocalBuildInfo, [ComponentName]) + -> C18.ComponentLocalBuildInfo + lbi (_,i,_) = i + + -- Cabal 1.16 and below + deps16 :: Either String [InstalledPackageId] + deps16 = map fst <$> filter (not . internal . snd) . nub <$> do + cbi <- concat <$> sequence [ extract "executableConfigs" + , extract "testSuiteConfigs" + , extract "benchmarkConfigs" ] + :: Either String [(String, C16.ComponentLocalBuildInfo)] + + return $ maybe [] C16.componentPackageDeps libraryConfig + ++ concatMap (C16.componentPackageDeps . snd) cbi + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal pkgid = pkgid == thisPkg + + libraryConfig :: Maybe C16.ComponentLocalBuildInfo + libraryConfig = do + field <- find ("libraryConfig" `isPrefixOf`) (tails config) + clbi <- stripPrefix " = " field + if "Nothing" `isPrefixOf` clbi + then Nothing + else case readMaybe <$> stripPrefix "Just " clbi of + Just x -> x + Nothing -> error $ "reading libraryConfig failed\n" ++ show (stripPrefix "Just " clbi) + + extract :: String -> Either String [(String, C16.ComponentLocalBuildInfo)] + extract field = readConfigs field <$> extractField config field + + readConfigs :: String -> String -> [(String, C16.ComponentLocalBuildInfo)] + readConfigs f s = case readMaybe s of + Just x -> x + Nothing -> error $ "reading config " ++ f ++ " failed" + + +readEither :: Read r => String -> Either String r +readEither s = case readMaybe s of + Just x -> Right x + Nothing -> Left $ "read: failed on input:\n" ++ s + +extractField :: CabalConfig -> String -> Either String String +extractField config field = + case extractParens <$> find (field `isPrefixOf`) (tails config) of + Just f -> Right f + Nothing -> Left $ "extractField: failed extracting "++field++" from input, input contained `"++field++"'? " ++ show (field `isInfixOf` config) diff --git a/ghc-mod.cabal b/ghc-mod.cabal index 77b2983..c043128 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -58,6 +58,9 @@ Library Other-Modules: Language.Haskell.GhcMod.Boot Language.Haskell.GhcMod.Browse Language.Haskell.GhcMod.CabalApi + Language.Haskell.GhcMod.CabalConfig + Language.Haskell.GhcMod.Cabal16 + Language.Haskell.GhcMod.Cabal18 Language.Haskell.GhcMod.Check Language.Haskell.GhcMod.Cradle Language.Haskell.GhcMod.Debug diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index 46b6b8e..d7b1d13 100644 --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -60,10 +60,3 @@ spec = do it "extracts build info" $ do info <- cabalAllBuildInfo <$> parseCabalFile "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 = []})))]}]" - - describe "cabalGetConfig" $ do - it "can reconfigure a cabal package" $ do - withDirectory_ "test/data/check-test-subdir" $ do - cradle <- findCradle - cfg <- cabalGetConfig cradle - cfg `shouldSatisfy` not . null From d1da6ab2896fa37aecf31d9822a12056eecec365 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 9 May 2014 20:36:20 +0200 Subject: [PATCH 2/6] Make getSystemLibDir use `GHC.Paths` instead of running `ghc` --- Language/Haskell/GhcMod/GHCApi.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs index ec87093..e30b3b0 100644 --- a/Language/Haskell/GhcMod/GHCApi.hs +++ b/Language/Haskell/GhcMod/GHCApi.hs @@ -24,22 +24,18 @@ import Data.Maybe (isJust, fromJust) import Exception (ghandle, SomeException(..)) import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..)) import qualified GHC as G +import GHC.Paths (libdir) import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types import System.Exit (exitSuccess) import System.IO (hPutStr, hPrint, stderr) import System.IO.Unsafe (unsafePerformIO) -import System.Process (readProcess) ---------------------------------------------------------------- -- | Obtaining the directory for system libraries. getSystemLibDir :: IO (Maybe FilePath) -getSystemLibDir = do - res <- readProcess "ghc" ["--print-libdir"] [] - return $ case res of - "" -> Nothing - dirn -> Just (init dirn) +getSystemLibDir = return $ Just libdir ---------------------------------------------------------------- From 8741323f5b9c5450c40205d0632f61a4b7e42125 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 9 May 2014 20:37:15 +0200 Subject: [PATCH 3/6] Fix tests for Cabal <= 1.16 --- Language/Haskell/GhcMod/GhcPkg.hs | 8 +++++++- test/CabalApiSpec.hs | 8 +++++++- test/CradleSpec.hs | 5 +++++ test/GhcPkgSpec.hs | 9 ++++++++- 4 files changed, 27 insertions(+), 3 deletions(-) diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs index 6c1f5b8..dcbadcf 100644 --- a/Language/Haskell/GhcMod/GhcPkg.hs +++ b/Language/Haskell/GhcMod/GhcPkg.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, ScopedTypeVariables, TupleSections #-} +{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, TupleSections #-} module Language.Haskell.GhcMod.GhcPkg ( ghcPkgDbOpt , ghcPkgDbStackOpts @@ -12,7 +12,9 @@ module Language.Haskell.GhcMod.GhcPkg ( import Config (cProjectVersionInt) import Control.Applicative ((<$>)) +#if MIN_VERSION_Cabal(1,18,0) import Control.Exception (SomeException(..)) +#endif import qualified Control.Exception as E import Data.Char (isSpace) import Data.List (isPrefixOf, intercalate) @@ -51,8 +53,12 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the -- exists) -> IO [GhcPkgDb] getPackageDbStack cdir = +#if MIN_VERSION_Cabal(1,18,0) (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db]) `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb] +#else + return [GlobalDb, UserDb] +#endif fromInstalledPackageId' :: InstalledPackageId -> Maybe Package fromInstalledPackageId' pid = let diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index d7b1d13..cd010dd 100644 --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP, ScopedTypeVariables #-} module CabalApiSpec where @@ -36,9 +36,15 @@ spec = do ghcOptions = ghcOptions res , includeDirs = map (toRelativeDir dir) (includeDirs res) } +#if MIN_VERSION_Cabal(1,18,0) if ghcVersion < 706 then ghcOptions res' `shouldContain` ["-global-package-conf", "-no-user-package-conf","-package-conf",cwd "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"] else ghcOptions res' `shouldContain` ["-global-package-db", "-no-user-package-db","-package-db",cwd "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"] +#else + if ghcVersion < 706 + then ghcOptions res' `shouldContain` ["-global-package-conf", "-user-package-conf","-XHaskell98"] + else ghcOptions res' `shouldContain` ["-global-package-db", "-user-package-db","-XHaskell98"] +#endif includeDirs res' `shouldBe` ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"] (pkgName `map` depPackages res') `shouldContain` ["Cabal"] diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index 2bf54e1..38fd869 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CradleSpec where import Control.Applicative @@ -31,7 +32,11 @@ spec = do cradleCurrentDir = "test" "data" "subdir1" "subdir2" , cradleRootDir = "test" "data" , cradleCabalFile = Just ("test" "data" "cabalapi.cabal") +#if MIN_VERSION_Cabal(1,18,0) , cradlePkgDbStack = [GlobalDb, PackageDb (cwd "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")] +#else + , cradlePkgDbStack = [GlobalDb, UserDb] +#endif } it "works even if a sandbox config file is broken" $ do withDirectory "test/data/broken-sandbox" $ \dir -> do diff --git a/test/GhcPkgSpec.hs b/test/GhcPkgSpec.hs index 1859829..3c84177 100644 --- a/test/GhcPkgSpec.hs +++ b/test/GhcPkgSpec.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE CPP #-} module GhcPkgSpec where import Language.Haskell.GhcMod.GhcPkg +import Language.Haskell.GhcMod.Types import System.Directory import System.FilePath (()) @@ -8,7 +10,12 @@ import Test.Hspec spec :: Spec spec = do - describe "getSandboxDb" $ do + describe "getPackageDbStack" $ do +#if !MIN_VERSION_Cabal(1,18,0) + it "does not include a sandbox with Cabal < 1.18" $ do + cwd <- getCurrentDirectory + getPackageDbStack cwd `shouldReturn` [GlobalDb, UserDb] +#endif it "parses a config file and extracts sandbox package db" $ do cwd <- getCurrentDirectory pkgDb <- getSandboxDb "test/data/" From 44b897c6a5203f2247707c75dbb59f782abdf763 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 9 May 2014 20:37:55 +0200 Subject: [PATCH 4/6] Print useful information when running spec --- test/Main.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/test/Main.hs b/test/Main.hs index bd0c8f8..0700432 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,9 +1,13 @@ +{-# LANGUAGE ScopedTypeVariables #-} import Spec import Dir import Test.Hspec import System.Process +import Language.Haskell.GhcMod (debugInfo, defaultOptions, findCradle) +import Control.Exception as E + main = do let sandboxes = [ "test/data", "test/data/check-packageid" , "test/data/duplicate-pkgver/" ] @@ -17,4 +21,10 @@ main = do genSandboxCfg `mapM_` sandboxes genGhcPkgCache `mapM_` pkgDirs system "find test -name setup-config -exec rm {} \\;" + system "cabal --version" + system "ghc --version" + + (putStrLn =<< debugInfo defaultOptions =<< findCradle) + `E.catch` (\(_ :: E.SomeException) -> return () ) + hspec spec From 175635505d696a1f350fb2ac1a89f095ffe1fed3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 9 May 2014 20:38:35 +0200 Subject: [PATCH 5/6] Fix warnings --- Language/Haskell/GhcMod/CabalApi.hs | 13 ++----------- Language/Haskell/GhcMod/CabalConfig.hs | 6 ++---- Language/Haskell/GhcMod/GhcPkg.hs | 4 ++-- Language/Haskell/GhcMod/Monad.hs | 11 ++++++++--- 4 files changed, 14 insertions(+), 20 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index ef44e8f..b052c4d 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -13,21 +13,16 @@ module Language.Haskell.GhcMod.CabalApi ( import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.CabalConfig -import Language.Haskell.GhcMod.Utils import Control.Applicative ((<$>)) -import Control.Exception (SomeException(..)) import qualified Control.Exception as E -import Control.Monad (filterM,mplus) +import Control.Monad (filterM) import CoreMonad (liftIO) import Data.Maybe (maybeToList) import Data.Set (fromList, toList) -import Data.List (find,tails,isPrefixOf,nub,stripPrefix) import Distribution.ModuleName (ModuleName,toFilePath) import Distribution.Package (Dependency(Dependency) - , PackageName(PackageName) - , InstalledPackageId(..) - , PackageIdentifier) + , PackageName(PackageName)) import qualified Distribution.Package as C import Distribution.PackageDescription (PackageDescription, BuildInfo, TestSuite, TestSuiteInterface(..), Executable) import qualified Distribution.PackageDescription as P @@ -36,16 +31,12 @@ import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..)) import Distribution.Simple.Program (ghcProgram) import Distribution.Simple.Program.Types (programName, programFindVersion) -import Distribution.Simple.BuildPaths (defaultDistPref) -import Distribution.Simple.Configure (localBuildInfoFile) -import Distribution.Simple.LocalBuildInfo (ComponentName) import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity (silent) import Distribution.Version (Version) import System.Directory (doesFileExist) import System.FilePath (()) -import Text.Read (readMaybe) ---------------------------------------------------------------- -- | Getting necessary 'CompilerOptions' from three information sources. diff --git a/Language/Haskell/GhcMod/CabalConfig.hs b/Language/Haskell/GhcMod/CabalConfig.hs index f22b4df..6cb91cd 100644 --- a/Language/Haskell/GhcMod/CabalConfig.hs +++ b/Language/Haskell/GhcMod/CabalConfig.hs @@ -13,15 +13,13 @@ import qualified Language.Haskell.GhcMod.Cabal18 as C18 import qualified Control.Exception as E import Control.Applicative ((<$>)) -import Control.Monad (filterM,mplus) +import Control.Monad (mplus) import Control.Monad.Error () import Data.Maybe () import Data.Set () import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix) -import Distribution.Package (PackageName(PackageName) - , InstalledPackageId(..) +import Distribution.Package (InstalledPackageId(..) , PackageIdentifier) -import qualified Distribution.Package as C import Distribution.Simple.BuildPaths (defaultDistPref) import Distribution.Simple.Configure (localBuildInfoFile) import Distribution.Simple.LocalBuildInfo (ComponentName) diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs index dcbadcf..b8b5a96 100644 --- a/Language/Haskell/GhcMod/GhcPkg.hs +++ b/Language/Haskell/GhcMod/GhcPkg.hs @@ -15,7 +15,6 @@ import Control.Applicative ((<$>)) #if MIN_VERSION_Cabal(1,18,0) import Control.Exception (SomeException(..)) #endif -import qualified Control.Exception as E import Data.Char (isSpace) import Data.List (isPrefixOf, intercalate) import Data.List.Split (splitOn) @@ -52,11 +51,12 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the -- cabal.sandbox.config file would be if it -- exists) -> IO [GhcPkgDb] -getPackageDbStack cdir = #if MIN_VERSION_Cabal(1,18,0) +getPackageDbStack cdir = (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db]) `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb] #else +getPackageDbStack _ = return [GlobalDb, UserDb] #endif diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 81faa30..5cfa8c1 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -23,11 +23,17 @@ import GhcMonad import Exception import MonadUtils import DynFlags - -import Data.Monoid (Monoid) +-- ghc <= 7.2 #if !MIN_VERSION_ghc(7,4,0) import HscTypes #endif + +-- base <= 4.6 +#if !MIN_VERSION_base(4,7,0) +import Data.Monoid (Monoid) +import Control.Monad.Trans.Class (lift) +#endif + import Data.IORef (IORef, readIORef, writeIORef, newIORef) import Control.Monad (liftM) @@ -36,7 +42,6 @@ import Control.Monad.Base (MonadBase,liftBase) import Control.Monad.Trans.RWS.Lazy (RWST(..),runRWST) import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith , control, liftBaseOp, liftBaseOp_) -import Control.Monad.Trans.Class (lift) import Control.Monad.Reader.Class import Control.Monad.Writer.Class import Control.Monad.State.Class From 13930a9d7d690f8bb8677efc23c1e0d83d8002c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 9 May 2014 21:12:52 +0200 Subject: [PATCH 6/6] Fix Cabal >= 1.18 --- Language/Haskell/GhcMod/CabalConfig.hs | 23 +++++++++++++---------- Language/Haskell/GhcMod/GhcPkg.hs | 4 ++-- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalConfig.hs b/Language/Haskell/GhcMod/CabalConfig.hs index 6cb91cd..75dc525 100644 --- a/Language/Haskell/GhcMod/CabalConfig.hs +++ b/Language/Haskell/GhcMod/CabalConfig.hs @@ -57,18 +57,25 @@ configDependencies thisPkg config = map fromInstalledPackageId deps Right ps -> ps Left msg -> error msg --- errorExtract = error $ --- "cabalConfigDependencies: Error extracting dependencies from setup-config" + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal pkgid = pkgid == thisPkg -- Cabal >= 1.18 deps18 :: Either String [InstalledPackageId] deps18 = - concatMap (map fst . C18.componentPackageDeps . lbi) + map fst + <$> filterInternal <$> (readEither =<< extractField config "componentsConfigs") - lbi :: (ComponentName, C18.ComponentLocalBuildInfo, [ComponentName]) - -> C18.ComponentLocalBuildInfo - lbi (_,i,_) = i + filterInternal + :: [(ComponentName, C18.ComponentLocalBuildInfo, [ComponentName])] + -> [(InstalledPackageId, PackageIdentifier)] + + filterInternal ccfg = [ (ipkgid, pkgid) + | (_,clbi,_) <- ccfg + , (ipkgid, pkgid) <- C18.componentPackageDeps clbi + , not (internal pkgid) ] -- Cabal 1.16 and below deps16 :: Either String [InstalledPackageId] @@ -81,10 +88,6 @@ configDependencies thisPkg config = map fromInstalledPackageId deps return $ maybe [] C16.componentPackageDeps libraryConfig ++ concatMap (C16.componentPackageDeps . snd) cbi where - -- True if this dependency is an internal one (depends on the library - -- defined in the same package). - internal pkgid = pkgid == thisPkg - libraryConfig :: Maybe C16.ComponentLocalBuildInfo libraryConfig = do field <- find ("libraryConfig" `isPrefixOf`) (tails config) diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs index b8b5a96..a2580cf 100644 --- a/Language/Haskell/GhcMod/GhcPkg.hs +++ b/Language/Haskell/GhcMod/GhcPkg.hs @@ -13,7 +13,7 @@ module Language.Haskell.GhcMod.GhcPkg ( import Config (cProjectVersionInt) import Control.Applicative ((<$>)) #if MIN_VERSION_Cabal(1,18,0) -import Control.Exception (SomeException(..)) +import qualified Control.Exception as E #endif import Data.Char (isSpace) import Data.List (isPrefixOf, intercalate) @@ -54,7 +54,7 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the #if MIN_VERSION_Cabal(1,18,0) getPackageDbStack cdir = (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db]) - `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb] + `E.catch` \(_ :: E.SomeException) -> return [GlobalDb, UserDb] #else getPackageDbStack _ = return [GlobalDb, UserDb]