Surprising error message with bang pattern

Reviewers: bgamari, alanz

Reviewed By: bgamari

Subscribers: sgraf, mpickering, rwbarton, thomie, carter

GHC Trac Issues: #13600

Differential Revision: https://phabricator.haskell.org/D5040

1 files changed, 24 insertions, 3 deletions

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 74db997bbb..d7aef8d77f 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -29,7 +29,7 @@ module Parser (parseModule, parseSignature, parseImport, parseStatement, parseBa
                parseType, parseHeader) where
 
 -- base
-import Control.Monad    ( unless, liftM )
+import Control.Monad    ( unless, liftM, when )
 import GHC.Exts
 import Data.Char
 import Control.Monad    ( mplus )
@@ -2483,8 +2483,14 @@ infixexp :: { LHsExpr GhcPs }
 infixexp_top :: { LHsExpr GhcPs }
         : exp10_top               { $1 }
         | infixexp_top qop exp10_top
-                                  {% ams (sLL $1 $> (OpApp noExt $1 $2 $3))
-                                         [mj AnnVal $2] }
+                                  {% do { when (srcSpanEnd (getLoc $2)
+                                            == srcSpanStart (getLoc $3)
+                                            && checkIfBang $2) $
+                                            warnSpaceAfterBang (comb2 $2 $3);
+                                          ams (sLL $1 $> (OpApp noExt $1 $2 $3))
+                                               [mj AnnVal $2]
+                                        }
+                                  }
 
 
 exp10_top :: { LHsExpr GhcPs }
@@ -3705,6 +3711,21 @@ hintExplicitForall' span = do
         , text "extension to enable explicit-forall syntax: forall <tvs>. <type>"
         ]
 
+checkIfBang :: LHsExpr GhcPs -> Bool
+checkIfBang (L _ (HsVar _ (L _ op))) = op == bang_RDR
+checkIfBang _ = False
+
+-- | Warn about missing space after bang
+warnSpaceAfterBang :: SrcSpan -> P ()
+warnSpaceAfterBang span = do
+    bang_on <- extension bangPatEnabled
+    unless bang_on $
+      addWarning Opt_WarnSpaceAfterBang span msg
+    where
+      msg = text "Did you forget to enable BangPatterns?" $$
+            text "If you mean to bind (!) then perhaps you want" $$
+            text "to add a space after the bang for clarity."
+
 -- When two single quotes don't followed by tyvar or gtycon, we report the
 -- error as empty character literal, or TH quote that missing proper type
 -- variable or constructor. See Trac #13450.