diff options
| author | Simon Jakobi <simon.jakobi@gmail.com> | 2018-06-08 22:20:30 +0200 | 
|---|---|---|
| committer | Alexander Biehl <alexbiehl@gmail.com> | 2018-06-08 22:20:30 +0200 | 
| commit | ef16b9f8f73e6a4d639919152925ab83d9b1024f (patch) | |
| tree | 69927b55f16867f9b89cc89d3b291f33184248cc | |
| parent | bea565ec5a029b8c19965aa22f34c23a112c0a7f (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.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/LexParseRn.hs | 20 | 
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 cbe55dc4..5d3cf2a6 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) @@ -120,11 +120,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 @@ -168,3 +168,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 | 
