Add TcRnDuplicateFieldName to TcRnMessage

3 files changed, 31 insertions, 16 deletions

diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index b3aabc6942..eef23cf56d 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -934,16 +934,7 @@ badDotDotCon con
          , nest 2 (text "The constructor has no labelled fields") ]
 
 dupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> TcRnMessage
-dupFieldErr ctxt dups
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    hsep [text "duplicate field name",
-          quotes (ppr (NE.head dups)),
-          text "in record", pprRFC ctxt]
-
-pprRFC :: HsRecFieldContext -> SDoc
-pprRFC (HsRecFieldCon {}) = text "construction"
-pprRFC (HsRecFieldPat {}) = text "pattern"
-pprRFC (HsRecFieldUpd {}) = text "update"
+dupFieldErr ctxt = TcRnDuplicateFieldName (toRecordFieldPart ctxt)
 
 toRecordFieldPart :: HsRecFieldContext -> RecordFieldPart
 toRecordFieldPart (HsRecFieldCon n)  = RecordFieldConstructor n
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 006f081cdd..034f04f91b 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -20,6 +20,7 @@ import GHC.Hs
 import GHC.Utils.Outputable
 import GHC.Unit.State (pprWithUnitState, UnitState)
 import qualified GHC.LanguageExtensions as LangExt
+import qualified Data.List.NonEmpty as NE
 
 
 instance Diagnostic TcRnMessage where
@@ -77,11 +78,12 @@ instance Diagnostic TcRnMessage where
     TcRnIllegalFieldPunning fld
       -> mkSimpleDecorated $ text "Illegal use of punning for field" <+> quotes (ppr fld)
     TcRnIllegalWildcardsInRecord fld_part
-      -> let prt = case fld_part of
-               RecordFieldConstructor{} -> text "construction"
-               RecordFieldPattern{}     -> text "pattern"
-               RecordFieldUpdate        -> text "update"
-         in mkSimpleDecorated $ text "Illegal `..' in record" <+> prt
+      -> mkSimpleDecorated $ text "Illegal `..' in record" <+> pprRecordFieldPart fld_part
+    TcRnDuplicateFieldName fld_part dups
+      -> mkSimpleDecorated $
+           hsep [text "duplicate field name",
+                 quotes (ppr (NE.head dups)),
+                 text "in record", pprRecordFieldPart fld_part]
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -119,6 +121,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnIllegalWildcardsInRecord{}
       -> ErrorWithoutFlag
+    TcRnDuplicateFieldName{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -156,6 +160,8 @@ instance Diagnostic TcRnMessage where
       -> [SuggestExtension LangExt.RecordPuns]
     TcRnIllegalWildcardsInRecord{}
       -> [SuggestExtension LangExt.RecordWildCards]
+    TcRnDuplicateFieldName{}
+      -> noHints
 
 messageWithInfoDiagnosticMessage :: UnitState
                                  -> ErrInfo
@@ -220,3 +226,10 @@ pprLevityPolyInType ty prov =
         LevityCheckInValidClass
           -> empty
   in formatLevPolyErr ty $$ extra
+
+
+pprRecordFieldPart :: RecordFieldPart -> SDoc
+pprRecordFieldPart = \case
+  RecordFieldConstructor{} -> text "construction"
+  RecordFieldPattern{}     -> text "pattern"
+  RecordFieldUpdate        -> text "update"
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 5adad142c9..d1b61e344c 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -18,11 +18,13 @@ import GHC.Types.Name.Reader
 import GHC.Types.SrcLoc
 import GHC.Unit.Types (Module)
 import GHC.Utils.Outputable
-import Data.Typeable
 import GHC.Core.Type (Type, Var)
 import GHC.Unit.State (UnitState)
 import GHC.Types.Basic
 
+import qualified Data.List.NonEmpty as NE
+import           Data.Typeable
+
 {-
 Note [Migrating TcM Messages]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -267,6 +269,15 @@ data TcRnMessage where
   -}
   TcRnIllegalWildcardsInRecord :: !RecordFieldPart -> TcRnMessage
 
+  {-| TcRnDuplicateFieldName is an error that occurs whenever
+      there are duplicate field names in a record.
+
+      Examples(s): None.
+
+     Test cases: None.
+  -}
+  TcRnDuplicateFieldName :: !RecordFieldPart -> NE.NonEmpty RdrName -> TcRnMessage
+
 -- | Which parts of a record field are affected by a particular error or warning.
 data RecordFieldPart
   = RecordFieldConstructor !Name