From a0db24b0a544c5d43b82140a9c755e676dc4a3d1 Mon Sep 17 00:00:00 2001 From: Naohiro Aota Date: Thu, 30 Jan 2014 20:42:25 +0900 Subject: [PATCH] Extend Package to include id This commit 1. rename Package with PackageBaseName 2. Pacakge = (PackageBaseName, Maybe String) to save its id 3. Expose packages with id if available --- Language/Haskell/GhcMod/CabalApi.hs | 18 +++++++++++++----- Language/Haskell/GhcMod/Cradle.hs | 4 +++- Language/Haskell/GhcMod/Debug.hs | 2 +- Language/Haskell/GhcMod/Gap.hs | 4 +++- Language/Haskell/GhcMod/Types.hs | 6 +++++- test/CabalApiSpec.hs | 2 +- test/CradleSpec.hs | 6 ++++-- test/DebugSpec.hs | 2 +- 8 files changed, 31 insertions(+), 13 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index daffe5c..f905b5a 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -44,26 +44,34 @@ getCompilerOptions ghcopts cradle pkgDesc = do wdir = cradleCurrentDir cradle Just cdir = cradleCabalDir cradle Just cfile = cradleCabalFile cradle + pkgs = cradlePackages cradle buildInfos = cabalAllBuildInfo pkgDesc idirs = includeDirectories cdir wdir $ cabalSourceDirs buildInfos - depPkgs = removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos + depPkgs = attachPackageIds pkgs $ removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos ---------------------------------------------------------------- -- Dependent packages -removeMe :: FilePath -> [Package] -> [Package] +removeMe :: FilePath -> [PackageBaseName] -> [PackageBaseName] removeMe cabalfile = filter (/= me) where me = dropExtension $ takeFileName cabalfile -removeThem :: [Package] -> [Package] -> [Package] +removeThem :: [PackageBaseName] -> [PackageBaseName] -> [PackageBaseName] removeThem badpkgs = filter (`notElem` badpkgs) -problematicPackages :: [Package] +problematicPackages :: [PackageBaseName] problematicPackages = [ "base-compat" -- providing "Prelude" ] +attachPackageIds :: [Package] -> [PackageBaseName] -> [Package] +attachPackageIds pkgs = map attachId + where + attachId x = case lookup x pkgs of + Nothing -> (x, Nothing) + Just p -> (x, p) + ---------------------------------------------------------------- -- Include directories for modules @@ -138,7 +146,7 @@ cabalAllBuildInfo pd = libBI ++ execBI ++ testBI ++ benchBI ---------------------------------------------------------------- -- | Extracting package names of dependency. -cabalDependPackages :: [BuildInfo] -> [Package] +cabalDependPackages :: [BuildInfo] -> [PackageBaseName] cabalDependPackages bis = uniqueAndSort $ pkgs where pkgs = map getDependencyPackageName $ concatMap targetBuildDepends bis diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index ed8c57b..8deea9a 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -32,6 +32,7 @@ findCradle = do , cradleCabalDir = Nothing , cradleCabalFile = Nothing , cradlePackageDbOpts = [] + , cradlePackages = [] } findCradle' :: FilePath -> IO Cradle @@ -43,13 +44,14 @@ findCradle' wdir = do , cradleCabalDir = Just cdir , cradleCabalFile = Just cfile , cradlePackageDbOpts = pkgDbOpts + , cradlePackages = [] } -- Just for testing findCradleWithoutSandbox :: IO Cradle findCradleWithoutSandbox = do cradle <- findCradle - return cradle { cradlePackageDbOpts = [] } + return cradle { cradlePackageDbOpts = [], cradlePackages = [] } ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index 3b3bbac..7666695 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -41,7 +41,7 @@ debug opt cradle fileName = do , "Cabal file: " ++ cabalFile , "GHC options: " ++ unwords gopts , "Include directories: " ++ unwords incDir - , "Dependent packages: " ++ intercalate ", " pkgs + , "Dependent packages: " ++ (intercalate ", " $ map fst pkgs) , "Fast check: " ++ if fast then "Yes" else "No" ] where diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs index 69e280a..680dcf3 100644 --- a/Language/Haskell/GhcMod/Gap.hs +++ b/Language/Haskell/GhcMod/Gap.hs @@ -234,8 +234,10 @@ addDevPkgs df pkgs = df'' df' = dopt_set df Opt_HideAllPackages #endif df'' = df' { - packageFlags = map ExposePackage pkgs ++ packageFlags df + packageFlags = map expose pkgs ++ packageFlags df } + expose (pkg, Nothing) = ExposePackage pkg + expose (_, Just pid) = ExposePackageId pid ---------------------------------------------------------------- ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 4912c2f..d8a55b0 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -90,6 +90,7 @@ data Cradle = Cradle { , cradleCabalFile :: Maybe FilePath -- | The package db options. ([\"-no-user-package-db\",\"-package-db\",\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\"]) , cradlePackageDbOpts :: [GHCOption] + , cradlePackages :: [Package] } deriving (Eq, Show) ---------------------------------------------------------------- @@ -101,7 +102,10 @@ type GHCOption = String type IncludeDir = FilePath -- | A package name. -type Package = String +type PackageBaseName = String + +-- | A package name and its ID. +type Package = (PackageBaseName, Maybe String) -- | Haskell expression. type Expression = String diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index 4174253..a2128d6 100644 --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -28,7 +28,7 @@ spec = do ghcOptions = ghcOptions res , includeDirs = map (toRelativeDir dir) (includeDirs res) } - res' `shouldBe` CompilerOptions {ghcOptions = ["-no-user-package-db","-package-db","/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"], depPackages = ["Cabal","base","template-haskell"]} + res' `shouldBe` CompilerOptions {ghcOptions = ["-no-user-package-db","-package-db","/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"], depPackages = [("Cabal", Nothing), ("base", Nothing) , ("template-haskell", Nothing)]} describe "cabalDependPackages" $ do it "extracts dependent packages" $ do diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index 42e3de2..c6d0243 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -22,6 +22,7 @@ spec = do , cradleCabalDir = Nothing , cradleCabalFile = Nothing , cradlePackageDbOpts = [] + , cradlePackages = [] } it "finds a cabal file and a sandbox" $ do withDirectory "test/data/subdir1/subdir2" $ \dir -> do @@ -31,6 +32,7 @@ spec = do , cradleCabalDir = Just ("test" "data") , cradleCabalFile = Just ("test" "data" "cabalapi.cabal") , cradlePackageDbOpts = ["-no-user-package-db", "-package-db", "test" "data" ".cabal-sandbox" "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"] + , cradlePackages = [] } it "works even if a sandbox config file is broken" $ do withDirectory "test/data/broken-sandbox" $ \dir -> do @@ -40,6 +42,7 @@ spec = do , cradleCabalDir = Just ("test" "data" "broken-sandbox") , cradleCabalFile = Just ("test" "data" "broken-sandbox" "dummy.cabal") , cradlePackageDbOpts = [] + , cradlePackages = [] } describe "getPackageDbDir" $ do @@ -51,11 +54,10 @@ spec = do getPackageDbDir "test/data/bad.config" `shouldThrow` anyException relativeCradle :: FilePath -> Cradle -> Cradle -relativeCradle dir cradle = Cradle { +relativeCradle dir cradle = cradle { cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle , cradleCabalDir = toRelativeDir dir <$> cradleCabalDir cradle , cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle - , cradlePackageDbOpts = cradlePackageDbOpts cradle } -- Work around GHC 7.2.2 where `canonicalizePath "/"` returns "/.". diff --git a/test/DebugSpec.hs b/test/DebugSpec.hs index 8331c6e..a97325d 100644 --- a/test/DebugSpec.hs +++ b/test/DebugSpec.hs @@ -7,7 +7,7 @@ import Dir checkFast :: String -> String -> IO () checkFast file ans = withDirectory_ "test/data" $ do - let cradle = Cradle "." Nothing Nothing [] + let cradle = Cradle "." Nothing Nothing [] [] res <- debugInfo defaultOptions cradle file lines res `shouldContain` [ans]