From b2d254243587187d1a165b441e7aa319f971dc84 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 29 May 2013 17:47:52 +0900 Subject: [PATCH] Using PackageDescription instead of GenericPackageDescription. This enables to pick conditional dependency in a cabal file. --- Language/Haskell/GhcMod/CabalApi.hs | 113 +++++++++++++--------------- 1 file changed, 52 insertions(+), 61 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index bf8a414..d990f1c 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -3,25 +3,27 @@ module Language.Haskell.GhcMod.CabalApi ( fromCabalFile , cabalParseFile - , cabalBuildInfo , cabalAllDependPackages , cabalAllSourceDirs , 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.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 @@ -32,32 +34,42 @@ fromCabalFile :: [GHCOption] -> 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 + 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 -- FIXME + 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 +cabalParseFile :: FilePath -> IO PackageDescription +cabalParseFile file = do + cid <- getGHCId + epgd <- readPackageDescription silent file + case toPkgDesc cid epgd of + Left _ -> throwIO $ userError "cabal file is broken" + Right (pd,_) -> return pd -- FIXME check empty + where + toPkgDesc cid = finalizePackageDescription [] (const True) buildPlatform cid [] ---------------------------------------------------------------- @@ -71,55 +83,26 @@ getGHCOptions ghcOptions binfo = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs ---------------------------------------------------------------- -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 ---------------------------------------------------------------- @@ -130,14 +113,22 @@ uniqueAndSort = toList . fromList -- | 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