From 3ebdc745d7bc79307986332dc71f3495099b4579 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Sat, 26 Nov 2011 04:20:12 +0100
Subject: Give preference to type over data constructors for doc comment links
 at renaming time.

Previously this was done in the backends.

Also, warn when a doc comment refers to something that is in scope but which we
don't have the .haddock file for.

These changes mean we can make DocIdentifier [a] into DocIdentifier a.
---
 src/Haddock/Interface/Rename.hs | 10 ++++------
 src/Haddock/Interface/Rn.hs     | 19 +++++++++----------
 2 files changed, 13 insertions(+), 16 deletions(-)

(limited to 'src/Haddock/Interface')

diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 88e64cfa..2c10146d 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -58,7 +58,7 @@ renameInterface renamingEnv warnings iface =
 
       -- combine the missing names and filter out the built-ins, which would
       -- otherwise allways be missing.
-      missingNames = nub $ filter isExternalName
+      missingNames = nub $ filter isExternalName  -- XXX: isExternalName filters out too much
                     (missingNames1 ++ missingNames2 ++ missingNames3)
 
       -- filter out certain built in type constructors using their string
@@ -171,11 +171,9 @@ renameDoc d = case d of
   DocParagraph doc -> do
     doc' <- renameDoc doc
     return (DocParagraph doc')
-  DocIdentifier ids -> do
-    lkp <- getLookupRn
-    case [ n | (True, n) <- map lkp ids ] of
-      ids'@(_:_) -> return (DocIdentifier ids')
-      [] -> return (DocIdentifier (map Undocumented ids))
+  DocIdentifier x -> do
+    x' <- rename x
+    return (DocIdentifier x')
   DocModule str -> return (DocModule str)
   DocEmphasis doc -> do
     doc' <- renameDoc doc
diff --git a/src/Haddock/Interface/Rn.hs b/src/Haddock/Interface/Rn.hs
index d63524b6..57704db7 100644
--- a/src/Haddock/Interface/Rn.hs
+++ b/src/Haddock/Interface/Rn.hs
@@ -5,7 +5,7 @@ import Haddock.Types
 import RnEnv       ( dataTcOccs )
 
 import RdrName     ( RdrName, gre_name, GlobalRdrEnv, lookupGRE_RdrName )
-import Name        ( Name )
+import Name        ( Name, isTyConName )
 import Outputable  ( ppr, showSDoc )
 
 rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name
@@ -13,10 +13,6 @@ rnHaddockModInfo gre hmod =
   let desc = hmi_description hmod
   in hmod { hmi_description = fmap (rnDoc gre) desc }
 
-ids2string :: [RdrName] -> String
-ids2string []    = []
-ids2string (x:_) = showSDoc $ ppr x
-
 data Id x = Id {unId::x}
 instance Monad Id where (Id v)>>=f = f v; return = Id
 
@@ -38,13 +34,16 @@ rnDoc gre = unId . do_rn
     doc' <- do_rn doc
     return (DocParagraph doc')
 
-  DocIdentifier ids -> do
-    let choices = concatMap dataTcOccs ids
+  DocIdentifier x -> do
+    let choices = dataTcOccs x
     let gres = concatMap (\rdrName ->
                  map gre_name (lookupGRE_RdrName rdrName gre)) choices
-    case gres of
-      []   -> return (DocMonospaced (DocString (ids2string ids)))
-      ids' -> return (DocIdentifier ids')
+    return $ case gres of
+      []   -> DocMonospaced (DocString (showSDoc $ ppr x))  -- TODO: DocIdentifierRdrName
+      [a]  -> DocIdentifier a
+      a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b
+        -- If an id can refer to multiple things, we give precedence to type
+        -- constructors.
 
   DocModule str -> return (DocModule str)
 
-- 
cgit v1.2.3