getCompilerOptions handles package-db options.

Language/Haskell/GhcMod/CabalApi.hs

@@ -36,7 +36,7 @@ import System.FilePath
 -- | Getting necessary 'CompilerOptions' from three information sources.
 getCompilerOptions :: [GHCOption] -> Cradle -> PackageDescription -> IO CompilerOptions
 getCompilerOptions ghcopts cradle pkgDesc = do
-    gopts <- getGHCOptions ghcopts cdir $ head buildInfos
+    gopts <- getGHCOptions ghcopts cradle cdir $ head buildInfos
     return $ CompilerOptions gopts idirs depPkgs
   where
     wdir       = cradleCurrentDir cradle
@@ -96,12 +96,13 @@ parseCabalFile file = do
 
 ----------------------------------------------------------------
 
-getGHCOptions :: [GHCOption] -> FilePath -> BuildInfo -> IO [GHCOption]
+getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption]
-getGHCOptions ghcopts cdir binfo = do
+getGHCOptions ghcopts cradle cdir binfo = do
     cabalCpp <- cabalCppOptions cdir
     let cpps = map ("-optP" ++) $ cppOptions binfo ++ cabalCpp
-    return $ ghcopts ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps
+    return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps
   where
+    pkgDb = cradlePackageDbOpts cradle
     lang = maybe "-XHaskell98" (("-X" ++) . display) $ defaultLanguage binfo
     libDirs = map ("-L" ++) $ extraLibDirs binfo
     exts = map (("-X" ++) . display) $ usedExtensions binfo

Language/Haskell/GhcMod/Cradle.hs

@@ -4,10 +4,10 @@ import Data.Char (isSpace)
 import Control.Applicative ((<$>))
 import Control.Exception as E (catch, throwIO, SomeException)
 import Control.Monad (filterM)
-import Data.List (isPrefixOf, isSuffixOf)
+import Data.List (isPrefixOf, isSuffixOf, tails)
 import Language.Haskell.GhcMod.Types
 import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist)
-import System.FilePath ((</>),takeDirectory)
+import System.FilePath ((</>), takeDirectory, takeFileName)
 
 ----------------------------------------------------------------
 
@@ -22,21 +22,21 @@ findCradle = do
   where
     handler :: FilePath -> SomeException -> IO Cradle
     handler wdir _ = return Cradle {
-        cradleCurrentDir  = wdir
+        cradleCurrentDir    = wdir
-      , cradleCabalDir    = Nothing
+      , cradleCabalDir      = Nothing
-      , cradleCabalFile   = Nothing
+      , cradleCabalFile     = Nothing
-      , cradlePackageConf = Nothing
+      , cradlePackageDbOpts = []
       }
 
 findCradle' :: FilePath -> IO Cradle
 findCradle' wdir = do
     (cdir,cfile) <- cabalDir wdir
-    mPkgConf <- getPackageDbDir cdir
+    pkgDbOpts <- getPackageDbOpts cdir
     return Cradle {
-        cradleCurrentDir  = wdir
+        cradleCurrentDir    = wdir
-      , cradleCabalDir    = Just cdir
+      , cradleCabalDir      = Just cdir
-      , cradleCabalFile   = Just cfile
+      , cradleCabalFile     = Just cfile
-      , cradlePackageConf = mPkgConf
+      , cradlePackageDbOpts = pkgDbOpts
       }
 
 ----------------------------------------------------------------
@@ -81,11 +81,40 @@ pkgDbKeyLen :: Int
 pkgDbKeyLen = length pkgDbKey
 
 -- | Extract a package db directory from the sandbox config file.
-getPackageDbDir :: FilePath -> IO (Maybe FilePath)
+getPackageDbOpts :: FilePath -> IO [GHCOption]
-getPackageDbDir cdir = (Just <$> getPkgDb) `E.catch` handler
+getPackageDbOpts cdir = (sandboxArguments <$> getPkgDb ) `E.catch` handler
   where
     getPkgDb = extractValue . parse <$> readFile (cdir </> configFile)
     parse = head . filter ("package-db:" `isPrefixOf`) . lines
     extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen
