[Git][ghc/ghc][wip/ghc-21100] Refactor getCaretDiagnostic
Vance Palacio (@vanceism7)
gitlab at gitlab.haskell.org
Tue Oct 25 21:45:11 UTC 2022
Vance Palacio pushed to branch wip/ghc-21100 at Glasgow Haskell Compiler / GHC
Commits:
9c77b034 by Vance Palacio at 2022-10-25T11:26:47-07:00
Refactor getCaretDiagnostic
In order to properly create this error message, we need access to the
line of code that caused the error. We need it without the carets
though, so we factor the part of `getCaretDiagnostic` out that grabs
the code
====
Add a new value ctor for `NotInScopeError`
Types.hs:
We need a new value ctor for `NotInScopeError` so we can tell if the
error is specifically related to associated types.
Codes.hs:
Because we made a new ctor, we also need a new error code for it.
====
Create the `UnknownAssociatedType` error
Env.hs:
The only way we can tell that we're dealing with an associated type is
via the `what` parameter. We change the parameter type to a
string, deferring SDoc creation to within `lookupInstDeclBndr` so
we can examine what `what` is. If it's `associated type`, we throw out
the `err` contained in `mb_name` and create the more specific
`UnknownAssociatedType` error. Otherwise we just do the normal thing.
Bind.hs: Pass our `what` param in as a plain string since
`lookupInstDeclBndr` requires that now
====
Construct the associated type error message
Now that we have everything in place, we can create our error message
for unknown associated types.
====
Accomodate for the `Maybe String`
I'm not exactly sure why the srcSpan would fail to generate a code,
but if it does, we use a simplified error message
====
Reword error and use `GhcHint`
I might've gone too far with this one, but we can just switch it back
if so. I thought of new wording for the error that might be a little
more direct.
We also utilize GhcHint for the suggestion on how to resolve the error.
Hint.hs:
Create a new value ctor for GhcHint: `SuggestDeclareAssociatedType`
which instructs the user how to resolve `UnknownAssociatedType` error.
Types.hs:
We add `RdrName` as a parameter to `UnknownAssociatedType` so we can
hand it off to our new GhcHint type
Env.hs:
We pass the RdrName to UnknownAssociatedType so we have it available
when creating the hint in `scopeErrorHints`
Errors/Ppr.hs:
Reword the error message and remove the resolution hint since it's been
moved to GhcHint
In `scopeErrorHints`, we pass the params from `UnknownAssociatedType`
to `SuggestDeclareAssociatedType`.
Hint/Ppr.hs:
We add in our SDoc wording for the `SuggestDeclareAssociatedType` hint
====
Update some failing test cases for the new wording
- - - - -
12 changed files:
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
- testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
- testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
- testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
Changes:
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -936,7 +936,7 @@ rnMethodBindLHS :: Bool -> Name
-> RnM (LHsBindsLR GhcRn GhcPs)
rnMethodBindLHS _ cls (L loc bind@(FunBind { fun_id = name })) rest
= setSrcSpanA loc $ do
- do { sel_name <- wrapLocMA (lookupInstDeclBndr cls (text "method")) name
+ do { sel_name <- wrapLocMA (lookupInstDeclBndr cls "method") name
-- We use the selector name as the binder
; let bind' = bind { fun_id = sel_name, fun_ext = noExtField }
; return (L loc bind' `consBag` rest ) }
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -350,7 +350,7 @@ lookupExactOcc_either name
}
-----------------------------------------------
-lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
+lookupInstDeclBndr :: Name -> String -> RdrName -> RnM Name
-- This is called on the method name on the left-hand side of an
-- instance declaration binding. eg. instance Functor T where
-- fmap = ...
@@ -378,11 +378,20 @@ lookupInstDeclBndr cls what rdr
-- when it's used
cls doc rdr
; case mb_name of
- Left err -> do { addErr (mkTcRnNotInScope rdr err)
+ Left err ->
+ -- If `what` is an associated type, we ignore the `err` value and create
+ -- our own error specifically dealing with associated types
+ case what of
+ "associated type" -> do { srcSpan <- getSrcSpanM
+ ; code <- liftIO $ getSrcCodeString srcSpan
+ ; addErr (mkTcRnNotInScope rdr (UnknownAssociatedType cls rdr code))
+ ; return (mkUnboundNameRdr rdr) }
+
+ _ -> do { addErr (mkTcRnNotInScope rdr err)
; return (mkUnboundNameRdr rdr) }
Right nm -> return nm }
where
- doc = what <+> text "of class" <+> quotes (ppr cls)
+ doc = text what <+> text "of class" <+> quotes (ppr cls)
-----------------------------------------------
lookupFamInstName :: Maybe Name -> LocatedN RdrName
@@ -390,7 +399,7 @@ lookupFamInstName :: Maybe Name -> LocatedN RdrName
-- Used for TyData and TySynonym family instances only,
-- See Note [Family instance binders]
lookupFamInstName (Just cls) tc_rdr -- Associated type; c.f GHC.Rename.Bind.rnMethodBind
- = wrapLocMA (lookupInstDeclBndr cls (text "associated type")) tc_rdr
+ = wrapLocMA (lookupInstDeclBndr cls "associated type") tc_rdr
lookupFamInstName Nothing tc_rdr -- Family instance; tc_rdr is an *occurrence*
= lookupLocatedOccRnConstr tc_rdr
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3074,7 +3074,20 @@ pprScopeError rdr_name scope_err =
hang (text "No top-level binding for")
2 (what <+> quotes (ppr rdr_name) <+> text "in this module")
UnknownSubordinate doc ->
- quotes (ppr rdr_name) <+> text "is not a (visible)" <+> doc
+ quotes (ppr rdr_name) <+> text "is not a (visible)" <+> doc
+ UnknownAssociatedType _ _ code ->
+ case code of
+ Just c ->
+ text "The line:"
+ $+$ nest 2 (pprCode $ text c)
+ $+$ text "defines a default equation for type" <+> sname
+ <+> text "but" <+> sname <+> text "itself has not been declared."
+ Nothing ->
+ text "A default equation for" <+> sname <+> text "was found, but" <+> sname
+ <+> text "has not been declared."
+ where
+ sname = quotes (ppr rdr_name)
+
where
what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
@@ -3087,6 +3100,9 @@ scopeErrorHints scope_err =
MissingBinding _ hints -> hints
NoTopLevelBinding -> noHints
UnknownSubordinate {} -> noHints
+ UnknownAssociatedType name rdr code ->
+ [SuggestDeclareAssociatedType name rdr decl]
+ where decl = head . split '=' <$> code
{- *********************************************************************
* *
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -3248,6 +3248,10 @@ data NotInScopeError
-- or, a class doesn't have an associated type with this name,
-- or, a record doesn't have a record field with this name.
| UnknownSubordinate SDoc
+
+ -- | A class doesn't have an associated type with this name
+ -- (Maybe String) is the snippet of code that has caused the error
+ | UnknownAssociatedType Name RdrName (Maybe String)
deriving Generic
-- | Create a @"not in scope"@ error message for the given 'RdrName'.
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -56,6 +56,7 @@ module GHC.Types.Error
, pprMessageBag
, mkLocMessage
, mkLocMessageWarningGroups
+ , getSrcCodeString
, getCaretDiagnostic
-- * Queries
, isIntrinsicErrorMessage
@@ -526,10 +527,14 @@ getMessageClassColour (MCDiagnostic SevWarning _reason _code) = Col.sWarning
getMessageClassColour MCFatal = Col.sFatal
getMessageClassColour _ = const mempty
-getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc
-getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty
-getCaretDiagnostic msg_class (RealSrcSpan span _) =
- caretDiagnostic <$> getSrcLine (srcSpanFile span) row
+-- | Get the snippet of code referenced by `SrcSpan`
+--
+-- We need this so that we can include the source code within our error message.
+-- E.g: https://gitlab.haskell.org/ghc/ghc/-/issues/21100
+getSrcCodeString :: SrcSpan -> IO (Maybe String)
+getSrcCodeString (UnhelpfulSpan _) = pure Nothing
+getSrcCodeString (RealSrcSpan span _) =
+ getSrcLine (srcSpanFile span) row
where
getSrcLine fn i =
getLine i (unpackFS fn)
@@ -549,11 +554,18 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) =
_ -> Nothing
_ -> pure Nothing
+ row = srcSpanStartLine span
+
-- allow user to visibly see that their code is incorrectly encoded
-- (StringBuffer.nextChar uses \0 to represent undecodable characters)
fix '\0' = '\xfffd'
fix c = c
+getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc
+getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty
+getCaretDiagnostic msg_class srcSpan@(RealSrcSpan span _) =
+ caretDiagnostic <$> getSrcCodeString srcSpan
+ where
row = srcSpanStartLine span
rowStr = show row
multiline = row /= srcSpanEndLine span
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -502,6 +502,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "MissingBinding" = 44432
GhcDiagnosticCode "NoTopLevelBinding" = 10173
GhcDiagnosticCode "UnknownSubordinate" = 54721
+ GhcDiagnosticCode "UnknownAssociatedType" = 87875
-- Diagnostic codes for deriving
GhcDiagnosticCode "DerivErrNotWellKinded" = 62016
=====================================
compiler/GHC/Types/Hint.hs
=====================================
@@ -417,6 +417,9 @@ data GhcHint
Test cases: none
-}
| SuggestSpecialiseVisibilityHints Name
+ {-| Suggest to declare the associated type
+ -}
+ | SuggestDeclareAssociatedType Name RdrName (Maybe String)
-- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
-- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -206,6 +206,14 @@ instance Outputable GhcHint where
<+> quotes (ppr name) <+> text "has an INLINABLE pragma"
where
mod = nameModule name
+ SuggestDeclareAssociatedType name rdrName (Just decl)
+ -> text "Declare" <+> quotes (ppr rdrName) <+> text "by adding:"
+ $+$ nest 2 (pprCode $ text decl)
+ $+$ text "to the class" <+> quotes (ppr name)
+ SuggestDeclareAssociatedType name rdrName Nothing
+ -> text "Declare the associated type" <+> quotes (ppr rdrName)
+ <+> text "for class" <+> quotes (ppr name)
+ <+> text "in addition to the default equation"
perhapsAsPat :: SDoc
perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
=====================================
testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
=====================================
@@ -1,3 +1,9 @@
-AssocTyDef01.hs:9:10: error: [GHC-54721]
- ‘OtherType’ is not a (visible) associated type of class ‘Cls’
+AssocTyDef01.hs:9:10: [GHC-87875]
+ The line:
+ type OtherType a = Int
+ defines a default equation for type ‘OtherType’ but ‘OtherType’ itself has not been declared.
+ Suggested fix:
+ Declare ‘OtherType’ by adding:
+ type OtherType a
+ to the class ‘Cls’
\ No newline at end of file
=====================================
testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
=====================================
@@ -1,3 +1,9 @@
-AssocTyDef07.hs:5:10: error: [GHC-54721]
- ‘Typ’ is not a (visible) associated type of class ‘Cls’
+AssocTyDef07.hs:5:10: [GHC-87875]
+ The line:
+ type Typ a = Int
+ defines a default equation for type ‘Typ’ but ‘Typ’ itself has not been declared.
+ Suggested fix:
+ Declare ‘Typ’ by adding:
+ type Typ a
+ to the class ‘Cls’
\ No newline at end of file
=====================================
testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
=====================================
@@ -1,3 +1,9 @@
-AssocTyDef08.hs:4:10: error: [GHC-54721]
- ‘Typ’ is not a (visible) associated type of class ‘Cls’
+AssocTyDef08.hs:4:10: [GHC-87875]
+ The line:
+ type Typ a = Int
+ defines a default equation for type ‘Typ’ but ‘Typ’ itself has not been declared.
+ Suggested fix:
+ Declare ‘Typ’ by adding:
+ type Typ a
+ to the class ‘Cls’
\ No newline at end of file
=====================================
testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
=====================================
@@ -1,3 +1,9 @@
-AssocTyDef09.hs:8:10: error: [GHC-54721]
- ‘OtherType’ is not a (visible) associated type of class ‘Cls’
+AssocTyDef09.hs:8:10: [GHC-87875]
+ The line:
+ type OtherType a = Int
+ defines a default equation for type ‘OtherType’ but ‘OtherType’ itself has not been declared.
+ Suggested fix:
+ Declare ‘OtherType’ by adding:
+ type OtherType a
+ to the class ‘Cls’
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c77b0346ea0b959980ac1332c185023e58c0b31
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c77b0346ea0b959980ac1332c185023e58c0b31
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/20221025/318054ef/attachment-0001.html>
More information about the ghc-commits
mailing list