diff --git a/Cabal.hs b/Cabal.hs index bad0f36..ae05b45 100644 --- a/Cabal.hs +++ b/Cabal.hs @@ -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" ++) diff --git a/CabalApi.hs b/CabalApi.hs new file mode 100644 index 0000000..48d57bc --- /dev/null +++ b/CabalApi.hs @@ -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 diff --git a/GHCApi.hs b/GHCApi.hs index 34f9d4c..337f879 100644 --- a/GHCApi.hs +++ b/GHCApi.hs @@ -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" diff --git a/ghc-mod.cabal b/ghc-mod.cabal index 5d33566..7e16dc8 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -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