getCompilerOptions handles package-db options.
This commit is contained in:
parent
46245fb694
commit
5f0fcd0442
@ -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 ghcopts cdir binfo = do
|
||||
getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption]
|
||||
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
|
||||
|
@ -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
|
||||
, cradleCabalDir = Nothing
|
||||
, cradleCabalFile = Nothing
|
||||
, cradlePackageConf = Nothing
|
||||
cradleCurrentDir = wdir
|
||||
, cradleCabalDir = Nothing
|
||||
, cradleCabalFile = Nothing
|
||||
, cradlePackageDbOpts = []
|
||||
}
|
||||
|
||||
findCradle' :: FilePath -> IO Cradle
|
||||
findCradle' wdir = do
|
||||
(cdir,cfile) <- cabalDir wdir
|
||||
mPkgConf <- getPackageDbDir cdir
|
||||
pkgDbOpts <- getPackageDbOpts cdir
|
||||
return Cradle {
|
||||
cradleCurrentDir = wdir
|
||||
, cradleCabalDir = Just cdir
|
||||
, cradleCabalFile = Just cfile
|
||||
, cradlePackageConf = mPkgConf
|
||||
cradleCurrentDir = wdir
|
||||
, cradleCabalDir = Just cdir
|
||||
, cradleCabalFile = Just cfile
|
||||
, 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)
|
||||
getPackageDbDir cdir = (Just <$> getPkgDb) `E.catch` handler
|
||||
getPackageDbOpts :: FilePath -> IO [GHCOption]
|
||||
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 _ = return Nothing
|
||||
handler :: SomeException -> IO [GHCOption]
|
||||
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
|
||||
|
@ -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
|
||||
|
@ -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/\")
|
||||
, cradlePackageConf :: 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]
|
||||
} deriving (Eq, Show)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
@ -84,11 +84,9 @@ main = flip catches handlers $ do
|
||||
hSetEncoding stdout utf8
|
||||
-- #endif
|
||||
args <- getArgs
|
||||
let (opt',cmdArg) = parseArgs argspec args
|
||||
(strVer,ver) <- getGHCVersion
|
||||
let (opt,cmdArg) = parseArgs argspec args
|
||||
cradle <- findCradle
|
||||
let opt = adjustOpts opt' cradle ver
|
||||
cmdArg0 = cmdArg !. 0
|
||||
let 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"]
|
||||
|
@ -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) }
|
||||
res' `shouldBe` CompilerOptions {ghcOptions = ["-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/subdir1/subdir2","test/data/test"], depPackages = ["Cabal","base","template-haskell"]}
|
||||
let res' = res {
|
||||
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
|
||||
|
@ -16,26 +16,26 @@ spec = do
|
||||
curDir <- canonicalizePath "/"
|
||||
res <- findCradle
|
||||
res `shouldBe` Cradle {
|
||||
cradleCurrentDir = curDir
|
||||
, cradleCabalDir = Nothing
|
||||
, cradleCabalFile = Nothing
|
||||
, cradlePackageConf = Nothing
|
||||
cradleCurrentDir = curDir
|
||||
, cradleCabalDir = Nothing
|
||||
, cradleCabalFile = 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"
|
||||
, cradleCabalDir = Just ("test" </> "data")
|
||||
, cradleCabalFile = Just ("test" </> "data" </> "cabalapi.cabal")
|
||||
, cradlePackageConf = Just ("test" </> "data" </> ".cabal-sandbox" </> "i386-osx-ghc-7.6.3-packages.conf.d")
|
||||
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" </> "i386-osx-ghc-7.6.3-packages.conf.d"]
|
||||
}
|
||||
|
||||
relativeCradle :: FilePath -> Cradle -> Cradle
|
||||
relativeCradle dir cradle = Cradle {
|
||||
cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle
|
||||
, cradleCabalDir = toRelativeDir dir <$> cradleCabalDir cradle
|
||||
, cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle
|
||||
, cradlePackageConf = toRelativeDir dir <$> cradlePackageConf cradle
|
||||
cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle
|
||||
, cradleCabalDir = toRelativeDir dir <$> cradleCabalDir cradle
|
||||
, cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle
|
||||
, cradlePackageDbOpts = map (toRelativeDir dir) (cradlePackageDbOpts cradle)
|
||||
}
|
||||
|
@ -7,9 +7,8 @@ import Dir
|
||||
|
||||
checkFast :: String -> String -> IO ()
|
||||
checkFast file ans = withDirectory_ "test/data" $ do
|
||||
(strVer,_) <- getGHCVersion
|
||||
cradle <- findCradle
|
||||
res <- debugInfo defaultOptions cradle strVer file
|
||||
let cradle = Cradle "." Nothing Nothing []
|
||||
res <- debugInfo defaultOptions cradle file
|
||||
lines res `shouldContain` [ans]
|
||||
|
||||
spec :: Spec
|
||||
|
Loading…
Reference in New Issue
Block a user