Pretty-printer no longer butchers function arrow fixity

It now correctly prints the parens around '(Int -> Int)' in

    {-# LANGUAGE TemplateHaskell #-}
    {-# OPTIONS_GHC -ddump-splices #-}
    module Bug where

    $([d| f :: Either Int (Int -> Int)
          f = undefined
        |])

Closes #13942

5 files changed, 54 insertions, 0 deletions

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 8b7af27231..8fc903bb5a 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -1330,6 +1330,7 @@ mk_apps head_ty (ty:tys) =
      ; mk_apps (HsAppTy head_ty' p_ty) tys }
   where
     add_parens t@(L _ HsAppTy{}) = returnL (HsParTy t)
+    add_parens t@(L _ HsFunTy{}) = returnL (HsParTy t)
     add_parens t                 = return t
 
 wrap_apps  :: LHsType GhcPs -> CvtM (LHsType GhcPs)
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 9cb968f2b4..1c2f2995d0 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -209,3 +209,7 @@ T13050p:
 .PHONY: T13550
 T13550:
 	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13550.hs
+
+.PHONY: T13942
+T13942:
+	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13942.hs
diff --git a/testsuite/tests/printer/T13942.hs b/testsuite/tests/printer/T13942.hs
new file mode 100644
index 0000000000..8899e1c58d
--- /dev/null
+++ b/testsuite/tests/printer/T13942.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
+module T13942 where
+
+$([d| f :: Either Int (Int -> Int)
+      f = undefined
+    |])
+
+{-
+
+Note: to debug
+
+~/inplace/bin/ghc-stage2 --interactive
+load the following
+--------------------------------------
+import Language.Haskell.TH
+
+foo :: IO ()
+foo = do
+  r <- runQ ([d| f :: Either Int (Int -> Int)
+                 f = undefined
+             |])
+  print r
+
+----------------------------------------
+foo
+[SigD f_0 (AppT (AppT (ConT Data.Either.Either) (ConT GHC.Types.Int)) (AppT (AppT ArrowT (ConT GHC.Types.Int)) (ConT GHC.Types.Int)))
+,ValD (VarP f_0) (NormalB (VarE GHC.Err.undefined)) []]
+
+[SigD f_0
+  (AppT (AppT (ConT Data.Either.Either)
+              (ConT GHC.Types.Int))
+        (AppT (AppT ArrowT
+                    (ConT GHC.Types.Int))
+              (ConT GHC.Types.Int)))
+-}
diff --git a/testsuite/tests/printer/T13942.stdout b/testsuite/tests/printer/T13942.stdout
new file mode 100644
index 0000000000..2d0f617074
--- /dev/null
+++ b/testsuite/tests/printer/T13942.stdout
@@ -0,0 +1,12 @@
+T13942.hs:(5,3)-(7,6): Splicing declarations
+    [d| f :: Either Int (Int -> Int)
+        f = undefined |]
+  ======>
+    f :: Either Int (Int -> Int)
+    f = undefined
+T13942.ppr.hs:(4,3)-(5,22): Splicing declarations
+    [d| f :: Either Int (Int -> Int)
+        f = undefined |]
+  ======>
+    f :: Either Int (Int -> Int)
+    f = undefined
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index c939e49300..a71d6e3534 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -49,3 +49,4 @@ test('Ppr048', ignore_stderr, run_command, ['$MAKE -s --no-print-directory ppr04
 test('T13199', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13199'])
 test('T13050p', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13050p'])
 test('T13550', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13550'])
+test('T13942', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13942'])