aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock')
-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