[Git][ghc/ghc][master] [feat] add a hint to `HasField` error message

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00
[feat] add a hint to `HasField` error message
- add a hint that indicates that the record that the record dot is used
  on might just be missing a field
- as the intention of the programmer is not entirely clear, it is only
  shown if the type is known
- This addresses in part issue #22382

- - - - -


4 changed files:

- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr


Changes:

=====================================
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) &&


=====================================
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


=====================================
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"
 


=====================================
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:



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1464a2a8de082f66ae250d63ab9d94dbe2ef8620

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1464a2a8de082f66ae250d63ab9d94dbe2ef8620
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230620/2cfcc71d/attachment-0001.html>