diff --git a/CHANGES.md b/CHANGES.md
index 21b2a5d..cede23b 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -3,12 +3,19 @@
 
 Version 1.14 [????.??.??]
 -------------------------
+* Support GHC 9.4.
 * Drop support for GHC 7.8 and 7.10. As a consequence of this, the
   `strictToBang` was removed as it no longer serves a useful purpose.
 * Desugared lambda expressions and guards that bind multiple patterns can now
   have patterns with unlifted types. The desugared code uses `UnboxedTuples` to
   make this possible, so if you load the desugared code into GHCi on prior to
   GHC 9.2, you will need to enable `-fobject-code`.
+* `th-desugar` now desugars `PromotedInfixT` and `PromotedUInfixT`, which were
+  added in GHC 9.4. Mirroring the existing treatment of other `Promoted*`
+  `Type`s, `PromotedInfixT` is desugared to an application of a `DConT` applied
+  to two arguments, just like `InfixT` is desugared. Similarly, attempting to
+  desugar a `PromotedUInfixT` results in an error, just like attempting to
+  desugar a `UInfixT` would be.
 * Fix an inconsistency which caused non-exhaustive `case` expressions to be
   desugared into uses of `EmptyCase`. Non-exhaustive `case` expressions are now
   desugared into code that throws a "`Non-exhaustive patterns in...`" error at
diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
index a36ab2c..74090bf 100644
--- a/Language/Haskell/TH/Desugar/Core.hs
+++ b/Language/Haskell/TH/Desugar/Core.hs
@@ -1126,8 +1126,8 @@ dsType StarT = return $ DConT typeKindName
 dsType ConstraintT = return $ DConT ''Constraint
 dsType (LitT lit) = return $ DLitT lit
 dsType EqualityT = return $ DConT ''(~)
-dsType (InfixT t1 n t2) = DAppT <$> (DAppT (DConT n) <$> dsType t1) <*> dsType t2
-dsType (UInfixT _ _ _) = fail "Cannot desugar unresolved infix operators."
+dsType (InfixT t1 n t2) = dsInfixT t1 n t2
+dsType (UInfixT{}) = dsUInfixT
 dsType (ParensT t) = dsType t
 dsType WildCardT = return DWildCardT
 #if __GLASGOW_HASKELL__ >= 801
@@ -1143,6 +1143,10 @@ dsType (ImplicitParamT n t) = do
 dsType (ForallVisT tvbs ty) =
   DForallT <$> (DForallVis <$> mapM dsTvbUnit tvbs) <*> dsType ty
 #endif
+#if __GLASGOW_HASKELL__ >= 903
+dsType (PromotedInfixT t1 n t2) = dsInfixT t1 n t2
+dsType PromotedUInfixT{} = dsUInfixT
+#endif
 
 #if __GLASGOW_HASKELL__ >= 900
 -- | Desugar a 'TyVarBndr'.
@@ -1190,6 +1194,14 @@ types, we pretend as if MulArrowT does not exist. As a result, the type of
 `Just` would be locally reified as `a -> Maybe a`, not `a #-> Maybe a`.
 -}
 
+-- | Desugar an infix 'Type'.
+dsInfixT :: DsMonad q => Type -> Name -> Type -> q DType
+dsInfixT t1 n t2 = DAppT <$> (DAppT (DConT n) <$> dsType t1) <*> dsType t2
+
+-- | We cannot desugar unresolved infix operators, so fail if we encounter one.
+dsUInfixT :: Fail.MonadFail m => m a
+dsUInfixT = fail "Cannot desugar unresolved infix operators."
+
 -- | Desugar a 'TyVarBndrSpec'.
 dsTvbSpec :: DsMonad q => TyVarBndrSpec -> q DTyVarBndrSpec
 #if __GLASGOW_HASKELL__ >= 900
@@ -1281,8 +1293,8 @@ dsPred ConstraintT =
 dsPred t@(LitT _) =
   impossible $ "Type literal seen as head of constraint: " ++ show t
 dsPred EqualityT = return [DConT ''(~)]
-dsPred (InfixT t1 n t2) = (:[]) <$> (DAppT <$> (DAppT (DConT n) <$> dsType t1) <*> dsType t2)
-dsPred (UInfixT _ _ _) = fail "Cannot desugar unresolved infix operators."
+dsPred (InfixT t1 n t2) = (:[]) <$> dsInfixT t1 n t2
+dsPred (UInfixT{}) = dsUInfixT
 dsPred (ParensT t) = dsPred t
 dsPred WildCardT = return [DWildCardT]
 #if __GLASGOW_HASKELL__ >= 801
@@ -1304,6 +1316,10 @@ dsPred t@(ForallVisT {}) =
 #if __GLASGOW_HASKELL__ >= 900
 dsPred MulArrowT = impossible "Linear arrow seen as head of constraint."
 #endif
+#if __GLASGOW_HASKELL__ >= 903
+dsPred (PromotedInfixT t1 n t2) = (:[]) <$> dsInfixT t1 n t2
+dsPred PromotedUInfixT{} = dsUInfixT
+#endif
 
 -- | Desugar a quantified constraint.
 dsForallPred :: DsMonad q => [TyVarBndrSpec] -> Cxt -> Pred -> q DCxt