module Data.Enumerator (
Stream (..)
, Iteratee (..)
, Step (..)
, Enumerator
, Enumeratee
, returnI
, yield
, continue
, (>>==)
, (==<<)
, ($$)
, (>==>)
, (<==<)
, throwError
, catchError
, Data.Enumerator.foldl
, Data.Enumerator.foldl'
, Data.Enumerator.foldM
, Data.Enumerator.iterate
, iterateM
, Data.Enumerator.repeat
, repeatM
, Data.Enumerator.replicate
, replicateM
, generateM
, Data.Enumerator.map
, Data.Enumerator.concatMap
, Data.Enumerator.filter
, Data.Enumerator.mapM
, concatMapM
, Data.Enumerator.filterM
, printChunks
, concatEnums
, joinI
, joinE
, Data.Enumerator.sequence
, enumList
, enumEOF
, run
, run_
, checkDone
, checkDoneEx
, isEOF
, liftTrans
, liftI
, peek
, Data.Enumerator.last
, Data.Enumerator.length
, Data.Enumerator.head
, Data.Enumerator.drop
, Data.Enumerator.dropWhile
, Data.Enumerator.span
, Data.Enumerator.break
, Data.Enumerator.consume
, liftFoldL
, liftFoldL'
, liftFoldM
) where
import qualified Prelude as Prelude
import Prelude hiding (
concatMap,
)
import Data.Monoid (Monoid, mempty, mappend, mconcat)
import qualified Control.Exception as Exc
import Data.Function (fix)
import Control.Monad.Trans.Class (MonadTrans, lift)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Control.Applicative as A
import qualified Control.Monad as CM
import Data.Typeable ( Typeable, typeOf
, Typeable1, typeOf1
, mkTyConApp, mkTyCon)
import Data.List (foldl')
import Data.List (genericSplitAt)
import Data.List (genericLength)
import qualified Data.Enumerator.List as EL
data Stream a
= Chunks [a]
| EOF
deriving (Show, Eq)
instance Monad Stream where
return = Chunks . return
Chunks xs >>= f = mconcat (fmap f xs)
EOF >>= _ = EOF
instance Functor Stream where
fmap f (Chunks xs) = Chunks (fmap f xs)
fmap _ EOF = EOF
instance A.Applicative Stream where
pure = return
(<*>) = CM.ap
instance Monoid (Stream a) where
mempty = Chunks mempty
mappend (Chunks xs) (Chunks ys) = Chunks (xs ++ ys)
mappend _ _ = EOF
data Step a m b
= Continue (Stream a -> Iteratee a m b)
| Yield b (Stream a)
| Error Exc.SomeException
newtype Iteratee a m b = Iteratee
{ runIteratee :: m (Step a m b)
}
returnI :: Monad m => Step a m b -> Iteratee a m b
returnI step = Iteratee (return step)
yield :: Monad m => b -> Stream a -> Iteratee a m b
yield x extra = returnI (Yield x extra)
continue :: Monad m => (Stream a -> Iteratee a m b)
-> Iteratee a m b
continue k = returnI (Continue k)
type Enumerator a m b = Step a m b -> Iteratee a m b
type Enumeratee ao ai m b = Step ai m b
-> Iteratee ao m (Step ai m b)
infixl 1 >>==
(>>==) :: Monad m
=> Iteratee a m b
-> (Step a m b -> Iteratee a' m b')
-> Iteratee a' m b'
i >>== f = Iteratee (runIteratee i >>= runIteratee . f)
infixr 1 ==<<
(==<<) :: Monad m
=> (Step a m b -> Iteratee a' m b')
-> Iteratee a m b
-> Iteratee a' m b'
(==<<) = flip (>>==)
infixr 0 $$
($$) :: Monad m
=> (Step a m b -> Iteratee a' m b')
-> Iteratee a m b
-> Iteratee a' m b'
($$) = (==<<)
infixr 1 >==>
(>==>) :: Monad m
=> Enumerator a m b
-> (Step a m b -> Iteratee a' m b')
-> Step a m b
-> Iteratee a' m b'
(>==>) e1 e2 s = e1 s >>== e2
infixr 1 <==<
(<==<) :: Monad m
=> (Step a m b -> Iteratee a' m b')
-> Enumerator a m b
-> Step a m b
-> Iteratee a' m b'
(<==<) = flip (>==>)
instance Monad m => Monad (Iteratee a m) where
return x = yield x (Chunks [])
m0 >>= f = ($ m0) $ fix $ \bind m -> Iteratee $ runIteratee m >>=
\r1 -> case r1 of
Continue k -> return (Continue (bind . k))
Error err -> return (Error err)
Yield x (Chunks []) -> runIteratee (f x)
Yield x extra -> runIteratee (f x) >>=
\r2 -> case r2 of
Continue k -> runIteratee (k extra)
Error err -> return (Error err)
Yield x' _ -> return (Yield x' extra)
instance MonadTrans (Iteratee a) where
lift m = Iteratee (m >>= runIteratee . return)
instance MonadIO m => MonadIO (Iteratee a m) where
liftIO = lift . liftIO
instance Monad m => Functor (Iteratee a m) where
fmap = CM.liftM
instance Monad m => A.Applicative (Iteratee a m) where
pure = return
(<*>) = CM.ap
instance (Typeable a, Typeable1 m) => Typeable1 (Iteratee a m) where
typeOf1 i = mkTyConApp tyCon [typeOf a, typeOf1 m] where
tyCon = mkTyCon "Data.Enumerator.Iteratee"
(a, m) = peel i
peel :: Iteratee a m b -> (a, m ())
peel = undefined
throwError :: (Monad m, Exc.Exception e) => e
-> Iteratee a m b
throwError exc = returnI (Error (Exc.toException exc))
catchError :: Monad m => Iteratee a m b
-> (Exc.SomeException -> Iteratee a m b)
-> Iteratee a m b
catchError iter h = iter >>== step where
step (Yield b as) = yield b as
step (Error err) = h err
step (Continue k) = continue (\s -> k s >>== step)
foldl :: Monad m => (b -> a -> b) -> b
-> Iteratee a m b
foldl step = continue . loop where
fold = Prelude.foldl step
loop acc stream = case stream of
Chunks [] -> continue (loop acc)
Chunks xs -> continue (loop (fold acc xs))
EOF -> yield acc EOF
foldl' :: Monad m => (b -> a -> b) -> b
-> Iteratee a m b
foldl' step = continue . loop where
fold = Data.List.foldl' step
loop acc stream = case stream of
Chunks [] -> continue (loop acc)
Chunks xs -> continue (loop (fold acc xs))
EOF -> yield acc EOF
foldM :: Monad m => (b -> a -> m b) -> b
-> Iteratee a m b
foldM step = continue . loop where
fold acc = lift . CM.foldM step acc
loop acc stream = case stream of
Chunks [] -> continue (loop acc)
Chunks xs -> fold acc xs >>= continue . loop
EOF -> yield acc EOF
iterate :: Monad m => (a -> a) -> a -> Enumerator a m b
iterate f = loop where
loop a (Continue k) = k (Chunks [a]) >>== loop (f a)
loop _ step = returnI step
iterateM :: Monad m => (a -> m a) -> a
-> Enumerator a m b
iterateM f base = loop (return base) where
loop m_a (Continue k) = do
a <- lift m_a
k (Chunks [a]) >>== loop (f a)
loop _ step = returnI step
repeat :: Monad m => a -> Enumerator a m b
repeat a = Data.Enumerator.iterate (const a) a
repeatM :: Monad m => m a -> Enumerator a m b
repeatM m_a step = do
a <- lift m_a
iterateM (const m_a) a step
replicateM :: Monad m => Integer -> m a
-> Enumerator a m b
replicateM maxCount getNext = loop maxCount where
loop 0 step = returnI step
loop n (Continue k) = do
next <- lift getNext
k (Chunks [next]) >>== loop (n 1)
loop _ step = returnI step
replicate :: Monad m => Integer -> a
-> Enumerator a m b
replicate maxCount a = replicateM maxCount (return a)
generateM :: Monad m => m (Maybe a)
-> Enumerator a m b
generateM getNext = loop where
loop (Continue k) = do
next <- lift getNext
case next of
Nothing -> continue k
Just x -> k (Chunks [x]) >>== loop
loop step = returnI step
concatMapM :: Monad m => (ao -> m [ai])
-> Enumeratee ao ai m b
concatMapM f = checkDone (continue . step) where
step k EOF = yield (Continue k) EOF
step k (Chunks xs) = loop k xs
loop k [] = continue (step k)
loop k (x:xs) = do
fx <- lift (f x)
k (Chunks fx) >>==
checkDoneEx (Chunks xs) (\k' -> loop k' xs)
concatMap :: Monad m => (ao -> [ai])
-> Enumeratee ao ai m b
concatMap f = concatMapM (return . f)
map :: Monad m => (ao -> ai)
-> Enumeratee ao ai m b
map f = concatMap (\x -> Prelude.map f [x])
filter :: Monad m => (a -> Bool)
-> Enumeratee a a m b
filter p = concatMap (\x -> Prelude.filter p [x])
mapM :: Monad m => (ao -> m ai)
-> Enumeratee ao ai m b
mapM f = concatMapM (\x -> Prelude.mapM f [x])
filterM :: Monad m => (a -> m Bool)
-> Enumeratee a a m b
filterM p = concatMapM (\x -> CM.filterM p [x])
printChunks :: (MonadIO m, Show a)
=> Bool
-> Iteratee a m ()
printChunks printEmpty = continue loop where
loop (Chunks xs) = do
let hide = null xs && not printEmpty
CM.unless hide (liftIO (print xs))
continue loop
loop EOF = do
liftIO (putStrLn "EOF")
yield () EOF
concatEnums :: Monad m => [Enumerator a m b]
-> Enumerator a m b
concatEnums = Prelude.foldl (>==>) returnI
joinI :: Monad m => Iteratee a m (Step a' m b)
-> Iteratee a m b
joinI outer = outer >>= check where
check (Continue k) = k EOF >>== \s -> case s of
Continue _ -> error "joinI: divergent iteratee"
_ -> check s
check (Yield x _) = return x
check (Error e) = throwError e
joinE :: Monad m
=> Enumerator ao m (Step ai m b)
-> Enumeratee ao ai m b
-> Enumerator ai m b
joinE enum enee s = Iteratee $ do
step <- runIteratee (enumEOF $$ enum $$ enee s)
case step of
Error err -> return (Error err)
Yield x _ -> return x
Continue _ -> error "joinE: divergent iteratee"
sequence :: Monad m => Iteratee ao m ai
-> Enumeratee ao ai m b
sequence i = loop where
loop = checkDone check
check k = isEOF >>= \f -> if f
then yield (Continue k) EOF
else step k
step k = i >>= \v -> k (Chunks [v]) >>== loop
enumList :: Monad m => Integer -> [a] -> Enumerator a m b
enumList n = loop where
loop xs (Continue k) | not (null xs) = let
(s1, s2) = genericSplitAt n xs
in k (Chunks s1) >>== loop s2
loop _ step = returnI step
run :: Monad m => Iteratee a m b
-> m (Either Exc.SomeException b)
run i = do
mStep <- runIteratee $ enumEOF ==<< i
case mStep of
Error err -> return $ Left err
Yield x _ -> return $ Right x
Continue _ -> error "run: divergent iteratee"
enumEOF :: Monad m => Enumerator a m b
enumEOF (Yield x _) = yield x EOF
enumEOF (Error err) = throwError err
enumEOF (Continue k) = k EOF >>== check where
check (Continue _) = error "enumEOF: divergent iteratee"
check s = enumEOF s
run_ :: Monad m => Iteratee a m b -> m b
run_ i = run i >>= either Exc.throw return
checkDoneEx :: Monad m =>
Stream a' ->
((Stream a -> Iteratee a m b) -> Iteratee a' m (Step a m b)) ->
Enumeratee a' a m b
checkDoneEx _ f (Continue k) = f k
checkDoneEx extra _ step = yield step extra
checkDone :: Monad m =>
((Stream a -> Iteratee a m b) -> Iteratee a' m (Step a m b)) ->
Enumeratee a' a m b
checkDone = checkDoneEx (Chunks [])
isEOF :: Monad m => Iteratee a m Bool
isEOF = continue $ \s -> case s of
EOF -> yield True s
_ -> yield False s
liftTrans :: (Monad m, MonadTrans t, Monad (t m)) =>
Iteratee a m b -> Iteratee a (t m) b
liftTrans iter = Iteratee $ do
step <- lift (runIteratee iter)
return $ case step of
Yield x cs -> Yield x cs
Error err -> Error err
Continue k -> Continue (liftTrans . k)
liftI :: Monad m => (Stream a -> Step a m b)
-> Iteratee a m b
liftI k = continue (returnI . k)
peek :: Monad m => Iteratee a m (Maybe a)
peek = continue loop where
loop (Chunks []) = continue loop
loop chunk@(Chunks (x:_)) = yield (Just x) chunk
loop EOF = yield Nothing EOF
last :: Monad m => Iteratee a m (Maybe a)
last = continue (loop Nothing) where
loop ret (Chunks xs) = continue . loop $ case xs of
[] -> ret
_ -> Just (Prelude.last xs)
loop ret EOF = yield ret EOF
length :: Monad m => Iteratee a m Integer
length = continue (loop 0) where
len = genericLength
loop n (Chunks xs) = continue (loop (n + len xs))
loop n EOF = yield n EOF
head :: Monad m => Iteratee a m (Maybe a)
head = EL.head
drop :: Monad m => Integer -> Iteratee a m ()
drop = EL.drop
dropWhile :: Monad m => (a -> Bool) -> Iteratee a m ()
dropWhile = EL.dropWhile
span :: Monad m => (a -> Bool) -> Iteratee a m [a]
span = EL.takeWhile
break :: Monad m => (a -> Bool) -> Iteratee a m [a]
break p = EL.takeWhile (not . p)
consume :: Monad m => Iteratee a m [a]
consume = EL.consume
liftFoldL :: Monad m => (b -> a -> b) -> b
-> Iteratee a m b
liftFoldL = Data.Enumerator.foldl
liftFoldL' :: Monad m => (b -> a -> b) -> b
-> Iteratee a m b
liftFoldL' = Data.Enumerator.foldl'
liftFoldM :: Monad m => (b -> a -> m b) -> b
-> Iteratee a m b
liftFoldM = Data.Enumerator.foldM