module Bio.Iteratee.List (
isFinished
,stream2list
,stream2stream
,dropWhileStream
,dropStream
,headStream
,tryHead
,lastStream
,heads
,peekStream
,roll
,lengthStream
,chunkLength
,takeFromChunk
,breakStream
,breakE
,takeStream
,takeUpTo
,takeWhileE
,mapStream
,concatMapStream
,concatMapStreamM
,mapMaybeStream
,filterStream
,filterStreamM
,groupStreamBy
,groupStreamOn
,mergeStreams
,mergeByChunks
,foldStream
,enumPureNChunk
,enumWith
,zipStreams
,zipStreams3
,zipStreams4
,zipStreams5
,sequenceStreams_
,countConsumed
,mapStreamM
,mapStreamM_
,foldStreamM
,module Bio.Iteratee.Iteratee
)
where
import Bio.Iteratee.Iteratee
import Bio.Prelude
import Control.Monad.Trans.Class
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 => Iteratee [el] m [el]
stream2list = liftM concat getChunks
stream2stream :: (Monad m, Nullable s, Monoid s) => Iteratee s m s
stream2stream = liftM mconcat getChunks
headStream :: Iteratee [el] m el
headStream = liftI step
where
step (Chunk [ ]) = icont step Nothing
step (Chunk (hd:tl)) = idone hd (Chunk tl)
step stream = icont step (Just (setEOF stream))
tryHead :: Iteratee [el] m (Maybe el)
tryHead = liftI step
where
step (Chunk [ ]) = liftI step
step (Chunk (hd:tl)) = idone (Just hd) (Chunk tl)
step stream = idone Nothing stream
lastStream :: Iteratee [el] m el
lastStream = liftI (step Nothing)
where
step l (Chunk xs)
| nullC xs = liftI (step l)
| otherwise = liftI $ step (Just $ last xs)
step l s@(EOF _) = case l of
Nothing -> icont (step l) . Just . setEOF $ s
Just x -> idone x s
heads :: (Monad m, Eq el) => [el] -> Iteratee [el] m Int
heads st | nullC st = return 0
heads st = loopE 0 st
where
loopE cnt xs
| nullC xs = return cnt
| otherwise = liftI (step cnt xs)
step cnt str (Chunk []) = liftI (step cnt str)
step cnt [ ] stream = idone cnt stream
step cnt (y:ys) s@(Chunk (x:xs))
| y == x = step (succ cnt) ys (Chunk xs)
| otherwise = idone cnt s
step cnt _ stream = idone cnt stream
peekStream :: Iteratee [el] m (Maybe el)
peekStream = liftI step
where
step (Chunk [ ]) = liftI step
step s@(Chunk (x:_)) = idone (Just x) s
step stream = idone Nothing stream
roll
:: Monad m
=> Int
-> Int
-> Iteratee [el] m [[el]]
roll t d | t > d = liftI step
where
step (Chunk vec)
| length vec >= t =
idone [take t vec] (Chunk $ drop d vec)
| null vec = liftI step
| otherwise = liftI (step' vec)
step stream = idone empty stream
step' v1 (Chunk vec) = step . Chunk $ v1 `mappend` vec
step' v1 stream = idone [v1] stream
roll t d = do r <- joinI (takeStream t stream2stream)
dropStream (dt)
return [r]
dropStream :: Int -> Iteratee [el] m ()
dropStream 0 = idone () (Chunk emptyP)
dropStream n' = liftI (step n')
where
step n (Chunk str)
| length str < n = liftI (step (n length str))
| otherwise = idone () (Chunk (drop n str))
step _ stream = idone () stream
dropWhileStream :: (el -> Bool) -> Iteratee [el] m ()
dropWhileStream p = liftI step
where
step (Chunk str)
| null rest = liftI step
| otherwise = idone () (Chunk rest)
where
rest = dropWhile p str
step stream = idone () stream
lengthStream :: Num a => Iteratee [el] m a
lengthStream = liftI (step 0)
where
step !i (Chunk xs) = liftI (step $ i + fromIntegral (length xs))
step !i stream = idone i stream
chunkLength :: Iteratee [el] m (Maybe Int)
chunkLength = liftI step
where
step s@(Chunk xs) = idone (Just $ length xs) s
step stream = idone Nothing stream
takeFromChunk :: Int -> Iteratee [el] m [el]
takeFromChunk n | n <= 0 = idone emptyP (Chunk emptyP)
takeFromChunk n = liftI step
where
step (Chunk xs) = let (h,t) = splitAt n xs in idone h $ Chunk t
step stream = idone emptyP stream
breakStream :: (el -> Bool) -> Iteratee [el] m [el]
breakStream cpred = icont (step mempty) Nothing
where
step bfr (Chunk str)
| null str = icont (step bfr) Nothing
| otherwise = case break cpred str of
(str', tail')
| null tail' -> icont (step (bfr `mappend` str)) Nothing
| otherwise -> idone (bfr `mappend` str') (Chunk tail')
step bfr stream = idone bfr stream
breakE :: (el -> Bool) -> Enumeratee [el] [el] m a
breakE cpred = eneeCheckIfDonePass (icont . step)
where
step k (Chunk s)
| null s = liftI (step k)
| otherwise = case break cpred s of
(str', tail')
| null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'
| otherwise -> idone (k $ Chunk str') (Chunk tail')
step k stream = idone (liftI k) stream
takeStream ::
Monad m
=> Int
-> Enumeratee [el] [el] m a
takeStream 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 (dropStream 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 (dropStream n' >> throwErr e) od oc
step n k (Chunk str)
| null str = liftI (step n k)
| length str <= n = takeStream (n length str) $ k (Chunk str)
| otherwise = idone (k (Chunk s1)) (Chunk s2)
where (s1, s2) = splitAt n str
step _n k stream = idone (liftI k) stream
takeUpTo :: Monad m => Int -> Enumeratee [el] [el] m a
takeUpTo i iter
| i <= 0 = idone iter (Chunk emptyP)
| 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)
| null str = liftI (step n k)
| length str < n = takeUpTo (n length str) $ k (Chunk str)
| otherwise =
let (s1, s2) = 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' ++ 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
takeWhileE :: (el -> Bool) -> Enumeratee [el] [el] m a
takeWhileE = breakE . (not .)
mapStream :: (el -> el') -> Enumeratee [el] [el'] m a
mapStream = mapChunks . map
concatMapStream :: Monoid t => (a -> t) -> Enumeratee [a] t m r
concatMapStream = mapChunks . foldMap
concatMapStreamM :: Monad m => (a -> m t) -> Enumeratee [a] t m r
concatMapStreamM f = eneeCheckIfDone (liftI . go)
where
go k (EOF mx) = idone (liftI k) (EOF mx)
go k (Chunk xs) | null xs = liftI (go k)
| otherwise = f (head xs) `mBind`
eneeCheckIfDone (flip go (Chunk (tail xs))) . k . Chunk
mapMaybeStream :: (a -> Maybe b) -> Enumeratee [a] [b] m r
mapMaybeStream = mapChunks . mapMaybe
filterStream :: (el -> Bool) -> Enumeratee [el] [el] m a
filterStream p = mapChunks (filter p)
filterStreamM :: Monad m => (a -> m Bool) -> Enumeratee [a] [a] m r
filterStreamM k = mapChunksM (go id)
where
go acc [ ] = return $! acc empty
go acc (h:t) = do p <- k h
let acc' = if p then (:) h . acc else acc
go acc' t
groupStreamOn :: (Monad m, Eq t1)
=> (e -> t1)
-> (t1 -> m (Iteratee [e] m t2))
-> Enumeratee [e] [(t1, t2)] m a
groupStreamOn proj inner = eneeCheckIfDonePass (icont . step)
where
step outer (EOF mx) = idone (liftI outer) $ EOF mx
step outer (Chunk [ ]) = liftI $ step outer
step outer c@(Chunk (h:_)) = let x = proj h
in lift (inner x) >>= \i -> step' x i outer c
step' c it outer (Chunk as)
| null as = liftI $ step' c it outer
| (l,r) <- span ((==) c . proj) as, not (null l) =
let od a _str = idoneM a $ EOF Nothing
oc k Nothing = return $ k (Chunk l)
oc k m = icontM k m
in lift (runIter it od oc) >>= \it' -> step' c it' outer (Chunk r)
step' c it outer str =
lift (run it) >>= \b -> eneeCheckIfDone (`step` str) . outer $ Chunk [(c,b)]
groupStreamBy :: Monad m
=> (t -> t -> Bool)
-> m (Iteratee [t] m t2)
-> Enumeratee [t] [t2] m a
groupStreamBy cmp inner = eneeCheckIfDonePass (icont . step)
where
step outer (EOF mx) = idone (liftI outer) $ EOF mx
step outer (Chunk [ ]) = liftI $ step outer
step outer c@(Chunk (h:_)) = lift inner >>= \i -> step' h i outer c
step' c it outer (Chunk as)
| null as = liftI $ step' c it outer
| (l,r) <- span (cmp c) as, not (null l) =
let od a _str = idoneM a $ EOF Nothing
oc k Nothing = return $ k (Chunk l)
oc k m = icontM k m
in lift (runIter it od oc) >>= \it' -> step' (head l) it' outer (Chunk r)
step' _ it outer str =
lift (run it) >>= \b -> eneeCheckIfDone (`step` str) . outer $ Chunk [b]
mergeStreams :: Monad m => (el1 -> el2 -> b) -> Enumeratee [el2] b (Iteratee [el1] m) a
mergeStreams f = convStream $ liftM2 f (lift headStream) headStream
mergeByChunks ::
Monad m
=> ([el1] -> [el2] -> c3)
-> ([el1] -> c3)
-> ([el2] -> c3)
-> Enumeratee [el2] c3 (Iteratee [el1] m) a
mergeByChunks f f1 f2 = unfoldConvStream iter (0 :: Int)
where
iter 1 = (\x -> (1,f1 x)) `liftM` lift getChunk
iter 2 = (\x -> (2,f2 x)) `liftM` 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
foldStream :: (a -> el -> a) -> a -> Iteratee [el] m a
foldStream f i = liftI (step i)
where
step acc (Chunk xs)
| null xs = liftI (step acc)
| otherwise = liftI (step $! foldl' f acc xs)
step acc stream = idone acc stream
zipStreams
:: Monad m
=> Iteratee [el] m a
-> Iteratee [el] m b
-> Iteratee [el] m (a, b)
zipStreams 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 (flip (,) 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 (flip (,) 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)
| length xs < length ys = c1
| otherwise = c2
shorter e@(EOF _) _ = e
shorter _ e@(EOF _) = e
zipStreams3
:: Monad m
=> Iteratee [el] m a -> Iteratee [el] m b
-> Iteratee [el] m c -> Iteratee [el] m (a, b, c)
zipStreams3 a b c = zipStreams a (zipStreams b c) >>=
\(r1, (r2, r3)) -> return (r1, r2, r3)
zipStreams4
:: Monad m
=> Iteratee [el] m a -> Iteratee [el] m b
-> Iteratee [el] m c -> Iteratee [el] m d
-> Iteratee [el] m (a, b, c, d)
zipStreams4 a b c d = zipStreams a (zipStreams3 b c d) >>=
\(r1, (r2, r3, r4)) -> return (r1, r2, r3, r4)
zipStreams5
:: Monad m
=> Iteratee [el] m a -> Iteratee [el] m b
-> Iteratee [el] m c -> Iteratee [el] m d
-> Iteratee [el] m e -> Iteratee [el] m (a, b, c, d, e)
zipStreams5 a b c d e = zipStreams a (zipStreams4 b c d e) >>=
\(r1, (r2, r3, r4, r5)) -> return (r1, r2, r3, r4, r5)
enumWith
:: Monad m
=> Iteratee [el] m a
-> Iteratee [el] m b
-> Iteratee [el] 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) = take (length xs 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)
sequenceStreams_
:: Monad m
=> [Iteratee [el] m a]
-> Iteratee [el] m ()
sequenceStreams_ = self
where
self is = liftI step
where
step (Chunk xs) | null xs = liftI step
step s@(Chunk _) = do
is' <- lift $ mapM (enumChunk s) is
(done, notDone) <- lift $ partition fst `liftM` mapM enumCheckIfDone is'
if 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 => [Iteratee [el] m a] -> Iteratee [el] m (Stream [el])
remainingStream is = lift $
return . 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)
| length xs < length ys = c1
| otherwise = c2
shorter (EOF e1 ) (EOF e2 ) = EOF (e1 `mplus` e2)
shorter e@(EOF _) _ = e
shorter _ e@(EOF _) = e
countConsumed :: (Monad m, Integral n) => Iteratee [el] m a -> Iteratee [el] m (a, n)
countConsumed i = go 0 (const i) (Chunk emptyP)
where
go !n f str@(EOF _) = flip (,) n `liftM` f str
go !n f str@(Chunk c) = Iteratee rI
where
newLen = n + fromIntegral (length c)
rI od oc = runIter (f str) onDone onCont
where
onDone a str'@(Chunk c') =
od (a, newLen fromIntegral (length c')) str'
onDone a str'@(EOF _) = od (a, n) str'
onCont f' = oc (go newLen f')
enumPureNChunk :: Monad m => [el] -> Int -> Enumerator [el] m a
enumPureNChunk str n iter
| null str = return iter
| n > 0 = enum' str iter
| otherwise = error $ "enumPureNChunk called with n==" ++ show n
where
enum' str' iter'
| null str' = return iter'
| otherwise = let (s1, s2) = 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
mapStreamM_ :: Monad m => (el -> m b) -> Iteratee [el] m ()
mapStreamM_ = mapChunksM_ . mapM_
mapStreamM :: Monad m => (el -> m el') -> Enumeratee [el] [el'] m a
mapStreamM = mapChunksM . mapM
foldStreamM :: Monad m => (b -> a -> m b) -> b -> Iteratee [a] m b
foldStreamM = foldChunksM . foldM