module Data.Iteratee.ListLike (
isFinished
,stream2list
,stream2stream
,break
,dropWhile
,drop
,head
,last
,heads
,peek
,roll
,length
,take
,takeUpTo
,mapStream
,rigidMapStream
,filter
,foldl
,foldl'
,foldl1
,foldl1'
,sum
,product
,enumPureNChunk
,enumPair
,module Data.Iteratee.Iteratee
)
where
import Prelude hiding (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 + LL.length xs)
step !i stream = idone (fromIntegral i) 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'
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