aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/Xhtml/Names.hs2
-rw-r--r--src/Haddock/Interface/Create.hs41
-rw-r--r--src/Haddock/Types.hs2
3 files changed, 33 insertions, 12 deletions
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 88ba14dc..863e5f90 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -81,7 +81,7 @@ ppQualifyName qual name mdl =
Nothing -> ppFullQualName mdl name
AbbreviateQual abbrevs localmdl ->
case (moduleString mdl == moduleString localmdl,
- M.lookup (moduleName mdl) abbrevs) of
+ M.lookup mdl abbrevs) of
(False, Just abbrev) -> ppQualName abbrev name
_ -> ppName name
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 9f183432..b9ca6d8c 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,16 +110,7 @@ createInterface tm flags modMap instIfaceMap = do
| 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
+ mkAbbrevMap dflags $ tm_renamed_source tm
return Interface {
ifaceMod = mdl,
@@ -141,6 +134,34 @@ createInterface tm flags modMap instIfaceMap = do
ifaceHaddockCoverage = coverage
}
+mkAbbrevMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
+mkAbbrevMap dflags mRenamedSource =
+ case mRenamedSource of
+ Nothing -> M.empty
+ Just (_,impDecls,_,_) ->
+ M.fromList $
+ mapMaybe (\(SrcLoc.L _ impDecl) -> do
+ abbrev <- ideclAs impDecl
+ return $
+ (lookupModuleDyn dflags
+ (fmap Module.fsToPackageId $
+ ideclPkgQual impDecl)
+ (case ideclName impDecl of SrcLoc.L _ name -> name),
+ abbrev))
+ 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
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 2195faf5..7a6d7bb9 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -390,7 +390,7 @@ data QualOption
-- Image a re-export of a whole module,
-- how could the re-exported identifiers be qualified?
-type AbbreviationMap = Map ModuleName ModuleName
+type AbbreviationMap = Map Module ModuleName
data Qualification
= NoQual