Merge branch '2021-02-09' into 'master'

Add patches for boomerang, modern-uri, and more

See merge request ghc/head.hackage!140

ci/config.sh

@@ -72,7 +72,6 @@ echo "Found GHC $version, commit $commit."
 case $version in
   9.0.*)
     #       package             ticket
-    broken  "plots"             19315
     ;;
 
   9.1.*)

patches/Spock-core-0.14.0.0.patch

+diff --git a/src/Web/Spock/Core.hs b/src/Web/Spock/Core.hs
+index 88d31cc..31345c3 100644
+--- a/src/Web/Spock/Core.hs
++++ b/src/Web/Spock/Core.hs
+@@ -77,7 +77,7 @@ instance RouteM SpockCtxT where
+     addMiddleware = SpockCtxT . AR.middleware
+     wireAny m action =
+         SpockCtxT $
+-        do hookLift <- lift $ asks unLiftHooked
++        do hookLift <- lift $ asks (\e -> unLiftHooked e)
+            case m of
+              MethodAny ->
+                  do forM_ allStdMethods $ \mReg ->
+@@ -103,7 +103,7 @@ withPrehookImpl hook (SpockCtxT hookBody) =
+ wireRouteImpl :: forall xs ctx m ps. (HasRep xs, Monad m) => SpockMethod -> Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
+ wireRouteImpl m path action =
+     SpockCtxT $
+-    do hookLift <- lift $ asks unLiftHooked
++    do hookLift <- lift $ asks (\e -> unLiftHooked e)
+        let actionPacker :: HVectElim xs (ActionCtxT ctx m ()) -> HVect xs -> ActionCtxT () m ()
+            actionPacker act captures = hookLift (uncurry act captures)
+        case m of

patches/boomerang-1.4.6.patch

+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) []
+ 

patches/bytestring-strict-builder-0.4.5.3.patch

