Read depend packages from *.cabal, and adjust compiler package flags.

This commit is contained in:
Kei Hibino 2012-10-24 09:11:09 +09:00
parent e5a2628dfa
commit ff9fa49141
4 changed files with 57 additions and 10 deletions

View File

@ -2,6 +2,7 @@
module Cabal (initializeGHC) where
import CabalApi (dependPackages)
import Control.Applicative
import Control.Exception
import Control.Monad
@ -29,7 +30,7 @@ initializeGHC :: Options -> FilePath -> [String] -> Bool -> Ghc (FilePath,LogRea
initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
where
withoutCabal = do
logReader <- initSession opt ghcOptions importDirs logging
logReader <- initSession opt ghcOptions importDirs Nothing logging
return (fileName,logReader)
withCabal = do
(owdir,cdir,cfile) <- liftIO getDirs
@ -42,7 +43,8 @@ initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
idirs = case hsSourceDirs of
[] -> [cdir,owdir]
dirs -> map (cdir </>) dirs ++ [owdir]
logReader <- initSession opt gopts idirs logging
depPkgs <- liftIO $ dependPackages cfile
logReader <- initSession opt gopts idirs (Just depPkgs) logging
return (fileName,logReader)
addX = ("-X" ++)

39
CabalApi.hs Normal file
View File

@ -0,0 +1,39 @@
module CabalApi (dependPackages) where
import Data.Maybe (maybeToList)
import Data.Set (fromList, toList)
import Distribution.Verbosity (silent)
import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
import Distribution.PackageDescription
(GenericPackageDescription,
condLibrary, condExecutables, condTestSuites, condBenchmarks,
CondTree, condTreeConstraints)
import Distribution.PackageDescription.Parse (readPackageDescription)
----------------------------------------------------------------
parseGenericDescription :: FilePath -> IO GenericPackageDescription
parseGenericDescription = readPackageDescription silent
getDepsOfPairs :: [(a1, CondTree v [b] a)] -> [b]
getDepsOfPairs = concatMap (condTreeConstraints . snd)
allDependsOfDescription :: GenericPackageDescription -> [Dependency]
allDependsOfDescription pd =
concat [depLib, depExe, depTests, depBench]
where
depLib = concatMap condTreeConstraints (maybeToList . condLibrary $ pd)
depExe = getDepsOfPairs . condExecutables $ pd
depTests = getDepsOfPairs . condTestSuites $ pd
depBench = getDepsOfPairs . condBenchmarks $ pd
getDependencyPackageName :: Dependency -> String
getDependencyPackageName (Dependency (PackageName n) _) = n
dependPackages :: FilePath -> IO [String]
dependPackages =
fmap (toList . fromList
. map getDependencyPackageName
. allDependsOfDescription)
. parseGenericDescription

View File

@ -31,29 +31,33 @@ initSession0 :: Options -> Ghc [PackageId]
initSession0 opt = getSessionDynFlags >>=
(>>= setSessionDynFlags) . setGhcFlags opt
initSession :: Options -> [String] -> [FilePath] -> Bool -> Ghc LogReader
initSession opt cmdOpts idirs logging = do
initSession :: Options -> [String] -> [FilePath] -> Maybe [String] -> Bool -> Ghc LogReader
initSession opt cmdOpts idirs mayPkgs logging = do
dflags <- getSessionDynFlags
let opts = map noLoc cmdOpts
(dflags',_,_) <- parseDynamicFlags dflags opts
(dflags'',readLog) <- liftIO . (>>= setLogger logging) . setGhcFlags opt . setFlags opt dflags' $ idirs
(dflags'',readLog) <- liftIO . (>>= setLogger logging)
. setGhcFlags opt . setFlags opt dflags' idirs $ mayPkgs
_ <- setSessionDynFlags dflags''
return readLog
----------------------------------------------------------------
setFlags :: Options -> DynFlags -> [FilePath] -> DynFlags
setFlags opt d idirs
setFlags :: Options -> DynFlags -> [FilePath] -> Maybe [String] -> DynFlags
setFlags opt d idirs mayPkgs
| expandSplice opt = dopt_set d' Opt_D_dump_splices
| otherwise = d'
where
d' = d {
packageFlags = ghcPackage : packageFlags d
, importPaths = idirs
d' = maySetExpose $ d {
importPaths = idirs
, ghcLink = LinkInMemory
, hscTarget = HscInterpreted
, flags = flags d
}
-- Do hide-all only when depend packages specified
maySetExpose df = maybe df (\x -> (dopt_set df Opt_HideAllPackages) {
packageFlags = map ExposePackage x ++ packageFlags df
}) mayPkgs
ghcPackage :: PackageFlag
ghcPackage = ExposePackage "ghc"

View File

@ -28,6 +28,7 @@ Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
Executable ghc-mod
Main-Is: GHCMod.hs
Other-Modules: Browse
CabalApi
Cabal
CabalDev
Check
@ -45,6 +46,7 @@ Executable ghc-mod
GHC-Options: -Wall
Build-Depends: base >= 4.0 && < 5
, Cabal
, containers
, convertible
, directory
, filepath