From c3d370ad042eeeb9f8afc3bf3e99cbbcb9407d60 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Mon, 2 Apr 2012 00:19:36 +0200 Subject: abbreviated qualification: use Packages.lookupModuleInAllPackages for finding the package that a module belongs to --- src/Haddock/Backends/Xhtml/Names.hs | 2 +- src/Haddock/Interface/Create.hs | 41 ++++++++++++++++++++++++++++--------- src/Haddock/Types.hs | 2 +- 3 files changed, 33 insertions(+), 12 deletions(-) (limited to 'src') 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 -- cgit v1.2.3 From 3eb6d272850950e4d0c41ed1169258e8c332dbed Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Mon, 2 Apr 2012 00:29:05 +0200 Subject: qualification style 'abbreviated' -> 'aliased' --- src/Haddock/Backends/Xhtml.hs | 4 ++-- src/Haddock/Backends/Xhtml/Names.hs | 6 +++--- src/Haddock/Interface/Create.hs | 14 +++++++------- src/Haddock/Options.hs | 4 ++-- src/Haddock/Types.hs | 16 ++++++++-------- 5 files changed, 22 insertions(+), 22 deletions(-) (limited to 'src') 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 863e5f90..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 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 b9ca6d8c..a0bfde42 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -109,8 +109,8 @@ createInterface tm flags modMap instIfaceMap = do | OptPrune `elem` opts = prunedExportItems0 | otherwise = exportItems - let abbrevs = - mkAbbrevMap dflags $ tm_renamed_source tm + let aliases = + mkAliasMap dflags $ tm_renamed_source tm return Interface { ifaceMod = mdl, @@ -129,25 +129,25 @@ createInterface tm flags modMap instIfaceMap = do ifaceVisibleExports = visibleNames, ifaceDeclMap = declMap, ifaceSubMap = subMap, - ifaceModuleAbbrevs = abbrevs, + ifaceModuleAliases = aliases, ifaceInstances = instances, ifaceHaddockCoverage = coverage } -mkAbbrevMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName -mkAbbrevMap dflags mRenamedSource = +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 - abbrev <- ideclAs impDecl + alias <- ideclAs impDecl return $ (lookupModuleDyn dflags (fmap Module.fsToPackageId $ ideclPkgQual impDecl) (case ideclName impDecl of SrcLoc.L _ name -> name), - abbrev)) + alias)) impDecls -- similar to GHC.lookupModule 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 7a6d7bb9..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 Module 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 -- cgit v1.2.3