diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index c753980e3bfa5dad68bf21ff19d886c0028a52bf..2936db9faa8c998855577af36f4085730d9ee887 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 8f54c6dafd4b00063c96675af7c2add70487323a..2814af0e695dc0ad6e7e77e908602c3e5ee13cf7 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 bef48ba14818fbf1c5c04506eeef1e6731c6accc..be0ca667afb9e483bc8fb9aa7281dff4347012bb 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’