hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

This commit is contained in:
Kazu Yamamoto 2014-03-28 12:05:11 +09:00
parent 1f7e7dea3b
commit 955b1b4091
6 changed files with 69 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Language/Haskell/GhcMod/CabalApi.hs
View File

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

67
Language/Haskell/GhcMod/Cradle.hs
View File

@ -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
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageDbOpts = []
, cradlePackages = []
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageDb = Nothing
, cradlePackages = []
}
findCradle' :: FilePath -> IO Cradle
findCradle' wdir = do
(cdir,cfile) <- cabalDir wdir
pkgDbOpts <- getPackageDbOpts cdir
pkgDbOpts <- getPackageDb cdir
return Cradle {
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageDbOpts = pkgDbOpts
, cradlePackages = []
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageDb = pkgDbOpts
, 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]
getPackageDbOpts cdir = (sandboxArguments <$> getPkgDb) `E.catch` handler
getPackageDb :: FilePath -> IO (Maybe FilePath)
getPackageDb cdir = (Just <$> getPkgDb) `E.catch` handler
where
getPkgDb = getPackageDbDir (cdir </> configFile)
handler :: SomeException -> IO [GHCOption]
handler _ = return []
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.
@ -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.
-- Exception is thrown if the string argument is incorrect.
-- | Creating user package db options for GHC.
--
-- >>> 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]
sandboxArguments pkgDb = [noUserPkgDbOpt, pkgDbOpt, pkgDb]
userPackageDbOptsForGhc :: Maybe FilePath -> [String]
userPackageDbOptsForGhc Nothing = []
userPackageDbOptsForGhc (Just 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")
(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.

4
Language/Haskell/GhcMod/Internal.hs
View File

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

7
Language/Haskell/GhcMod/PkgDoc.hs
View File

@ -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')

4
Language/Haskell/GhcMod/Types.hs
View File

@ -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\"])
, cradlePackageDbOpts :: [GHCOption]
-- | User package db. (\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\")
, cradlePackageDb :: Maybe FilePath
-- | Dependent packages.
, cradlePackages :: [Package]
} deriving (Eq, Show)

30
test/CradleSpec.hs
View File

@ -18,31 +18,31 @@ spec = do
curDir <- stripLastDot <$> canonicalizePath "/"
res <- findCradle
res `shouldBe` Cradle {
cradleCurrentDir = curDir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageDbOpts = []
, cradlePackages = []
cradleCurrentDir = curDir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageDb = Nothing
, 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"
, 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 = []
cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
, cradleCabalDir = Just ("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")
, 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"
, cradleCabalDir = Just ("test" </> "data" </> "broken-sandbox")
, cradleCabalFile = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
, cradlePackageDbOpts = []
, cradlePackages = []
cradleCurrentDir = "test" </> "data" </> "broken-sandbox"
, cradleCabalDir = Just ("test" </> "data" </> "broken-sandbox")
, cradleCabalFile = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
, cradlePackageDb = Nothing
, cradlePackages = []
}
describe "getPackageDbDir" $ do