Convert Diagnostics GHC.Tc.Gen.* (Part 3)

Converts all diagnostics in the `GHC.Tc.Gen.Expr` module.

(#20116)

3 files changed, 266 insertions, 107 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 841f0aa713..6975eeb9d3 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -19,13 +19,13 @@ import GHC.Core.Type
 import GHC.Data.Bag
 import GHC.Tc.Errors.Types
 import GHC.Tc.Types.Rank (Rank(..))
-import GHC.Tc.Utils.TcType (tcSplitForAllTyVars)
+import GHC.Tc.Utils.TcType (TcType, tcSplitForAllTyVars)
 import GHC.Types.Error
-import GHC.Types.FieldLabel (flIsOverloaded, flSelector)
+import GHC.Types.FieldLabel (FieldLabelString, flIsOverloaded, flSelector)
 import GHC.Types.Id (isRecordSelector)
 import GHC.Types.Name
 import GHC.Types.Name.Reader (GreName(..), pprNameProvenance)
-import GHC.Types.SrcLoc (GenLocated(..))
+import GHC.Types.SrcLoc (GenLocated(..), unLoc)
 import GHC.Types.TyThing
 import GHC.Types.Var.Env (emptyTidyEnv)
 import GHC.Types.Var.Set (pprVarSet, pluralVarSet)
@@ -398,6 +398,79 @@ instance Diagnostic TcRnMessage where
         ppr_name (FieldGreName fl) | flIsOverloaded fl = ppr fl
                                    | otherwise         = ppr (flSelector fl)
         ppr_name (NormalGreName name) = ppr name
+    TcRnAmbiguousField rupd parent_type
+      -> mkSimpleDecorated $
+          vcat [ text "The record update" <+> ppr rupd
+                   <+> text "with type" <+> ppr parent_type
+                   <+> text "is ambiguous."
+               , text "This will not be supported by -XDuplicateRecordFields in future releases of GHC."
+               ]
+    TcRnMissingFields con fields
+      -> mkSimpleDecorated $ vcat [header, nest 2 rest]
+         where
+           rest | null fields = empty
+                | otherwise   = vcat (fmap pprField fields)
+           header = text "Fields of" <+> quotes (ppr con) <+>
+                    text "not initialised" <>
+                    if null fields then empty else colon
+    TcRnFieldUpdateInvalidType prs
+      -> mkSimpleDecorated $
+           hang (text "Record update for insufficiently polymorphic field"
+                   <> plural prs <> colon)
+              2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ])
+    TcRnNoConstructorHasAllFields conflictingFields
+      -> mkSimpleDecorated $
+           hang (text "No constructor has all these fields:")
+              2 (pprQuotedList conflictingFields)
+    TcRnMixedSelectors data_name data_sels pat_name pat_syn_sels
+      -> mkSimpleDecorated $
+           text "Cannot use a mixture of pattern synonym and record selectors" $$
+           text "Record selectors defined by"
+             <+> quotes (ppr data_name)
+             <> colon
+             <+> pprWithCommas ppr data_sels $$
+           text "Pattern synonym selectors defined by"
+             <+> quotes (ppr pat_name)
+             <> colon
+             <+> pprWithCommas ppr pat_syn_sels
+    TcRnMissingStrictFields con fields
+      -> mkSimpleDecorated $ vcat [header, nest 2 rest]
+         where
+           rest | null fields = empty  -- Happens for non-record constructors
+                                       -- with strict fields
+                | otherwise   = vcat (fmap pprField fields)
+
+           header = text "Constructor" <+> quotes (ppr con) <+>
+                    text "does not have the required strict field(s)" <>
+                    if null fields then empty else colon
+    TcRnNoPossibleParentForFields rbinds
+      -> mkSimpleDecorated $
+           hang (text "No type has all these fields:")
+              2 (pprQuotedList fields)
+         where fields = map (hfbLHS . unLoc) rbinds
+    TcRnBadOverloadedRecordUpdate _rbinds
+      -> mkSimpleDecorated $
+           text "Record update is ambiguous, and requires a type signature"
+    TcRnStaticFormNotClosed name reason
+      -> mkSimpleDecorated $
+           quotes (ppr name)
+             <+> text "is used in a static form but it is not closed"
+             <+> text "because it"
+             $$ sep (causes reason)
+         where
+          causes :: NotClosedReason -> [SDoc]
+          causes NotLetBoundReason = [text "is not let-bound."]
+          causes (NotTypeClosed vs) =
+            [ text "has a non-closed type because it contains the"
+            , text "type variables:" <+>
+              pprVarSet vs (hsep . punctuate comma . map (quotes . ppr))
+            ]
+          causes (NotClosed n reason) =
+            let msg = text "uses" <+> quotes (ppr n) <+> text "which"
+             in case reason of
+                  NotClosed _ _ -> msg : causes reason
+                  _   -> let (xs0, xs1) = splitAt 1 $ causes reason
+                          in fmap (msg <+>) xs0 ++ xs1
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -553,6 +626,24 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnConflictingExports{}
       -> ErrorWithoutFlag
