Repository : ssh://darcs.haskell.org//srv/darcs/haddock On branch : ghc-7.4
http://hackage.haskell.org/trac/ghc/changeset/c3d370ad042eeeb9f8afc3bf3e99cbbcb9407d60 >--------------------------------------------------------------- commit c3d370ad042eeeb9f8afc3bf3e99cbbcb9407d60 Author: Henning Thielemann <[email protected]> Date: Mon Apr 2 00:19:36 2012 +0200 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(-) diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 88ba14d..863e5f9 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 9f18343..b9ca6d8 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 2195faf..7a6d7bb 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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
