[commit: ghc] master: Pretty-printer no longer butchers function arrow fixity (c506f83)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c506f8353755333e21d5ee35bc71d2c8f9ddcb1b/ghc

>---------------------------------------------------------------

commit c506f8353755333e21d5ee35bc71d2c8f9ddcb1b
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Mon Jul 10 13:00:36 2017 +0200

    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


>---------------------------------------------------------------

c506f8353755333e21d5ee35bc71d2c8f9ddcb1b
 compiler/hsSyn/Convert.hs             |  1 +
 testsuite/tests/printer/Makefile      |  4 ++++
 testsuite/tests/printer/T13942.hs     | 36 +++++++++++++++++++++++++++++++++++
 testsuite/tests/printer/T13942.stdout | 12 ++++++++++++
 testsuite/tests/printer/all.T         |  1 +
 5 files changed, 54 insertions(+)

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 8b7af27..8fc903b 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 9cb968f..1c2f299 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 0000000..8899e1c
--- /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 0000000..2d0f617
--- /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 c939e49..a71d6e3 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'])