Refactor the way packages databases are handled

- cradle now stores a list of active package databases instead of only
  the user store (if present).

- rename `cradlePackageDb` -> `cradlePkgDbStack` as that`s what the ghc
  documentaion calls this kind of thing

- `getPackageDbPackages` now returns names of all visible packages in
  the given directory. Also the implementation now uses `ghc-pkg`
  instead of manually looking at the package database

Language/Haskell/GhcMod/CabalApi.hs

@@ -9,6 +9,9 @@ module Language.Haskell.GhcMod.CabalApi (
   , cabalAllTargets
   ) where
 
+import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.GhcPkg
+
 import Control.Applicative ((<$>))
 import Control.Exception (throwIO)
 import Control.Monad (filterM)
@@ -30,8 +33,6 @@ import Distribution.System (buildPlatform)
 import Distribution.Text (display)
 import Distribution.Verbosity (silent)
 import Distribution.Version (Version)
-import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Cradle
 import System.Directory (doesFileExist)
 import System.FilePath (dropExtension, takeFileName, (</>))
 
@@ -114,7 +115,7 @@ getGHCOptions ghcopts cradle rdir binfo = do
     let cpps = map ("-optP" ++) $ P.cppOptions binfo ++ cabalCpp
     return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps
   where
-    pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle
+    pkgDb = ghcDbStackOpts $ cradlePkgDbStack cradle
     lang = maybe "-XHaskell98" (("-X" ++) . display) $ P.defaultLanguage binfo
     libDirs = map ("-L" ++) $ P.extraLibDirs binfo
     exts = map (("-X" ++) . display) $ P.usedExtensions binfo

Language/Haskell/GhcMod/Cradle.hs

@@ -3,23 +3,18 @@
 module Language.Haskell.GhcMod.Cradle (
     findCradle
   , findCradleWithoutSandbox
-  , getPackageDbDir
-  , getPackageDbPackages
-  , userPackageDbOptsForGhc
-  , userPackageDbOptsForGhcPkg
-  , getSandboxDir
   ) where
 
+import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.GhcPkg
+
 import Control.Applicative ((<$>))
-import Control.Exception (SomeException(..))
 import qualified Control.Exception as E
 import Control.Exception.IOChoice ((||>))
 import Control.Monad (filterM)
-import Data.Char (isSpace)
+import Data.List (isSuffixOf)
-import Data.List (isPrefixOf, isSuffixOf, tails)
-import Language.Haskell.GhcMod.Types
 import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist)
-import System.FilePath ((</>), takeDirectory, takeFileName)
+import System.FilePath ((</>), takeDirectory)
 
 ----------------------------------------------------------------
 
@@ -35,24 +30,24 @@ findCradle = do
 cabalCradle :: FilePath -> IO Cradle
 cabalCradle wdir = do
     (rdir,cfile) <- cabalDir wdir
-    pkgDbOpts <- getPackageDb rdir
+    pkgDbStack <- getPackageDbStack rdir
     return Cradle {
         cradleCurrentDir = wdir
       , cradleRootDir    = rdir
       , cradleCabalFile  = Just cfile
-      , cradlePackageDb  = pkgDbOpts
+      , cradlePkgDbStack = pkgDbStack
       , cradlePackages   = []
       }
 
 sandboxCradle :: FilePath -> IO Cradle
 sandboxCradle wdir = do
     rdir <- getSandboxDir wdir
-    pkgDbOpts <- getPackageDb rdir
+    pkgDbStack <- getPackageDbStack rdir
     return Cradle {
         cradleCurrentDir = wdir
       , cradleRootDir    = rdir
       , cradleCabalFile  = Nothing
-      , cradlePackageDb  = pkgDbOpts
+      , cradlePkgDbStack = pkgDbStack
       , cradlePackages   = []
       }
 
@@ -61,7 +56,7 @@ plainCradle wdir = return Cradle {
         cradleCurrentDir = wdir
       , cradleRootDir    = wdir
       , cradleCabalFile  = Nothing
-      , cradlePackageDb  = Nothing
+      , cradlePkgDbStack = [GlobalDb]
       , cradlePackages   = []
       }
 
@@ -69,7 +64,7 @@ plainCradle wdir = return Cradle {
 findCradleWithoutSandbox :: IO Cradle
 findCradleWithoutSandbox = do
     cradle <- findCradle
-    return cradle { cradlePackageDb = Nothing, cradlePackages = [] }
+    return cradle { cradlePkgDbStack = [GlobalDb], cradlePackages = [] }
 
 ----------------------------------------------------------------
 
@@ -103,121 +98,6 @@ getCabalFiles dir = getFiles >>= filterM doesCabalFileExist
 
 ----------------------------------------------------------------
 
-configFile :: String
-configFile = "cabal.sandbox.config"
-
-pkgDbKey :: String
-pkgDbKey = "package-db:"
-
-pkgDbKeyLen :: Int
-pkgDbKeyLen = length pkgDbKey
-
--- | Obtaining GHC options relating to a package db directory
-getPackageDb :: FilePath -> IO (Maybe FilePath)
-getPackageDb cdir = (Just <$> getPkgDb) `E.catch` handler
-  where
-    getPkgDb = getPackageDbDir (cdir </> configFile)
-    handler :: SomeException -> IO (Maybe FilePath)
-    handler _ = return Nothing
-
--- | Extract a package db directory from the sandbox config file.
---   Exception is thrown if the sandbox config file is broken.
-getPackageDbDir :: FilePath -> IO FilePath
-getPackageDbDir sconf = do
-    -- Be strict to ensure that an error can be caught.
-    !path <- extractValue . parse <$> readFile sconf
-    return path
-  where
-    parse = head . filter ("package-db:" `isPrefixOf`) . lines
-    extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop pkgDbKeyLen
-    -- dropWhileEnd is not provided prior to base 4.5.0.0.
-    dropWhileEnd :: (a -> Bool) -> [a] -> [a]
-    dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
-
--- | Creating user package db options for GHC.
---
--- >>> userPackageDbOptsForGhc (Just "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d")
--- ["-no-user-package-db","-package-db","/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"]
--- >>> userPackageDbOptsForGhc (Just "/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d")
--- ["-no-user-package-conf","-package-conf","/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"]
-userPackageDbOptsForGhc :: Maybe FilePath -> [String]
-userPackageDbOptsForGhc Nothing      = []
-userPackageDbOptsForGhc (Just pkgDb) = [noUserPkgDbOpt, pkgDbOpt, pkgDb]
-  where
-    ver = extractGhcVer pkgDb
-    (noUserPkgDbOpt,pkgDbOpt)
-      | ver < 706 = ("-no-user-package-conf", "-package-conf")
-      | otherwise = ("-no-user-package-db",   "-package-db")
-
--- | Creating user package db options for ghc-pkg.
---
--- >>> userPackageDbOptsForGhcPkg (Just "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d")
--- ["--no-user-package-db","--package-db=/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"]
--- >>> userPackageDbOptsForGhcPkg (Just "/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d")
--- ["--no-user-package-conf","--package-conf=/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"]
-userPackageDbOptsForGhcPkg :: Maybe FilePath -> [String]
-userPackageDbOptsForGhcPkg Nothing      = []
-userPackageDbOptsForGhcPkg (Just pkgDb) = [noUserPkgDbOpt, pkgDbOpt]
-  where
-    ver = extractGhcVer pkgDb
-    (noUserPkgDbOpt,pkgDbOpt)
-      | ver < 706 = ("--no-user-package-conf", "--package-conf=" ++ pkgDb)
-      | otherwise = ("--no-user-package-db",   "--package-db="   ++ pkgDb)
-
--- | Extracting GHC version from the path of package db.
---   Exception is thrown if the string argument is incorrect.
---
--- >>> extractGhcVer "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"
--- 706
-extractGhcVer :: String -> Int
-extractGhcVer dir = ver
-  where
-    file = takeFileName dir
-    findVer = drop 4 . head . filter ("ghc-" `isPrefixOf`) . tails
-    (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 . (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 = takeWhile (not . isSpace) . dropWhile isSpace . drop keylen
-
-nameKey :: String
-nameKey = "name:"
-
-idKey :: String
-idKey = "id:"
-
-nameKeyLength :: Int
-nameKeyLength = length nameKey
-
-idKeyLength :: Int
-idKeyLength = length idKey
-
 getSandboxDir :: FilePath -> IO FilePath
 getSandboxDir dir = do
     exist <- doesFileExist sfile
@@ -228,5 +108,5 @@ getSandboxDir dir = do
       else
         getSandboxDir dir'
   where
-    sfile = dir </> configFile
+    sfile = dir </> "cabal.sandbox.config"
     dir' = takeDirectory dir

Language/Haskell/GhcMod/Debug.hs

@@ -51,7 +51,9 @@ debug opt cradle fileName = do
     cabalFile = fromMaybe "" mCabalFile
     origGopts = ghcOpts opt
     simpleCompilerOption = CompilerOptions origGopts [] []
-    fromCabalFile = parseCabalFile file >>= getCompilerOptions origGopts cradle
+    fromCabalFile = do
+        pkgDesc <- parseCabalFile file
+        getCompilerOptions origGopts cradle pkgDesc
       where
         file = fromJust mCabalFile
 

Language/Haskell/GhcMod/GHCApi.hs

@@ -11,6 +11,11 @@ module Language.Haskell.GhcMod.GHCApi (
   , getSystemLibDir
   ) where
 
+import Language.Haskell.GhcMod.CabalApi
+import Language.Haskell.GhcMod.ErrMsg
+import Language.Haskell.GhcMod.GHCChoice
+import Language.Haskell.GhcMod.GhcPkg
+
 import Control.Applicative (Alternative, (<$>))
 import Control.Monad (void, forM)
 import CoreMonad (liftIO)
@@ -20,10 +25,6 @@ import DynFlags (dopt_set)
 import Exception (ghandle, SomeException(..))
 import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..))
 import qualified GHC as G
-import Language.Haskell.GhcMod.CabalApi
-import Language.Haskell.GhcMod.Cradle (userPackageDbOptsForGhc)
-import Language.Haskell.GhcMod.ErrMsg
-import Language.Haskell.GhcMod.GHCChoice
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Types
 import System.Exit (exitSuccess)
@@ -89,10 +90,10 @@ initializeFlagsWithCradle opt cradle ghcopts logging
         logger <- initSession SingleFile opt compOpts logging
         return (logger, Nothing)
       where
-        pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle
+        pkgOpts = ghcDbStackOpts $ cradlePkgDbStack cradle
         compOpts
-          | null pkgDb = CompilerOptions ghcopts importDirs []
+          | null pkgOpts = CompilerOptions ghcopts importDirs []
-          | otherwise  = CompilerOptions (ghcopts ++ pkgDb) [wdir,rdir] []
+          | otherwise    = CompilerOptions (ghcopts ++ pkgOpts) [wdir,rdir] []
         wdir = cradleCurrentDir cradle
         rdir = cradleRootDir    cradle
 

Language/Haskell/GhcMod/GhcPkg.hs

@@ -0,0 +1,165 @@
+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
+module Language.Haskell.GhcMod.GhcPkg (
+    ghcPkgList
+  , ghcPkgDbOpt
+  , ghcPkgDbStackOpts
+  , ghcDbStackOpts
+  , ghcDbOpt
+  , getSandboxDb
+  , getPackageDbStack
+  , getPackageDbPackages
+  ) where
+
+import Language.Haskell.GhcMod.Types
+
+import Control.Applicative ((<$>))
+import Control.Exception (SomeException(..))
+import qualified Control.Exception as E
+--import Control.Exception.IOChoice ((||>))
+import Data.Char (isSpace)
+import Data.List (isPrefixOf, tails)
+import System.FilePath ((</>), takeFileName)
+import System.Process (readProcess)
+
+-- | Get path to sandbox package db
+getSandboxDb :: FilePath -- ^ Path to the cabal package root directory
+                         -- (containing the @cabal.sandbox.config@ file)
+             -> IO FilePath
+getSandboxDb cdir =
+    getSandboxDbDir (cdir </> "cabal.sandbox.config")
+
+-- | Extract the sandbox package db directory from the cabal.sandbox.config file.
+--   Exception is thrown if the sandbox config file is broken.
+getSandboxDbDir :: FilePath -- ^ Path to the @cabal.sandbox.config@ file
+                -> IO FilePath
+getSandboxDbDir sconf = do
+    -- Be strict to ensure that an error can be caught.
+    !path <- extractValue . parse <$> readFile sconf
+    return path
+  where
+    key = "package-db:"
+    keyLen = length key
+
+    parse = head . filter (key `isPrefixOf`) . lines
+    extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop keyLen
+    -- dropWhileEnd is not provided prior to base 4.5.0.0.
+    dropWhileEnd :: (a -> Bool) -> [a] -> [a]
+    dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
+
+-- | Get a list of packages from the global, user or cabal sandbox package
+-- database.
+--
+--   If a sandbox exists this will return packages from the global package db
+--   and the sandbox, otherwise packages from the global and user package db are
+--   returned.
+getPackageDbPackages :: FilePath -- ^ Project Directory (where the
+                                 -- cabal.sandbox.config file would be if it
+                                 -- exists)
+                     -> IO [PackageBaseName]
+getPackageDbPackages cdir =
+    ghcPkgList =<< getPackageDbStack cdir
+
+getPackageDbStack :: FilePath -- ^ Project Directory (where the
+                                 -- cabal.sandbox.config file would be if it
+                                 -- exists)
+                  -> IO [GhcPkgDb]
+getPackageDbStack cdir =
+    (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db])
+      `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb]
+
+
+-- | List packages in one or more ghc package stores
+ghcPkgList :: [GhcPkgDb] -> IO [PackageBaseName]
+ghcPkgList dbs =
+    words <$> readProcess "ghc-pkg" opts ""
+  where
+    opts =
+        ["--simple-output", "--names-only", "list"]
+          ++ ghcPkgDbStackOpts dbs
+
+-- | Get options needed to add a list of package dbs to ghc-pkg's db stack
+ghcPkgDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
+                  -> [String]
+ghcPkgDbStackOpts dbs = (ghcPkgDbOpt `concatMap` dbs)
+
+-- | Get options needed to add a list of package dbs to ghc's db stack
+ghcDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
+                  -> [String]
+ghcDbStackOpts dbs = (ghcDbOpt `concatMap` dbs)
+
+
+ghcPkgDbOpt :: GhcPkgDb -> [String]
+ghcPkgDbOpt GlobalDb = ["--global"]
+ghcPkgDbOpt UserDb   = ["--user"]
+ghcPkgDbOpt (PackageDb pkgDb) =
+    [noUserPkgDbOpt, pkgDbOpt]
+  where
+    ver = extractGhcVer pkgDb
+    (noUserPkgDbOpt,pkgDbOpt)
+      | ver < 706 = ("--no-user-package-conf", "--package-conf=" ++ pkgDb)
+      | otherwise = ("--no-user-package-db",   "--package-db="   ++ pkgDb)
+
+ghcDbOpt :: GhcPkgDb -> [String]
+ghcDbOpt GlobalDb = ["-global-package-db"]
+ghcDbOpt UserDb   = ["-user-package-db"]
+ghcDbOpt (PackageDb pkgDb) =
+    [noUserPkgDbOpt, pkgDbOpt, pkgDb]
+  where
+    ver = extractGhcVer pkgDb
+    (noUserPkgDbOpt,pkgDbOpt)
+      | ver < 706 = ("-no-user-package-conf", "-package-conf")
+      | otherwise = ("-no-user-package-db",   "-package-db")
+
+-- | Extracting GHC version from the path of package db.
+--   Exception is thrown if the string argument is incorrect.
+--
+-- >>> extractGhcVer "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"
+-- 706
+extractGhcVer :: String -> Int
+extractGhcVer dir = ver
+  where
+    file = takeFileName dir
+    findVer = drop 4 . head . filter ("ghc-" `isPrefixOf`) . tails
+    (verStr1,_:left) = break (== '.') $ findVer file
+    (verStr2,_)      = break (== '.') left
+    ver = read verStr1 * 100 + read verStr2
+
+
+-- 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 . (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 = takeWhile (not . isSpace) . dropWhile isSpace . drop keylen
+
+-- nameKey :: String
+-- nameKey = "name:"
+
+-- idKey :: String
+-- idKey = "id:"
+
+-- nameKeyLength :: Int
+-- nameKeyLength = length nameKey
+
+-- idKeyLength :: Int
+-- idKeyLength = length idKey

Language/Haskell/GhcMod/Internal.hs

@@ -7,9 +7,6 @@ module Language.Haskell.GhcMod.Internal (
   , Package
   , IncludeDir
   , CompilerOptions(..)
-  -- * Cradle
-  , userPackageDbOptsForGhc
-  , userPackageDbOptsForGhcPkg
   -- * Cabal API
   , parseCabalFile
   , getCompilerOptions
@@ -38,7 +35,6 @@ module Language.Haskell.GhcMod.Internal (
 
 import Language.Haskell.GhcMod.Browse
 import Language.Haskell.GhcMod.CabalApi
-import Language.Haskell.GhcMod.Cradle
 import Language.Haskell.GhcMod.ErrMsg
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.GHCChoice

Language/Haskell/GhcMod/PkgDoc.hs

@@ -1,8 +1,9 @@
 module Language.Haskell.GhcMod.PkgDoc (packageDoc) where
 
-import Control.Applicative ((<$>))
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Cradle
+import Language.Haskell.GhcMod.GhcPkg
+
+import Control.Applicative ((<$>))
 import System.Process (readProcess)
 
 -- | Obtaining the package name and the doc path of a module.
@@ -22,6 +23,8 @@ pkgDoc cradle mdl = do
         let ret = pkg ++ " " ++ drop 14 htmlpath
         return ret
   where
-    toModuleOpts = ["find-module", mdl, "--simple-output"] ++ userPackageDbOptsForGhcPkg (cradlePackageDb cradle)
+    toModuleOpts = ["find-module", mdl, "--simple-output"]
-    toDocDirOpts pkg = ["field", pkg, "haddock-html"] ++ userPackageDbOptsForGhcPkg (cradlePackageDb cradle)
+                   ++ ghcPkgDbStackOpts (cradlePkgDbStack cradle)
+    toDocDirOpts pkg = ["field", pkg, "haddock-html"]
+                       ++ ghcPkgDbStackOpts (cradlePkgDbStack cradle)
     trim = takeWhile (`notElem` " \n")

Language/Haskell/GhcMod/Types.hs

@@ -88,14 +88,17 @@ data Cradle = Cradle {
   , cradleRootDir    :: FilePath
   -- | The file name of the found cabal file.
   , cradleCabalFile  :: Maybe FilePath
-  -- | User package db. (\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\")
+  -- | Package database stack
-  , cradlePackageDb  :: Maybe FilePath
+  , cradlePkgDbStack  :: [GhcPkgDb]
-  -- | Dependent packages.
+  -- | Package dependencies
   , cradlePackages   :: [Package]
   } deriving (Eq, Show)
 
 ----------------------------------------------------------------
 
+-- | GHC package database flags.
+data GhcPkgDb = GlobalDb | UserDb | PackageDb String deriving (Eq, Show)
+
 -- | A single GHC command line option.
 type GHCOption  = String
 

ghc-mod.cabal

@@ -54,6 +54,7 @@ Library
                         Language.Haskell.GhcMod.ErrMsg
                         Language.Haskell.GhcMod.Flag
                         Language.Haskell.GhcMod.GHCApi
+                        Language.Haskell.GhcMod.GhcPkg
                         Language.Haskell.GhcMod.GHCChoice
                         Language.Haskell.GhcMod.Gap
                         Language.Haskell.GhcMod.Info
@@ -117,10 +118,11 @@ Test-Suite doctest
 
 Test-Suite spec
   Default-Language:     Haskell2010
-  Main-Is:              Spec.hs
+  Main-Is:              Main.hs
   Hs-Source-Dirs:       test, .
   Type:                 exitcode-stdio-1.0
   Other-Modules:        Dir
+                        Spec
                         BrowseSpec
                         CabalApiSpec
                         CheckSpec
@@ -129,6 +131,7 @@ Test-Suite spec
                         LangSpec
                         LintSpec
                         ListSpec
+                        GhcPkgSpec
   Build-Depends:        base >= 4.0 && < 5
                       , containers
                       , directory

test/CabalApiSpec.hs

@@ -9,6 +9,8 @@ import Language.Haskell.GhcMod.CabalApi
 import Language.Haskell.GhcMod.Cradle
 import Language.Haskell.GhcMod.Types
 import Test.Hspec
+import System.Directory
+import System.FilePath
 
 import Dir
 
@@ -20,6 +22,7 @@ spec = do
 
     describe "getCompilerOptions" $ do
         it "gets necessary CompilerOptions" $ do
+            cwd <- getCurrentDirectory
             withDirectory "test/data/subdir1/subdir2" $ \dir -> do
                 cradle <- findCradle
                 pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle
@@ -28,7 +31,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", Nothing), ("base", Nothing) , ("template-haskell", Nothing)]}
+                res' `shouldBe` CompilerOptions {ghcOptions = ["-global-package-db", "-no-user-package-db","-package-db",cwd </> "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

@@ -4,7 +4,7 @@ import Control.Applicative
 import Data.List (isSuffixOf)
 import Language.Haskell.GhcMod.Cradle
 import Language.Haskell.GhcMod.Types
-import System.Directory (canonicalizePath)
+import System.Directory (canonicalizePath,getCurrentDirectory)
 import System.FilePath ((</>), pathSeparator)
 import Test.Hspec
 
@@ -21,17 +21,18 @@ spec = do
                     cradleCurrentDir = curDir
                   , cradleRootDir    = curDir
                   , cradleCabalFile  = Nothing
-                  , cradlePackageDb  = Nothing
+                  , cradlePkgDbStack = [GlobalDb]
                   , cradlePackages   = []
                   }
         it "finds a cabal file and a sandbox" $ do
+            cwd <- getCurrentDirectory
             withDirectory "test/data/subdir1/subdir2" $ \dir -> do
                 res <- relativeCradle dir <$> findCradle
                 res `shouldBe` Cradle {
                     cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
                   , cradleRootDir    = "test" </> "data"
                   , cradleCabalFile  = Just ("test" </> "data" </> "cabalapi.cabal")
-                  , cradlePackageDb  = Just ("test" </> "data" </> ".cabal-sandbox" </> "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
+                  , cradlePkgDbStack = [GlobalDb, PackageDb (cwd </> "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
@@ -41,23 +42,10 @@ spec = do
                     cradleCurrentDir = "test" </> "data" </> "broken-sandbox"
                   , cradleRootDir    = "test" </> "data" </> "broken-sandbox"
                   , cradleCabalFile  = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
-                  , cradlePackageDb  = Nothing
+                  , cradlePkgDbStack = [GlobalDb, UserDb]
                   , cradlePackages   = []
                   }
 
-    describe "getPackageDbDir" $ do
-        it "parses a config file and extracts package db" $ do
-            pkgDb <- getPackageDbDir "test/data/cabal.sandbox.config"
-            pkgDb `shouldBe` "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"
-
-        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

test/GhcPkgSpec.hs

@@ -0,0 +1,27 @@
+module GhcPkgSpec where
+
+import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.GhcPkg
+
+import Control.Applicative
+import System.Directory
+import System.FilePath ((</>))
+import Test.Hspec
+
+import Dir
+
+spec :: Spec
+spec = do
+    describe "getSandboxDb" $ do
+        it "parses a config file and extracts sandbox package db" $ do
+            cwd <- getCurrentDirectory
+            pkgDb <- getSandboxDb "test/data/"
+            pkgDb `shouldBe` (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
+
+        it "throws an error if a config file is broken" $ do
+            getSandboxDb "test/data/broken-sandbox" `shouldThrow` anyException
+
+    describe "getPackageDbPackages" $ do
+        it "find a config file and extracts packages" $ do
+            pkgs <- getPackageDbPackages "test/data/check-packageid"
+            pkgs `shouldSatisfy` (\x -> length x >= 1)

test/Main.hs

@@ -0,0 +1,12 @@
+import Spec
+import Dir
+
+import Test.Hspec
+import System.Process
+
+main = do
+  let sandboxes = [ "test/data", "test/data/check-packageid" ]
+      genSandboxCfg dir = withDirectory dir $ \cwd -> do
+         system ("sed 's|@CWD@|" ++ cwd ++ "|g' cabal.sandbox.config.in > cabal.sandbox.config")
+  genSandboxCfg `mapM` sandboxes
+  hspec spec

test/Spec.hs

@@ -1 +1 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}

test/data/cabal.sandbox.config.in

@@ -4,15 +4,15 @@
 -- if you want to change the default settings for this sandbox.
 
 
-local-repo: /home/me/work/ghc-mod/test/data/.cabal-sandbox/packages
+local-repo: @CWD@/test/data/.cabal-sandbox/packages
-logs-dir: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs
+logs-dir: @CWD@/test/data/.cabal-sandbox/logs
-world-file: /home/me/work/ghc-mod/test/data/.cabal-sandbox/world
+world-file: @CWD@/test/data/.cabal-sandbox/world
 user-install: False
-package-db: /home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d
+package-db: @CWD@/test/data/.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
+build-summary: @CWD@/test/data/.cabal-sandbox/logs/build.log
 
-install-dirs 
+install-dirs
-  prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox
+  prefix: @CWD@/test/data/.cabal-sandbox
   bindir: $prefix/bin
   libdir: $prefix/lib
   libsubdir: $arch-$os-$compiler/$pkgid

test/data/check-packageid/cabal.sandbox.config.in

@@ -4,15 +4,15 @@
 -- if you want to change the default settings for this sandbox.
 
 
-local-repo: /home/me/work/ghc-mod/test/data/.cabal-sandbox/packages
+local-repo: @CWD@/test/data/.cabal-sandbox/packages
-logs-dir: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs
+logs-dir: @CWD@/test/data/.cabal-sandbox/logs
-world-file: /home/me/work/ghc-mod/test/data/.cabal-sandbox/world
+world-file: @CWD@/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
+build-summary: @CWD@/test/data/.cabal-sandbox/logs/build.log
 
-install-dirs 
+install-dirs
-  prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox
+  prefix: @CWD@/test/data/.cabal-sandbox
   bindir: $prefix/bin
   libdir: $prefix/lib
   libsubdir: $arch-$os-$compiler/$pkgid