Implement -Woperator-whitespace (#18834)

This patch implements two related warnings:

  -Woperator-whitespace-ext-conflict
      warns on uses of infix operators that would be parsed
      differently were a particular GHC extension enabled

  -Woperator-whitespace
      warns on prefix, suffix, and tight infix uses of infix
      operators

Updates submodules: haddock, containers.

18 files changed, 213 insertions, 41 deletions

diff --git a/compiler/GHC/Cmm/CallConv.hs b/compiler/GHC/Cmm/CallConv.hs
index 5d591a0dd3..0f65ef2157 100644
--- a/compiler/GHC/Cmm/CallConv.hs
+++ b/compiler/GHC/Cmm/CallConv.hs
@@ -207,14 +207,14 @@ nodeOnly = ([VanillaReg 1], [], [], [], [])
 realArgRegsCover :: Platform -> [GlobalReg]
 realArgRegsCover platform
     | passFloatArgsInXmm platform
-    = map ($VGcPtr) (realVanillaRegs platform) ++
+    = map ($ VGcPtr) (realVanillaRegs platform) ++
       realLongRegs platform ++
       realDoubleRegs platform -- we only need to save the low Double part of XMM registers.
                               -- Moreover, the NCG can't load/store full XMM
                               -- registers for now...
 
     | otherwise
-    = map ($VGcPtr) (realVanillaRegs platform) ++
+    = map ($ VGcPtr) (realVanillaRegs platform) ++
       realFloatRegs  platform ++
       realDoubleRegs platform ++
       realLongRegs   platform
diff --git a/compiler/GHC/CmmToLlvm/Regs.hs b/compiler/GHC/CmmToLlvm/Regs.hs
index 411ec22bbb..c4d9d12a48 100644
--- a/compiler/GHC/CmmToLlvm/Regs.hs
+++ b/compiler/GHC/CmmToLlvm/Regs.hs
@@ -50,12 +50,12 @@ lmGlobalReg platform suf reg
         VanillaReg 9 _ -> wordGlobal $ "R9" ++ suf
         VanillaReg 10 _ -> wordGlobal $ "R10" ++ suf
         SpLim          -> wordGlobal $ "SpLim" ++ suf
-        FloatReg 1     -> floatGlobal $"F1" ++ suf
-        FloatReg 2     -> floatGlobal $"F2" ++ suf
-        FloatReg 3     -> floatGlobal $"F3" ++ suf
-        FloatReg 4     -> floatGlobal $"F4" ++ suf
-        FloatReg 5     -> floatGlobal $"F5" ++ suf
-        FloatReg 6     -> floatGlobal $"F6" ++ suf
+        FloatReg 1     -> floatGlobal $ "F1" ++ suf
+        FloatReg 2     -> floatGlobal $ "F2" ++ suf
+        FloatReg 3     -> floatGlobal $ "F3" ++ suf
+        FloatReg 4     -> floatGlobal $ "F4" ++ suf
+        FloatReg 5     -> floatGlobal $ "F5" ++ suf
+        FloatReg 6     -> floatGlobal $ "F6" ++ suf
         DoubleReg 1    -> doubleGlobal $ "D1" ++ suf
         DoubleReg 2    -> doubleGlobal $ "D2" ++ suf
         DoubleReg 3    -> doubleGlobal $ "D3" ++ suf
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 661253b856..e228c416be 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -501,6 +501,8 @@ data WarningFlag =
    | Opt_WarnCompatUnqualifiedImports     -- Since 8.10
    | Opt_WarnDerivingDefaults
    | Opt_WarnInvalidHaddock               -- Since 8.12
+   | Opt_WarnOperatorWhitespaceExtConflict  -- Since 9.2
+   | Opt_WarnOperatorWhitespace             -- Since 9.2
    deriving (Eq, Show, Enum)
 
 -- | Used when outputting warnings: if a reason is given, it is
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 4c3052d023..ccc7d2b8a3 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3328,7 +3328,9 @@ wWarningFlagsDeps = [
                                          Opt_WarnPrepositiveQualifiedModule,
   flagSpec "unused-packages"             Opt_WarnUnusedPackages,
   flagSpec "compat-unqualified-imports"  Opt_WarnCompatUnqualifiedImports,
-  flagSpec "invalid-haddock"             Opt_WarnInvalidHaddock
+  flagSpec "invalid-haddock"             Opt_WarnInvalidHaddock,
+  flagSpec "operator-whitespace-ext-conflict"  Opt_WarnOperatorWhitespaceExtConflict,
+  flagSpec "operator-whitespace"         Opt_WarnOperatorWhitespace
  ]
 
 -- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
@@ -4085,7 +4087,8 @@ standardWarnings -- see Note [Documenting warning flags]
         Opt_WarnInaccessibleCode,
         Opt_WarnSpaceAfterBang,
         Opt_WarnNonCanonicalMonadInstances,
-        Opt_WarnNonCanonicalMonoidInstances
+        Opt_WarnNonCanonicalMonoidInstances,
+        Opt_WarnOperatorWhitespaceExtConflict
       ]
 
 -- | Things you get with -W
