----------------------------------------------------------------------------- -- | -- Module: Data.Enumerator -- Copyright: 2010 John Millikin -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- -- Core enumerator types, and some useful primitives. -- -- This module is intended to be imported qualified: -- -- @ -- import qualified Data.Enumerator as E -- @ -- ----------------------------------------------------------------------------- module Data.Enumerator ( -- * Types Stream (..) , Iteratee (..) , Step (..) , Enumerator , Enumeratee -- * Primitives , returnI , continue , yield -- ** Operators , (>>==) , (==<<) , ($$) , (>==>) , (<==<) , (=$) , ($=) -- ** Running iteratees , run , run_ -- ** Error handling , throwError , catchError -- * Miscellaneous , concatEnums , joinI , joinE , Data.Enumerator.sequence , enumEOF , checkContinue0 , checkContinue1 , checkDoneEx , checkDone , isEOF , tryIO -- ** Testing and debugging , printChunks , enumList -- * Legacy compatibility -- ** Obsolete , liftTrans , liftI , peek , Data.Enumerator.last , Data.Enumerator.length -- ** Aliases , 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 {-# SOURCE #-} qualified Data.Enumerator.List as EL import Data.List (genericLength) -- | A 'Stream' is a sequence of chunks generated by an 'Enumerator'. -- -- @('Chunks' [])@ is used to indicate that a stream is still active, but -- currently has no available data. Iteratees should ignore empty chunks. 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 -- | The 'Iteratee' is capable of accepting more input. Note that more input -- is not necessarily required; the 'Iteratee' might be able to generate a -- value immediately if it receives 'EOF'. = Continue (Stream a -> Iteratee a m b) -- | The 'Iteratee' cannot receive any more input, and has generated a -- result. Included in this value is left-over input, which can be passed to -- composed 'Iteratee's. | Yield b (Stream a) -- | The 'Iteratee' encountered an error which prevents it from proceeding -- further. | Error Exc.SomeException -- | The primary data type for this library, which consumes -- input from a 'Stream' until it either generates a value or encounters -- an error. Rather than requiring all input at once, an iteratee will -- return 'Continue' when it is capable of processing more data. -- -- In general, iteratees begin in the 'Continue' state. As each chunk is -- passed to the continuation, the iteratee returns the next step: -- 'Continue' for more data, 'Yield' when it's finished, or 'Error' to -- abort processing. 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 -- | While 'Iteratee's consume data, enumerators generate it. Since -- @'Iteratee'@ is an alias for @m ('Step' a m b)@, 'Enumerator's can -- be considered step transformers of type -- @'Step' a m b -> m ('Step' a m b)@. -- -- 'Enumerator's typically read from an external source (parser, handle, -- random generator, etc). They feed chunks into an 'Iteratee' until the -- source runs out of data (triggering 'EOF') or the iteratee finishes -- processing ('Yield's a value). type Enumerator a m b = Step a m b -> Iteratee a m b -- | In cases where an enumerator acts as both a source and sink, the resulting -- type is named an 'Enumeratee'. Enumeratees have two input types, -- “outer a” (@aOut@) and “inner a” (@aIn@). type Enumeratee ao ai m b = Step ai m b -> Iteratee ao m (Step ai m b) -- | Since: 0.4.8 instance Typeable1 Stream where typeOf1 _ = mkTyConApp tyCon [] where tyCon = mkTyCon "Data.Enumerator.Stream" -- | Since: 0.4.6 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] -- | Since: 0.4.8 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 -- | Since: 0.4.5 instance A.Applicative Stream where pure = return (<*>) = CM.ap -- | @'returnI' step = 'Iteratee' (return step)@ returnI :: Monad m => Step a m b -> Iteratee a m b returnI step = Iteratee (return step) -- | @'yield' x extra = 'returnI' ('Yield' x extra)@ -- -- WARNING: due to the current encoding of iteratees in this library, -- careless use of the 'yield' primitive may violate the monad laws. -- To prevent this, always make sure that an iteratee never yields -- extra data unless it has received at least one input element. -- -- More strictly, iteratees may not yield data that they did not -- receive as input. Don't use 'yield' to “inject” elements -- into the stream. yield :: Monad m => b -> Stream a -> Iteratee a m b yield x extra = returnI (Yield x extra) -- | @'continue' k = 'returnI' ('Continue' k)@ continue :: Monad m => (Stream a -> Iteratee a m b) -> Iteratee a m b continue k = returnI (Continue k) -- | Run an iteratee until it finishes, and return either the final value -- (if it succeeded) or the error (if it failed). 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" -- | Like 'run', except errors are converted to exceptions and thrown. -- Primarily useful for small scripts or other simple cases. -- -- Since: 0.4.1 run_ :: Monad m => Iteratee a m b -> m b run_ i = run i >>= either Exc.throw return -- | @'throwError' exc = 'returnI' ('Error' ('Exc.toException' exc))@ throwError :: (Monad m, Exc.Exception e) => e -> Iteratee a m b throwError exc = returnI (Error (Exc.toException exc)) -- | Runs the iteratee, and calls an exception handler if an 'Error' is -- returned. By handling errors within the enumerator library, and requiring -- all errors to be represented by 'Exc.SomeException', libraries with -- varying error types can be easily composed. -- -- WARNING: after a few rounds of "catchError doesn't work because X", this -- function has grown into a horrible monster. I have no concept of what -- unexpected behaviors lurk in its dark crevices. Users are strongly advised -- to wrap all uses of @catchError@ with an appropriate @isolate@, such as -- @Data.Enumerator.List.isolate@ or @Data.Enumerator.Binary.isolate@, which -- will handle input framing even in the face of unexpected errors. -- -- Within the error handler, it is difficult or impossible to know how much -- input the original iteratee has consumed. -- -- Since: 0.1.1 catchError :: Monad m => Iteratee a m b -> (Exc.SomeException -> Iteratee a m b) -> Iteratee a m b catchError i h = go i where go iter = Iteratee $ do step <- runIteratee iter case step of Yield _ _ -> return step Error err -> runIteratee (h err) Continue k -> return (Continue (wrap k)) wrap k EOF = Iteratee $ do res <- run (k EOF) case res of Left err -> runIteratee (enumEOF $$ h err) Right b -> return (Yield b EOF) wrap k stream = Iteratee $ do step <- runIteratee (k stream) case step of Yield _ _ -> return step Error err -> do step' <- runIteratee (h err) case step' of Continue k' -> runIteratee (k' stream) _ -> return step Continue k' -> return (Continue (wrap k')) infixl 1 >>== infixr 1 ==<< infixr 0 $$ infixr 1 >==> infixr 1 <==< -- | Equivalent to '(>>=)' for @m ('Step' a m b)@; allows 'Iteratee's with -- different input types to be composed. (>>==) :: 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) -- | @'(==\<\<)' = flip '(\>\>==)'@ (==<<) :: Monad m => (Step a m b -> Iteratee a' m b') -> Iteratee a m b -> Iteratee a' m b' (==<<) = flip (>>==) -- | @'($$)' = '(==\<\<)'@ -- -- This might be easier to read when passing a chain of iteratees to an -- enumerator. -- -- Since: 0.1.1 ($$) :: Monad m => (Step a m b -> Iteratee a' m b') -> Iteratee a m b -> Iteratee a' m b' ($$) = (==<<) -- | @'(>==>)' e1 e2 s = e1 s '>>==' e2@ -- -- Since: 0.1.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 -- | @'(\<==\<)' = flip '(>==>)'@ -- -- Since: 0.1.1 (<==<) :: Monad m => (Step a m b -> Iteratee a' m b') -> Enumerator a m b -> Step a m b -> Iteratee a' m b' (<==<) = flip (>==>) -- | Print chunks as they're received from the enumerator, optionally -- printing empty chunks. printChunks :: (MonadIO m, Show a) => Bool -- ^ Print empty chunks -> 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' n xs@ enumerates /xs/ as a stream, passing /n/ inputs per -- chunk. -- -- Primarily useful for testing and debugging. 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 -- | Compose a list of 'Enumerator's using @'(>>==)'@ concatEnums :: Monad m => [Enumerator a m b] -> Enumerator a m b concatEnums = Prelude.foldl (>==>) returnI -- | 'joinI' is used to “flatten” 'Enumeratee's into an -- 'Iteratee'. 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 infixr 0 =$ -- | @enum =$ iter = 'joinI' (enum $$ iter)@ -- -- “Wraps” an iteratee /inner/ in an enumeratee /wrapper/. -- The resulting iteratee will consume /wrapper/’s input type and -- yield /inner/’s output type. -- -- Note: if the inner iteratee yields leftover input when it finishes, -- that extra will be discarded. -- -- As an example, consider an iteratee that converts a stream of UTF8-encoded -- bytes into a single 'TL.Text': -- -- > consumeUTF8 :: Monad m => Iteratee ByteString m Text -- -- It could be written with either 'joinI' or '(=$)': -- -- > import Data.Enumerator.Text as ET -- > -- > consumeUTF8 = joinI (decode utf8 $$ ET.consume) -- > consumeUTF8 = decode utf8 =$ ET.consume -- -- Since: 0.4.9 (=$) :: Monad m => Enumeratee ao ai m b -> Iteratee ai m b -> Iteratee ao m b enum =$ iter = joinI (enum $$ iter) -- | Flatten an enumerator/enumeratee pair into a single enumerator. 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" infixr 0 $= -- | @enum $= enee = 'joinE' enum enee@ -- -- “Wraps” an enumerator /inner/ in an enumeratee /wrapper/. -- The resulting enumerator will generate /wrapper/’s output type. -- -- As an example, consider an enumerator that yields line character counts -- for a text file (e.g. for source code readability checking): -- -- > enumFileCounts :: FilePath -> Enumerator Int IO b -- -- It could be written with either 'joinE' or '($=)': -- -- > import Data.Text as T -- > import Data.Enumerator.List as EL -- > import Data.Enumerator.Text as ET -- > -- > enumFileCounts path = joinE (enumFile path) (EL.map T.length) -- > enumFileCounts path = enumFile path $= EL.map T.length -- -- Since: 0.4.9 ($=) :: Monad m => Enumerator ao m (Step ai m b) -> Enumeratee ao ai m b -> Enumerator ai m b ($=) = joinE -- | Feeds outer input elements into the provided iteratee until it yields -- an inner input, passes that to the inner iteratee, and then loops. 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 -- | Sends 'EOF' to its iteratee. Most clients should use 'run' or 'run_' -- instead. 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 -- | A common pattern in 'Enumeratee' implementations is to check whether -- the inner 'Iteratee' has finished, and if so, to return its output. -- 'checkDone' passes its parameter a continuation if the 'Iteratee' -- can still consume input, or yields otherwise. -- -- Since: 0.4.3 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' = 'checkDoneEx' ('Chunks' [])@ -- -- Use this for enumeratees which do not have an input buffer. checkDone :: Monad m => ((Stream a -> Iteratee a m b) -> Iteratee a' m (Step a m b)) -> Enumeratee a' a m b checkDone = checkDoneEx (Chunks []) -- | Check whether a stream has reached EOF. Most clients should use -- 'Data.Enumerator.List.head' instead. isEOF :: Monad m => Iteratee a m Bool isEOF = continue $ \s -> case s of EOF -> yield True s _ -> yield False s -- | Try to run an IO computation. If it throws an exception, the exception -- is caught and converted into an {\tt Error}. -- -- Since: 0.4.9 tryIO :: MonadIO m => IO b -> Iteratee a m b tryIO io = Iteratee $ do tried <- liftIO (Exc.try io) return $ case tried of Right b -> Yield b (Chunks []) Left err -> Error err -- | A common pattern in 'Enumerator' implementations is to check whether -- the inner 'Iteratee' has finished, and if so, to return its output. -- 'checkContinue0' passes its parameter a continuation if the 'Iteratee' -- can still consume input; if not, it returns the iteratee's step. -- -- The type signature here is a bit crazy, but it's actually very easy to -- use. Take this code: -- -- > repeat :: Monad m => a -> Enumerator a m b -- > repeat x = loop where -- > loop (Continue k) = k (Chunks [x]) >>== loop -- > loop step = returnI step -- -- And rewrite it without the boilerplate: -- -- > repeat :: Monad m => a -> Enumerator a m b -- > repeat x = checkContinue0 $ \loop k -> k (Chunks [x] >>== loop -- -- Since: 0.4.9 checkContinue0 :: Monad m => (Enumerator a m b -> (Stream a -> Iteratee a m b) -> Iteratee a m b) -> Enumerator a m b checkContinue0 inner = loop where loop (Continue k) = inner loop k loop step = returnI step -- | Like 'checkContinue0', but allows each loop step to use a state value: -- -- > iterate :: Monad m => (a -> a) -> a -> Enumerator a m b -- > iterate f = checkContinue1 $ \loop a k -> k (Chunks [a]) >>== loop (f a) -- -- Since: 0.4.9 checkContinue1 :: Monad m => ((s1 -> Enumerator a m b) -> s1 -> (Stream a -> Iteratee a m b) -> Iteratee a m b) -> s1 -> Enumerator a m b checkContinue1 inner = loop where loop s (Continue k) = inner loop s k loop _ step = returnI step -- | Lift an 'Iteratee' onto a monad transformer, re-wrapping the -- 'Iteratee'’s inner monadic values. -- -- Since: 0.1.1 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) {-# DEPRECATED liftI "Use 'Data.Enumerator.continue' instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.continue' instead liftI :: Monad m => (Stream a -> Step a m b) -> Iteratee a m b liftI k = continue (returnI . k) -- | Peek at the next element in the stream, or 'Nothing' if the stream -- has ended. 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 -- | Get the last element in the stream, or 'Nothing' if the stream -- has ended. -- -- Consumes the entire stream. 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 -- | Get how many elements remained in the stream. -- -- Consumes the entire stream. 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 {-# DEPRECATED head "Use 'Data.Enumerator.List.head' instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.head' instead head :: Monad m => Iteratee a m (Maybe a) head = EL.head {-# DEPRECATED drop "Use 'Data.Enumerator.List.drop' instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.drop' instead drop :: Monad m => Integer -> Iteratee a m () drop = EL.drop {-# DEPRECATED dropWhile "Use 'Data.Enumerator.List.dropWhile' instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.dropWhile' instead dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () dropWhile = EL.dropWhile {-# DEPRECATED span "Use 'Data.Enumerator.List.takeWhile' instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.takeWhile' instead span :: Monad m => (a -> Bool) -> Iteratee a m [a] span = EL.takeWhile {-# DEPRECATED break "Use 'Data.Enumerator.List.takeWhile' instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.takeWhile' instead break :: Monad m => (a -> Bool) -> Iteratee a m [a] break p = EL.takeWhile (not . p) {-# DEPRECATED consume "Use 'Data.Enumerator.List.consume' instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.consume' instead consume :: Monad m => Iteratee a m [a] consume = EL.consume {-# DEPRECATED foldl "Use Data.Enumerator.List.fold instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.fold' instead -- -- Since: 0.4.5 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 {-# DEPRECATED foldl' "Use Data.Enumerator.List.fold instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.fold' instead -- -- Since: 0.4.5 foldl' :: Monad m => (b -> a -> b) -> b -> Iteratee a m b foldl' = EL.fold {-# DEPRECATED foldM "Use Data.Enumerator.List.foldM instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.foldM' instead -- -- Since: 0.4.5 foldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m b foldM = EL.foldM {-# DEPRECATED iterate "Use Data.Enumerator.List.iterate instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.iterate' instead -- -- Since: 0.4.5 iterate :: Monad m => (a -> a) -> a -> Enumerator a m b iterate = EL.iterate {-# DEPRECATED iterateM "Use Data.Enumerator.List.iterateM instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.iterateM' instead -- -- Since: 0.4.5 iterateM :: Monad m => (a -> m a) -> a -> Enumerator a m b iterateM = EL.iterateM {-# DEPRECATED repeat "Use Data.Enumerator.List.repeat instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.repeat' instead -- -- Since: 0.4.5 repeat :: Monad m => a -> Enumerator a m b repeat = EL.repeat {-# DEPRECATED repeatM "Use Data.Enumerator.List.repeatM instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.repeatM' instead -- -- Since: 0.4.5 repeatM :: Monad m => m a -> Enumerator a m b repeatM = EL.repeatM {-# DEPRECATED replicate "Use Data.Enumerator.List.replicate instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.replicate' instead -- -- Since: 0.4.5 replicate :: Monad m => Integer -> a -> Enumerator a m b replicate = EL.replicate {-# DEPRECATED replicateM "Use Data.Enumerator.List.replicateM instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.replicateM' instead -- -- Since: 0.4.5 replicateM :: Monad m => Integer -> m a -> Enumerator a m b replicateM = EL.replicateM {-# DEPRECATED generateM "Use Data.Enumerator.List.generateM instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.generateM' instead -- -- Since: 0.4.5 generateM :: Monad m => m (Maybe a) -> Enumerator a m b generateM = EL.generateM {-# DEPRECATED map "Use Data.Enumerator.List.map instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.map' instead map :: Monad m => (ao -> ai) -> Enumeratee ao ai m b map = EL.map {-# DEPRECATED mapM "Use Data.Enumerator.List.mapM instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.mapM' instead -- -- Since: 0.4.3 mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m b mapM = EL.mapM {-# DEPRECATED concatMap "Use Data.Enumerator.List.concatMap instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.concatMap' instead -- -- Since: 0.4.3 concatMap :: Monad m => (ao -> [ai]) -> Enumeratee ao ai m b concatMap = EL.concatMap {-# DEPRECATED concatMapM "Use Data.Enumerator.List.concatMapM instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.concatMapM' instead -- -- Since: 0.4.5 concatMapM :: Monad m => (ao -> m [ai]) -> Enumeratee ao ai m b concatMapM = EL.concatMapM {-# DEPRECATED filter "Use Data.Enumerator.List.filter instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.filter' instead -- -- Since: 0.4.5 filter :: Monad m => (a -> Bool) -> Enumeratee a a m b filter = EL.filter {-# DEPRECATED filterM "Use Data.Enumerator.List.filterM instead" #-} -- | Deprecated in 0.4.8: use 'Data.Enumerator.List.filterM' instead -- -- Since: 0.4.5 filterM :: Monad m => (a -> m Bool) -> Enumeratee a a m b filterM = EL.filterM {-# DEPRECATED liftFoldL "Use Data.Enumerator.List.fold instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.fold' instead -- -- Since: 0.1.1 liftFoldL :: Monad m => (b -> a -> b) -> b -> Iteratee a m b liftFoldL = Data.Enumerator.foldl {-# DEPRECATED liftFoldL' "Use Data.Enumerator.List.fold instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.fold' instead -- -- Since: 0.1.1 liftFoldL' :: Monad m => (b -> a -> b) -> b -> Iteratee a m b liftFoldL' = EL.fold {-# DEPRECATED liftFoldM "Use Data.Enumerator.List.foldM instead" #-} -- | Deprecated in 0.4.5: use 'Data.Enumerator.List.foldM' instead -- -- Since: 0.1.1 liftFoldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m b liftFoldM = EL.foldM