[commit: ghc] master: Fix #15331 with careful blasts of parenthesizeHsType (b6a3386)

[git at git.haskell.org]

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

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

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

commit b6a3386186b77333b7a6cdc163499d7dae0dad1c
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Thu Jul 5 08:51:43 2018 -0400

    Fix #15331 with careful blasts of parenthesizeHsType
    
    Summary:
    Another `-ddump-splices` bug that can be solved with more
    judicious use of parentheses.
    
    Test Plan: make test TEST=T15331
    
    Reviewers: goldfire, bgamari, alanz, tdammers
    
    Reviewed By: tdammers
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #15331
    
    Differential Revision: https://phabricator.haskell.org/D4920


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

b6a3386186b77333b7a6cdc163499d7dae0dad1c
 compiler/hsSyn/Convert.hs        | 3 ++-
 compiler/hsSyn/HsTypes.hs        | 4 ++--
 compiler/hsSyn/HsUtils.hs        | 5 ++++-
 compiler/typecheck/TcGenDeriv.hs | 2 +-
 testsuite/tests/th/T15331.hs     | 9 +++++++++
 testsuite/tests/th/T15331.stderr | 6 ++++++
 testsuite/tests/th/all.T         | 1 +
 7 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index aa651da..c64cb7c 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -818,7 +818,8 @@ cvtl e = wrapL (cvt e)
     cvt (AppTypeE e t) = do { e' <- cvtl e
                             ; t' <- cvtType t
                             ; tp <- wrap_apps t'
-                            ; return $ HsAppType (mkHsWildCardBndrs tp) e' }
+                            ; let tp' = parenthesizeHsType appPrec tp
+                            ; return $ HsAppType (mkHsWildCardBndrs tp') e' }
     cvt (LamE [] e)    = cvt e -- Degenerate case. We convert the body as its
                                -- own expression to avoid pretty-printing
                                -- oddities that can result from zero-argument
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 6d14d7d..cbaa9fb 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -1425,8 +1425,8 @@ ppr_tylit (HsStrTy _ s) = text (show s)
 hsTypeNeedsParens :: PprPrec -> HsType pass -> Bool
 hsTypeNeedsParens p = go
   where
-    go (HsForAllTy{})        = False
-    go (HsQualTy{})          = False
+    go (HsForAllTy{})        = p >= funPrec
+    go (HsQualTy{})          = p >= funPrec
     go (HsBangTy{})          = p > topPrec
     go (HsRecTy{})           = False
     go (HsTyVar{})           = False
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index ca0cb92..a759f1a 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -178,7 +178,10 @@ mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2)
 
 mkHsAppType :: (XAppTypeE (GhcPass id) ~ LHsWcType GhcRn)
             => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)
-mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType t e)
+mkHsAppType e t = addCLoc e t_body (HsAppType paren_wct e)
+  where
+    t_body    = hswc_body t
+    paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }
 
 mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
 mkHsAppTypes = foldl mkHsAppType
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index e1665e2..beaad98 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -1810,7 +1810,7 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty
 nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
 nlHsAppType e s = noLoc (HsAppType hs_ty e)
   where
-    hs_ty = mkHsWildCardBndrs $ nlHsParTy (typeToLHsType s)
+    hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec (typeToLHsType s)
 
 nlExprWithTySig :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
 nlExprWithTySig e s = noLoc $ ExprWithTySig hs_ty
diff --git a/testsuite/tests/th/T15331.hs b/testsuite/tests/th/T15331.hs
new file mode 100644
index 0000000..0b0a076
--- /dev/null
+++ b/testsuite/tests/th/T15331.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+module T15331 where
+
+import Data.Proxy
+
+$([d| f :: Proxy (Int -> Int)
+      f = Proxy @(Int -> Int)
+    |])
diff --git a/testsuite/tests/th/T15331.stderr b/testsuite/tests/th/T15331.stderr
new file mode 100644
index 0000000..99bfdfd
--- /dev/null
+++ b/testsuite/tests/th/T15331.stderr
@@ -0,0 +1,6 @@
+T15331.hs:(7,3)-(9,6): Splicing declarations
+    [d| f :: Proxy (Int -> Int)
+        f = Proxy @(Int -> Int) |]
+  ======>
+    f :: Proxy (Int -> Int)
+    f = Proxy @(Int -> Int)
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index d8b8c94..84aa84b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -417,3 +417,4 @@ test('T14885c', normal, compile, [''])
 test('T15243', normal, compile, ['-dsuppress-uniques'])
 test('T15321', normal, compile_fail, [''])
 test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])