[commit: haddock] master: Fixes #253 (87f255f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/?p=haddock.git;a=commit;h=87f255f4407e4548083c8c87d27cdfab08a1f504

>---------------------------------------------------------------

commit 87f255f4407e4548083c8c87d27cdfab08a1f504
Author: Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>
Date:   Thu Aug 29 23:21:30 2013 +0100

    Fixes #253


>---------------------------------------------------------------

87f255f4407e4548083c8c87d27cdfab08a1f504
 html-test/src/Ticket253_1.hs        |    6 ++++++
 html-test/src/Ticket253_2.hs        |    6 ++++++
 src/Haddock/Interface/LexParseRn.hs |   18 ++++++++++++++++--
 3 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/html-test/src/Ticket253_1.hs b/html-test/src/Ticket253_1.hs
new file mode 100644
index 0000000..62ab4b1
--- /dev/null
+++ b/html-test/src/Ticket253_1.hs
@@ -0,0 +1,6 @@
+module Ticket253_1 where
+-- | See 'Ticket253_2.bar'.
+--
+-- Also see 'Ticket253_2.Baz'
+foo :: Int
+foo = 0
diff --git a/html-test/src/Ticket253_2.hs b/html-test/src/Ticket253_2.hs
new file mode 100644
index 0000000..a19d4ce
--- /dev/null
+++ b/html-test/src/Ticket253_2.hs
@@ -0,0 +1,6 @@
+module Ticket253_2 where
+-- | Comment
+bar :: Int
+bar = 0
+
+data Baz = Baz
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index ced12d8..9d775bc 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -32,7 +32,6 @@ import GHC
 import Name
 import Outputable
 import RdrName
-import RnEnv
 
 
 processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (Doc Name))
@@ -96,7 +95,7 @@ rename dflags gre = rn
       DocAppend a b -> DocAppend (rn a) (rn b)
       DocParagraph doc -> DocParagraph (rn doc)
       DocIdentifier x -> do
-        let choices = dataTcOccs x
+        let choices = dataTcOccs' x
         let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices
         case names of
           [] ->
@@ -109,6 +108,7 @@ rename dflags gre = rn
           a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b
               -- If an id can refer to multiple things, we give precedence to type
               -- constructors.
+
       DocWarning doc -> DocWarning (rn doc)
       DocEmphasis doc -> DocEmphasis (rn doc)
       DocMonospaced doc -> DocMonospaced (rn doc)
@@ -126,6 +126,20 @@ rename dflags gre = rn
       DocEmpty -> DocEmpty
       DocString str -> DocString str
 
+dataTcOccs' :: RdrName -> [RdrName]
+-- If the input is a data constructor, return both it and a type
+-- constructor.  This is useful when we aren't sure which we are
+-- looking at.
+--
+-- We use this definition instead of the GHC's to provide proper linking to
+-- functions accross modules. See ticket #253 on Haddock Trac.
+dataTcOccs' rdr_name
+  | isDataOcc occ             = [rdr_name, rdr_name_tc]
+  | otherwise                 = [rdr_name]
+  where
+    occ = rdrNameOcc rdr_name
+    rdr_name_tc = setRdrNameSpace rdr_name tcName
+
 
 outOfScope :: DynFlags -> RdrName -> Doc a
 outOfScope dflags x =