Add TcRnIllegalWildCardsInRecord to TcRnMessage

6 files changed, 48 insertions, 3 deletions

diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 9129a46a8a..b3aabc6942 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -925,9 +925,7 @@ getFieldUpdLbls :: [LHsRecUpdField GhcPs] -> [RdrName]
 getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) flds
 
 needFlagDotDot :: HsRecFieldContext -> TcRnMessage
-needFlagDotDot ctxt = TcRnUnknownMessage $ mkPlainError noHints $
-  vcat [text "Illegal `..' in record" <+> pprRFC ctxt,
-        text "Use RecordWildCards to permit this"]
+needFlagDotDot = TcRnIllegalWildcardsInRecord . toRecordFieldPart
 
 badDotDotCon :: Name -> TcRnMessage
 badDotDotCon con
@@ -947,6 +945,11 @@ pprRFC (HsRecFieldCon {}) = text "construction"
 pprRFC (HsRecFieldPat {}) = text "pattern"
 pprRFC (HsRecFieldUpd {}) = text "update"
 
+toRecordFieldPart :: HsRecFieldContext -> RecordFieldPart
+toRecordFieldPart (HsRecFieldCon n)  = RecordFieldConstructor n
+toRecordFieldPart (HsRecFieldPat n)  = RecordFieldPattern     n
+toRecordFieldPart (HsRecFieldUpd {}) = RecordFieldUpdate
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 9f5445e1ac..006f081cdd 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -76,6 +76,12 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $ text "Empty record update"
     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
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -111,6 +117,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnIllegalFieldPunning{}
       -> ErrorWithoutFlag
+    TcRnIllegalWildcardsInRecord{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -146,6 +154,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnIllegalFieldPunning{}
       -> [SuggestExtension LangExt.RecordPuns]
+    TcRnIllegalWildcardsInRecord{}
+      -> [SuggestExtension LangExt.RecordWildCards]
 
 messageWithInfoDiagnosticMessage :: UnitState
                                  -> ErrInfo
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 2ac17b3399..5adad142c9 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -7,6 +7,7 @@ module GHC.Tc.Errors.Types (
   , ErrInfo(..)
   , LevityCheckProvenance(..)
   , ShadowedNameProvenance(..)
+  , RecordFieldPart(..)
   ) where
 
 import GHC.Hs
@@ -251,6 +252,26 @@ data TcRnMessage where
   -}
   TcRnIllegalFieldPunning :: !(Located RdrName) -> TcRnMessage
 
+  {-| TcRnIllegalWildcardsInRecord is an error that occurs whenever
+      wildcards (..) are used in a record without the relevant
+      extension being enabled.
+
+      Examples(s):
+
+      data Foo = Foo { a :: Int }
+
+      foo :: Foo -> Int
+      foo Foo{..} = a  -- Not ok, wildcards used without extension.
+
+     Test cases: parser/should_fail/RecordWildCardsFail
+  -}
+  TcRnIllegalWildcardsInRecord :: !RecordFieldPart -> TcRnMessage
+
+-- | Which parts of a record field are affected by a particular error or warning.
+data RecordFieldPart
+  = RecordFieldConstructor !Name
+  | RecordFieldPattern !Name
+  | RecordFieldUpdate
 
 -- | Where a shadowed name comes from
 data ShadowedNameProvenance
diff --git a/testsuite/tests/parser/should_fail/RecordWildCardsFail.hs b/testsuite/tests/parser/should_fail/RecordWildCardsFail.hs
new file mode 100644
index 0000000000..2639193815
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordWildCardsFail.hs
@@ -0,0 +1,7 @@
+
+module RecordWildCardsFail where
+
+data Foo = Foo { a :: Int }
+
+foo :: Foo -> Int
+foo Foo{..} = a
diff --git a/testsuite/tests/parser/should_fail/RecordWildCardsFail.stderr b/testsuite/tests/parser/should_fail/RecordWildCardsFail.stderr
new file mode 100644
index 0000000000..2f7958b45c
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordWildCardsFail.stderr
@@ -0,0 +1,3 @@
+RecordWildCardsFail.hs:7:5:
+    Illegal `..' in record pattern
+    Suggested fix: Perhaps you intended to use RecordWildCards
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 82cddd8ed8..7787826a4b 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -194,3 +194,4 @@ test('T19928', normal, compile_fail, [''])
 test('T19923a', normal, compile_fail, [''])
 test('T19923b', normal, compile_fail, [''])
 test('T19923c', normal, compile_fail, [''])
+test('RecordWildCardsFail', normal, compile_fail, [''])