Fixes #253

1 files changed, 16 insertions, 2 deletions

diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index ced12d8d..9d775bcb 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 =