pretty-printer: Do not print ApplicativeDo join

* Do not print `join` in ApplictiveStmt, unless ppr-debug
* Print parens around multiple parallel binds

When ApplicativeDo is enabled, the renamer analyses the statements of a
`do` block and in certain cases marks them as needing to be rewritten
using `join`.

For example, if you have:

```
foo = do
  a <- e1
  b <- e2
  doSomething a b
```

it will be desugared into:

```
foo = join (doSomething <$> e1 <*> e2)
```

After renaming but before desugaring the expression is stored
essentially as:

```
foo = do
  [will need join] (a <- e1 | b <- e2)
  [no return] doSomething a b
```

Before this change, the pretty printer would print a call to `join`,
even though it is not needed at this stage at all. The expression will be
actually rewritten into one using join only at desugaring, at which
point a literal call to join will be inserted.

4 files changed, 46 insertions, 4 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 473868c4e8..724087eb96 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -55,7 +55,7 @@ import {-# SOURCE #-} TcRnTypes (TcLclEnv)
 import Data.Data hiding (Fixity(..))
 import qualified Data.Data as Data (Fixity(..))
 import qualified Data.Kind
-import Data.Maybe (isNothing)
+import Data.Maybe (isJust)
 
 import GHCi.RemoteTypes ( ForeignRef )
 import qualified Language.Haskell.TH as TH (Q)
@@ -2273,9 +2273,8 @@ pprStmt (ApplicativeStmt _ args mb_join)
      let
          ap_expr = sep (punctuate (text " |") (map pp_arg args))
      in
-       if isNothing mb_join
-          then ap_expr
-          else text "join" <+> parens ap_expr
+       whenPprDebug (if isJust mb_join then text "[join]" else empty) <+>
+       (if lengthAtLeast args 2 then parens else id) ap_expr
 
    pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc
    pp_arg (_, ApplicativeArgOne _ pat expr isBody _)
diff --git a/testsuite/tests/ado/ado010.hs b/testsuite/tests/ado/ado010.hs
new file mode 100644
index 0000000000..a48eefa296
--- /dev/null
+++ b/testsuite/tests/ado/ado010.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# OPTIONS_GHC -ddump-rn -dsuppress-uniques #-}
+
+module Test where
+
+-- Sanity check for a simple expression not involving join.
+q1 :: IO ()
+q1 = do
+    a <- pure ()
+    b <- pure ()
+    pure $ pureNothing a
+  where
+    pureNothing :: a -> ()
+    pureNothing _ = ()
+
+-- Sanity check for a simple expression involving join.
+q2 :: IO ()
+q2 = do
+    a <- pure ()
+    b <- pure ()
+    doNothing a
+  where
+    doNothing :: a -> IO ()
+    doNothing _ = pure ()
diff --git a/testsuite/tests/ado/ado010.stderr b/testsuite/tests/ado/ado010.stderr
new file mode 100644
index 0000000000..f5b98c8354
--- /dev/null
+++ b/testsuite/tests/ado/ado010.stderr
@@ -0,0 +1,18 @@
+
+==================== Renamer ====================
+Test.q1 :: IO ()
+Test.q1
+  = do (a <- pure () | b <- pure ())
+       return $ pureNothing a
+  where
+      pureNothing :: a -> ()
+      pureNothing _ = ()
+Test.q2 :: IO ()
+Test.q2
+  = do (a <- pure () | b <- pure ())
+       doNothing a
+  where
+      doNothing :: a -> IO ()
+      doNothing _ = pure ()
+
+
diff --git a/testsuite/tests/ado/all.T b/testsuite/tests/ado/all.T
index 11a9f4d6c8..b6f2480189 100644
--- a/testsuite/tests/ado/all.T
+++ b/testsuite/tests/ado/all.T
@@ -7,6 +7,7 @@ test('ado006', normal, compile, [''])
 test('ado007', normal, compile, [''])
 test('ado008', normal, compile, [''])
 test('ado009', normal, compile, [''])
+test('ado010', normal, compile, [''])
 test('T11607', normal, compile_and_run, [''])
 test('ado-optimal', normal, compile_and_run, [''])
 test('T12490', normal, compile, [''])