diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 41 | ||||
| -rw-r--r-- | 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 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  | 
