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

4 files changed, 41 insertions, 2 deletions

diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr
index 6ff285fbef..ed44b3c2b1 100644
--- a/testsuite/tests/deriving/should_compile/T14682.stderr
+++ b/testsuite/tests/deriving/should_compile/T14682.stderr
@@ -61,14 +61,14 @@ Derived class instances:
            c1 <- GHC.Arr.range (a1, b1), c2 <- GHC.Arr.range (a2, b2)]
     GHC.Arr.unsafeIndex
       (T14682.Foo a1 a2, T14682.Foo b1 b2)
-      T14682.Foo c1 c2
+      (T14682.Foo c1 c2)
       = (GHC.Arr.unsafeIndex (a2, b2) c2
            GHC.Num.+
              (GHC.Arr.unsafeRangeSize (a2, b2)
                 GHC.Num.* GHC.Arr.unsafeIndex (a1, b1) c1))
     GHC.Arr.inRange
       (T14682.Foo a1 a2, T14682.Foo b1 b2)
-      T14682.Foo c1 c2
+      (T14682.Foo c1 c2)
       = (GHC.Arr.inRange (a1, b1) c1
            GHC.Classes.&& GHC.Arr.inRange (a2, b2) c2)
   
diff --git a/testsuite/tests/th/T14875.hs b/testsuite/tests/th/T14875.hs
new file mode 100644
index 0000000000..e601d36da8
--- /dev/null
+++ b/testsuite/tests/th/T14875.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T14875 where
+
+$([d| f :: Bool -> Bool
+      f x = case x of
+              (True :: Bool) -> True
+              (False :: Bool) -> False
+
+      g :: Bool -> Bool
+      g x = (case x of
+               True -> True
+               False -> False) :: Bool
+    |])
diff --git a/testsuite/tests/th/T14875.stderr b/testsuite/tests/th/T14875.stderr
new file mode 100644
index 0000000000..09374f243d
--- /dev/null
+++ b/testsuite/tests/th/T14875.stderr
@@ -0,0 +1,24 @@
+T14875.hs:(5,3)-(14,6): Splicing declarations
+    [d| f :: Bool -> Bool
+        f x
+          = case x of
+              (True :: Bool) -> True
+              (False :: Bool) -> False
+        g :: Bool -> Bool
+        g x
+          = (case x of
+               True -> True
+               False -> False) ::
+              Bool |]
+  ======>
+    f :: Bool -> Bool
+    f x
+      = case x of
+          (True :: Bool) -> True
+          (False :: Bool) -> False
+    g :: Bool -> Bool
+    g x
+      = (case x of
+           True -> True
+           False -> False) ::
+          Bool
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 2b6e517697..4169d7e202 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -407,6 +407,7 @@ test('T14869', normal, compile,
 test('T14888', normal, compile,
     ['-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags])
 test('T14298', normal, compile_and_run, ['-v0'])
+test('T14875', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T14885a', normal, compile, [''])
 test('T14885b', normal, compile, [''])
 test('T14885c', normal, compile, [''])