Merge pull request #179 from naota/add-package-id

Expose packages in sandbox with their ids

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

Language/Haskell/GhcMod/Cradle.hs

@@ -4,6 +4,7 @@ module Language.Haskell.GhcMod.Cradle (
     findCradle
   , findCradleWithoutSandbox
   , getPackageDbDir
+  , getPackageDbPackages
   ) where
 
 import Data.Char (isSpace)
@@ -32,6 +33,7 @@ findCradle = do
       , cradleCabalDir      = Nothing
       , cradleCabalFile     = Nothing
       , cradlePackageDbOpts = []
+      , cradlePackages      = []
       }
 
 findCradle' :: FilePath -> IO Cradle
@@ -43,13 +45,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 = [] }
 
 ----------------------------------------------------------------
 
@@ -139,3 +142,7 @@ 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 _ = return []

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

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

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

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

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
@@ -50,12 +53,16 @@ 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 {
+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 "/.".

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]
 

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

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