From a0db24b0a544c5d43b82140a9c755e676dc4a3d1 Mon Sep 17 00:00:00 2001 From: Naohiro Aota Date: Thu, 30 Jan 2014 20:42:25 +0900 Subject: [PATCH 1/3] 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] From 04022ab0acb0f55cb2c5cfd21d6bcb859bc6fbf5 Mon Sep 17 00:00:00 2001 From: Naohiro Aota Date: Thu, 30 Jan 2014 20:09:57 +0900 Subject: [PATCH 2/3] Add test to check package id extraction This commit add a failing test to check extracting package id. The test will fail with the following output for now: 1) Cradle.getPackageDbPackages find a config file and extracts packages with their ids expected: [("template-haskell",Just "template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c")] but got: [] --- Language/Haskell/GhcMod/Cradle.hs | 41 +++++++++++++++++++ test/CradleSpec.hs | 5 +++ ....0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf | 37 +++++++++++++++++ .../data/check-packageid/cabal.sandbox.config | 25 +++++++++++ 4 files changed, 108 insertions(+) create mode 100644 test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf create mode 100644 test/data/check-packageid/cabal.sandbox.config diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index 8deea9a..780ff71 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -4,6 +4,7 @@ module Language.Haskell.GhcMod.Cradle ( findCradle , findCradleWithoutSandbox , getPackageDbDir + , getPackageDbPackages ) where import Data.Char (isSpace) @@ -141,3 +142,43 @@ extractGhcVer dir = ver (verStr1,_:left) = break (== '.') $ findVer file (verStr2,_) = break (== '.') left ver = read verStr1 * 100 + read verStr2 + +-- | Obtaining packages installed in a package db directory. +getPackageDbPackages :: FilePath -> IO [Package] +getPackageDbPackages cdir = (getPkgDb >>= listDbPackages) `E.catch` handler + where + getPkgDb = getPackageDbDir (cdir configFile) + handler :: SomeException -> IO [Package] + handler _ = return [] + +listDbPackages :: FilePath -> IO [Package] +listDbPackages pkgdir = do + files <- filter (".conf" `isSuffixOf`) <$> getDirectoryContents pkgdir + mapM extractPackage $ map (pkgdir ) files + +extractPackage :: FilePath -> IO Package +extractPackage pconf = do + contents <- lines <$> readFile pconf + -- Be strict to ensure that an error can be caught. + let !name = extractName $ parseName contents + !pid = extractId $ parseId contents + return (name, Just pid) + where + parseName = parse nameKey + extractName = extract nameKeyLength + parseId = parse idKey + extractId = extract idKeyLength + parse key = head . filter (key `isPrefixOf`) + extract keylen = fst . break isSpace . dropWhile isSpace . drop keylen + +nameKey :: String +nameKey = "name:" + +idKey :: String +idKey = "id:" + +nameKeyLength :: Int +nameKeyLength = length nameKey + +idKeyLength :: Int +idKeyLength = length idKey diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index c6d0243..87c47ad 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -53,6 +53,11 @@ spec = do it "throws an error if a config file is broken" $ do getPackageDbDir "test/data/bad.config" `shouldThrow` anyException + describe "getPackageDbPackages" $ do + it "find a config file and extracts packages with their ids" $ do + pkgs <- getPackageDbPackages "test/data/check-packageid" + pkgs `shouldBe` [("template-haskell", Just "template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c")] + relativeCradle :: FilePath -> Cradle -> Cradle relativeCradle dir cradle = cradle { cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle diff --git a/test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf b/test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf new file mode 100644 index 0000000..26a27e3 --- /dev/null +++ b/test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf @@ -0,0 +1,37 @@ +name: template-haskell +version: 2.8.0.0 +id: template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c +license: BSD3 +copyright: +maintainer: libraries@haskell.org +stability: +homepage: +package-url: +synopsis: +description: Facilities for manipulating Haskell source code using Template Haskell. +category: +author: +exposed: True +exposed-modules: Language.Haskell.TH.Syntax + Language.Haskell.TH.PprLib Language.Haskell.TH.Ppr + Language.Haskell.TH.Lib Language.Haskell.TH.Quote + Language.Haskell.TH +hidden-modules: +trusted: False +import-dirs: /usr/lib64/ghc-7.6.3/template-haskell-2.8.0.0 +library-dirs: /usr/lib64/ghc-7.6.3/template-haskell-2.8.0.0 +hs-libraries: HStemplate-haskell-2.8.0.0 +extra-libraries: +extra-ghci-libraries: +include-dirs: +includes: +depends: base-4.6.0.1-2bc8d09dc7b7883c4b97d1eb4a9d4ac8 + containers-0.5.0.0-120bacdd7a06bf9f1f601811aa72d6c3 + pretty-1.1.1.0-65070790589ca7952412e425f427ac56 +hugs-options: +cc-options: +ld-options: +framework-dirs: +frameworks: +haddock-interfaces: /usr/share/doc/ghc-7.6.3/html/libraries/template-haskell-2.8.0.0/template-haskell.haddock +haddock-html: /usr/share/doc/ghc-7.6.3/html/libraries/template-haskell-2.8.0.0 diff --git a/test/data/check-packageid/cabal.sandbox.config b/test/data/check-packageid/cabal.sandbox.config new file mode 100644 index 0000000..4de501a --- /dev/null +++ b/test/data/check-packageid/cabal.sandbox.config @@ -0,0 +1,25 @@ +-- This is a Cabal package environment file. +-- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY. +-- Please create a 'cabal.config' file in the same directory +-- if you want to change the default settings for this sandbox. + + +local-repo: /home/me/work/ghc-mod/test/data/.cabal-sandbox/packages +logs-dir: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs +world-file: /home/me/work/ghc-mod/test/data/.cabal-sandbox/world +user-install: False +package-db: test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d +build-summary: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs/build.log + +install-dirs + prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox + bindir: $prefix/bin + libdir: $prefix/lib + libsubdir: $arch-$os-$compiler/$pkgid + libexecdir: $prefix/libexec + datadir: $prefix/share + datasubdir: $arch-$os-$compiler/$pkgid + docdir: $datadir/doc/$arch-$os-$compiler/$pkgid + htmldir: $docdir/html + haddockdir: $htmldir + sysconfdir: $prefix/etc From 46492a19b0d023683baf4154302ae15d25faebdb Mon Sep 17 00:00:00 2001 From: Naohiro Aota Date: Thu, 30 Jan 2014 21:21:40 +0900 Subject: [PATCH 3/3] Expose packages in sandbox with their ids This commit implement scaning a package db directory to collect package id If you installed a package both in a sandbox and globally, global package may be selected even if there's a package in a sandbox, which is different behavior from cabal sandbox. e.g. when you have fast-logger-2.0 globally and fast-logger-0.3.3 in a sandbox: (Without patch) $ ghc-mod check Foundation.hs Foundation.hs:12:31:Module `System.Log.FastLogger' does not export `Logger' (With patch) $ ghc-mod check Foundation.hs --- Language/Haskell/GhcMod/Cradle.hs | 38 +------------------------------ 1 file changed, 1 insertion(+), 37 deletions(-) diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index 780ff71..30b9a83 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -145,40 +145,4 @@ extractGhcVer dir = ver -- | Obtaining packages installed in a package db directory. getPackageDbPackages :: FilePath -> IO [Package] -getPackageDbPackages cdir = (getPkgDb >>= listDbPackages) `E.catch` handler - where - getPkgDb = getPackageDbDir (cdir configFile) - handler :: SomeException -> IO [Package] - handler _ = return [] - -listDbPackages :: FilePath -> IO [Package] -listDbPackages pkgdir = do - files <- filter (".conf" `isSuffixOf`) <$> getDirectoryContents pkgdir - mapM extractPackage $ map (pkgdir ) files - -extractPackage :: FilePath -> IO Package -extractPackage pconf = do - contents <- lines <$> readFile pconf - -- Be strict to ensure that an error can be caught. - let !name = extractName $ parseName contents - !pid = extractId $ parseId contents - return (name, Just pid) - where - parseName = parse nameKey - extractName = extract nameKeyLength - parseId = parse idKey - extractId = extract idKeyLength - parse key = head . filter (key `isPrefixOf`) - extract keylen = fst . break isSpace . dropWhile isSpace . drop keylen - -nameKey :: String -nameKey = "name:" - -idKey :: String -idKey = "id:" - -nameKeyLength :: Int -nameKeyLength = length nameKey - -idKeyLength :: Int -idKeyLength = length idKey +getPackageDbPackages _ = return []