@@ -0,0 +1,47 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+module Data.Conduit.List
3+ ( fold
4+ , fromList
5+ ) where
6+
7+import Data.Conduit
8+import Control.Monad.Trans.Control (MonadBaseControl)
9+import Control.Monad.Base (liftBase)
10+import qualified Data.IORef as I
11+import Control.Applicative ((<$>))
12+import Data.List (foldl')
13+
14+fold :: MonadBaseControl IO m
15+ => (b -> a -> b)
16+ -> b
17+ -> Sink a m b
18+fold f accum0 = Sink $ do
19+ iaccum <- liftBase $ I.newIORef accum0
20+ return $ go iaccum
21+ where
22+ go iaccum EOF = SinkResult [] . Just <$> liftBase (I.readIORef iaccum)
23+ go iaccum (Chunks cs) = do
24+ liftBase $ I.atomicModifyIORef iaccum $
25+ \accum -> (foldl' f accum cs, ())
26+ return $ SinkResult [] Nothing
27+
28+fromList :: MonadBaseControl IO m => [a] -> Source m a
29+fromList l = Source $ do
30+ il <- liftBase $ I.newIORef l
31+ unSource $ mkSource $ do
32+ l' <- liftBase $ I.atomicModifyIORef il $ \x -> ([], x)
33+ return $ if null l' then EOF else Chunks l'
34+ where
35+ unSource (Source s) = s
36+
37+take :: MonadBaseControl IO m
38+ => Int
39+ -> Sink a m [a]
40+take count0 = Sink $ do
41+ istate <- liftBase $ I.newIORef (count0, [])
42+ return $ go istate
43+ where
44+ go istate EOF = SinkResult [] . Just . snd <$> liftBase (I.readIORef istate)
45+ go istate (Chunks cs) = do
46+ (count, rest) <- liftBase $ I.readIORef
47+ undefined