aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Jakobi <simon.jakobi@gmail.com>2018-06-08 22:20:30 +0200
committerSimon Jakobi <simon.jakobi@gmail.com>2018-06-13 23:39:30 +0200
commit02b2f1d46d0982f19e339051ca13e6cb203840cb (patch)
treed0f15df384ca46e52da7c5b396ff51f8d74a0ae4
parent254de3010dddb06bc1dacf4c029a9e8f30ff1600 (diff)
Renamer: Warn about ambiguous identifiers (#831)
* Renamer: Warn about ambiguous identifiers Example: Warning: 'elem' is ambiguous. It is defined * in ‘Data.Foldable’ * at /home/simon/tmp/hdk/src/Lib.hs:7:1 You may be able to disambiguate the identifier by qualifying it or by hiding some imports. Defaulting to 'elem' defined at /home/simon/tmp/hdk/src/Lib.hs:7:1 Fixes #830. * Deduplicate warnings Fixes #832.
-rw-r--r--haddock-api/src/Haddock/Interface.hs4
-rw-r--r--haddock-api/src/Haddock/Interface/LexParseRn.hs20
2 files changed, 19 insertions, 5 deletions
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 89064a6c..a66745ea 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -184,10 +184,10 @@ processModule verbosity modsum flags modMap instIfaceMap = do
if not $ isBootSummary modsum then do
out verbosity verbose "Creating interface..."
- (interface, msg) <- {-# SCC createIterface #-}
+ (interface, msgs) <- {-# SCC createIterface #-}
withTiming getDynFlags "createInterface" (const ()) $ do
runWriterGhc $ createInterface tm flags modMap instIfaceMap
- liftIO $ mapM_ putStrLn msg
+ liftIO $ mapM_ putStrLn (nub msgs)
dflags <- getDynFlags
let (haddockable, haddocked) = ifaceHaddockCoverage interface
percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index c91b89d7..d8793d63 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -28,7 +28,7 @@ import Haddock.Interface.ParseModuleHeader
import Haddock.Parser
import Haddock.Types
import Name
-import Outputable ( showPpr )
+import Outputable ( showPpr, showSDoc )
import RdrName
import EnumSet
import RnEnv (dataTcOccs)
@@ -119,11 +119,11 @@ rename dflags gre = rn
-- There is only one name in the environment that matches so
-- use it.
[a] -> pure (DocIdentifier a)
+
-- 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 -> pure (DocIdentifier a)
- | otherwise -> pure (DocIdentifier b)
+ a:b:_ -> ambiguous dflags x (if isTyConName a then a else b) names
DocWarning doc -> DocWarning <$> rn doc
DocEmphasis doc -> DocEmphasis <$> rn doc
@@ -167,3 +167,17 @@ outOfScope dflags x =
tell ["Warning: '" ++ showPpr dflags a ++ "' is out of scope."]
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]
+ 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
+ x_str = '\'' : showPpr dflags x ++ "'"
+ defnLoc = showSDoc dflags . pprNameDefnLoc