+    TcRnAmbiguousField{}
+      -> WarningWithFlag Opt_WarnAmbiguousFields
+    TcRnMissingFields{}
+      -> WarningWithFlag Opt_WarnMissingFields
+    TcRnFieldUpdateInvalidType{}
+      -> ErrorWithoutFlag
+    TcRnNoConstructorHasAllFields{}
+      -> ErrorWithoutFlag
+    TcRnMixedSelectors{}
+      -> ErrorWithoutFlag
+    TcRnMissingStrictFields{}
+      -> ErrorWithoutFlag
+    TcRnNoPossibleParentForFields{}
+      -> ErrorWithoutFlag
+    TcRnBadOverloadedRecordUpdate{}
+      -> ErrorWithoutFlag
+    TcRnStaticFormNotClosed{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -724,6 +815,24 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnConflictingExports{}
       -> noHints
+    TcRnAmbiguousField{}
+      -> noHints
+    TcRnMissingFields{}
+      -> noHints
+    TcRnFieldUpdateInvalidType{}
+      -> noHints
+    TcRnNoConstructorHasAllFields{}
+      -> noHints
+    TcRnMixedSelectors{}
+      -> noHints
+    TcRnMissingStrictFields{}
+      -> noHints
+    TcRnNoPossibleParentForFields{}
+      -> noHints
+    TcRnBadOverloadedRecordUpdate{}
+      -> noHints
+    TcRnStaticFormNotClosed{}
+      -> noHints
 
 messageWithInfoDiagnosticMessage :: UnitState
                                  -> ErrInfo
@@ -789,6 +898,8 @@ pprLevityPolyInType ty prov =
           -> empty
   in formatLevPolyErr ty $$ extra
 
+pprField :: (FieldLabelString, TcType) -> SDoc
+pprField (f,ty) = ppr f <+> dcolon <+> ppr ty
 
 pprRecordFieldPart :: RecordFieldPart -> SDoc
 pprRecordFieldPart = \case
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 4272ac9a4a..7bcd83c98c 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -12,6 +12,7 @@ module GHC.Tc.Errors.Types (
   , hasKinds
   , SuggestUndecidableInstances(..)
   , suggestUndecidableInstances
+  , NotClosedReason(..)
   ) where
 
 import GHC.Prelude
@@ -20,15 +21,20 @@ import GHC.Hs
 import {-# SOURCE #-} GHC.Tc.Types (TcIdSigInfo)
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Rank (Rank)
+import GHC.Tc.Utils.TcType (TcType)
 import GHC.Types.Error
+import GHC.Types.FieldLabel (FieldLabelString)
 import GHC.Types.Name (Name, OccName)
 import GHC.Types.Name.Reader
 import GHC.Types.SrcLoc
 import GHC.Types.TyThing (TyThing)
+import GHC.Types.Var (Id)
+import GHC.Types.Var.Set (TyVarSet, VarSet)
 import GHC.Unit.Types (Module)
 import GHC.Utils.Outputable
 import GHC.Core.Class (Class)
 import GHC.Core.Coercion.Axiom (CoAxBranch)
+import GHC.Core.ConLike (ConLike)
 import GHC.Core.FamInstEnv (FamInst)
 import GHC.Core.InstEnv (ClsInst)
 import GHC.Core.TyCon (TyCon, TyConFlavour)
@@ -36,7 +42,6 @@ import GHC.Core.Type (Kind, Type, Var)
 import GHC.Unit.State (UnitState)
 import GHC.Unit.Module.Name (ModuleName)
 import GHC.Types.Basic
-import GHC.Types.Var.Set (TyVarSet)
 
 import qualified Data.List.NonEmpty as NE
 import           Data.Typeable hiding (TyCon)
@@ -1097,6 +1102,135 @@ data TcRnMessage where
     -> IE GhcPs -- ^ Export decl of second export
     -> TcRnMessage
 
+  {-| TcRnAmbiguousField is a warning controlled by -Wambiguous-fields occurring
+      when a record update's type cannot be precisely determined. This will not
+      be supported by -XDuplicateRecordFields in future releases.
+
+      Example(s):
+      data Person  = MkPerson  { personId :: Int, name :: String }
+      data Address = MkAddress { personId :: Int, address :: String }
+      bad1 x = x { personId = 4 } :: Person -- ambiguous
+      bad2 (x :: Person) = x { personId = 4 } -- ambiguous
+      good x = (x :: Person) { personId = 4 } -- not ambiguous
+
+     Test cases: overloadedrecflds/should_fail/overloadedrecfldsfail06
+  -}
+  TcRnAmbiguousField
+    :: HsExpr GhcRn -- ^ Field update
+    -> TyCon -- ^ Record type
+    -> TcRnMessage
+
+  {-| TcRnMissingFields is a warning controlled by -Wmissing-fields occurring
+      when the intialisation of a record is missing one or more (lazy) fields.
+
+      Example(s):
+      data Rec = Rec { a :: Int, b :: String, c :: Bool }
+      x = Rec { a = 1, b = "two" } -- missing field 'c'
+
+     Test cases: deSugar/should_compile/T13870
+                 deSugar/should_compile/ds041
+                 patsyn/should_compile/T11283
+                 rename/should_compile/T5334
+                 rename/should_compile/T12229
+                 rename/should_compile/T5892a
+                 warnings/should_fail/WerrorFail2
+  -}
+  TcRnMissingFields :: ConLike -> [(FieldLabelString, TcType)] -> TcRnMessage
+
+  {-| TcRnFieldUpdateInvalidType is an error occurring when an updated field's
+      type mentions something that is outside the universally quantified variables
+      of the data constructor, such as an existentially quantified type.
+
+      Example(s):
+      data X = forall a. MkX { f :: a }
+      x = (MkX ()) { f = False }
+
+      Test cases: patsyn/should_fail/records-exquant
+                  typecheck/should_fail/T3323
+  -}
+  TcRnFieldUpdateInvalidType :: [(FieldLabelString,TcType)] -> TcRnMessage
+
+  {-| TcRnNoConstructorHasAllFields is an error that occurs when a record update
+      has fields that no single constructor encompasses.
+
+      Example(s):
+      data Foo = A { x :: Bool }
+               | B { y :: Int }
+      foo = (A False) { x = True, y = 5 }
+
+     Test cases: overloadedrecflds/should_fail/overloadedrecfldsfail08
+                 patsyn/should_fail/mixed-pat-syn-record-sels
+                 typecheck/should_fail/T7989
+  -}
+  TcRnNoConstructorHasAllFields :: [FieldLabelString] -> TcRnMessage
+
+  {- TcRnMixedSelectors is an error for when a mixture of pattern synonym and
+      record selectors are used in the same record update block.
+
+      Example(s):
+      data Rec = Rec { foo :: Int, bar :: String }
+      pattern Pat { f1, f2 } = Rec { foo = f1, bar = f2 }
+      illegal :: Rec -> Rec
+      illegal r = r { f1 = 1, bar = "two" }
+
+     Test cases: patsyn/should_fail/records-mixing-fields
+  -}
+  TcRnMixedSelectors
+    :: Name -- ^ Record
+    -> [Id] -- ^ Record selectors
+    -> Name -- ^ Pattern synonym
+    -> [Id] -- ^ Pattern selectors
+    -> TcRnMessage
+
+  {- TcRnMissingStrictFields is an error occurring when a record field marked
+     as strict is omitted when constructing said record.
+
+     Example(s):
+     data R = R { strictField :: !Bool, nonStrict :: Int }
+     x = R { nonStrict = 1 }
+
+    Test cases: typecheck/should_fail/T18869
+                typecheck/should_fail/tcfail085
+                typecheck/should_fail/tcfail112
+  -}
+  TcRnMissingStrictFields :: ConLike -> [(FieldLabelString, TcType)] -> TcRnMessage
+
+  {- TcRnNoPossibleParentForFields is an error thrown when the fields used in a
+     record update block do not all belong to any one type.
+
+     Example(s):
+     data R1 = R1 { x :: Int, y :: Int }
+     data R2 = R2 { y :: Int, z :: Int }
+     update r = r { x = 1, y = 2, z = 3 }
+
+    Test cases: overloadedrecflds/should_fail/overloadedrecfldsfail01
+                overloadedrecflds/should_fail/overloadedrecfldsfail14
+  -}
+  TcRnNoPossibleParentForFields :: [LHsRecUpdField GhcRn] -> TcRnMessage
+
+  {- TcRnBadOverloadedRecordUpdate is an error for a record update that cannot
+     be pinned down to any one constructor and thus must be given a type signature.
+
+     Example(s):
+     data R1 = R1 { x :: Int }
+     data R2 = R2 { x :: Int }
+     update r = r { x = 1 } -- needs a type signature
+
+    Test cases: overloadedrecflds/should_fail/overloadedrecfldsfail01
+  -}
+  TcRnBadOverloadedRecordUpdate :: [LHsRecUpdField GhcRn] -> TcRnMessage
+
+  {- TcRnStaticFormNotClosed is an error pertaining to terms that are marked static
+     using the -XStaticPointers extension but which are not closed terms.
+
+     Example(s):
+     f x = static x
+
+    Test cases: rename/should_fail/RnStaticPointersFail01
+                rename/should_fail/RnStaticPointersFail03
+  -}
+  TcRnStaticFormNotClosed :: Name -> NotClosedReason -> TcRnMessage
+
 -- | Which parts of a record field are affected by a particular error or warning.
 data RecordFieldPart
   = RecordFieldConstructor !Name
@@ -1151,3 +1285,9 @@ data SuggestUndecidableInstances
 suggestUndecidableInstances :: Bool -> SuggestUndecidableInstances
 suggestUndecidableInstances True  = YesSuggestUndecidableInstaces
 suggestUndecidableInstances False = NoSuggestUndecidableInstaces
+
+-- | A data type to describe why a variable is not closed.
+-- See Note [Not-closed error messages] in GHC.Tc.Gen.Expr
+data NotClosedReason = NotLetBoundReason
+                     | NotTypeClosed VarSet
+                     | NotClosed Name NotClosedReason
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index d61bbbe694..899a69353e 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -738,7 +738,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds }) res_
               con1_tv_set  = mkVarSet con1_tvs
               bad_fld (fld, ty) = fld `elem` upd_fld_occs &&
                                       not (tyCoVarsOfType ty `subVarSet` con1_tv_set)
