module Data.Iteratee.ListLike (
isFinished
,stream2list
,stream2stream
,break
,dropWhile
,drop
,head
,tryHead
,last
,heads
,peek
,roll
,length
,chunkLength
,takeFromChunk
,breakE
,take
,takeUpTo
,takeWhile
,takeWhileE
,mapStream
,rigidMapStream
,filter
,group
,groupBy
,merge
,mergeByChunks
,foldl
,foldl'
,foldl1
,foldl1'
,sum
,product
,enumPureNChunk
,enumWith
,zip
,zip3
,zip4
,zip5
,sequence_
,countConsumed
,mapM_
,foldM
,module Data.Iteratee.Iteratee
)
where
import Prelude hiding (mapM_, null, head, last, drop, dropWhile, take, takeWhile, break, foldl, foldl1, length, filter, sum, product, zip, zip3, sequence_)
import qualified Prelude as Prelude
import qualified Data.ListLike as LL
import qualified Data.ListLike.FoldableLL as FLL
import Data.Iteratee.Iteratee
import Data.Monoid
import Control.Applicative ((<$>), (<*>), (<*))
import Control.Arrow (first, (***))
import Control.Monad (liftM, mplus)
import qualified Control.Monad as CM
import Control.Monad.Trans.Class
import Data.Word (Word8)
import qualified Data.ByteString as B
isFinished :: (Monad m, Nullable s) => Iteratee s m Bool
isFinished = icontP check
where
check c@(Chunk xs)
| nullC xs = (icontP check, c)
| otherwise = (idone False, c)
check s@(EOF _) = (idone True, s)
stream2list :: (Monad m, Nullable s, LL.ListLike s el) => Iteratee s m [el]
stream2list = liftM (concatMap LL.toList) getChunks
stream2stream :: (Monad m, Nullable s, Monoid s) => Iteratee s m s
stream2stream = liftM mconcat getChunks
break :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m s
break cpred = icontP (step mempty)
where
step bfr c@(Chunk str)
| LL.null str = (icontP (step bfr), c)
| otherwise = case LL.break cpred str of
(str', tail')
| LL.null tail' -> (icontP (step (bfr `mappend` str)), Chunk tail')
| otherwise -> (idone (bfr `mappend` str'), Chunk tail')
step bfr stream = (idone bfr, stream)
head :: (Monad m, LL.ListLike s el) => Iteratee s m el
head = icontP step
where
step c@(Chunk vec)
| LL.null vec = (icontP step, c)
| otherwise = (idone (LL.head vec), Chunk $ LL.tail vec)
step stream = (ierr (icontP step) (setEOF stream), stream)
tryHead :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe el)
tryHead = icontP step
where
step c@(Chunk vec)
| LL.null vec = (icontP step, c)
| otherwise = (idone (Just $ LL.head vec), Chunk $ LL.tail vec)
step stream = (idone Nothing, stream)
last :: (Monad m, LL.ListLike s el, Nullable s) => Iteratee s m el
last = icontP (step Nothing)
where
step l c@(Chunk xs)
| nullC xs = (icontP (step l), c)
| otherwise = (icontP $ step (Just $ LL.last xs), Chunk LL.empty)
step l s@(EOF _) = case l of
Nothing -> (ierr (icontP (step l)) (setEOF s), s)
Just x -> (idone x, s)
heads :: (Monad m, Nullable s, LL.ListLike s el, Eq el)
=> s
-> Iteratee s m Int
heads st | nullC st = return 0
heads st = loop 0 st
where
loop cnt xs
| nullC xs = return cnt
| otherwise = icontP (step cnt xs)
step cnt str (Chunk xs) | nullC xs = (icontP (step cnt str), Chunk xs)
step cnt str stream | nullC str = (idone cnt, stream)
step cnt str s@(Chunk xs) =
if LL.head str == LL.head xs
then step (succ cnt) (LL.tail str) (Chunk $ LL.tail xs)
else (idone cnt, s)
step cnt _ stream = (idone cnt, stream)
peek :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe el)
peek = icontP step
where
step s@(Chunk vec)
| LL.null vec = (icontP step, s)
| otherwise = (idone (Just $ LL.head vec), s)
step stream = (idone Nothing, stream)
roll
:: (Monad m, Functor m, Nullable s, LL.ListLike s el, LL.ListLike s' s)
=> Int
-> Int
-> Iteratee s m s'
roll t d | t > d = icontP step
where
step (Chunk vec)
| LL.length vec >= d =
(idone (LL.singleton $ LL.take t vec), Chunk $ LL.drop d vec)
| LL.length vec >= t =
(idone (LL.singleton $ LL.take t vec) <* drop (dLL.length vec)
,mempty)
| LL.null vec = (icontP step, mempty)
| otherwise = (icontP (step' vec), mempty)
step stream = (idone LL.empty, stream)
step' v1 (Chunk vec) = step . Chunk $ v1 `mappend` vec
step' v1 stream = (idone (LL.singleton v1), stream)
roll t d = LL.singleton <$> joinI (take t stream2stream) <* drop (dt)
drop :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()
drop 0 = idone ()
drop n' = icontP (step n')
where
step n (Chunk str)
| LL.length str < n = (icontP (step (n LL.length str)), mempty)
| otherwise = (idone (), Chunk (LL.drop n str))
step _ stream = (idone (), stream)
dropWhile :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m ()
dropWhile p = icontP step
where
step (Chunk str)
| LL.null left = (icontP step, mempty)
| otherwise = (idone (), Chunk left)
where
left = LL.dropWhile p str
step stream = (idone (), stream)
length :: (Monad m, Num a, LL.ListLike s el) => Iteratee s m a
length = icontP (step 0)
where
step !i (Chunk xs) = let newL = i + fromIntegral (LL.length xs)
in newL `seq` (icontP (step newL), mempty)
step !i stream = (idone i, stream)
chunkLength :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe Int)
chunkLength = icontP step
where
step s@(Chunk xs) = (idone (Just $ LL.length xs), s)
step stream = (idone Nothing, stream)
takeFromChunk ::
(Monad m, Nullable s, LL.ListLike s el)
=> Int
-> Iteratee s m s
takeFromChunk n | n <= 0 = idone empty
takeFromChunk n = icontP step
where
step (Chunk xs) = let (h,t) = LL.splitAt n xs in (idone h, Chunk t)
step stream = (idone empty, stream)
breakE
:: (LL.ListLike s el, NullPoint s, Monad m, Functor m)
=> (el -> Bool)
-> Enumeratee s s m a
breakE cpred = go
where
go = eneeCheckIfDonePass (icont . step)
step k (Chunk s)
| LL.null s = return (icont (step k), mempty)
| otherwise = case LL.break cpred s of
(str', tail')
| LL.null tail' -> do
(i', _) <- k (Chunk str')
return (go i' <* dropWhile (not . cpred), Chunk tail')
| otherwise -> (idone *** const (Chunk tail')) `liftM` k (Chunk str')
step k stream = return (idone (icont k), stream)
take ::
(Monad m, Nullable s, LL.ListLike s el)
=> Int
-> Enumeratee s s m a
take n' iter
| n' <= 0 = return iter
| otherwise = runIter iter onDone onCont onErr onReq
where
onDone x = drop n' >> idone (idone x)
onCont k = if n' == 0 then idone (icont k)
else icont (step n' k)
onErr i = ierr (take n' i)
onReq mb doB = ireq mb (take n' . doB)
step n k c@(Chunk str)
| LL.null str = return (icont (step n k), c)
| LL.length str <= n = (take (n LL.length str) *** const mempty)
`liftM` k (Chunk str)
| otherwise = (idone *** const (Chunk s2)) `liftM` k (Chunk s1)
where (s1, s2) = LL.splitAt n str
step _n k stream = return (idone (icont k), stream)
takeUpTo :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a
takeUpTo i iter
| i <= 0 = idone iter
| otherwise = runIter iter onDone onCont onErr onReq
where
onDone x = idone (idone x)
onCont k = if i == 0 then idone (icont k)
else icont (step i k)
onErr i' = ierr (takeUpTo i i')
onReq mb doB = ireq mb (takeUpTo i . doB)
step n k c@(Chunk str)
| LL.null str = return (icont (step n k), c)
| LL.length str < n = first (takeUpTo (n LL.length str))
`liftM` k (Chunk str)
| otherwise = do
let (s1, s2) = LL.splitAt n str
(iter', preStr) <- k (Chunk s1)
case preStr of
(Chunk preC)
| LL.null preC -> return (idone iter', Chunk s2)
| otherwise -> return (idone iter'
, Chunk $ preC `LL.append` s2)
_ -> return (idone iter', preStr)
step _ k stream = return (idone (icont k), stream)
takeWhile :: (Monad m, LL.ListLike s el ) => (el -> Bool) -> Iteratee s m s
takeWhile = break . (not .)
takeWhileE
:: (LL.ListLike s el, NullPoint s, Monad m, Functor m)
=> (el -> Bool)
-> Enumeratee s s m a
takeWhileE = breakE . (not .)
mapStream
:: (Monad m
,LL.ListLike (s el) el
,LL.ListLike (s el') el'
,NullPoint (s el)
,LooseMap s el el')
=> (el -> el')
-> Enumeratee (s el) (s el') m a
mapStream f = mapChunks (lMap f)
rigidMapStream
:: (Monad m, LL.ListLike s el, NullPoint s)
=> (el -> el)
-> Enumeratee s s m a
rigidMapStream f = mapChunks (LL.rigidMap f)
filter
:: (Monad m, Functor m, Nullable s, LL.ListLike s el)
=> (el -> Bool)
-> Enumeratee s s m a
filter p = convStream (LL.filter p <$> getChunk)
group
:: (LL.ListLike s el, Monad m, Nullable s)
=> Int
-> Enumeratee s [s] m a
group cksz iinit = icont (step 0 id iinit)
where
step sz pfxd icur (Chunk s)
| LL.null s = return (icont (step sz pfxd icur), Chunk s)
| LL.length s + sz < cksz = return (icont (step (sz+LL.length s)
(pfxd . (s:)) icur)
, mempty)
| otherwise =
let (full, rest) = gsplit . mconcat $ pfxd [s]
pfxd' = if LL.null rest then id else (rest:)
onDone x = return (idone (idone x), Chunk rest)
onErr i e = return (ierr (icont (step (LL.length rest) pfxd' i)) e
, Chunk rest)
onCont k = (icont . step (LL.length rest) pfxd'
*** const (Chunk rest))
`liftM` k (Chunk full)
onReq mb doB = mb >>= \b ->
step (LL.length rest) pfxd' (doB b) (Chunk rest)
in runIter icur onDone onCont onErr onReq
step _ pfxd icur mErr = case pfxd [] of
[] -> return (idone icur, mErr)
rest -> ((, mErr) . idone) `liftM`
enumPure1Chunk [mconcat rest] icur
gsplit ls = case LL.splitAt cksz ls of
(g, rest) | LL.null rest -> if LL.length g == cksz
then ([g], LL.empty)
else ([], g)
| otherwise -> let (grest, leftover) = gsplit rest
g' = g : grest
in (g', leftover)
groupBy
:: forall s el m a. (LL.ListLike s el, Monad m, Nullable s)
=> (el -> el -> Bool)
-> Enumeratee s [s] m a
groupBy same iinit = icont $ go iinit (const True, id)
where
go icurr pfx (Chunk s) = case gsplit pfx s of
([], partial) -> return (icont $ go icurr partial, mempty)
(full, partial) ->
let onCont k = k (Chunk full) >>= \(inext, str') ->
case str' of
Chunk rest -> return (icont $ go inext partial
, Chunk $ mconcat rest)
EOF mex -> return (icont $ go inext partial, EOF mex)
onErr inext e = return (ierr (icont (go inext partial)) e
, EOF (Just e))
onDone :: a -> m (Iteratee s m (Iteratee [s] m a), Stream s)
onDone a = return (idone (idone a)
, Chunk . mconcat $ snd partial [])
onReq mb doB = mb >>= \b -> go (doB b) pfx (Chunk s)
in runIter icurr onDone onCont onErr onReq
go icurr (_inpfx, pfxd) (EOF mex) = case pfxd [] of
[] -> ((,EOF mex) . idone) `liftM` enumChunk (EOF mex) icurr
rest -> ((,EOF mex) . idone) `liftM`
(enumPure1Chunk [mconcat rest] icurr >>= enumChunk (EOF mex))
gsplit (inpfx, pfxd) curr = case llGroupBy same curr of
[] -> ([], (inpfx, pfxd))
[g0] | inpfx (LL.head g0) -> ([], (same $ LL.head g0, pfxd . (g0 :)))
| otherwise -> ([mconcat $ pfxd []], (same $ LL.head g0, pfxd . (g0 :)))
(g0:grest@(_:_)) | inpfx (LL.head g0) -> let glast = Prelude.last grest
gfirst = mconcat $ (pfxd . (g0 :)) []
gdone = gfirst : Prelude.init grest
in ( gdone, (same (LL.head glast), (glast :)) )
| otherwise -> let glast = Prelude.last grest
gfirst = mconcat $ pfxd []
gdone = gfirst : Prelude.init grest
in ( gdone, (same (LL.head glast), (glast :)) )
llGroupBy eq l
| LL.null l = []
| otherwise = LL.cons x ys : llGroupBy eq zs
where (ys, zs) = LL.span (eq x) xs
x = LL.head l
xs = LL.tail l
merge ::
(LL.ListLike s1 el1
,LL.ListLike s2 el2
,Nullable s1
,Nullable s2
,Monad m
,Functor m)
=> (el1 -> el2 -> b)
-> Enumeratee s2 b (Iteratee s1 m) a
merge f = convStream $ f <$> lift head <*> head
mergeByChunks ::
(Nullable c2, Nullable c1
,NullPoint c2, NullPoint c1
,LL.ListLike c1 el1, LL.ListLike c2 el2
,Functor m, Monad m)
=> (c1 -> c2 -> c3)
-> (c1 -> c3)
-> (c2 -> c3)
-> Enumeratee c2 c3 (Iteratee c1 m) a
mergeByChunks f f1 f2 = unfoldConvStream iter (0 :: Int)
where
iter 1 = (1,) . f1 <$> lift getChunk
iter 2 = (2,) . f2 <$> getChunk
iter _ = do
ml1 <- lift chunkLength
ml2 <- chunkLength
case (ml1, ml2) of
(Just l1, Just l2) -> do
let tval = min l1 l2
c1 <- lift $ takeFromChunk tval
c2 <- takeFromChunk tval
return (0, f c1 c2)
(Just _, Nothing) -> iter 1
(Nothing, _) -> iter 2
foldl
:: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)
=> (a -> el -> a)
-> a
-> Iteratee s m a
foldl f i = icontP (step i)
where
step acc c@(Chunk xs)
| LL.null xs = (icontP (step acc), c)
| otherwise = (icontP (step $ FLL.foldl f acc xs), mempty)
step acc stream = (idone acc, stream)
foldl'
:: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)
=> (a -> el -> a)
-> a
-> Iteratee s m a
foldl' f i = icontP (step i)
where
step acc c@(Chunk xs)
| LL.null xs = (icontP (step acc), c)
| otherwise = (icontP (step $! FLL.foldl' f acc xs), mempty)
step acc stream = (idone acc, stream)
foldl1
:: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)
=> (el -> el -> el)
-> Iteratee s m el
foldl1 f = icontP step
where
step c@(Chunk xs)
| LL.null xs = (icontP step, c)
| otherwise = (foldl f $ FLL.foldl1 f xs, mempty)
step stream = (ierr (icontP step) $ toException EofException
, stream)
foldl1'
:: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)
=> (el -> el -> el)
-> Iteratee s m el
foldl1' f = icontP step
where
step c@(Chunk xs)
| LL.null xs = (icontP step, c)
| otherwise = (foldl' f $ FLL.foldl1 f xs, mempty)
step stream = (ierr (icontP step) $ toException EofException
, stream)
sum :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el
sum = icontP (step 0)
where
step acc c@(Chunk xs)
| LL.null xs = (icontP (step acc), c)
| otherwise = (icontP (step $! acc + LL.sum xs), mempty)
step acc str = (idone acc, str)
product :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el
product = icontP (step 1)
where
step acc c@(Chunk xs)
| LL.null xs = (icontP (step acc), c)
| otherwise = (icontP (step $! acc * LL.product xs), mempty)
step acc str = (idone acc, str)
zip
:: (Monad m, Nullable s, LL.ListLike s el)
=> Iteratee s m a
-> Iteratee s m b
-> Iteratee s m (a, b)
zip x0 y0 = runIter x0 (odx y0) (ocx y0) (oex y0) (orx y0)
where
odx yIter a = (a, ) `liftM` yIter
ocx yIter k = runIter yIter (ody k) (ocy k) (oey k) (ory k)
oex yIter i' e = throwRec e (zip i' yIter)
orx yIter ma doA = ireq ma $ (`zip` yIter) . doA
ody x_k b = (,b) `liftM` icont x_k
ocy xK yK = icont (step xK yK)
oey xK i' e = throwRec e (zip (icont xK) i')
ory xK mb doB = ireq mb (zip (icont xK) . doB)
step xK yK (Chunk xs) | nullC xs = return (icont (step xK yK), Chunk xs)
step xK yK str = do
(x,xLeft) <- xK str
(y,yLeft) <- yK str
return (zip x y, shorter xLeft yLeft)
shorter c1@(Chunk xs) c2@(Chunk ys)
| LL.length xs < LL.length ys = c1
| otherwise = c2
shorter e@(EOF _) _ = e
shorter _ e@(EOF _) = e
zip3
:: (Monad m, Nullable s, LL.ListLike s el)
=> Iteratee s m a -> Iteratee s m b
-> Iteratee s m c -> Iteratee s m (a, b, c)
zip3 a b c = zip a (zip b c) >>=
\(r1, (r2, r3)) -> return (r1, r2, r3)
zip4
:: (Monad m, Nullable s, LL.ListLike s el)
=> Iteratee s m a -> Iteratee s m b
-> Iteratee s m c -> Iteratee s m d
-> Iteratee s m (a, b, c, d)
zip4 a b c d = zip a (zip3 b c d) >>=
\(r1, (r2, r3, r4)) -> return (r1, r2, r3, r4)
zip5
:: (Monad m, Nullable s, LL.ListLike s el)
=> Iteratee s m a -> Iteratee s m b
-> Iteratee s m c -> Iteratee s m d
-> Iteratee s m e -> Iteratee s m (a, b, c, d, e)
zip5 a b c d e = zip a (zip4 b c d e) >>=
\(r1, (r2, r3, r4, r5)) -> return (r1, r2, r3, r4, r5)
enumWith
:: (Monad m, Nullable s, LL.ListLike s el)
=> Iteratee s m a
-> Iteratee s m b
-> Iteratee s m (a, b)
enumWith x0 y0 = runIter x0 (odx y0) (ocx y0) (oex y0) (orx y0)
where
odx yIter a = (a,) `liftM` joinIM (enumEof yIter)
ocx yIter k = runIter yIter (ody k) (ocy k) (oey k) (ory k)
oex yIter i' e = throwRec e (enumWith i' yIter)
orx yIter ma doA = ireq ma $ (`enumWith` yIter) . doA
ody x_k b = (,b) `liftM` icont x_k
ocy xK yK = icont (step xK yK)
oey xK i' e = throwRec e (enumWith (icont xK) i')
ory xK mb doB = ireq mb (enumWith (icont xK) . doB)
step xK yK (Chunk xs) | nullC xs = return (icont (step xK yK), Chunk xs)
step xK yK str = do
(x, xLeft) <- xK str
(y,_yLeft) <- yK str
return (enumWith x y, xLeft)
sequence_
:: forall el s m a. (Monad m, LL.ListLike s el, Nullable s)
=> [Iteratee s m a]
-> Iteratee s m ()
sequence_ = check []
where
check [] [] = idone ()
check ks [] = icont (step ks)
check ks (i:iters) = runIter i (\_ -> check ks iters)
(onCont ks iters)
(onErr ks iters)
(onReq ks iters)
onCont ks iters k = check (k:ks) iters
onErr ks iters i e = throwRec e (check ks (i:iters))
onReq :: [Stream s -> m (Iteratee s m a, Stream s)]
-> [Iteratee s m a]
-> m b
-> (b -> Iteratee s m a)
-> Iteratee s m ()
onReq ks iters mb doB = ireq mb (\b -> check ks (doB b:iters))
step ks str = first (check []) `liftM` CM.foldM (accf str) ([], str) ks
accf str (iS, !strs) k = ((:iS) *** flip shorter strs) `liftM` k str
shorter c1@(Chunk xs) c2@(Chunk ys)
| LL.length xs < LL.length ys = c1
| otherwise = c2
shorter (EOF e1 ) (EOF e2 ) = EOF (e1 `mplus` e2)
shorter e@(EOF _) _ = e
shorter _ e@(EOF _) = e
countConsumed :: forall a s el m n.
(Monad m, LL.ListLike s el, Nullable s, Integral n) =>
Iteratee s m a
-> Iteratee s m (a, n)
countConsumed = check 0
where
newLen :: n -> s -> s -> n
newLen n c c' = n + fromIntegral (LL.length c LL.length c')
check :: n -> Iteratee s m a -> Iteratee s m (a,n)
check !n iter = runIter iter (onDone n)
(onCont n)
(onErr n)
(onReq n)
step !n k str@(Chunk c) = k str >>= \res -> return $ case res of
(i, Chunk c') -> (check (newLen n c c') i, Chunk c')
(i, str'@(EOF (Just e))) -> (throwRec e (check (newLen n c mempty) i)
, str')
(i, str') -> (throwRec EofException
(check (newLen n c mempty) i), str')
step n k str = first (liftM (,n)) `liftM` k str
onDone n a = idone (a,n)
onCont n k = icont (step n k)
onErr n i e = throwRec e (check n i)
onReq n mb doB = ireq mb (check n . doB)
enumPureNChunk :: (Monad m, LL.ListLike s el) => s -> Int -> Enumerator s m a
enumPureNChunk str n iter
| LL.null str = return iter
| n > 0 = enum' str iter
| otherwise = error $ "enumPureNChunk called with n==" ++ show n
where
enum' str' iter'
| LL.null str' = return iter'
| otherwise = let (s1, s2) = LL.splitAt n str'
onCont k = k (Chunk s1) >>= enum' s2 . fst
onErr i' e = return $ ierr i' e
onReq mb doB = mb >>= enum' str' . doB
in runIter iter' idoneM onCont onErr onReq
mapM_
:: (Monad m, LL.ListLike s el, Nullable s)
=> (el -> m b)
-> Iteratee s m ()
mapM_ f = icont step
where
step c@(Chunk xs) | LL.null xs = return (icont step, c)
step (Chunk xs) = LL.mapM_ f xs >> return (icont step, mempty)
step s@(EOF _) = return (idone (), s)
foldM
:: (Monad m, LL.ListLike s b, Nullable s)
=> (a -> b -> m a)
-> a
-> Iteratee s m a
foldM f e = icont (step e)
where
step acc c@(Chunk xs) | LL.null xs = return (icont (step acc), c)
step acc (Chunk xs) = CM.foldM f acc (LL.toList xs) >>= \acc' ->
return (icont (step acc'), mempty)
step acc stream = return (idone acc, stream)