diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Rename/Names.hs | 180 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 243 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 208 | ||||
| -rw-r--r-- | compiler/GHC/Types/Error/Codes.hs | 30 | ||||
| -rw-r--r-- | compiler/GHC/Types/Hint.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Types/Hint/Ppr.hs | 2 |
6 files changed, 448 insertions, 220 deletions
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 92cab86d05..ba45769034 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -72,7 +72,6 @@ import GHC.Types.Basic ( TopLevelFlag(..) ) import GHC.Types.SourceText import GHC.Types.Id import GHC.Types.HpcInfo -import GHC.Types.Error import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) @@ -90,7 +89,7 @@ import GHC.Data.Maybe import GHC.Data.List.SetOps ( removeDups ) import Control.Monad -import Data.Foldable ( for_, toList ) +import Data.Foldable ( for_ ) import Data.IntMap ( IntMap ) import qualified Data.IntMap as IntMap import Data.Map ( Map ) @@ -323,7 +322,7 @@ rnImportDecl this_mod NoRawPkgQual -> pure () RawPkgQual _ -> do pkg_imports <- xoptM LangExt.PackageImports - when (not pkg_imports) $ addErr packageImportErr + when (not pkg_imports) $ addErr TcRnPackageImportsDisabled let qual_only = isImportDeclQualified qual_style @@ -356,8 +355,7 @@ rnImportDecl this_mod NoPkgQual -> True ThisPkg uid -> uid == homeUnitId_ (hsc_dflags hsc_env) OtherPkg _ -> False)) - (addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (text "A module cannot import itself:" <+> ppr imp_mod_name)) + (addErr (TcRnSelfImport imp_mod_name)) -- Check for a missing import list (Opt_WarnMissingImportList also -- checks for T(..) items but that is done in checkDodgyImport below) @@ -365,12 +363,7 @@ rnImportDecl this_mod Just (Exactly, _) -> return () -- Explicit import list _ | implicit -> return () -- Do not bleat for implicit imports | qual_only -> return () - | otherwise -> whenWOptM Opt_WarnMissingImportList $ do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingImportList) - noHints - (missingImportListWarn imp_mod_name) - addDiagnostic msg + | otherwise -> addDiagnostic (TcRnNoExplicitImportList imp_mod_name) iface <- loadSrcInterface doc imp_mod_name want_boot pkg_qual @@ -389,11 +382,9 @@ rnImportDecl this_mod -- is not deterministic. The hs-boot test can show this up. dflags <- getDynFlags warnIf ((want_boot == IsBoot) && (mi_boot iface == NotBoot) && isOneShot (ghcMode dflags)) - (warnRedundantSourceImport imp_mod_name) + (TcRnRedundantSourceImport imp_mod_name) when (mod_safe && not (safeImportsOn dflags)) $ - addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (text "safe import can't be used as Safe Haskell isn't on!" - $+$ text ("please enable Safe Haskell through either Safe, Trustworthy or Unsafe")) + addErr (TcRnSafeImportsDisabled imp_mod_name) let qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name @@ -432,12 +423,7 @@ rnImportDecl this_mod -- Complain if we import a deprecated module case mi_warns iface of - WarnAll txt -> do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithCategory (warningTxtCategory txt)) - noHints - (moduleWarn imp_mod_name txt) - addDiagnostic msg + WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () -- Complain about -Wcompat-unqualified-imports violations. @@ -614,11 +600,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM () warnUnqualifiedImport decl iface = when bad_import $ do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnCompatUnqualifiedImports) - noHints - warning - addDiagnosticAt loc msg + addDiagnosticAt loc (TcRnCompatUnqualifiedImport decl) where mod = mi_module iface loc = getLocA $ ideclName decl @@ -635,21 +617,10 @@ warnUnqualifiedImport decl iface = && not has_import_list && mod `elemModuleSet` qualifiedMods - warning = vcat - [ text "To ensure compatibility with future core libraries changes" - , text "imports to" <+> ppr (ideclName decl) <+> text "should be" - , text "either qualified or have an explicit import list." - ] - -- Modules for which we warn if we see unqualified imports qualifiedMods = mkModuleSet [ dATA_LIST ] -warnRedundantSourceImport :: ModuleName -> TcRnMessage -warnRedundantSourceImport mod_name - = mkTcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints $ - text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name) - {- ************************************************************************ * * @@ -1252,32 +1223,35 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) = setSrcSpanA loc $ do (stuff, warns) <- liftM (fromMaybe ([],[])) $ run_lookup (lookup_ie ieRdr) - mapM_ emit_warning warns + mapM_ (addTcRnDiagnostic <=< warning_msg) warns return [ (L loc ie, gres) | (ie,gres) <- stuff ] where + -- Warn when importing T(..) and no children are brought in scope - emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $ - addTcRnDiagnostic (TcRnDodgyImports n) - emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $ - addTcRnDiagnostic (TcRnMissingImportList ieRdr) - emit_warning (BadImportW ie) = whenWOptM Opt_WarnDodgyImports $ do + warning_msg (DodgyImport n) = + pure (TcRnDodgyImports (DodgyImportsEmptyParent n)) + warning_msg MissingImportList = + pure (TcRnMissingImportList ieRdr) + warning_msg (BadImportW ie) = do -- 'BadImportW' is only constructed below in 'handle_bad_import', in -- the 'EverythingBut' case, so that's what we pass to -- 'badImportItemErr'. - badImportItemErr iface decl_spec ie BadImportIsParent all_avails EverythingBut + reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails + pure (TcRnDodgyImports (DodgyImportsHiding reason)) run_lookup :: IELookupM a -> TcRn (Maybe a) run_lookup m = case m of Failed err -> do - lookup_err_msg err + msg <- lookup_err_msg err + addErr (TcRnImportLookup msg) return Nothing Succeeded a -> return (Just a) lookup_err_msg err = case err of - BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails Exactly - IllegalImport -> illegalImportItemErr - QualImportError rdr -> qualImportItemErr rdr - AmbiguousImport rdr xs -> ambiguousImportItemErr rdr xs + BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails + IllegalImport -> pure ImportLookupIllegal + QualImportError rdr -> pure (ImportLookupQualified rdr) + AmbiguousImport rdr xs -> pure (ImportLookupAmbiguous rdr xs) -- For each import item, we convert its RdrNames to Names, -- and at the same time compute all the GlobalRdrElt corresponding @@ -1756,8 +1730,7 @@ warnUnusedImportDecls gbl_env hsc_src (vcat [ text "Uses:" <+> ppr uses , text "Import usage" <+> ppr usage]) - ; whenWOptM Opt_WarnUnusedImports $ - mapM_ (warnUnusedImport Opt_WarnUnusedImports rdr_env) usage + ; mapM_ (warnUnusedImport rdr_env) usage ; whenGOptM Opt_D_dump_minimal_imports $ printMinimalImports hsc_src usage } @@ -1862,9 +1835,8 @@ mkImportMap gres is:iss -> bestImport (is NE.:| iss) add _ gres = gre : gres -warnUnusedImport :: WarningFlag -> GlobalRdrEnv - -> ImportDeclUsage -> RnM () -warnUnusedImport flag rdr_env (L loc decl, used, unused) +warnUnusedImport :: GlobalRdrEnv -> ImportDeclUsage -> RnM () +warnUnusedImport rdr_env (L loc decl, used, unused) -- Do not warn for 'import M()' | Just (Exactly, L _ []) <- ideclImportList decl @@ -1878,9 +1850,7 @@ warnUnusedImport flag rdr_env (L loc decl, used, unused) -- Nothing used; drop entire declaration | null used - = let dia = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag flag) noHints msg1 - in addDiagnosticAt (locA loc) dia + = addDiagnosticAt (locA loc) (TcRnUnusedImport decl UnusedImportNone) -- Everything imported is used; nop | null unused @@ -1891,45 +1861,27 @@ warnUnusedImport flag rdr_env (L loc decl, used, unused) | Just (_, L _ imports) <- ideclImportList decl , length unused == 1 , Just (L loc _) <- find (\(L _ ie) -> ((ieName ie) :: Name) `elem` unused) imports - = let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2 - in addDiagnosticAt (locA loc) dia + = addDiagnosticAt (locA loc) (TcRnUnusedImport decl (UnusedImportSome sort_unused)) -- Some imports are unused | otherwise - = let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2 - in addDiagnosticAt (locA loc) dia + = addDiagnosticAt (locA loc) (TcRnUnusedImport decl (UnusedImportSome sort_unused)) where - msg1 = vcat [ pp_herald <+> quotes pp_mod <+> is_redundant - , nest 2 (text "except perhaps to import instances from" - <+> quotes pp_mod) - , text "To import instances alone, use:" - <+> text "import" <+> pp_mod <> parens Outputable.empty ] - msg2 = sep [ pp_herald <+> quotes sort_unused - , text "from module" <+> quotes pp_mod <+> is_redundant] - pp_herald = text "The" <+> pp_qual <+> text "import of" - pp_qual - | isImportDeclQualified (ideclQualified decl)= text "qualified" - | otherwise = Outputable.empty - pp_mod = ppr (unLoc (ideclName decl)) - is_redundant = text "is redundant" - -- In warning message, pretty-print identifiers unqualified unconditionally -- to improve the consistent for ambiguous/unambiguous identifiers. -- See trac#14881. - ppr_possible_field n = + possible_field n = case lookupGRE_Name rdr_env n of Just (GRE { gre_par = par, gre_info = IAmRecField info }) -> let fld_occ :: OccName fld_occ = nameOccName $ flSelector $ recFieldLabel info - in case par of - ParentIs p -> pprNameUnqualified p <> parens (ppr fld_occ) - NoParent -> ppr fld_occ - _ -> pprNameUnqualified n + in UnusedImportNameRecField par fld_occ + _ -> UnusedImportNameRegular n -- Print unused names in a deterministic (lexicographic) order - sort_unused :: SDoc - sort_unused = pprWithCommas ppr_possible_field $ + sort_unused :: [UnusedImportName] + sort_unused = fmap possible_field $ sortBy (comparing nameOccName) unused {- @@ -2137,30 +2089,13 @@ DRFPatSynExport for a test of this. ************************************************************************ -} -qualImportItemErr :: RdrName -> TcRn () -qualImportItemErr rdr - = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal qualified name in import item:") - 2 (ppr rdr) - -ambiguousImportItemErr :: RdrName -> [GlobalRdrElt] -> TcRn () -ambiguousImportItemErr rdr gres - = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints err - where - err = hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:") - 2 (vcat (map (ppr . greOccName) gres)) - badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> BadImportIsSubordinate -> [AvailInfo] - -> ImportListInterpretation - -> TcRn () -badImportItemErr iface decl_spec ie sub avails ili - = do { patsyns_enabled <- xoptM LangExt.PatternSynonyms - ; let err = TcRnBadImport importErrorKind iface decl_spec ie patsyns_enabled ili - ; case ili of - EverythingBut -> addTcRnDiagnostic err - Exactly -> addErr err } + -> TcRn ImportLookupReason +badImportItemErr iface decl_spec ie sub avails = do + patsyns_enabled <- xoptM LangExt.PatternSynonyms + pure (ImportLookupBad importErrorKind iface decl_spec ie patsyns_enabled) where importErrorKind | any checkIfTyCon avails = case sub of @@ -2189,43 +2124,15 @@ badImportItemErr iface decl_spec ie sub avails ili IEThingWith _ _ _ ns -> map (ieWrappedName . unLoc) ns _ -> panic "importedChildren failed pattern match: no children" -illegalImportItemErr :: TcRn () -illegalImportItemErr = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal import item" - addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn () addDupDeclErr gres@(gre :| _) - = addErrAt (getSrcSpan (NE.last sorted_names)) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - -- Report the error at the later location - vcat [text "Multiple declarations of" <+> - quotes (ppr (greOccName gre)), - -- NB. print the OccName, not the Name, because the - -- latter might not be in scope in the RdrEnv and so will - -- be printed qualified. - text "Declared at:" <+> - vcat (toList $ ppr . nameSrcLoc <$> sorted_names)] + -- Report the error at the later location + = addErrAt (getSrcSpan (NE.last sorted_names)) $ (TcRnDuplicateDecls (greOccName gre) sorted_names) where sorted_names = NE.sortBy (SrcLoc.leftmost_smallest `on` nameSrcSpan) (fmap greName gres) -missingImportListWarn :: ModuleName -> SDoc -missingImportListWarn mod - = text "The module" <+> quotes (ppr mod) <+> text "does not have an explicit import list" - -moduleWarn :: ModuleName -> WarningTxt GhcRn -> SDoc -moduleWarn mod (WarningTxt _ _ txt) - = sep [ text "Module" <+> quotes (ppr mod) <> colon, - nest 2 (vcat (map (ppr . hsDocString . unLoc) txt)) ] -moduleWarn mod (DeprecatedTxt _ txt) - = sep [ text "Module" <+> quotes (ppr mod) - <+> text "is deprecated:", - nest 2 (vcat (map (ppr . hsDocString . unLoc) txt)) ] - -packageImportErr :: TcRnMessage -packageImportErr - = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Package-qualified imports are not enabled; use PackageImports" - -- This data decl will parse OK -- data T = a Int -- treating "a" as the constructor. @@ -2241,9 +2148,4 @@ packageImportErr checkConName :: RdrName -> TcRn () checkConName name - = checkErr (isRdrDataCon name || isRdrTc name) (badDataCon name) - -badDataCon :: RdrName -> TcRnMessage -badDataCon name - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hsep [text "Illegal data constructor name", quotes (ppr name)] + = checkErr (isRdrDataCon name || isRdrTc name) (TcRnIllegalDataCon name) diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 4152866492..ef00752196 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -154,8 +154,11 @@ instance Diagnostic TcRnMessage where ) : [errInfoContext, errInfoSupplementary] TcRnUnusedPatternBinds bind -> mkDecorated [hang (text "This pattern-binding binds no variables:") 2 (ppr bind)] - TcRnDodgyImports gre + TcRnDodgyImports (DodgyImportsEmptyParent gre) -> mkDecorated [dodgy_msg (text "import") gre (dodgy_msg_insert gre)] + TcRnDodgyImports (DodgyImportsHiding reason) + -> mkSimpleDecorated $ + pprImportLookup reason TcRnDodgyExports gre -> mkDecorated [dodgy_msg (text "export") gre (dodgy_msg_insert gre)] TcRnMissingImportList ie @@ -1115,58 +1118,6 @@ instance Diagnostic TcRnMessage where TcRnTypeDataForbids feature -> mkSimpleDecorated $ ppr feature <+> text "are not allowed in type data declarations." - TcRnBadImport k iface decl_spec ie _ps _interp -> - mkSimpleDecorated $ - let - pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc - pprImpDeclSpec iface decl_spec = - quotes (ppr (is_mod decl_spec)) <+> case mi_boot iface of - IsBoot -> text "(hi-boot interface)" - NotBoot -> empty - withContext msgs = - hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) - 2 (vcat msgs) - in case k of - BadImportNotExported -> - vcat - [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> - text "does not export" <+> quotes (ppr ie) <> dot - ] - BadImportAvailVar -> - withContext - [ text "an item called" - <+> quotes val <+> text "is exported, but it is not a type." - ] - where - val_occ = rdrNameOcc $ ieName ie - val = parenSymOcc val_occ (ppr val_occ) - BadImportAvailTyCon {} -> - withContext - [ text "an item called" - <+> quotes tycon <+> text "is exported, but it is a type." - ] - where - tycon_occ = rdrNameOcc $ ieName ie - tycon = parenSymOcc tycon_occ (ppr tycon_occ) - BadImportNotExportedSubordinates ns -> - withContext - [ text "an item called" <+> quotes sub <+> text "is exported, but it does not export any children" - , text "(constructors, class methods or field names) called" - <+> pprWithCommas (quotes . ppr) ns <> dot - ] - where - sub_occ = rdrNameOcc $ ieName ie - sub = parenSymOcc sub_occ (ppr sub_occ) - BadImportAvailDataCon dataType_occ -> - withContext - [ text "an item called" <+> quotes datacon - , text "is exported, but it is a data constructor of" - , quotes dataType <> dot - ] - where - datacon_occ = rdrNameOcc $ ieName ie - datacon = parenSymOcc datacon_occ (ppr datacon_occ) - dataType = parenSymOcc dataType_occ (ppr dataType_occ) TcRnIllegalNewtype con show_linear_types reason -> mkSimpleDecorated $ @@ -1791,6 +1742,54 @@ instance Diagnostic TcRnMessage where text "not even by defaulting." TcRnInterfaceError reason -> diagnosticMessage (tcOptsIfaceOpts opts) reason + TcRnSelfImport imp_mod_name + -> mkSimpleDecorated $ + text "A module cannot import itself:" <+> ppr imp_mod_name + TcRnNoExplicitImportList mod + -> mkSimpleDecorated $ + text "The module" <+> quotes (ppr mod) <+> text "does not have an explicit import list" + TcRnSafeImportsDisabled _ + -> mkSimpleDecorated $ + text "safe import can't be used as Safe Haskell isn't on!" + TcRnDeprecatedModule mod txt + -> mkSimpleDecorated $ + sep [ text "Module" <+> quotes (ppr mod) <> text extra <> colon, + nest 2 (vcat (map (ppr . hsDocString . unLoc) msg)) ] + where + (extra, msg) = case txt of + WarningTxt _ _ msg -> ("", msg) + DeprecatedTxt _ msg -> (" is deprecated", msg) + TcRnCompatUnqualifiedImport decl + -> mkSimpleDecorated $ + vcat + [ text "To ensure compatibility with future core libraries changes" + , text "imports to" <+> ppr (ideclName decl) <+> text "should be" + , text "either qualified or have an explicit import list." + ] + TcRnRedundantSourceImport mod_name + -> mkSimpleDecorated $ + text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name) + TcRnImportLookup reason + -> mkSimpleDecorated $ + pprImportLookup reason + TcRnUnusedImport decl reason + -> mkSimpleDecorated $ + pprUnusedImport decl reason + TcRnDuplicateDecls name sorted_names + -> mkSimpleDecorated $ + vcat [text "Multiple declarations of" <+> + quotes (ppr name), + -- NB. print the OccName, not the Name, because the + -- latter might not be in scope in the RdrEnv and so will + -- be printed qualified. + text "Declared at:" <+> + vcat (NE.toList $ ppr . nameSrcLoc <$> sorted_names)] + TcRnPackageImportsDisabled + -> mkSimpleDecorated $ + text "Package-qualified imports are not enabled" + TcRnIllegalDataCon name + -> mkSimpleDecorated $ + hsep [text "Illegal data constructor name", quotes (ppr name)] diagnosticReason = \case TcRnUnknownMessage m @@ -2365,10 +2364,29 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInterfaceError err -> interfaceErrorReason err - TcRnBadImport _ _ _ _ _ importKind - -> case importKind of - Exactly -> ErrorWithoutFlag - EverythingBut -> WarningWithFlag Opt_WarnDodgyImports + TcRnSelfImport{} + -> ErrorWithoutFlag + TcRnNoExplicitImportList{} + -> WarningWithFlag Opt_WarnMissingImportList + TcRnSafeImportsDisabled{} + -> ErrorWithoutFlag + TcRnDeprecatedModule _ txt + -> WarningWithCategory (warningTxtCategory txt) + TcRnCompatUnqualifiedImport{} + -> WarningWithFlag Opt_WarnCompatUnqualifiedImports + TcRnRedundantSourceImport{} + -> WarningWithoutFlag + TcRnImportLookup{} + -> ErrorWithoutFlag + TcRnUnusedImport{} + -> WarningWithFlag Opt_WarnUnusedImports + TcRnDuplicateDecls{} + -> ErrorWithoutFlag + TcRnPackageImportsDisabled + -> ErrorWithoutFlag + TcRnIllegalDataCon{} + -> ErrorWithoutFlag + diagnosticHints = \case TcRnUnknownMessage m @@ -2975,7 +2993,19 @@ instance Diagnostic TcRnMessage where -> [SuggestAddTypeSignatures UnnamedBinding] TcRnInterfaceError reason -> interfaceErrorHints reason - TcRnBadImport k _ is ie patsyns_enabled _ -> + TcRnSelfImport{} + -> noHints + TcRnNoExplicitImportList{} + -> noHints + TcRnSafeImportsDisabled{} + -> [SuggestSafeHaskell] + TcRnDeprecatedModule{} + -> noHints + TcRnCompatUnqualifiedImport{} + -> noHints + TcRnRedundantSourceImport{} + -> noHints + TcRnImportLookup (ImportLookupBad k _ is ie patsyns_enabled) -> let mod = is_mod is occ = rdrNameOcc $ ieName ie in case k of @@ -2984,6 +3014,16 @@ instance Diagnostic TcRnMessage where BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword (is_mod is)] BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (is_mod is, patsyns_enabled)) par] BadImportNotExportedSubordinates{} -> noHints + TcRnImportLookup{} + -> noHints + TcRnUnusedImport{} + -> noHints + TcRnDuplicateDecls{} + -> noHints + TcRnPackageImportsDisabled + -> [suggestExtension LangExt.PackageImports] + TcRnIllegalDataCon{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode @@ -5153,3 +5193,90 @@ pprDisabledClassExtension cls = \case vcat [ hang (text "Constraint" <+> quotes (ppr pred) <+> text "in the type of" <+> quotes (ppr sel_id)) 2 (text "constrains only the class type variables")] + +pprImportLookup :: ImportLookupReason -> SDoc +pprImportLookup = \case + ImportLookupBad k iface decl_spec ie _ps -> + let + pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc + pprImpDeclSpec iface decl_spec = + quotes (ppr (is_mod decl_spec)) <+> case mi_boot iface of + IsBoot -> text "(hi-boot interface)" + NotBoot -> empty + withContext msgs = + hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) + 2 (vcat msgs) + in case k of + BadImportNotExported -> + vcat + [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> + text "does not export" <+> quotes (ppr ie) <> dot + ] + BadImportAvailVar -> + withContext + [ text "an item called" + <+> quotes val <+> text "is exported, but it is not a type." + ] + where + val_occ = rdrNameOcc $ ieName ie + val = parenSymOcc val_occ (ppr val_occ) + BadImportAvailTyCon {} -> + withContext + [ text "an item called" + <+> quotes tycon <+> text "is exported, but it is a type." + ] + where + tycon_occ = rdrNameOcc $ ieName ie + tycon = parenSymOcc tycon_occ (ppr tycon_occ) + BadImportNotExportedSubordinates ns -> + withContext + [ text "an item called" <+> quotes sub <+> text "is exported, but it does not export any children" + , text "(constructors, class methods or field names) called" + <+> pprWithCommas (quotes . ppr) ns <> dot + ] + where + sub_occ = rdrNameOcc $ ieName ie + sub = parenSymOcc sub_occ (ppr sub_occ) + BadImportAvailDataCon dataType_occ -> + withContext + [ text "an item called" <+> quotes datacon + , text "is exported, but it is a data constructor of" + , quotes dataType <> dot + ] + where + datacon_occ = rdrNameOcc $ ieName ie + datacon = parenSymOcc datacon_occ (ppr datacon_occ) + dataType = parenSymOcc dataType_occ (ppr dataType_occ) + ImportLookupQualified rdr -> + hang (text "Illegal qualified name in import item:") + 2 (ppr rdr) + ImportLookupIllegal -> + text "Illegal import item" + ImportLookupAmbiguous rdr gres -> + hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:") + 2 (vcat (map (ppr . greOccName) gres)) + +pprUnusedImport :: ImportDecl GhcRn -> UnusedImportReason -> SDoc +pprUnusedImport decl = \case + UnusedImportNone -> + vcat [ pp_herald <+> quotes pp_mod <+> text "is redundant" + , nest 2 (text "except perhaps to import instances from" + <+> quotes pp_mod) + , text "To import instances alone, use:" + <+> text "import" <+> pp_mod <> parens empty ] + UnusedImportSome sort_unused -> + sep [ pp_herald <+> quotes (pprWithCommas pp_unused sort_unused) + , text "from module" <+> quotes pp_mod <+> text "is redundant"] + where + pp_mod = ppr (unLoc (ideclName decl)) + pp_herald = text "The" <+> pp_qual <+> text "import of" + pp_qual + | isImportDeclQualified (ideclQualified decl) = text "qualified" + | otherwise = empty + pp_unused = \case + UnusedImportNameRegular n -> + pprNameUnqualified n + UnusedImportNameRecField par fld_occ -> + case par of + ParentIs p -> pprNameUnqualified p <> parens (ppr fld_occ) + NoParent -> ppr fld_occ diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 8cdc5eb007..9e017a6e52 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -110,6 +110,10 @@ module GHC.Tc.Errors.Types ( , HsTyVarBndrExistentialFlag(..) , TySynCycleTyCons , BadImportKind(..) + , DodgyImportsReason (..) + , ImportLookupReason (..) + , UnusedImportReason (..) + , UnusedImportName (..) ) where import GHC.Prelude @@ -365,13 +369,11 @@ data TcRnMessage where -> HsTyVarBndrExistentialFlag -- ^ tyVar binder. -> TcRnMessage - {-| TcRnDodgyImports is a warning (controlled with -Wdodgy-imports) that occurs when - an import of the form 'T(..)' or 'f(..)' does not actually import anything beside - 'T'/'f' itself. + {-| TcRnDodgyImports is a group of warnings (controlled with -Wdodgy-imports). - Test cases: rename/should_compile/T7167 + See 'DodgyImportsReason' for the different warnings. -} - TcRnDodgyImports :: GlobalRdrElt -> TcRnMessage + TcRnDodgyImports :: !DodgyImportsReason -> TcRnMessage {-| TcRnDodgyExports is a warning (controlled by -Wdodgy-exports) that occurs when an export of the form 'T(..)' for a type constructor 'T' does not actually export anything beside 'T' itself. @@ -2937,21 +2939,6 @@ data TcRnMessage where rename/should_fail/T5657 -} TcRnSectionWithoutParentheses :: HsExpr GhcPs -> TcRnMessage - {-| TcRnBadImport is an error that occurs in cases where an item in an import - statement is not exported by the corresponding module. - When a nonexistent item is included in the 'hiding' section of an import - statement, this becomes a warning instead, controlled by -Wdodgy-imports. - - Test cases: - testsuite/tests/module/should_fail/T21826.hs - -} - TcRnBadImport :: BadImportKind - -> ModIface - -> ImpDeclSpec - -> IE GhcPs - -> Bool -- ^ whether @-XPatternSynonyms@ was enabled - -> ImportListInterpretation - -> TcRnMessage {- TcRnBindingOfExistingName is an error triggered by an attempt to rebind built-in syntax, punned list or tuple syntax, or a name quoted via Template Haskell. @@ -3821,6 +3808,105 @@ data TcRnMessage where TcRnTypeSynonymCycle :: !TySynCycleTyCons -- ^ The tycons involved in the cycle -> TcRnMessage + {-| TcRnSelfImport is an error indicating that a module contains an + import of itself. + + Test cases: + T9032 + -} + TcRnSelfImport :: !ModuleName -- ^ The module + -> TcRnMessage + + {-| TcRnNoExplicitImportList is a warning indicating that an import + statement did not include an explicit import list. + + Test cases: + T1789, T4489 + -} + TcRnNoExplicitImportList :: !ModuleName -- ^ The imported module + -> TcRnMessage + + {-| TcRnSafeImportsDisabled is an error indicating that an import was + declared using the @safe@ keyword while SafeHaskell wasn't active. + + Test cases: + Mixed01 + -} + TcRnSafeImportsDisabled :: !ModuleName -- ^ The imported module + -> TcRnMessage + + {-| TcRnDeprecatedModule is a warning indicating that an imported module + is annotated with a warning or deprecation pragma. + + Test cases: + DeprU + -} + TcRnDeprecatedModule :: !ModuleName -- ^ The imported module + -> !(WarningTxt GhcRn) -- ^ The pragma data + -> TcRnMessage + + {-| TcRnCompatUnqualifiedImport is a warning indicating that a special + module (right now only Data.List) was imported unqualified without + import list, for compatibility reasons. + + Test cases: + T17244A + -} + TcRnCompatUnqualifiedImport :: !(ImportDecl GhcPs) -- ^ The import + -> TcRnMessage + + {-| TcRnRedundantSourceImport is a warning indicating that a {-# SOURCE #-} + import was used when there is no import cycle. + + Test cases: + none + -} + TcRnRedundantSourceImport :: !ModuleName -- ^ The imported module + -> TcRnMessage + + {-| TcRnImportLookup is a group of errors about bad imported names. + -} + TcRnImportLookup :: !ImportLookupReason -- ^ Details about the error + -> TcRnMessage + + {-| TcRnUnusedImport is a group of errors about unused imports. + -} + TcRnUnusedImport :: !(ImportDecl GhcRn) -- ^ The import + -> !UnusedImportReason -- ^ Details about the error + -> TcRnMessage + + {-| TcRnDuplicateDecls is an error indicating that the same name was used for + multiple declarations. + + Test cases: + FieldSelectors, overloadedrecfldsfail03, T17965, NFSDuplicate, T9975a, + TDMultiple01, mod19, mod38, mod21, mod66, mod20, TDPunning, mod18, mod22, + TDMultiple02, T4127a, ghci048, T8932, rnfail015, rnfail010, rnfail011, + rnfail013, rnfail002, rnfail003, rn_dup, rnfail009, T7164, rnfail043, + TH_dupdecl, rnfail012 + -} + TcRnDuplicateDecls :: !OccName -- ^ The name of the declarations + -> !(NE.NonEmpty Name) -- ^ The individual declarations + -> TcRnMessage + + {-| TcRnPackageImportsDisabled is an error indicating that an import uses + a package qualifier while the extension PackageImports was disabled. + + Test cases: + PackageImportsDisabled + -} + TcRnPackageImportsDisabled :: TcRnMessage + + {-| TcRnIllegalDataCon is an error indicating that a data constructor was + defined using a lowercase name, or a symbolic name in prefix position. + Mostly caught by PsErrNotADataCon. + + Test cases: + None + -} + TcRnIllegalDataCon :: !RdrName -- ^ The constructor name + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -5246,3 +5332,85 @@ instance Outputable HsTyVarBndrExistentialFlag where type TySynCycleTyCons = [Either TyCon (LTyClDecl GhcRn)] + +-- | Different types of warnings for dodgy imports. +data DodgyImportsReason = + {-| An import of the form 'T(..)' or 'f(..)' does not actually import anything beside + 'T'/'f' itself. + + Test cases: + DodgyImports + -} + DodgyImportsEmptyParent !GlobalRdrElt + | + {-| A 'hiding' clause contains something that would be reported as an error in a + regular import, but is relaxed to a warning. + + Test cases: + DodgyImports_hiding + -} + DodgyImportsHiding !ImportLookupReason + deriving (Generic) + +-- | Different types of errors for import lookup. +data ImportLookupReason where + {-| An item in an import statement is not exported by the corresponding + module. + + Test cases: + T21826, recomp001, retc001, mod79, mod80, mod81, mod91, T6007, T7167, + T9006, T11071, T9905fail2, T5385, T10668 + -} + ImportLookupBad :: BadImportKind + -> ModIface + -> ImpDeclSpec + -> IE GhcPs + -> Bool -- ^ whether @-XPatternSynonyms@ was enabled + -> ImportLookupReason + {-| A name is specified with a qualifying module. + + Test cases: + T3792 + -} + ImportLookupQualified :: !RdrName -- ^ The name extracted from the import item + -> ImportLookupReason + + {-| Something completely unexpected is in an import list, like @module Foo@. + + Test cases: + ImportLookupIllegal + -} + ImportLookupIllegal :: ImportLookupReason + {-| An item in an import list matches multiple names exported from that module. + + Test cases: + None + -} + ImportLookupAmbiguous :: !RdrName -- ^ The name extracted from the import item + -> ![GlobalRdrElt] -- ^ The potential matches + -> ImportLookupReason + deriving (Generic) + +-- | Distinguish record fields from other names for pretty-printing. +data UnusedImportName where + UnusedImportNameRecField :: !Parent -> !OccName -> UnusedImportName + UnusedImportNameRegular :: !Name -> UnusedImportName + +-- | Different types of errors for unused imports. +data UnusedImportReason where + {-| No names in the import list are used in the module. + + Test cases: + overloadedrecfldsfail06, T10890_2, t22391, t22391j, T1074, prog018, + mod177, rn046, rn037, T5211 + -} + UnusedImportNone :: UnusedImportReason + {-| A set of names in the import list are not used in the module. + + Test cases: + overloadedrecfldsfail06, T17324, mod176, T11970A, rn046, T14881, + T7454, T8149, T13064 + -} + UnusedImportSome :: ![UnusedImportName] -- ^ The unsed names + -> UnusedImportReason + deriving (Generic) diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index 195f6e0608..46597c8e0c 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -331,7 +331,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnTypeDoesNotHaveFixedRuntimeRep" = 18478 GhcDiagnosticCode "TcRnImplicitLift" = 00846 GhcDiagnosticCode "TcRnUnusedPatternBinds" = 61367 - GhcDiagnosticCode "TcRnDodgyImports" = 99623 GhcDiagnosticCode "TcRnDodgyExports" = 75356 GhcDiagnosticCode "TcRnMissingImportList" = 77037 GhcDiagnosticCode "TcRnUnsafeDueToPlugin" = 01687 @@ -578,6 +577,15 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnIncoherentRoles" = 18273 GhcDiagnosticCode "TcRnTyFamNameMismatch" = 88221 GhcDiagnosticCode "TcRnTypeSynonymCycle" = 97522 + GhcDiagnosticCode "TcRnSelfImport" = 43281 + GhcDiagnosticCode "TcRnNoExplicitImportList" = 16029 + GhcDiagnosticCode "TcRnSafeImportsDisabled" = 26971 + GhcDiagnosticCode "TcRnDeprecatedModule" = 15328 + GhcDiagnosticCode "TcRnCompatUnqualifiedImport" = 82347 + GhcDiagnosticCode "TcRnRedundantSourceImport" = 54478 + GhcDiagnosticCode "TcRnDuplicateDecls" = 29916 + GhcDiagnosticCode "TcRnPackageImportsDisabled" = 10032 + GhcDiagnosticCode "TcRnIllegalDataCon" = 78448 -- PatSynInvalidRhsReason GhcDiagnosticCode "PatSynNotInvertible" = 69317 @@ -656,6 +664,18 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "DefaultDataInstDecl" = 39639 GhcDiagnosticCode "FunBindLacksEquations" = 52078 + -- TcRnDodgyImports/DodgyImportsReason + GhcDiagnosticCode "DodgyImportsEmptyParent" = 99623 + + -- TcRnImportLookup/ImportLookupReason + GhcDiagnosticCode "ImportLookupQualified" = 48795 + GhcDiagnosticCode "ImportLookupIllegal" = 14752 + GhcDiagnosticCode "ImportLookupAmbiguous" = 92057 + + -- TcRnUnusedImport/UnusedImportReason + GhcDiagnosticCode "UnusedImportNone" = 66111 + GhcDiagnosticCode "UnusedImportSome" = 38856 + -- Diagnostic codes for the foreign function interface GhcDiagnosticCode "NotADataType" = 31136 GhcDiagnosticCode "NewtypeDataConNotInScope" = 72317 @@ -820,6 +840,10 @@ type family ConRecursInto con where ConRecursInto "TcRnRoleValidationFailed" = 'Just RoleValidationFailedReason ConRecursInto "TcRnClassExtensionDisabled" = 'Just DisabledClassExtension ConRecursInto "TcRnTyFamsDisabled" = 'Just TyFamsDisabledReason + ConRecursInto "TcRnDodgyImports" = 'Just DodgyImportsReason + ConRecursInto "DodgyImportsHiding" = 'Just ImportLookupReason + ConRecursInto "TcRnImportLookup" = 'Just ImportLookupReason + ConRecursInto "TcRnUnusedImport" = 'Just UnusedImportReason -- -- TH errors @@ -861,8 +885,8 @@ type family ConRecursInto con where ConRecursInto "DsUnknownMessage" = 'Just UnknownDiagnostic ---------------------------------- - -- Constructors of TcRnBadImport - ConRecursInto "TcRnBadImport" = 'Just BadImportKind + -- Constructors of ImportLookupBad + ConRecursInto "ImportLookupBad" = 'Just BadImportKind ---------------------------------- -- Any other constructors: don't recur, instead directly diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs index c715a8f05e..4ce8d04a9d 100644 --- a/compiler/GHC/Types/Hint.hs +++ b/compiler/GHC/Types/Hint.hs @@ -429,6 +429,11 @@ data GhcHint | SuggestExplicitBidiPatSyn Name (LPat GhcRn) [LIdP GhcRn] + {-| Suggest enabling one of the SafeHaskell modes Safe, Unsafe or + Trustworthy. + -} + | SuggestSafeHaskell + -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way -- to instantiate a particular signature, where the first argument is diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs index 774d27ac7c..c0945f29fe 100644 --- a/compiler/GHC/Types/Hint/Ppr.hs +++ b/compiler/GHC/Types/Hint/Ppr.hs @@ -230,6 +230,8 @@ instance Outputable GhcHint where where pp_name = ppr name pp_args = hsep (map ppr args) + SuggestSafeHaskell + -> text "Enable Safe Haskell through either Safe, Trustworthy or Unsafe." perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" |