user package db options for both GHC and ghc-pkg.

Language/Haskell/GhcMod/CabalApi.hs

@@ -31,6 +31,7 @@ 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, (</>))
 
@@ -113,7 +114,7 @@ getGHCOptions ghcopts cradle cdir binfo = do
     let cpps = map ("-optP" ++) $ P.cppOptions binfo ++ cabalCpp
     return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps
   where
-    pkgDb = cradlePackageDbOpts cradle
+    pkgDb = userPackageDbOptsForGhc $ cradlePackageDb 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

@@ -5,6 +5,8 @@ module Language.Haskell.GhcMod.Cradle (
   , findCradleWithoutSandbox
   , getPackageDbDir
   , getPackageDbPackages
+  , userPackageDbOptsForGhc
+  , userPackageDbOptsForGhcPkg
   ) where
 
 import Control.Applicative ((<$>))
@@ -30,30 +32,30 @@ findCradle = do
   where
     handler :: FilePath -> SomeException -> IO Cradle
     handler wdir _ = return Cradle {
-        cradleCurrentDir    = wdir
+        cradleCurrentDir = wdir
-      , cradleCabalDir      = Nothing
+      , cradleCabalDir   = Nothing
-      , cradleCabalFile     = Nothing
+      , cradleCabalFile  = Nothing
-      , cradlePackageDbOpts = []
+      , cradlePackageDb  = Nothing
-      , cradlePackages      = []
+      , cradlePackages   = []
       }
 
 findCradle' :: FilePath -> IO Cradle
 findCradle' wdir = do
     (cdir,cfile) <- cabalDir wdir
-    pkgDbOpts <- getPackageDbOpts cdir
+    pkgDbOpts <- getPackageDb cdir
     return Cradle {
-        cradleCurrentDir    = wdir
+        cradleCurrentDir = wdir
-      , cradleCabalDir      = Just cdir
+      , cradleCabalDir   = Just cdir
-      , cradleCabalFile     = Just cfile
+      , cradleCabalFile  = Just cfile
-      , cradlePackageDbOpts = pkgDbOpts
+      , cradlePackageDb  = pkgDbOpts
-      , cradlePackages      = []
+      , cradlePackages   = []
       }
 
 -- Just for testing
 findCradleWithoutSandbox :: IO Cradle
 findCradleWithoutSandbox = do
     cradle <- findCradle
-    return cradle { cradlePackageDbOpts = [], cradlePackages = [] }
+    return cradle { cradlePackageDb = Nothing, cradlePackages = [] }
 
 ----------------------------------------------------------------
 
@@ -97,12 +99,12 @@ pkgDbKeyLen :: Int
 pkgDbKeyLen = length pkgDbKey
 
 -- | Obtaining GHC options relating to a package db directory
-getPackageDbOpts :: FilePath -> IO [GHCOption]
+getPackageDb :: FilePath -> IO (Maybe FilePath)
-getPackageDbOpts cdir = (sandboxArguments <$> getPkgDb) `E.catch` handler
+getPackageDb cdir = (Just <$> getPkgDb) `E.catch` handler
   where
     getPkgDb = getPackageDbDir (cdir </> configFile)
-    handler :: SomeException -> IO [GHCOption]
+    handler :: SomeException -> IO (Maybe FilePath)
-    handler _ = return []
+    handler _ = return Nothing
 
 -- | Extract a package db directory from the sandbox config file.
 --   Exception is thrown if the sandbox config file is broken.
@@ -118,20 +120,35 @@ getPackageDbDir sconf = do
     dropWhileEnd :: (a -> Bool) -> [a] -> [a]
     dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
 
--- | Adding necessary GHC options to the package db.
+-- | Creating user package db options for GHC.
---   Exception is thrown if the string argument is incorrect.
 --
--- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"
+-- >>> 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"]
--- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.4.1-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"]
-sandboxArguments :: FilePath -> [String]
+userPackageDbOptsForGhc :: Maybe FilePath -> [String]
-sandboxArguments pkgDb = [noUserPkgDbOpt, pkgDbOpt, pkgDb]
+userPackageDbOptsForGhc Nothing      = []
+userPackageDbOptsForGhc (Just pkgDb) = [noUserPkgDbOpt, pkgDbOpt, pkgDb]
   where
     ver = extractGhcVer pkgDb
-    (pkgDbOpt,noUserPkgDbOpt)
+    (noUserPkgDbOpt,pkgDbOpt)
-      | ver < 706 = ("-package-conf","-no-user-package-conf")
+      | ver < 706 = ("-no-user-package-conf", "-package-conf")
-      | otherwise = ("-package-db",  "-no-user-package-db")
+      | 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.