+diff --git a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
+index 69ba0ff..e130f2c 100644
+--- a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
++++ b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
+@@ -62,8 +62,8 @@ shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w
+ #endif
+ 
+ #if !defined(__HADDOCK__)
+-shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`   i)
+-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)
++shiftr_w16 (W16# w) (I# i) = W16# (narrowWord16Compat# (extendWord16Compat# w `uncheckedShiftRL#`   i))
++shiftr_w32 (W32# w) (I# i) = W32# (narrowWord32Compat# (extendWord32Compat# w `uncheckedShiftRL#`   i))
+ 
+ #if WORD_SIZE_IN_BITS < 64
+ shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
+@@ -77,6 +77,32 @@ shiftr_w32 = shiftR
+ shiftr_w64 = shiftR
+ #endif
+ 
++#if MIN_VERSION_base(4,16,0)
++extendWord16Compat# :: Word16# -> Word#
++extendWord16Compat# = extendWord16#
++
++narrowWord16Compat# :: Word# -> Word16#
++narrowWord16Compat# = narrowWord16#
++
++extendWord32Compat# :: Word32# -> Word#
++extendWord32Compat# = extendWord32#
++
++narrowWord32Compat# :: Word# -> Word32#
++narrowWord32Compat# = narrowWord32#
++#else
++extendWord16Compat# :: Word# -> Word#
++extendWord16Compat# x = x
++
++narrowWord16Compat# :: Word# -> Word#
++narrowWord16Compat# x = x
++
++extendWord32Compat# :: Word# -> Word#
++extendWord32Compat# x = x
++
++narrowWord32Compat# :: Word# -> Word#
++narrowWord32Compat# x = x
++#endif
++
+ 
+ -- | Select an implementation depending on the bit-size of 'Word's.
+ -- Currently, it produces a runtime failure if the bitsize is different.
+diff --git a/library/ByteString/StrictBuilder/UTF8.hs b/library/ByteString/StrictBuilder/UTF8.hs
+index c1bb7f4..7e6d964 100644
+--- a/library/ByteString/StrictBuilder/UTF8.hs
++++ b/library/ByteString/StrictBuilder/UTF8.hs
+@@ -19,8 +19,8 @@ type UTF8Char =
+ 
+ {-# INLINE char #-}
+ char :: Char -> UTF8Char
+-char =
+-  unicodeCodePoint . ord
++char x =
++  unicodeCodePoint (ord x)
+ 
+ {-# INLINE unicodeCodePoint #-}
+ unicodeCodePoint :: Int -> UTF8Char
+@@ -28,7 +28,7 @@ unicodeCodePoint x f1 f2 f3 f4 =
+   if x <= 0x7F
+     then
+       f1 (fromIntegral x)
+-    else 
++    else
+       if x <= 0x07FF
+         then
+           f2

patches/charset-0.3.7.1.patch

+diff --git a/charset.cabal b/charset.cabal
+index 4824684..63db0e0 100644
+--- a/charset.cabal
++++ b/charset.cabal
+@@ -1,5 +1,6 @@
+ name:          charset
+ version:       0.3.7.1
++x-revision: 2
+ license:       BSD3
+ license-File:  LICENSE
+ copyright:     (c) Edward Kmett 2010-2012
+@@ -26,8 +27,8 @@ library
+   build-depends:
+     base                 >= 4       && < 5,
+     array                >= 0.2     && < 0.6,
+-    bytestring           >= 0.9     && < 0.11,
+-    containers           >= 0.2     && < 0.6,
++    bytestring           >= 0.9     && < 0.12,
++    containers           >= 0.2     && < 0.7,
+     semigroups           >= 0.8.3.1 && < 1,
+     unordered-containers >= 0.1.4.6 && < 0.3
+ 
+diff --git a/src/Data/CharSet/ByteSet.hs b/src/Data/CharSet/ByteSet.hs
+index 78e9e7f..8e576c4 100644
+--- a/src/Data/CharSet/ByteSet.hs
++++ b/src/Data/CharSet/ByteSet.hs
+@@ -30,7 +30,7 @@ module Data.CharSet.ByteSet
+ 
+ import Data.Bits ((.&.), (.|.))
+ import Foreign.Storable (peekByteOff, pokeByteOff)
+-import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#)
++import GHC.Base
+ import GHC.Word (Word8(W8#))
+ import qualified Data.ByteString as B
+ import qualified Data.ByteString.Internal as I
+@@ -44,7 +44,21 @@ shiftR :: Int -> Int -> Int
+ shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)
+ 
+ shiftL :: Word8 -> Int -> Word8
+-shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))
++shiftL (W8# x#) (I# i#) = W8# (narrow8WordCompat# (extendWord8Compat# x# `shiftL#` i#))
++
++#if MIN_VERSION_base(4,16,0)
++extendWord8Compat# :: Word8# -> Word#
++extendWord8Compat# = extendWord8#
++
++narrow8WordCompat# :: Word# -> Word8#
++narrow8WordCompat# = narrowWord8#
++#else
++extendWord8Compat# :: Word# -> Word#
++extendWord8Compat# x = x
++
++narrow8WordCompat# :: Word# -> Word#
++narrow8WordCompat# = narrow8Word#
++#endif
+ 
+ index :: Int -> I
+ index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))

patches/data-serializer-0.3.4.1.patch

+diff --git a/src/Data/Deserializer.hs b/src/Data/Deserializer.hs
+index 5975e37..eb9c78d 100644
+--- a/src/Data/Deserializer.hs
++++ b/src/Data/Deserializer.hs
+@@ -637,16 +637,16 @@ instance Deserializer μ ⇒ Deserializer (BigEndianDeserializer μ) where
+ -- | Force the default byte order.
+ deserializeIn ∷ Deserializer μ
+               ⇒ Endian → (∀ μ' . (Deserializer μ') ⇒ μ' α) → μ α
+-deserializeIn LittleEndian = deserializeL
+-deserializeIn BigEndian    = deserializeB
++deserializeIn LittleEndian f = deserializeL f
++deserializeIn BigEndian    f = deserializeB f
+ {-# INLINE deserializeIn #-}
+ 
+ -- | Force the default byte order to be the host byte order.
+ deserializeH ∷ Deserializer μ ⇒ (∀ μ' . (Deserializer μ') ⇒ μ' α) → μ α
+ #ifdef WORDS_BIGENDIAN
+-deserializeH = deserializeB
++deserializeH f = deserializeB f
+ #else
+-deserializeH = deserializeL
++deserializeH f = deserializeL f
+ #endif
+ 
+ -- | Deserialization result.
+diff --git a/src/Data/Serializer.hs b/src/Data/Serializer.hs
+index 1b87a3f..dd82799 100644
+--- a/src/Data/Serializer.hs
++++ b/src/Data/Serializer.hs
+@@ -576,16 +576,16 @@ instance Serializer s ⇒ Serializer (BigEndianSerializer s) where
+ 
+ -- | Force the default byte order.
+ serializeIn ∷ Serializer s ⇒ Endian → (∀ s' . (Serializer s') ⇒ s') → s
+-serializeIn LittleEndian = serializeL
+-serializeIn BigEndian    = serializeB
++serializeIn LittleEndian f = serializeL f
++serializeIn BigEndian    f = serializeB f
+ {-# INLINE serializeIn #-}
+ 
+ -- | Force the default byte order to be the host byte order.
+ serializeH ∷ Serializer s ⇒ (∀ s' . (Serializer s') ⇒ s') → s
+ #ifdef WORDS_BIGENDIAN
+-serializeH = serializeB
++serializeH f = serializeB f
+ #else
+-serializeH = serializeL
++serializeH f = serializeL f
+ #endif
+ {-# INLINE serializeH #-}
+ 

patches/hedgehog-1.0.4.patch

+diff --git a/src/Hedgehog/Internal/TH.hs b/src/Hedgehog/Internal/TH.hs
+index 39b3bc1..b6913a6 100644
+--- a/src/Hedgehog/Internal/TH.hs
++++ b/src/Hedgehog/Internal/TH.hs
+@@ -15,7 +15,7 @@ import           Hedgehog.Internal.Discovery
+ import           Hedgehog.Internal.Property
+ 
+ import           Language.Haskell.TH (Exp(..), Q, TExp, location, runIO)
+-import           Language.Haskell.TH.Syntax (Loc(..), mkName, unTypeQ, unsafeTExpCoerce)
++import           Language.Haskell.TH.Syntax (Loc(..), mkName, unsafeTExpCoerce, Code, liftCode, examineCode, unsafeCodeCoerce, unTypeCode)
+ 
+ type TExpQ a =
+   Q (TExp a)
+@@ -24,11 +24,11 @@ type TExpQ a =
+ --
+ --   Functions starting with `prop_` are assumed to be properties.
+ --
+-discover :: TExpQ Group
++discover :: Code Q Group
+ discover = discoverPrefix "prop_"
+ 
+-discoverPrefix :: String -> TExpQ Group
+-discoverPrefix prefix = do
++discoverPrefix :: String -> Code Q Group
++discoverPrefix prefix = liftCode $ do
+   file <- getCurrentFile
+   properties <- Map.toList <$> runIO (readProperties prefix file)
+ 
+@@ -44,24 +44,24 @@ discoverPrefix prefix = do
+       fmap (mkNamedProperty . fst) $
+       List.sortBy startLine properties
+ 
+-  [|| Group $$(moduleName) $$(listTE names) ||]
++  examineCode [|| Group $$(moduleName) $$(listTE names) ||]
+ 
+-mkNamedProperty :: PropertyName -> TExpQ (PropertyName, Property)
++mkNamedProperty :: PropertyName -> Code Q (PropertyName, Property)
+ mkNamedProperty name = do
+   [|| (name, $$(unsafeProperty name)) ||]
+ 
+-unsafeProperty :: PropertyName -> TExpQ Property
++unsafeProperty :: PropertyName -> Code Q Property
+ unsafeProperty =
+-  unsafeTExpCoerce . pure . VarE . mkName . unPropertyName
++  unsafeCodeCoerce . pure . VarE . mkName . unPropertyName
+ 
+-listTE :: [TExpQ a] -> TExpQ [a]
+-listTE xs = do
+-  unsafeTExpCoerce . pure . ListE =<< traverse unTypeQ xs
++listTE :: [Code Q a] -> Code Q [a]
++listTE xs = liftCode $ do
++  unsafeTExpCoerce . pure . ListE =<< traverse unTypeCode xs
+ 
+-moduleName :: TExpQ GroupName
+-moduleName = do
++moduleName :: Code Q GroupName
++moduleName = liftCode $ do
+   loc <- GroupName . loc_module <$> location
+-  [|| loc ||]
++  examineCode [|| loc ||]
+ 
+ getCurrentFile :: Q FilePath
+ getCurrentFile =

patches/hvect-0.4.0.0.patch

+diff --git a/src/Data/HVect.hs b/src/Data/HVect.hs
+index 9922e80..ce3a3d3 100644
+--- a/src/Data/HVect.hs
++++ b/src/Data/HVect.hs
+@@ -1,4 +1,5 @@
+ {-# LANGUAGE DataKinds #-}
++{-# LANGUAGE FlexibleContexts #-}
+ {-# LANGUAGE FlexibleInstances #-}
+ {-# LANGUAGE GADTs #-}
+ {-# LANGUAGE KindSignatures #-}

patches/modern-uri-0.3.3.1.patch

+diff --git a/Text/URI/Types.hs b/Text/URI/Types.hs
+index 116359a..553af6f 100644
+--- a/Text/URI/Types.hs
++++ b/Text/URI/Types.hs
+@@ -126,7 +126,7 @@ instance TH.Lift URI where
+   lift = liftData
+ 
+ #if MIN_VERSION_template_haskell(2,16,0)
+-  liftTyped = TH.unsafeTExpCoerce . TH.lift
++  liftTyped = TH.unsafeCodeCoerce . TH.lift
+ #endif
+ 
+ -- | Make a given 'URI' reference absolute using the supplied @'RText'
+@@ -169,7 +169,7 @@ instance TH.Lift Authority where
+   lift = liftData
+ 
+ #if MIN_VERSION_template_haskell(2,16,0)
+-  liftTyped = TH.unsafeTExpCoerce . TH.lift
++  liftTyped = TH.unsafeCodeCoerce . TH.lift
+ #endif
+ 
+ -- | User info as a combination of username and password.
+@@ -195,7 +195,7 @@ instance TH.Lift UserInfo where
+   lift = liftData
+ 
+ #if MIN_VERSION_template_haskell(2,16,0)
+-  liftTyped = TH.unsafeTExpCoerce . TH.lift
++  liftTyped = TH.unsafeCodeCoerce . TH.lift
+ #endif
+ 
+ -- | Query parameter either in the form of flag or as a pair of key and
+@@ -221,7 +221,7 @@ instance TH.Lift QueryParam where
+   lift = liftData
+ 
+ #if MIN_VERSION_template_haskell(2,16,0)
+-  liftTyped = TH.unsafeTExpCoerce . TH.lift
++  liftTyped = TH.unsafeCodeCoerce . TH.lift
+ #endif
+ 
+ -- | Parse exception thrown by 'mkURI' when a given 'Text' value cannot be
+@@ -267,7 +267,7 @@ instance Typeable l => TH.Lift (RText l) where
+   lift = liftData
+ 
+ #if MIN_VERSION_template_haskell(2,16,0)
+-  liftTyped = TH.unsafeTExpCoerce . TH.lift
++  liftTyped = TH.unsafeCodeCoerce . TH.lift
+ #endif
+ 
+ -- | Refined text labels.
+@@ -547,8 +547,8 @@ arbText' f = fromJust . f . T.pack <$> listOf1 arbitrary
+ ----------------------------------------------------------------------------
+ -- TH lifting helpers
+ 
+-liftData :: Data a => a -> TH.Q TH.Exp
++liftData :: (TH.Quote m, Data a) => a -> m TH.Exp
+ liftData = TH.dataToExpQ (fmap liftText . cast)
+ 
+-liftText :: Text -> TH.Q TH.Exp
++liftText :: TH.Quote m => Text -> m TH.Exp
+ liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)

patches/monad-validate-1.2.0.0.patch

+diff --git a/src/Control/Monad/Validate/Internal.hs b/src/Control/Monad/Validate/Internal.hs
+index cfb1d6b..96aee8e 100644
+--- a/src/Control/Monad/Validate/Internal.hs
++++ b/src/Control/Monad/Validate/Internal.hs
+@@ -296,7 +296,7 @@ instance (Monad m) => Applicative (ValidateT e m) where
+   {-# INLINABLE (<*>) #-}
+ 
+ instance (Monad m) => Monad (ValidateT e m) where
+-  ValidateT x >>= f = ValidateT (x >>= (getValidateT . f))
++  ValidateT x >>= f = ValidateT (x >>= (\a -> getValidateT (f a)))
+   {-# INLINE (>>=) #-}
+ 
+ instance MonadTrans (ValidateT e) where

patches/pipes-4.3.14.patch

-diff --git a/src/Pipes.hs b/src/Pipes.hs
-index 7382826..b1cd820 100644
---- a/src/Pipes.hs
-+++ b/src/Pipes.hs
-@@ -138,7 +138,7 @@ f '~>' 'yield' = f
- @
- -}
- yield :: Functor m => a -> Producer' a m ()
--yield = respond
-+yield x = respond x
- {-# INLINABLE [1] yield #-}
- 
- {-| @(for p body)@ loops over @p@ replacing each 'yield' with @body@.
-@@ -183,7 +183,7 @@ for = (//>)
- {-# RULES
-     "for (for p f) g" forall p f g . for (for p f) g = for p (\a -> for (f a) g)
- 
--  ; "for p yield" forall p . for p yield = p
-+  ; "for p yield" forall p . for p (\x -> yield x) = p
- 
-   ; "for (yield x) f" forall x f . for (yield x) f = f x
- 
-@@ -637,7 +637,7 @@ next = go
- 
- -- | Convert a 'F.Foldable' to a 'Producer'
- each :: (Functor m, Foldable f) => f a -> Producer' a m ()
--each = F.foldr (\a p -> yield a >> p) (return ())
-+each f = F.foldr (\a p -> yield a >> p) (return ()) f
- {-# INLINABLE each #-}
- {-  The above code is the same as:
- 
-diff --git a/src/Pipes/Prelude.hs b/src/Pipes/Prelude.hs
-index 4ab3e0f..f37e20a 100644
---- a/src/Pipes/Prelude.hs
-+++ b/src/Pipes/Prelude.hs
-@@ -403,12 +403,12 @@ As a result of the second law,
- > mapMaybe return = mapMaybe Just = cat
- -}
- mapMaybe :: Functor m => (a -> Maybe b) -> Pipe a b m r
--mapMaybe f = for cat $ maybe (pure ()) yield . f
-+mapMaybe f = for cat $ maybe (pure ()) (\x -> yield x) . f
- {-# INLINABLE [1] mapMaybe #-}
- 
- {-# RULES
-     "p >-> mapMaybe f" forall p f.
--        p >-> mapMaybe f = for p $ maybe (pure ()) yield . f
-+        p >-> mapMaybe f = for p $ maybe (pure ()) (\x -> yield x) . f
-   #-}
- 
- {-| @(filterM predicate)@ only forwards values that satisfy the monadic
-@@ -453,12 +453,12 @@ As a result of the third law,
- > wither (pure . const Nothing) = wither (const (pure Nothing)) = drain
- -}
- wither :: Monad m => (a -> m (Maybe b)) -> Pipe a b m r
--wither f = for cat $ lift . f >=> maybe (pure ()) yield
-+wither f = for cat $ lift . f >=> maybe (pure ()) (\x -> yield x)
- {-# INLINABLE [1] wither #-}
- 
- {-# RULES
-     "p >-> wither f" forall p f .
--        p >-> wither f = for p $ lift . f >=> maybe (pure ()) yield
-+        p >-> wither f = for p $ lift . f >=> maybe (pure ()) (\x -> yield x)
-   #-}
- 
- {-| @(take n)@ only allows @n@ values to pass through
-@@ -474,8 +474,8 @@ wither f = for cat $ lift . f >=> maybe (pure ()) yield
- take :: Functor m => Int -> Pipe a a m ()
- take = go
-   where
--    go 0 = return () 
--    go n = do 
-+    go 0 = return ()
-+    go n = do
-         a <- await
-         yield a
-         go (n-1)
-@@ -555,11 +555,11 @@ dropWhile predicate = go
- 
- -- | Flatten all 'Foldable' elements flowing downstream
- concat :: (Functor m, Foldable f) => Pipe (f a) a m r
--concat = for cat each
-+concat = for cat (\x -> each x)
- {-# INLINABLE [1] concat #-}
- 
- {-# RULES
--    "p >-> concat" forall p . p >-> concat = for p each
-+    "p >-> concat" forall p . p >-> concat = for p (\x -> each x)
-   #-}
- 
- -- | Outputs the indices of all elements that match the given element
-@@ -653,7 +653,7 @@ show = map Prelude.show
- 
- -- | Evaluate all values flowing downstream to WHNF
- seq :: Functor m => Pipe a a m r
--seq = for cat $ \a -> yield $! a
-+seq = for cat $ \a -> (\x -> yield x) $! a
- {-# INLINABLE seq #-}
- 
- {-| Create a `Pipe` from a `ListT` transformation
-@@ -663,7 +663,7 @@ seq = for cat $ \a -> yield $! a
- > loop return = cat
- -}
- loop :: Monad m => (a -> ListT m b) -> Pipe a b m r
--loop k = for cat (every . k)
-+loop k = for cat (\x -> every (k x))
- {-# INLINABLE loop #-}
- 
- {- $folds
-@@ -926,7 +926,7 @@ zipWith :: Monad m
-     -> (Producer  a m r)
-     -> (Producer  b m r)
-     -> (Producer' c m r)
--zipWith f = go
-+zipWith f pi1 pi2 = go pi1 pi2
-   where
-     go p1 p2 = do
-         e1 <- lift $ next p1
-@@ -981,18 +981,18 @@ generalize p x0 = evalStateP x0 $ up >\\ hoist lift p //> dn
-         lift $ put x
- {-# INLINABLE generalize #-}
- 
--{-| The natural unfold into a 'Producer' with a step function and a seed 
-+{-| The natural unfold into a 'Producer' with a step function and a seed
- 
- > unfoldr next = id
- -}
--unfoldr :: Monad m 
-+unfoldr :: Monad m
-         => (s -> m (Either r (a, s))) -> s -> Producer a m r
- unfoldr step = go where
-   go s0 = do
-     e <- lift (step s0)
-     case e of
-       Left r -> return r
--      Right (a,s) -> do 
-+      Right (a,s) -> do
-         yield a
-         go s
- {-# INLINABLE unfoldr #-}

patches/primitive-extras-0.8.patch

+diff --git a/library/PrimitiveExtras/Bitmap.hs b/library/PrimitiveExtras/Bitmap.hs
+index d9a1fe0..ccbab8b 100644
+--- a/library/PrimitiveExtras/Bitmap.hs
++++ b/library/PrimitiveExtras/Bitmap.hs
+@@ -2,7 +2,7 @@ module PrimitiveExtras.Bitmap
+ (
+   Bitmap,
+   empty,
+-  singleton,
++  PrimitiveExtras.Bitmap.singleton,
+   insert,
+   invert,
+   indexList,
+diff --git a/library/PrimitiveExtras/SparseSmallArray.hs b/library/PrimitiveExtras/SparseSmallArray.hs
+index fec94db..ff6ef42 100644
+--- a/library/PrimitiveExtras/SparseSmallArray.hs
++++ b/library/PrimitiveExtras/SparseSmallArray.hs
+@@ -2,7 +2,7 @@ module PrimitiveExtras.SparseSmallArray
+ (
+   SparseSmallArray,
+   empty,
+-  singleton,
++  PrimitiveExtras.SparseSmallArray.singleton,
+   maybeList,
+   pair,
+   insert,
+@@ -50,7 +50,7 @@ empty = SparseSmallArray Bitmap.empty Prelude.empty
+ -- An array with a single element at the specified index.
+ {-# INLINE singleton #-}
+ singleton :: Int -> e -> SparseSmallArray e
+-singleton i e = 
++singleton i e =
+   let b = Bitmap.singleton i
+       a = runST $ newSmallArray 1 e >>= unsafeFreezeSmallArray
+       in SparseSmallArray b a
+@@ -58,9 +58,9 @@ singleton i e =
+ {-# INLINE pair #-}
+ pair :: Int -> e -> Int -> e -> SparseSmallArray e
+ pair i1 e1 i2 e2 =
+-  {-# SCC "pair" #-} 
++  {-# SCC "pair" #-}
+   SparseSmallArray bitmap array
+-  where 
++  where
+     bitmap = Bitmap.pair i1 i2
+     array = SmallArray.orderedPair i1 e1 i2 e2
+ 
+@@ -76,15 +76,15 @@ It's your obligation to ensure that the index is empty before the operation.
+ {-# INLINE insert #-}
+ insert :: Int -> e -> SparseSmallArray e -> SparseSmallArray e
+ insert i e (SparseSmallArray b a) =
+-  {-# SCC "insert" #-} 
++  {-# SCC "insert" #-}
+   let
+     sparseIndex = Bitmap.populatedIndex i b
+     in SparseSmallArray (Bitmap.insert i b) (SmallArray.insert sparseIndex e a)
+-    
++
+ {-# INLINE replace #-}
+ replace :: Int -> e -> SparseSmallArray e -> SparseSmallArray e
+ replace i e (SparseSmallArray b a) =
+-  {-# SCC "replace" #-} 
++  {-# SCC "replace" #-}
+   let
+     sparseIndex = Bitmap.populatedIndex i b
+     in SparseSmallArray b (SmallArray.set sparseIndex e a)
+@@ -109,7 +109,7 @@ unset i (SparseSmallArray b a) =
+ {-# INLINE lookup #-}
+ lookup :: Int -> SparseSmallArray e -> Maybe e