module Data.Iteratee.ListLike (
isFinished
,stream2list
,stream2stream
,break
,dropWhile
,drop
,head
,last
,heads
,peek
,roll
,length
,breakE
,take
,takeUpTo
,mapStream
,rigidMapStream
,filter
,group
,groupBy
,foldl
,foldl'
,foldl1
,foldl1'
,sum
,product
,enumPureNChunk
,enumPair
,mapM_
,foldM
,module Data.Iteratee.Iteratee
)
where
import Prelude hiding (mapM_, null, head, last, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product)
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.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
| True = idone False c
check s@(EOF _) = idone True s
stream2list :: (Monad m, Nullable s, LL.ListLike s el) => Iteratee s m [el]
stream2list = liftI (step [])
where
step acc (Chunk ls)
| nullC ls = liftI (step acc)
| True = liftI (step (acc ++ LL.toList ls))
step acc str = idone acc str
stream2stream :: (Monad m, Nullable s, Monoid s) => Iteratee s m s
stream2stream = icont (step mempty) Nothing
where
step acc (Chunk ls)
| nullC ls = icont (step acc) Nothing
| True = icont (step (acc `mappend` ls)) Nothing
step acc str = idone acc str
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
| True = case LL.break cpred str of
(str', tail')
| LL.null tail' -> icont (step (bfr `mappend` str)) Nothing
| True -> 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
| True = idone (LL.head vec) (Chunk $ LL.tail vec)
step stream = icont step (Just (setEOF 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 _) = maybe (icont (step l) . Just . setEOF $ s) return l
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
| True = 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
| True = 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
| True = 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))
| True = 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
| True = 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
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
| True = 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)
| True = 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 _ = runIter (return (return x)) 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)
| True = idone (k (Chunk s1)) (Chunk s2)
where (s1, s2) = LL.splitAt n str
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 = eneeCheckIfDone (liftI . step)
where
step k (Chunk xs)
| LL.null xs = liftI (step k)
| True = mapStream f $ k (Chunk $ lMap f xs)
step k s = idone (liftI k) s
rigidMapStream ::
(Monad m, LL.ListLike s el, NullPoint s) =>
(el -> el)
-> Enumeratee s s m a
rigidMapStream f = eneeCheckIfDone (liftI . step)
where
step k (Chunk xs)
| LL.null xs = liftI (step k)
| True = rigidMapStream f $ k (Chunk $ LL.rigidMap f xs)
step k s = idone (liftI k) s
filter ::
(Monad m, Nullable s, LL.ListLike s el) =>
(el -> Bool)
-> Enumeratee s s m a
filter p = convStream f'
where
f' = icont step Nothing
step (Chunk xs)
| LL.null xs = f'
| True = idone (LL.filter p xs) mempty
step _ = f'
group :: (LL.ListLike s el, Monad m, Nullable s) =>
Int -> Enumeratee s [s] m a
group sz iinit = liftI $ go iinit LL.empty
where go icurr pfx (Chunk s) = case gsplit (pfx `LL.append` s) of
(full, partial) | LL.null full -> liftI $ go icurr partial
| otherwise -> do inext <- lift $ enumPure1Chunk full icurr
liftI $ go inext partial
go icurr pfx (EOF mex)
| LL.null pfx = lift . enumChunk (EOF mex) $ icurr
| otherwise = do inext <- lift $ enumPure1Chunk (LL.singleton pfx) icurr
lift . enumChunk (EOF mex) $ inext
gsplit ls = case LL.splitAt sz ls of
(g, rest) | LL.null rest -> if LL.length g == sz
then (LL.singleton g, LL.empty)
else (LL.empty, g)
| otherwise -> let (grest, leftover) = gsplit rest
g' = g `LL.cons` grest
in g' `seq` (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 LL.empty
where go icurr pfx (Chunk s) = case gsplit (pfx `LL.append` s) of
(full, partial)
| LL.null full -> liftI $ go icurr partial
| otherwise -> do inext <- lift . enumPure1Chunk full $ icurr
liftI $ go inext partial
go icurr pfx (EOF mex)
| LL.null pfx = lift . enumChunk (EOF mex) $ icurr
| otherwise = do inext <- lift . enumPure1Chunk (LL.singleton pfx) $ icurr
lift . enumChunk (EOF mex) $ inext
gsplit ll | LL.null ll = (LL.empty, LL.empty)
| otherwise = let groups = llGroupBy same ll
full = LL.init groups
partial = LL.last groups
in full `seq` partial `seq` (full, partial)
llGroupBy eq l
| LL.null l = LL.empty
| otherwise = LL.cons (LL.cons x ys) (llGroupBy eq zs)
where (ys, zs) = LL.span (eq x) xs
x = LL.head l
xs = LL.tail l
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)
| True = 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)
| True = 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
| True = 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
| True = 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)
| True = 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)
| True = 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 i1 i2 = Iteratee $ \od oc -> runIter i1 (onDone od oc) (onCont od oc)
where
onDone od oc x s = runIter i2 (oD12 od oc x s) (onCont' od oc x)
oD12 od oc x1 s1 x2 s2 = runIter (idone (x1,x2) (longest s1 s2)) od oc
onCont od oc k mErr = runIter (icont (step k) mErr) od oc
where
onCont' od oc x1 k mErr = runIter (icont (step2 x1 k) mErr) od oc
step k c@(Chunk str)
| nullC str = liftI (step k)
| True = lift (enumPure1Chunk str i2) >>= enumPair (k c)
step k s@(EOF Nothing) = lift (enumEof i2) >>= enumPair (k s)
step k s@(EOF (Just e)) = lift (enumErr e i2) >>= enumPair (k s)
step2 x1 k (Chunk str)
| nullC str = liftI (step2 x1 k)
step2 x1 k str = enumPair (return x1) (k str)
longest c1@(Chunk xs) c2@(Chunk ys) = if LL.length xs > LL.length ys
then c1 else c2
longest e@(EOF _) _ = e
longest _ 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
| True = error $ "enumPureNChunk called with n==" ++ show n
where
enum' str' iter'
| LL.null str' = return iter'
| True = 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