aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Haddock/Backends/Xhtml.hs4
-rw-r--r--src/Haddock/Backends/Xhtml/Names.hs6
-rw-r--r--src/Haddock/Interface/Create.hs45
-rw-r--r--src/Haddock/Options.hs4
-rw-r--r--src/Haddock/Types.hs16
5 files changed, 48 insertions, 27 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index fc94e7d6..94ca6d10 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -468,9 +468,9 @@ ppHtmlModule odir doctitle themes
maybe_contents_url maybe_index_url unicode qual debug iface = do
let
mdl = ifaceMod iface
- abbrevs = ifaceModuleAbbrevs iface
+ aliases = ifaceModuleAliases iface
mdl_str = moduleString mdl
- real_qual = makeModuleQual qual abbrevs mdl
+ real_qual = makeModuleQual qual aliases mdl
html =
headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++
bodyHtml doctitle (Just iface)
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 88ba14dc..48d0f7f1 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -79,10 +79,10 @@ ppQualifyName qual name mdl =
Just _ -> ppFullQualName mdl name
-- some other module, D.x -> D.x
Nothing -> ppFullQualName mdl name
- AbbreviateQual abbrevs localmdl ->
+ AliasedQual aliases localmdl ->
case (moduleString mdl == moduleString localmdl,
- M.lookup (moduleName mdl) abbrevs) of
- (False, Just abbrev) -> ppQualName abbrev name
+ M.lookup mdl aliases) of
+ (False, Just alias) -> ppQualName alias name
_ -> ppName name
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
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 792c0be3..46f9def7 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -126,7 +126,7 @@ options backwardsCompat =
Option ['t'] ["title"] (ReqArg Flag_Heading "TITLE")
"page heading",
Option ['q'] ["qual"] (ReqArg Flag_Qualification "QUAL")
- "qualification of names, one of \n'none' (default), 'full', 'local'\n'relative' or 'abbreviate'",
+ "qualification of names, one of \n'none' (default), 'full', 'local'\n'relative' or 'aliased'",
Option ['?'] ["help"] (NoArg Flag_Help)
"display this help and exit",
Option ['V'] ["version"] (NoArg Flag_Version)
@@ -237,7 +237,7 @@ qualification flags =
["full"] -> Right OptFullQual
["local"] -> Right OptLocalQual
["relative"] -> Right OptRelativeQual
- ["abbreviate"] -> Right OptAbbreviateQual
+ ["aliased"] -> Right OptAliasedQual
[arg] -> Left $ "unknown qualification type " ++ show arg
_:_ -> Left "qualification option given multiple times"
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 2195faf5..97d56a52 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -103,8 +103,8 @@ data Interface = Interface
-- module.
, ifaceVisibleExports :: ![Name]
- -- | Abbreviations of module imports as in @import A.B.C as C@.
- , ifaceModuleAbbrevs :: AbbreviationMap
+ -- | Aliases of module imports as in @import A.B.C as C@.
+ , ifaceModuleAliases :: AliasMap
-- | Instances exported by the module.
, ifaceInstances :: ![Instance]
@@ -383,21 +383,21 @@ data QualOption
| OptLocalQual -- ^ Qualify all imported names fully.
| OptRelativeQual -- ^ Like local, but strip module prefix
-- from modules in the same hierarchy.
- | OptAbbreviateQual -- ^ Uses abbreviations of module names
+ | OptAliasedQual -- ^ Uses aliases of module names
-- as suggested by module import renamings.
-- However, we are unfortunately not able
-- to maintain the original qualifications.
-- Image a re-export of a whole module,
-- how could the re-exported identifiers be qualified?
-type AbbreviationMap = Map ModuleName ModuleName
+type AliasMap = Map Module ModuleName
data Qualification
= NoQual
| FullQual
| LocalQual Module
| RelativeQual Module
- | AbbreviateQual AbbreviationMap Module
+ | AliasedQual AliasMap Module
-- ^ @Module@ contains the current module.
-- This way we can distinguish imported and local identifiers.
@@ -407,12 +407,12 @@ makeContentsQual qual =
OptNoQual -> NoQual
_ -> FullQual
-makeModuleQual :: QualOption -> AbbreviationMap -> Module -> Qualification
-makeModuleQual qual abbrevs mdl =
+makeModuleQual :: QualOption -> AliasMap -> Module -> Qualification
+makeModuleQual qual aliases mdl =
case qual of
OptLocalQual -> LocalQual mdl
OptRelativeQual -> RelativeQual mdl
- OptAbbreviateQual -> AbbreviateQual abbrevs mdl
+ OptAliasedQual -> AliasedQual aliases mdl
OptFullQual -> FullQual
OptNoQual -> NoQual
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-16 03:29:36 +0000