Fix #14875 by introducing PprPrec, and using it

Trying to determine when to insert parentheses during TH
conversion is a bit of a mess. There is an assortment of functions
that try to detect this, such as:

* `hsExprNeedsParens`
* `isCompoundHsType`
* `hsPatNeedsParens`
* `isCompoundPat`
* etc.

To make things worse, each of them have slightly different semantics.
Plus, they don't work well in the presence of explicit type
signatures, as #14875 demonstrates.

All of these problems can be alleviated with the use of an explicit
precedence argument (much like what `showsPrec` currently does). To
accomplish this, I introduce a new `PprPrec` data type, and define
standard predences for things like function application, infix
operators, function arrows, and explicit type signatures (that last
one is new). I then added `PprPrec` arguments to the various
`-NeedsParens` functions, and use them to make smarter decisions
about when things need to be parenthesized.

A nice side effect is that functions like `isCompoundHsType` are
now completely unneeded, since they're simply aliases for
`hsTypeNeedsParens appPrec`. As a result, I did a bit of refactoring
to remove these sorts of functions. I also did a pass over various
utility functions in GHC for constructing AST forms and used more
appropriate precedences where convenient.

Along the way, I also ripped out the existing `TyPrec`
data type (which was tailor-made for pretty-printing `Type`s) and
replaced it with `PprPrec` for consistency.

Test Plan: make test TEST=T14875

Reviewers: alanz, goldfire, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14875

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

1 files changed, 13 insertions, 6 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 278b45edf2..46f4dc0444 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -20,10 +20,11 @@ nestDepth :: Int
 nestDepth = 4
 
 type Precedence = Int
-appPrec, unopPrec, opPrec, noPrec :: Precedence
-appPrec  = 3    -- Argument of a function application
-opPrec   = 2    -- Argument of an infix operator
-unopPrec = 1    -- Argument of an unresolved infix operator
+appPrec, opPrec, unopPrec, sigPrec, noPrec :: Precedence
+appPrec  = 4    -- Argument of a function application
+opPrec   = 3    -- Argument of an infix operator
+unopPrec = 2    -- Argument of an unresolved infix operator
+sigPrec  = 1    -- Argument of an explicit type signature
 noPrec   = 0    -- Others
 
 parensIf :: Bool -> Doc -> Doc
@@ -194,7 +195,8 @@ pprExp _ (CompE ss) =
         ss' = init ss
 pprExp _ (ArithSeqE d) = ppr d
 pprExp _ (ListE es) = brackets (commaSep es)
-pprExp i (SigE e t) = parensIf (i > noPrec) $ ppr e <+> dcolon <+> ppr t
+pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e
+                                          <+> dcolon <+> ppr t
 pprExp _ (RecConE nm fs) = ppr nm <> braces (pprFields fs)
 pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs)
 pprExp i (StaticE e) = parensIf (i >= appPrec) $
@@ -219,9 +221,14 @@ instance Ppr Stmt where
 
 ------------------------------
 instance Ppr Match where
-    ppr (Match p rhs ds) = ppr p <+> pprBody False rhs
+    ppr (Match p rhs ds) = pprMatchPat p <+> pprBody False rhs
                         $$ where_clause ds
 
+pprMatchPat :: Pat -> Doc
+-- Everything except pattern signatures bind more tightly than (->)
+pprMatchPat p@(SigP {}) = parens (ppr p)
+pprMatchPat p           = ppr p
+
 ------------------------------
 pprGuarded :: Doc -> (Guard, Exp) -> Doc
 pprGuarded eqDoc (guard, expr) = case guard of