diff options
author | Alfredo Di Napoli <alfredo@well-typed.com> | 2021-07-06 12:48:49 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-07-09 08:46:44 -0400 |
commit | e17850c4b9b988809dafbd6a35c7b3c3bf050dd5 (patch) | |
tree | 2b9a7d1426c99dcf3f399bdbc74e4d9796d215f3 /compiler | |
parent | 5193bd06c09009ebd2797a6674b458ec4b70248b (diff) | |
download | haskell-e17850c4b9b988809dafbd6a35c7b3c3bf050dd5.tar.gz |
Add TcRnDuplicateFieldName to TcRnMessage
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/Rename/Pat.hs | 11 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 23 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 13 |
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 |