diff --git a/Cradle.hs b/Cradle.hs index 0987f12..2462bac 100644 --- a/Cradle.hs +++ b/Cradle.hs @@ -1,6 +1,5 @@ module Cradle where -import CabalApi (getGHCVersion) import Control.Applicative ((<$>)) import Control.Exception (throwIO) import Control.Monad @@ -10,11 +9,9 @@ import System.FilePath ((),takeDirectory) import Types -- An error would be thrown -findCradle :: Maybe FilePath -> IO Cradle -findCradle (Just sbox) = do - (strver, ver) <- getGHCVersion - conf <- checkPackageConf sbox strver - let confOpts = ghcPackageConfOptions ver conf +findCradle :: Maybe FilePath -> String -> IO Cradle +findCradle (Just sbox) strver = do + pkgConf <- checkPackageConf sbox strver wdir <- getCurrentDirectory cfiles <- cabalDir wdir return $ case cfiles of @@ -22,39 +19,33 @@ findCradle (Just sbox) = do cradleCurrentDir = wdir , cradleCabalDir = Nothing , cradleCabalFile = Nothing - , cradlePackageConfOpts = Just confOpts - , cradleGHCVersion = strver + , cradlePackageConf = Just pkgConf } Just (cdir,cfile) -> Cradle { cradleCurrentDir = wdir , cradleCabalDir = Just cdir , cradleCabalFile = Just cfile - , cradlePackageConfOpts = Just confOpts - , cradleGHCVersion = strver + , cradlePackageConf = Just pkgConf } -findCradle Nothing = do - (strver, ver) <- getGHCVersion +findCradle Nothing strver = do wdir <- getCurrentDirectory cfiles <- cabalDir wdir case cfiles of Nothing -> return Cradle { - cradleCurrentDir = wdir - , cradleCabalDir = Nothing - , cradleCabalFile = Nothing - , cradlePackageConfOpts = Nothing - , cradleGHCVersion = strver + cradleCurrentDir = wdir + , cradleCabalDir = Nothing + , cradleCabalFile = Nothing + , cradlePackageConf = Nothing } Just (cdir,cfile) -> do let sbox = cdir "cabal-dev/" - conf = packageConfName sbox strver - confOpts = ghcPackageConfOptions ver conf - exist <- doesFileExist conf + pkgConf = packageConfName sbox strver + exist <- doesFileExist pkgConf return Cradle { - cradleCurrentDir = wdir - , cradleCabalDir = Just cdir - , cradleCabalFile = Just cfile - , cradlePackageConfOpts = if exist then Just confOpts else Nothing - , cradleGHCVersion = strver + cradleCurrentDir = wdir + , cradleCabalDir = Just cdir + , cradleCabalFile = Just cfile + , cradlePackageConf = if exist then Just pkgConf else Nothing } cabalDir :: FilePath -> IO (Maybe (FilePath,FilePath)) @@ -80,8 +71,3 @@ checkPackageConf path ver = do return conf else throwIO $ userError $ conf ++ " not found" - -ghcPackageConfOptions :: Int -> String -> [String] -ghcPackageConfOptions ver file - | ver >= 706 = ["-package-db", file, "-no-user-package-conf"] - | otherwise = ["-package-conf", file, "-no-user-package-conf"] diff --git a/Debug.hs b/Debug.hs index 556e436..8e4bb8f 100644 --- a/Debug.hs +++ b/Debug.hs @@ -10,11 +10,11 @@ import Types ---------------------------------------------------------------- -debugInfo :: Options -> Cradle -> String -> IO String -debugInfo opt cradle fileName = unlines <$> debug opt cradle fileName +debugInfo :: Options -> Cradle -> String -> String -> IO String +debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName -debug :: Options -> Cradle -> String -> IO [String] -debug opt cradle fileName = do +debug :: Options -> Cradle -> String -> String -> IO [String] +debug opt cradle ver fileName = do (gopts, incDir, pkgs, langext) <- if cabal then fromCabalFile (ghcOpts opt) cradle @@ -23,7 +23,7 @@ debug opt cradle fileName = do dflags <- getDynamicFlags fast <- getFastCheck dflags fileName (Just langext) return [ - "GHC version: " ++ ghcVer + "GHC version: " ++ ver , "Current directory: " ++ currentDir , "Cabal file: " ++ cabalFile , "GHC options: " ++ intercalate " " gopts @@ -32,7 +32,6 @@ debug opt cradle fileName = do , "Fast check: " ++ if fast then "Yes" else "No" ] where - ghcVer = cradleGHCVersion cradle currentDir = cradleCurrentDir cradle cabal = isJust $ cradleCabalFile cradle cabalFile = fromMaybe "" $ cradleCabalFile cradle diff --git a/GHCMod.hs b/GHCMod.hs index 441f49c..6ddcf93 100644 --- a/GHCMod.hs +++ b/GHCMod.hs @@ -3,6 +3,7 @@ module Main where import Browse +import CabalApi import Check import Control.Applicative import Control.Exception @@ -87,8 +88,9 @@ main :: IO () main = flip catches handlers $ do args <- getArgs let (opt',cmdArg) = parseArgs argspec args - cradle <- findCradle $ sandbox opt' - let opt = ajustOpts opt' cradle + (strVer,ver) <- getGHCVersion + cradle <- findCradle (sandbox opt') strVer + let opt = adjustOpts opt' cradle ver cmdArg0 = cmdArg !. 0 cmdArg1 = cmdArg !. 1 cmdArg2 = cmdArg !. 2 @@ -99,7 +101,7 @@ main = flip catches handlers $ do "list" -> listModules opt "check" -> withFile (checkSyntax opt cradle) cmdArg1 "expand" -> withFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1 - "debug" -> withFile (debugInfo opt cradle) cmdArg1 + "debug" -> withFile (debugInfo opt cradle strVer) cmdArg1 "type" -> withFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1 "info" -> withFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1 "lint" -> withFile (lintSyntax opt) cmdArg1 @@ -137,11 +139,13 @@ main = flip catches handlers $ do xs !. idx | length xs <= idx = throw SafeList | otherwise = xs !! idx - ajustOpts opt cradle = case mpkgopts of + adjustOpts opt cradle ver = case mPkgConf of Nothing -> opt - Just pkgopts -> opt { ghcOpts = pkgopts ++ ghcOpts opt } + Just pkgConf -> opt { + ghcOpts = ghcPackageConfOptions ver pkgConf ++ ghcOpts opt + } where - mpkgopts = cradlePackageConfOpts cradle + mPkgConf = cradlePackageConf cradle ---------------------------------------------------------------- @@ -156,3 +160,9 @@ preBrowsedModules = [ , "Data.Maybe" , "System.IO" ] + + +ghcPackageConfOptions :: Int -> String -> [String] +ghcPackageConfOptions ver file + | ver >= 706 = ["-package-db", file, "-no-user-package-conf"] + | otherwise = ["-package-conf", file, "-no-user-package-conf"] diff --git a/Types.hs b/Types.hs index 33d2e31..2df9317 100644 --- a/Types.hs +++ b/Types.hs @@ -65,11 +65,10 @@ addNewLine = (++ "\n") ---------------------------------------------------------------- data Cradle = Cradle { - cradleCurrentDir :: FilePath - , cradleCabalDir :: Maybe FilePath - , cradleCabalFile :: Maybe FilePath - , cradlePackageConfOpts :: Maybe [String] - , cradleGHCVersion :: String + cradleCurrentDir :: FilePath + , cradleCabalDir :: Maybe FilePath + , cradleCabalFile :: Maybe FilePath + , cradlePackageConf :: Maybe FilePath } deriving Show ---------------------------------------------------------------- diff --git a/test/CheckSpec.hs b/test/CheckSpec.hs index 7c43379..20feb20 100644 --- a/test/CheckSpec.hs +++ b/test/CheckSpec.hs @@ -1,5 +1,6 @@ module CheckSpec where +import CabalApi import Check import Cradle import Expectation @@ -11,6 +12,7 @@ spec = do describe "checkSyntax" $ do it "can check even if an executable depends on its library" $ do withDirectory "test/data/ghc-mod-check" $ do - cradle <- findCradle Nothing + (strVer,_) <- getGHCVersion + cradle <- findCradle Nothing strVer res <- checkSyntax defaultOptions cradle "main.hs" res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\NUL\n" diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs index b61b524..cf8ba12 100644 --- a/test/InfoSpec.hs +++ b/test/InfoSpec.hs @@ -1,5 +1,6 @@ module InfoSpec where +import CabalApi import Cradle import Expectation import Info @@ -11,6 +12,7 @@ spec = do describe "typeExpr" $ do it "shows types of the expression and its outers" $ do withDirectory "test/data/ghc-mod-check" $ do - cradle <- findCradle Nothing + (strVer,_) <- getGHCVersion + cradle <- findCradle Nothing strVer res <- typeExpr defaultOptions cradle "Data.Foo" 9 5 "Data/Foo.hs" res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"