diff --git a/compiler/GHC/Parser/Errors.hs b/compiler/GHC/Parser/Errors.hs
index b67bf32baf..cf93890532 100644
--- a/compiler/GHC/Parser/Errors.hs
+++ b/compiler/GHC/Parser/Errors.hs
@@ -1,6 +1,8 @@
 module GHC.Parser.Errors
    ( Warning(..)
    , TransLayoutReason(..)
+   , OperatorWhitespaceSymbol(..)
+   , OperatorWhitespaceOccurrence(..)
    , NumUnderscoreReason(..)
    , Error(..)
    , ErrorDesc(..)
@@ -57,6 +59,20 @@ data Warning
    | WarnImportPreQualified !SrcSpan
       -- ^ Pre qualified import with 'WarnPrepositiveQualifiedModule' enabled
 
+   | WarnOperatorWhitespaceExtConflict !SrcSpan !OperatorWhitespaceSymbol
+   | WarnOperatorWhitespace !SrcSpan !FastString !OperatorWhitespaceOccurrence
+
+-- | The operator symbol in the 'WarnOperatorWhitespaceExtConflict' warning.
+data OperatorWhitespaceSymbol
+   = OperatorWhitespaceSymbol_PrefixPercent
+   | OperatorWhitespaceSymbol_PrefixDollar
+   | OperatorWhitespaceSymbol_PrefixDollarDollar
+
+-- | The operator occurrence type in the 'WarnOperatorWhitespace' warning.
+data OperatorWhitespaceOccurrence
+   = OperatorWhitespaceOccurrence_Prefix
+   | OperatorWhitespaceOccurrence_Suffix
+   | OperatorWhitespaceOccurrence_TightInfix
 
 data TransLayoutReason
    = TransLayout_Where -- ^ "`where' clause at the same depth as implicit layout block"
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index f99cac90a4..c4b411b1c3 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -102,6 +102,34 @@ pprWarning = \case
              <+> text "after the module name instead."
          $$ text "To allow this, enable language extension 'ImportQualifiedPost'"
 
+   WarnOperatorWhitespaceExtConflict loc sym
+      -> mkParserWarn Opt_WarnOperatorWhitespaceExtConflict loc $
+         let mk_prefix_msg operator_symbol extension_name syntax_meaning =
+                  text "The prefix use of a" <+> quotes (text operator_symbol)
+                    <+> text "would denote" <+> text syntax_meaning
+               $$ nest 2 (text "were the" <+> text extension_name <+> text "extension enabled.")
+               $$ text "Suggested fix: add whitespace after the"
+                    <+> quotes (text operator_symbol) <> char '.'
+         in
+         case sym of
+           OperatorWhitespaceSymbol_PrefixPercent -> mk_prefix_msg "%" "LinearTypes" "a multiplicity annotation"
+           OperatorWhitespaceSymbol_PrefixDollar -> mk_prefix_msg "$" "TemplateHaskell" "an untyped splice"
+           OperatorWhitespaceSymbol_PrefixDollarDollar -> mk_prefix_msg "$$" "TemplateHaskell" "a typed splice"
+
+
+   WarnOperatorWhitespace loc sym occ_type
+      -> mkParserWarn Opt_WarnOperatorWhitespace loc $
+         let mk_msg occ_type_str =
+                  text "The" <+> text occ_type_str <+> text "use of a" <+> quotes (ftext sym)
+                    <+> text "might be repurposed as special syntax"
+               $$ nest 2 (text "by a future language extension.")
+               $$ text "Suggested fix: add whitespace around it."
+         in
+         case occ_type of
+           OperatorWhitespaceOccurrence_Prefix -> mk_msg "prefix"
+           OperatorWhitespaceOccurrence_Suffix -> mk_msg "suffix"
+           OperatorWhitespaceOccurrence_TightInfix -> mk_msg "tight infix"
+
 pprError :: Error -> ErrMsg
 pprError err = mkParserErr (errLoc err) $ vcat
    (pp_err (errDesc err) : map pp_hint (errHints err))
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 654db86651..17f6dd0e65 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -1572,42 +1572,65 @@ qconsym buf len = ITqconsym $! splitQualName buf len False
 
 -- See Note [Whitespace-sensitive operator parsing]
 varsym_prefix :: Action
-varsym_prefix = sym $ \exts s ->
-  if | s == fsLit "@"  -- regardless of TypeApplications for better error messages
-     -> return ITtypeApp
-     | LinearTypesBit `xtest` exts, s == fsLit "%"
-     -> return ITpercent
-     | ThQuotesBit `xtest` exts, s == fsLit "$"
-     -> return ITdollar
-     | ThQuotesBit `xtest` exts, s == fsLit "$$"
-     -> return ITdollardollar
-     | s == fsLit "-"   -- Only when LexicalNegation is on, otherwise we get ITminus and
-                        -- don't hit this code path. See Note [Minus tokens]
-     -> return ITprefixminus
+varsym_prefix = sym $ \span exts s ->
+  let warnExtConflict errtok =
+        do { addWarning Opt_WarnOperatorWhitespaceExtConflict $
+               WarnOperatorWhitespaceExtConflict (mkSrcSpanPs span) errtok
+           ; return (ITvarsym s) }
+  in
+  if | s == fsLit "@" ->
+         return ITtypeApp  -- regardless of TypeApplications for better error messages
+     | s == fsLit "%" ->
+         if xtest LinearTypesBit exts
+         then return ITpercent
+         else warnExtConflict OperatorWhitespaceSymbol_PrefixPercent
+     | s == fsLit "$" ->
+         if xtest ThQuotesBit exts
+         then return ITdollar
+         else warnExtConflict OperatorWhitespaceSymbol_PrefixDollar
+     | s == fsLit "$$" ->
+         if xtest ThQuotesBit exts
+         then return ITdollardollar
+         else warnExtConflict OperatorWhitespaceSymbol_PrefixDollarDollar
+     | s == fsLit "-" ->
+         return ITprefixminus -- Only when LexicalNegation is on, otherwise we get ITminus
+                              -- and don't hit this code path. See Note [Minus tokens]
      | s == fsLit "!" -> return ITbang
      | s == fsLit "~" -> return ITtilde
-     | otherwise -> return (ITvarsym s)
+     | otherwise ->
+         do { addWarning Opt_WarnOperatorWhitespace $
+                WarnOperatorWhitespace (mkSrcSpanPs span) s
+                  OperatorWhitespaceOccurrence_Prefix
+            ; return (ITvarsym s) }
 
 -- See Note [Whitespace-sensitive operator parsing]
 varsym_suffix :: Action
-varsym_suffix = sym $ \_ s ->
+varsym_suffix = sym $ \span _ s ->
   if | s == fsLit "@" -> failMsgP (Error ErrSuffixAT [])
-     | otherwise      -> return (ITvarsym s)
+     | otherwise ->
+         do { addWarning Opt_WarnOperatorWhitespace $
+                WarnOperatorWhitespace (mkSrcSpanPs span) s
+                  OperatorWhitespaceOccurrence_Suffix
+            ; return (ITvarsym s) }
 
 -- See Note [Whitespace-sensitive operator parsing]
 varsym_tight_infix :: Action
-varsym_tight_infix = sym $ \_ s ->
+varsym_tight_infix = sym $ \span _ s ->
   if | s == fsLit "@" -> return ITat
-     | otherwise -> return (ITvarsym s)
+     | otherwise ->
+         do { addWarning Opt_WarnOperatorWhitespace $
+                WarnOperatorWhitespace (mkSrcSpanPs span) s
+                  OperatorWhitespaceOccurrence_TightInfix
+            ;  return (ITvarsym s) }
 
 -- See Note [Whitespace-sensitive operator parsing]
 varsym_loose_infix :: Action
-varsym_loose_infix = sym (\_ s -> return $ ITvarsym s)
+varsym_loose_infix = sym (\_ _ s -> return $ ITvarsym s)
 
 consym :: Action
-consym = sym (\_exts s -> return $ ITconsym s)
+consym = sym (\_span _exts s -> return $ ITconsym s)
 
-sym :: (ExtsBitmap -> FastString -> P Token) -> Action
+sym :: (PsSpan -> ExtsBitmap -> FastString -> P Token) -> Action
 sym con span buf len =
   case lookupUFM reservedSymsFM fs of
     Just (keyword, NormalSyntax, 0) ->
@@ -1616,20 +1639,20 @@ sym con span buf len =
       exts <- getExts
       if exts .&. i /= 0
         then return $ L span keyword
-        else L span <$!> con exts fs
+        else L span <$!> con span exts fs
     Just (keyword, UnicodeSyntax, 0) -> do
       exts <- getExts
       if xtest UnicodeSyntaxBit exts
         then return $ L span keyword
-        else L span <$!> con exts fs
+        else L span <$!> con span exts fs
     Just (keyword, UnicodeSyntax, i) -> do
       exts <- getExts
       if exts .&. i /= 0 && xtest UnicodeSyntaxBit exts
         then return $ L span keyword
-        else L span <$!> con exts fs
+        else L span <$!> con span exts fs
     Nothing -> do
       exts <- getExts
-      L span <$!> con exts fs
+      L span <$!> con span exts fs
   where
     !fs = lexemeToFastString buf len
 
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index fa9e80ecfd..68d2908dbb 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -427,7 +427,7 @@ resumeExec canLogSpan step
                     hist' = case mb_brkpt of
                        Nothing -> prevHistoryLst
                        Just bi
-                         | not $canLogSpan span -> prevHistoryLst
+                         | not $ canLogSpan span -> prevHistoryLst
                          | otherwise -> mkHistory hsc_env apStack bi `consBL`
                                                         fromListBL 50 hist
                 handleRunStatus step expr bindings final_ids status hist'
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 5f07299258..5eb4bc51c9 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -51,6 +51,7 @@ To reverse ``-Werror``, which makes all warnings into errors, use ``-Wwarn``.
         * :ghc-flag:`-Wunrecognised-warning-flags`
         * :ghc-flag:`-Winaccessible-code`
         * :ghc-flag:`-Wstar-binder`
+        * :ghc-flag:`-Woperator-whitespace-ext-conflict`
 
 The following flags are simple ways to select standard "packages" of warnings:
 
@@ -1853,6 +1854,7 @@ of ``-W(no-)*``.
 .. ghc-flag:: -Winvalid-haddock
     :shortdesc: warn when a Haddock comment occurs in an invalid position
     :type: dynamic
+    :reverse: -Wno-invalid-haddock
     :category:
 
     :since: 9.0
@@ -1869,6 +1871,56 @@ of ``-W(no-)*``.
     This warning informs you about discarded documentation comments.
     It has no effect when :ghc-flag:`-haddock` is disabled.
 
+.. ghc-flag:: -Woperator-whitespace-ext-conflict
+    :shortdesc: warn on uses of infix operators that would be parsed differently
+                were a particular GHC extension enabled
+    :type: dynamic
+    :reverse: -Wno-operator-whitespace-ext-conflict
+    :category:
+
+    :since: 9.2
+
+    When :extension:`TemplateHaskell` is enabled, ``f $x`` is parsed as ``f``
+    applied to an untyped splice. But when the extension is disabled, the
+    expression is parsed as a use of the ``$`` infix operator.
+
+    To make it easy to read ``f $x`` without checking the enabled extensions,
+    one could rewrite it as ``f $ x``, which is what this warning suggests.
+
+    Currently, it detects the following cases:
+
+    * ``$x`` could mean an untyped splice under :extension:`TemplateHaskell`
+    * ``$$x`` could mean a typed splice under :extension:`TemplateHaskell`
+    * ``%m`` could mean a multiplicity annotation under :extension:`LinearTypes`
+
+    It only covers extensions that currently exist. If you want to enforce a
+    stricter policy and always require whitespace around all infix operators,
+    use :ghc-flag:`-Woperator-whitespace`.
+
+.. ghc-flag:: -Woperator-whitespace
+    :shortdesc: warn on prefix, suffix, and tight infix uses of infix operators
+    :type: dynamic
+    :reverse: -Wno-operator-whitespace
+    :category:
+
+    :since: 9.2
+
+    There are four types of infix operator occurrences, as defined by
+    `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__::
+
+      a ! b   -- a loose infix occurrence
+      a!b     -- a tight infix occurrence
+      a !b    -- a prefix occurrence
+      a! b    -- a suffix occurrence
+
+    A loose infix occurrence of any operator is always parsed as an infix
+    operator, but other occurrence types may be assigned a special meaning.
+    For example, a prefix ``!`` denotes a bang pattern, and a prefix ``$``
+    denotes a :extension:`TemplateHaskell` splice.
+
+    This warning encourages the use of loose infix occurrences of all infix
+    operators, to prevent possible conflicts with future language extensions.
+
 .. ghc-flag:: -Wauto-orphans
     :shortdesc: *(deprecated)* Does nothing
     :type: dynamic
diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs
index bc86f39766..53c33ccbfe 100644
--- a/ghc/GHCi/UI/Tags.hs
+++ b/ghc/GHCi/UI/Tags.hs
@@ -95,7 +95,7 @@ listModuleTags m = do
        dflags <- getDynFlags
        mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo
        let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual
-       let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo
+       let names = fromMaybe [] $ GHC.modInfoTopLevelScope mInfo
        let localNames = filter ((m==) . nameModule) names
        mbTyThings <- mapM GHC.lookupName localNames
        return $! [ tagInfo dflags unqual exported kind name realLoc
@@ -153,11 +153,11 @@ collateAndWriteTags CTagsWithLineNumbers file tagInfos = do
 -- ctags style with the Ex expression being a regex searching the line, Vim et al
 collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al
   tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos
-  let tags = unlines $ sort $ map showCTag $concat tagInfoGroups
+  let tags = unlines $ sort $ map showCTag $ concat tagInfoGroups
   tryIO (writeTagsSafely file tags)
 
 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
-  tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos
+  tagInfoGroups <- makeTagGroupsWithSrcInfo $ filter tagExported tagInfos
   let tagGroups = map processGroup tagInfoGroups
   tryIO (writeTagsSafely file $ concat tagGroups)
 
@@ -176,7 +176,7 @@ makeTagGroupsWithSrcInfo tagInfos = do
   where
     addTagSrcInfo [] = throwGhcException (CmdLineError "empty tag file group??")
     addTagSrcInfo group@(tagInfo:_) = do
-      file <- readFile $tagFile tagInfo
+      file <- readFile $ tagFile tagInfo
       let sortedGroup = sortBy (comparing tagLine) group
       return $ perFile sortedGroup 1 0 $ lines file
 
@@ -197,7 +197,7 @@ showCTag ti =
   where
     tagCmd =
       case tagSrcInfo ti of
-        Nothing -> show $tagLine ti
+        Nothing -> show $ tagLine ti
         Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/"
 
       where
diff --git a/libraries/containers b/libraries/containers
-Subproject 535384f5919eafb03856cf604b99cc94ce04e37
+Subproject 648fdb95cb4cf406ed7364533de6314069e3ffa
diff --git a/testsuite/tests/parser/should_compile/T18834a.hs b/testsuite/tests/parser/should_compile/T18834a.hs
new file mode 100644
index 0000000000..7666173d20
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T18834a.hs
@@ -0,0 +1,8 @@
+module T18834a where
+
+(%) = ($)
+($$) = ($)
+
+x = even $0
+y = even $$0
+z = even %0
diff --git a/testsuite/tests/parser/should_compile/T18834a.stderr b/testsuite/tests/parser/should_compile/T18834a.stderr
new file mode 100644
index 0000000000..2fd8f5903d
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T18834a.stderr
@@ -0,0 +1,15 @@
+
+T18834a.hs:6:10: warning: [-Woperator-whitespace-ext-conflict (in -Wdefault)]
+    The prefix use of a ‘$’ would denote an untyped splice
+      were the TemplateHaskell extension enabled.
+    Suggested fix: add whitespace after the ‘$’.
+
+T18834a.hs:7:10: warning: [-Woperator-whitespace-ext-conflict (in -Wdefault)]
+    The prefix use of a ‘$$’ would denote a typed splice
+      were the TemplateHaskell extension enabled.
+    Suggested fix: add whitespace after the ‘$$’.
+
+T18834a.hs:8:10: warning: [-Woperator-whitespace-ext-conflict (in -Wdefault)]
+    The prefix use of a ‘%’ would denote a multiplicity annotation
+      were the LinearTypes extension enabled.
+    Suggested fix: add whitespace after the ‘%’.
diff --git a/testsuite/tests/parser/should_compile/T18834b.hs b/testsuite/tests/parser/should_compile/T18834b.hs
new file mode 100644
index 0000000000..8a020b8b5f
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T18834b.hs
@@ -0,0 +1,8 @@
+{-# OPTIONS -Woperator-whitespace #-}
+
+module T18834b where
+
+f a b = a+ b
+g a b = a +b
+h a b = a+b
+k a b = a + b  -- this one is OK, no warning
diff --git a/testsuite/tests/parser/should_compile/T18834b.stderr b/testsuite/tests/parser/should_compile/T18834b.stderr
new file mode 100644
index 0000000000..9ec4f81bb4
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T18834b.stderr
@@ -0,0 +1,15 @@
+
+T18834b.hs:5:10: warning: [-Woperator-whitespace]
+    The suffix use of a ‘+’ might be repurposed as special syntax
+      by a future language extension.
+    Suggested fix: add whitespace around it.
+
+T18834b.hs:6:11: warning: [-Woperator-whitespace]
+    The prefix use of a ‘+’ might be repurposed as special syntax
+      by a future language extension.
+    Suggested fix: add whitespace around it.
+
+T18834b.hs:7:10: warning: [-Woperator-whitespace]
+    The tight infix use of a ‘+’ might be repurposed as special syntax
+      by a future language extension.
+    Suggested fix: add whitespace around it.
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 48e1136daa..f63a3f95d9 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -170,3 +170,5 @@ test('proposal-229f',
 
 test('T15730a', normal, compile_and_run, [''])
 test('T18130', normal, compile, [''])
+test('T18834a', normal, compile, [''])
+test('T18834b', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_compile/T16312.hs b/testsuite/tests/typecheck/should_compile/T16312.hs
index 1823d98558..a18f38df61 100644
--- a/testsuite/tests/typecheck/should_compile/T16312.hs
+++ b/testsuite/tests/typecheck/should_compile/T16312.hs
@@ -9,6 +9,6 @@ instance Functor g => Functor (Curried g h) where
   fmap f (Curried g) = Curried (g . fmap (.f))
 
 instance (Functor g, g ~ h) => Applicative (Curried g h) where
-  pure a = Curried (fmap ($a))
+  pure a = Curried (fmap ($ a))
   Curried mf <*> Curried ma = Curried (ma . mf . fmap (.))
   {-# INLINE (<*>) #-}
diff --git a/utils/haddock b/utils/haddock
-Subproject f7d9e0bb987ca31c3b15cbe63198dafbeee3a39
+Subproject 77261e89c31b41eb5d7f1d16bb1de5b14b4296f