From 0da9e88273a0ffb13132631fb5ea526ea9efeeb9 Mon Sep 17 00:00:00 2001 From: Soham Chowdhury Date: Mon, 24 Apr 2023 20:14:33 +0200 Subject: More informative errors for bad imports (#21826) --- compiler/GHC/Rename/Names.hs | 128 ++++++++++++++++++-------------------- compiler/GHC/Rename/Unbound.hs | 6 +- compiler/GHC/Rename/Utils.hs | 4 +- compiler/GHC/Tc/Errors/Ppr.hs | 92 ++++++++++++++++++++++++--- compiler/GHC/Tc/Errors/Types.hs | 33 +++++++++- compiler/GHC/Tc/Utils/TcType.hs | 6 +- compiler/GHC/Types/Error/Codes.hs | 11 ++++ compiler/GHC/Types/Hint.hs | 29 +++++---- compiler/GHC/Types/Hint/Ppr.hs | 68 +++++++++++++++----- 9 files changed, 263 insertions(+), 114 deletions(-) (limited to 'compiler') diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index aae3fe497b..92cab86d05 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -1241,7 +1241,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) | isQual rdr = failLookupWith (QualImportError rdr) | null lookups - = failLookupWith (BadImport ie) + = failLookupWith (BadImport ie BadImportIsParent) | otherwise = return $ concatMap nonDetNameEnvElts lookups where @@ -1249,8 +1249,8 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])] lookup_lie (L loc ieRdr) - = do (stuff, warns) <- setSrcSpanA loc $ - liftM (fromMaybe ([],[])) $ + = setSrcSpanA loc $ + do (stuff, warns) <- liftM (fromMaybe ([],[])) $ run_lookup (lookup_ie ieRdr) mapM_ emit_warning warns return [ (L loc ie, gres) | (ie,gres) <- stuff ] @@ -1261,21 +1261,20 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $ addTcRnDiagnostic (TcRnMissingImportList ieRdr) emit_warning (BadImportW ie) = whenWOptM Opt_WarnDodgyImports $ do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnDodgyImports) - noHints - (lookup_err_msg (BadImport ie)) - addDiagnostic msg + -- '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 run_lookup :: IELookupM a -> TcRn (Maybe a) run_lookup m = case m of Failed err -> do - addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (lookup_err_msg err) + lookup_err_msg err return Nothing Succeeded a -> return (Just a) lookup_err_msg err = case err of - BadImport ie -> badImportItemErr iface decl_spec ie all_avails + BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails Exactly IllegalImport -> illegalImportItemErr QualImportError rdr -> qualImportItemErr rdr AmbiguousImport rdr xs -> ambiguousImportItemErr rdr xs @@ -1330,7 +1329,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) dc_name = lookup_name ie (setRdrNameSpace tc srcDataName) in case catIELookupM [ tc_name, dc_name ] of - [] -> failLookupWith (BadImport ie) + [] -> failLookupWith (BadImport ie BadImportIsParent) names -> return ([mkIEThingAbs tc' l (imp_item name) | name <- names], []) | otherwise -> do ImpOccItem { imp_item = gre } <- lookup_name ie (ieWrappedName tc') @@ -1345,7 +1344,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- See Note [Importing DuplicateRecordFields] case lookupChildren subnames rdr_ns of - Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs)) + Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs) BadImportIsSubordinate) -- We are trying to import T( a,b,c,d ), and failed -- to find 'b' and 'd'. So we make up an import item -- to report as failing, namely T( b, d ). @@ -1369,7 +1368,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) where n = greName gre handle_bad_import m = catchIELookup m $ \err -> case err of - BadImport ie | want_hiding == EverythingBut -> return ([], [BadImportW ie]) + BadImport ie _ | want_hiding == EverythingBut -> return ([], [BadImportW ie]) _ -> failLookupWith err type IELookupM = MaybeErr IELookupError @@ -1379,9 +1378,11 @@ data IELookupWarning | MissingImportList | DodgyImport GlobalRdrElt +data BadImportIsSubordinate = BadImportIsParent | BadImportIsSubordinate + data IELookupError = QualImportError RdrName - | BadImport (IE GhcPs) + | BadImport (IE GhcPs) BadImportIsSubordinate | IllegalImport | AmbiguousImport RdrName [GlobalRdrElt] -- e.g. a duplicated field name as a top-level import @@ -2136,67 +2137,60 @@ DRFPatSynExport for a test of this. ************************************************************************ -} -qualImportItemErr :: RdrName -> SDoc +qualImportItemErr :: RdrName -> TcRn () qualImportItemErr rdr - = hang (text "Illegal qualified name in import item:") + = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ + hang (text "Illegal qualified name in import item:") 2 (ppr rdr) -ambiguousImportItemErr :: RdrName -> [GlobalRdrElt] -> SDoc +ambiguousImportItemErr :: RdrName -> [GlobalRdrElt] -> TcRn () ambiguousImportItemErr rdr gres - = hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:") - 2 (vcat (map (ppr . greOccName) gres)) - -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 -> Outputable.empty - -badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc -badImportItemErrStd iface decl_spec ie - = sep [text "Module", pprImpDeclSpec iface decl_spec, - text "does not export", quotes (ppr ie)] - -badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs - -> SDoc -badImportItemErrDataCon dataType_occ iface decl_spec ie - = vcat [ text "In module" - <+> pprImpDeclSpec iface decl_spec - <> colon - , nest 2 $ quotes datacon - <+> text "is a data constructor of" - <+> quotes dataType - , text "To import it use" - , nest 2 $ text "import" - <+> ppr (is_mod decl_spec) - <> parens_sp (dataType <> parens_sp datacon) - , text "or" - , nest 2 $ text "import" - <+> ppr (is_mod decl_spec) - <> parens_sp (dataType <> text "(..)") - ] + = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints err where - datacon_occ = rdrNameOcc $ ieName ie - datacon = parenSymOcc datacon_occ (ppr datacon_occ) - dataType = parenSymOcc dataType_occ (ppr dataType_occ) - parens_sp d = parens (space <> d <> space) -- T( f,g ) - -badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> SDoc -badImportItemErr iface decl_spec ie avails - = case find checkIfDataCon avails of - Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie - Nothing -> badImportItemErrStd iface decl_spec ie + 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 } where - checkIfDataCon (AvailTC _ ns) = - case find (\n -> importedFS == occNameFS (occName n)) ns of - Just n -> isDataConName n - Nothing -> False - checkIfDataCon _ = False + importErrorKind + | any checkIfTyCon avails = case sub of + BadImportIsParent -> BadImportAvailTyCon + BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren + | any checkIfVarName avails = BadImportAvailVar + | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con) + | otherwise = BadImportNotExported + checkIfDataCon = checkIfAvailMatches isDataConName + checkIfTyCon = checkIfAvailMatches isTyConName + checkIfVarName = + \case + AvailTC{} -> False + Avail n -> importedFS == occNameFS (occName n) + && (isVarOcc <||> isFieldOcc) (occName n) + checkIfAvailMatches namePred = + \case + AvailTC _ ns -> + case find (\n -> importedFS == occNameFS (occName n)) ns of + Just n -> namePred n + Nothing -> False + Avail{} -> False availOccName = occName . availName importedFS = occNameFS . rdrNameOcc $ ieName ie + unavailableChildren = map (rdrNameOcc) $ case ie of + IEThingWith _ _ _ ns -> map (ieWrappedName . unLoc) ns + _ -> panic "importedChildren failed pattern match: no children" -illegalImportItemErr :: SDoc -illegalImportItemErr = text "Illegal import item" +illegalImportItemErr :: TcRn () +illegalImportItemErr = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal import item" addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn () addDupDeclErr gres@(gre :| _) @@ -2212,7 +2206,7 @@ addDupDeclErr gres@(gre :| _) where sorted_names = NE.sortBy (SrcLoc.leftmost_smallest `on` nameSrcSpan) - (fmap greName gres) + (fmap greName gres) missingImportListWarn :: ModuleName -> SDoc missingImportListWarn mod diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs index ee9f2c82b8..199cebbaa9 100644 --- a/compiler/GHC/Rename/Unbound.hs +++ b/compiler/GHC/Rename/Unbound.hs @@ -195,7 +195,7 @@ unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env suggs = mconcat [ if_ne (SuggestSimilarNames tried_rdr_name) $ similarNameSuggestions looking_for dflags global_env local_env tried_rdr_name - , map ImportSuggestion imp_suggs + , map (ImportSuggestion $ rdrNameOcc tried_rdr_name) imp_suggs , extensionSuggestions tried_rdr_name , fieldSelectorSuggestions global_env tried_rdr_name ] (imp_errs, imp_suggs) = importSuggestions looking_for global_env hpt curr_mod imports tried_rdr_name @@ -321,9 +321,9 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name , (mod : mods) <- map fst interesting_imports = ([ModulesDoNotExport (mod :| mods) occ_name], []) | mod : mods <- helpful_imports_non_hiding - = ([], [CouldImportFrom (mod :| mods) occ_name]) + = ([], [CouldImportFrom (mod :| mods)]) | mod : mods <- helpful_imports_hiding - = ([], [CouldUnhideFrom (mod :| mods) occ_name]) + = ([], [CouldUnhideFrom (mod :| mods)]) | otherwise = ([], []) where diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index 4992ebf309..a00d97dd0d 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -565,8 +565,8 @@ mkNameClashErr :: Outputable a mkNameClashErr rdr_name gres = mkTcRnUnknownMessage $ mkPlainError noHints $ (vcat [ text "Ambiguous occurrence" <+> quotes (ppr rdr_name) - , text "It could refer to" - , nest 3 (vcat (msg1 : msgs)) ]) + , text "It could refer to" + , nest 3 (vcat (msg1 : msgs)) ]) where np1 NE.:| nps = gres msg1 = text "either" <+> ppr_gre np1 diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 5cc8ab5f64..33c67fee79 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -29,6 +29,10 @@ import GHC.Prelude import GHC.Builtin.Names import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon, filterCTuple ) +import GHC.Types.Name.Reader +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.Warnings + import GHC.Core.Coercion import GHC.Core.Unify ( tcMatchTys ) import GHC.Core.TyCon @@ -58,14 +62,13 @@ import GHC.Tc.Types.Rank (Rank(..)) import GHC.Tc.Utils.TcType import GHC.Types.Error -import GHC.Types.Hint (UntickedPromotedThing(..), pprUntickedConstructor, isBareSymbol) +import GHC.Types.Hint import GHC.Types.Hint.Ppr () -- Outputable GhcHint import GHC.Types.Basic import GHC.Types.Error.Codes ( constructorCode ) import GHC.Types.Id import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Name -import GHC.Types.Name.Reader import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.SrcLoc @@ -78,7 +81,6 @@ import GHC.Types.Fixity (defaultFixity) import GHC.Unit.State import GHC.Unit.Module -import GHC.Unit.Module.Warnings ( warningTxtCategory, pprWarningTxtForMsg ) import GHC.Data.Bag import GHC.Data.FastString @@ -876,9 +878,9 @@ instance Diagnostic TcRnMessage where in case why of NotADataType -> quotes (ppr ty) <+> text "is not a data type" - NewtypeDataConNotInScope Nothing -> + NewtypeDataConNotInScope _ [] -> hang innerMsg 2 $ text "because its data constructor is not in scope" - NewtypeDataConNotInScope (Just tc) -> + NewtypeDataConNotInScope tc _ -> hang innerMsg 2 $ text "because the data constructor for" <+> quotes (ppr tc) <+> text "is not in scope" @@ -1113,6 +1115,58 @@ 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 $ @@ -2311,7 +2365,10 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInterfaceError err -> interfaceErrorReason err - + TcRnBadImport _ _ _ _ _ importKind + -> case importKind of + Exactly -> ErrorWithoutFlag + EverythingBut -> WarningWithFlag Opt_WarnDodgyImports diagnosticHints = \case TcRnUnknownMessage m @@ -2582,8 +2639,13 @@ instance Diagnostic TcRnMessage where TcRnIllegalForeignType _ reason -> case reason of TypeCannotBeMarshaled _ why - | NewtypeDataConNotInScope{} <- why -> [SuggestImportingDataCon] - | UnliftedFFITypesNeeded <- why -> [suggestExtension LangExt.UnliftedFFITypes] + | NewtypeDataConNotInScope tc _ <- why + -> let tc_nm = tyConName tc + dc = dataConName $ head $ tyConDataCons tc + in [ ImportSuggestion (occName dc) + $ ImportDataCon Nothing (nameOccName tc_nm) ] + | UnliftedFFITypesNeeded <- why + -> [suggestExtension LangExt.UnliftedFFITypes] _ -> noHints TcRnInvalidCIdentifier{} -> noHints @@ -2913,7 +2975,17 @@ instance Diagnostic TcRnMessage where -> [SuggestAddTypeSignatures UnnamedBinding] TcRnInterfaceError reason -> interfaceErrorHints reason - + TcRnBadImport k _ is ie patsyns_enabled _ -> + let mod = is_mod is + occ = rdrNameOcc $ ieName ie + in case k of + BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod] + BadImportNotExported -> noHints + BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword (is_mod is)] + BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (is_mod is, patsyns_enabled)) par] + BadImportNotExportedSubordinates{} -> noHints + + diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode -- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z", @@ -4841,7 +4913,7 @@ expandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret) -- ... -- type T0 = Int -- - -- `tyExpansions T10` returns [T9, T8, T7, ... Int] + -- `tyExpansions T10` returns [T9, T8, T7, ..., Int] -- -- This only expands the top layer, so if you have: -- diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 38615d0f0d..e2a69e0ce2 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -109,6 +109,7 @@ module GHC.Tc.Errors.Types ( , HsTypeOrSigType(..) , HsTyVarBndrExistentialFlag(..) , TySynCycleTyCons + , BadImportKind(..) ) where import GHC.Prelude @@ -123,9 +124,9 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType, TcSigmaType, TcPredType) -import GHC.Types.Avail (AvailInfo) import GHC.Types.Basic import GHC.Types.Error +import GHC.Types.Avail import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) import GHC.Types.Id.Info ( RecSelParent(..) ) @@ -163,6 +164,7 @@ import qualified Data.List.NonEmpty as NE import Data.Typeable (Typeable) import GHC.Unit.Module.Warnings (WarningCategory, WarningTxt) import qualified Language.Haskell.TH.Syntax as TH +import GHC.Unit.Module.ModIface import GHC.Generics ( Generic ) import GHC.Types.Name.Env (NameEnv) @@ -2935,6 +2937,21 @@ 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. @@ -4751,6 +4768,20 @@ data WhenMatching = WhenMatching TcType TcType CtOrigin (Maybe TypeOrKind) deriving Generic +data BadImportKind + -- | Module does not export... + = BadImportNotExported + -- | Missing @type@ keyword when importing a type. + | BadImportAvailTyCon + -- | Trying to import a data constructor directly, e.g. + -- @import Data.Maybe (Just)@ instead of @import Data.Maybe (Maybe(Just))@ + | BadImportAvailDataCon OccName + -- | The parent does not export the given children. + | BadImportNotExportedSubordinates [OccName] + -- | Incorrect @type@ keyword when importing something which isn't a type. + | BadImportAvailVar + deriving Generic + -- | Some form of @"not in scope"@ error. See also the 'OutOfScopeHole' -- constructor of 'HoleError'. data NotInScopeError diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index 845e954b83..e7d33c3a80 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -2071,7 +2071,7 @@ data IllegalForeignTypeReason -- | Reason why a type cannot be marshalled through the FFI. data TypeCannotBeMarshaledReason = NotADataType - | NewtypeDataConNotInScope !(Maybe TyCon) + | NewtypeDataConNotInScope !TyCon ![Type] | UnliftedFFITypesNeeded | NotABoxedMarshalableTyCon | ForeignLabelNotAPtr @@ -2180,9 +2180,7 @@ checkRepTyCon check_tc ty | otherwise -> check_tc tc Nothing -> NotValid NotADataType where - mk_nt_reason tc tys - | null tys = NewtypeDataConNotInScope Nothing - | otherwise = NewtypeDataConNotInScope (Just tc) + mk_nt_reason tc tys = NewtypeDataConNotInScope tc tys {- Note [Foreign import dynamic] diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index e5d7a84bb6..9c2f7d1dc3 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -620,6 +620,13 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "MultiplePossibleParents" = 99339 GhcDiagnosticCode "InvalidTyConParent" = 33238 + -- BadImport + GhcDiagnosticCode "BadImportNotExported" = 61689 + GhcDiagnosticCode "BadImportAvailDataCon" = 35373 + GhcDiagnosticCode "BadImportNotExportedSubordinates" = 10237 + GhcDiagnosticCode "BadImportAvailTyCon" = 56449 + GhcDiagnosticCode "BadImportAvailVar" = 12112 + -- TcRnPragmaWarning GhcDiagnosticCode "WarningTxt" = 63394 GhcDiagnosticCode "DeprecatedTxt" = 68441 @@ -852,6 +859,10 @@ type family ConRecursInto con where ConRecursInto "DsUnknownMessage" = 'Just UnknownDiagnostic + ---------------------------------- + -- Constructors of TcRnBadImport + ConRecursInto "TcRnBadImport" = 'Just BadImportKind + ---------------------------------- -- Any other constructors: don't recur, instead directly -- use the constructor name for the error code. diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs index 635b965035..c715a8f05e 100644 --- a/compiler/GHC/Types/Hint.hs +++ b/compiler/GHC/Types/Hint.hs @@ -402,16 +402,9 @@ data GhcHint Test cases: mod28, mod36, mod87, mod114, ... -} - | ImportSuggestion ImportSuggestion + | ImportSuggestion OccName ImportSuggestion - {-| Suggest importing a data constructor to bring it into scope - Triggered by: 'GHC.Tc.Errors.Types.TcRnTypeCannotBeMarshaled' - - Test cases: ccfail004 - -} - | SuggestImportingDataCon - {-| Found a pragma in the body of a module, suggest - placing it in the header + {-| Found a pragma in the body of a module, suggest placing it in the header. -} | SuggestPlacePragmaInHeader {-| Suggest using pattern matching syntax for a non-bidirectional pattern synonym @@ -452,9 +445,23 @@ data InstantiationSuggestion = InstantiationSuggestion !ModuleName !Module -- | Suggest how to fix an import. data ImportSuggestion -- | Some module exports what we want, but we aren't explicitly importing it. - = CouldImportFrom (NE.NonEmpty (Module, ImportedModsVal)) OccName + = CouldImportFrom (NE.NonEmpty (Module, ImportedModsVal)) -- | Some module exports what we want, but we are explicitly hiding it. - | CouldUnhideFrom (NE.NonEmpty (Module, ImportedModsVal)) OccName + | CouldUnhideFrom (NE.NonEmpty (Module, ImportedModsVal)) + -- | The module exports what we want, but it isn't a type. + | CouldRemoveTypeKeyword ModuleName + -- | The module exports what we want, but it's a type and we have @ExplicitNamespaces@ on. + | CouldAddTypeKeyword ModuleName + -- | Suggest importing a data constructor to bring it into scope + | ImportDataCon + -- | Where to suggest importing the 'DataCon' from. + -- + -- The 'Bool' tracks whether to suggest using an import of the form + -- @import (pattern Foo)@, depending on whether @-XPatternSynonyms@ + -- was enabled. + { ies_suggest_import_from :: Maybe (ModuleName, Bool) + -- | The 'OccName' of the parent of the data constructor. + , ies_parent :: OccName } -- | Explain how something is in scope. data HowInScope diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs index 641dbb1691..774d27ac7c 100644 --- a/compiler/GHC/Types/Hint/Ppr.hs +++ b/compiler/GHC/Types/Hint/Ppr.hs @@ -16,7 +16,7 @@ import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Hs.Expr () -- instance Outputable import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id -import GHC.Types.Name (NameSpace, pprDefinedAt, occNameSpace, pprNameSpace, isValNameSpace, nameModule) +import GHC.Types.Name import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace) import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine) import GHC.Unit.Module.Imported (ImportedModsVal(..)) @@ -199,10 +199,8 @@ instance Outputable GhcHint where whose | null parents = empty | otherwise = text "belonging to the type" <> plural parents <+> pprQuotedList parents - ImportSuggestion import_suggestion - -> pprImportSuggestion import_suggestion - SuggestImportingDataCon - -> text "Import the data constructor to bring it into scope" + ImportSuggestion occ_name import_suggestion + -> pprImportSuggestion occ_name import_suggestion SuggestPlacePragmaInHeader -> text "Perhaps you meant to place it in the module header?" $$ text "The module header is the section at the top of the file, before the" <+> quotes (text "module") <+> text "keyword" @@ -237,50 +235,88 @@ perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" -- | Pretty-print an 'ImportSuggestion'. -pprImportSuggestion :: ImportSuggestion -> SDoc -pprImportSuggestion (CouldImportFrom mods occ_name) +pprImportSuggestion :: OccName -> ImportSuggestion -> SDoc +pprImportSuggestion occ_name (CouldImportFrom mods) | (mod, imv) NE.:| [] <- mods = fsep - [ text "Perhaps you want to add" + [ text "Add" , quotes (ppr occ_name) , text "to the import list" , text "in the import of" , quotes (ppr mod) - , parens (ppr (imv_span imv)) <> dot + , parens (text "at" <+> ppr (imv_span imv)) <> dot ] | otherwise = fsep - [ text "Perhaps you want to add" + [ text "Add" , quotes (ppr occ_name) , text "to one of these import lists:" ] $$ nest 2 (vcat - [ quotes (ppr mod) <+> parens (ppr (imv_span imv)) + [ quotes (ppr mod) <+> parens (text "at" <+> ppr (imv_span imv)) | (mod,imv) <- NE.toList mods ]) -pprImportSuggestion (CouldUnhideFrom mods occ_name) +pprImportSuggestion occ_name (CouldUnhideFrom mods) | (mod, imv) NE.:| [] <- mods = fsep - [ text "Perhaps you want to remove" + [ text "Remove" , quotes (ppr occ_name) , text "from the explicit hiding list" , text "in the import of" , quotes (ppr mod) - , parens (ppr (imv_span imv)) <> dot + , parens (text "at" <+> ppr (imv_span imv)) <> dot ] | otherwise = fsep - [ text "Perhaps you want to remove" + [ text "Remove" , quotes (ppr occ_name) , text "from the hiding clauses" , text "in one of these imports:" ] $$ nest 2 (vcat - [ quotes (ppr mod) <+> parens (ppr (imv_span imv)) + [ quotes (ppr mod) <+> parens (text "at" <+> ppr (imv_span imv)) | (mod,imv) <- NE.toList mods ]) +pprImportSuggestion occ_name (CouldAddTypeKeyword mod) + = vcat [ text "Add the" <+> quotes (text "type") + <+> text "keyword to the import statement:" + , nest 2 $ text "import" + <+> ppr mod + <+> parens_sp (text "type" <+> pprPrefixOcc occ_name) + ] + where + parens_sp d = parens (space <> d <> space) +pprImportSuggestion occ_name (CouldRemoveTypeKeyword mod) + = vcat [ text "Remove the" <+> quotes (text "type") + <+> text "keyword from the import statement:" + , nest 2 $ text "import" + <+> ppr mod + <+> parens_sp (pprPrefixOcc occ_name) ] + where + parens_sp d = parens (space <> d <> space) +pprImportSuggestion dc_occ (ImportDataCon Nothing parent_occ) + = text "Import the data constructor" <+> quotes (ppr dc_occ) <+> + text "of" <+> quotes (ppr parent_occ) +pprImportSuggestion dc_occ (ImportDataCon (Just (mod, patsyns_enabled)) parent_occ) + = vcat $ [ text "Use" + , nest 2 $ text "import" + <+> ppr mod + <+> parens_sp (pprPrefixOcc parent_occ <> parens_sp (pprPrefixOcc dc_occ)) + , text "or" + , nest 2 $ text "import" + <+> ppr mod + <+> parens_sp (pprPrefixOcc parent_occ <> text "(..)") + ] ++ if patsyns_enabled + then [ text "or" + , nest 2 $ text "import" + <+> ppr mod + <+> parens_sp (text "pattern" <+> pprPrefixOcc dc_occ) + ] + else [] + where + parens_sp d = parens (space <> d <> space) -- | Pretty-print a 'SimilarName'. pprSimilarName :: NameSpace -> SimilarName -> SDoc -- cgit v1.2.1