-        ; checkTc (null bad_upd_flds) (badFieldTypes bad_upd_flds)
+        ; checkTc (null bad_upd_flds) (TcRnFieldUpdateInvalidType bad_upd_flds)
 
         -- STEP 4  Note [Type of a record update]
         -- Figure out types for the scrutinee and result
@@ -1218,7 +1218,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
     identifyParent fam_inst_envs possible_parents
       = case foldr1 intersect possible_parents of
         -- No parents for all fields: record update is ill-typed
-        []  -> failWithTc (noPossibleParents rbnds)
+        []  -> failWithTc (TcRnNoPossibleParentForFields rbnds)
 
         -- Exactly one datatype with all the fields: use that
         [p] -> return p
@@ -1237,7 +1237,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
                   ; return (RecSelData tc) }
 
         -- Nothing else we can try...
-        _ -> failWithTc badOverloadedUpdate
+        _ -> failWithTc (TcRnBadOverloadedRecordUpdate rbnds)
 
     -- Make a field unambiguous by choosing the given parent.
     -- Emits an error if the field cannot have that parent,
@@ -1286,13 +1286,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
     -- See Note [Deprecating ambiguous fields] in GHC.Tc.Gen.Head
     reportAmbiguousField :: TyCon -> TcM ()
     reportAmbiguousField parent_type =
