diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2013-05-30 v2.0.3 + * Using finalizePackageDescription to enable "if else" in a cabal + file. + +2013-05-21 v2.0.2 + * Document fixes. + +2013-05-21 v2.0.1 + * Document fixes. + 2013-05-21 v2.0.0 * ghc-mod also provides a library (Language.Haskell.GhcMod) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -2,26 +2,31 @@ module Language.Haskell.GhcMod.CabalApi ( fromCabalFile - , cabalParseFile - , cabalBuildInfo + , parseCabalFile , cabalAllDependPackages , cabalAllSourceDirs + , cabalAllBuildInfo , getGHCVersion ) where -import Control.Applicative +import Control.Applicative ((<$>)) import Control.Exception (throwIO) import Data.List (intercalate) -import Data.Maybe (maybeToList, listToMaybe) +import Data.Maybe (maybeToList) import Data.Set (fromList, toList) -import Distribution.Package (Dependency(Dependency), PackageName(PackageName)) +import Distribution.Package (Dependency(Dependency) + , PackageName(PackageName) + , PackageIdentifier(pkgName)) import Distribution.PackageDescription +import Distribution.PackageDescription.Configuration (finalizePackageDescription) import Distribution.PackageDescription.Parse (readPackageDescription) +import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..)) import Distribution.Simple.Program (ghcProgram) import Distribution.Simple.Program.Types (programName, programFindVersion) +import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity (silent) -import Distribution.Version (versionBranch) +import Distribution.Version (versionBranch, Version) import Language.Haskell.GhcMod.Types import System.FilePath @@ -31,33 +36,48 @@ -> Cradle -> IO ([GHCOption],[IncludeDir],[Package]) 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 + cabal <- parseCabalFile cfile + return $ cookInfo ghcOptions cradle cabal where Just cfile = cradleCabalFile cradle -cookInfo :: [String] -> Cradle -> GenericPackageDescription -> BuildInfo +cookInfo :: [String] -> Cradle -> PackageDescription -> ([GHCOption],[IncludeDir],[Package]) -cookInfo ghcOptions cradle cabal binfo = (gopts,idirs,depPkgs) +cookInfo ghcOptions cradle cabal = (gopts,idirs,depPkgs) where wdir = cradleCurrentDir cradle Just cdir = cradleCabalDir cradle Just cfile = cradleCabalFile cradle - gopts = getGHCOptions ghcOptions binfo - idirs = includeDirectories cdir wdir $ cabalAllSourceDirs cabal - depPkgs = removeMe cfile $ cabalAllDependPackages cabal + buildInfos = cabalAllBuildInfo cabal + gopts = getGHCOptions ghcOptions $ head buildInfos + idirs = includeDirectories cdir wdir $ cabalAllSourceDirs buildInfos + depPkgs = removeMe cfile $ cabalAllDependPackages buildInfos removeMe :: FilePath -> [String] -> [String] removeMe cabalfile = filter (/= me) where me = dropExtension $ takeFileName cabalfile +includeDirectories :: String -> String -> [FilePath] -> [String] +includeDirectories cdir wdir [] = uniqueAndSort [cdir,wdir] +includeDirectories cdir wdir dirs = uniqueAndSort (map (cdir ) dirs ++ [cdir,wdir]) + ---------------------------------------------------------------- -cabalParseFile :: FilePath -> IO GenericPackageDescription -cabalParseFile = readPackageDescription silent +parseCabalFile :: FilePath -> IO PackageDescription +parseCabalFile file = do + cid <- getGHCId + epgd <- readPackageDescription silent file + case toPkgDesc cid epgd of + Left deps -> throwIO $ userError $ show deps ++ " are not installed" + Right (pd,_) -> if nullPkg pd + then throwIO $ userError $ file ++ " is broken" + else return pd + where + toPkgDesc cid = finalizePackageDescription [] (const True) buildPlatform cid [] + nullPkg pd = name == "" + where + PackageName name = pkgName (package pd) ---------------------------------------------------------------- @@ -71,56 +91,26 @@ ---------------------------------------------------------------- --- Causes error, catched in the upper function. -cabalBuildInfo :: GenericPackageDescription -> Maybe BuildInfo -cabalBuildInfo pd = fromLibrary pd <|> fromExecutable pd +cabalAllBuildInfo :: PackageDescription -> [BuildInfo] +cabalAllBuildInfo pd = libBI ++ execBI ++ testBI ++ benchBI where - fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c - fromExecutable c = buildInfo . condTreeData . snd <$> listToMaybe (condExecutables c) + libBI = map libBuildInfo $ maybeToList $ library pd + execBI = map buildInfo $ executables pd + testBI = map testBuildInfo $ testSuites pd + benchBI = map benchmarkBuildInfo $ benchmarks pd ---------------------------------------------------------------- -cabalAllSourceDirs :: GenericPackageDescription -> [FilePath] -cabalAllSourceDirs = fromPackageDescription (f libBuildInfo) (f buildInfo) (f testBuildInfo) (f benchmarkBuildInfo) - where - f getBuildInfo = concatMap (hsSourceDirs . getBuildInfo . condTreeData) - -cabalAllDependPackages :: GenericPackageDescription -> [Package] -cabalAllDependPackages pd = uniqueAndSort pkgs - where - pkgs = map getDependencyPackageName $ cabalAllDependency pd - -cabalAllDependency :: GenericPackageDescription -> [Dependency] -cabalAllDependency = fromPackageDescription getDeps getDeps getDeps getDeps - where - getDeps :: [Tree a] -> [Dependency] - getDeps = concatMap condTreeConstraints - -getDependencyPackageName :: Dependency -> Package -getDependencyPackageName (Dependency (PackageName nm) _) = nm +cabalAllSourceDirs :: [BuildInfo] -> [FilePath] +cabalAllSourceDirs bis = uniqueAndSort $ concatMap hsSourceDirs bis ---------------------------------------------------------------- -type Tree = CondTree ConfVar [Dependency] - -fromPackageDescription :: ([Tree Library] -> [a]) - -> ([Tree Executable] -> [a]) - -> ([Tree TestSuite] -> [a]) - -> ([Tree Benchmark] -> [a]) - -> GenericPackageDescription - -> [a] -fromPackageDescription f1 f2 f3 f4 pd = lib ++ exe ++ tests ++ bench +cabalAllDependPackages :: [BuildInfo] -> [Package] +cabalAllDependPackages bis = uniqueAndSort $ pkgs where - lib = f1 . maybeToList . condLibrary $ pd - exe = f2 . map snd . condExecutables $ pd - tests = f3 . map snd . condTestSuites $ pd - bench = f4 . map snd . condBenchmarks $ pd - ----------------------------------------------------------------- - -includeDirectories :: String -> String -> [FilePath] -> [String] -includeDirectories cdir wdir [] = uniqueAndSort [cdir,wdir] -includeDirectories cdir wdir dirs = uniqueAndSort (map (cdir ) dirs ++ [cdir,wdir]) + pkgs = map getDependencyPackageName $ concatMap targetBuildDepends bis + getDependencyPackageName (Dependency (PackageName nm) _) = nm ---------------------------------------------------------------- @@ -131,14 +121,22 @@ -- | Getting GHC version. 7.6.3 becames 706 in the second of the result. getGHCVersion :: IO (GHCVersion, Int) -getGHCVersion = ghcVer >>= toTupple +getGHCVersion = toTupple <$> getGHC where - ghcVer = programFindVersion ghcProgram silent (programName ghcProgram) - toTupple Nothing = throwIO $ userError "ghc not found" - toTupple (Just v) - | length vs < 2 = return (verstr, 0) - | otherwise = return (verstr, ver) + toTupple v + | length vs < 2 = (verstr, 0) + | otherwise = (verstr, ver) where vs = versionBranch v ver = (vs !! 0) * 100 + (vs !! 1) verstr = intercalate "." . map show $ vs + +getGHCId :: IO CompilerId +getGHCId = CompilerId GHC <$> getGHC + +getGHC :: IO Version +getGHC = do + mv <- programFindVersion ghcProgram silent (programName ghcProgram) + case mv of + Nothing -> throwIO $ userError "ghc not found" + Just v -> return $ v 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: 2.0.2 +Version: 2.0.3 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -14,7 +14,7 @@ This package includes the ghc-mod command, the ghc-mod library, and Emacs front-end (for historical reasons). - For more information, please see ts home page. + For more information, please see its home page. Category: Development Cabal-Version: >= 1.10 diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -1,27 +1,29 @@ +{-# LANGUAGE ScopedTypeVariables #-} + module CabalApiSpec where import Control.Applicative +import Control.Exception import Language.Haskell.GhcMod.CabalApi import Test.Hspec spec :: Spec spec = do + describe "parseCabalFile" $ do + it "throws an exception if the cabal file is broken" $ do + parseCabalFile "test/data/broken-cabal/broken.cabal" `shouldThrow` (\(e::IOException) -> True) + describe "cabalAllDependPackages" $ do it "extracts dependent packages" $ do - pkgs <- cabalAllDependPackages <$> cabalParseFile "test/data/cabalapi.cabal" + pkgs <- cabalAllDependPackages . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" pkgs `shouldBe` ["Cabal","base","template-haskell"] describe "cabalAllSourceDirs" $ do it "extracts all hs-source-dirs" $ do - dirs <- cabalAllSourceDirs <$> cabalParseFile "test/data/check-test-subdir/check-test-subdir.cabal" + dirs <- cabalAllSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal" dirs `shouldBe` ["src", "test"] describe "cabalBuildInfo" $ do it "extracts build info" $ do - info <- cabalBuildInfo <$> cabalParseFile "test/data/cabalapi.cabal" - let infoStr = show info - 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 + info <- cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" + show info `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 = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]"