aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface/Create.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Interface/Create.hs')
-rw-r--r--src/Haddock/Interface/Create.hs45
1 files changed, 33 insertions, 12 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 80b5a970..ea4636fe 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -30,6 +30,8 @@ import Control.Applicative
import Control.Monad
import qualified Data.Traversable as T
+import qualified Packages
+import qualified Module
import qualified SrcLoc
import GHC hiding (flags)
import HscTypes
@@ -108,17 +110,8 @@ createInterface tm flags modMap instIfaceMap = do
| OptPrune `elem` opts = prunedExportItems0
| otherwise = exportItems
- let abbrevs =
- case tm_renamed_source tm of
- Nothing -> M.empty
- Just (_,impDecls,_,_) ->
- M.fromList $
- mapMaybe (\(SrcLoc.L _ impDecl) -> do
- abbrev <- ideclAs impDecl
- return
- (case ideclName impDecl of SrcLoc.L _ name -> name,
- abbrev))
- impDecls
+ let aliases =
+ mkAliasMap dflags $ tm_renamed_source tm
return Interface {
ifaceMod = mdl,
@@ -137,11 +130,39 @@ createInterface tm flags modMap instIfaceMap = do
ifaceVisibleExports = visibleNames,
ifaceDeclMap = declMap,
ifaceSubMap = subMap,
- ifaceModuleAbbrevs = abbrevs,
+ ifaceModuleAliases = aliases,
ifaceInstances = instances,
ifaceHaddockCoverage = coverage
}
+mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
+mkAliasMap dflags mRenamedSource =
+ case mRenamedSource of
+ Nothing -> M.empty
+ Just (_,impDecls,_,_) ->
+ M.fromList $
+ mapMaybe (\(SrcLoc.L _ impDecl) -> do
+ alias <- ideclAs impDecl
+ return $
+ (lookupModuleDyn dflags
+ (fmap Module.fsToPackageId $
+ ideclPkgQual impDecl)
+ (case ideclName impDecl of SrcLoc.L _ name -> name),
+ alias))
+ impDecls
+
+-- similar to GHC.lookupModule
+lookupModuleDyn ::
+ DynFlags -> Maybe PackageId -> ModuleName -> Module
+lookupModuleDyn _ (Just pkgId) mdlName =
+ Module.mkModule pkgId mdlName
+lookupModuleDyn dflags Nothing mdlName =
+ flip Module.mkModule mdlName $
+ case filter snd $
+ Packages.lookupModuleInAllPackages dflags mdlName of
+ (pkgId,_):_ -> Packages.packageConfigId pkgId
+ [] -> Module.mainPackageId
+
-------------------------------------------------------------------------------
-- Warnings