diff options
| -rw-r--r-- | src/Haddock/Backends/Html.hs | 20 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 29 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 4 |
3 files changed, 31 insertions, 22 deletions
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs index bb0927ca..cd35e9f6 100644 --- a/src/Haddock/Backends/Html.hs +++ b/src/Haddock/Backends/Html.hs @@ -1467,17 +1467,17 @@ topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), iface) case maybe_source_url of Nothing -> Html.emptyTable Just url -> tda [theclass "declbut"] << - let url' = spliceURL (Just fname) (Just orig_mod) + let url' = spliceURL (Just fname) (Just origMod) (Just name) (Just loc) url in anchor ! [href url'] << toHtml "Source" - mod = iface_module iface - - -- for source links, we want to point to the original module - -- for the name, because only that will have the source. - orig_mod = case Map.lookup name (iface_env iface) of - Just (Qual m _) -> m - _ -> mod + -- for source links, we want to point to the original module, + -- because only that will have the source. + origMod = case Map.lookup (nameOccName name) (ifaceEnv iface) of + Just n -> case nameModule_maybe n of + Just m -> m + Nothing -> mod + _ -> error "This shouldn't happen (topDeclBox)" wikiLink = case maybe_wiki_url of @@ -1487,7 +1487,9 @@ topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), iface) (Just name) (Just loc) url in anchor ! [href url'] << toHtml "Comments" - mod = iface_module iface + mod = ifaceMod iface + fname = unpackFS (srcSpanFile loc) + -- a box for displaying an 'argument' (some code which has text to the -- right of it). Wrapping is not allowed in these boxes, whereas it is diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index fba25fe2..d2e616cc 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -53,17 +53,19 @@ createInterface ghcMod flags modMap = do | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0 | otherwise = opts0 - let group = ghcGroup ghcMod - entities = (nubBy sameName . getTopEntities) group - exports = fmap (reverse . map unLoc) (ghcMbExports ghcMod) - entityNames_ = entityNames entities - subNames = allSubNames group - localNames = entityNames_ ++ subNames - subMap = mkSubMap group - expDeclMap = mkDeclMap (ghcExportedNames ghcMod) group - localDeclMap = mkDeclMap entityNames_ group - docMap = mkDocMap group - ignoreExps = Flag_IgnoreAllExports `elem` flags + let group = ghcGroup ghcMod + entities = (nubBy sameName . getTopEntities) group + exports = fmap (reverse . map unLoc) (ghcMbExports ghcMod) + entityNames_ = entityNames entities + subNames = allSubNames group + localNames = entityNames_ ++ subNames + subMap = mkSubMap group + expDeclMap = mkDeclMap (ghcExportedNames ghcMod) group + localDeclMap = mkDeclMap entityNames_ group + docMap = mkDocMap group + ignoreExps = Flag_IgnoreAllExports `elem` flags + exportedNames = ghcExportedNames ghcMod + origEnv = Map.fromList [ (nameOccName n, n) | n <- exportedNames ] visibleNames <- mkVisibleNames mod modMap localNames (ghcNamesInScope ghcMod) @@ -92,8 +94,9 @@ createInterface ghcMod flags modMap = do ifaceRnDocMap = Map.empty, ifaceSubMap = subMap, ifaceExportItems = prunedExportItems, - ifaceRnExportItems = [], - ifaceExports = ghcExportedNames ghcMod, + ifaceRnExportItems = [], + ifaceEnv = origEnv, + ifaceExports = exportedNames, ifaceVisibleExports = visibleNames, ifaceExportedDeclMap = expDeclMap, ifaceInstances = ghcInstances ghcMod diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index 0efffafb..580dc8cc 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -13,6 +13,7 @@ import qualified Data.Map as Map import GHC hiding (NoLink) import Outputable +import OccName {-! for DocOption derive: Binary !-} data DocOption @@ -141,6 +142,9 @@ data Interface = Interface { ifaceExportItems :: [ExportItem Name], ifaceRnExportItems :: [ExportItem DocName], + -- | Environment mapping exported names to *original* names + ifaceEnv :: Map OccName Name, + -- | All the names that are defined in this module ifaceLocals :: [Name], |