Refactor getCaretDiagnosticwip/ghc-21100

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

====
Add comments and use explicit fields

Use explicit fields On `UnknownAssociatedType` and
`SuggestDeclareAssociatedType` ctors, just so the constructors are a
little better documented

12 files changed, 102 insertions, 18 deletions

diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 7f3edf841c..8f650fccfd 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/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 ) }
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 3d3ded48f0..c79dfb38c1 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/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
 
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 8dae970dee..4ace7d3398 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/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 
 
 {- *********************************************************************
 *                                                                      *
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 854ebd3bf6..0ce9831dfb 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -3248,6 +3248,13 @@ 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.
+  | UnknownAssociatedType 
+    { typeclassName :: Name -- ^ The name of the typeclass with the missing type decl 
+    , associatedTypeName :: RdrName -- ^ The name of the undeclared associated type
+    , srcCode :: Maybe String -- ^ The source code that caused the error. Derived from SrcSpan
+    }
   deriving Generic
 
 -- | Create a @"not in scope"@ error message for the given 'RdrName'.
diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs
index 3c8ff8b4bb..d2deb57d63 100644
--- a/compiler/GHC/Types/Error.hs
+++ b/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
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
index 00346aa722..b039193224 100644
--- a/compiler/GHC/Types/Error/Codes.hs
+++ b/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
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index 31f8d4422b..8ae2733baa 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -417,6 +417,13 @@ data GhcHint
         Test cases: none
     -}
   | SuggestSpecialiseVisibilityHints Name
+    {-| Suggest to declare the associated type
+    -}
+  | SuggestDeclareAssociatedType 
+      { typeclassName :: Name -- ^ The name of the typeclass with the missing type decl 
+      , associatedTypeName :: RdrName -- ^ The name of the undeclared associated type
+      , typeDecl :: Maybe String -- ^ The code suggestion of how to declare the associated type
+      }
 
 -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
 -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index 53890e8daf..25b6476aab 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/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"
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
index 546803fcde..0aa62b1e37 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
+++ b/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
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
index 30595d68aa..3dba70418f 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
+++ b/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
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
index 1d2494243e..e51fae1abd 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
+++ b/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
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
index 4bcf093a88..c8b84a6dbd 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
+++ b/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