aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
authorDavid Waern <davve@dtek.chalmers.se>2008-01-06 14:40:52 +0000
committerDavid Waern <davve@dtek.chalmers.se>2008-01-06 14:40:52 +0000
commit671ec1ad8aec260511887788338f186055ac52d1 (patch)
tree06a96219aa35f2e24be6837b822968b75c4aead2 /src/Haddock/Backends
parent64512e4a070a69359bc26d43670cec6abc672caa (diff)
Manual merge of a patch to the 0.8 branch
Thu Dec 6 15:00:10 CET 2007 Simon Marlow <simonmar@microsoft.com> * Source links must point to the original module, not the referring module
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Html.hs20
1 files changed, 11 insertions, 9 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