From 34d863153155284c3e389d258f454490c205b58f Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Sat, 5 Aug 2023 17:59:26 +0100
Subject: [PATCH] EPA: Remove parenthesizeHsType

This is called from PostProcess.hs, and adds spurious parens.
With the looser version of exact printing we had before we could
tolerate this, as they would be swallowed by the original at the same
place.

But with the next change (remove EpAnnNotUsed) they result in
duplicates in the output.

For Darwin build:

Metric Increase:
    MultiLayerModulesTH_OneShot
---
 compiler/GHC/Hs/Type.hs                              |  2 +-
 compiler/GHC/Hs/Utils.hs                             | 12 ++++++------
 .../parser/should_fail/unpack_inside_type.stderr     |  4 ++--
 3 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index c753980e3bfa..2936db9faa8c 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -541,7 +541,7 @@ mkHsOpTy prom ty1 op ty2 = HsOpTy noAnn prom ty1 op ty2
 
 mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 mkHsAppTy t1 t2
-  = addCLocA t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))
+  = addCLocA t1 t2 (HsAppTy noExtField t1 t2)
 
 mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
            -> LHsType (GhcPass p)
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 8f54c6dafd4b..2814af0e695d 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -263,7 +263,7 @@ mkHsAppType :: LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn
 mkHsAppType e t = addCLocA t_body e (HsAppType noExtField e noHsTok paren_wct)
   where
     t_body    = hswc_body t
-    paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }
+    paren_wct = t { hswc_body = t_body }
 
 mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
 mkHsAppTypes = foldl' mkHsAppType
@@ -628,9 +628,9 @@ nlHsTyVar :: IsSrcSpanAnn p a
 nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)
 
-nlHsAppTy f t = noLocA (HsAppTy noExtField f (parenthesizeHsType appPrec t))
+nlHsAppTy f t = noLocA (HsAppTy noExtField f t)
 nlHsTyVar p x = noLocA (HsTyVar noAnn p (noLocA x))
-nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) (parenthesizeHsType funPrec a) b)
+nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) a b)
 nlHsParTy t   = noLocA (HsParTy noAnn t)
 
 nlHsTyConApp :: IsSrcSpanAnn p a
@@ -647,14 +647,14 @@ nlHsTyConApp prom fixity tycon tys
     mk_app :: LHsType (GhcPass p) -> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
     mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLocA $ HsParTy noAnn fun) arg
       -- parenthesize things like `(A + B) C`
-    mk_app fun (HsValArg ty) = noLocA (HsAppTy noExtField fun (parenthesizeHsType appPrec ty))
-    mk_app fun (HsTypeArg at ki) = noLocA (HsAppKindTy noExtField fun at (parenthesizeHsType appPrec ki))
+    mk_app fun (HsValArg ty) = noLocA (HsAppTy noExtField fun ty)
+    mk_app fun (HsTypeArg at ki) = noLocA (HsAppKindTy noExtField fun at ki)
     mk_app fun (HsArgPar _) = noLocA (HsParTy noAnn fun)
 
 nlHsAppKindTy ::
   LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
 nlHsAppKindTy f k
-  = noLocA (HsAppKindTy noExtField f noHsTok (parenthesizeHsType appPrec k))
+  = noLocA (HsAppKindTy noExtField f noHsTok k)
 
 {-
 Tuples.  All these functions are *pre-typechecker* because they lack
diff --git a/testsuite/tests/parser/should_fail/unpack_inside_type.stderr b/testsuite/tests/parser/should_fail/unpack_inside_type.stderr
index bef48ba14818..be0ca667afb9 100644
--- a/testsuite/tests/parser/should_fail/unpack_inside_type.stderr
+++ b/testsuite/tests/parser/should_fail/unpack_inside_type.stderr
@@ -2,6 +2,6 @@
 unpack_inside_type.hs:3:25: error: [GHC-18932]
     • Unexpected UNPACK annotation: {-# UNPACK #-}Int
       UNPACK annotation cannot appear nested inside a type
-    • In the first argument of ‘Maybe’, namely ‘({-# UNPACK #-}Int)’
-      In the type ‘Maybe ({-# UNPACK #-}Int)’
+    • In the first argument of ‘Maybe’, namely ‘{-# UNPACK #-}Int’
+      In the type ‘Maybe {-# UNPACK #-}Int’
       In the definition of data constructor ‘T’
-- 
GitLab