-    handler :: SomeException -> IO (Maybe FilePath)
+    handler :: SomeException -> IO [GHCOption]
-    handler _ = return Nothing
+    handler _ = return []
+
+-- | Adding necessary GHC options to the package db.
+--   Exception is thrown if the string argument is incorrect.
+--
+-- >>> sandboxArguments "/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"
+-- ["-no-user-package-conf","-package-conf","/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"]
+sandboxArguments :: FilePath -> [String]
+sandboxArguments pkgDb = [noUserPkgDbOpt, pkgDbOpt, pkgDb]
+  where
+    ver = extractGhcVer pkgDb
+    (pkgDbOpt,noUserPkgDbOpt)
+      | ver < 706 = ("-package-conf","-no-user-package-conf")
+      | otherwise = ("-package-db",  "-no-user-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

Language/Haskell/GhcMod/Debug.hs

@@ -17,18 +17,16 @@ import Prelude
 -- | Obtaining debug information.
 debugInfo :: Options
           -> Cradle
-          -> GHCVersion
           -> FilePath   -- ^ A target file.
           -> IO String
-debugInfo opt cradle ver fileName = unlines <$> withGHC fileName (debug opt cradle ver fileName)
+debugInfo opt cradle fileName = unlines <$> withGHC fileName (debug opt cradle fileName)
 
 -- | Obtaining debug information.
 debug :: Options
       -> Cradle
-      -> GHCVersion
       -> FilePath     -- ^ A target file.
       -> Ghc [String]
-debug opt cradle ver fileName = do
+debug opt cradle fileName = do
     CompilerOptions gopts incDir pkgs <-
         if cabal then
             liftIO (fromCabalFile ||> return simpleCompilerOption)
@@ -39,8 +37,7 @@ debug opt cradle ver fileName = do
         setTargetFiles [fileName]
         pure . canCheckFast <$> depanal [] False
     return [
-        "GHC version:         " ++ ver
+        "Current directory:   " ++ currentDir
-      , "Current directory:   " ++ currentDir
       , "Cabal file:          " ++ cabalFile
       , "GHC options:         " ++ unwords gopts
       , "Include directories: " ++ unwords incDir

Language/Haskell/GhcMod/Types.hs

@@ -82,8 +82,8 @@ data Cradle = Cradle {
   , cradleCabalDir    :: Maybe FilePath
   -- | The file name of the found cabal file.
   , cradleCabalFile   :: Maybe FilePath
-  -- | The sandbox directory. (e.g. \"\/foo\/bar\/packages-\<ver\>.conf/\")
+  -- | The package db options. ([\"-no-user-package-db\",\"-package-db\",\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\"])
-  , cradlePackageConf :: Maybe FilePath
+  , cradlePackageDbOpts :: [GHCOption]
   } deriving (Eq, Show)
 
 ----------------------------------------------------------------

src/GHCMod.hs

@@ -84,11 +84,9 @@ main = flip catches handlers $ do
     hSetEncoding stdout utf8
 -- #endif
     args <- getArgs
-    let (opt',cmdArg) = parseArgs argspec args
+    let (opt,cmdArg) = parseArgs argspec args
-    (strVer,ver) <- getGHCVersion
     cradle <- findCradle
-    let opt = adjustOpts opt' cradle ver
+    let cmdArg0 = cmdArg !. 0
-        cmdArg0 = cmdArg !. 0
         cmdArg1 = cmdArg !. 1
         cmdArg2 = cmdArg !. 2
         cmdArg3 = cmdArg !. 3
@@ -102,7 +100,7 @@ main = flip catches handlers $ do
       "list"   -> listModules opt
       "check"  -> checkSyntax opt cradle remainingArgs
       "expand" -> checkSyntax opt { expandSplice = True } cradle remainingArgs
-      "debug"  -> nArgs 1 $ debugInfo opt cradle strVer cmdArg1
+      "debug"  -> nArgs 1 $ debugInfo opt cradle cmdArg1
       "type"   -> nArgs 4 $ typeExpr opt cradle cmdArg1 cmdArg2 (read cmdArg3) (read cmdArg4)
       "info"   -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg2 cmdArg3
       "lint"   -> nArgs 1 withFile (lintSyntax opt) cmdArg1
@@ -145,13 +143,6 @@ main = flip catches handlers $ do
     xs !. idx
       | length xs <= idx = throw SafeList
       | otherwise = xs !! idx
-    adjustOpts opt cradle ver = case mPkgConf of
-            Nothing      -> opt
-            Just pkgConf -> opt {
-                ghcOpts = ghcPackageConfOptions ver pkgConf ++ ghcOpts opt
-              }
-      where
-        mPkgConf = cradlePackageConf cradle
 
 ----------------------------------------------------------------
 
@@ -166,9 +157,3 @@ preBrowsedModules = [
   , "Data.Maybe"
   , "System.IO"
   ]
-
-
-ghcPackageConfOptions :: Int -> String -> [String]
-ghcPackageConfOptions ver file
-  | ver >= 706 = ["-package-db",   file, "-no-user-package-db"]
-  | otherwise  = ["-package-conf", file, "-no-user-package-conf"]

test/CabalApiSpec.hs

@@ -24,8 +24,11 @@ spec = do
                 cradle <- findCradle
                 pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle
                 res <- getCompilerOptions [] cradle pkgDesc
-                let res' = res { includeDirs = map (toRelativeDir dir) (includeDirs res) }
+                let res' = res {
-                res' `shouldBe` CompilerOptions {ghcOptions = ["-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/subdir1/subdir2","test/data/test"], depPackages = ["Cabal","base","template-haskell"]}
+                        ghcOptions  = map (toRelativeDir dir) (ghcOptions res)
+                      , includeDirs = map (toRelativeDir dir) (includeDirs res)
+                      }
+                res' `shouldBe` CompilerOptions {ghcOptions = ["-no-user-package-db","-package-db","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"]}
 
     describe "cabalDependPackages" $ do
         it "extracts dependent packages" $ do

test/CradleSpec.hs

@@ -16,26 +16,26 @@ spec = do
                 curDir <- canonicalizePath "/"
                 res <- findCradle
                 res `shouldBe` Cradle {
-                    cradleCurrentDir = curDir
+                    cradleCurrentDir    = curDir
-                  , cradleCabalDir = Nothing
+                  , cradleCabalDir      = Nothing
-                  , cradleCabalFile = Nothing
+                  , cradleCabalFile     = Nothing
-                  , cradlePackageConf = Nothing
+                  , cradlePackageDbOpts = []
                   }
 
         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")
-                  , cradlePackageConf = Just ("test" </> "data" </> ".cabal-sandbox" </> "i386-osx-ghc-7.6.3-packages.conf.d")
+                  , cradlePackageDbOpts = ["-no-user-package-db", "-package-db", "test" </> "data" </> ".cabal-sandbox" </> "i386-osx-ghc-7.6.3-packages.conf.d"]
                   }
 
 relativeCradle :: FilePath -> Cradle -> Cradle
 relativeCradle dir cradle = Cradle {
-    cradleCurrentDir  = toRelativeDir dir  $  cradleCurrentDir  cradle
+    cradleCurrentDir    = toRelativeDir dir  $  cradleCurrentDir    cradle
-  , cradleCabalDir    = toRelativeDir dir <$> cradleCabalDir    cradle
+  , cradleCabalDir      = toRelativeDir dir <$> cradleCabalDir      cradle
-  , cradleCabalFile   = toRelativeDir dir <$> cradleCabalFile   cradle
+  , cradleCabalFile     = toRelativeDir dir <$> cradleCabalFile     cradle
-  , cradlePackageConf = toRelativeDir dir <$> cradlePackageConf cradle
+  , cradlePackageDbOpts = map (toRelativeDir dir) (cradlePackageDbOpts cradle)
   }

test/DebugSpec.hs

@@ -7,9 +7,8 @@ import Dir
 
 checkFast :: String -> String -> IO ()
 checkFast file ans = withDirectory_ "test/data" $ do
-    (strVer,_) <- getGHCVersion
+    let cradle = Cradle "." Nothing Nothing []
-    cradle <- findCradle
+    res <- debugInfo defaultOptions cradle file
-    res <- debugInfo defaultOptions cradle strVer file
     lines res `shouldContain` [ans]
 
 spec :: Spec