Improve parser error messages for TypeApplications

With this patch, we always parse  f @t  as a type application,
thereby producing better error messages.

This steals two syntactic forms:

* Prefix form of the @-operator in expressions. Since the @-operator is
  a divergence from the Haskell Report anyway, this is not a major loss.

* Prefix form of @-patterns. Since we are stealing loose infix form
  anyway, might as well sacrifice the prefix form for the sake of much
  better error messages.

11 files changed, 48 insertions, 25 deletions

diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 6dde13f7a9..a9bb4fa87d 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2738,11 +2738,9 @@ fexp    :: { ECP }
                                           mkHsAppPV (comb2 $1 $>) $1 $2 }
 
         -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
-        | fexp PREFIX_AT atype       {% runECP_P $1 >>= \ $1 ->
-                                        runPV (checkExpBlockArguments $1) >>= \_ ->
-                                        fmap ecpFromExp $
-                                        ams (sLL $1 $> $ HsAppType noExtField $1 (mkHsWildCardBndrs $3))
-                                            [mj AnnAt $2] }
+        | fexp PREFIX_AT atype       { ECP $
+                                        runECP_PV $1 >>= \ $1 ->
+                                        amms (mkHsAppTypePV (comb2 $1 $>) $1 $3) [mj AnnAt $2] }
 
         | 'static' aexp              {% runECP_P $2 >>= \ $2 ->
                                         fmap ecpFromExp $
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index bc4349e391..8245974db6 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -1449,7 +1449,7 @@ qconsym buf len = ITqconsym $! splitQualName buf len False
 -- See Note [Whitespace-sensitive operator parsing]
 varsym_prefix :: Action
 varsym_prefix = sym $ \exts s ->
-  if | TypeApplicationsBit `xtest` exts, s == fsLit "@"
+  if | s == fsLit "@"  -- regardless of TypeApplications for better error messages
      -> return ITtypeApp
      | ThQuotesBit `xtest` exts, s == fsLit "$"
      -> return ITdollar
@@ -2461,7 +2461,6 @@ data ExtBits
   | BinaryLiteralsBit
   | NegativeLiteralsBit
   | HexFloatLiteralsBit
-  | TypeApplicationsBit
   | StaticPointersBit
   | NumericUnderscoresBit
   | StarIsTypeBit
@@ -2548,7 +2547,6 @@ mkParserFlags' warningFlags extensionFlags thisPackage
       .|. NegativeLiteralsBit         `xoptBit` LangExt.NegativeLiterals
       .|. HexFloatLiteralsBit         `xoptBit` LangExt.HexFloatLiterals
       .|. PatternSynonymsBit          `xoptBit` LangExt.PatternSynonyms
-      .|. TypeApplicationsBit         `xoptBit` LangExt.TypeApplications
       .|. StaticPointersBit           `xoptBit` LangExt.StaticPointers
       .|. NumericUnderscoresBit       `xoptBit` LangExt.NumericUnderscores
       .|. StarIsTypeBit               `xoptBit` LangExt.StarIsType
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 82a8b9398f..273fa0d704 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1811,6 +1811,8 @@ class b ~ (Body b) GhcPs => DisambECP b where
   superFunArg :: (DisambECP (FunArg b) => PV (Located b)) -> PV (Located b)
   -- | Disambiguate "f x" (function application)
   mkHsAppPV :: SrcSpan -> Located b -> Located (FunArg b) -> PV (Located b)
+  -- | Disambiguate "f @t" (visible type application)
+  mkHsAppTypePV :: SrcSpan -> Located b -> LHsType GhcPs -> PV (Located b)
   -- | Disambiguate "if ... then ... else ..."
   mkHsIfPV :: SrcSpan
          -> LHsExpr GhcPs
@@ -1925,6 +1927,7 @@ instance DisambECP (HsCmd GhcPs) where
     checkCmdBlockArguments c
     checkExpBlockArguments e
     return $ L l (HsCmdApp noExtField c e)
+  mkHsAppTypePV l c t = cmdFail l (ppr c <+> text "@" <> ppr t)
   mkHsIfPV l c semi1 a semi2 b = do
     checkDoAndIfThenElse c semi1 a semi2 b
     return $ L l (mkHsCmdIf c a b)
@@ -1982,6 +1985,9 @@ instance DisambECP (HsExpr GhcPs) where
     checkExpBlockArguments e1
     checkExpBlockArguments e2
     return $ L l (HsApp noExtField e1 e2)
+  mkHsAppTypePV l e t = do
+    checkExpBlockArguments e
+    return $ L l (HsAppType noExtField e (mkHsWildCardBndrs t))
   mkHsIfPV l c semi1 a semi2 b = do
     checkDoAndIfThenElse c semi1 a semi2 b
     return $ L l (mkHsIf c a b)
@@ -2064,6 +2070,8 @@ instance DisambECP (PatBuilder GhcPs) where
   type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
   superFunArg m = m
   mkHsAppPV l p1 p2 = return $ L l (PatBuilderApp p1 p2)
+  mkHsAppTypePV l _ _ = addFatalError l $
+    text "Type applications in patterns are not yet supported"
   mkHsIfPV l _ _ _ _ _ = addFatalError l $ text "(if ... then ... else ...)-syntax in pattern"
   mkHsDoPV l _ = addFatalError l $ text "do-notation in pattern"
   mkHsParPV l p = return $ L l (PatBuilderPar p)
diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst
index 4dc49f0328..b5ac79d457 100644
--- a/docs/users_guide/bugs.rst
+++ b/docs/users_guide/bugs.rst
@@ -76,13 +76,20 @@ Lexical syntax
    See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
    for the precise rules.
 
--  As-patterns must not be surrounded by whitespace::
+-  As-patterns must not be surrounded by whitespace on either side::
 
      f p@(x, y, z) = ...    -- accepted by both GHC and the Haskell Report
-     f p @ (x, y, z) = ...  -- accepted by the Haskell Report but not GHC
 
-   When surrounded by whitespace, ``(@)`` is treated by GHC as a regular infix
-   operator.
+     -- accepted by the Haskell Report but not GHC:
+     f p @ (x, y, z) = ...
+     f p @(x, y, z) = ...
+     f p@ (x, y, z) = ...
+
+   When surrounded by whitespace on both sides, ``(@)`` is treated by GHC as a
+   regular infix operator.
+
+   When preceded but not followed by whitespace, ``(@)`` is treated as a
+   visible type application.
 
    See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
    for the precise rules.
diff --git a/testsuite/tests/parser/should_fail/T18251c.hs b/testsuite/tests/parser/should_fail/T18251c.hs
new file mode 100644
index 0000000000..da455fea64
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T18251c.hs
@@ -0,0 +1,3 @@
+module T18251c where
+
+f = id @Int
diff --git a/testsuite/tests/parser/should_fail/T18251c.stderr b/testsuite/tests/parser/should_fail/T18251c.stderr
new file mode 100644
index 0000000000..9a7c66f8f3
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T18251c.stderr
@@ -0,0 +1,4 @@
+
+T18251c.hs:3:5: error:
+    Illegal visible type application ‘@Int’
+      Perhaps you intended to use TypeApplications
diff --git a/testsuite/tests/parser/should_fail/T18251d.hs b/testsuite/tests/parser/should_fail/T18251d.hs
new file mode 100644
index 0000000000..76864b6e72
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T18251d.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE ExplicitForAll #-}
+
+module T18251d where
+
+f :: forall a. a -> ()
+f @a _ = ()
diff --git a/testsuite/tests/parser/should_fail/T18251d.stderr b/testsuite/tests/parser/should_fail/T18251d.stderr
new file mode 100644
index 0000000000..4e64922070
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T18251d.stderr
@@ -0,0 +1,3 @@
+
+T18251d.hs:6:1: error:
+    Type applications in patterns are not yet supported
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 8256906296..3b31682cb2 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -169,4 +169,6 @@ test('T15730b', normal, compile_fail, [''])
 test('T18130Fail', normal, compile_fail, [''])
 test('T18251a', normal, compile_fail, [''])
 test('T18251b', normal, compile_fail, [''])
+test('T18251c', normal, compile_fail, [''])
+test('T18251d', normal, compile_fail, [''])
 test('T18251f', normal, compile_fail, [''])
diff --git a/testsuite/tests/th/T12411.stderr b/testsuite/tests/th/T12411.stderr
index 13b778f8a1..22f7de0190 100644
--- a/testsuite/tests/th/T12411.stderr
+++ b/testsuite/tests/th/T12411.stderr
@@ -1,8 +1,6 @@
 
-T12411.hs:4:6: error:
-    Variable not in scope:
-      (@)
-        :: (a1 -> f0 a1) -> t0 -> Language.Haskell.TH.Lib.Internal.DecsQ
+T12411.hs:4:1: error:
+    Illegal visible type application ‘@Q’
+      Perhaps you intended to use TypeApplications
 
-T12411.hs:4:7: error:
-    Data constructor not in scope: Q :: [a0] -> t0
+T12411.hs:4:7: error: Not in scope: type constructor or class ‘Q’
diff --git a/testsuite/tests/typecheck/should_fail/T15527.stderr b/testsuite/tests/typecheck/should_fail/T15527.stderr
index 2b764caef9..8908b17218 100644
--- a/testsuite/tests/typecheck/should_fail/T15527.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15527.stderr
@@ -1,8 +1,4 @@
 
-T15527.hs:4:10: error:
-    Variable not in scope:
-      (@)
-        :: ((b0 -> c0) -> (a0 -> b0) -> a0 -> c0)
-           -> t0 -> (Int -> Int) -> (Int -> Int) -> Int -> Int
-
-T15527.hs:4:11: error: Data constructor not in scope: Int
+T15527.hs:4:6: error:
+    Illegal visible type application ‘@Int’
+      Perhaps you intended to use TypeApplications