-        setSrcSpan loc $ addDiagnostic $
-          TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnAmbiguousFields) noHints $
-          vcat [ text "The record update" <+> ppr rupd
-                   <+> text "with type" <+> ppr parent_type
-                   <+> text "is ambiguous."
-               , text "This will not be supported by -XDuplicateRecordFields in future releases of GHC."
-               ]
+        setSrcSpan loc $ addDiagnostic $ TcRnAmbiguousField rupd parent_type
       where
         rupd = RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds, rupd_ext = noExtField }
         loc  = getLocA (head rbnds)
@@ -1401,13 +1395,10 @@ checkMissingFields con_like rbinds arg_tys
                         -- But C{} is still valid if no strict fields
   = if any isBanged field_strs then
         -- Illegal if any arg is strict
-        addErrTc (missingStrictFields con_like [])
+        addErrTc (TcRnMissingStrictFields con_like [])
     else do
         when (notNull field_strs && null field_labels) $ do
-          let msg = TcRnUnknownMessage $
-                mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingFields)
-                                  noHints
-                                  (missingFields con_like [])
+          let msg = TcRnMissingFields con_like []
           (diagnosticTc True msg)
 
   | otherwise = do              -- A record
@@ -1415,7 +1406,7 @@ checkMissingFields con_like rbinds arg_tys
         fs <- zonk_fields missing_s_fields
         -- It is an error to omit a strict field, because
         -- we can't substitute it with (error "Missing field f")
