diff --git a/CabalApi.hs b/CabalApi.hs --- a/CabalApi.hs +++ b/CabalApi.hs @@ -12,7 +12,7 @@ import Control.Applicative import Control.Exception (throwIO) import Data.List (intercalate) -import Data.Maybe (fromJust, maybeToList) +import Data.Maybe (maybeToList, listToMaybe) import Data.Set (fromList, toList) import Distribution.Package (Dependency(Dependency), PackageName(PackageName)) import Distribution.PackageDescription @@ -30,21 +30,23 @@ fromCabalFile :: [GHCOption] -> Cradle -> IO ([GHCOption],[IncludeDir],[Package]) -fromCabalFile ghcOptions cradle = - cookInfo ghcOptions cradle <$> cabalParseFile cfile +fromCabalFile ghcOptions cradle = do + cabal <- cabalParseFile cfile + case cabalBuildInfo cabal of + Nothing -> throwIO $ userError "cabal file is broken" + Just binfo -> return $ cookInfo ghcOptions cradle cabal binfo where - Just cfile = cradleCabalFile cradle + Just cfile = cradleCabalFile cradle -cookInfo :: [String] -> Cradle -> GenericPackageDescription - -> ([GHCOption],[IncludeDir],[Package]) -cookInfo ghcOptions cradle cabal = (gopts,idirs,depPkgs) +cookInfo :: [String] -> Cradle -> GenericPackageDescription -> BuildInfo + -> ([GHCOption],[IncludeDir],[Package]) +cookInfo ghcOptions cradle cabal binfo = (gopts,idirs,depPkgs) where - owdir = cradleCurrentDir cradle + wdir = cradleCurrentDir cradle Just cdir = cradleCabalDir cradle Just cfile = cradleCabalFile cradle - binfo = cabalBuildInfo cabal gopts = getGHCOptions ghcOptions binfo - idirs = includeDirectroies cdir owdir $ cabalAllSourceDirs cabal + idirs = includeDirectories cdir wdir $ cabalAllSourceDirs cabal depPkgs = removeMe cfile $ cabalAllDependPackages cabal removeMe :: FilePath -> [String] -> [String] @@ -70,13 +72,11 @@ ---------------------------------------------------------------- -- Causes error, catched in the upper function. -cabalBuildInfo :: GenericPackageDescription -> BuildInfo -cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd +cabalBuildInfo :: GenericPackageDescription -> Maybe BuildInfo +cabalBuildInfo pd = fromLibrary pd <|> fromExecutable pd where - fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c - fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c) - toMaybe [] = Nothing - toMaybe (x:_) = Just x + fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c + fromExecutable c = buildInfo . condTreeData . snd <$> listToMaybe (condExecutables c) ---------------------------------------------------------------- @@ -118,9 +118,9 @@ ---------------------------------------------------------------- -includeDirectroies :: String -> String -> [FilePath] -> [String] -includeDirectroies cdir owdir [] = uniqueAndSort [cdir,owdir] -includeDirectroies cdir owdir dirs = uniqueAndSort (map (cdir ) dirs ++ [owdir]) +includeDirectories :: String -> String -> [FilePath] -> [String] +includeDirectories cdir wdir [] = uniqueAndSort [cdir,wdir] +includeDirectories cdir wdir dirs = uniqueAndSort (map (cdir ) dirs ++ [cdir,wdir]) ---------------------------------------------------------------- diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,7 @@ 2013-04-02 v1.12.4 * C-M-d on Emacs now can browse functions and types. - * Checking "QuasiQuotes" as well ass "TemplateHaskell". (@eagletmt) + * Checking "QuasiQuotes" as well as "TemplateHaskell". (@eagletmt) * "ghc-mod info" can display info of non-exported functions. (@mvoidex) diff --git a/Cradle.hs b/Cradle.hs --- a/Cradle.hs +++ b/Cradle.hs @@ -16,15 +16,15 @@ cfiles <- cabalDir wdir return $ case cfiles of Nothing -> Cradle { - cradleCurrentDir = wdir - , cradleCabalDir = Nothing - , cradleCabalFile = Nothing + cradleCurrentDir = wdir + , cradleCabalDir = Nothing + , cradleCabalFile = Nothing , cradlePackageConf = Just pkgConf } Just (cdir,cfile) -> Cradle { - cradleCurrentDir = wdir - , cradleCabalDir = Just cdir - , cradleCabalFile = Just cfile + cradleCurrentDir = wdir + , cradleCabalDir = Just cdir + , cradleCabalFile = Just cfile , cradlePackageConf = Just pkgConf } findCradle Nothing strver = do diff --git a/Debug.hs b/Debug.hs --- a/Debug.hs +++ b/Debug.hs @@ -2,6 +2,7 @@ import CabalApi import Control.Applicative +import Control.Exception.IOChoice import Control.Monad import Data.List (intercalate) import Data.Maybe @@ -19,7 +20,7 @@ debug opt cradle ver fileName = do (gopts, incDir, pkgs) <- if cabal then - fromCabalFile (ghcOpts opt) cradle + fromCabalFile (ghcOpts opt) cradle ||> return (ghcOpts opt, [], []) else return (ghcOpts opt, [], []) [fast] <- withGHC fileName $ do diff --git a/GHCApi.hs b/GHCApi.hs --- a/GHCApi.hs +++ b/GHCApi.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} + module GHCApi ( withGHC , withGHCDummyFile @@ -20,6 +22,7 @@ import ErrMsg import Exception import GHC +import GHCChoice import GHC.Paths (libdir) import System.Exit import System.IO @@ -50,13 +53,15 @@ initializeFlagsWithCradle :: Options -> Cradle -> [GHCOption] -> Bool -> Ghc LogReader initializeFlagsWithCradle opt cradle ghcOptions logging - | cabal = do - (gopts,idirs,depPkgs) <- liftIO $ fromCabalFile ghcOptions cradle - initSession CabalPkg opt gopts idirs (Just depPkgs) logging - | otherwise = - initSession SingleFile opt ghcOptions importDirs Nothing logging + | cabal = withCabal ||> withoutCabal + | otherwise = withoutCabal where cabal = isJust $ cradleCabalFile cradle + withCabal = do + (gopts,idirs,depPkgs) <- liftIO $ fromCabalFile ghcOptions cradle + initSession CabalPkg opt gopts idirs (Just depPkgs) logging + withoutCabal = + initSession SingleFile opt ghcOptions importDirs Nothing logging ---------------------------------------------------------------- @@ -164,4 +169,4 @@ canCheckFast = not . any (hasTHorQQ . ms_hspp_opts) where hasTHorQQ :: DynFlags -> Bool - hasTHorQQ dflags = any (\opt -> xopt opt dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes] + hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes] diff --git a/GHCMod.hs b/GHCMod.hs --- a/GHCMod.hs +++ b/GHCMod.hs @@ -168,5 +168,5 @@ ghcPackageConfOptions :: Int -> String -> [String] ghcPackageConfOptions ver file - | ver >= 706 = ["-package-db", file, "-no-user-package-conf"] + | ver >= 706 = ["-package-db", file, "-no-user-package-db"] | otherwise = ["-package-conf", file, "-no-user-package-conf"] diff --git a/ghc-mod.cabal b/ghc-mod.cabal --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -1,5 +1,5 @@ Name: ghc-mod -Version: 1.12.4 +Version: 1.12.5 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -20,4 +20,8 @@ it "extracts build info" $ do info <- cabalBuildInfo <$> cabalParseFile "test/data/cabalapi.cabal" let infoStr = show info - infoStr `shouldBe` "BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = []}" + infoStr `shouldBe` "Just (BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = []})" + + it "returns Nothing if the cabal file is broken" $ do + info <- cabalBuildInfo <$> cabalParseFile "test/data/broken-cabal/broken.cabal" + info `shouldBe` Nothing