TH-spliced class instances are pretty-printed incorrectly post-#3384

Summary:
The HsSyn prettyprinter tests patch 499e43824bda967546ebf95ee33ec1f84a114a7c
broke the pretty-printing of Template Haskell-spliced class instances.

Test Plan: ./validate

Reviewers: RyanGlScott, austin, goldfire, bgamari

Reviewed By: RyanGlScott, bgamari

Subscribers: thomie

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

4 files changed, 91 insertions, 0 deletions

diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 7a6bbc5de4..bc2a4ed998 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -197,3 +197,7 @@ ppr047:
 .PHONY: ppr048
 ppr048:
 	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr048.hs
+
+.PHONY: T13199
+T13199:
+	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13199.hs
diff --git a/testsuite/tests/printer/T13199.hs b/testsuite/tests/printer/T13199.hs
new file mode 100644
index 0000000000..0bc36f3730
--- /dev/null
+++ b/testsuite/tests/printer/T13199.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
+module Bug where
+
+class C a b c
+data B a b = B { aa :: a, bb :: b }
+
+-- Types requiring parens.
+$([d| instance C (Maybe a) (Maybe b) c
+    |])
+
+-- ---------------------------------------------------------------------
+-- Patterns requiring parens according to hsPatNeedsParens
+
+-- SigPatIn. What about SigPatOut?
+$([d| g (a :: (Int -> Int) -> Int) = True |])
+
+-- ViewPat
+$([d| h (id -> x) = True |])
+
+-- PrefixCon with non-null args
+$([d| f (Just (Just False)) = True |])
+
+-- InfixCon for ConPatIn
+$([d| i (B (a `B` c) d) = True |])
+
+-- RecCon does not
+$([d| j B { aa = a} = True |])
+
+
+$([d| k = id @(Maybe Int) |])
+
+$([d| l = case Just 'a' of Just a -> Just ((\x -> x) a) |])
diff --git a/testsuite/tests/printer/T13199.stdout b/testsuite/tests/printer/T13199.stdout
new file mode 100644
index 0000000000..62e56590e0
--- /dev/null
+++ b/testsuite/tests/printer/T13199.stdout
@@ -0,0 +1,48 @@
+T13199.hs:(14,3)-(15,6): Splicing declarations
+    [d| instance C (Maybe a) (Maybe b) c |]
+  ======>
+    instance C (Maybe a) (Maybe b) c
+T13199.hs:21:3-44: Splicing declarations
+    [d| g (a :: (Int -> Int) -> Int) = True |]
+  ======>
+    g (a :: (Int -> Int) -> Int) = True
+T13199.hs:24:3-27: Splicing declarations
+    [d| h (id -> x) = True |] ======> h (id -> x) = True
+T13199.hs:27:3-37: Splicing declarations
+    [d| f (Just (Just False)) = True |]
+  ======>
+    f (Just (Just False)) = True
+T13199.hs:30:3-33: Splicing declarations
+    [d| i (B (a `B` c) d) = True |] ======> i (B (a `B` c) d) = True
+T13199.hs:33:3-29: Splicing declarations
+    [d| j B {aa = a} = True |] ======> j B {aa = a} = True
+T13199.hs:36:3-28: Splicing declarations
+    [d| k = id @(Maybe Int) |] ======> k = id @(Maybe Int)
+T13199.hs:38:3-58: Splicing declarations
+    [d| l = case Just 'a' of { Just a -> Just ((\ x -> x) a) } |]
+  ======>
+    l = case Just 'a' of { Just a -> Just ((\ x -> x) a) }
+T13199.ppr.hs:11:3-41: Splicing declarations
+    [d| instance C (Maybe a) (Maybe b) c |]
+  ======>
+    instance C (Maybe a) (Maybe b) c
+T13199.ppr.hs:12:3-44: Splicing declarations
+    [d| g (a :: (Int -> Int) -> Int) = True |]
+  ======>
+    g (a :: (Int -> Int) -> Int) = True
+T13199.ppr.hs:13:3-27: Splicing declarations
+    [d| h (id -> x) = True |] ======> h (id -> x) = True
+T13199.ppr.hs:14:3-37: Splicing declarations
+    [d| f (Just (Just False)) = True |]
+  ======>
+    f (Just (Just False)) = True
+T13199.ppr.hs:15:3-33: Splicing declarations
+    [d| i (B (a `B` c) d) = True |] ======> i (B (a `B` c) d) = True
+T13199.ppr.hs:16:3-28: Splicing declarations
+    [d| j B {aa = a} = True |] ======> j B {aa = a} = True
+T13199.ppr.hs:17:3-28: Splicing declarations
+    [d| k = id @(Maybe Int) |] ======> k = id @(Maybe Int)
+T13199.ppr.hs:18:3-63: Splicing declarations
+    [d| l = case Just 'a' of { Just a -> Just ((\ x -> x) a) } |]
+  ======>
+    l = case Just 'a' of { Just a -> Just ((\ x -> x) a) }
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index e0cfcc23a9..3106f936ba 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -46,3 +46,4 @@ test('Ppr045', ignore_stderr, run_command, ['$MAKE -s --no-print-directory ppr04
 test('Ppr046', ignore_stderr, run_command, ['$MAKE -s --no-print-directory ppr046'])
 test('Ppr047', expect_fail, run_command, ['$MAKE -s --no-print-directory ppr047'])
 test('Ppr048', ignore_stderr, run_command, ['$MAKE -s --no-print-directory ppr048'])
+test('T13199', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13199'])