From 671ec1ad8aec260511887788338f186055ac52d1 Mon Sep 17 00:00:00 2001 From: David Waern Date: Sun, 6 Jan 2008 14:40:52 +0000 Subject: Manual merge of a patch to the 0.8 branch Thu Dec 6 15:00:10 CET 2007 Simon Marlow * Source links must point to the original module, not the referring module --- src/Haddock/Backends/Html.hs | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) (limited to 'src/Haddock/Backends/Html.hs') 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 -- cgit v1.2.3