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
,enumPair
,enumWith
,zip
,zip3
,zip4
,zip5
,sequence_
,countConsumed
,greedy
,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 Data.List (partition)
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.Monad (liftM, liftM2, mplus, (<=<))
import Control.Monad.Trans.Class
import Data.Word (Word8)
import qualified Data.ByteString as B
isFinished :: (Nullable s) => Iteratee s m Bool
isFinished = liftI check
where
check c@(Chunk xs)
| nullC xs = liftI check
| 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 :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m s
break cpred = icont (step mempty) Nothing
where
step bfr (Chunk str)
| LL.null str = icont (step bfr) Nothing
| otherwise = case LL.break cpred str of
(str', tail')
| LL.null tail' -> icont (step (bfr `mappend` str)) Nothing
| otherwise -> idone (bfr `mappend` str') (Chunk tail')
step bfr stream = idone bfr stream
head :: (LL.ListLike s el) => Iteratee s m el
head = liftI step
where
step (Chunk vec)
| LL.null vec = icont step Nothing
| otherwise = idone (LL.head vec) (Chunk $ LL.tail vec)
step stream = icont step (Just (setEOF stream))
tryHead :: (LL.ListLike s el) => Iteratee s m (Maybe el)
tryHead = liftI step
where
step (Chunk vec)
| LL.null vec = liftI step
| otherwise = idone (Just $ LL.head vec) (Chunk $ LL.tail vec)
step stream = idone Nothing stream
last :: (LL.ListLike s el, Nullable s) => Iteratee s m el
last = liftI (step Nothing)
where
step l (Chunk xs)
| nullC xs = liftI (step l)
| otherwise = liftI $ step (Just $ LL.last xs)
step l s@(EOF _) = case l of
Nothing -> icont (step l) . Just . setEOF $ 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 = liftI (step cnt xs)
step cnt str (Chunk xs) | nullC xs = liftI (step cnt str)
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 :: (LL.ListLike s el) => Iteratee s m (Maybe el)
peek = liftI step
where
step s@(Chunk vec)
| LL.null vec = liftI step
| 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 = liftI step
where
step (Chunk vec)
| LL.length vec >= t =
idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec)
| LL.null vec = liftI step
| otherwise = liftI (step' vec)
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 :: (Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()
drop 0 = idone () (Chunk empty)
drop n' = liftI (step n')
where
step n (Chunk str)
| LL.length str < n = liftI (step (n LL.length str))
| otherwise = idone () (Chunk (LL.drop n str))
step _ stream = idone () stream
dropWhile :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m ()
dropWhile p = liftI step
where
step (Chunk str)
| LL.null left = liftI step
| otherwise = idone () (Chunk left)
where
left = LL.dropWhile p str
step stream = idone () stream
length :: (Num a, LL.ListLike s el) => Iteratee s m a
length = liftI (step 0)
where
step !i (Chunk xs) = liftI (step $ i + fromIntegral (LL.length xs))
step !i stream = idone i stream
chunkLength :: (LL.ListLike s el) => Iteratee s m (Maybe Int)
chunkLength = liftI step
where
step s@(Chunk xs) = idone (Just $ LL.length xs) s
step stream = idone Nothing stream
takeFromChunk ::
(Nullable s, LL.ListLike s el)
=> Int
-> Iteratee s m s
takeFromChunk n | n <= 0 = idone empty (Chunk empty)
takeFromChunk n = liftI 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)
=> (el -> Bool)
-> Enumeratee s s m a
breakE cpred = eneeCheckIfDonePass (icont . step)
where
step k (Chunk s)
| LL.null s = liftI (step k)
| otherwise = case LL.break cpred s of
(str', tail')
| LL.null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'
| otherwise -> idone (k $ Chunk str') (Chunk tail')
step k stream = idone (liftI 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 = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)
where
on_done od oc x _ = runIter (drop n' >> return (return x)) od oc
on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)
else runIter (liftI (step n' k)) od oc
on_cont od oc _ (Just e) = runIter (drop n' >> throwErr e) od oc
step n k (Chunk str)
| LL.null str = liftI (step n k)
| LL.length str <= n = take (n LL.length str) $ k (Chunk str)
| otherwise = idone (k (Chunk s1)) (Chunk s2)
where (s1, s2) = LL.splitAt n str
step _n k stream = idone (liftI k) stream
takeUpTo :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a
takeUpTo i iter
| i <= 0 = idone iter (Chunk empty)
| otherwise = Iteratee $ \od oc ->
runIter iter (onDone od oc) (onCont od oc)
where
onDone od oc x str = runIter (idone (return x) str) od oc
onCont od oc k Nothing = if i == 0 then od (liftI k) (Chunk mempty)
else runIter (liftI (step i k)) od oc
onCont od oc _ (Just e) = runIter (throwErr e) od oc
step n k (Chunk str)
| LL.null str = liftI (step n k)
| LL.length str < n = takeUpTo (n LL.length str) $ k (Chunk str)
| otherwise =
let (s1, s2) = LL.splitAt n str
in Iteratee $ \od' _ -> do
res <- runIter (k (Chunk s1)) (\a s -> return $ Left (a, s))
(\k' e -> return $ Right (k',e))
case res of
Left (a,Chunk s1') -> od' (return a)
(Chunk $ s1' `LL.append` s2)
Left (a,s') -> od' (idone a s') (Chunk s2)
Right (k',e) -> od' (icont k' e) (Chunk s2)
step _ k stream = idone (liftI k) stream
takeWhile :: (LL.ListLike s el ) => (el -> Bool) -> Iteratee s m s
takeWhile = break . (not .)
takeWhileE
:: (LL.ListLike s el, NullPoint s)
=> (el -> Bool)
-> Enumeratee s s m a
takeWhileE = breakE . (not .)
mapStream
:: (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
:: (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 = liftI (step 0 id iinit)
where
step sz pfxd icur (Chunk s)
| LL.null s = liftI (step sz pfxd icur)
| LL.length s + sz < cksz = liftI (step (sz+LL.length s) (pfxd . (s:)) icur)
| otherwise =
let (full, rest) = gsplit . mconcat $ pfxd [s]
pfxd' = if LL.null rest then id else (rest:)
onDone x str = return $ Left (x,str)
onCont k Nothing = return . Right . Left . k $ Chunk full
onCont k e = return . Right $ Right (liftI k, e)
in do
res <- lift $ runIter icur onDone onCont
case res of
Left (x,str) -> idone (idone x str) (Chunk rest)
Right (Left inext) -> liftI $ step (LL.length rest) pfxd' inext
Right (Right (inext, e)) -> icont (step (LL.length rest)
pfxd' inext)
e
step _ pfxd icur mErr = case pfxd [] of
[] -> idone icur mErr
rest -> do
inext <- lift $ enumPure1Chunk [mconcat rest] icur
idone inext mErr
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
:: (LL.ListLike s el, Monad m, Nullable s)
=> (el -> el -> Bool)
-> Enumeratee s [s] m a
groupBy same iinit = liftI $ go iinit (const True, id)
where
go icurr pfx (Chunk s) = case gsplit pfx s of
([], partial) -> liftI $ go icurr partial
(full, partial) -> do
let onCont k Nothing = return $ Right $ Left $ k $ Chunk full
onCont k e = return $ Right $ Right (liftI k, e)
onDone x str = return $ Left (x,str)
res <- lift $ runIter icurr onDone onCont
case res of
Left (x,str) -> idone (idone x str) (Chunk (mconcat $ snd partial []))
Right (Left inext) -> liftI $ go inext partial
Right (Right (inext,e)) -> icont (go inext partial) e
go icurr (_inpfx, pfxd) (EOF mex) = case pfxd [] of
[] -> lift . enumChunk (EOF mex) $ icurr
rest -> do inext <- lift . enumPure1Chunk [mconcat rest] $ icurr
lift . enumChunk (EOF mex) $ inext
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
:: (LL.ListLike s el, FLL.FoldableLL s el)
=> (a -> el -> a)
-> a
-> Iteratee s m a
foldl f i = liftI (step i)
where
step acc (Chunk xs)
| LL.null xs = liftI (step acc)
| otherwise = liftI (step $ FLL.foldl f acc xs)
step acc stream = idone acc stream
foldl'
:: (LL.ListLike s el, FLL.FoldableLL s el)
=> (a -> el -> a)
-> a
-> Iteratee s m a
foldl' f i = liftI (step i)
where
step acc (Chunk xs)
| LL.null xs = liftI (step acc)
| otherwise = liftI (step $! FLL.foldl' f acc xs)
step acc stream = idone acc stream
foldl1
:: (LL.ListLike s el, FLL.FoldableLL s el)
=> (el -> el -> el)
-> Iteratee s m el
foldl1 f = liftI step
where
step (Chunk xs)
| LL.null xs = liftI step
| otherwise = foldl f $ FLL.foldl1 f xs
step stream = icont step (Just (setEOF stream))
foldl1'
:: (LL.ListLike s el, FLL.FoldableLL s el)
=> (el -> el -> el)
-> Iteratee s m el
foldl1' f = liftI step
where
step (Chunk xs)
| LL.null xs = liftI step
| otherwise = foldl' f $ FLL.foldl1 f xs
step stream = icont step (Just (setEOF stream))
sum :: (LL.ListLike s el, Num el) => Iteratee s m el
sum = liftI (step 0)
where
step acc (Chunk xs)
| LL.null xs = liftI (step acc)
| otherwise = liftI (step $! acc + LL.sum xs)
step acc str = idone acc str
product :: (LL.ListLike s el, Num el) => Iteratee s m el
product = liftI (step 1)
where
step acc (Chunk xs)
| LL.null xs = liftI (step acc)
| otherwise = liftI (step $! acc * LL.product xs)
step acc str = idone acc str
enumPair
:: (Monad m, Nullable s, LL.ListLike s el)
=> Iteratee s m a
-> Iteratee s m b
-> Iteratee s m (a, b)
enumPair = zip
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 = do
(a', x') <- lift $ runIter x0 od oc
(b', y') <- lift $ runIter y0 od oc
case checkDone a' b' of
Just (Right (a,b,s)) -> idone (a,b) s
Just (Left (Left a)) -> liftM (a,) y'
Just (Left (Right b)) -> liftM (,b) x'
Nothing -> liftI (step x' y')
where
step x y (Chunk xs) | nullC xs = liftI (step x y)
step x y (Chunk xs) = do
(a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x
(b', y') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs y
case checkDone a' b' of
Just (Right (a,b,s)) -> idone (a,b) s
Just (Left (Left a)) -> liftM (a,) y'
Just (Left (Right b)) -> liftM (,b) x'
Nothing -> liftI (step x' y')
step x y (EOF err) = joinIM $ case err of
Nothing -> (liftM2.liftM2) (,) (enumEof x) (enumEof y)
Just e -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)
od a s = return (Just (a, s), idone a s)
oc k e = return (Nothing , icont k e)
checkDone r1 r2 = case (r1, r2) of
(Just (a, s1), Just (b,s2)) -> Just $ Right (a, b, shorter s1 s2)
(Just (a, _), Nothing) -> Just . Left $ Left a
(Nothing, Just (b, _)) -> Just . Left $ Right b
(Nothing, Nothing) -> Nothing
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 i1 i2 = do
(a', x') <- lift $ runIter i1 od oc
(_, y') <- lift $ runIter i2 od oc
case a' of
Just (a, s) -> flip idone s =<< lift (liftM (a,) $ run i2)
Nothing -> go x' y'
where
od a s = return (Just (a, s), idone a s)
oc k e = return (Nothing , icont k e)
getUsed xs (Chunk ys) = LL.take (LL.length xs LL.length ys) xs
getUsed xs (EOF _) = xs
go x y = liftI step
where
step (Chunk xs) | nullC xs = liftI step
step (Chunk xs) = do
(a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x
case a' of
Just (a, s) -> do
b <- lift $ run =<< enumPure1Chunk (getUsed xs s) y
idone (a, b) s
Nothing -> lift (enumPure1Chunk xs y) >>= go x'
step (EOF err) = joinIM $ case err of
Nothing -> (liftM2.liftM2) (,) (enumEof x) (enumEof y)
Just e -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)
sequence_
:: (Monad m, LL.ListLike s el, Nullable s)
=> [Iteratee s m a]
-> Iteratee s m ()
sequence_ = self
where
self is = liftI step
where
step (Chunk xs) | LL.null xs = liftI step
step s@(Chunk _) = do
is' <- lift $ mapM (enumChunk s) is
(done, notDone) <- lift $ partition fst `liftM` mapM enumCheckIfDone is'
if Prelude.null notDone
then idone () <=< remainingStream $ map snd done
else self $ map snd notDone
step s@(EOF _) = do
s' <- remainingStream <=< lift $ mapM (enumChunk s) is
case s' of
EOF (Just e) -> throwErr e
_ -> idone () s'
remainingStream
:: (Monad m, Nullable s, LL.ListLike s el)
=> [Iteratee s m a] -> Iteratee s m (Stream s)
remainingStream is = lift $
return . Prelude.foldl1 shorter <=< mapM (\i -> runIter i od oc) $ is
where
od _ s = return s
oc _ e = return $ case e of
Nothing -> mempty
_ -> EOF e
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 i = go 0 (const i) (Chunk empty)
where
go :: n -> (Stream s -> Iteratee s m a) -> Stream s
-> Iteratee s m (a, n)
go !n f str@(EOF _) = (, n) `liftM` f str
go !n f str@(Chunk c) = Iteratee rI
where
newLen = n + fromIntegral (LL.length c)
rI od oc = runIter (f str) onDone onCont
where
onDone a str'@(Chunk c') =
od (a, newLen fromIntegral (LL.length c')) str'
onDone a str'@(EOF _) = od (a, n) str'
onCont f' mExc = oc (go newLen f') mExc
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'
on_cont k Nothing = enum' s2 . k $ Chunk s1
on_cont k e = return $ icont k e
in runIter iter' idoneM on_cont
greedy ::
(Monad m, Functor m, LL.ListLike s el', Monoid a) =>
Iteratee s m a
-> Iteratee s m a
greedy iter' = liftI (step [] iter')
where
step acc iter (Chunk str)
| LL.null str = liftI (step acc iter)
| otherwise = joinIM $ do
i2 <- enumPure1Chunk str iter
result <- runIter i2 (\a s -> return $ Left (a,s))
(\k e -> return $ Right (icont k e))
case result of
Left (a, Chunk resS)
| LL.null resS
|| LL.length resS == LL.length str -> return $
idone (mconcat $ reverse (a:acc)) (Chunk resS)
Left (a, stream) -> return $ step (a:acc) iter stream
Right i -> return $ fmap (mconcat . reverse . (:acc)) i
step acc iter stream = joinIM $
enumChunk stream (fmap (mconcat . reverse . (:acc)) iter)
mapM_
:: (Monad m, LL.ListLike s el, Nullable s)
=> (el -> m b)
-> Iteratee s m ()
mapM_ f = liftI step
where
step (Chunk xs) | LL.null xs = liftI step
step (Chunk xs) = lift (LL.mapM_ f xs) >> liftI step
step s@(EOF _) = idone () s
foldM
:: (Monad m, LL.ListLike s b, Nullable s)
=> (a -> b -> m a)
-> a
-> Iteratee s m a
foldM f e = liftI step
where
step (Chunk xs) | LL.null xs = liftI step
step (Chunk xs) = do
x <- lift $ f e (LL.head xs)
joinIM $ enumPure1Chunk (LL.tail xs) (foldM f x)
step (EOF _) = return e