diff --git a/patches/HTTP-4000.3.15.patch b/patches/HTTP-4000.3.15.patch
deleted file mode 100644
index d7601f91cf9a6d462aab0f8d529ef872a2dca569..0000000000000000000000000000000000000000
--- a/patches/HTTP-4000.3.15.patch
+++ /dev/null
@@ -1,13 +0,0 @@
-diff --git a/Network/TCP.hs b/Network/TCP.hs
-index 6f20319..ce01117 100644
---- a/Network/TCP.hs
-+++ b/Network/TCP.hs
-@@ -89,7 +89,7 @@ instance Eq EndPoint where
-      map toLower host1 == map toLower host2 && port1 == port2
- 
- data Conn a 
-- = MkConn { connSock      :: ! Socket
-+ = MkConn { connSock      :: !Socket
-           , connHandle    :: Handle
-           , connBuffer    :: BufferOp a
-           , connInput     :: Maybe a
diff --git a/patches/bifunctors-5.5.10.patch b/patches/bifunctors-5.5.10.patch
index b90913c61a1ab906dacf3b3c1c9e70544c55d22a..f520ba47c38a9228a3764374c2d5b8278302dcef 100644
--- a/patches/bifunctors-5.5.10.patch
+++ b/patches/bifunctors-5.5.10.patch
@@ -1,29 +1,27 @@
 diff --git a/src/Data/Bifunctor/TH.hs b/src/Data/Bifunctor/TH.hs
-index 6545db1..f817ec7 100644
+index 6545db1..41f77ea 100644
 --- a/src/Data/Bifunctor/TH.hs
 +++ b/src/Data/Bifunctor/TH.hs
-@@ -1252,7 +1252,12 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp)
+@@ -1252,7 +1252,11 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp)
                   -> Q Match
  mkSimpleConMatch fold conName insides = do
    varsNeeded <- newNameList "_arg" $ length insides
 -  let pat = ConP conName (map VarP varsNeeded)
 +  let pat = ConP conName
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                 []
 +#endif
 +                 (map VarP varsNeeded)
    rhs <- fold conName (zipWith (\i v -> i $ VarE v) insides varsNeeded)
    return $ Match pat (NormalB rhs) []
  
-@@ -1276,7 +1281,12 @@ mkSimpleConMatch2 :: (Exp -> [Exp] -> Q Exp)
+@@ -1276,7 +1280,11 @@ mkSimpleConMatch2 :: (Exp -> [Exp] -> Q Exp)
                    -> Q Match
  mkSimpleConMatch2 fold conName insides = do
    varsNeeded <- newNameList "_arg" lengthInsides
 -  let pat = ConP conName (map VarP varsNeeded)
 +  let pat = ConP conName
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                 []
 +#endif
 +                 (map VarP varsNeeded)
