From 671ec1ad8aec260511887788338f186055ac52d1 Mon Sep 17 00:00:00 2001
From: David Waern <davve@dtek.chalmers.se>
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 <simonmar@microsoft.com>
* 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')
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