module Data.Conduit.List
(
sourceList
, sourceNull
, fold
, take
, drop
, head
, zip
, peek
, consume
, sinkNull
, foldM
, mapM_
, map
, concatMap
, concatMapAccum
, groupBy
, isolate
, filter
, mapM
, concatMapM
, concatMapAccumM
) where
import Prelude
( ($), return, (==), (), Int
, (.), id, Maybe (..), Monad
, Bool (..)
, (>>)
, flip
, seq
, otherwise
)
import Data.Conduit
import Data.Monoid (mempty)
import Control.Monad (liftM, liftM2)
fold :: Monad m
=> (b -> a -> b)
-> b
-> Sink a m b
fold f accum0 =
go accum0
where
go accum = Processing (push accum) (return accum)
push accum input =
let accum' = f accum input
in accum' `seq` go accum'
foldM :: Monad m
=> (b -> a -> m b)
-> b
-> Sink a m b
foldM f accum0 = sinkState
accum0
(\accum input -> do
accum' <- f accum input
return $ StateProcessing accum'
)
return
mapM_ :: Monad m
=> (a -> m ())
-> Sink a m ()
mapM_ f =
Processing push close
where
push input = SinkM $ f input >> return (Processing push close)
close = return ()
sourceList :: Monad m => [a] -> Source m a
sourceList [] = Closed
sourceList (x:xs) = Open (sourceList xs) (return ()) x
drop :: Monad m
=> Int
-> Sink a m ()
drop 0 = Processing (flip Done () . Just) (return ())
drop count =
Processing push (return ())
where
count' = count 1
push _
| count' == 0 = Done Nothing ()
| otherwise = drop count'
take :: Monad m
=> Int
-> Sink a m [a]
take count0 =
go count0 id
where
go count front = Processing (push count front) (return $ front [])
push 0 front x = Done (Just x) (front [])
push count front x
| count' == 0 = Done Nothing (front [x])
| otherwise = Processing (push count' front') (return $ front' [])
where
count' = count 1
front' = front . (x:)
head :: Monad m => Sink a m (Maybe a)
head =
Processing push close
where
push x = Done Nothing (Just x)
close = return Nothing
peek :: Monad m => Sink a m (Maybe a)
peek =
Processing push close
where
push x = Done (Just x) (Just x)
close = return Nothing
map :: Monad m => (a -> b) -> Conduit a m b
map f =
NeedInput push close
where
push i = HaveOutput (NeedInput push close) (return ()) (f i)
close = mempty
mapM :: Monad m => (a -> m b) -> Conduit a m b
mapM f =
NeedInput push close
where
push = flip ConduitM (return ()) . liftM (HaveOutput (NeedInput push close) (return ())) . f
close = mempty
concatMap :: Monad m => (a -> [b]) -> Conduit a m b
concatMap f =
NeedInput push close
where
push = haveMore (NeedInput push close) (return ()) . f
close = mempty
concatMapM :: Monad m => (a -> m [b]) -> Conduit a m b
concatMapM f =
NeedInput push close
where
push = flip ConduitM (return ()) . liftM (haveMore (NeedInput push close) (return ())) . f
close = mempty
concatMapAccum :: Monad m => (a -> accum -> (accum, [b])) -> accum -> Conduit a m b
concatMapAccum f accum = conduitState accum push close
where
push state input = let (state', result) = f input state
in return $ StateProducing state' result
close _ = return []
concatMapAccumM :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> Conduit a m b
concatMapAccumM f accum = conduitState accum push close
where
push state input = do (state', result) <- f input state
return $ StateProducing state' result
close _ = return []
consume :: Monad m => Sink a m [a]
consume =
go id
where
go front = Processing (push front) (return $ front [])
push front x = go (front . (x:))
groupBy :: Monad m => (a -> a -> Bool) -> Conduit a m [a]
groupBy f = conduitState
[]
push
close
where
push [] v = return $ StateProducing [v] []
push s@(x:_) v =
if f x v then
return $ StateProducing (v:s) []
else
return $ StateProducing [v] [s]
close s = return [s]
isolate :: Monad m => Int -> Conduit a m a
isolate count0 = conduitState
count0
push
close
where
close _ = return []
push count x = do
if count == 0
then return $ StateFinished (Just x) []
else do
let count' = count 1
return $ if count' == 0
then StateFinished Nothing [x]
else StateProducing count' [x]
filter :: Monad m => (a -> Bool) -> Conduit a m a
filter f =
NeedInput push close
where
push i | f i = HaveOutput (NeedInput push close) (return ()) i
push _ = NeedInput push close
close = mempty
sinkNull :: Monad m => Sink a m ()
sinkNull =
Processing push close
where
push _ = sinkNull
close = return ()
sourceNull :: Monad m => Source m a
sourceNull = mempty
zip :: Monad m => Source m a -> Source m b -> Source m (a, b)
zip Closed Closed = Closed
zip Closed (Open _ close _) = SourceM (close >> return Closed) close
zip (Open _ close _) Closed = SourceM (close >> return Closed) close
zip Closed (SourceM _ close) = SourceM (close >> return Closed) close
zip (SourceM _ close) Closed = SourceM (close >> return Closed) close
zip (SourceM mx closex) (SourceM my closey) = SourceM (liftM2 zip mx my) (closex >> closey)
zip (SourceM mx closex) y@(Open _ closey _) = SourceM (liftM (\x -> zip x y) mx) (closex >> closey)
zip x@(Open _ closex _) (SourceM my closey) = SourceM (liftM (\y -> zip x y) my) (closex >> closey)
zip (Open srcx closex x) (Open srcy closey y) = Open (zip srcx srcy) (closex >> closey) (x, y)