diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index 495c07f200041e35ee2a3ecec24aa6637e065c52..ec166205155e6606a2bc4a151ffaff5cd9185dad 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -2316,7 +2316,7 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm (Nothing, _) -> do -- No matches but perhaps several unifiers { (_, rel_binds, item) <- relevantBindings True ctxt item ; candidate_insts <- get_candidate_instances - ; (imp_errs, field_suggestions) <- record_field_suggestions + ; (imp_errs, field_suggestions) <- record_field_suggestions item ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) } -- Some matches => overlap errors @@ -2352,13 +2352,33 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm | otherwise = False -- See Note [Out-of-scope fields with -XOverloadedRecordDot] - record_field_suggestions :: TcM ([ImportError], [GhcHint]) - record_field_suggestions = flip (maybe $ return ([], noHints)) record_field $ \name -> + record_field_suggestions :: ErrorItem -> TcM ([ImportError], [GhcHint]) + record_field_suggestions item = flip (maybe $ return ([], noHints)) record_field $ \name -> do { glb_env <- getGlobalRdrEnv ; lcl_env <- getLocalRdrEnv - ; if occ_name_in_scope glb_env lcl_env name - then return ([], noHints) - else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) } + ; let field_name_hints = report_no_fieldnames item + ; (errs, hints) <- if occ_name_in_scope glb_env lcl_env name + then return ([], noHints) + else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) + ; pure (errs, hints ++ field_name_hints) + } + + -- get type names from instance + -- resolve the type - if it's in scope is it a record? + -- if it's a record, report an error - the record name + the field that could not be found + report_no_fieldnames :: ErrorItem -> [GhcHint] + report_no_fieldnames item + | Just (EvVarDest evvar) <- ei_evdest item + -- we can assume that here we have a `HasField @Symbol x r a` instance + -- because of HasFieldOrigin in record_field + , Just (_, [_symbol, x, r, a]) <- tcSplitTyConApp_maybe (varType evvar) + , Just (r_tycon, _) <- tcSplitTyConApp_maybe r + , Just x_name <- isStrLitTy x + -- we check that this is a record type by checking whether it has any + -- fields (in scope) + , not . null $ tyConFieldLabels r_tycon + = [RemindRecordMissingField x_name r a] + | otherwise = [] occ_name_in_scope glb_env lcl_env occ_name = not $ null (lookupGRE_OccName (IncludeFields WantNormal) glb_env occ_name) && diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs index b5b4591795bced23db0ca59c03fa648168d4edba..dc979918fdd3a62a707a7cddd99048fe0c379a3b 100644 --- a/compiler/GHC/Types/Hint.hs +++ b/compiler/GHC/Types/Hint.hs @@ -35,7 +35,7 @@ import GHC.Hs.Extension (GhcTc, GhcRn) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) import GHC.Core.TyCon (TyCon) -import GHC.Core.Type (PredType) +import GHC.Core.Type (PredType, Type) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName) import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec) @@ -44,7 +44,7 @@ import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic import GHC.Utils.Outputable -import GHC.Data.FastString (fsLit) +import GHC.Data.FastString (fsLit, FastString) import Data.Typeable ( Typeable ) @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Remind the user that there is no field of a type and name in the record, + constructors are in the usual order $x$, $r$, $a$ -} + | RemindRecordMissingField FastString Type Type {-| Suggest binding the type variable on the LHS of the type declaration -} | SuggestBindTyVarOnLhs RdrName diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs index 4815cc3bca6a4b946e1afce703d592813ce7c4c4..49913fd2fa73a963aef7b3c67b23fac67b64ec21 100644 --- a/compiler/GHC/Types/Hint/Ppr.hs +++ b/compiler/GHC/Types/Hint/Ppr.hs @@ -14,6 +14,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Core.TyCon +import GHC.Core.TyCo.Rep ( mkVisFunTyMany ) import GHC.Hs.Expr () -- instance Outputable import GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id @@ -251,6 +252,12 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + RemindRecordMissingField x r a -> + text "NB: There is no field selector" <+> ppr_sel + <+> text "in scope for record type" <+> ppr_r + where ppr_sel = quotes (ftext x <+> dcolon <+> ppr_arr_r_a) + ppr_arr_r_a = ppr $ mkVisFunTyMany r a + ppr_r = quotes $ ppr r SuggestBindTyVarOnLhs tv -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr index 15d3d96e86aa29cc55383630ee8f45b4c9e48ad2..7858d21cc0d122e792f08ceae922454055b8f85e 100644 --- a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr +++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr @@ -18,6 +18,7 @@ RecordDotSyntaxFail8.hs:37:3: error: [GHC-39999] RecordDotSyntaxFail8.hs:37:11: error: [GHC-39999] • No instance for ‘HasField "quux" Quux a0’ arising from selecting the field ‘quux’ + NB: There is no field selector ‘quux :: Quux -> a0’ in scope for record type ‘Quux’ • In the second argument of ‘($)’, namely ‘....baz.quux’ In a stmt of a 'do' block: print $ ....baz.quux In the expression: