module Data.Iteratee.ListLike (
isFinished
,stream2list
,stream2stream
,break
,dropWhile
,drop
,head
,tryHead
,last
,heads
,peek
,roll
,length
,chunkLength
,takeFromChunk
,breakE
,take
,takeUpTo
,mapStream
,rigidMapStream
,filter
,group
,groupBy
,merge
,mergeByChunks
,foldl
,foldl'
,foldl1
,foldl1'
,sum
,product
,enumPureNChunk
,enumPair
,enumWith
,zip
,zip3
,zip4
,zip5
,sequence_
,mapM_
,foldM
,module Data.Iteratee.Iteratee
)
where
import Prelude hiding (mapM_, null, head, last, drop, dropWhile, take, 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 Data.Maybe (catMaybes)
import Control.Applicative ((<$>), (<*>), (<*))
import Control.Monad (liftM, liftM2, mplus, (<=<))
import Control.Monad.Trans.Class
import Data.Word (Word8)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
isFinished :: (Monad m, 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 :: (Monad m, 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 :: (Monad m, 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 :: (Monad m, 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 :: (Monad m, 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 :: (Monad m, 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 >= d =
idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec)
| LL.length vec >= t =
idone (LL.singleton $ LL.take t vec) mempty <* drop (dLL.length 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 :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()
drop 0 = return ()
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 :: (Monad m, 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 :: (Monad m, 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 :: (Monad m, 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 ::
(Monad m, Nullable s, LL.ListLike s el)
=> Int
-> Iteratee s m s
takeFromChunk n | n <= 0 = return 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
:: (Monad m, LL.ListLike s el, NullPoint s)
=> (el -> Bool)
-> Enumeratee s s m a
breakE cpred = eneeCheckIfDone (liftI . step)
where
step k (Chunk s)
| LL.null s = liftI (step k)
| otherwise = case LL.break cpred s of
(str', tail')
| LL.null tail' -> eneeCheckIfDone (liftI . step) . k $ Chunk str'
| otherwise -> idone (k $ Chunk str') (Chunk tail')
step k stream = idone (k stream) 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 (k stream) stream
takeUpTo :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a
takeUpTo i iter
| i <= 0 = return iter
| 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 (k stream) stream
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 = 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:)
in do
inext <- lift $ enumPure1Chunk full icur
liftI $ step (LL.length rest) pfxd' inext
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 inext <- lift $ enumPure1Chunk full icurr
liftI $ go inext partial
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
:: (Monad m, 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'
:: (Monad m, 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
:: (Monad m, 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'
:: (Monad m, 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 :: (Monad m, 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 :: (Monad m, 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 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
(b', y') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs y
case checkDone a' b' of
Just (a, b, s) -> idone (a, b) s
Nothing -> zip x' y'
step (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 =
r1 >>= \(a, s1) -> r2 >>= \(b, s2) ->
return (a, b, shorter s1 s2)
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 = go i1 i2
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
is'' <- lift $ catMaybes `liftM` mapM checkIfDone is'
if Prelude.null is''
then idone () <=< remainingStream $ is'
else self is''
step s@(EOF _) = do
s' <- remainingStream <=< lift $ mapM (enumChunk s) is
case s' of
EOF (Just e) -> throwErr e
_ -> idone () s'
checkIfDone i = runIter i
(\_ _ -> return Nothing)
(\k e -> return $ Just $ icont k e)
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
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
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