diff --git a/patches/async-2.2.3.patch b/patches/async-2.2.3.patch deleted file mode 100644 index c6ad805b56afbebb93b3802473c40e4fa12f372f..0000000000000000000000000000000000000000 --- a/patches/async-2.2.3.patch +++ /dev/null @@ -1,28 +0,0 @@ -diff --git a/Control/Concurrent/Async.hs b/Control/Concurrent/Async.hs -index 064a262..16c772c 100644 ---- a/Control/Concurrent/Async.hs -+++ b/Control/Concurrent/Async.hs -@@ -959,9 +959,21 @@ tryAll = try - {-# INLINE rawForkIO #-} - rawForkIO :: IO () -> IO ThreadId - rawForkIO action = IO $ \ s -> -- case (fork# action s) of (# s1, tid #) -> (# s1, ThreadId tid #) -+ case (fork# -+#if __GLASGOW_HASKELL__ >= 903 -+ (unIO action) -+#else -+ action -+#endif -+ s) of (# s1, tid #) -> (# s1, ThreadId tid #) - - {-# INLINE rawForkOn #-} - rawForkOn :: Int -> IO () -> IO ThreadId - rawForkOn (I# cpu) action = IO $ \ s -> -- case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #) -+ case (forkOn# cpu -+#if __GLASGOW_HASKELL__ >= 903 -+ (unIO action) -+#else -+ action -+#endif -+ s) of (# s1, tid #) -> (# s1, ThreadId tid #) diff --git a/patches/barbies-th-0.1.8.patch b/patches/barbies-th-0.1.8.patch deleted file mode 100644 index 1cdf903c0d9505063594a556bc12f4ae67789c1a..0000000000000000000000000000000000000000 --- a/patches/barbies-th-0.1.8.patch +++ /dev/null @@ -1,32 +0,0 @@ -diff --git a/src/Barbies/TH.hs b/src/Barbies/TH.hs -index cc18a21..2f29aae 100644 ---- a/src/Barbies/TH.hs -+++ b/src/Barbies/TH.hs -@@ -1,3 +1,4 @@ -+{-# LANGUAGE CPP #-} - {-# LANGUAGE RankNTypes #-} - {-# LANGUAGE LambdaCase #-} - {-# LANGUAGE PolyKinds #-} -@@ -132,8 +133,13 @@ declareBareBWithOtherBarbies friends decsQ = do - -- Turn TyVarBndr into just a Name such that we can - -- reconstruct the constructor applied to already-present - -- type variables below. -+#if MIN_VERSION_template_haskell(2,17,0) -+ varName (PlainTV n _) = n -+ varName (KindedTV n _ _) = n -+#else - varName (PlainTV n) = n - varName (KindedTV n _) = n -+#endif - - -- The type name as present originally along with its type - -- variables. -@@ -212,7 +218,7 @@ declareBareBWithOtherBarbies friends decsQ = do - standaloneDerivWithStrategyD strat (pure []) [t|$(cls) ($(vanillaType) Bare Identity)|]) - [ (strat, pure t) | (_, DerivClause strat preds) <- classes', t <- preds ] - return $ DataD [] dataName -- (tvbs ++ [PlainTV nSwitch, PlainTV nWrap]) -+ (tvbs ++ [plainTV nSwitch, plainTV nWrap]) - Nothing - [transformed] - [DerivClause Nothing $ concatMap fst classes'] diff --git a/patches/blaze-builder-0.4.2.1.patch b/patches/blaze-builder-0.4.2.1.patch deleted file mode 100644 index 4874a483b265f4227694e5684519a59dbd2d8f83..0000000000000000000000000000000000000000 --- a/patches/blaze-builder-0.4.2.1.patch +++ /dev/null @@ -1,30 +0,0 @@ -diff --git a/Blaze/ByteString/Builder/HTTP.hs b/Blaze/ByteString/Builder/HTTP.hs -index 78b904a..9f62f99 100644 ---- a/Blaze/ByteString/Builder/HTTP.hs -+++ b/Blaze/ByteString/Builder/HTTP.hs -@@ -49,11 +49,24 @@ import Data.Monoid - shiftr_w32 :: Word32 -> Int -> Word32 - - #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) --shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i) -+shiftr_w32 (W32# w) (I# i) = W32# (wordToWord32Compat# (word32ToWordCompat# w `uncheckedShiftRL#` i)) - #else - shiftr_w32 = shiftR - #endif - -+#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 - - -- | Write a CRLF sequence. - writeCRLF :: Write diff --git a/patches/conduit-1.3.4.1.patch b/patches/conduit-1.3.4.1.patch deleted file mode 100644 index d305b516034bd9d8931a6c5f00d24d4484a40e8b..0000000000000000000000000000000000000000 --- a/patches/conduit-1.3.4.1.patch +++ /dev/null @@ -1,57 +0,0 @@ -diff --git a/src/Data/Conduit/Internal/Conduit.hs b/src/Data/Conduit/Internal/Conduit.hs -index ac8e3f3..78895e1 100644 ---- a/src/Data/Conduit/Internal/Conduit.hs -+++ b/src/Data/Conduit/Internal/Conduit.hs -@@ -328,8 +328,8 @@ connectResume (SealedConduitT left0) (ConduitT right0) = - recurse = goLeft rp rc - - sourceToPipe :: Monad m => Source m o -> Pipe l i o u m () --sourceToPipe = -- go . (`unConduitT` Done) -+sourceToPipe s = -+ go $ unConduitT s Done - where - go (HaveOutput p o) = HaveOutput (go p) o - go (NeedInput _ c) = go $ c () -@@ -338,8 +338,8 @@ sourceToPipe = - go (Leftover p ()) = go p - - sinkToPipe :: Monad m => Sink i m r -> Pipe l i o u m r --sinkToPipe = -- go . injectLeftovers . (`unConduitT` Done) -+sinkToPipe s = -+ go $ injectLeftovers $ unConduitT s Done - where - go (HaveOutput _ o) = absurd o - go (NeedInput p c) = NeedInput (go . p) (const $ go $ c ()) -@@ -348,8 +348,8 @@ sinkToPipe = - go (Leftover _ l) = absurd l - - conduitToPipe :: Monad m => Conduit i m o -> Pipe l i o u m () --conduitToPipe = -- go . injectLeftovers . (`unConduitT` Done) -+conduitToPipe s = -+ go $ injectLeftovers $ unConduitT s Done - where - go (HaveOutput p o) = HaveOutput (go p) o - go (NeedInput p c) = NeedInput (go . p) (const $ go $ c ()) -@@ -402,7 +402,7 @@ catchC :: (MonadUnliftIO m, Exception e) - catchC (ConduitT p0) onErr = ConduitT $ \rest -> let - go (Done r) = rest r - go (PipeM mp) = PipeM $ withRunInIO $ \run -> E.catch (run (liftM go mp)) -- (return . (`unConduitT`rest) . onErr) -+ (\s -> return $ unConduitT (onErr s) rest) - go (Leftover p i) = Leftover (go p) i - go (NeedInput x y) = NeedInput (go . x) (go . y) - go (HaveOutput p o) = HaveOutput (go p) o -@@ -693,8 +693,8 @@ passthroughSink (ConduitT sink0) final = ConduitT $ \rest -> let - -- - -- Since 1.2.6 - sourceToList :: Monad m => Source m a -> m [a] --sourceToList = -- go . (`unConduitT` Done) -+sourceToList s = -+ go $ unConduitT s Done - where - go (Done _) = return [] - go (HaveOutput src x) = liftM (x:) (go src) diff --git a/patches/mono-traversable-1.0.15.2.patch b/patches/mono-traversable-1.0.15.2.patch deleted file mode 100644 index 34bd7e1c75654e4b1b15170b80c15d2f5522f852..0000000000000000000000000000000000000000 --- a/patches/mono-traversable-1.0.15.2.patch +++ /dev/null @@ -1,76 +0,0 @@ -diff --git a/src/Data/MonoTraversable.hs b/src/Data/MonoTraversable.hs -index 2387a21..9499372 100644 ---- a/src/Data/MonoTraversable.hs -+++ b/src/Data/MonoTraversable.hs -@@ -94,7 +94,11 @@ import qualified Data.Vector as V - import qualified Data.Vector.Unboxed as U - import qualified Data.Vector.Storable as VS - import qualified Data.IntSet as IntSet --import Data.Semigroup (Semigroup, Option (..), Arg) -+import Data.Semigroup (Semigroup -+#if !(MIN_VERSION_base(4,16,0)) -+ , Option (..) -+#endif -+ , Arg) - import qualified Data.ByteString.Unsafe as SU - import Control.Monad.Trans.Identity (IdentityT) - -@@ -115,7 +119,9 @@ type instance Element (ViewL a) = a - type instance Element (ViewR a) = a - type instance Element (IntMap a) = a - type instance Element IntSet = Int -+#if !(MIN_VERSION_base(4,16,0)) - type instance Element (Option a) = a -+#endif - type instance Element (NonEmpty a) = a - type instance Element (Identity a) = a - type instance Element (r -> a) = a -@@ -188,7 +194,9 @@ instance MonoFunctor (Seq a) - instance MonoFunctor (ViewL a) - instance MonoFunctor (ViewR a) - instance MonoFunctor (IntMap a) -+#if !(MIN_VERSION_base(4,16,0)) - instance MonoFunctor (Option a) -+#endif - instance MonoFunctor (NonEmpty a) - instance MonoFunctor (Identity a) - instance MonoFunctor (r -> a) -@@ -366,7 +374,7 @@ class MonoFoldable mono where - -- /See 'Data.NonNull.ofoldMap1' from "Data.NonNull" for a total version of this function./ - ofoldMap1Ex :: Semigroup m => (Element mono -> m) -> mono -> m - ofoldMap1Ex f = fromMaybe (Prelude.error "Data.MonoTraversable.ofoldMap1Ex") -- . getOption . ofoldMap (Option . Just . f) -+ . ofoldMap (Just . f) - - -- | Right-associative fold of a monomorphic container with no base element. - -- -@@ -657,7 +665,9 @@ instance MonoFoldable (Seq a) where - instance MonoFoldable (ViewL a) - instance MonoFoldable (ViewR a) - instance MonoFoldable (IntMap a) -+#if !(MIN_VERSION_base(4,16,0)) - instance MonoFoldable (Option a) -+#endif - instance MonoFoldable (NonEmpty a) - instance MonoFoldable (Identity a) - instance MonoFoldable (Map k v) where -@@ -1066,7 +1076,9 @@ instance MonoTraversable (Seq a) - instance MonoTraversable (ViewL a) - instance MonoTraversable (ViewR a) - instance MonoTraversable (IntMap a) -+#if !(MIN_VERSION_base(4,16,0)) - instance MonoTraversable (Option a) -+#endif - instance MonoTraversable (NonEmpty a) - instance MonoTraversable (Identity a) - instance MonoTraversable (Map k v) -@@ -1209,7 +1221,9 @@ instance MonoPointed TL.Text where - -- Applicative - instance MonoPointed [a] - instance MonoPointed (Maybe a) -+#if !(MIN_VERSION_base(4,16,0)) - instance MonoPointed (Option a) -+#endif - instance MonoPointed (NonEmpty a) - instance MonoPointed (Identity a) - instance MonoPointed (Vector a) diff --git a/patches/primitive-sort-0.1.0.0.patch b/patches/primitive-sort-0.1.0.0.patch deleted file mode 100644 index f7e97cd37bb96c840c0f3a4465e1149228ccb2f8..0000000000000000000000000000000000000000 --- a/patches/primitive-sort-0.1.0.0.patch +++ /dev/null @@ -1,135 +0,0 @@ -diff --git a/primitive-sort.cabal b/primitive-sort.cabal -index 0aa87d5..1328a2d 100644 ---- a/primitive-sort.cabal -+++ b/primitive-sort.cabal -@@ -1,6 +1,7 @@ - cabal-version: 2.0 - name: primitive-sort - version: 0.1.0.0 -+x-revision: 4 - synopsis: Sort primitive arrays - description: - This library provides a stable sorting algorithm for primitive arrays. -@@ -27,7 +28,7 @@ library - base >= 0.4.9 && < 5 - , primitive >= 0.6.4.0 - , ghc-prim -- , contiguous >= 0.1 && < 0.2 -+ , contiguous >= 0.2 && < 0.6 - ghc-options: -O2 - default-language: Haskell2010 - -diff --git a/src/Data/Primitive/Sort.hs b/src/Data/Primitive/Sort.hs -index 83a141c..beb5af9 100644 ---- a/src/Data/Primitive/Sort.hs -+++ b/src/Data/Primitive/Sort.hs -@@ -29,7 +29,7 @@ import GHC.ST (ST(..)) - import GHC.IO (IO(..)) - import GHC.Int (Int(..)) - import Control.Monad --import GHC.Prim -+import GHC.Exts - import Control.Concurrent (getNumCapabilities) - import Data.Primitive.Contiguous (Contiguous,Mutable,Element) - import qualified Data.Primitive.Contiguous as C -@@ -116,7 +116,7 @@ sortMutable !dst = do - then insertionSortRange dst 0 len - else do - work <- C.new len -- C.copyMutable work 0 dst 0 len -+ C.copyMutable work 0 dst 0 len - caps <- unsafeEmbedIO getNumCapabilities - let minElemsPerThread = 20000 - maxThreads = unsafeQuot len minElemsPerThread -@@ -182,8 +182,8 @@ sortTaggedMutableN !len !dst !dstTags = if len < thresholdTagged - insertionSortTaggedRange dst dstTags 0 len - return (dst,dstTags) - else do -- work <- C.cloneMutable dst 0 len -- workTags <- C.cloneMutable dstTags 0 len -+ work <- C.cloneMutable dst 0 len -+ workTags <- C.cloneMutable dstTags 0 len - caps <- unsafeEmbedIO getNumCapabilities - let minElemsPerThread = 20000 - maxThreads = unsafeQuot len minElemsPerThread -@@ -210,7 +210,7 @@ sortUnique src = runST $ do - -- | Sort an immutable array. Only a single copy of each duplicated - -- element is preserved. This operation may run in-place, or it may - -- need to allocate a new array, so the argument may not be reused ---- after this function is applied to it. -+-- after this function is applied to it. - sortUniqueMutable :: (Contiguous arr, Element arr a, Ord a) - => Mutable arr s a - -> ST s (Mutable arr s a) -@@ -317,7 +317,7 @@ splitMergeParallel !arr !work !level !start !end = if level > 1 - else do - let !mid = unsafeQuot (end + start) 2 - !levelDown = half level -- tandem -+ tandem - (splitMergeParallel work arr levelDown start mid) - (splitMergeParallel work arr levelDown mid end) - mergeParallel work arr level start mid end -@@ -337,7 +337,7 @@ splitMergeParallelTagged !arr !work !arrTags !workTags !level !start !end = if l - then do - let !mid = unsafeQuot (end + start) 2 - !levelDown = half level -- tandem -+ tandem - (splitMergeParallelTagged work arr workTags arrTags levelDown start mid) - (splitMergeParallelTagged work arr workTags arrTags levelDown mid end) - mergeParallelTagged work arr workTags arrTags level start mid end -@@ -395,7 +395,7 @@ mergeParallel !src !dst !threads !start !mid !end = do - -> Int -- previous B end - -> Int -- how many chunk have we already iterated over - -> ST s Int -- go !prevEndA !prevEndB !ix = -+ go !prevEndA !prevEndB !ix = - if | prevEndA == mid && prevEndB == end -> return ix - | prevEndA == mid -> do - forkST_ $ do -@@ -440,7 +440,7 @@ mergeParallel !src !dst !threads !start !mid !end = do - mergeNonContiguous src dst startA endA startB endB startDst - putLock lock - go endA endB (ix + 1) -- !endElem <- C.read src (start + chunk) -+ !endElem <- C.read src (start + chunk) - !endA <- findIndexOfGtElem src (endElem :: a) start mid - !endB <- findIndexOfGtElem src endElem mid end - forkST_ $ do -@@ -474,7 +474,7 @@ mergeParallelTagged !src !dst !srcTags !dstTags !threads !start !mid !end = do - -> Int -- previous B end - -> Int -- how many chunk have we already iterated over - -> ST s Int -- go !prevEndA !prevEndB !ix = -+ go !prevEndA !prevEndB !ix = - if | prevEndA == mid && prevEndB == end -> return ix - | prevEndA == mid -> do - forkST_ $ do -@@ -519,7 +519,7 @@ mergeParallelTagged !src !dst !srcTags !dstTags !threads !start !mid !end = do - mergeNonContiguousTagged src dst srcTags dstTags startA endA startB endB startDst - putLock lock - go endA endB (ix + 1) -- !endElem <- C.read src (start + chunk) -+ !endElem <- C.read src (start + chunk) - !endA <- findIndexOfGtElem src (endElem :: k) start mid - !endB <- findIndexOfGtElem src endElem mid end - forkST_ $ do -@@ -685,7 +685,7 @@ insertionSortRange !arr !start !end = go start - insertElement arr (a :: a) start ix - go (ix + 1) - else return () -- -+ - insertElement :: forall arr s a. (Contiguous arr, Element arr a, Ord a) - => Mutable arr s a - -> a -@@ -725,7 +725,7 @@ insertionSortTaggedRange !karr !varr !start !end = go start - insertElementTagged karr varr a v start ix - go (ix + 1) - else return () -- -+ - insertElementTagged :: forall karr varr s k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v) - => Mutable karr s k - -> Mutable varr s v diff --git a/patches/random-1.2.0.patch b/patches/random-1.2.0.patch deleted file mode 100644 index 1f39b2934429eda63bb07c44689674210a38a585..0000000000000000000000000000000000000000 --- a/patches/random-1.2.0.patch +++ /dev/null @@ -1,34 +0,0 @@ -diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs -index a0b3afc..ad907d8 100644 ---- a/src/System/Random/Internal.hs -+++ b/src/System/Random/Internal.hs -@@ -745,13 +745,27 @@ instance UniformRange CDouble where - -- `Char`, therefore it is totally fine to omit all the unnecessary checks involved in - -- other paths of conversion. - word32ToChar :: Word32 -> Char --word32ToChar (W32# w#) = C# (chr# (word2Int# w#)) -+word32ToChar (W32# w#) = C# (chr# (word2Int# (word32ToWordCompat# w#))) - {-# INLINE word32ToChar #-} - - charToWord32 :: Char -> Word32 --charToWord32 (C# c#) = W32# (int2Word# (ord# c#)) -+charToWord32 (C# c#) = W32# (wordToWord32Compat# (int2Word# (ord# c#))) - {-# INLINE charToWord32 #-} - -+#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 -+ - instance Uniform Char where - uniformM g = word32ToChar <$> unbiasedWordMult32 (charToWord32 maxBound) g - {-# INLINE uniformM #-} diff --git a/patches/semigroupoids-5.3.5.patch b/patches/semigroupoids-5.3.5.patch deleted file mode 100644 index 558a90c4473c9f59d3d27633896c1e46f8741939..0000000000000000000000000000000000000000 --- a/patches/semigroupoids-5.3.5.patch +++ /dev/null @@ -1,114 +0,0 @@ -diff --git a/semigroupoids.cabal b/semigroupoids.cabal -index 7463780..ed28e9d 100644 ---- a/semigroupoids.cabal -+++ b/semigroupoids.cabal -@@ -1,6 +1,7 @@ - name: semigroupoids - category: Control, Comonads - version: 5.3.5 -+x-revision: 1 - license: BSD3 - cabal-version: >= 1.10 - license-file: LICENSE -@@ -131,7 +132,7 @@ library - bifunctors >= 5.5.9 && < 6, - template-haskell >= 0.2.5.0, - transformers >= 0.3 && < 0.6, -- transformers-compat >= 0.5 && < 0.7 -+ transformers-compat >= 0.5 && < 0.8 - - if impl(ghc >= 7.0 && < 7.2) - build-depends: generic-deriving >= 1.14 && < 1.15 -diff --git a/src/Data/Functor/Alt.hs b/src/Data/Functor/Alt.hs -index 72fefc5..e405a65 100644 ---- a/src/Data/Functor/Alt.hs -+++ b/src/Data/Functor/Alt.hs -@@ -53,7 +53,11 @@ import Data.Functor.Product - import Data.Functor.Reverse - import Data.List.NonEmpty (NonEmpty(..)) - import qualified Data.Monoid as Monoid --import Data.Semigroup (Option(..), Semigroup(..)) -+import Data.Semigroup ( -+#if !(MIN_VERSION_base(4,16,0)) -+ Option(..), -+#endif -+ Semigroup(..)) - import qualified Data.Semigroup as Semigroup - import Prelude (($),Either(..),Maybe(..),const,IO,Ord,(++),(.),either,seq,undefined) - import Unsafe.Coerce -@@ -187,8 +191,10 @@ instance Alt Maybe where - Nothing <!> b = b - a <!> _ = a - -+#if !(MIN_VERSION_base(4,16,0)) - instance Alt Option where - (<!>) = (<|>) -+#endif - - instance MonadPlus m => Alt (WrappedMonad m) where - (<!>) = (<|>) -diff --git a/src/Data/Functor/Bind/Class.hs b/src/Data/Functor/Bind/Class.hs -index e9a6ddc..b23ad2d 100644 ---- a/src/Data/Functor/Bind/Class.hs -+++ b/src/Data/Functor/Bind/Class.hs -@@ -272,10 +272,12 @@ instance Apply Maybe where - (<. ) = (<* ) - ( .>) = ( *>) - -+#if !(MIN_VERSION_base(4,16,0)) - instance Apply Option where - (<.>) = (<*>) - (<. ) = (<* ) - ( .>) = ( *>) -+#endif - - instance Apply Identity where - (<.>) = (<*>) -@@ -576,8 +578,10 @@ instance Bind IO where - instance Bind Maybe where - (>>-) = (>>=) - -+#if !(MIN_VERSION_base(4,16,0)) - instance Bind Option where - (>>-) = (>>=) -+#endif - - instance Bind Identity where - (>>-) = (>>=) -diff --git a/src/Data/Functor/Plus.hs b/src/Data/Functor/Plus.hs -index 8f541b1..ff22785 100644 ---- a/src/Data/Functor/Plus.hs -+++ b/src/Data/Functor/Plus.hs -@@ -106,8 +106,10 @@ instance Plus [] where - instance Plus Maybe where - zero = Nothing - -+#if !(MIN_VERSION_base(4,16,0)) - instance Plus Option where - zero = empty -+#endif - - instance MonadPlus m => Plus (WrappedMonad m) where - zero = empty -diff --git a/src/Data/Semigroup/Foldable/Class.hs b/src/Data/Semigroup/Foldable/Class.hs -index 9b54448..c7e75a4 100644 ---- a/src/Data/Semigroup/Foldable/Class.hs -+++ b/src/Data/Semigroup/Foldable/Class.hs -@@ -73,7 +73,7 @@ class Foldable t => Foldable1 t where - foldMap1 :: Semigroup m => (a -> m) -> t a -> m - toNonEmpty :: t a -> NonEmpty a - -- foldMap1 f = maybe (error "foldMap1") id . getOption . foldMap (Option . Just . f) -+ foldMap1 f = maybe (error "foldMap1") id . foldMap (Just . f) - fold1 = foldMap1 id - toNonEmpty = foldMap1 (:|[]) - -@@ -131,7 +131,7 @@ class Bifoldable t => Bifoldable1 t where - {-# INLINE bifold1 #-} - - bifoldMap1 :: Semigroup m => (a -> m) -> (b -> m) -> t a b -> m -- bifoldMap1 f g = maybe (error "bifoldMap1") id . getOption . bifoldMap (Option . Just . f) (Option . Just . g) -+ bifoldMap1 f g = maybe (error "bifoldMap1") id . bifoldMap (Just . f) (Just . g) - {-# INLINE bifoldMap1 #-} - - instance Bifoldable1 Arg where diff --git a/patches/text-short-0.1.3.patch b/patches/text-short-0.1.3.patch deleted file mode 100644 index 61453bb02570e7835c08e691c7a19e7f6a37d810..0000000000000000000000000000000000000000 --- a/patches/text-short-0.1.3.patch +++ /dev/null @@ -1,86 +0,0 @@ -diff --git a/src/Data/Text/Short/Internal.hs b/src/Data/Text/Short/Internal.hs -index 876985e..f3b1d92 100644 ---- a/src/Data/Text/Short/Internal.hs -+++ b/src/Data/Text/Short/Internal.hs -@@ -125,7 +125,7 @@ import Foreign.C - import GHC.Base (assert, unsafeChr) - import qualified GHC.CString as GHC - import GHC.Exts (Addr#, ByteArray#, Int (I#), -- Int#, MutableByteArray#, -+ Int#, MutableByteArray#, Word#, - Ptr (..), RealWorld, Word (W#)) - import qualified GHC.Exts - import qualified GHC.Foreign as GHC -@@ -143,6 +143,10 @@ import Text.Printf (PrintfArg, formatArg, - - import qualified PrimOps - -+#if MIN_VERSION_base(4,16,0) -+import GHC.Exts (Word8#, wordToWord8#) -+#endif -+ - -- | A compact representation of Unicode strings. - -- - -- A 'ShortText' value is a sequence of Unicode scalar values, as defined in -@@ -1271,7 +1275,7 @@ newByteArray (B (I# n#)) - {-# INLINE writeWord8Array #-} - writeWord8Array :: MBA s -> B -> Word -> ST s () - writeWord8Array (MBA# mba#) (B (I# i#)) (W# w#) -- = ST $ \s -> case GHC.Exts.writeWord8Array# mba# i# w# s of -+ = ST $ \s -> case GHC.Exts.writeWord8Array# mba# i# (wordToWord8Compat# w#) s of - s' -> (# s', () #) - {- not needed yet - {-# INLINE indexWord8Array #-} -@@ -1279,6 +1283,14 @@ indexWord8Array :: ShortText -> B -> Word - indexWord8Array (ShortText (BSSI.SBS ba#)) (B (I# i#)) = W# (GHC.Exts.indexWord8Array# ba# i#) - -} - -+#if MIN_VERSION_base(4,16,0) -+wordToWord8Compat# :: Word# -> Word8# -+wordToWord8Compat# = wordToWord8# -+#else -+wordToWord8Compat# :: Word# -> Word# -+wordToWord8Compat# x = x -+#endif -+ - {-# INLINE copyAddrToByteArray #-} - copyAddrToByteArray :: Ptr a -> MBA RealWorld -> B -> B -> ST RealWorld () - copyAddrToByteArray (Ptr src#) (MBA# dst#) (B (I# dst_off#)) (B (I# len#)) -diff --git a/text-short.cabal b/text-short.cabal -index a72d7a2..6580149 100644 ---- a/text-short.cabal -+++ b/text-short.cabal -@@ -2,6 +2,7 @@ cabal-version: 1.18 - - name: text-short - version: 0.1.3 -+x-revision: 3 - synopsis: Memory-efficient representation of Unicode text strings - license: BSD3 - license-file: LICENSE -@@ -14,7 +15,7 @@ description: This package provides the 'ShortText' type which is suitabl - . - The main difference between 'Text' and 'ShortText' is that 'ShortText' uses UTF-8 instead of UTF-16 internally and also doesn't support zero-copy slicing (thereby saving 2 words). Consequently, the memory footprint of a (boxed) 'ShortText' value is 4 words (2 words when unboxed) plus the length of the UTF-8 encoded payload. - --tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4 -+tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4 - extra-source-files: ChangeLog.md - - Source-Repository head -@@ -33,13 +34,13 @@ library - - other-modules: Data.Text.Short.Internal - -- build-depends: base >= 4.7 && < 4.13 -- , bytestring >= 0.10.4 && < 0.11 -+ build-depends: base >= 4.7 && < 4.16 -+ , bytestring >= 0.10.4 && < 0.12 - , hashable >= 1.2.6 && < 1.4 - , deepseq >= 1.3 && < 1.5 - , text >= 1.0 && < 1.3 - , binary >= 0.7.1 && < 0.9 -- , ghc-prim >= 0.3.1 && < 0.6 -+ , ghc-prim >= 0.3.1 && < 0.8 - - if !impl(ghc >= 8.0) - build-depends: semigroups >= 0.18.2 && < 0.20 diff --git a/patches/witherable-0.4.1.patch b/patches/witherable-0.4.1.patch deleted file mode 100644 index ef8c3b7331999accc90febfedb8716e04647a87e..0000000000000000000000000000000000000000 --- a/patches/witherable-0.4.1.patch +++ /dev/null @@ -1,43 +0,0 @@ -diff --git a/src/Data/Witherable.hs b/src/Data/Witherable.hs -index d7f9148..80f7001 100644 ---- a/src/Data/Witherable.hs -+++ b/src/Data/Witherable.hs -@@ -96,7 +96,7 @@ instance Applicative (Peat a b) where - - -- | Reconstitute a 'Filter' from its monomorphic form. - cloneFilter :: FilterLike (Peat a b) s t a b -> Filter s t a b --cloneFilter l f = (`runPeat` f) . l (\a -> Peat $ \g -> g a) -+cloneFilter l f x = runPeat (l (\a -> Peat $ \g -> g a) x) f - {-# INLINABLE cloneFilter #-} - - -- | 'witherOf' is actually 'id', but left for consistency. -diff --git a/src/Witherable.hs b/src/Witherable.hs -index 49998bc..3fd271c 100644 ---- a/src/Witherable.hs -+++ b/src/Witherable.hs -@@ -54,7 +54,9 @@ import Data.Hashable - import Data.Monoid - import Data.Orphans () - import Data.Proxy -+#if !(MIN_VERSION_base(4,16,0)) - import Data.Semigroup (Option (..)) -+#endif - import Data.Traversable.WithIndex - import Data.Void - import Prelude hiding (filter) -@@ -156,6 +158,7 @@ instance Witherable Maybe where - wither f (Just a) = f a - {-# INLINABLE wither #-} - -+#if !(MIN_VERSION_base(4,16,0)) - instance Filterable Option where - mapMaybe f = (>>= Option . f) - {-# INLINE mapMaybe #-} -@@ -163,6 +166,7 @@ instance Filterable Option where - instance Witherable Option where - wither f (Option x) = Option <$> wither f x - {-# INLINE wither #-} -+#endif - - -- Option doesn't have the necessary instances in Lens - --instance FilterableWithIndex () Option