[commit: haddock] master, wip/api-annots-ghc-7.10-3: Clearly default to variables in out of scope case (6dee5e8)

[git at git.haskell.org]

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

On branches: master,wip/api-annots-ghc-7.10-3
Link       : http://git.haskell.org/haddock.git/commitdiff/6dee5e814d1934cbed458894e01b4913452422e6

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

commit 6dee5e814d1934cbed458894e01b4913452422e6
Author: Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>
Date:   Fri Mar 27 00:05:58 2015 +0000

    Clearly default to variables in out of scope case


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

6dee5e814d1934cbed458894e01b4913452422e6
 CHANGES                                         |  3 ++
 haddock-api/src/Haddock/Interface/LexParseRn.hs | 63 ++++++++++++++++---------
 2 files changed, 43 insertions(+), 23 deletions(-)

diff --git a/CHANGES b/CHANGES
index c988423..419a7be 100644
--- a/CHANGES
+++ b/CHANGES
@@ -32,6 +32,9 @@ Changes in version 2.16.0
 
  * Deal better with long synopsis lines (#151)
 
+ * Don't default to type constructors for out-of-scope names (#253 and
+   #375)
+
 Changes in version 2.15.0
 
  * Always read in prologue files as UTF8 (#286 and Cabal #1721)
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 614e606..14826ea 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -30,6 +30,7 @@ import Haddock.Types
 import Name
 import Outputable (showPpr)
 import RdrName
+import RnEnv (dataTcOccs)
 
 processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString]
                   -> Maybe (MDoc Name)
@@ -73,7 +74,13 @@ processModuleHeader dflags gre safety mayStr = do
   where
     failure = (emptyHaddockModInfo, Nothing)
 
-
+-- | Takes a 'GlobalRdrEnv' which (hopefully) contains all the
+-- definitions and a parsed comment and we attempt to make sense of
+-- where the identifiers in the comment point to. We're in effect
+-- trying to convert 'RdrName's to 'Name's, with some guesswork and
+-- fallbacks in case we can't locate the identifiers.
+--
+-- See the comments in the source for implementation commentary.
 rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> Doc Name
 rename dflags gre = rn
   where
@@ -81,19 +88,36 @@ rename dflags gre = rn
       DocAppend a b -> DocAppend (rn a) (rn b)
       DocParagraph doc -> DocParagraph (rn doc)
       DocIdentifier x -> do
-        let choices = dataTcOccs' x
+        -- Generate the choices for the possible kind of thing this
+        -- is.
+        let choices = dataTcOccs x
+        -- Try to look up all the names in the GlobalRdrEnv that match
+        -- the names.
         let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices
+
         case names of
+          -- We found no names in the env so we start guessing.
           [] ->
             case choices of
               [] -> DocMonospaced (DocString (showPpr dflags x))
-              [a] -> outOfScope dflags a
-              a:b:_ | isRdrTc a -> outOfScope dflags a
-                    | otherwise -> outOfScope dflags b
+              -- There was nothing in the environment so we need to
+              -- pick some default from what's available to us. We
+              -- diverge here from the old way where we would default
+              -- to type constructors as we're much more likely to
+              -- actually want anchors to regular definitions than
+              -- type constructor names (such as in #253). So now we
+              -- only get type constructor links if they are actually
+              -- in scope.
+              a:_ -> outOfScope dflags a
+
+          -- There is only one name in the environment that matches so
+          -- use it.
           [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.
+          -- But when there are multiple names available, default to
+          -- type constructors: somewhat awfully GHC returns the
+          -- values in the list positionally.
+          a:b:_ | isTyConName a -> DocIdentifier a
+                | otherwise -> DocIdentifier b
 
       DocWarning doc -> DocWarning (rn doc)
       DocEmphasis doc -> DocEmphasis (rn doc)
@@ -114,21 +138,14 @@ rename dflags gre = rn
       DocString str -> DocString str
       DocHeader (Header l t) -> DocHeader $ Header l (rn t)
 
-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
-
-
+-- | Wrap an identifier that's out of scope (i.e. wasn't found in
+-- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently
+-- we simply monospace the identifier in most cases except when the
+-- identifier is qualified: if the identifier is qualified then we can
+-- still try to guess and generate anchors accross modules but the
+-- users shouldn't rely on this doing the right thing. See tickets
+-- #253 and #375 on the confusion this causes depending on which
+-- default we pick in 'rename'.
 outOfScope :: DynFlags -> RdrName -> Doc a
 outOfScope dflags x =
   case x of