From fc1e2510c1fa2ffba26c9b8b84a93a62cd46c461 Mon Sep 17 00:00:00 2001
From: Alfredo Di Napoli <alfredo@well-typed.com>
Date: Tue, 6 Jul 2021 15:26:53 +0200
Subject: Add TcRnIllegalWildcardsInConstructor to TcRnMessage

---
 compiler/GHC/Rename/Pat.hs      | 8 +-------
 compiler/GHC/Tc/Errors/Ppr.hs   | 8 ++++++++
 compiler/GHC/Tc/Errors/Types.hs | 9 +++++++++
 3 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index f68aceaf84..28e4c806a1 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -806,7 +806,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
            ; checkErr dd_flag (needFlagDotDot ctxt)
            ; (rdr_env, lcl_env) <- getRdrEnvs
            ; con_fields <- lookupConstructorFields con
-           ; when (null con_fields) (addErr (badDotDotCon con))
+           ; when (null con_fields) (addErr (TcRnIllegalWildcardsInConstructor con))
            ; let present_flds = mkOccSet $ map rdrNameOcc (getFieldLbls flds)
 
                    -- For constructor uses (but not patterns)
@@ -924,12 +924,6 @@ getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) f
 needFlagDotDot :: HsRecFieldContext -> TcRnMessage
 needFlagDotDot = TcRnIllegalWildcardsInRecord . toRecordFieldPart
 
-badDotDotCon :: Name -> TcRnMessage
-badDotDotCon con
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con)
-         , nest 2 (text "The constructor has no labelled fields") ]
-
 dupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> TcRnMessage
 dupFieldErr ctxt = TcRnDuplicateFieldName (toRecordFieldPart ctxt)
 
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 0d842c0e2d..0ef1d48ac5 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -88,6 +88,10 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $ vcat [text "Illegal view pattern: " <+> ppr pat]
     TcRnCharLiteralOutOfRange c
       -> mkSimpleDecorated $ text "character literal out of range: '\\" <> char c  <> char '\''
+    TcRnIllegalWildcardsInConstructor con
+      -> mkSimpleDecorated $
+           vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con)
+                , nest 2 (text "The constructor has no labelled fields") ]
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -131,6 +135,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnCharLiteralOutOfRange{}
       -> ErrorWithoutFlag
+    TcRnIllegalWildcardsInConstructor{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -174,6 +180,8 @@ instance Diagnostic TcRnMessage where
       -> [SuggestExtension LangExt.ViewPatterns]
     TcRnCharLiteralOutOfRange{}
       -> noHints
+    TcRnIllegalWildcardsInConstructor{}
+      -> noHints
 
 messageWithInfoDiagnosticMessage :: UnitState
                                  -> ErrInfo
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 0af49bc19a..6d133bff61 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -303,6 +303,15 @@ data TcRnMessage where
   -}
   TcRnCharLiteralOutOfRange :: !Char -> TcRnMessage
 
+  {-| TcRnIllegalWildcardsInConstructor is an error that occurs whenever
+      the record wildcards '..' are used inside a constructor without labeled fields.
+
+      Examples(s): None
+
+     Test cases: None
+  -}
+  TcRnIllegalWildcardsInConstructor :: !Name -> TcRnMessage
+
 -- | Which parts of a record field are affected by a particular error or warning.
 data RecordFieldPart
   = RecordFieldConstructor !Name
-- 
cgit v1.2.1