-        addErrTc (missingStrictFields con_like fs)
+        addErrTc (TcRnMissingStrictFields con_like fs)
 
     warn <- woptM Opt_WarnMissingFields
     when (warn && notNull missing_ns_fields) $ do
@@ -1423,10 +1414,7 @@ checkMissingFields con_like rbinds arg_tys
         -- It is not an error (though we may want) to omit a
         -- lazy field, because we can always use
         -- (error "Missing field f") instead.
-        let msg = TcRnUnknownMessage $
-              mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingFields)
-                                noHints
-                                (missingFields con_like fs)
+        let msg = TcRnMissingFields con_like fs
         diagnosticTc True msg
 
   where
@@ -1468,22 +1456,13 @@ fieldCtxt :: FieldLabelString -> SDoc
 fieldCtxt field_name
   = text "In the" <+> quotes (ppr field_name) <+> text "field of a record"
 
-badFieldTypes :: [(FieldLabelString,TcType)] -> TcRnMessage
-badFieldTypes prs
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    hang (text "Record update for insufficiently polymorphic field"
-                         <> plural prs <> colon)
-       2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ])
-
 badFieldsUpd
   :: [LHsFieldBind GhcTc (LAmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
                -- Field names that don't belong to a single datacon
   -> [ConLike] -- Data cons of the type which the first field name belongs to
   -> TcRnMessage
 badFieldsUpd rbinds data_cons
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    hang (text "No constructor has all these fields:")
-       2 (pprQuotedList conflictingFields)
+  = TcRnNoConstructorHasAllFields conflictingFields
           -- See Note [Finding the conflicting fields]
   where
     -- A (preferably small) set of fields such that no constructor contains
@@ -1554,60 +1533,12 @@ a decent stab, no more.  See #7989.
 
 mixedSelectors :: [Id] -> [Id] -> TcRnMessage
 mixedSelectors data_sels@(dc_rep_id:_) pat_syn_sels@(ps_rep_id:_)
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    text "Cannot use a mixture of pattern synonym and record selectors" $$
-    text "Record selectors defined by"
-      <+> quotes (ppr (tyConName rep_dc))
-      <> colon
-      <+> pprWithCommas ppr data_sels $$
-    text "Pattern synonym selectors defined by"
-      <+> quotes (ppr (patSynName rep_ps))
-      <> colon
-      <+> pprWithCommas ppr pat_syn_sels
+  = TcRnMixedSelectors (tyConName rep_dc) data_sels (patSynName rep_ps) pat_syn_sels
   where
     RecSelPatSyn rep_ps = recordSelectorTyCon ps_rep_id
     RecSelData rep_dc = recordSelectorTyCon dc_rep_id
 mixedSelectors _ _ = panic "GHC.Tc.Gen.Expr: mixedSelectors emptylists"
 
-
-missingStrictFields :: ConLike -> [(FieldLabelString, TcType)] -> TcRnMessage
-missingStrictFields con fields
-  = TcRnUnknownMessage $ mkPlainError noHints $ vcat [header, nest 2 rest]
-  where
-    pprField (f,ty) = ppr f <+> dcolon <+> ppr ty
-    rest | null fields = Outputable.empty  -- Happens for non-record constructors
-                                           -- with strict fields
-         | otherwise   = vcat (fmap pprField fields)
-
-    header = text "Constructor" <+> quotes (ppr con) <+>
-             text "does not have the required strict field(s)" <>
-             if null fields then Outputable.empty else colon
-
-missingFields :: ConLike -> [(FieldLabelString, TcType)] -> SDoc
-missingFields con fields
-  = vcat [header, nest 2 rest]
-  where
-    pprField (f,ty) = ppr f <+> text "::" <+> ppr ty
-    rest | null fields = Outputable.empty
-         | otherwise   = vcat (fmap pprField fields)
-    header = text "Fields of" <+> quotes (ppr con) <+>
-             text "not initialised" <>
-             if null fields then Outputable.empty else colon
-
--- callCtxt fun args = text "In the call" <+> parens (ppr (foldl' mkHsApp fun args))
-
-noPossibleParents :: [LHsRecUpdField GhcRn] -> TcRnMessage
-noPossibleParents rbinds
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    hang (text "No type has all these fields:")
-       2 (pprQuotedList fields)
-  where
-    fields = map (hfbLHS . unLoc) rbinds
-
-badOverloadedUpdate :: TcRnMessage
-badOverloadedUpdate = TcRnUnknownMessage $ mkPlainError noHints $
-  text "Record update is ambiguous, and requires a type signature"
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1616,11 +1547,6 @@ badOverloadedUpdate = TcRnUnknownMessage $ mkPlainError noHints $
 ************************************************************************
 -}
 
--- | A data type to describe why a variable is not closed.
-data NotClosedReason = NotLetBoundReason
-                     | NotTypeClosed VarSet
-                     | NotClosed Name NotClosedReason
-
 -- | Checks if the given name is closed and emits an error if not.
 --
 -- See Note [Not-closed error messages].
@@ -1686,25 +1612,7 @@ checkClosedInStaticForm name = do
     -- when the final node has a non-closed type.
     --
     explain :: Name -> NotClosedReason -> TcRnMessage
-    explain name reason = TcRnUnknownMessage $ mkPlainError noHints $
-      quotes (ppr name) <+> text "is used in a static form but it is not closed"
-                        <+> text "because it"
-                        $$
-                        sep (causes reason)
-
-    causes :: NotClosedReason -> [SDoc]
-    causes NotLetBoundReason = [text "is not let-bound."]
-    causes (NotTypeClosed vs) =
-      [ text "has a non-closed type because it contains the"
-      , text "type variables:" <+>
-        pprVarSet vs (hsep . punctuate comma . map (quotes . ppr))
-      ]
-    causes (NotClosed n reason) =
-      let msg = text "uses" <+> quotes (ppr n) <+> text "which"
-       in case reason of
-            NotClosed _ _ -> msg : causes reason
-            _   -> let (xs0, xs1) = splitAt 1 $ causes reason
-                    in fmap (msg <+>) xs0 ++ xs1
+    explain = TcRnStaticFormNotClosed
 
 -- Note [Not-closed error messages]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~