aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
authorSimon Jakobi <simon.jakobi@gmail.com>2018-06-22 21:37:22 +0200
committerSimon Jakobi <simon.jakobi@gmail.com>2018-07-20 16:19:35 +0200
commit2952cfbab2880cec35fa57f80dd26e2b5a873cae (patch)
tree745b1cee521775a652d79828bfe5e1eafdfc959a /haddock-api/src/Haddock
parente8542876e9c75a8616f92d47ef7946ff663e6275 (diff)
Don't warn about ambiguous identifiers when the candidate names belong to the same type
This also changes the defaulting heuristic for ambiguous identifiers. We now prefer local names primarily, and type constructors or class names secondarily. Partially fixes #854. (cherry picked from commit d504a2864a4e1982e142cf88c023e7caeea3b76f)
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r--haddock-api/src/Haddock/Interface/LexParseRn.hs53
1 files changed, 35 insertions, 18 deletions
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 10616f33..87face7c 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -1,5 +1,6 @@
{-# OPTIONS_GHC -Wwarn #-}
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Interface.LexParseRn
@@ -18,7 +19,11 @@ module Haddock.Interface.LexParseRn
, processModuleHeader
) where
+import Avail
+import Control.Arrow
+import Control.Monad
import Data.List
+import Data.Ord
import Documentation.Haddock.Doc (metaDocConcat)
import DynFlags (languageExtensions)
import qualified GHC.LanguageExtensions as LangExt
@@ -94,11 +99,9 @@ rename dflags gre = rn
-- 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
+ -- Lookup any GlobalRdrElts that match the choices.
+ case concatMap (\c -> lookupGRE_RdrName c gre) choices of
-- We found no names in the env so we start guessing.
[] ->
case choices of
@@ -117,12 +120,10 @@ rename dflags gre = rn
-- There is only one name in the environment that matches so
-- use it.
- [a] -> pure (DocIdentifier a)
+ [a] -> pure (DocIdentifier (gre_name a))
- -- But when there are multiple names available, default to
- -- type constructors: somewhat awfully GHC returns the
- -- values in the list positionally.
- a:b:_ -> ambiguous dflags x (if isTyConName a then a else b) names
+ -- There are multiple names available.
+ gres -> ambiguous dflags x gres
DocWarning doc -> DocWarning <$> rn doc
DocEmphasis doc -> DocEmphasis <$> rn doc
@@ -169,16 +170,32 @@ outOfScope dflags x =
pure (monospaced a)
monospaced a = DocMonospaced (DocString (showPpr dflags a))
--- | Warn about an ambiguous identifier.
-ambiguous :: DynFlags -> RdrName -> Name -> [Name] -> ErrMsgM (Doc Name)
-ambiguous dflags x dflt names = do
- tell [msg]
+-- | Handle ambiguous identifiers.
+--
+-- Prefers local names primarily and type constructors or class names secondarily.
+--
+-- Emits a warning if the 'GlobalRdrElts's don't belong to the same type or class.
+ambiguous :: DynFlags
+ -> RdrName
+ -> [GlobalRdrElt] -- ^ More than one @gre@s sharing the same `RdrName` above.
+ -> ErrMsgM (Doc Name)
+ambiguous dflags x gres = do
+ let noChildren = map availName (gresToAvailInfo gres)
+ dflt = maximumBy (comparing (isLocalName &&& isTyConName)) noChildren
+ msg = "Warning: " ++ x_str ++ " is ambiguous. It is defined\n" ++
+ concatMap (\n -> " * " ++ defnLoc n ++ "\n") (map gre_name gres) ++
+ " You may be able to disambiguate the identifier by qualifying it or\n" ++
+ " by hiding some imports.\n" ++
+ " Defaulting to " ++ x_str ++ " defined " ++ defnLoc dflt
+ -- TODO: Once we have a syntax for namespace qualification (#667) we may also
+ -- want to emit a warning when an identifier is a data constructor for a type
+ -- of the same name, but not the only constructor.
+ -- For example, for @data D = C | D@, someone may want to reference the @D@
+ -- constructor.
+ when (length noChildren > 1) $ tell [msg]
pure (DocIdentifier dflt)
where
- msg = "Warning: " ++ x_str ++ " is ambiguous. It is defined\n" ++
- concatMap (\n -> " * " ++ defnLoc n ++ "\n") names ++
- " You may be able to disambiguate the identifier by qualifying it or\n" ++
- " by hiding some imports.\n" ++
- " Defaulting to " ++ x_str ++ " defined " ++ defnLoc dflt
+ isLocalName (nameSrcLoc -> RealSrcLoc {}) = True
+ isLocalName _ = False
x_str = '\'' : showPpr dflags x ++ "'"
defnLoc = showSDoc dflags . pprNameDefnLoc