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 (MonadTrans(..))
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
{-# INLINE isFinished #-}
stream2list :: Monad m => Iteratee [el] m [el]
stream2list = liftM concat getChunks
{-# INLINE stream2list #-}
stream2stream :: (Monad m, Nullable s, Monoid s) => Iteratee s m s
stream2stream = liftM mconcat getChunks
{-# INLINE stream2stream #-}
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))
{-# INLINE headStream #-}
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
{-# INLINE tryHead #-}
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
{-# INLINE lastStream #-}
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
{-# INLINE heads #-}
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
{-# INLINE peekStream #-}
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 (d-t)
return [r]
{-# INLINE roll #-}
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
{-# INLINE dropStream #-}
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
{-# INLINE dropWhileStream #-}
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
{-# INLINE lengthStream #-}
chunkLength :: Iteratee [el] m (Maybe Int)
chunkLength = liftI step
where
step s@(Chunk xs) = idone (Just $ length xs) s
step stream = idone Nothing stream
{-# INLINE chunkLength #-}
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
{-# INLINE takeFromChunk #-}
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
{-# INLINE breakStream #-}
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
{-# INLINE breakE #-}
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
{-# INLINE takeStream #-}
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
{-# INLINE takeUpTo #-}
takeWhileE :: (el -> Bool) -> Enumeratee [el] [el] m a
takeWhileE = breakE . (not .)
{-# INLINEABLE takeWhileE #-}
mapStream :: (el -> el') -> Enumeratee [el] [el'] m a
mapStream = mapChunks . map
{-# INLINE mapStream #-}
concatMapStream :: Monoid t => (a -> t) -> Enumeratee [a] t m r
concatMapStream = mapChunks . foldMap
{-# INLINE concatMapStream #-}
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
{-# INLINE concatMapStreamM #-}
mapMaybeStream :: (a -> Maybe b) -> Enumeratee [a] [b] m r
mapMaybeStream = mapChunks . mapMaybe
{-# INLINE mapMaybeStream #-}
filterStream :: (el -> Bool) -> Enumeratee [el] [el] m a
filterStream p = mapChunks (filter p)
{-# INLINE filterStream #-}
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
{-# INLINE filterStreamM #-}
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
{-# INLINE mergeStreams #-}
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
{-# INLINE mergeByChunks #-}
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
{-# INLINE foldStream #-}
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
{-# INLINE zipStreams #-}
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)
{-# INLINE zipStreams3 #-}
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)
{-# INLINE zipStreams4 #-}
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)
{-# INLINE zipStreams5 #-}
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)
{-# INLINE enumWith #-}
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')
{-# INLINE countConsumed #-}
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
{-# INLINE enumPureNChunk #-}
mapStreamM_ :: Monad m => (el -> m b) -> Iteratee [el] m ()
mapStreamM_ = mapChunksM_ . mapM_
{-# INLINE mapStreamM_ #-}
mapStreamM :: Monad m => (el -> m el') -> Enumeratee [el] [el'] m a
mapStreamM = mapChunksM . mapM
{-# INLINE mapStreamM #-}
foldStreamM :: Monad m => (b -> a -> m b) -> b -> Iteratee [a] m b
foldStreamM = foldChunksM . foldM
{-# INLINE foldStreamM #-}