Clean up TH's treatment of unary tuples (or, #16881 part two)

!1906 left some loose ends in regards to Template Haskell's treatment
of unary tuples. This patch ends to tie up those loose ends:

* In addition to having `TupleT 1` produce unary tuples, `TupE [exp]`
  and `TupP [pat]` also now produce unary tuples.
* I have added various special cases in GHC's pretty-printers to
  ensure that explicit 1-tuples are printed using the `Unit` type.
  See `testsuite/tests/th/T17380`.
* The GHC 8.10.1 release notes entry has been tidied up a little.

Fixes #16881. Fixes #17371. Fixes #17380.

1 files changed, 20 insertions, 4 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 98ddd1c2ca..461f213813 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -153,7 +153,11 @@ pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat ap
                                            <+> text "->" <+> ppr e
 pprExp i (LamCaseE ms) = parensIf (i > noPrec)
                        $ text "\\case" $$ nest nestDepth (ppr ms)
-pprExp _ (TupE es) = parens (commaSepWith (pprMaybeExp noPrec) es)
+pprExp i (TupE es)
+  | [Just e] <- es
+  = pprExp i (ConE (tupleDataName 1) `AppE` e)
+  | otherwise
+  = parens (commaSepWith (pprMaybeExp noPrec) es)
 pprExp _ (UnboxedTupE es) = hashParens (commaSepWith (pprMaybeExp noPrec) es)
 pprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity
 -- Nesting in Cond is to avoid potential problems in do statements
@@ -291,7 +295,11 @@ instance Ppr Pat where
 pprPat :: Precedence -> Pat -> Doc
 pprPat i (LitP l)     = pprLit i l
 pprPat _ (VarP v)     = pprName' Applied v
-pprPat _ (TupP ps)    = parens (commaSep ps)
+pprPat i (TupP ps)
+  | [_] <- ps
+  = pprPat i (ConP (tupleDataName 1) ps)
+  | otherwise
+  = parens (commaSep ps)
 pprPat _ (UnboxedTupP ps) = hashParens (commaSep ps)
 pprPat _ (UnboxedSumP p alt arity) = unboxedSumBars (ppr p) alt arity
 pprPat i (ConP s ps)  = parensIf (i >= appPrec) $ pprName' Applied s
@@ -742,6 +750,7 @@ pprParendType (VarT v)            = pprName' Applied v
 -- `Applied` is used here instead of `ppr` because of infix names (#13887)
 pprParendType (ConT c)            = pprName' Applied c
 pprParendType (TupleT 0)          = text "()"
+pprParendType (TupleT 1)          = pprParendType (ConT (tupleTypeName 1))
 pprParendType (TupleT n)          = parens (hcat (replicate (n-1) comma))
 pprParendType (UnboxedTupleT n)   = hashParens $ hcat $ replicate (n-1) comma
 pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar
@@ -750,6 +759,7 @@ pprParendType ListT               = text "[]"
 pprParendType (LitT l)            = pprTyLit l
 pprParendType (PromotedT c)       = text "'" <> pprName' Applied c
 pprParendType (PromotedTupleT 0)  = text "'()"
+pprParendType (PromotedTupleT 1)  = pprParendType (PromotedT (tupleDataName 1))
 pprParendType (PromotedTupleT n)  = quoteParens (hcat (replicate (n-1) comma))
 pprParendType PromotedNilT        = text "'[]"
 pprParendType PromotedConsT       = text "'(:)"
@@ -801,9 +811,15 @@ pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) =
     sep [pprFunArgType arg1 <+> text "~", ppr arg2]
 pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg)
 pprTyApp (TupleT n, args)
- | length args == n = parens (commaSep args)
+ | length args == n
+ = if n == 1
+   then pprTyApp (ConT (tupleTypeName 1), args)
+   else parens (commaSep args)
 pprTyApp (PromotedTupleT n, args)
- | length args == n = quoteParens (commaSep args)
+ | length args == n
+ = if n == 1
+   then pprTyApp (PromotedT (tupleDataName 1), args)
+   else quoteParens (commaSep args)
 pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args)
 
 pprFunArgType :: Type -> Doc    -- Should really use a precedence argument