From ab68cdc420e46512b125d37386d177ed1c82a463 Mon Sep 17 00:00:00 2001 From: Julian Brunner Date: Mon, 26 Aug 2024 05:10:19 +0200 Subject: [PATCH 1/4] avoid dropping upstream items in mergeSource --- conduit/src/Data/Conduit/Internal/Conduit.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/conduit/src/Data/Conduit/Internal/Conduit.hs b/conduit/src/Data/Conduit/Internal/Conduit.hs index 9139fa353..8384e7d3e 100644 --- a/conduit/src/Data/Conduit/Internal/Conduit.hs +++ b/conduit/src/Data/Conduit/Internal/Conduit.hs @@ -613,7 +613,7 @@ mergeSource = loop . sealConduitT go a = do (src1, mi) <- lift $ src0 $$++ await case mi of - Nothing -> return () + Nothing -> leftover a Just i -> yield (i, a) >> loop src1 From a200ebd3a997d9a349519076cf1cd6b3e4557e88 Mon Sep 17 00:00:00 2001 From: Julian Brunner Date: Mon, 26 Aug 2024 15:52:53 +0200 Subject: [PATCH 2/4] add test case for mergeSource item dropping --- conduit/test/main.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/conduit/test/main.hs b/conduit/test/main.hs index c7860c622..5ee5b1cd8 100644 --- a/conduit/test/main.hs +++ b/conduit/test/main.hs @@ -704,6 +704,12 @@ main = hspec $ do withShortAlphaIndex = CI.mergeSource (CL.sourceList ["A", "B", "C"]) output <- runConduit $ src .| withShortAlphaIndex .| CL.consume output `shouldBe` [("A", 1), ("B", 2), ("C", 3)] + it "does not drop upstream items" $ do + let num = CL.sourceList [1 .. 10 :: Int] + let chr = CL.sourceList ['a' .. 'c'] + (output, remainder) <- runConduit $ num .| liftA2 (,) (CI.mergeSource chr .| CL.consume) CL.consume + output `shouldBe` [('a', 1), ('b', 2), ('c', 3)] + remainder `shouldBe` [4 .. 10] describe "passthroughSink" $ do it "works" $ do From 67478550c371b283f683c843d648a8c5b98f5290 Mon Sep 17 00:00:00 2001 From: Julian Brunner Date: Mon, 26 Aug 2024 15:55:29 +0200 Subject: [PATCH 3/4] add changelog entry for #513 --- conduit/ChangeLog.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/conduit/ChangeLog.md b/conduit/ChangeLog.md index 1f7cce1aa..33d498863 100644 --- a/conduit/ChangeLog.md +++ b/conduit/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for conduit +## 1.3.6 + +* Avoid dropping upstream items in `mergeSource` [#513](https://github.com/snoyberg/conduit/pull/513) + ## 1.3.5 * Add `groupOn` From 84c7abc10e85ad1e9c12de8efcf53d9d7da2d1f3 Mon Sep 17 00:00:00 2001 From: Julian Brunner Date: Mon, 26 Aug 2024 16:38:56 +0200 Subject: [PATCH 4/4] import liftA2 for tests to work on older versions of base --- conduit/test/main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/conduit/test/main.hs b/conduit/test/main.hs index 5ee5b1cd8..2d33ea38e 100644 --- a/conduit/test/main.hs +++ b/conduit/test/main.hs @@ -32,7 +32,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Writer (execWriter, tell, runWriterT) import Control.Monad.Trans.State (evalStateT, get, put) import qualified Control.Monad.Writer as W -import Control.Applicative (pure, (<$>), (<*>)) +import Control.Applicative (pure, (<$>), (<*>), liftA2) import qualified Control.Monad.Catch as Catch import Data.Functor.Identity (Identity,runIdentity) import Control.Monad (forever, void)