From 5f0fcd044263142422c4c98a65ce227f6be538bc Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Fri, 20 Sep 2013 17:15:41 +0900 Subject: [PATCH] getCompilerOptions handles package-db options. --- Language/Haskell/GhcMod/CabalApi.hs | 9 +++-- Language/Haskell/GhcMod/Cradle.hs | 59 +++++++++++++++++++++-------- Language/Haskell/GhcMod/Debug.hs | 9 ++--- Language/Haskell/GhcMod/Types.hs | 4 +- src/GHCMod.hs | 21 ++-------- test/CabalApiSpec.hs | 7 +++- test/CradleSpec.hs | 24 ++++++------ test/DebugSpec.hs | 5 +-- 8 files changed, 76 insertions(+), 62 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index b7a89e1..33c78c5 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/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 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 diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index c532bf3..dede047 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/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 - , 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 \ No newline at end of file + 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 diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index 946e223..3b3bbac 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 489bc46..6ac01f9 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/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-\.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) ---------------------------------------------------------------- diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 4de9ae2..82e8c51 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -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"] diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index a1e4969..63a3458 100644 --- a/test/CabalApiSpec.hs +++ b/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) } - 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 diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index 4598055..8d3320e 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -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) } diff --git a/test/DebugSpec.hs b/test/DebugSpec.hs index 15f8958..8331c6e 100644 --- a/test/DebugSpec.hs +++ b/test/DebugSpec.hs @@ -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