Language/Haskell/GhcMod/Internal.hs

@@ -7,6 +7,9 @@ module Language.Haskell.GhcMod.Internal (
   , Package
   , IncludeDir
   , CompilerOptions(..)
+  -- * Cradle
+  , userPackageDbOptsForGhc
+  , userPackageDbOptsForGhcPkg
   -- * Cabal API
   , parseCabalFile
   , getCompilerOptions
@@ -35,6 +38,7 @@ 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

@@ -2,6 +2,7 @@ module Language.Haskell.GhcMod.PkgDoc (packageDoc) where
 
 import Control.Applicative ((<$>))
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Cradle
 import System.Process (readProcess)
 
 -- | Obtaining the package name and the doc path of a module.
@@ -17,10 +18,10 @@ pkgDoc cradle mdl = do
     if pkg == "" then
         return "\n"
       else do
-        htmlpath <- readProcess "ghc-pkg" ["field", pkg, "haddock-html"] []
+        htmlpath <- readProcess "ghc-pkg" (toDocDirOpts pkg) []
         let ret = pkg ++ " " ++ drop 14 htmlpath
         return ret
   where
-    toModuleOpts = ["find-module", "--simple-output"] ++ cradlePackageDbOpts cradle ++ [mdl]
+    toModuleOpts = ["find-module", mdl, "--simple-output"] ++ userPackageDbOptsForGhcPkg (cradlePackageDb cradle)
+    toDocDirOpts pkg = ["field", pkg, "haddock-html"] ++ userPackageDbOptsForGhcPkg (cradlePackageDb cradle)
     trim = takeWhile (/= '\n')
-

Language/Haskell/GhcMod/Types.hs

@@ -88,8 +88,8 @@ data Cradle = Cradle {
   , cradleCabalDir    :: Maybe FilePath
   -- | The file name of the found cabal file.
   , cradleCabalFile   :: Maybe FilePath
-  -- | The package db options. ([\"-no-user-package-db\",\"-package-db\",\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\"])
+  -- | User package db. (\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\")
-  , cradlePackageDbOpts :: [GHCOption]
+  , cradlePackageDb :: Maybe FilePath
   -- | Dependent packages.
   , cradlePackages :: [Package]
   } deriving (Eq, Show)

test/CradleSpec.hs

@@ -18,31 +18,31 @@ spec = do
                 curDir <- stripLastDot <$> canonicalizePath "/"
                 res <- findCradle
                 res `shouldBe` Cradle {
-                    cradleCurrentDir    = curDir
+                    cradleCurrentDir = curDir
-                  , cradleCabalDir      = Nothing
+                  , cradleCabalDir   = Nothing
-                  , cradleCabalFile     = Nothing
+                  , cradleCabalFile  = Nothing
-                  , cradlePackageDbOpts = []
+                  , cradlePackageDb  = Nothing
-                  , cradlePackages      = []
+                  , cradlePackages   = []
                   }
         it "finds a cabal file and a sandbox" $ do
             withDirectory "test/data/subdir1/subdir2" $ \dir -> do
                 res <- relativeCradle dir <$> findCradle
                 res `shouldBe` Cradle {
-                    cradleCurrentDir    = "test" </> "data" </> "subdir1" </> "subdir2"
+                    cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
-                  , cradleCabalDir      = Just ("test" </> "data")
+                  , cradleCabalDir   = Just ("test" </> "data")
-                  , cradleCabalFile     = Just ("test" </> "data" </> "cabalapi.cabal")
+                  , 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"]
+                  , cradlePackageDb  = Just ("test" </> "data" </> ".cabal-sandbox" </> "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
-                  , cradlePackages      = []
+                  , cradlePackages   = []
                   }
         it "works even if a sandbox config file is broken" $ do
             withDirectory "test/data/broken-sandbox" $ \dir -> do
                 res <- relativeCradle dir <$> findCradle
                 res `shouldBe` Cradle {
-                    cradleCurrentDir    = "test" </> "data" </> "broken-sandbox"
+                    cradleCurrentDir = "test" </> "data" </> "broken-sandbox"
-                  , cradleCabalDir      = Just ("test" </> "data" </> "broken-sandbox")
+                  , cradleCabalDir   = Just ("test" </> "data" </> "broken-sandbox")
-                  , cradleCabalFile     = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
+                  , cradleCabalFile  = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
-                  , cradlePackageDbOpts = []
+                  , cradlePackageDb  = Nothing
-                  , cradlePackages      = []
+                  , cradlePackages   = []
                   }
 
     describe "getPackageDbDir" $ do