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(..)) +