Fix #16133 by checking for TypeApplications in rnExpr

3 files changed, 13 insertions, 9 deletions

diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 9ee9669319..607f5237c5 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -35,7 +35,7 @@ import RnFixity
 import RnUtils          ( HsDocContext(..), bindLocalNamesFV, checkDupNames
                         , bindLocalNames
                         , mapMaybeFvRn, mapFvRn
-                        , warnUnusedLocalBinds )
+                        , warnUnusedLocalBinds, typeAppErr )
 import RnUnbound        ( reportUnboundName )
 import RnSplice         ( rnBracket, rnSpliceExpr, checkThLocalName )
 import RnTypes
@@ -171,7 +171,9 @@ rnExpr (HsApp x fun arg)
        ; return (HsApp x fun' arg', fvFun `plusFV` fvArg) }
 
 rnExpr (HsAppType x fun arg)
-  = do { (fun',fvFun) <- rnLExpr fun
+  = do { type_app <- xoptM LangExt.TypeApplications
+       ; unless type_app $ addErr $ typeAppErr "type" $ hswc_body arg
+       ; (fun',fvFun) <- rnLExpr fun
        ; (arg',fvArg) <- rnHsWcType HsTypeCtx arg
        ; return (HsAppType x fun' arg', fvFun `plusFV` fvArg) }
 
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 735456dfee..f66c1bd29f 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -47,7 +47,7 @@ import RnHsDoc          ( rnLHsDoc, rnMbLHsDoc )
 import RnEnv
 import RnUnbound        ( perhapsForallMsg )
 import RnUtils          ( HsDocContext(..), withHsDocContext, mapFvRn
-                        , pprHsDocContext, bindLocalNamesFV
+                        , pprHsDocContext, bindLocalNamesFV, typeAppErr
                         , newLocalBndrRn, checkDupRdrNames, checkShadowedRdrNames )
 import RnFixity         ( lookupFieldFixityRn, lookupFixityRn
                         , lookupTyFixityRn )
@@ -645,7 +645,7 @@ rnHsTyKi env (HsAppTy _ ty1 ty2)
 
 rnHsTyKi env (HsAppKindTy _ ty k)
   = do { kind_app <- xoptM LangExt.TypeApplications
-       ; unless kind_app (addErr (typeAppErr k))
+       ; unless kind_app (addErr (typeAppErr "kind" k))
        ; (ty', fvs1) <- rnLHsTyKi env ty
        ; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k
        ; return (HsAppKindTy noExt ty' k', fvs1 `plusFV` fvs2) }
@@ -1477,10 +1477,6 @@ opTyErr op overall_ty
           | otherwise
           = text "Use TypeOperators to allow operators in types"
 
-typeAppErr :: LHsKind GhcPs -> SDoc
-typeAppErr (L _ k)
-  = hang (text "Illegal visible kind application" <+> quotes (ppr k))
-       2 (text "Perhaps you intended to use TypeApplications")
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/rename/RnUtils.hs b/compiler/rename/RnUtils.hs
index 0201822638..3a743b56fb 100644
--- a/compiler/rename/RnUtils.hs
+++ b/compiler/rename/RnUtils.hs
@@ -3,6 +3,7 @@
 This module contains miscellaneous functions related to renaming.
 
 -}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -14,7 +15,7 @@ module RnUtils (
         warnUnusedMatches, warnUnusedTypePatterns,
         warnUnusedTopBinds, warnUnusedLocalBinds,
         mkFieldEnv,
-        unknownSubordinateErr, badQualBndrErr,
+        unknownSubordinateErr, badQualBndrErr, typeAppErr,
         HsDocContext(..), pprHsDocContext,
         inHsDocContext, withHsDocContext,
 
@@ -363,6 +364,11 @@ badQualBndrErr :: RdrName -> SDoc
 badQualBndrErr rdr_name
   = text "Qualified name in binding position:" <+> ppr rdr_name
 
+typeAppErr :: String -> LHsType GhcPs -> SDoc
+typeAppErr what (L _ k)
+  = hang (text "Illegal visible" <+> text what <+> text "application"
+            <+> quotes (char '@' <> ppr k))
+       2 (text "Perhaps you intended to use TypeApplications")
 
 checkTupSize :: Int -> RnM ()
 checkTupSize tup_size