diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 122f0b9ec0d25e9c66ae48cdccae4ad6b24d5192..696c4454c78bd896d9567e79f25174bf16157dfd 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -399,7 +399,7 @@ ppr_data :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]
 ppr_data maybeInst ctxt t argsDoc ksig cs decs
   = sep [text "data" <+> maybeInst
             <+> pprCxt ctxt
-            <+> ppr t <+> argsDoc <+> ksigDoc <+> maybeWhere,
+            <+> pprName' Applied t <+> argsDoc <+> ksigDoc <+> maybeWhere,
          nest nestDepth (sep (pref $ map ppr cs)),
          if null decs
            then empty
@@ -679,8 +679,9 @@ pprStrictType = pprBangType
 
 ------------------------------
 pprParendType :: Type -> Doc
-pprParendType (VarT v)            = ppr v
-pprParendType (ConT c)            = ppr c
+pprParendType (VarT v)            = pprName' Applied v
+-- `Applied` is used here instead of `ppr` because of infix names (#13887)
+pprParendType (ConT c)            = pprName' Applied c
 pprParendType (TupleT 0)          = text "()"
 pprParendType (TupleT n)          = parens (hcat (replicate (n-1) comma))
 pprParendType (UnboxedTupleT n)   = hashParens $ hcat $ replicate (n-1) comma
diff --git a/testsuite/tests/th/T10828.stderr b/testsuite/tests/th/T10828.stderr
index 82509ec7b03753859aa2da1596135570e0bb66ef..70ed74bc1ec4889d0345d7765d5e74c61ed09ab3 100644
--- a/testsuite/tests/th/T10828.stderr
+++ b/testsuite/tests/th/T10828.stderr
@@ -8,7 +8,7 @@ newtype Bar_13 :: * -> GHC.Types.Bool -> *
   = MkBar_14 :: a_15 -> Bar_13 a_15 b_16
 data T10828.T (a_0 :: *) where
     T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1
-    T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . Data.Type.Equality.~ a_2
+    T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (Data.Type.Equality.~) a_2
                                                                       GHC.Types.Int => {T10828.foo :: a_2,
                                                                                         T10828.bar :: b_3} -> T10828.T GHC.Types.Int
 data T'_0 a_1 :: * where
diff --git a/testsuite/tests/th/T12403.stdout b/testsuite/tests/th/T12403.stdout
index 24e222a7326a784743f6a29391e860b756e55423..386b1c0a8983b88dd7f8da19d4bcb307a1c71b61 100644
--- a/testsuite/tests/th/T12403.stdout
+++ b/testsuite/tests/th/T12403.stdout
@@ -1,5 +1,5 @@
 data Main.T
     = Main.T ((# , #) GHC.Types.Int
-                      GHC.Types.Int :: GHC.Prim.TYPE (GHC.Types.TupleRep (GHC.Types.: GHC.Types.LiftedRep
-                                                                                      (GHC.Types.: GHC.Types.LiftedRep
-                                                                                                   GHC.Types.[]))))
+                      GHC.Types.Int :: GHC.Prim.TYPE (GHC.Types.TupleRep ((GHC.Types.:) GHC.Types.LiftedRep
+                                                                                        ((GHC.Types.:) GHC.Types.LiftedRep
+                                                                                                       GHC.Types.[]))))