diff --git a/patches/boomerang-1.4.6.patch b/patches/boomerang-1.4.6.patch
deleted file mode 100644
index bbee64e28b330ac839c861893c93242d45e6c42a..0000000000000000000000000000000000000000
--- a/patches/boomerang-1.4.6.patch
+++ /dev/null
@@ -1,57 +0,0 @@
-diff --git a/Text/Boomerang/TH.hs b/Text/Boomerang/TH.hs
-index 8a635da..d9020fb 100644
---- a/Text/Boomerang/TH.hs
-+++ b/Text/Boomerang/TH.hs
-@@ -41,7 +41,7 @@ derivePrinterParsers = makeBoomerangs
- {-# DEPRECATED derivePrinterParsers "Use makeBoomerangs instead" #-}
- 
- -- Derive a router for a single constructor.
--deriveBoomerang :: (Name, [TyVarBndr]) -> Con -> Q [Dec]
-+deriveBoomerang :: (Name, [TyVarBndrUnit]) -> Con -> Q [Dec]
- deriveBoomerang (tName, tParams) con =
-   case con of
-     NormalC name tys -> go name (map snd tys)
-@@ -50,8 +50,8 @@ deriveBoomerang (tName, tParams) con =
-       runIO $ putStrLn $ "Skipping unsupported constructor " ++ show (conName con)
-       return []
-   where
--    takeName (PlainTV n) = n
--    takeName (KindedTV n _) = n
-+    takeName (PlainTV n _) = n
-+    takeName (KindedTV n _ _) = n
-     go name tys = do
-       let name' = mkBoomerangName name
-       let tok' = mkName "tok"
-@@ -66,7 +66,7 @@ deriveBoomerang (tName, tParams) con =
-       expr <- [| xpure $(deriveConstructor name (length tys))
-                      $(deriveDestructor name tys) |]
-       return [ SigD name'
--                    (ForallT (map PlainTV ([tok', e', r'] ++ (map takeName tParams)))
-+                    (ForallT (map (`PlainTV` SpecifiedSpec) ([tok', e', r'] ++ (map takeName tParams)))
-                              []
-                              (AppT (AppT ppType inT) outT))
-              , FunD name' [Clause [] (NormalB expr) []]
-@@ -98,13 +98,21 @@ deriveDestructor name tys = do
-   ConE cons  <- [| (:-) |]
- 
- 
--  let conPat   = ConP name (map VarP fieldNames)
-+  let conPat   = ConP name
-+#if __GLASGOW_HASKELL__ >= 901
-+                           []
-+#endif
-+                           (map VarP fieldNames)
-   let okBody   = ConE just `AppE`
-                   foldr
-                     (\h t -> ConE cons `AppE` VarE h `AppE` t)
-                     (VarE r)
-                     fieldNames
--  let okCase   = Match (ConP cons [conPat, VarP r]) (NormalB okBody) []
-+  let okCase   = Match (ConP cons
-+#if __GLASGOW_HASKELL__ >= 901
-+                                  []
-+#endif
-+                                  [conPat, VarP r]) (NormalB okBody) []
-   let nStr = show name
-   let failCase = Match WildP (NormalB nothing) []
- 
diff --git a/patches/boomerang-1.4.7.patch b/patches/boomerang-1.4.7.patch
new file mode 100644
index 0000000000000000000000000000000000000000..a116230cc91e6ba0b8350ed17c99da992fbd8ea4
--- /dev/null
+++ b/patches/boomerang-1.4.7.patch
@@ -0,0 +1,28 @@
+diff --git a/Text/Boomerang/TH.hs b/Text/Boomerang/TH.hs
+index 629d1f2..f7dadd6 100644
+--- a/Text/Boomerang/TH.hs
++++ b/Text/Boomerang/TH.hs
+@@ -97,13 +97,21 @@ deriveDestructor name tys = do
+   ConE cons  <- [| (:-) |]
+ 
+ 
+-  let conPat   = ConP name (map VarP fieldNames)
++  let conPat   = ConP name
++#if __GLASGOW_HASKELL__ >= 901
++                           []
++#endif
++                           (map VarP fieldNames)
+   let okBody   = ConE just `AppE`
+                   foldr
+                     (\h t -> ConE cons `AppE` VarE h `AppE` t)
+                     (VarE r)
+                     fieldNames
+-  let okCase   = Match (ConP cons [conPat, VarP r]) (NormalB okBody) []
++  let okCase   = Match (ConP cons
++#if __GLASGOW_HASKELL__ >= 901
++                                  []
++#endif
++                                  [conPat, VarP r]) (NormalB okBody) []
+   let nStr = show name
+   let failCase = Match WildP (NormalB nothing) []
+ 
diff --git a/patches/bound-2.0.3.patch b/patches/bound-2.0.3.patch
index 98e7311bd72b2c557c663a023a2b4e6b81153e1f..da8b858e82e05dd951ae1d7005690a48f3d705c0 100644
--- a/patches/bound-2.0.3.patch
+++ b/patches/bound-2.0.3.patch
@@ -1,15 +1,14 @@
 diff --git a/src/Bound/TH.hs b/src/Bound/TH.hs
-index c4a9255..83253cf 100644
+index c4a9255..faced54 100644
 --- a/src/Bound/TH.hs
 +++ b/src/Bound/TH.hs
-@@ -318,7 +318,12 @@ interpret bnds = do
+@@ -318,7 +318,11 @@ interpret bnds = do
       exprs <- foldM bindOne (ConE name) bounds
       pure $
         Match
 -       (ConP name [ VarP arg | (arg, _) <- bounds ])
 +       (ConP name
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +             []
 +#endif
 +             [ VarP arg | (arg, _) <- bounds ])
diff --git a/patches/constraints-extras-0.3.0.2.patch b/patches/constraints-extras-0.3.0.2.patch
index e97fe13dd43baf1315001cc7a872ec20567890a3..5d61b2f63e26491924a618ef099eec3e2af668a8 100644
--- a/patches/constraints-extras-0.3.0.2.patch
+++ b/patches/constraints-extras-0.3.0.2.patch
@@ -34,7 +34,7 @@ index 029e5a8..0e8c49c 100644
    main-is: README.lhs
    ghc-options: -Wall -optL -q
 diff --git a/src/Data/Constraint/Extras/TH.hs b/src/Data/Constraint/Extras/TH.hs
-index 148ff3e..45179d4 100644
+index 148ff3e..52b2ec3 100644
 --- a/src/Data/Constraint/Extras/TH.hs
 +++ b/src/Data/Constraint/Extras/TH.hs
 @@ -1,3 +1,4 @@
@@ -42,14 +42,13 @@ index 148ff3e..45179d4 100644
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE QuasiQuotes #-}
  {-# LANGUAGE TemplateHaskell #-}
-@@ -55,7 +56,12 @@ matches c n argDictName = do
+@@ -55,7 +56,11 @@ matches c n argDictName = do
                      Nothing -> WildP : rest done
                      Just _ -> VarP v : rest True
                  pat = foldr patf (const []) ps False
 -            in [Match (ConP name pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []]
 +            in [Match (ConP name
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                            []
 +#endif
 +                            pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []]
diff --git a/patches/cql-4.0.3.patch b/patches/cql-4.0.3.patch
index a6413a9feb8061e6c85089c6d2df423249bebc54..87c2f1883d3c0556daeceed499b7a51c312f35ae 100644
--- a/patches/cql-4.0.3.patch
+++ b/patches/cql-4.0.3.patch
@@ -1,16 +1,15 @@
 diff --git a/src/Database/CQL/Protocol/Record.hs b/src/Database/CQL/Protocol/Record.hs
-index 266501a..8c84f54 100644
+index 266501a..1ea7db3 100644
 --- a/src/Database/CQL/Protocol/Record.hs
 +++ b/src/Database/CQL/Protocol/Record.hs
-@@ -91,8 +91,17 @@ asTupleDecl c =
+@@ -91,8 +91,16 @@ asTupleDecl c =
    where
      go n t = do
          vars <- replicateM (length t) (newName "a")
 -        return $ Clause [ConP n (map VarP vars)] (body vars) []
 -    body = NormalB . mkTup . map VarE
 +        return $ Clause [ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                              []
 +#endif
 +                              (map VarP vars)] (body vars) []
@@ -23,7 +22,7 @@ index 266501a..8c84f54 100644
  asRecrdDecl ::Con -> Q Clause
  asRecrdDecl c =
 diff --git a/src/Database/CQL/Protocol/Tuple/TH.hs b/src/Database/CQL/Protocol/Tuple/TH.hs
-index 26a179f..c381b8e 100644
+index 26a179f..ab43ff2 100644
 --- a/src/Database/CQL/Protocol/Tuple/TH.hs
 +++ b/src/Database/CQL/Protocol/Tuple/TH.hs
 @@ -72,7 +72,11 @@ storeDecl n = do
@@ -39,14 +38,13 @@ index 26a179f..c381b8e 100644
      size         = var "put" $$ SigE (litInt n) (tcon "Word16")
      value x v    = var "putValue" $$ VarE x $$ (var "toCql" $$ VarE v)
  
-@@ -117,7 +121,12 @@ cqlInstances n = do
+@@ -117,7 +121,11 @@ cqlInstances n = do
          Clause
              [VarP (mkName "t")]
              (NormalB $ CaseE (var "t")
 -                [ Match (ParensP (ConP (mkName "CqlTuple") [ListP (map VarP names)]))
 +                [ Match (ParensP (ConP (mkName "CqlTuple")
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                                       []
 +#endif
 +                                       [ListP (map VarP names)]))
diff --git a/patches/cryptonite-0.27.patch b/patches/cryptonite-0.27.patch
deleted file mode 100644
index 0c376a918d87e4a7643e1955038b5b818d70a6b3..0000000000000000000000000000000000000000
--- a/patches/cryptonite-0.27.patch
+++ /dev/null
@@ -1,165 +0,0 @@
-diff --git a/Crypto/Internal/WordArray.hs b/Crypto/Internal/WordArray.hs
-index 0f3c0f6..349be6c 100644
---- a/Crypto/Internal/WordArray.hs
-+++ b/Crypto/Internal/WordArray.hs
-@@ -10,6 +10,7 @@
- --
- -- The array produced should never be exposed to the user directly.
- --
-+{-# LANGUAGE CPP #-}
- {-# LANGUAGE BangPatterns #-}
- {-# LANGUAGE MagicHash #-}
- {-# LANGUAGE UnboxedTuples #-}
-@@ -114,7 +115,7 @@ mutableArray32FromAddrBE (I# n) a = IO $ \s ->
-         loop i st mb
-             | booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
-             | otherwise             =
--                let !st' = writeWord32Array# mb i (be32Prim (indexWord32OffAddr# a i)) st
-+                let !st' = writeWord32Array# mb i (wordToWord32Compat# (be32Prim (word32ToWordCompat# (indexWord32OffAddr# a i)))) st
-                  in loop (i +# 1#) st' mb
- 
- -- | freeze a Mutable Array of Word32 into a immutable Array of Word32
-@@ -155,3 +156,17 @@ mutableArrayWriteXor32 :: MutableArray32 -> Int -> Word32 -> IO ()
- mutableArrayWriteXor32 m o w =
-     mutableArrayRead32 m o >>= \wOld -> mutableArrayWrite32 m o (wOld `xor` w)
- {-# INLINE mutableArrayWriteXor32 #-}
-+
-+#if MIN_VERSION_base(4,16,0)
-+word32ToWordCompat# :: Word32# -> Word#
-+word32ToWordCompat# = word32ToWord#
-+
-+wordToWord32Compat# :: Word# -> Word32#
-+wordToWord32Compat# = wordToWord32#
-+#else
-+word32ToWordCompat# :: Word# -> Word#
-+word32ToWordCompat# x = x
-+
-+wordToWord32Compat# :: Word# -> Word#
-+wordToWord32Compat# x = x
-+#endif
-diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs
-index e624b42..253b222 100644
---- a/Crypto/Number/Basic.hs
-+++ b/Crypto/Number/Basic.hs
-@@ -100,6 +100,7 @@ numBits n = gmpSizeInBits n `onGmpUnsupported` (if n == 0 then 1 else computeBit
- 
- -- | Compute the number of bytes for an integer
- numBytes :: Integer -> Int
-+numBytes 0 = 1
- numBytes n = gmpSizeInBytes n `onGmpUnsupported` ((numBits n + 7) `div` 8)
- 
- -- | Express an integer as an odd number and a power of 2
-diff --git a/Crypto/Number/Compat.hs b/Crypto/Number/Compat.hs
-index 01e0455..4ebb9cb 100644
---- a/Crypto/Number/Compat.hs
-+++ b/Crypto/Number/Compat.hs
-@@ -51,7 +51,9 @@ onGmpUnsupported GmpUnsupported   f = f
- 
- -- | Compute the GCDE of a two integer through GMP
- gmpGcde :: Integer -> Integer -> GmpSupported (Integer, Integer, Integer)
--#if MIN_VERSION_integer_gmp(0,5,1)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpGcde _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(0,5,1)
- gmpGcde a b =
-     GmpSupported (s, t, g)
-   where (# g, s #) = gcdExtInteger a b
-@@ -72,7 +74,9 @@ gmpLog2 _ = GmpUnsupported
- -- | Compute the power modulus using extra security to remain constant
- -- time wise through GMP
- gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
--#if MIN_VERSION_integer_gmp(1,0,2)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpPowModSecInteger _ _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(1,0,2)
- gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
- #elif MIN_VERSION_integer_gmp(1,0,0)
- gmpPowModSecInteger _ _ _ = GmpUnsupported
-@@ -84,7 +88,9 @@ gmpPowModSecInteger _ _ _ = GmpUnsupported
- 
- -- | Compute the power modulus through GMP
- gmpPowModInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
--#if MIN_VERSION_integer_gmp(0,5,1)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpPowModInteger _ _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(0,5,1)
- gmpPowModInteger b e m = GmpSupported (powModInteger b e m)
- #else
- gmpPowModInteger _ _ _ = GmpUnsupported
-@@ -92,7 +98,9 @@ gmpPowModInteger _ _ _ = GmpUnsupported
- 
- -- | Inverse modulus of a number through GMP
- gmpInverse :: Integer -> Integer -> GmpSupported (Maybe Integer)
--#if MIN_VERSION_integer_gmp(0,5,1)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpInverse _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(0,5,1)
- gmpInverse g m
-     | r == 0    = GmpSupported Nothing
-     | otherwise = GmpSupported (Just r)
-@@ -103,7 +111,9 @@ gmpInverse _ _ = GmpUnsupported
- 
- -- | Get the next prime from a specific value through GMP
- gmpNextPrime :: Integer -> GmpSupported Integer
--#if MIN_VERSION_integer_gmp(0,5,1)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpNextPrime _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(0,5,1)
- gmpNextPrime n = GmpSupported (nextPrimeInteger n)
- #else
- gmpNextPrime _ = GmpUnsupported
-@@ -111,7 +121,9 @@ gmpNextPrime _ = GmpUnsupported
- 
- -- | Test if a number is prime using Miller Rabin
- gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
--#if MIN_VERSION_integer_gmp(0,5,1)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpTestPrimeMillerRabin _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(0,5,1)
- gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
-     case testPrimeInteger n tries of
-         0# -> False
-@@ -138,7 +150,9 @@ gmpSizeInBits _ = GmpUnsupported
- 
- -- | Export an integer to a memory (big-endian)
- gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
--#if MIN_VERSION_integer_gmp(1,0,0)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpExportInteger _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(1,0,0)
- gmpExportInteger n (Ptr addr) = GmpSupported $ do
-     _ <- exportIntegerToAddr n addr 1#
-     return ()
-@@ -152,7 +166,9 @@ gmpExportInteger _ _ = GmpUnsupported
- 
- -- | Export an integer to a memory (little-endian)
- gmpExportIntegerLE :: Integer -> Ptr Word8 -> GmpSupported (IO ())
--#if MIN_VERSION_integer_gmp(1,0,0)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpExportIntegerLE _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(1,0,0)
- gmpExportIntegerLE n (Ptr addr) = GmpSupported $ do
-     _ <- exportIntegerToAddr n addr 0#
-     return ()
-@@ -166,7 +182,9 @@ gmpExportIntegerLE _ _ = GmpUnsupported
- 
- -- | Import an integer from a memory (big-endian)
- gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
--#if MIN_VERSION_integer_gmp(1,0,0)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpImportInteger _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(1,0,0)
- gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
-     importIntegerFromAddr addr (int2Word# n) 1#
- #elif MIN_VERSION_integer_gmp(0,5,1)
-@@ -178,7 +196,9 @@ gmpImportInteger _ _ = GmpUnsupported
- 
- -- | Import an integer from a memory (little-endian)
- gmpImportIntegerLE :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
--#if MIN_VERSION_integer_gmp(1,0,0)
-+#if MIN_VERSION_integer_gmp(1,1,0)
-+gmpImportIntegerLE _ _ = GmpUnsupported
-+#elif MIN_VERSION_integer_gmp(1,0,0)
- gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $
-     importIntegerFromAddr addr (int2Word# n) 0#
- #elif MIN_VERSION_integer_gmp(0,5,1)
diff --git a/patches/data-dword-0.3.2.patch b/patches/data-dword-0.3.2.patch
index 970d74340b4bcbb103cf58dde71fc8f0831179f5..e3e00f3823a91fb1c49f217b1aad2ffb858b5fba 100644
--- a/patches/data-dword-0.3.2.patch
+++ b/patches/data-dword-0.3.2.patch
@@ -1,5 +1,5 @@
 diff --git a/src/Data/DoubleWord/TH.hs b/src/Data/DoubleWord/TH.hs
-index 78bbfa9..99beec4 100644
+index 78bbfa9..24f93e1 100644
 --- a/src/Data/DoubleWord/TH.hs
 +++ b/src/Data/DoubleWord/TH.hs
 @@ -157,7 +157,7 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $
@@ -176,14 +176,13 @@ index 78bbfa9..99beec4 100644
                                     (NormalB e) []]
      match' p e ds = Match p (NormalB e) ds
      match p e     = match' p e []
-@@ -1565,3 +1565,10 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $
+@@ -1565,3 +1565,9 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $
        | ConT ut == t = Just ts
        | otherwise    = smallerStdTypes' t ts
  
 +conPCompat :: Name -> [Pat] -> Pat
 +conPCompat n pats = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                         []
 +#endif
 +                         pats
diff --git a/patches/deriving-compat-0.5.10.patch b/patches/deriving-compat-0.5.10.patch
index 47e304caa9c5873c2ef07157a28a2b189ad6a1fb..553c576179f37a15d46a280935db30b5bd3846d0 100644
--- a/patches/deriving-compat-0.5.10.patch
+++ b/patches/deriving-compat-0.5.10.patch
@@ -1,5 +1,91 @@
+diff --git a/src/Data/Deriving/Internal.hs b/src/Data/Deriving/Internal.hs
+index 3c1e37b..2a89bbc 100644
+--- a/src/Data/Deriving/Internal.hs
++++ b/src/Data/Deriving/Internal.hs
+@@ -2146,16 +2146,36 @@ eqWord16HashValName :: Name
+ eqWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "eqWord16#"
+ 
+ extendInt8HashValName :: Name
+-extendInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendInt8#"
++extendInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim"
++# if MIN_VERSION_base(4,16,0)
++                                                        "int8ToInt#"
++# else
++                                                        "extendInt8#"
++# endif
+ 
+ extendInt16HashValName :: Name
+-extendInt16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendInt16#"
++extendInt16HashValName = mkNameG_v "ghc-prim" "GHC.Prim"
++# if MIN_VERSION_base(4,16,0)
++                                                         "int16ToInt#"
++# else
++                                                         "extendInt16#"
++# endif
+ 
+ extendWord8HashValName :: Name
+-extendWord8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendWord8#"
++extendWord8HashValName = mkNameG_v "ghc-prim" "GHC.Prim"
++# if MIN_VERSION_base(4,16,0)
++                                                         "word8ToWord#"
++# else
++                                                         "extendWord8#"
++# endif
+ 
+ extendWord16HashValName :: Name
+-extendWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendWord16#"
++extendWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim"
++# if MIN_VERSION_base(4,16,0)
++                                                          "word16ToWord#"
++# else
++                                                          "extendWord16#"
++# endif
+ 
+ geInt8HashValName :: Name
+ geInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "geInt8#"
+diff --git a/src/Data/Deriving/Via/Internal.hs b/src/Data/Deriving/Via/Internal.hs
+index 49aec0c..259407a 100644
+--- a/src/Data/Deriving/Via/Internal.hs
++++ b/src/Data/Deriving/Via/Internal.hs
+@@ -46,12 +46,11 @@ $('deriveGND' [t| forall a. 'Eq' a => 'Eq' (Foo a) |])
+ deriveGND :: Q Type -> Q [Dec]
+ deriveGND qty = do
+   ty <- qty
+-  let (instanceTvbs, instanceCxt, instanceTy) = decomposeType ty
++  let (_instanceTvbs, instanceCxt, instanceTy) = decomposeType ty
+   instanceTy' <- (resolveTypeSynonyms <=< resolveInfixT) instanceTy
+   decs <- deriveViaDecs instanceTy' Nothing
+-  let instanceHeader = ForallT instanceTvbs instanceCxt instanceTy
+-  (:[]) `fmap` instanceD (return [])
+-                         (return instanceHeader)
++  (:[]) `fmap` instanceD (return instanceCxt)
++                         (return instanceTy)
+                          (map return decs)
+ 
+ {- | Generates an instance for a type class by emulating the behavior of the
+@@ -71,7 +70,7 @@ correctly across all the types being used (e.g., to make sure that the same
+ deriveVia :: Q Type -> Q [Dec]
+ deriveVia qty = do
+   ty <- qty
+-  let (instanceTvbs, instanceCxt, viaApp) = decomposeType ty
++  let (_instanceTvbs, instanceCxt, viaApp) = decomposeType ty
+   viaApp' <- (resolveTypeSynonyms <=< resolveInfixT) viaApp
+   (instanceTy, viaTy)
+     <- case unapplyTy viaApp' of
+@@ -84,9 +83,8 @@ deriveVia qty = do
+                 , "\t[t| forall a. C (T a) `Via` V a |]"
+                 ]
+   decs <- deriveViaDecs instanceTy (Just viaTy)
+-  let instanceHeader = ForallT instanceTvbs instanceCxt instanceTy
+-  (:[]) `fmap` instanceD (return [])
+-                         (return instanceHeader)
++  (:[]) `fmap` instanceD (return instanceCxt)
++                         (return instanceTy)
+                          (map return decs)
+ 
+ deriveViaDecs :: Type       -- ^ The instance head (e.g., @Eq (Foo a)@)
 diff --git a/src/Data/Functor/Deriving/Internal.hs b/src/Data/Functor/Deriving/Internal.hs
-index 57d8f9c..8adb4c5 100644
+index 57d8f9c..e79ba2d 100644
 --- a/src/Data/Functor/Deriving/Internal.hs
 +++ b/src/Data/Functor/Deriving/Internal.hs
 @@ -703,7 +703,7 @@ functorFunTrivial fmapE traverseE ff z = go ff
@@ -29,15 +115,88 @@ index 57d8f9c..8adb4c5 100644
        -- Make sure to zip BEFORE invoking catMaybes. We want the variable
        -- indicies in each expression to match up with the argument indices
        -- in conExpr (defined below).
-@@ -933,3 +933,11 @@ mkSimpleTupleCase matchForCon tupSort insides x = do
+@@ -933,3 +933,10 @@ mkSimpleTupleCase matchForCon tupSort insides x = do
  #endif
    m <- matchForCon tupDataName insides
    return $ CaseE x [m]
 +
 +conPCompat :: Name -> [Pat] -> Pat
 +conPCompat n pats = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                         []
 +#endif
 +                         pats
+diff --git a/src/Text/Show/Deriving/Internal.hs b/src/Text/Show/Deriving/Internal.hs
+index 75e10c2..4a2a092 100644
+--- a/src/Text/Show/Deriving/Internal.hs
++++ b/src/Text/Show/Deriving/Internal.hs
+@@ -694,22 +694,42 @@ primShowTbl = Map.fromList
+     , (int8HashTypeName,   PrimShow
+                              { primShowBoxer      = appE (conE iHashDataName) . appE (varE extendInt8HashValName)
+                              , primShowPostfixMod = oneHashE
+-                             , primShowConv       = mkNarrowE "narrowInt8#"
++                             , primShowConv       = mkNarrowE
++# if MIN_VERSION_base(4,16,0)
++                                                              "intToInt8#"
++# else
++                                                              "narrowInt8#"
++# endif
+                              })
+     , (int16HashTypeName,  PrimShow
+                              { primShowBoxer      = appE (conE iHashDataName) . appE (varE extendInt16HashValName)
+                              , primShowPostfixMod = oneHashE
+-                             , primShowConv       = mkNarrowE "narrowInt16#"
++                             , primShowConv       = mkNarrowE
++# if MIN_VERSION_base(4,16,0)
++                                                              "intToInt16#"
++# else
++                                                              "narrowInt16#"
++# endif
+                              })
+     , (word8HashTypeName,  PrimShow
+                              { primShowBoxer      = appE (conE wHashDataName) . appE (varE extendWord8HashValName)
+                              , primShowPostfixMod = twoHashE
+-                             , primShowConv       = mkNarrowE "narrowWord8#"
++                             , primShowConv       = mkNarrowE
++# if MIN_VERSION_base(4,16,0)
++                                                              "wordToWord8#"
++# else
++                                                              "narrowWord8#"
++# endif
+                              })
+     , (word16HashTypeName, PrimShow
+                              { primShowBoxer      = appE (conE wHashDataName) . appE (varE extendWord16HashValName)
+                              , primShowPostfixMod = twoHashE
+-                             , primShowConv       = mkNarrowE "narrowWord16#"
++                             , primShowConv       = mkNarrowE
++# if MIN_VERSION_base(4,16,0)
++                                                              "wordToWord16#"
++# else
++                                                              "narrowWord16#"
++# endif
+                              })
+ #endif
+     ]
+diff --git a/tests/GH27Spec.hs b/tests/GH27Spec.hs
+index 3e5d372..5eb152a 100644
+--- a/tests/GH27Spec.hs
++++ b/tests/GH27Spec.hs
+@@ -30,6 +30,10 @@ import Prelude.Compat
+ 
+ import Test.Hspec
+ 
++{-
++Unfortunately, this cannot be made to work on GHC 9.2.
++See https://github.com/haskell-compat/deriving-compat/issues/34.
++
+ #if MIN_VERSION_template_haskell(2,12,0)
+ import Data.Deriving.Via
+ import Data.Functor.Const
+@@ -37,6 +41,7 @@ import Data.Functor.Const
+ newtype Age = MkAge Int
+ $(deriveVia [t| forall a. Show Age `Via` Const Int a |])
+ #endif
++-}
+ 
+ main :: IO ()
+ main = hspec spec
diff --git a/patches/doctest-0.16.3.patch b/patches/doctest-0.16.3.patch
index 568a2739574cb4501531010a4ac15219fd386911..02cd32869bb890e69ae68a508067ad3f451facaf 100644
--- a/patches/doctest-0.16.3.patch
+++ b/patches/doctest-0.16.3.patch
@@ -13,7 +13,7 @@ index 1b55e76..c890767 100644
  
  executable doctest
 diff --git a/src/Extract.hs b/src/Extract.hs
-index 81ed5a9..1606e89 100644
+index 81ed5a9..4f4f6b6 100644
 --- a/src/Extract.hs
 +++ b/src/Extract.hs
 @@ -21,10 +21,20 @@ import           GHC hiding (flags, Module, Located)
@@ -117,6 +117,60 @@ index 81ed5a9..1606e89 100644
  #else
      loadModPlugins = return
  #endif
+@@ -219,13 +249,15 @@ docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs
+     -- traversing the whole source in a generic way, to ensure that we get
+     -- everything in source order.
+     header  = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]]
++    exports = [ (Nothing, L (locA loc) doc)
+ #if __GLASGOW_HASKELL__ < 710
+-    exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- concat (hsmodExports source)]
++              | L loc (IEDoc doc) <- concat (hsmodExports source)
+ #elif __GLASGOW_HASKELL__ < 805
+-    exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)]
++              | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)
+ #else
+-    exports = [(Nothing, L loc doc) | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)]
++              | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)
+ #endif
++              ]
+     decls   = extractDocStrings (hsmodDecls source)
+ 
+ type Selector a = a -> ([(Maybe String, LHsDocString)], Bool)
+@@ -279,15 +311,21 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
+       -- no location information attached.  The location information is
+       -- attached to HsDecl instead.
+ #if __GLASGOW_HASKELL__ < 805
+-      DocD x -> select (fromDocDecl loc x)
++      DocD x
+ #else
+-      DocD _ x -> select (fromDocDecl loc x)
++      DocD _ x
+ #endif
++               -> select (fromDocDecl (locA loc) x)
+ 
+       _ -> (extractDocStrings decl, True)
+ 
+-    fromLDocDecl :: Selector LDocDecl
+-    fromLDocDecl (L loc x) = select (fromDocDecl loc x)
++    fromLDocDecl :: Selector
++#if __GLASGOW_HASKELL__ >= 901
++                             (LDocDecl GhcPs)
++#else
++                             LDocDecl
++#endif
++    fromLDocDecl (L loc x) = select (fromDocDecl (locA loc) x)
+ 
+     fromLHsDocString :: Selector LHsDocString
+     fromLHsDocString x = select (Nothing, x)
+@@ -302,3 +340,8 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
+ unpackHDS :: HsDocString -> String
+ unpackHDS (HsDocString s) = unpackFS s
+ #endif
++
++#if __GLASGOW_HASKELL__ < 901
++locA :: SrcSpan -> SrcSpan
++locA = id
++#endif
 diff --git a/src/GhcUtil.hs b/src/GhcUtil.hs
 index 52e965e..f1eb842 100644
 --- a/src/GhcUtil.hs
diff --git a/patches/doctest-0.18.1.patch b/patches/doctest-0.18.1.patch
index 7bbb4074b84b4cf515a89c004b641994a93b9a56..0cb9341f86a27ddf17538b75c841bbe71f69b6d0 100644
--- a/patches/doctest-0.18.1.patch
+++ b/patches/doctest-0.18.1.patch
@@ -1,5 +1,5 @@
 diff --git a/src/Extract.hs b/src/Extract.hs
-index e419fdc..9785bef 100644
+index e419fdc..cdad6ae 100644
 --- a/src/Extract.hs
 +++ b/src/Extract.hs
 @@ -66,6 +66,12 @@ import           GHC.Runtime.Loader (initializePlugins)
@@ -54,6 +54,60 @@ index e419fdc..9785bef 100644
  #else
      loadModPlugins = return
  #endif
+@@ -238,13 +255,15 @@ docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs
+     -- traversing the whole source in a generic way, to ensure that we get
+     -- everything in source order.
+     header  = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]]
++    exports = [ (Nothing, L (locA loc) doc)
+ #if __GLASGOW_HASKELL__ < 710
+-    exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- concat (hsmodExports source)]
++              | L loc (IEDoc doc) <- concat (hsmodExports source)
+ #elif __GLASGOW_HASKELL__ < 805
+-    exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)]
++              | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)
+ #else
+-    exports = [(Nothing, L loc doc) | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)]
++              | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)
+ #endif
++              ]
+     decls   = extractDocStrings (hsmodDecls source)
+ 
+ type Selector a = a -> ([(Maybe String, LHsDocString)], Bool)
+@@ -298,15 +317,21 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
+       -- no location information attached.  The location information is
+       -- attached to HsDecl instead.
+ #if __GLASGOW_HASKELL__ < 805
+-      DocD x -> select (fromDocDecl loc x)
++      DocD x
+ #else
+-      DocD _ x -> select (fromDocDecl loc x)
++      DocD _ x
+ #endif
++               -> select (fromDocDecl (locA loc) x)
+ 
+       _ -> (extractDocStrings decl, True)
+ 
+-    fromLDocDecl :: Selector LDocDecl
+-    fromLDocDecl (L loc x) = select (fromDocDecl loc x)
++    fromLDocDecl :: Selector
++#if __GLASGOW_HASKELL__ >= 901
++                             (LDocDecl GhcPs)
++#else
++                             LDocDecl
++#endif
++    fromLDocDecl (L loc x) = select (fromDocDecl (locA loc) x)
+ 
+     fromLHsDocString :: Selector LHsDocString
+     fromLHsDocString x = select (Nothing, x)
+@@ -321,3 +346,8 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
+ unpackHDS :: HsDocString -> String
+ unpackHDS (HsDocString s) = unpackFS s
+ #endif
++
++#if __GLASGOW_HASKELL__ < 901
++locA :: SrcSpan -> SrcSpan
++locA = id
++#endif
 diff --git a/src/GhcUtil.hs b/src/GhcUtil.hs
 index c928496..810d58a 100644
 --- a/src/GhcUtil.hs
diff --git a/patches/free-functors-1.2.1.patch b/patches/free-functors-1.2.1.patch
index a8ba393f4fc228fd67129860032fed1e7e9464b4..3949d26aecb7d40923563bb5d27b33378af5327d 100644
--- a/patches/free-functors-1.2.1.patch
+++ b/patches/free-functors-1.2.1.patch
@@ -1,15 +1,14 @@
 diff --git a/src/Data/Functor/Cofree/Internal.hs b/src/Data/Functor/Cofree/Internal.hs
-index 59cbd36..af7c7bc 100644
+index 59cbd36..6ece256 100644
 --- a/src/Data/Functor/Cofree/Internal.hs
 +++ b/src/Data/Functor/Cofree/Internal.hs
-@@ -40,7 +40,12 @@ cofreeDeriv cofree = idDeriv {
+@@ -40,7 +40,11 @@ cofreeDeriv cofree = idDeriv {
    cst = \e -> [| const $e $kExp |], -- Suppress "Defined but not used: ‘k’" warning
    res = \e -> [| $(pure (ConE cofree)) $kExp $e |],
    eff = \e -> [| $(pure (ConE cofree)) $kExp <$> $e |],
 -  inp = fmap (\vp -> ConP cofree [kPat, vp])
 +  inp = fmap (\vp -> ConP cofree
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                          []
 +#endif
 +                          [kPat, vp])
diff --git a/patches/haskell-src-meta-0.8.7.patch b/patches/haskell-src-meta-0.8.7.patch
index 9cb62a4c90bc2f8e4205dff76f40ccf4c66b9a38..5098191791d3b936ae33de38fa3cfeeadfc4b485 100644
--- a/patches/haskell-src-meta-0.8.7.patch
+++ b/patches/haskell-src-meta-0.8.7.patch
@@ -1,15 +1,14 @@
 diff --git a/src/Language/Haskell/Meta/Syntax/Translate.hs b/src/Language/Haskell/Meta/Syntax/Translate.hs
-index 6b795bf..4a3a571 100644
+index 6b795bf..6658fa8 100644
 --- a/src/Language/Haskell/Meta/Syntax/Translate.hs
 +++ b/src/Language/Haskell/Meta/Syntax/Translate.hs
-@@ -222,7 +222,12 @@ instance ToPat (Exts.Pat l) where
+@@ -222,7 +222,11 @@ instance ToPat (Exts.Pat l) where
      TH.DoublePrimL r'' -> TH.DoublePrimL (negate r'')
      _                  -> nonsense "toPat" "negating wrong kind of literal" l
    toPat (Exts.PInfixApp _ p n q) = TH.UInfixP (toPat p) (toName n) (toPat q)
 -  toPat (Exts.PApp _ n ps) = TH.ConP (toName n) (fmap toPat ps)
 +  toPat (Exts.PApp _ n ps) = TH.ConP (toName n)
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                                     []
 +#endif
 +                                     (fmap toPat ps)
@@ -17,17 +16,16 @@ index 6b795bf..4a3a571 100644
    toPat (Exts.PTuple _ Exts.Unboxed ps) = TH.UnboxedTupP (fmap toPat ps)
    toPat (Exts.PList _ ps) = TH.ListP (fmap toPat ps)
 diff --git a/src/Language/Haskell/Meta/Utils.hs b/src/Language/Haskell/Meta/Utils.hs
-index 6cdadcb..5378ff3 100644
+index 6cdadcb..baea476 100644
 --- a/src/Language/Haskell/Meta/Utils.hs
 +++ b/src/Language/Haskell/Meta/Utils.hs
-@@ -333,7 +333,12 @@ fromDataConI (DataConI dConN ty _tyConN) =
+@@ -333,7 +333,11 @@ fromDataConI (DataConI dConN ty _tyConN) =
    let n = arityT ty
    in replicateM n (newName "a")
        >>= \ns -> return (Just (LamE
 -                    [ConP dConN (fmap VarP ns)]
 +                    [ConP dConN
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                          []
 +#endif
 +                          (fmap VarP ns)]
diff --git a/patches/hxt-9.3.1.21.patch b/patches/hxt-9.3.1.21.patch
deleted file mode 100644
index ec5c6e3a38192bc106805d70864097ce58b05874..0000000000000000000000000000000000000000
--- a/patches/hxt-9.3.1.21.patch
+++ /dev/null
@@ -1,257 +0,0 @@
-diff --git a/src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs b/src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs
-index 9a81bbd..8095180 100644
---- a/src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs
-+++ b/src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs
-@@ -59,8 +59,8 @@ import           Text.XML.HXT.DOM.Interface
- -- state datatype consists of a system state and a user state
- -- the user state is not fixed
- 
--data XIOState us        = XIOState { xioSysState  :: ! XIOSysState
--                                   , xioUserState :: ! us
-+data XIOState us        = XIOState { xioSysState  :: !XIOSysState
-+                                   , xioUserState :: !us
-                                    }
- 
- instance (NFData us) => NFData (XIOState us) where
-@@ -152,42 +152,42 @@ withoutUserState      = withOtherUserState ()
- -- predefined system state data type with all components for the
- -- system functions, like trace, error handling, ...
- 
--data XIOSysState        = XIOSys  { xioSysWriter :: ! XIOSysWriter
--                                  , xioSysEnv    :: ! XIOSysEnv
-+data XIOSysState        = XIOSys  { xioSysWriter :: !XIOSysWriter
-+                                  , xioSysEnv    :: !XIOSysEnv
-                                   }
- 
- instance NFData XIOSysState where
-     rnf x = seq x ()    -- all fields of interest are strict
- 
--data XIOSysWriter       = XIOwrt  { xioErrorStatus     :: ! Int
--                                  , xioErrorMsgList    :: ! XmlTrees
-+data XIOSysWriter       = XIOwrt  { xioErrorStatus     :: !Int
-+                                  , xioErrorMsgList    :: !XmlTrees
-                                   , xioExpatErrors     ::   IOSArrow XmlTree XmlTree
--                                  , xioRelaxNoOfErrors :: ! Int
--                                  , xioRelaxDefineId   :: ! Int
-+                                  , xioRelaxNoOfErrors :: !Int
-+                                  , xioRelaxDefineId   :: !Int
-                                   , xioRelaxAttrList   ::   AssocList String XmlTrees
-                                   }
- 
--data XIOSysEnv          = XIOEnv  { xioTraceLevel      :: ! Int
-+data XIOSysEnv          = XIOEnv  { xioTraceLevel      :: !Int
-                                   , xioTraceCmd        ::   Int -> String -> IO ()
-                                   , xioErrorMsgHandler ::   String -> IO ()
--                                  , xioErrorMsgCollect :: ! Bool
--                                  , xioBaseURI         :: ! String
--                                  , xioDefaultBaseURI  :: ! String
--                                  , xioAttrList        :: ! Attributes
--                                  , xioInputConfig     :: ! XIOInputConfig
--                                  , xioParseConfig     :: ! XIOParseConfig
--                                  , xioOutputConfig    :: ! XIOOutputConfig
--                                  , xioRelaxConfig     :: ! XIORelaxConfig
--                                  , xioXmlSchemaConfig :: ! XIOXmlSchemaConfig
--                                  , xioCacheConfig     :: ! XIOCacheConfig
-+                                  , xioErrorMsgCollect :: !Bool
-+                                  , xioBaseURI         :: !String
-+                                  , xioDefaultBaseURI  :: !String
-+                                  , xioAttrList        :: !Attributes
-+                                  , xioInputConfig     :: !XIOInputConfig
-+                                  , xioParseConfig     :: !XIOParseConfig
-+                                  , xioOutputConfig    :: !XIOOutputConfig
-+                                  , xioRelaxConfig     :: !XIORelaxConfig
-+                                  , xioXmlSchemaConfig :: !XIOXmlSchemaConfig
-+                                  , xioCacheConfig     :: !XIOCacheConfig
-                                   }
- 
--data XIOInputConfig     = XIOIcgf { xioStrictInput    :: ! Bool
--                                  , xioEncodingErrors :: ! Bool
-+data XIOInputConfig     = XIOIcgf { xioStrictInput    :: !Bool
-+                                  , xioEncodingErrors :: !Bool
-                                   , xioInputEncoding  ::   String
-                                   , xioHttpHandler    ::   IOSArrow XmlTree XmlTree
--                                  , xioInputOptions   :: ! Attributes
--                                  , xioRedirect       :: ! Bool
-+                                  , xioInputOptions   :: !Attributes
-+                                  , xioRedirect       :: !Bool
-                                   , xioProxy          ::   String
-                                   }
- 
-@@ -196,59 +196,59 @@ data XIOParseConfig     = XIOPcfg { xioMimeTypes             ::   MimeTypeTable
-                                   , xioMimeTypeFile          ::   String
-                                   , xioAcceptedMimeTypes     ::   [String]
-                                   , xioFileMimeType          ::   String
--                                  , xioWarnings              :: ! Bool
--                                  , xioRemoveWS              :: ! Bool
--                                  , xioParseByMimeType       :: ! Bool
--                                  , xioParseHTML             :: ! Bool
--                                  , xioLowerCaseNames        :: ! Bool
--                                  , xioPreserveComment       :: ! Bool
--                                  , xioValidate              :: ! Bool
--                                  , xioSubstDTDEntities      :: ! Bool
--                                  , xioSubstHTMLEntities     :: ! Bool
--                                  , xioCheckNamespaces       :: ! Bool
--                                  , xioCanonicalize          :: ! Bool
--                                  , xioIgnoreNoneXmlContents :: ! Bool
--                                  , xioTagSoup               :: ! Bool
-+                                  , xioWarnings              :: !Bool
-+                                  , xioRemoveWS              :: !Bool
-+                                  , xioParseByMimeType       :: !Bool
-+                                  , xioParseHTML             :: !Bool
-+                                  , xioLowerCaseNames        :: !Bool
-+                                  , xioPreserveComment       :: !Bool
-+                                  , xioValidate              :: !Bool
-+                                  , xioSubstDTDEntities      :: !Bool
-+                                  , xioSubstHTMLEntities     :: !Bool
-+                                  , xioCheckNamespaces       :: !Bool
-+                                  , xioCanonicalize          :: !Bool
-+                                  , xioIgnoreNoneXmlContents :: !Bool
-+                                  , xioTagSoup               :: !Bool
-                                   , xioTagSoupParser         ::   IOSArrow XmlTree XmlTree
--                                  , xioExpat                 :: ! Bool
-+                                  , xioExpat                 :: !Bool
-                                   , xioExpatParser           ::   IOSArrow XmlTree XmlTree
-                                   }
- 
--data XIOOutputConfig    = XIOOcfg { xioIndent         :: ! Bool
--                                  , xioOutputEncoding :: ! String
--                                  , xioOutputFmt      :: ! XIOXoutConfig
--                                  , xioXmlPi          :: ! Bool
--                                  , xioNoEmptyElemFor :: ! [String]
--                                  , xioAddDefaultDTD  :: ! Bool
--                                  , xioTextMode       :: ! Bool
--                                  , xioShowTree       :: ! Bool
--                                  , xioShowHaskell    :: ! Bool
-+data XIOOutputConfig    = XIOOcfg { xioIndent         :: !Bool
-+                                  , xioOutputEncoding :: !String
-+                                  , xioOutputFmt      :: !XIOXoutConfig
-+                                  , xioXmlPi          :: !Bool
-+                                  , xioNoEmptyElemFor :: ![String]
-+                                  , xioAddDefaultDTD  :: !Bool
-+                                  , xioTextMode       :: !Bool
-+                                  , xioShowTree       :: !Bool
-+                                  , xioShowHaskell    :: !Bool
-                                   }
- data XIOXoutConfig      = XMLoutput | XHTMLoutput | HTMLoutput | PLAINoutput
-                           deriving (Eq)
- 
--data XIORelaxConfig     = XIORxc  { xioRelaxValidate        :: ! Bool
-+data XIORelaxConfig     = XIORxc  { xioRelaxValidate        :: !Bool
-                                   , xioRelaxSchema          ::   String
--                                  , xioRelaxCheckRestr      :: ! Bool
--                                  , xioRelaxValidateExtRef  :: ! Bool
--                                  , xioRelaxValidateInclude :: ! Bool
--                                  , xioRelaxCollectErrors   :: ! Bool
-+                                  , xioRelaxCheckRestr      :: !Bool
-+                                  , xioRelaxValidateExtRef  :: !Bool
-+                                  , xioRelaxValidateInclude :: !Bool
-+                                  , xioRelaxCollectErrors   :: !Bool
-                                   , xioRelaxValidator       ::   IOSArrow XmlTree XmlTree
-                                   }
- 
--data XIOXmlSchemaConfig = XIOScc  { xioXmlSchemaValidate  :: ! Bool
-+data XIOXmlSchemaConfig = XIOScc  { xioXmlSchemaValidate  :: !Bool
-                                   , xioXmlSchemaSchema    ::   String
-                                   , xioXmlSchemaValidator ::   IOSArrow XmlTree XmlTree
-                                   }
- 
- data XIOCacheConfig     = XIOCch  { xioBinaryCompression   ::   CompressionFct
-                                   , xioBinaryDeCompression ::   DeCompressionFct
--                                  , xioWithCache           :: ! Bool
--                                  , xioCacheDir            :: ! String
--                                  , xioDocumentAge         :: ! Int
--                                  , xioCache404Err         :: ! Bool
-+                                  , xioWithCache           :: !Bool
-+                                  , xioCacheDir            :: !String
-+                                  , xioDocumentAge         :: !Int
-+                                  , xioCache404Err         :: !Bool
-                                   , xioCacheRead           ::   String -> IOSArrow XmlTree XmlTree
--                                  , xioStrictDeserialize   :: ! Bool
-+                                  , xioStrictDeserialize   :: !Bool
-                                   }
- 
- type MimeTypeHandlers   = M.Map String (IOSArrow XmlTree XmlTree)
-diff --git a/src/Text/XML/HXT/DOM/QualifiedName.hs b/src/Text/XML/HXT/DOM/QualifiedName.hs
-index 18ef9e6..7cf2b6b 100644
---- a/src/Text/XML/HXT/DOM/QualifiedName.hs
-+++ b/src/Text/XML/HXT/DOM/QualifiedName.hs
-@@ -110,7 +110,7 @@ import           Data.Char.Properties.XMLCharProps (isXmlNCNameChar,
- -- Names are always reduced to normal form, and they are stored internally in a name cache
- -- for sharing equal names by the same data structure
- 
--data XName                      = XN { _idXN :: ! Int        -- for optimization of equality test, see Eq instance
-+data XName                      = XN { _idXN :: !Int        -- for optimization of equality test, see Eq instance
-                                      ,  unXN ::   String
-                                      }
-                                   deriving (Typeable)
-@@ -158,9 +158,9 @@ type NsEnv              = AssocList XName XName
- -- When dealing with namespaces, the document tree must be processed by 'Text.XML.HXT.Arrow.Namespace.propagateNamespaces'
- -- to split names of structure \"prefix:localPart\" and label the name with the apropriate namespace uri
- 
--data QName      = QN { localPart'    :: ! XName
--                     , namePrefix'   :: ! XName
--                     , namespaceUri' :: ! XName
-+data QName      = QN { localPart'    :: !XName
-+                     , namePrefix'   :: !XName
-+                     , namespaceUri' :: !XName
-                      }
-              deriving (Typeable)
- 
-@@ -507,9 +507,9 @@ toNsEnv                         = map (newXName *** newXName)
- 
- -- the name and string cache
- 
--data NameCache          = NC { _newXN   :: ! Int                                       -- next free name id
--                             , _xnCache :: ! (M.Map String XName)
--                             , _qnCache :: ! (M.Map (XName, XName, XName) QName)       -- we need another type than QName
-+data NameCache          = NC { _newXN   :: !Int                                       -- next free name id
-+                             , _xnCache :: !(M.Map String XName)
-+                             , _qnCache :: !(M.Map (XName, XName, XName) QName)       -- we need another type than QName
-                              }                                                          -- for the key because of the unusable
-                                                                                         -- Eq instance of QName
- type ChangeNameCache r  = NameCache -> (NameCache, r)
-@@ -530,13 +530,13 @@ nullXName
-  , xmlNamespaceXName
-  , xmlXName             :: XName
- 
--initialXNames@
-- [ nullXName
-- , xmlnsNamespaceXName
-- , xmlnsXName
-- , xmlNamespaceXName
-- , xmlXName
-- ]                      = zipWith XN [0..] $
-+initialXNames@[ nullXName
-+              , xmlnsNamespaceXName
-+              , xmlnsXName
-+              , xmlNamespaceXName
-+              , xmlXName
-+              ]
-+                        = zipWith XN [0..] $
-                           [ ""
-                           , xmlnsNamespace
-                           , a_xmlns
-@@ -548,8 +548,8 @@ initialQNames           :: [QName]
- 
- xmlnsQN                 :: QName
- 
--initialQNames@
-- [xmlnsQN]              = [QN xmlnsXName nullXName xmlnsNamespaceXName]
-+initialQNames@[xmlnsQN]
-+                        = [QN xmlnsXName nullXName xmlnsNamespaceXName]
- 
- initialCache            :: NameCache
- initialCache            = NC
-diff --git a/src/Text/XML/HXT/Parser/XmlCharParser.hs b/src/Text/XML/HXT/Parser/XmlCharParser.hs
-index 702f847..4bc13b1 100644
---- a/src/Text/XML/HXT/Parser/XmlCharParser.hs
-+++ b/src/Text/XML/HXT/Parser/XmlCharParser.hs
-@@ -49,7 +49,7 @@ type XParser s a        = GenParser Char (XPState s) a
- type SimpleXParser a    = XParser () a
- 
- data XPState s          = XPState
--    { xps_normalizeNewline :: ! Bool
-+    { xps_normalizeNewline :: !Bool
-     , xps_userState        :: s
-     }
- 
diff --git a/patches/inspection-testing-0.4.3.0.patch b/patches/inspection-testing-0.4.3.0.patch
index 25c2d6311d34a7ba72a8c6a0480dbe018cc1292a..fb3d21b3055e1eb618f86dd71dd551a9ddb49b6a 100644
--- a/patches/inspection-testing-0.4.3.0.patch
+++ b/patches/inspection-testing-0.4.3.0.patch
@@ -1,8 +1,19 @@
 diff --git a/src/Test/Inspection/Core.hs b/src/Test/Inspection/Core.hs
-index 7816010..265d3ba 100644
+index 7816010..45ec4b6 100644
 --- a/src/Test/Inspection/Core.hs
 +++ b/src/Test/Inspection/Core.hs
-@@ -83,7 +83,12 @@ slice binds v
+@@ -44,6 +44,10 @@ import DataCon
+ import TyCon (TyCon, isClassTyCon)
+ #endif
+ 
++#if MIN_VERSION_ghc(9,1,0)
++import GHC.Types.Tickish (CoreTickish, GenTickish(..))
++#endif
++
+ import qualified Data.Set as S
+ import Control.Monad.State.Strict
+ import Control.Monad.Trans.Maybe
+@@ -83,7 +87,12 @@ slice binds v
      go (Type _)                    = pure ()
      go (Coercion _)                = pure ()
  
@@ -16,7 +27,7 @@ index 7816010..265d3ba 100644
  
  -- | Pretty-print a slice
  pprSlice :: Slice -> SDoc
-@@ -211,7 +216,11 @@ eqSlice it slice1 slice2
+@@ -211,14 +220,22 @@ eqSlice it slice1 slice2
      go _ _ _ = guard False
  
      -----------
@@ -27,8 +38,21 @@ index 7816010..265d3ba 100644
 +#endif
        = guard (c1 == c2) >> go (rnBndrs2 env bs1 bs2) e1 e2
  
-     go_tick :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool
-@@ -250,7 +259,12 @@ allTyCons ignore slice =
+-    go_tick :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool
+-    go_tick env (Breakpoint lid lids) (Breakpoint rid rids)
++    go_tick :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool
++    go_tick env (Breakpoint{breakpointId = lid, breakpointFVs = lids})
++                (Breakpoint{breakpointId = rid, breakpointFVs = rids})
+           = lid == rid  &&  map (rnOccL env) lids == map (rnOccR env) rids
+     go_tick _ l r = l == r
+ 
++#if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
++type CoreTickish = Tickish Id
++#endif
+ 
+ 
+ -- | Returns @True@ if the given core expression mentions no type constructor
+@@ -250,7 +267,12 @@ allTyCons ignore slice =
  
      goB (b, e) = goV b ++ go e
  
@@ -42,7 +66,7 @@ index 7816010..265d3ba 100644
  
      goT (TyVarTy _)      = []
      goT (AppTy t1 t2)    = goT t1 ++ goT t2
-@@ -296,7 +310,12 @@ freeOfTerm slice needles = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]
+@@ -296,7 +318,12 @@ freeOfTerm slice needles = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]
  
      goB (_, e) = go e
  
@@ -56,7 +80,7 @@ index 7816010..265d3ba 100644
  
      goAltCon (DataAlt dc) | isNeedle (dataConName dc) = False
      goAltCon _ = True
-@@ -343,7 +362,12 @@ doesNotAllocate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go (idArity v
+@@ -343,7 +370,12 @@ doesNotAllocate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go (idArity v
          -- A let binding allocates if any variable is not a join point and not
          -- unlifted
  
diff --git a/patches/invariant-0.5.4.patch b/patches/invariant-0.5.4.patch
index e35aaeb24dda6b9ead7306fec4114193ca8a581a..ec4d7cd9fccfe680b39b90c94afa6d6c59a33485 100644
--- a/patches/invariant-0.5.4.patch
+++ b/patches/invariant-0.5.4.patch
@@ -28,17 +28,16 @@ index e68ec01..ce0ded0 100644
  instance Invariant (Arg a) where
    invmap = invmapFunctor
 diff --git a/src/Data/Functor/Invariant/TH.hs b/src/Data/Functor/Invariant/TH.hs
-index a94dd5d..a629b00 100644
+index a94dd5d..b50c748 100644
 --- a/src/Data/Functor/Invariant/TH.hs
 +++ b/src/Data/Functor/Invariant/TH.hs
-@@ -866,7 +866,12 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp)
+@@ -866,7 +866,11 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp)
                   -> Q Match
  mkSimpleConMatch fold conName insides = do
    varsNeeded <- newNameList "_arg" $ length insides
 -  let pat = ConP conName (map VarP varsNeeded)
 +  let pat = ConP conName
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                 []
 +#endif
 +                 (map VarP varsNeeded)
diff --git a/patches/kind-generics-th-0.2.2.1.patch b/patches/kind-generics-th-0.2.2.1.patch
deleted file mode 100644
index abe0ebf508ff8ad484f9c4350a1c4f30c1a53be4..0000000000000000000000000000000000000000
--- a/patches/kind-generics-th-0.2.2.1.patch
+++ /dev/null
@@ -1,31 +0,0 @@
-diff --git a/src/Generics/Kind/TH.hs b/src/Generics/Kind/TH.hs
-index 74c24b2..f3732b6 100644
---- a/src/Generics/Kind/TH.hs
-+++ b/src/Generics/Kind/TH.hs
-@@ -485,7 +485,12 @@ nTimes n f = f . nTimes (n-1) f
- newNameList :: String -> Int -> Q [Name]
- newNameList prefix n = traverse (newName . (prefix ++) . show) [1..n]
- 
--gatherExistentials :: [ConstructorInfo] -> [TyVarBndr]
-+gatherExistentials :: [ConstructorInfo]
-+#if MIN_VERSION_template_haskell(2,17,0)
-+                   -> [TyVarBndrUnit]
-+#else
-+                   -> [TyVarBndr]
-+#endif
- gatherExistentials = concatMap constructorVars
- 
- gatherConstraints :: [ConstructorInfo] -> [Pred]
-@@ -545,7 +550,11 @@ resolveConSynonyms con@(ConstructorInfo{ constructorVars    = vars
-   vars'    <- traverse (\tvb ->
-                          case tvb of
-                            PlainTV{} -> pure tvb
--                           KindedTV n k -> KindedTV n <$> resolveTypeSynonyms k) vars
-+                           KindedTV n
-+#if MIN_VERSION_template_haskell(2,17,0)
-+                                    _
-+#endif
-+                                    k -> kindedTV n <$> resolveTypeSynonyms k) vars
-   context' <- traverse resolveTypeSynonyms context
-   fields'  <- traverse resolveTypeSynonyms fields
-   pure $ con{ constructorVars = vars'
diff --git a/patches/lens-4.19.2.patch b/patches/lens-4.19.2.patch
index 5a484455f19a9a4bbfa1eabf93d5c2a02fafe3f1..898d619131b10b1fdbbf148543961e13112dddfb 100644
--- a/patches/lens-4.19.2.patch
+++ b/patches/lens-4.19.2.patch
@@ -427,7 +427,7 @@ index 2276d7e..7aadf53 100644
 +ixmapped i = setting $ ixmap i
  {-# INLINE ixmapped #-}
 diff --git a/src/Language/Haskell/TH/Lens.hs b/src/Language/Haskell/TH/Lens.hs
-index 652b880..50429ed 100644
+index 652b880..5bb6f45 100644
 --- a/src/Language/Haskell/TH/Lens.hs
 +++ b/src/Language/Haskell/TH/Lens.hs
 @@ -425,6 +425,7 @@ import Control.Lens.At
@@ -665,12 +665,11 @@ index 652b880..50429ed 100644
        remitter _ = Nothing
  
  _ImplicitParamVarE :: Prism' Exp String
-@@ -2550,8 +2581,14 @@ _ConP :: Prism' Pat (Name, [Pat])
+@@ -2550,8 +2581,13 @@ _ConP :: Prism' Pat (Name, [Pat])
  _ConP
    = prism' reviewer remitter
    where
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +      reviewer (x, y) = ConP x [] y
 +      remitter (ConP x _ y) = Just (x, y)
 +#else
@@ -680,7 +679,7 @@ index 652b880..50429ed 100644
        remitter _ = Nothing
  
  _InfixP :: Prism' Pat (Pat, Name, Pat)
-@@ -2642,7 +2679,7 @@ _ViewP
+@@ -2642,7 +2678,7 @@ _ViewP
        remitter (ViewP x y) = Just (x, y)
        remitter _ = Nothing
  
@@ -689,7 +688,7 @@ index 652b880..50429ed 100644
  _ForallT
    = prism' reviewer remitter
    where
-@@ -2847,7 +2884,7 @@ _ImplicitParamT
+@@ -2847,7 +2883,7 @@ _ImplicitParamT
  #endif
  
  #if MIN_VERSION_template_haskell(2,16,0)
@@ -698,7 +697,7 @@ index 652b880..50429ed 100644
  _ForallVisT
    = prism' reviewer remitter
    where
-@@ -2856,20 +2893,28 @@ _ForallVisT
+@@ -2856,20 +2892,28 @@ _ForallVisT
        remitter _ = Nothing
  #endif
  
@@ -733,7 +732,7 @@ index 652b880..50429ed 100644
        remitter _ = Nothing
  
  #if MIN_VERSION_template_haskell(2,11,0)
-@@ -2889,7 +2934,7 @@ _KindSig
+@@ -2889,7 +2933,7 @@ _KindSig
        remitter (KindSig x) = Just x
        remitter _ = Nothing
  
diff --git a/patches/lens-5.0.1.patch b/patches/lens-5.0.1.patch
index dd964e334fde6e831bfb5a9b1c928cd07f6df53c..769e0719d3a01c038f45dd12614d27c495794c39 100644
--- a/patches/lens-5.0.1.patch
+++ b/patches/lens-5.0.1.patch
@@ -17,15 +17,14 @@ index a8a76f0..55516c3 100644
  -- * contravariant
  
 diff --git a/src/Language/Haskell/TH/Lens.hs b/src/Language/Haskell/TH/Lens.hs
-index 6202d37..91fae75 100644
+index 6202d37..8b5d9a2 100644
 --- a/src/Language/Haskell/TH/Lens.hs
 +++ b/src/Language/Haskell/TH/Lens.hs
-@@ -2476,8 +2476,14 @@ _ConP :: Prism' Pat (Name, [Pat])
+@@ -2476,8 +2476,13 @@ _ConP :: Prism' Pat (Name, [Pat])
  _ConP
    = prism' reviewer remitter
    where
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +      reviewer (x, y) = ConP x [] y
 +      remitter (ConP x _ y) = Just (x, y)
 +#else
diff --git a/patches/lens-family-th-0.5.2.0.patch b/patches/lens-family-th-0.5.2.0.patch
index b600fdbd2d22ae791d457156366fcf54cb02630b..400c629fab0bd26513b7c634bc45b9412b306045 100644
--- a/patches/lens-family-th-0.5.2.0.patch
+++ b/patches/lens-family-th-0.5.2.0.patch
@@ -1,15 +1,14 @@
 diff --git a/src/Lens/Family/THCore.hs b/src/Lens/Family/THCore.hs
-index 9139718..90d14f8 100644
+index 9139718..272da90 100644
 --- a/src/Lens/Family/THCore.hs
 +++ b/src/Lens/Family/THCore.hs
-@@ -158,7 +158,12 @@ deriveTraversal nameTransform ty cs con = do
+@@ -158,7 +158,11 @@ deriveTraversal nameTransform ty cs con = do
  
  deconstructReconstruct :: Con -> String -> (Pat, Exp)
  deconstructReconstruct c nameBase = (pat, expr) where
 -  pat = ConP conN (map VarP argNames)
 +  pat = ConP conN
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +             []
 +#endif
 +             (map VarP argNames)
diff --git a/patches/pandoc-2.12.patch b/patches/pandoc-2.13.patch
similarity index 89%
rename from patches/pandoc-2.12.patch
rename to patches/pandoc-2.13.patch
index 77892da348dbdc1bf2d4846e23888d52f9eed144..faca437fb8159ba94a48188db4f68c6ed4f488a2 100644
--- a/patches/pandoc-2.12.patch
+++ b/patches/pandoc-2.13.patch
@@ -37,7 +37,7 @@ index 92bda36..496991f 100644
                                 camelCaseStrToHyphenated
                             } ''WrapOption)
 diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs
-index bcf26c4..ea5bd8b 100644
+index 7c6d017..ea62fea 100644
 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs
 +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs
 @@ -57,7 +57,7 @@ module Text.Pandoc.Readers.Docx.Combine ( smushInlines
@@ -62,6 +62,16 @@ index bcf26c4..ea5bd8b 100644
        x_rem_attr = filter isAttrModifier x_remaining
        y_rem_attr = filter isAttrModifier y_remaining
    in
+@@ -182,7 +182,7 @@ isAttrModifier _                  = False
+ 
+ smushInlines :: [Inlines] -> Inlines
+ smushInlines xs = combineInlines xs' mempty
+-  where xs' = foldl' combineInlines mempty xs
++  where xs' = L.foldl' combineInlines mempty xs
+ 
+ smushBlocks :: [Blocks] -> Blocks
+-smushBlocks xs = foldl' combineBlocks mempty xs
++smushBlocks xs = L.foldl' combineBlocks mempty xs
 diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs
 index df90880..e4cf1f8 100644
 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs
diff --git a/patches/parameterized-utils-2.1.2.0.patch b/patches/parameterized-utils-2.1.2.0.patch
index 78f464ca844fcbb264d5dde6e8e109f9141d5630..92043608ce41bffd751674df7bc684cd8112c42a 100644
--- a/patches/parameterized-utils-2.1.2.0.patch
+++ b/patches/parameterized-utils-2.1.2.0.patch
@@ -121,7 +121,7 @@ index bde0080..4e95448 100644
  -- | Recursor for natural numbeers.
  natRec :: forall p f
 diff --git a/src/Data/Parameterized/TH/GADT.hs b/src/Data/Parameterized/TH/GADT.hs
-index fc6563c..ef98c93 100644
+index fc6563c..73b4069 100644
 --- a/src/Data/Parameterized/TH/GADT.hs
 +++ b/src/Data/Parameterized/TH/GADT.hs
 @@ -8,6 +8,7 @@
@@ -150,15 +150,14 @@ index fc6563c..ef98c93 100644
    let go s e = [| $(s) . showChar ' ' . showsPrec 11 $(varE e) |]
    let ctor = [| showString $(return (LitE (StringL (nameBase nm)))) |]
    let rhs | null vars = ctor
-@@ -532,3 +533,11 @@ matchShowCtor p con = showCon p (constructorName con) (length (constructorFields
+@@ -532,3 +533,10 @@ matchShowCtor p con = showCon p (constructorName con) (length (constructorFields
  --
  -- The use of 'DataArg' says that the type parameter of the 'NatRepr' must
  -- be the same as the second type parameter of @T@.
 +
 +conPCompat :: Name -> [Pat] -> Pat
 +conPCompat n pats = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                           []
 +#endif
 +                           pats
diff --git a/patches/shakespeare-2.0.25.patch b/patches/shakespeare-2.0.25.patch
index 086b2125d96f3c76ac18b6b80e6efbd6647d31bf..f1f55362ee3305bc1980d447eb3f17c9a9e79fcc 100644
--- a/patches/shakespeare-2.0.25.patch
+++ b/patches/shakespeare-2.0.25.patch
@@ -1,15 +1,14 @@
 diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
-index e60fdfc..14ca5cb 100644
+index e60fdfc..63c5157 100644
 --- a/Text/Hamlet.hs
 +++ b/Text/Hamlet.hs
-@@ -139,7 +139,12 @@ bindingPattern (BindList is) = do
+@@ -139,7 +139,11 @@ bindingPattern (BindList is) = do
      return (ListP patterns, concat scopes)
  bindingPattern (BindConstr con is) = do
      (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
 -    return (ConP (mkConName con) patterns, concat scopes)
 +    return (ConP (mkConName con)
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                 []
 +#endif
 +                 patterns, concat scopes)
@@ -17,7 +16,7 @@ index e60fdfc..14ca5cb 100644
      let f (Ident field,b) =
             do (p,s) <- bindingPattern b
 diff --git a/Text/MkSizeType.hs b/Text/MkSizeType.hs
-index ee54e7a..3121e53 100644
+index ee54e7a..94e559c 100644
 --- a/Text/MkSizeType.hs
 +++ b/Text/MkSizeType.hs
 @@ -38,7 +38,7 @@ showInstanceDec name unit' = instanceD [] (instanceType "Show" name) [showDec]
@@ -49,20 +48,19 @@ index ee54e7a..3121e53 100644
          body = NormalB $ AppE (ConE name) (AppE (VarE fun) (VarE v))
          fun = mkName fun'
          v = mkName "v"
-@@ -92,3 +92,11 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness
+@@ -92,3 +92,10 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness
  
  instanceD :: Cxt -> Type -> [Dec] -> Dec
  instanceD = InstanceD Nothing
 +
 +conPCompat :: Name -> [Pat] -> Pat
 +conPCompat n pats = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                         []
 +#endif
 +                         pats
 diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs
-index 836bcb6..1e927c2 100644
+index 836bcb6..7d56294 100644
 --- a/Text/Shakespeare/I18N.hs
 +++ b/Text/Shakespeare/I18N.hs
 @@ -1,3 +1,4 @@
@@ -97,15 +95,14 @@ index 836bcb6..1e927c2 100644
          (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d)
          []
  
-@@ -405,3 +406,11 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness
+@@ -405,3 +406,10 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness
  
  instanceD :: Cxt -> Type -> [Dec] -> Dec
  instanceD = InstanceD Nothing
 +
 +conPCompat :: Name -> [Pat] -> Pat
 +conPCompat n pats = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                         []
 +#endif
 +                         pats
diff --git a/patches/text-show-3.9.patch b/patches/text-show-3.9.patch
new file mode 100644
index 0000000000000000000000000000000000000000..e37d83a1abfbb68c48faedc8f85fa37680028845
--- /dev/null
+++ b/patches/text-show-3.9.patch
@@ -0,0 +1,243 @@
+diff --git a/src/TextShow/TH/Internal.hs b/src/TextShow/TH/Internal.hs
+index c83c70e..c5c61d2 100644
+--- a/src/TextShow/TH/Internal.hs
++++ b/src/TextShow/TH/Internal.hs
+@@ -78,7 +78,11 @@ import           GHC.Exts ( Char(..), Double(..), Float(..), Int(..), Word(..)
+                           , Char#, Double#, Float#, Int#, Word#
+ #if MIN_VERSION_base(4,13,0)
+                           , Int8#, Int16#, Word8#, Word16#
++# if MIN_VERSION_base(4,16,0)
++                          , int8ToInt#, int16ToInt#, word8ToWord#, word16ToWord#
++# else
+                           , extendInt8#, extendInt16#, extendWord8#, extendWord16#
++# endif
+ #endif
+                           )
+ import           GHC.Show (appPrec, appPrec1)
+@@ -1258,24 +1262,68 @@ primShowTbl = Map.fromList
+                     })
+ #if MIN_VERSION_base(4,13,0)
+     , (''Int8#,   PrimShow
+-                    { primShowBoxer      = appE (conE 'I#) . appE (varE 'extendInt8#)
++                    { primShowBoxer      = appE (conE 'I#) . appE (varE
++# if MIN_VERSION_base(4,16,0)
++                                                                        'int8ToInt#
++# else
++                                                                        'extendInt8#
++# endif
++                                                                  )
+                     , primShowPostfixMod = oneHashE
+-                    , primShowConv       = mkNarrowE "narrowInt8#"
++                    , primShowConv       = mkNarrowE
++# if MIN_VERSION_base(4,16,0)
++                                                     "intToInt8#"
++# else
++                                                     "narrowInt8#"
++# endif
+                     })
+     , (''Int16#,  PrimShow
+-                    { primShowBoxer      = appE (conE 'I#) . appE (varE 'extendInt16#)
++                    { primShowBoxer      = appE (conE 'I#) . appE (varE
++# if MIN_VERSION_base(4,16,0)
++                                                                        'int16ToInt#
++# else
++                                                                        'extendInt16#
++# endif
++                                                                  )
+                     , primShowPostfixMod = oneHashE
+-                    , primShowConv       = mkNarrowE "narrowInt16#"
++                    , primShowConv       = mkNarrowE
++# if MIN_VERSION_base(4,16,0)
++                                                     "intToInt16#"
++# else
++                                                     "narrowInt16#"
++# endif
+                     })
+     , (''Word8#,  PrimShow
+-                    { primShowBoxer      = appE (conE 'W#) . appE (varE 'extendWord8#)
++                    { primShowBoxer      = appE (conE 'W#) . appE (varE
++# if MIN_VERSION_base(4,16,0)
++                                                                        'word8ToWord#
++# else
++                                                                        'extendWord8#
++# endif
++                                                                  )
+                     , primShowPostfixMod = twoHashE
+-                    , primShowConv       = mkNarrowE "narrowWord8#"
++                    , primShowConv       = mkNarrowE
++# if MIN_VERSION_base(4,16,0)
++                                                     "wordToWord8#"
++# else
++                                                     "narrowWord8#"
++# endif
+                     })
+     , (''Word16#, PrimShow
+-                    { primShowBoxer      = appE (conE 'W#) . appE (varE 'extendWord16#)
++                    { primShowBoxer      = appE (conE 'W#) . appE (varE
++# if MIN_VERSION_base(4,16,0)
++                                                                        'word16ToWord#
++# else
++                                                                        'extendWord16#
++# endif
++                                                                  )
+                     , primShowPostfixMod = twoHashE
+-                    , primShowConv       = mkNarrowE "narrowWord16#"
++                    , primShowConv       = mkNarrowE
++# if MIN_VERSION_base(4,16,0)
++                                                     "wordToWord16#"
++# else
++                                                     "narrowWord16#"
++# endif
+                     })
+ #endif
+     ]
+diff --git a/tests/Derived/MagicHash.hs b/tests/Derived/MagicHash.hs
+index 7421618..3b938f1 100644
+--- a/tests/Derived/MagicHash.hs
++++ b/tests/Derived/MagicHash.hs
+@@ -124,8 +124,8 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon'# a b) where
+       I# i2 <- arbitrary
+       W# w1 <- arbitrary
+       W# w2 <- arbitrary
+-      pure $ TyCon'# a b (narrowInt8# i1)  (narrowInt16# i2)
+-                         (narrowWord8# w1) (narrowWord16# w2)
++      pure $ TyCon'# a b (intToInt8Compat# i1)   (intToInt16Compat# i2)
++                         (wordToWord8Compat# w1) (wordToWord16Compat# w2)
+ 
+ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily'# a b) where
+     arbitrary = do
+@@ -135,8 +135,35 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily'# a b) where
+       I# i2 <- arbitrary
+       W# w1 <- arbitrary
+       W# w2 <- arbitrary
+-      pure $ TyFamily'# a b (narrowInt8# i1)  (narrowInt16# i2)
+-                            (narrowWord8# w1) (narrowWord16# w2)
++      pure $ TyFamily'# a b (intToInt8Compat# i1)   (intToInt16Compat# i2)
++                            (wordToWord8Compat# w1) (wordToWord16Compat# w2)
++
++
++# if MIN_VERSION_base(4,16,0)
++intToInt8Compat# :: Int# -> Int8#
++intToInt8Compat# = intToInt8#
++
++intToInt16Compat# :: Int# -> Int16#
++intToInt16Compat# = intToInt16#
++
++wordToWord8Compat# :: Word# -> Word8#
++wordToWord8Compat# = wordToWord8#
++
++wordToWord16Compat# :: Word# -> Word16#
++wordToWord16Compat# = wordToWord16#
++# else
++intToInt8Compat# :: Int# -> Int8#
++intToInt8Compat# = narrowInt8#
++
++intToInt16Compat# :: Int# -> Int16#
++intToInt16Compat# = narrowInt16#
++
++wordToWord8Compat# :: Word# -> Word8#
++wordToWord8Compat# = narrowWord8#
++
++wordToWord16Compat# :: Word# -> Word16#
++wordToWord16Compat# = narrowWord16#
++# endif
+ #endif
+ 
+ -------------------------------------------------------------------------------
+diff --git a/tests/Derived/TypeSynonyms.hs b/tests/Derived/TypeSynonyms.hs
+index 3882bd9..12deec2 100644
+--- a/tests/Derived/TypeSynonyms.hs
++++ b/tests/Derived/TypeSynonyms.hs
+@@ -78,10 +78,12 @@ newtype instance TyFamily a b = TyFamily
+ -------------------------------------------------------------------------------
+ 
+ -- TODO: Replace these with non-orphan instances
++#if !(MIN_VERSION_base(4,16,0))
+ $(deriveShow1 ''(,,,))
+ #if defined(NEW_FUNCTOR_CLASSES)
+ $(deriveShow2 ''(,,,))
+ #endif
++#endif
+ 
+ $(deriveShow1 ''TyCon)
+ #if defined(NEW_FUNCTOR_CLASSES)
+diff --git a/tests/Instances/Data/Tuple.hs b/tests/Instances/Data/Tuple.hs
+index e96b6ad..019bb83 100644
+--- a/tests/Instances/Data/Tuple.hs
++++ b/tests/Instances/Data/Tuple.hs
+@@ -1,3 +1,4 @@
++{-# LANGUAGE CPP                #-}
+ {-# LANGUAGE DeriveGeneric      #-}
+ {-# LANGUAGE StandaloneDeriving #-}
+ {-# OPTIONS_GHC -fno-warn-orphans #-}
+@@ -99,8 +100,10 @@ instance ( Arbitrary a
+          ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
+     arbitrary = genericArbitrary
+ 
++#if !(MIN_VERSION_base(4,16,0))
+ deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k)
+ deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l)
+ deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m)
+ deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
+ deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
++#endif
+diff --git a/tests/Instances/Data/Typeable.hs b/tests/Instances/Data/Typeable.hs
+index 2812c05..890c2fd 100644
+--- a/tests/Instances/Data/Typeable.hs
++++ b/tests/Instances/Data/Typeable.hs
+@@ -37,7 +37,11 @@ import Data.Typeable.Internal (TyCon(..))
+ #if MIN_VERSION_base(4,10,0)
+ import GHC.Exts (Int(..), Ptr(..))
+ import GHC.Types (KindRep(..), RuntimeRep(..), TypeLitSort(..),
+-                  VecCount(..), VecElem(..))
++                  VecCount(..), VecElem(..)
++# if MIN_VERSION_base(4,16,0)
++                 , Levity(..)
++# endif
++                 )
+ import Type.Reflection (SomeTypeRep(..), Typeable, TypeRep, typeRep)
+ #else
+ import Data.Typeable.Internal (TypeRep(..))
+@@ -80,8 +84,13 @@ instance Arbitrary RuntimeRep where
+     arbitrary = oneof [ VecRep <$> arbitrary <*> arbitrary
+                       , pure $ TupleRep []
+                       , pure $ SumRep []
++#if MIN_VERSION_base(4,16,0)
++                      , pure $ BoxedRep Lifted
++                      , pure $ BoxedRep Unlifted
++#else
+                       , pure LiftedRep
+                       , pure UnliftedRep
++#endif
+                       , pure IntRep
+                       , pure WordRep
+                       , pure Int64Rep
+diff --git a/text-show.cabal b/text-show.cabal
+index b328593..c69a876 100644
+--- a/text-show.cabal
++++ b/text-show.cabal
+@@ -1,5 +1,6 @@
+ name:                text-show
+ version:             3.9
++x-revision: 1
+ synopsis:            Efficient conversion of values into Text
+ description:         @text-show@ offers a replacement for the @Show@ typeclass intended
+                      for use with @Text@ instead of @String@s. This package was created
+@@ -157,7 +158,7 @@ library
+   build-depends:       array                 >= 0.3    && < 0.6
+                      , base-compat-batteries >= 0.11   && < 0.12
+                      , bifunctors            >= 5.1    && < 6
+-                     , bytestring            >= 0.9    && < 0.11
++                     , bytestring            >= 0.9    && < 0.12
+                      , bytestring-builder
+                      , containers            >= 0.1    && < 0.7
+                      , generic-deriving      >= 1.11   && < 2
+@@ -341,7 +342,7 @@ test-suite spec
+   build-depends:       array                 >= 0.3    && < 0.6
+                      , base-compat-batteries >= 0.11   && < 0.12
+                      , base-orphans          >= 0.8.2  && < 0.9
+-                     , bytestring            >= 0.9    && < 0.11
++                     , bytestring            >= 0.9    && < 0.12
+                      , bytestring-builder
+                      , deriving-compat       >= 0.5.6  && < 1
+                      , generic-deriving      >= 1.11   && < 2
diff --git a/patches/th-desugar-1.11.patch b/patches/th-desugar-1.11.patch
index e853dd3da62a0939e7d65f9f27b41021b1027692..3969210ea480b3284fad4e80364be468c771f27c 100644
--- a/patches/th-desugar-1.11.patch
+++ b/patches/th-desugar-1.11.patch
@@ -15,31 +15,29 @@ index 626a689..adc1bb4 100644
  instance Desugar [Dec] [DDec] where
    desugar = dsDecs
 diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
-index 21b1fbe..c48e50d 100644
+index 21b1fbe..a5f06ad 100644
 --- a/Language/Haskell/TH/Desugar/Core.hs
 +++ b/Language/Haskell/TH/Desugar/Core.hs
-@@ -85,8 +85,18 @@ dsExp (LamCaseE matches) = do
+@@ -85,8 +85,16 @@ dsExp (LamCaseE matches) = do
  dsExp (TupE exps) = dsTup tupleDataName exps
  dsExp (UnboxedTupE exps) = dsTup unboxedTupleDataName exps
  dsExp (CondE e1 e2 e3) =
 -  dsExp (CaseE e1 [ Match (ConP 'True [])  (NormalB e2) []
 -                  , Match (ConP 'False []) (NormalB e3) [] ])
 +  dsExp (CaseE e1 [ Match (ConP 'True
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                                 []
 +#endif
 +                                 [])  (NormalB e2) []
 +                  , Match (ConP 'False
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                                 []
 +#endif
 +                                 []) (NormalB e3) [] ])
  dsExp (MultiIfE guarded_exps) =
    let failure = DAppE (DVarE 'error) (DLitE (StringL "Non-exhaustive guards in multi-way if")) in
    dsGuards guarded_exps failure
-@@ -105,7 +115,11 @@ dsExp (CaseE exp matches) = do
+@@ -105,7 +113,11 @@ dsExp (CaseE exp matches) = do
    matches' <- dsMatches scrutinee matches
    return $ DLetE [DValD (DVarP scrutinee) exp'] $
             DCaseE (DVarE scrutinee) matches'
@@ -52,35 +50,33 @@ index 21b1fbe..c48e50d 100644
  dsExp (CompE stmts) = dsComp stmts
  dsExp (ArithSeqE (FromR exp)) = DAppE (DVarE 'enumFrom) <$> dsExp exp
  dsExp (ArithSeqE (FromThenR exp1 exp2)) =
-@@ -509,7 +523,12 @@ dsParComp (q : rest) = do
+@@ -509,7 +521,11 @@ dsParComp (q : rest) = do
    (rest_pat, rest_exp) <- dsParComp rest
    dsQ <- dsComp (q ++ [mk_tuple_stmt qv])
    let zipped = DAppE (DAppE (DVarE 'mzip) dsQ) rest_exp
 -  return (ConP (tupleDataName 2) [mk_tuple_pat qv, rest_pat], zipped)
 +  return (ConP (tupleDataName 2)
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +               []
 +#endif
 +               [mk_tuple_pat qv, rest_pat], zipped)
  
  -- helper function for dsParComp
  mk_tuple_stmt :: OSet Name -> Stmt
-@@ -553,7 +572,12 @@ dsPat (VarP n) = return $ DVarP n
+@@ -553,7 +569,11 @@ dsPat (VarP n) = return $ DVarP n
  dsPat (TupP pats) = DConP (tupleDataName (length pats)) <$> mapM dsPat pats
  dsPat (UnboxedTupP pats) = DConP (unboxedTupleDataName (length pats)) <$>
                             mapM dsPat pats
 -dsPat (ConP name pats) = DConP name <$> mapM dsPat pats
 +dsPat (ConP name
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +            _
 +#endif
 +            pats) = DConP name <$> mapM dsPat pats
  dsPat (InfixP p1 name p2) = DConP name <$> mapM dsPat [p1, p2]
  dsPat (UInfixP _ _ _) =
    fail "Cannot desugar unresolved infix operators."
-@@ -779,7 +803,7 @@ dsDec (KiSigD n ki) = (:[]) <$> (DKiSigD n <$> dsType ki)
+@@ -779,7 +799,7 @@ dsDec (KiSigD n ki) = (:[]) <$> (DKiSigD n <$> dsType ki)
  
  -- | Desugar a 'DataD' or 'NewtypeD'.
  dsDataDec :: DsMonad q
@@ -89,7 +85,7 @@ index 21b1fbe..c48e50d 100644
            -> Maybe Kind -> [Con] -> [DerivingClause] -> q [DDec]
  dsDataDec nd cxt n tvbs mk cons derivings = do
    tvbs' <- mapM dsTvb tvbs
-@@ -796,7 +820,7 @@ dsDataDec nd cxt n tvbs mk cons derivings = do
+@@ -796,7 +816,7 @@ dsDataDec nd cxt n tvbs mk cons derivings = do
  
  -- | Desugar a 'DataInstD' or a 'NewtypeInstD'.
  dsDataInstDec :: DsMonad q
@@ -98,7 +94,7 @@ index 21b1fbe..c48e50d 100644
                -> Maybe Kind -> [Con] -> [DerivingClause] -> q [DDec]
  dsDataInstDec nd cxt n mtvbs tys mk cons derivings = do
    mtvbs' <- mapM (mapM dsTvb) mtvbs
-@@ -1134,6 +1158,10 @@ dsClauses n clauses@(Clause outer_pats _ _ : _) = do
+@@ -1134,6 +1154,10 @@ dsClauses n clauses@(Clause outer_pats _ _ : _) = do
  
  -- | Desugar a type
  dsType :: DsMonad q => Type -> q DType
@@ -109,7 +105,7 @@ index 21b1fbe..c48e50d 100644
  dsType (ForallT tvbs preds ty) =
    mkDForallConstrainedT ForallInvis <$> mapM dsTvb tvbs <*> dsCxt preds <*> dsType ty
  dsType (AppT t1 t2) = DAppT <$> dsType t1 <*> dsType t2
-@@ -1178,9 +1206,8 @@ dsType (ForallVisT tvbs ty) = DForallT ForallVis <$> mapM dsTvb tvbs <*> dsType
+@@ -1178,9 +1202,8 @@ dsType (ForallVisT tvbs ty) = DForallT ForallVis <$> mapM dsTvb tvbs <*> dsType
  #endif
  
  -- | Desugar a @TyVarBndr@
@@ -121,7 +117,7 @@ index 21b1fbe..c48e50d 100644
  
  -- | Desugar a @Cxt@
  dsCxt :: DsMonad q => Cxt -> q DCxt
-@@ -1294,7 +1321,7 @@ dsPred t@(ForallVisT {}) =
+@@ -1294,7 +1317,7 @@ dsPred t@(ForallVisT {}) =
  #endif
  
  -- | Desugar a quantified constraint.
@@ -130,14 +126,13 @@ index 21b1fbe..c48e50d 100644
  dsForallPred tvbs cxt p = do
    ps' <- dsPred p
    case ps' of
-@@ -1375,7 +1402,12 @@ mkTupleDPat pats = DConP (tupleDataName (length pats)) pats
+@@ -1375,7 +1398,11 @@ mkTupleDPat pats = DConP (tupleDataName (length pats)) pats
  -- | Make a tuple 'Pat' from a list of 'Pat's. Avoids using a 1-tuple.
  mkTuplePat :: [Pat] -> Pat
  mkTuplePat [pat] = pat
 -mkTuplePat pats = ConP (tupleDataName (length pats)) pats
 +mkTuplePat pats = ConP (tupleDataName (length pats))
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                       []
 +#endif
 +                       pats
@@ -409,7 +404,7 @@ index 7b35177..989ce4e 100644
  default_res_ki :: Maybe Kind -> Kind
  default_res_ki = fromMaybe StarT
 diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs
-index 4a18d57..914dbe2 100644
+index 4a18d57..a1f6f7c 100644
 --- a/Language/Haskell/TH/Desugar/Sweeten.hs
 +++ b/Language/Haskell/TH/Desugar/Sweeten.hs
 @@ -28,7 +28,7 @@ module Language.Haskell.TH.Desugar.Sweeten (
@@ -421,21 +416,20 @@ index 4a18d57..914dbe2 100644
  #if __GLASGOW_HASKELL__ >= 801
    patSynDirToTH,
  #endif
-@@ -75,7 +75,12 @@ matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) []
+@@ -75,7 +75,11 @@ matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) []
  patToTH :: DPat -> Pat
  patToTH (DLitP lit)    = LitP lit
  patToTH (DVarP n)      = VarP n
 -patToTH (DConP n pats) = ConP n (map patToTH pats)
 +patToTH (DConP n pats) = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                              []
 +#endif
 +                              (map patToTH pats)
  patToTH (DTildeP pat)  = TildeP (patToTH pat)
  patToTH (DBangP pat)   = BangP (patToTH pat)
  patToTH (DSigP pat ty) = SigP (patToTH pat) (typeToTH ty)
-@@ -90,15 +95,15 @@ decToTH :: DDec -> [Dec]
+@@ -90,15 +94,15 @@ decToTH :: DDec -> [Dec]
  decToTH (DLetDec d) = maybeToList (letDecToTH d)
  decToTH (DDataD Data cxt n tvbs _mk cons derivings) =
  #if __GLASGOW_HASKELL__ > 710
@@ -454,7 +448,7 @@ index 4a18d57..914dbe2 100644
              (concatMap derivClauseToTH derivings)]
  #else
    [NewtypeD (cxtToTH cxt) n (map tvbToTH tvbs) (conToTH con)
-@@ -106,9 +111,9 @@ decToTH (DDataD Newtype cxt n tvbs _mk [con] derivings) =
+@@ -106,9 +110,9 @@ decToTH (DDataD Newtype cxt n tvbs _mk [con] derivings) =
  #endif
  decToTH (DDataD Newtype _cxt _n _tvbs _mk _cons _derivings) =
    error "Newtype declaration without exactly 1 constructor."
@@ -466,7 +460,7 @@ index 4a18d57..914dbe2 100644
  decToTH (DInstanceD over mtvbs _cxt _ty decs) =
    [instanceDToTH over cxt' ty' decs]
    where
-@@ -125,16 +130,16 @@ decToTH (DInstanceD over mtvbs _cxt _ty decs) =
+@@ -125,16 +129,16 @@ decToTH (DInstanceD over mtvbs _cxt _ty decs) =
  decToTH (DForeignD f) = [ForeignD (foreignToTH f)]
  #if __GLASGOW_HASKELL__ > 710
  decToTH (DOpenTypeFamilyD (DTypeFamilyHead n tvbs frs ann)) =
@@ -487,7 +481,7 @@ index 4a18d57..914dbe2 100644
  #endif
  decToTH (DDataInstD nd cxt mtvbs lhs mk cons derivings) =
    let ndc = case (nd, cons) of
-@@ -151,12 +156,12 @@ decToTH (DTySynInstD eqn) =
+@@ -151,12 +155,12 @@ decToTH (DTySynInstD eqn) =
  #endif
  #if __GLASGOW_HASKELL__ > 710
  decToTH (DClosedTypeFamilyD (DTypeFamilyHead n tvbs frs ann) eqns) =
@@ -502,7 +496,7 @@ index 4a18d57..914dbe2 100644
  #endif
  decToTH (DRoleAnnotD n roles) = [RoleAnnotD n roles]
  decToTH (DStandaloneDerivD mds mtvbs _cxt _ty) =
-@@ -210,11 +215,11 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings =
+@@ -210,11 +214,11 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings =
    case ndc of
      DNewtypeCon con ->
  #if __GLASGOW_HASKELL__ >= 807
@@ -516,7 +510,7 @@ index 4a18d57..914dbe2 100644
                      (concatMap derivClauseToTH derivings)]
  #else
        [NewtypeInstD (cxtToTH cxt) _n _lhs_args (conToTH con)
-@@ -223,11 +228,11 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings =
+@@ -223,11 +227,11 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings =
  
      DDataCons cons ->
  #if __GLASGOW_HASKELL__ >= 807
@@ -530,7 +524,7 @@ index 4a18d57..914dbe2 100644
                   (concatMap derivClauseToTH derivings)]
  #else
        [DataInstD (cxtToTH cxt) _n _lhs_args (map conToTH cons)
-@@ -244,7 +249,7 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings =
+@@ -244,7 +248,7 @@ dataInstDecToTH ndc cxt _mtvbs lhs _mk derivings =
  frsToTH :: DFamilyResultSig -> FamilyResultSig
  frsToTH DNoSig          = NoSig
  frsToTH (DKindSig k)    = KindSig (typeToTH k)
@@ -539,7 +533,7 @@ index 4a18d57..914dbe2 100644
  #else
  frsToTH :: DFamilyResultSig -> Maybe Kind
  frsToTH DNoSig                      = Nothing
-@@ -291,7 +296,7 @@ conToTH (DCon [] [] n (DRecC vstys) _) =
+@@ -291,7 +295,7 @@ conToTH (DCon [] [] n (DRecC vstys) _) =
  -- perfectly OK to put all of the quantified type variables
  -- (both universal and existential) in a ForallC.
  conToTH (DCon tvbs cxt n fields rty) =
@@ -548,7 +542,7 @@ index 4a18d57..914dbe2 100644
  #else
  -- On GHCs earlier than 8.0, we must be careful, since the only time ForallC is
  -- used is when there are either:
-@@ -370,7 +375,7 @@ pragmaToTH (DSpecialiseP n ty m_inl phases) =
+@@ -370,7 +374,7 @@ pragmaToTH (DSpecialiseP n ty m_inl phases) =
  pragmaToTH (DSpecialiseInstP ty) = Just $ SpecialiseInstP (typeToTH ty)
  #if __GLASGOW_HASKELL__ >= 807
  pragmaToTH (DRuleP str mtvbs rbs lhs rhs phases) =
@@ -557,7 +551,7 @@ index 4a18d57..914dbe2 100644
                 (expToTH lhs) (expToTH rhs) phases
  #else
  pragmaToTH (DRuleP str _ rbs lhs rhs phases) =
-@@ -399,7 +404,7 @@ tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
+@@ -399,7 +403,7 @@ tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
  tySynEqnToTH (DTySynEqn tvbs lhs rhs) =
    let lhs' = typeToTH lhs in
    case unfoldType lhs' of
@@ -566,7 +560,7 @@ index 4a18d57..914dbe2 100644
      (_, _) -> error $ "Illegal type instance LHS: " ++ pprint lhs'
  #else
  tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
-@@ -418,18 +423,17 @@ typeToTH :: DType -> Type
+@@ -418,18 +422,17 @@ typeToTH :: DType -> Type
  -- so that we may collapse them into a single ForallT when sweetening.
  -- See Note [Desugaring and sweetening ForallT] in L.H.T.Desugar.Core.
  typeToTH (DForallT ForallInvis tvbs (DConstrainedT ctxt ty)) =
@@ -588,7 +582,7 @@ index 4a18d57..914dbe2 100644
      ty'   = typeToTH ty
  typeToTH (DConstrainedT cxt ty) = ForallT [] (map predToTH cxt) (typeToTH ty)
  typeToTH (DAppT t1 t2)          = AppT (typeToTH t1) (typeToTH t2)
-@@ -451,9 +455,20 @@ typeToTH (DAppKindT t k)        = AppKindT (typeToTH t) (typeToTH k)
+@@ -451,9 +454,20 @@ typeToTH (DAppKindT t k)        = AppKindT (typeToTH t) (typeToTH k)
  typeToTH (DAppKindT t _)        = typeToTH t
  #endif
  
@@ -612,7 +606,7 @@ index 4a18d57..914dbe2 100644
  
  cxtToTH :: DCxt -> Cxt
  cxtToTH = map predToTH
-@@ -530,13 +545,13 @@ predToTH DWildCardT  = error "Wildcards supported only in GHC 8.0+"
+@@ -530,13 +544,13 @@ predToTH DWildCardT  = error "Wildcards supported only in GHC 8.0+"
  -- so that we may collapse them into a single ForallT when sweetening.
  -- See Note [Desugaring and sweetening ForallT] in L.H.T.Desugar.Core.
  predToTH (DForallT ForallInvis tvbs (DConstrainedT ctxt p)) =
@@ -629,7 +623,7 @@ index 4a18d57..914dbe2 100644
  predToTH (DConstrainedT cxt p) = ForallT [] (map predToTH cxt) (predToTH p)
  #else
 diff --git a/Language/Haskell/TH/Desugar/Util.hs b/Language/Haskell/TH/Desugar/Util.hs
-index dd2f621..87ce301 100644
+index dd2f621..d63ad9d 100644
 --- a/Language/Haskell/TH/Desugar/Util.hs
 +++ b/Language/Haskell/TH/Desugar/Util.hs
 @@ -36,6 +36,7 @@ module Language.Haskell.TH.Desugar.Util (
@@ -720,21 +714,20 @@ index dd2f621..87ce301 100644
  #endif
  unravelType t = (FANil, t)
  
-@@ -414,7 +413,12 @@ extractBoundNamesPat (LitP _)              = OS.empty
+@@ -414,7 +413,11 @@ extractBoundNamesPat (LitP _)              = OS.empty
  extractBoundNamesPat (VarP name)           = OS.singleton name
  extractBoundNamesPat (TupP pats)           = foldMap extractBoundNamesPat pats
  extractBoundNamesPat (UnboxedTupP pats)    = foldMap extractBoundNamesPat pats
 -extractBoundNamesPat (ConP _ pats)         = foldMap extractBoundNamesPat pats
 +extractBoundNamesPat (ConP _
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                           _
 +#endif
 +                             pats)         = foldMap extractBoundNamesPat pats
  extractBoundNamesPat (InfixP p1 _ p2)      = extractBoundNamesPat p1 `OS.union`
                                               extractBoundNamesPat p2
  extractBoundNamesPat (UInfixP p1 _ p2)     = extractBoundNamesPat p1 `OS.union`
-@@ -566,3 +570,31 @@ uniStarKindName = ''(Kind.★)
+@@ -566,3 +569,31 @@ uniStarKindName = ''(Kind.★)
  uniStarKindName = starKindName
  #endif
  #endif
diff --git a/patches/th-desugar-1.12.patch b/patches/th-desugar-1.12.patch
index e0a86dc79926b305e4a2143fb2514797119f9fa7..8da2efebc19da7643dac63572802d5ce03be5f12 100644
--- a/patches/th-desugar-1.12.patch
+++ b/patches/th-desugar-1.12.patch
@@ -1,36 +1,33 @@
 diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
-index 0a6fe1d..ea00a8b 100644
+index 0a6fe1d..ba9e12d 100644
 --- a/Language/Haskell/TH/Desugar/Core.hs
 +++ b/Language/Haskell/TH/Desugar/Core.hs
-@@ -89,8 +89,18 @@ dsExp (LamCaseE matches) = do
+@@ -89,8 +89,16 @@ dsExp (LamCaseE matches) = do
  dsExp (TupE exps) = dsTup tupleDataName exps
  dsExp (UnboxedTupE exps) = dsTup unboxedTupleDataName exps
  dsExp (CondE e1 e2 e3) =
 -  dsExp (CaseE e1 [ Match (ConP 'True [])  (NormalB e2) []
 -                  , Match (ConP 'False []) (NormalB e3) [] ])
 +  dsExp (CaseE e1 [ Match (ConP 'True
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                                 []
 +#endif
 +                                 [])  (NormalB e2) []
 +                  , Match (ConP 'False
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                                 []
 +#endif
 +                                 []) (NormalB e3) [] ])
  dsExp (MultiIfE guarded_exps) =
    let failure = DAppE (DVarE 'error) (DLitE (StringL "Non-exhaustive guards in multi-way if")) in
    dsGuards guarded_exps failure
-@@ -558,7 +568,12 @@ dsPat (VarP n) = return $ DVarP n
+@@ -558,7 +566,11 @@ dsPat (VarP n) = return $ DVarP n
  dsPat (TupP pats) = DConP (tupleDataName (length pats)) <$> mapM dsPat pats
  dsPat (UnboxedTupP pats) = DConP (unboxedTupleDataName (length pats)) <$>
                             mapM dsPat pats
 -dsPat (ConP name pats) = DConP name <$> mapM dsPat pats
 +dsPat (ConP name
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +            _
 +#endif
 +            pats) = DConP name <$> mapM dsPat pats
@@ -38,17 +35,16 @@ index 0a6fe1d..ea00a8b 100644
  dsPat (UInfixP _ _ _) =
    fail "Cannot desugar unresolved infix operators."
 diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs
-index 1512ddb..f7475c2 100644
+index 1512ddb..efa9ace 100644
 --- a/Language/Haskell/TH/Desugar/Sweeten.hs
 +++ b/Language/Haskell/TH/Desugar/Sweeten.hs
-@@ -74,7 +74,12 @@ matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) []
+@@ -74,7 +74,11 @@ matchToTH (DMatch pat exp) = Match (patToTH pat) (NormalB (expToTH exp)) []
  patToTH :: DPat -> Pat
  patToTH (DLitP lit)    = LitP lit
  patToTH (DVarP n)      = VarP n
 -patToTH (DConP n pats) = ConP n (map patToTH pats)
 +patToTH (DConP n pats) = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                              []
 +#endif
 +                              (map patToTH pats)
@@ -56,17 +52,16 @@ index 1512ddb..f7475c2 100644
  patToTH (DBangP pat)   = BangP (patToTH pat)
  patToTH (DSigP pat ty) = SigP (patToTH pat) (typeToTH ty)
 diff --git a/Language/Haskell/TH/Desugar/Util.hs b/Language/Haskell/TH/Desugar/Util.hs
-index 6ad206c..73da83a 100644
+index 6ad206c..f5227dd 100644
 --- a/Language/Haskell/TH/Desugar/Util.hs
 +++ b/Language/Haskell/TH/Desugar/Util.hs
-@@ -417,7 +417,12 @@ extractBoundNamesPat (LitP _)              = OS.empty
+@@ -417,7 +417,11 @@ extractBoundNamesPat (LitP _)              = OS.empty
  extractBoundNamesPat (VarP name)           = OS.singleton name
  extractBoundNamesPat (TupP pats)           = foldMap extractBoundNamesPat pats
  extractBoundNamesPat (UnboxedTupP pats)    = foldMap extractBoundNamesPat pats
 -extractBoundNamesPat (ConP _ pats)         = foldMap extractBoundNamesPat pats
 +extractBoundNamesPat (ConP _
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                           _
 +#endif
 +                             pats)         = foldMap extractBoundNamesPat pats
diff --git a/patches/true-name-0.1.0.3.patch b/patches/true-name-0.1.0.3.patch
index 5803a48c1b2d338077f2164a6a401931c0cd06a9..eb67b87318c4c656c5b48180daa5a9e4af9cb966 100644
--- a/patches/true-name-0.1.0.3.patch
+++ b/patches/true-name-0.1.0.3.patch
@@ -1,5 +1,5 @@
 diff --git a/Unsafe/TrueName.hs b/Unsafe/TrueName.hs
-index cab1bc1..a53edae 100644
+index cab1bc1..40423aa 100644
 --- a/Unsafe/TrueName.hs
 +++ b/Unsafe/TrueName.hs
 @@ -65,6 +65,11 @@ decNames dec = case dec of
@@ -47,14 +47,13 @@ index cab1bc1..a53edae 100644
  #endif
  
  predNames :: Pred -> [Name]{- {{{ -}
-@@ -321,7 +342,12 @@ truename = QuasiQuoter
+@@ -321,7 +342,11 @@ truename = QuasiQuoter
          _ -> err $ occString occ ++ " has a strange flavour"
      makeP (name, vars) = if vars == [".."]
              then RecP name . capture VarP <$> recFields name
 -            else return $ ConP name (map pat vars) where
 +            else return $ ConP name
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                               []
 +#endif
 +                               (map pat vars) where
diff --git a/patches/typenums-0.1.2.1.patch b/patches/typenums-0.1.2.1.patch
deleted file mode 100644
index 18fcce45958d22a73063bbaccb5d91568ea9c1e3..0000000000000000000000000000000000000000
--- a/patches/typenums-0.1.2.1.patch
+++ /dev/null
@@ -1,53 +0,0 @@
-diff --git a/src/Data/TypeNums/Ints.hs b/src/Data/TypeNums/Ints.hs
-index 300bd5b..b0f6cbc 100644
---- a/src/Data/TypeNums/Ints.hs
-+++ b/src/Data/TypeNums/Ints.hs
-@@ -53,14 +53,17 @@ data TInt
- class KnownInt (n :: k) where
-   intSing :: SInt n
- 
-+proxy'# :: () -> Proxy# (a :: k)
-+proxy'# _ = proxy#
-+
- instance forall n. KnownNat n => KnownInt n where
--  intSing = SInt $! natVal' (proxy# @Nat @n)
-+  intSing = SInt $! natVal' (proxy'# @Nat @n ())
- 
- instance forall n. KnownNat n => KnownInt ('Pos n) where
--  intSing = SInt $! natVal' (proxy# @Nat @n)
-+  intSing = SInt $! natVal' (proxy'# @Nat @n ())
- 
- instance forall n. KnownNat n => KnownInt ('Neg n) where
--  intSing = SInt $! negate (natVal' (proxy# @Nat @n))
-+  intSing = SInt $! negate (natVal' (proxy'# @Nat @n ()))
- 
- -- | Get the value associated with a type-level integer
- intVal ::
-diff --git a/src/Data/TypeNums/Rats.hs b/src/Data/TypeNums/Rats.hs
-index 74a7bb6..390bca5 100644
---- a/src/Data/TypeNums/Rats.hs
-+++ b/src/Data/TypeNums/Rats.hs
-@@ -58,16 +58,19 @@ newtype SRat r =
- class KnownRat r where
-   ratSing :: SRat r
- 
-+proxy'# :: () -> Proxy# (a :: k)
-+proxy'# _ = proxy#
-+
- instance {-# OVERLAPPING #-} (TypeError ('Text "Denominator must not equal 0")) =>
-                              KnownRat (n ':% 0) where
-   ratSing = error "Unreachable"
- 
--instance {-# OVERLAPS #-} forall (n :: k) d. (KnownInt n, KnownNat d, d /= 0) =>
-+instance {-# OVERLAPS #-} forall k (n :: k) d. (KnownInt n, KnownNat d, d /= 0) =>
-                           KnownRat (n ':% d) where
--  ratSing = SRat $! intVal' (proxy# @k @n) % natVal' (proxy# @Nat @d)
-+  ratSing = SRat $! intVal' (proxy'# @k @n ()) % natVal' (proxy'# @Nat @d ())
- 
--instance {-# OVERLAPPABLE #-} forall (n :: k). (KnownInt n) => KnownRat n where
--  ratSing = SRat $! intVal' (proxy# @k @n) % 1
-+instance {-# OVERLAPPABLE #-} forall k (n :: k). (KnownInt n) => KnownRat n where
-+  ratSing = SRat $! intVal' (proxy'# @k @n ()) % 1
- 
- -- | Get the value associated with a type-level rational
- ratVal ::
diff --git a/patches/vector-th-unbox-0.2.1.9.patch b/patches/vector-th-unbox-0.2.1.9.patch
index bee24190c728d8af01141b276a98e8ca7a66407e..5b7c006c6a3d575deb9ed610ef39d7056a564982 100644
--- a/patches/vector-th-unbox-0.2.1.9.patch
+++ b/patches/vector-th-unbox-0.2.1.9.patch
@@ -1,8 +1,8 @@
 diff --git a/Data/Vector/Unboxed/Deriving.hs b/Data/Vector/Unboxed/Deriving.hs
-index 3752249..f7e811c 100644
+index 3752249..50fcd49 100644
 --- a/Data/Vector/Unboxed/Deriving.hs
 +++ b/Data/Vector/Unboxed/Deriving.hs
-@@ -56,10 +56,17 @@ common name = do
+@@ -56,10 +56,16 @@ common name = do
      let vName = mkName ("V_" ++ name)
      i <- newPatExp "idx"
      n <- newPatExp "len"
@@ -15,11 +15,19 @@ index 3752249..f7e811c 100644
      return Common {..}
 +  where
 +    conPCompat n pats = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                             []
 +#endif
 +                             pats
  
  -- Turn any 'Name' into a capturable one.
  capture :: Name -> Name
+@@ -164,7 +170,7 @@ derivingUnbox name argsQ toRepQ fromRepQ = do
+         , newtypeVector, instanceVector ]
+ 
+ newtypeInstD' :: Name -> [Type] -> Con -> Dec
+-newtypeInstD' name args con = 
++newtypeInstD' name args con =
+ #if MIN_VERSION_template_haskell(2,15,0)
+     NewtypeInstD [] Nothing (foldl AppT (ConT name) args) Nothing con []
+ #elif MIN_VERSION_template_haskell(2,11,0)
diff --git a/patches/xml-hamlet-0.5.0.1.patch b/patches/xml-hamlet-0.5.0.1.patch
index c331d12c78d28c105042f97d9b89d3b55f1727f4..2d83a797f337755431879c890d48d091c6d23ffe 100644
--- a/patches/xml-hamlet-0.5.0.1.patch
+++ b/patches/xml-hamlet-0.5.0.1.patch
@@ -1,15 +1,14 @@
 diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs
-index e0dec6d..cb218dd 100644
+index e0dec6d..5dc0235 100644
 --- a/Text/Hamlet/XML.hs
 +++ b/Text/Hamlet/XML.hs
-@@ -77,7 +77,12 @@ bindingPattern (BindList is) = do
+@@ -77,7 +77,11 @@ bindingPattern (BindList is) = do
      return (ListP patterns, concat scopes)
  bindingPattern (BindConstr con is) = do
      (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
 -    return (ConP (mkConName con) patterns, concat scopes)
 +    return (ConP (mkConName con)
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                 []
 +#endif
 +                 patterns, concat scopes)
diff --git a/patches/yesod-core-1.6.18.8.patch b/patches/yesod-core-1.6.18.8.patch
index 7b5338f2a8beb22617fbe64f1801a4eea00b64da..254cdd21d710f9364399d84b21d872df17ad4ced 100644
--- a/patches/yesod-core-1.6.18.8.patch
+++ b/patches/yesod-core-1.6.18.8.patch
@@ -53,7 +53,7 @@ index f3505b9..7fe9159 100644
            ) appCxt'
      mname <- lookupTypeName namestr
 diff --git a/src/Yesod/Routes/TH/Dispatch.hs b/src/Yesod/Routes/TH/Dispatch.hs
-index c061a1c..d496dfd 100644
+index c061a1c..1d12c9d 100644
 --- a/src/Yesod/Routes/TH/Dispatch.hs
 +++ b/src/Yesod/Routes/TH/Dispatch.hs
 @@ -1,3 +1,4 @@
@@ -93,20 +93,19 @@ index c061a1c..d496dfd 100644
                                  return (pat, Just $ VarE multiName)
  
                      let dynsMulti =
-@@ -200,3 +201,11 @@ mkDispatchClause MkDispatchSettings {..} resources = do
+@@ -200,3 +201,10 @@ mkDispatchClause MkDispatchSettings {..} resources = do
  defaultGetHandler :: Maybe String -> String -> Q Exp
  defaultGetHandler Nothing s = return $ VarE $ mkName $ "handle" ++ s
  defaultGetHandler (Just method) s = return $ VarE $ mkName $ map toLower method ++ s
 +
 +conPCompat :: Name -> [Pat] -> Pat
 +conPCompat n pats = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                         []
 +#endif
 +                         pats
 diff --git a/src/Yesod/Routes/TH/RenderRoute.hs b/src/Yesod/Routes/TH/RenderRoute.hs
-index 09654c8..c7ed292 100644
+index 09654c8..6d9e4de 100644
 --- a/src/Yesod/Routes/TH/RenderRoute.hs
 +++ b/src/Yesod/Routes/TH/RenderRoute.hs
 @@ -67,7 +67,7 @@ mkRenderRouteClauses =
@@ -127,20 +126,19 @@ index 09654c8..c7ed292 100644
  
          pack' <- [|pack|]
          tsp <- [|toPathPiece|]
-@@ -182,3 +182,11 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness
+@@ -182,3 +182,10 @@ notStrict = Bang NoSourceUnpackedness NoSourceStrictness
  
  instanceD :: Cxt -> Type -> [Dec] -> Dec
  instanceD = InstanceD Nothing
 +
 +conPCompat :: Name -> [Pat] -> Pat
 +conPCompat n pats = ConP n
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                         []
 +#endif
 +                         pats
 diff --git a/src/Yesod/Routes/TH/RouteAttrs.hs b/src/Yesod/Routes/TH/RouteAttrs.hs
-index 0f1aeec..8d52ff5 100644
+index 0f1aeec..72b24b4 100644
 --- a/src/Yesod/Routes/TH/RouteAttrs.hs
 +++ b/src/Yesod/Routes/TH/RouteAttrs.hs
 @@ -1,3 +1,4 @@
@@ -148,14 +146,13 @@ index 0f1aeec..8d52ff5 100644
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE RecordWildCards #-}
  module Yesod.Routes.TH.RouteAttrs
-@@ -26,7 +27,12 @@ goTree front (ResourceParent name _check pieces trees) =
+@@ -26,7 +27,11 @@ goTree front (ResourceParent name _check pieces trees) =
      toIgnore = length $ filter isDynamic pieces
      isDynamic Dynamic{} = True
      isDynamic Static{} = False
 -    front' = front . ConP (mkName name) . ignored
 +    front' = front . ConP (mkName name)
-+-- TODO: Use MIN_VERSION_template_haskell(2,18,0) here (see https://gitlab.haskell.org/ghc/ghc/-/issues/19083)
-+#if __GLASGOW_HASKELL__ >= 901
++#if MIN_VERSION_template_haskell(2,18,0)
 +                          []
 +#endif
 +                   . ignored