@@ -0,0 +1,201 @@
1+diff -ruN orig/Data/Conduit/TMChan.hs new/Data/Conduit/TMChan.hs
2+--- orig/Data/Conduit/TMChan.hs 2014-08-27 18:36:44.141176333 +0300
3++++ new/Data/Conduit/TMChan.hs 2014-08-27 18:36:43.000000000 +0300
4+@@ -63,22 +63,23 @@
5+ import Control.Concurrent.STM.TMChan
6+
7+ import Data.Conduit
8+-import Data.Conduit.Internal (Pipe (..), ConduitM (..))
9++import qualified Data.Conduit.List as CL
10+
11+-chanSource
12++chanSource
13+ :: MonadIO m
14+ => chan -- ^ The channel.
15+ -> (chan -> STM (Maybe a)) -- ^ The 'read' function.
16+ -> (chan -> STM ()) -- ^ The 'close' function.
17+ -> Source m a
18+-chanSource ch reader closer = ConduitM src
19+- where
20+- src = PipeM pull
21+- pull = do a <- liftSTM $ reader ch
22+- case a of
23+- Just x -> return $ HaveOutput src close x
24+- Nothing -> return $ Done ()
25+- close = liftSTM $ closer ch
26++chanSource ch reader closer =
27++ loop
28++ where
29++ loop = do
30++ a <- liftSTM $ reader ch
31++ case a of
32++ Just x -> yieldOr x close >> loop
33++ Nothing -> return ()
34++ close = liftSTM $ closer ch
35+ {-# INLINE chanSource #-}
36+
37+ chanSink
38+@@ -87,13 +88,9 @@
39+ -> (chan -> a -> STM ()) -- ^ The 'write' function.
40+ -> (chan -> STM ()) -- ^ The 'close' function.
41+ -> Sink a m ()
42+-chanSink ch writer closer = ConduitM sink
43+- where
44+- sink = NeedInput push close
45+-
46+- push input = PipeM ((liftIO . atomically $ writer ch input)
47+- >> (return $ NeedInput push close))
48+- close = const . liftSTM $ closer ch
49++chanSink ch writer closer = do
50++ CL.mapM_ $ liftIO . atomically . writer ch
51++ liftSTM $ closer ch
52+ {-# INLINE chanSink #-}
53+
54+ -- | A simple wrapper around a TBMChan. As data is pushed into the channel, the
55+diff -ruN orig/Data/Conduit/TQueue.hs new/Data/Conduit/TQueue.hs
56+--- orig/Data/Conduit/TQueue.hs 2014-08-27 18:36:44.141176333 +0300
57++++ new/Data/Conduit/TQueue.hs 2014-08-27 18:36:43.000000000 +0300
58+@@ -58,46 +58,28 @@
59+ import Control.Monad
60+ import Control.Monad.IO.Class
61+ import Data.Conduit
62+-import Data.Conduit.Internal
63++import qualified Data.Conduit.List as CL
64+
65+ -- | A simple wrapper around a "TQueue". As data is pushed into the queue, the
66+ -- source will read it and pass it down the conduit pipeline.
67+ sourceTQueue :: MonadIO m => TQueue a -> Source m a
68+-sourceTQueue q = ConduitM src
69+- where src = PipeM pull
70+- pull = do x <- liftSTM $ readTQueue q
71+- return $ HaveOutput src close x
72+- close = return ()
73++sourceTQueue q = forever $ liftSTM (readTQueue q) >>= yield
74+
75+ -- | A simple wrapper around a "TQueue". As data is pushed into this sink, it
76+ -- will magically begin to appear in the queue.
77+ sinkTQueue :: MonadIO m => TQueue a -> Sink a m ()
78+-sinkTQueue q = ConduitM src
79+- where src = sink
80+- sink = NeedInput push close
81+- push input = PipeM ((liftSTM $ writeTQueue q input)
82+- >> (return $ NeedInput push close))
83+- close _ = return ()
84++sinkTQueue q = CL.mapM_ (liftSTM . writeTQueue q)
85+
86+ -- | A simple wrapper around a "TBQueue". As data is pushed into the queue, the
87+ -- source will read it and pass it down the conduit pipeline.
88+ sourceTBQueue :: MonadIO m => TBQueue a -> Source m a
89+-sourceTBQueue q = ConduitM src
90+- where src = PipeM pull
91+- pull = do x <- liftSTM $ readTBQueue q
92+- return $ HaveOutput src close x
93+- close = return ()
94++sourceTBQueue q = forever $ liftSTM (readTBQueue q) >>= yield
95+
96+ -- | A simple wrapper around a "TBQueue". As data is pushed into this sink, it
97+ -- will magically begin to appear in the queue. Boolean argument is used
98+ -- to specify if queue should be closed when the sink is closed.
99+ sinkTBQueue :: MonadIO m => TBQueue a -> Sink a m ()
100+-sinkTBQueue q = ConduitM src
101+- where src = sink
102+- sink = NeedInput push close
103+- push input = PipeM ((liftSTM $ writeTBQueue q input)
104+- >> (return $ NeedInput push close))
105+- close _ = return ()
106++sinkTBQueue q = CL.mapM_ (liftSTM . writeTBQueue q)
107+
108+ -- | A convenience wrapper for creating a source and sink TBQueue of the given
109+ -- size at once, without exposing the underlying queue.
110+@@ -109,14 +91,15 @@
111+ -- source will read it and pass it down the conduit pipeline. When the
112+ -- queue is closed, the source will close also.
113+ sourceTMQueue :: MonadIO m => TMQueue a -> Source m a
114+-sourceTMQueue q = ConduitM src
115+- where src = PipeM pull
116+- pull = do mx <- liftSTM $ readTMQueue q
117+- case mx of
118+- Nothing -> return $ Done ()
119+- Just x -> return $ HaveOutput src close x
120+- close = do liftSTM $ closeTMQueue q
121+- return ()
122++sourceTMQueue q =
123++ loop
124++ where
125++ loop = do
126++ mx <- liftSTM $ readTMQueue q
127++ case mx of
128++ Nothing -> return ()
129++ Just x -> yieldOr x close >> loop
130++ close = liftSTM $ closeTMQueue q
131+
132+ -- | A simple wrapper around a "TMQueue". As data is pushed into this sink, it
133+ -- will magically begin to appear in the queue.
134+@@ -124,26 +107,23 @@
135+ => TMQueue a
136+ -> Bool -- ^ Should the queue be closed when the sink is closed?
137+ -> Sink a m ()
138+-sinkTMQueue q shouldClose = ConduitM src
139+- where src = sink
140+- sink = NeedInput push close
141+- push input = PipeM ((liftSTM $ writeTMQueue q input)
142+- >> (return $ NeedInput push close))
143+- close _ = do when shouldClose (liftSTM $ closeTMQueue q)
144+- return ()
145++sinkTMQueue q shouldClose = do
146++ CL.mapM_ (liftSTM . writeTMQueue q)
147++ when shouldClose (liftSTM $ closeTMQueue q)
148+
149+ -- | A simple wrapper around a "TBMQueue". As data is pushed into the queue, the
150+ -- source will read it and pass it down the conduit pipeline. When the
151+ -- queue is closed, the source will close also.
152+ sourceTBMQueue :: MonadIO m => TBMQueue a -> Source m a
153+-sourceTBMQueue q = ConduitM src
154+- where src = PipeM pull
155+- pull = do mx <- liftSTM $ readTBMQueue q
156+- case mx of
157+- Nothing -> return $ Done ()
158+- Just x -> return $ HaveOutput src close x
159+- close = do liftSTM $ closeTBMQueue q
160+- return ()
161++sourceTBMQueue q =
162++ loop
163++ where
164++ loop = do
165++ mx <- liftSTM $ readTBMQueue q
166++ case mx of
167++ Nothing -> return ()
168++ Just x -> yieldOr x close >> loop
169++ close = liftSTM $ closeTBMQueue q
170+
171+ -- | A simple wrapper around a "TBMQueue". As data is pushed into this sink, it
172+ -- will magically begin to appear in the queue.
173+@@ -151,13 +131,9 @@
174+ => TBMQueue a
175+ -> Bool -- ^ Should the queue be closed when the sink is closed?
176+ -> Sink a m ()
177+-sinkTBMQueue q shouldClose = ConduitM src
178+- where src = sink
179+- sink = NeedInput push close
180+- push input = PipeM ((liftSTM $ writeTBMQueue q input)
181+- >> (return $ NeedInput push close))
182+- close _ = do when shouldClose (liftSTM $ closeTBMQueue q)
183+- return ()
184++sinkTBMQueue q shouldClose = do
185++ CL.mapM_ (liftSTM . writeTBMQueue q)
186++ when shouldClose (liftSTM $ closeTBMQueue q)
187+
188+
189+ liftSTM :: forall (m :: * -> *) a. MonadIO m => STM a -> m a
190+diff -ruN orig/stm-conduit.cabal new/stm-conduit.cabal
191+--- orig/stm-conduit.cabal 2014-08-27 18:36:44.145176333 +0300
192++++ new/stm-conduit.cabal 2014-08-27 18:36:43.000000000 +0300
193+@@ -29,7 +29,7 @@
194+ , stm-chans >= 2.0 && < 3.1
195+ , cereal >= 0.4.0.1
196+ , cereal-conduit >= 0.7.2
197+- , conduit >= 1.0 && < 1.2
198++ , conduit >= 1.0 && < 1.3
199+ , conduit-extra >= 1.0 && < 1.2
200+ , directory >= 1.1
201+ , resourcet >= 0.3 && < 1.2