diff --git a/ci/config.sh b/ci/config.sh index 9bb8244bde113b989e0f342e9cce938431868c0c..007ec4276edffff0f0b9840dda247f7c88a843e7 100644 --- a/ci/config.sh +++ b/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.*) diff --git a/patches/Spock-core-0.14.0.0.patch b/patches/Spock-core-0.14.0.0.patch new file mode 100644 index 0000000000000000000000000000000000000000..85b0bb1e10f3e14ca11dd600d653d2ebd67065cc --- /dev/null +++ b/patches/Spock-core-0.14.0.0.patch @@ -0,0 +1,22 @@ +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 diff --git a/patches/attoparsec-0.13.2.4.patch b/patches/attoparsec-0.13.2.5.patch similarity index 100% rename from patches/attoparsec-0.13.2.4.patch rename to patches/attoparsec-0.13.2.5.patch diff --git a/patches/boomerang-1.4.6.patch b/patches/boomerang-1.4.6.patch new file mode 100644 index 0000000000000000000000000000000000000000..bbee64e28b330ac839c861893c93242d45e6c42a --- /dev/null +++ b/patches/boomerang-1.4.6.patch @@ -0,0 +1,57 @@ +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/bytestring-strict-builder-0.4.5.3.patch b/patches/bytestring-strict-builder-0.4.5.3.patch new file mode 100644 index 0000000000000000000000000000000000000000..1d45937a48c38a4d83b4ba8412b4546040c9cfa5 --- /dev/null +++ b/patches/bytestring-strict-builder-0.4.5.3.patch @@ -0,0 +1,72 @@ +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 diff --git a/patches/charset-0.3.7.1.patch b/patches/charset-0.3.7.1.patch new file mode 100644 index 0000000000000000000000000000000000000000..990dcd17702d88715ee07b19653267b7c4fd3d1b --- /dev/null +++ b/patches/charset-0.3.7.1.patch @@ -0,0 +1,58 @@ +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)) diff --git a/patches/data-serializer-0.3.4.1.patch b/patches/data-serializer-0.3.4.1.patch new file mode 100644 index 0000000000000000000000000000000000000000..321ba1daf51356cf2f38e9681b56f650ca9e2da1 --- /dev/null +++ b/patches/data-serializer-0.3.4.1.patch @@ -0,0 +1,50 @@ +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 #-} + diff --git a/patches/hedgehog-1.0.4.patch b/patches/hedgehog-1.0.4.patch new file mode 100644 index 0000000000000000000000000000000000000000..258149f1a546b4a40e91036e2272322015996c14 --- /dev/null +++ b/patches/hedgehog-1.0.4.patch @@ -0,0 +1,63 @@ +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 = diff --git a/patches/hvect-0.4.0.0.patch b/patches/hvect-0.4.0.0.patch new file mode 100644 index 0000000000000000000000000000000000000000..dff75b044943ba9d9119a1382cc3c8e34aa688a2 --- /dev/null +++ b/patches/hvect-0.4.0.0.patch @@ -0,0 +1,10 @@ +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 #-} diff --git a/patches/modern-uri-0.3.3.1.patch b/patches/modern-uri-0.3.3.1.patch new file mode 100644 index 0000000000000000000000000000000000000000..d3df697b9b885dcc0b280c1097c97c36145e7fd8 --- /dev/null +++ b/patches/modern-uri-0.3.3.1.patch @@ -0,0 +1,60 @@ +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) diff --git a/patches/monad-validate-1.2.0.0.patch b/patches/monad-validate-1.2.0.0.patch new file mode 100644 index 0000000000000000000000000000000000000000..0685a81955e053d9f2be0521beb3fd8509bc4be3 --- /dev/null +++ b/patches/monad-validate-1.2.0.0.patch @@ -0,0 +1,13 @@ +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 diff --git a/patches/pipes-4.3.14.patch b/patches/pipes-4.3.14.patch deleted file mode 100644 index 1b45c236a958552c2762f7c819971ce5c2455de7..0000000000000000000000000000000000000000 --- a/patches/pipes-4.3.14.patch +++ /dev/null @@ -1,139 +0,0 @@ -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 #-} diff --git a/patches/primitive-extras-0.8.patch b/patches/primitive-extras-0.8.patch new file mode 100644 index 0000000000000000000000000000000000000000..30d5ee4eaa87b83c35e19dabaf7d3dc7f002d71d --- /dev/null +++ b/patches/primitive-extras-0.8.patch @@ -0,0 +1,84 @@ +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 + lookup i (SparseSmallArray b a) = +- {-# SCC "lookup" #-} ++ {-# SCC "lookup" #-} + if Bitmap.isPopulated i b + then Just (indexSmallArray a (Bitmap.populatedIndex i b)) + else Nothing +@@ -148,7 +148,7 @@ onElementAtFocus index (Focus concealA revealA) = Focus concealSsa revealSsa whe + Focus.Remove -> Focus.Leave + revealSsa (SparseSmallArray indices array) = + fmap (fmap aChangeToSsaChange) $ +- if Bitmap.isPopulated index indices ++ if Bitmap.isPopulated index indices + then do + a <- indexSmallArrayM array (Bitmap.populatedIndex index indices) + revealA a diff --git a/patches/text-builder-0.6.6.1.patch b/patches/text-builder-0.6.6.1.patch new file mode 100644 index 0000000000000000000000000000000000000000..03c19e300da81536ea46eff4c95df970a46f0223 --- /dev/null +++ b/patches/text-builder-0.6.6.1.patch @@ -0,0 +1,15 @@ +diff --git a/library/Text/Builder/UTF16.hs b/library/Text/Builder/UTF16.hs +index 2478b87..1687b9e 100644 +--- a/library/Text/Builder/UTF16.hs ++++ b/library/Text/Builder/UTF16.hs +@@ -12,8 +12,8 @@ type UTF16View = + + {-# INLINE char #-} + char :: Char -> UTF16View +-char = +- unicodeCodePoint . ord ++char x = ++ unicodeCodePoint (ord x) + + {-# INLINE unicodeCodePoint #-} + unicodeCodePoint :: Int -> UTF16View