module Data.Enumerator (
Stream (..)
, Iteratee (..)
, Step (..)
, Enumerator
, Enumeratee
, returnI
, continue
, yield
, (>>==)
, (==<<)
, ($$)
, (>==>)
, (<==<)
, run
, run_
, throwError
, catchError
, concatEnums
, joinI
, joinE
, Data.Enumerator.sequence
, enumEOF
, checkDoneEx
, checkDone
, isEOF
, printChunks
, enumList
, liftTrans
, liftI
, peek
, Data.Enumerator.last
, Data.Enumerator.length
, Data.Enumerator.head
, Data.Enumerator.drop
, Data.Enumerator.dropWhile
, Data.Enumerator.span
, Data.Enumerator.break
, consume
, Data.Enumerator.foldl
, Data.Enumerator.foldl'
, foldM
, Data.Enumerator.iterate
, iterateM
, Data.Enumerator.repeat
, repeatM
, Data.Enumerator.replicate
, replicateM
, generateM
, Data.Enumerator.map
, Data.Enumerator.mapM
, Data.Enumerator.concatMap
, concatMapM
, Data.Enumerator.filter
, filterM
, liftFoldL
, liftFoldL'
, liftFoldM
) where
import Data.Typeable ( Typeable, typeOf
, Typeable1, typeOf1
, mkTyConApp, mkTyCon)
import Data.List (genericSplitAt)
import qualified Control.Exception as Exc
import Data.Monoid (Monoid, mempty, mappend, mconcat)
import Control.Monad.Trans.Class (MonadTrans, lift)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Applicative as A
import qualified Control.Monad as CM
import Data.Function (fix)
import qualified Data.Enumerator.List as EL
import Data.List (genericLength)
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 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)
}
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
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)
instance Typeable1 Stream where
typeOf1 _ = mkTyConApp tyCon [] where
tyCon = mkTyCon "Data.Enumerator.Stream"
instance (Typeable a, Typeable1 m) =>
Typeable1 (Iteratee a m) where
typeOf1 i = let
tyCon = mkTyCon "Data.Enumerator.Iteratee"
(a, m) = peel i
peel :: Iteratee a m b -> (a, m ())
peel = undefined
in mkTyConApp tyCon [typeOf a, typeOf1 m]
instance (Typeable a, Typeable1 m) =>
Typeable1 (Step a m) where
typeOf1 s = let
tyCon = mkTyCon "Data.Enumerator.Step"
(a, m) = peel s
peel :: Step a m b -> (a, m ())
peel = undefined
in mkTyConApp tyCon [typeOf a, typeOf1 m]
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 Functor Stream where
fmap f (Chunks xs) = Chunks (fmap f xs)
fmap _ EOF = EOF
instance A.Applicative Stream where
pure = return
(<*>) = CM.ap
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)
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"
run_ :: Monad m => Iteratee a m b -> m b
run_ i = run i >>= either Exc.throw return
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)
infixl 1 >>==
infixr 1 ==<<
infixr 0 $$
infixr 1 >==>
infixr 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)
(==<<) :: Monad m
=> (Step a m b -> Iteratee a' m b')
-> Iteratee a m b
-> Iteratee a' m b'
(==<<) = flip (>>==)
($$) :: Monad m
=> (Step a m b -> Iteratee a' m b')
-> Iteratee a m b
-> Iteratee a' m b'
($$) = (==<<)
(>==>) :: 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
(<==<) :: Monad m
=> (Step a m b -> Iteratee a' m b')
-> Enumerator a m b
-> Step a m b
-> Iteratee a' m b'
(<==<) = flip (>==>)
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
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
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
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
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
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' = EL.fold
foldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m b
foldM = EL.foldM
iterate :: Monad m => (a -> a) -> a -> Enumerator a m b
iterate = EL.iterate
iterateM :: Monad m => (a -> m a) -> a -> Enumerator a m b
iterateM = EL.iterateM
repeat :: Monad m => a -> Enumerator a m b
repeat = EL.repeat
repeatM :: Monad m => m a -> Enumerator a m b
repeatM = EL.repeatM
replicate :: Monad m => Integer -> a -> Enumerator a m b
replicate = EL.replicate
replicateM :: Monad m => Integer -> m a -> Enumerator a m b
replicateM = EL.replicateM
generateM :: Monad m => m (Maybe a) -> Enumerator a m b
generateM = EL.generateM
map :: Monad m => (ao -> ai) -> Enumeratee ao ai m b
map = EL.map
mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m b
mapM = EL.mapM
concatMap :: Monad m => (ao -> [ai]) -> Enumeratee ao ai m b
concatMap = EL.concatMap
concatMapM :: Monad m => (ao -> m [ai]) -> Enumeratee ao ai m b
concatMapM = EL.concatMapM
filter :: Monad m => (a -> Bool) -> Enumeratee a a m b
filter = EL.filter
filterM :: Monad m => (a -> m Bool) -> Enumeratee a a m b
filterM = EL.filterM
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' = EL.fold
liftFoldM :: Monad m => (b -> a -> m b) -> b
-> Iteratee a m b
liftFoldM = EL.foldM