Added a new warning about compatibility with RequiredTypeArguments

This commit introduces a new warning
that indicates code incompatible with
future extension: RequiredTypeArguments.

Enabling this extension may break some code and the warning
will help to make it compatible in advance.

2 files changed, 27 insertions, 2 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index f135826147..8d18cad2a2 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -62,7 +62,7 @@ import GHC.Types.Error.Codes ( constructorCode )
 import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Name.Reader ( GreName(..), pprNameProvenance
-                             , RdrName, rdrNameOcc, greMangledName )
+                             , RdrName, rdrNameOcc, greMangledName, grePrintableName )
 import GHC.Types.Name.Set
 import GHC.Types.SrcLoc
 import GHC.Types.TyThing
@@ -1221,6 +1221,18 @@ instance Diagnostic TcRnMessage where
       hang (text "A section must be enclosed in parentheses")
          2 (text "thus:" <+> (parens (ppr expr)))
 
+    TcRnCapturedTermName tv_name shadowed_term_names
+      -> mkSimpleDecorated $
+        text "The type variable" <+> quotes (ppr tv_name) <+>
+          text "is implicitly quantified," $+$
+          text "even though another variable of the same name is in scope:" $+$
+          nest 2 var_names $+$
+          text "This is not forward-compatible with a planned GHC extension, RequiredTypeArguments."
+        where
+          var_names = case shadowed_term_names of
+              Left gbl_names -> vcat (map (\name -> quotes (ppr $ grePrintableName name) <+> pprNameProvenance name) gbl_names)
+              Right lcl_name -> quotes (ppr lcl_name) <+> text "defined at"
+                <+> ppr (nameSrcLoc lcl_name)
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -1625,6 +1637,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnIllegalTupleSection{}
       -> ErrorWithoutFlag
+    TcRnCapturedTermName{}
+      -> WarningWithFlag Opt_WarnTermVariableCapture
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -2034,7 +2048,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnIllegalTupleSection{}
       -> [suggestExtension LangExt.TupleSections]
-
+    TcRnCapturedTermName{}
+      -> [SuggestRenameTypeVariable]
 
   diagnosticCode = constructorCode
 
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 990c97970c..13bef7b699 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -1642,6 +1642,16 @@ data TcRnMessage where
   -}
   TcRnForallIdentifier :: RdrName -> TcRnMessage
 
+  {-| TcRnCapturedTermName is a warning (controlled by -Wterm-variable-capture) that occurs
+    when an implicitly quantified type variable's name is already used for a term.
+    Example:
+      a = 10
+      f :: a -> a
+
+    Test cases: T22513a T22513b T22513c T22513d T22513e T22513f T22513g T22513h T22513i
+ -}
+  TcRnCapturedTermName :: RdrName -> Either [GlobalRdrElt] Name -> TcRnMessage
+
   {-| TcRnTypeEqualityOutOfScope is a warning (controlled by -Wtype-equality-out-of-scope)
       that occurs when the type equality (a ~ b) is not in scope.