diff --git a/patches/kind-generics-0.4.0.0.patch b/patches/kind-generics-0.4.0.0.patch
deleted file mode 100644
index 9ca4e168d62366b155102f2b2a2d4fb5701cbc83..0000000000000000000000000000000000000000
--- a/patches/kind-generics-0.4.0.0.patch
+++ /dev/null
@@ -1,13 +0,0 @@
-diff --git a/src/Generics/Kind.hs b/src/Generics/Kind.hs
-index ff27d38..352a600 100644
---- a/src/Generics/Kind.hs
-+++ b/src/Generics/Kind.hs
-@@ -75,7 +75,7 @@ deriving instance (Interpret c x => Show (f x)) => Show ((c :=>: f) x)
- -- > instance GenericK E LoT0 where
- -- >   type RepK E = Exists (*) (Field Var0)
- data Exists k (f :: LoT (k -> d) -> *) (x :: LoT d) where
--  Exists :: forall (t :: k) d (f :: LoT (k -> d) -> *) (x :: LoT d)
-+  Exists :: forall k (t :: k) d (f :: LoT (k -> d) -> *) (x :: LoT d)
-           .{ unExists :: f (t ':&&: x) } -> Exists k f x
- deriving instance (forall t. Show (f (t ':&&: x))) => Show (Exists k f x)
- 
diff --git a/patches/vinyl-0.12.1.patch b/patches/vinyl-0.12.1.patch
deleted file mode 100644
index b72ca2386aa2adda4ccf92193c9274a9fc3721a2..0000000000000000000000000000000000000000
--- a/patches/vinyl-0.12.1.patch
+++ /dev/null
@@ -1,120 +0,0 @@
-diff --git a/Data/Vinyl/Lens.hs b/Data/Vinyl/Lens.hs
-index 512d8d0..eb02d0c 100644
---- a/Data/Vinyl/Lens.hs
-+++ b/Data/Vinyl/Lens.hs
-@@ -1,3 +1,4 @@
-+{-# LANGUAGE CPP #-}
- {-# LANGUAGE TypeApplications #-}
- {-# LANGUAGE AllowAmbiguousTypes #-}
- {-# LANGUAGE UndecidableInstances #-}
-@@ -173,10 +174,16 @@ class is ~ RImage rs ss => RecSubset record rs ss is where
-   rreplaceC rs = getIdentity . rsubsetC (\_ -> Identity rs)
-   {-# INLINE rreplaceC #-}
- 
-+#if __GLASGOW_HASKELL__ >= 809
-+# define KVS(kvs) kvs
-+#else
-+# define KVS(kvs)
-+#endif
-+
- -- | A lens into a slice of the larger record. This is 'rsubsetC' with
- -- the type arguments reordered for more convenient usage with
- -- @TypeApplications@.
--rsubset :: forall rs ss f g record is.
-+rsubset :: forall KVS(k) rs ss f g record is.
-            (RecSubset record (rs :: [k]) (ss :: [k]) is,
-            Functor g, RecSubsetFCtx record f)
-         => (record f rs -> g (record f rs)) -> record f ss -> g (record f ss)
-diff --git a/Data/Vinyl/Recursive.hs b/Data/Vinyl/Recursive.hs
-index b813e47..f359ef1 100644
---- a/Data/Vinyl/Recursive.hs
-+++ b/Data/Vinyl/Recursive.hs
-@@ -1,3 +1,4 @@
-+{-# LANGUAGE CPP #-}
- {-# LANGUAGE TypeFamilies #-}
- {-# LANGUAGE ConstraintKinds #-}
- {-# LANGUAGE BangPatterns #-}
-@@ -137,9 +138,15 @@ reifyConstraint prx rec =
-     RNil -> RNil
-     (x :& xs) -> Compose (Dict x) :& reifyConstraint prx xs
- 
-+#if __GLASGOW_HASKELL__ >= 809
-+# define KVS(kvs) kvs
-+#else
-+# define KVS(kvs)
-+#endif
-+
- -- | Build a record whose elements are derived solely from a
- -- constraint satisfied by each.
--rpureConstrained :: forall c (f :: u -> *) proxy ts.
-+rpureConstrained :: forall KVS(u) c (f :: u -> *) proxy ts.
-                     (AllConstrained c ts, RecApplicative ts)
-                  => proxy c -> (forall a. c a => f a) -> Rec f ts
- rpureConstrained _ f = go (rpure Proxy)
-diff --git a/Data/Vinyl/SRec.hs b/Data/Vinyl/SRec.hs
-index 6f850c8..44b1f02 100644
---- a/Data/Vinyl/SRec.hs
-+++ b/Data/Vinyl/SRec.hs
-@@ -25,6 +25,7 @@
- -- Note that the lens field accessors for 'SRec' do not support
- -- changing the types of the fields as they do for 'Rec' and
- -- 'ARec'.
-+{-# LANGUAGE CPP #-}
- {-# LANGUAGE AllowAmbiguousTypes #-}
- {-# LANGUAGE BangPatterns #-}
- {-# LANGUAGE ConstraintKinds #-}
-@@ -74,7 +75,7 @@ import GHC.Base (realWorld#)
- import GHC.TypeLits (Symbol)
- 
- import GHC.Prim (MutableByteArray#, newAlignedPinnedByteArray#, byteArrayContents#)
--import GHC.Prim (unsafeCoerce#, touch#, RealWorld)
-+import GHC.Exts (unsafeCoerce#, touch#, RealWorld)
- import GHC.Ptr (Ptr(..))
- import GHC.Types (Int(..))
- 
-@@ -218,8 +219,14 @@ mallocAndCopy src n = do
-     withForeignPtr dst $ \dst' ->
-       dst <$ copyBytes dst' src' n
- 
-+#if __GLASGOW_HASKELL__ >= 809
-+# define KVS(kvs) kvs
-+#else
-+# define KVS(kvs)
-+#endif
-+
- -- | Set a field.
--sput :: forall (f :: u -> *) (t :: u) (ts :: [u]).
-+sput :: forall KVS(u) (f :: u -> *) (t :: u) (ts :: [u]).
-         ( FieldOffset f ts t
-         , Storable (Rec f ts)
-         , AllConstrained (FieldOffset f ts) ts)
-@@ -296,7 +303,7 @@ instance ( i ~ RIndex (t :: (Symbol,*)) (ts :: [(Symbol,*)])
-   {-# INLINE rputC #-}
- 
- -- | Get a subset of a record's fields.
--srecGetSubset :: forall (ss :: [u]) (rs :: [u]) (f :: u -> *).
-+srecGetSubset :: forall KVS(u) (ss :: [u]) (rs :: [u]) (f :: u -> *).
-                  (RPureConstrained (FieldOffset f ss) rs,
-                   RPureConstrained (FieldOffset f rs) rs,
-                   RFoldMap rs, RMap rs, RApply rs,
-@@ -334,7 +341,7 @@ newtype TaggedIO a = TaggedIO { unTagIO :: IO () }
- type Poker f = Lift (->) f TaggedIO
- 
- -- | Set a subset of a record's fields.
--srecSetSubset :: forall (f :: u -> *) (ss :: [u]) (rs :: [u]).
-+srecSetSubset :: forall KVS(u) (f :: u -> *) (ss :: [u]) (rs :: [u]).
-                  (rs ⊆ ss,
-                   RPureConstrained (FieldOffset f ss) rs,
-                   RPureConstrained (FieldOffset f rs) rs,
-diff --git a/Data/Vinyl/TypeLevel.hs b/Data/Vinyl/TypeLevel.hs
-index 710b46e..f8e11e9 100644
---- a/Data/Vinyl/TypeLevel.hs
-+++ b/Data/Vinyl/TypeLevel.hs
-@@ -11,6 +11,7 @@
- {-# LANGUAGE TypeFamilies          #-}
- {-# LANGUAGE TypeFamilyDependencies #-}
- {-# LANGUAGE TypeOperators         #-}
-+{-# LANGUAGE UndecidableInstances  #-}
- 
- module Data.Vinyl.TypeLevel where
- 
diff --git a/patches/vinyl-0.12.2.patch b/patches/vinyl-0.12.2.patch
new file mode 100644
index 0000000000000000000000000000000000000000..b710c44f8cbedba197bd8a813b1c77d44ae3fc64
--- /dev/null
+++ b/patches/vinyl-0.12.2.patch
@@ -0,0 +1,13 @@
+diff --git a/Data/Vinyl/SRec.hs b/Data/Vinyl/SRec.hs
+index 828d2eb..1d19f95 100644
+--- a/Data/Vinyl/SRec.hs
++++ b/Data/Vinyl/SRec.hs
+@@ -81,7 +81,7 @@ import GHC.Base (realWorld#)
+ import GHC.TypeLits (Symbol)
+ 
+ import GHC.Prim (MutableByteArray#, newAlignedPinnedByteArray#, byteArrayContents#)
+-import GHC.Prim (unsafeCoerce#, touch#, RealWorld)
++import GHC.Exts (unsafeCoerce#, touch#, RealWorld)
+ import GHC.Ptr (Ptr(..))
+ import GHC.Types (Int(..))
+