diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Benchmarks.hs @@ -0,0 +1,98 @@ +-- Copyright (C) 2010-2011 John Millikin +-- +-- See license.txt for details +module Main where + +import Criterion.Types +import qualified Criterion.Config as C +import qualified Criterion.Main as C +import qualified Progression.Config as P +import qualified Progression.Main as P + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as BL + +import qualified Data.Text as T +import qualified Data.Text as TL + +import Data.Enumerator hiding (map, replicate) +import qualified Data.Enumerator as E +import qualified Data.Enumerator.List as EL +import qualified Data.Enumerator.Binary as EB +import qualified Data.Enumerator.Text as ET + +import Control.DeepSeq +import Data.Functor.Identity +import System.Environment +import System.Exit +import System.IO + +instance NFData B.ByteString + +instance NFData BL.ByteString where + rnf a = rnf (BL.toChunks a) + +bytes_100 :: B.ByteString +bytes_100 = B.replicate 100 0x61 + +chars_100 :: T.Text +chars_100 = T.replicate 100 (T.singleton 'a') + +bench_binary :: Iteratee B.ByteString Identity b -> b +bench_binary iter = runIdentity (run_ (enum $$ iter)) where + enum = enumList 2 (replicate 1000 bytes_100) + +bench_text :: Iteratee T.Text Identity b -> b +bench_text iter = runIdentity (run_ (enum $$ iter)) where + enum = enumList 2 (replicate 1000 chars_100) + +bench_bind :: Iteratee Int Identity b -> b +bench_bind iter = runIdentity (run_ (enum 10000 $$ iter)) where + enum 0 step = returnI step + enum n (Continue k) = k (Chunks [n]) >>== enum (n - 1) + enum _ step = returnI step + +bench_enumFile :: Maybe Integer -> Iteratee B.ByteString IO b -> IO b +bench_enumFile limit iter = run_ (EB.enumFileRange "/dev/zero" Nothing limit $$ iter) + +iterUnit :: Monad m => Iteratee a m () +iterUnit = continue loop where + loop EOF = yield () EOF + loop (Chunks _) = continue loop + +iterUnitTo :: Monad m => Int -> Iteratee a m () +iterUnitTo n | n <= 0 = yield () EOF +iterUnitTo n = continue check where + check EOF = yield () EOF + check (Chunks _) = iterUnitTo (n - 1) + +benchmarks :: [Benchmark] +benchmarks = + [ bgroup "general" + [ bench "bind" (nf bench_bind iterUnit) + ] + , bgroup "binary" + [ bench "takeWhile" (nf bench_binary (EB.takeWhile (const True))) + , bench "consume" (nf bench_binary EB.consume) + , bench "enumFile-nolimit" (nfIO (bench_enumFile Nothing (iterUnitTo 10000))) + , bench "enumFile-limit" (nfIO (bench_enumFile (Just 1000000000) (iterUnitTo 10000))) + ] + , bgroup "text" + [ bench "takeWhile" (nf bench_text (ET.takeWhile (const True))) + , bench "consume" (nf bench_text ET.consume) + ] + ] + +main :: IO () +main = do + args <- getArgs + case args of + "progression":extra -> withArgs extra $ P.defaultMain (bgroup "all" benchmarks) + "criterion":extra -> withArgs extra $ let + config = C.defaultConfig { C.cfgPerformGC = C.ljust True } + in C.defaultMainWith config (return ()) benchmarks + _ -> do + name <- getProgName + hPutStrLn stderr $ concat ["Usage: ", name, " "] + exitFailure diff --git a/benchmarks/enumerator-benchmarks.cabal b/benchmarks/enumerator-benchmarks.cabal new file mode 100644 --- /dev/null +++ b/benchmarks/enumerator-benchmarks.cabal @@ -0,0 +1,18 @@ +name: enumerator-benchmarks +version: 0 +build-type: Simple +cabal-version: >= 1.6 + +executable enumerator_benchmarks + main-is: Benchmarks.hs + ghc-options: -Wall -O2 + + build-depends: + base > 3 && < 5 + , transformers + , bytestring + , text + , enumerator + , criterion + , progression + , deepseq diff --git a/enumerator.cabal b/enumerator.cabal --- a/enumerator.cabal +++ b/enumerator.cabal @@ -1,16 +1,16 @@ name: enumerator -version: 0.4.13.1 +version: 0.4.14 synopsis: Reliable, high-performance processing with left-fold enumerators license: MIT license-file: license.txt author: John Millikin maintainer: jmillikin@gmail.com -copyright: Copyright (c) John Millikin 2010 +copyright: Copyright (c) John Millikin 2010-2011 build-type: Simple -cabal-version: >=1.6 +cabal-version: >= 1.6 category: Data, Enumerator stability: experimental -homepage: http://john-millikin.com/software/enumerator/ +homepage: https://john-millikin.com/software/enumerator/ bug-reports: mailto:jmillikin@gmail.com tested-with: GHC==6.12.1 @@ -54,33 +54,19 @@ transformed data to an /inner/ iteratee. extra-source-files: - readme.txt - -- - src/api-docs.anansi - src/compatibility.anansi - src/enumerator.anansi - src/io.anansi - src/list-analogues.anansi - src/primitives.anansi - src/public-interface.anansi - src/summary.anansi - src/text-codecs.anansi - src/types.anansi - src/utilities.anansi + benchmarks/enumerator-benchmarks.cabal + benchmarks/Benchmarks.hs -- examples/cat.hs examples/wc.hs -- scripts/common.bash scripts/dist - scripts/haddock - scripts/latex scripts/run-benchmarks scripts/run-tests -- - tests/Benchmarks.hs tests/enumerator-tests.cabal - tests/Properties.hs + tests/Tests.hs source-repository head type: bazaar @@ -88,7 +74,7 @@ library ghc-options: -Wall -O2 - hs-source-dirs: hs + hs-source-dirs: lib build-depends: transformers >= 0.2 && < 0.3 diff --git a/hs/Data/Enumerator.hs b/hs/Data/Enumerator.hs deleted file mode 100644 --- a/hs/Data/Enumerator.hs +++ /dev/null @@ -1,958 +0,0 @@ - - ------------------------------------------------------------------------------ --- | --- 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 diff --git a/hs/Data/Enumerator.hs-boot b/hs/Data/Enumerator.hs-boot deleted file mode 100644 --- a/hs/Data/Enumerator.hs-boot +++ /dev/null @@ -1,13 +0,0 @@ - -module Data.Enumerator where -import qualified Control.Exception as Exc -data Stream a -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) - } -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) diff --git a/hs/Data/Enumerator/Binary.hs b/hs/Data/Enumerator/Binary.hs deleted file mode 100644 --- a/hs/Data/Enumerator/Binary.hs +++ /dev/null @@ -1,629 +0,0 @@ - - ------------------------------------------------------------------------------ --- | --- Module: Data.Enumerator.Binary --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Byte-oriented alternatives to "Data.Enumerator.List". Note that the --- enumeratees in this module must unpack their inputs to work properly. If --- you do not need to handle leftover input on a byte-by-byte basis, the --- chunk-oriented versions will be much faster. --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Data.Enumerator.Binary as EB --- @ --- --- Since: 0.4.5 --- ------------------------------------------------------------------------------ - -module Data.Enumerator.Binary ( - - -- * IO - enumHandle - , enumHandleRange - , enumFile - , enumFileRange - , iterHandle - - -- * List analogues - - -- ** Folds - , fold - , foldM - - -- ** Maps - , Data.Enumerator.Binary.map - , Data.Enumerator.Binary.mapM - , Data.Enumerator.Binary.mapM_ - , Data.Enumerator.Binary.concatMap - , concatMapM - - -- ** Accumulating maps - , mapAccum - , mapAccumM - , concatMapAccum - , concatMapAccumM - - -- ** Infinite streams - , Data.Enumerator.Binary.iterate - , iterateM - , Data.Enumerator.Binary.repeat - , repeatM - - -- ** Bounded streams - , Data.Enumerator.Binary.replicate - , replicateM - , generateM - , unfold - , unfoldM - - -- ** Filters - , Data.Enumerator.Binary.filter - , filterM - - -- ** Consumers - , Data.Enumerator.Binary.take - , takeWhile - , consume - - -- ** Unsorted - , Data.Enumerator.Binary.head - , Data.Enumerator.Binary.drop - , Data.Enumerator.Binary.dropWhile - , require - , isolate - , splitWhen - - - ) where - -import Prelude hiding (head, drop, takeWhile, mapM_) -import Data.Enumerator hiding ( head, drop, iterateM, repeatM, replicateM - , generateM, filterM, consume, foldM - , concatMapM) -import Control.Monad.IO.Class (MonadIO) -import qualified Data.ByteString as B -import qualified System.IO as IO -import qualified Control.Exception as Exc -import System.IO.Error (isEOFError) -import Data.Word (Word8) -import qualified Data.Enumerator.List as EL -import qualified Control.Monad as CM -import qualified Data.ByteString.Lazy as BL -import Control.Monad.Trans.Class (lift) -import Control.Monad (liftM) - - - --- | Consume the entire input stream with a strict left fold, one byte --- at a time. --- --- Since: 0.4.8 - -fold :: Monad m => (b -> Word8 -> b) -> b - -> Iteratee B.ByteString m b -fold step = EL.fold (B.foldl' step) - - --- | Consume the entire input stream with a strict monadic left fold, one --- byte at a time. --- --- Since: 0.4.8 - -foldM :: Monad m => (b -> Word8 -> m b) -> b - -> Iteratee B.ByteString m b -foldM step = EL.foldM (\b bytes -> CM.foldM step b (B.unpack bytes)) - - --- | Enumerates a stream of bytes by repeatedly applying a function to --- some state. --- --- Similar to 'iterate'. --- --- Since: 0.4.8 - -unfold :: Monad m => (s -> Maybe (Word8, s)) -> s -> Enumerator B.ByteString m b -unfold f = checkContinue1 $ \loop s k -> case f s of - Nothing -> continue k - Just (b, s') -> k (Chunks [B.singleton b]) >>== loop s' - - --- | Enumerates a stream of bytes by repeatedly applying a computation to --- some state. --- --- Similar to 'iterateM'. --- --- Since: 0.4.8 - -unfoldM :: Monad m => (s -> m (Maybe (Word8, s))) -> s -> Enumerator B.ByteString m b -unfoldM f = checkContinue1 $ \loop s k -> do - fs <- lift (f s) - case fs of - Nothing -> continue k - Just (b, s') -> k (Chunks [B.singleton b]) >>== loop s' - - --- | @'map' f@ applies /f/ to each input byte and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -map :: Monad m => (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m b -map f = Data.Enumerator.Binary.concatMap (\x -> B.singleton (f x)) - - --- | @'mapM' f@ applies /f/ to each input byte and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -mapM :: Monad m => (Word8 -> m Word8) -> Enumeratee B.ByteString B.ByteString m b -mapM f = Data.Enumerator.Binary.concatMapM (\x -> liftM B.singleton (f x)) - - --- | @'mapM_' f@ applies /f/ to each input byte, and discards the results. --- --- Since: 0.4.11 - -mapM_ :: Monad m => (Word8 -> m ()) -> Iteratee B.ByteString m () -mapM_ f = foldM (\_ x -> f x >> return ()) () - - --- | @'concatMap' f@ applies /f/ to each input byte and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -concatMap :: Monad m => (Word8 -> B.ByteString) -> Enumeratee B.ByteString B.ByteString m b -concatMap f = Data.Enumerator.Binary.concatMapM (return . f) - - --- | @'concatMapM' f@ applies /f/ to each input byte and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -concatMapM :: Monad m => (Word8 -> m B.ByteString) -> Enumeratee B.ByteString B.ByteString m b -concatMapM f = checkDone (continue . step) where - step k EOF = yield (Continue k) EOF - step k (Chunks xs) = loop k (BL.unpack (BL.fromChunks xs)) - - loop k [] = continue (step k) - loop k (x:xs) = do - fx <- lift (f x) - k (Chunks [fx]) >>== - checkDoneEx (Chunks [B.pack xs]) (\k' -> loop k' xs) - - --- | Similar to 'concatMap', but with a stateful step function. --- --- Since: 0.4.11 - -concatMapAccum :: Monad m => (s -> Word8 -> (s, B.ByteString)) -> s -> Enumeratee B.ByteString B.ByteString m b -concatMapAccum f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case B.uncons x of - Nothing -> loop s k xs - Just (b, x') -> case f s b of - (s', ai) -> k (Chunks [ai]) >>== - checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) - - --- | Similar to 'concatMapM', but with a stateful step function. --- --- Since: 0.4.11 - -concatMapAccumM :: Monad m => (s -> Word8 -> m (s, B.ByteString)) -> s -> Enumeratee B.ByteString B.ByteString m b -concatMapAccumM f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case B.uncons x of - Nothing -> loop s k xs - Just (b, x') -> do - (s', ai) <- lift (f s b) - k (Chunks [ai]) >>== - checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) - - --- | Similar to 'map', but with a stateful step function. --- --- Since: 0.4.9 - -mapAccum :: Monad m => (s -> Word8 -> (s, Word8)) -> s -> Enumeratee B.ByteString B.ByteString m b -mapAccum f = concatMapAccum (\s w -> case f s w of (s', w') -> (s', B.singleton w')) - - --- | Similar to 'mapM', but with a stateful step function. --- --- Since: 0.4.9 - -mapAccumM :: Monad m => (s -> Word8 -> m (s, Word8)) -> s -> Enumeratee B.ByteString B.ByteString m b -mapAccumM f = concatMapAccumM (\s w -> do - (s', w') <- f s w - return (s', B.singleton w')) - - --- | @'iterate' f x@ enumerates an infinite stream of repeated applications --- of /f/ to /x/. --- --- Analogous to 'Prelude.iterate'. --- --- Since: 0.4.8 - -iterate :: Monad m => (Word8 -> Word8) -> Word8 -> Enumerator B.ByteString m b -iterate f = checkContinue1 $ \loop s k -> k (Chunks [B.singleton s]) >>== loop (f s) - - --- | Similar to 'iterate', except the iteration function is monadic. --- --- Since: 0.4.8 - -iterateM :: Monad m => (Word8 -> m Word8) -> Word8 -> Enumerator B.ByteString m b -iterateM f base = worker (return base) where - worker = checkContinue1 $ \loop m_byte k -> do - byte <- lift m_byte - k (Chunks [B.singleton byte]) >>== loop (f byte) - - --- | Enumerates an infinite stream of a single byte. --- --- Analogous to 'Prelude.repeat'. --- --- Since: 0.4.8 - -repeat :: Monad m => Word8 -> Enumerator B.ByteString m b -repeat byte = EL.repeat (B.singleton byte) - - --- | Enumerates an infinite stream of byte. Each byte is computed by the --- underlying monad. --- --- Since: 0.4.8 - -repeatM :: Monad m => m Word8 -> Enumerator B.ByteString m b -repeatM next = EL.repeatM (liftM B.singleton next) - - --- | @'replicate' n x@ enumerates a stream containing /n/ copies of /x/. --- --- Since: 0.4.8 - -replicate :: Monad m => Integer -> Word8 -> Enumerator B.ByteString m b -replicate n byte = EL.replicate n (B.singleton byte) - - --- | @'replicateM' n m_x@ enumerates a stream of /n/ bytes, with each byte --- computed by /m_x/. --- --- Since: 0.4.8 - -replicateM :: Monad m => Integer -> m Word8 -> Enumerator B.ByteString m b -replicateM n next = EL.replicateM n (liftM B.singleton next) - - --- | Like 'repeatM', except the computation may terminate the stream by --- returning 'Nothing'. --- --- Since: 0.4.8 - -generateM :: Monad m => m (Maybe Word8) -> Enumerator B.ByteString m b -generateM next = EL.generateM (liftM (liftM B.singleton) next) - - --- | Applies a predicate to the stream. The inner iteratee only receives --- characters for which the predicate is @True@. --- --- Since: 0.4.8 - -filter :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b -filter p = Data.Enumerator.Binary.concatMap (\x -> B.pack [x | p x]) - - --- | Applies a monadic predicate to the stream. The inner iteratee only --- receives bytes for which the predicate returns @True@. --- --- Since: 0.4.8 - -filterM :: Monad m => (Word8 -> m Bool) -> Enumeratee B.ByteString B.ByteString m b -filterM p = Data.Enumerator.Binary.concatMapM (\x -> liftM B.pack (CM.filterM p [x])) - - --- | @'take' n@ extracts the next /n/ bytes from the stream, as a lazy --- ByteString. --- --- Since: 0.4.5 - -take :: Monad m => Integer -> Iteratee B.ByteString m BL.ByteString -take n | n <= 0 = return BL.empty -take n = continue (loop id n) where - loop acc n' (Chunks xs) = iter where - lazy = BL.fromChunks xs - len = toInteger (BL.length lazy) - - iter = if len < n' - then continue (loop (acc . (BL.append lazy)) (n' - len)) - else let - (xs', extra) = BL.splitAt (fromInteger n') lazy - in yield (acc xs') (toChunks extra) - loop acc _ EOF = yield (acc BL.empty) EOF - - --- | @'takeWhile' p@ extracts input from the stream until the first byte which --- does not match the predicate. --- --- Since: 0.4.5 - -takeWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m BL.ByteString -takeWhile p = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = iter where - lazy = BL.fromChunks xs - (xs', extra) = BL.span p lazy - iter = if BL.null extra - then continue (loop (acc . (BL.append lazy))) - else yield (acc xs') (toChunks extra) - loop acc EOF = yield (acc BL.empty) EOF - - --- | @'consume' = 'takeWhile' (const True)@ --- --- Since: 0.4.5 - -consume :: Monad m => Iteratee B.ByteString m BL.ByteString -consume = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = iter where - lazy = BL.fromChunks xs - iter = continue (loop (acc . (BL.append lazy))) - loop acc EOF = yield (acc BL.empty) EOF - - --- | Get the next byte from the stream, or 'Nothing' if the stream has --- ended. --- --- Since: 0.4.5 - -head :: Monad m => Iteratee B.ByteString m (Maybe Word8) -head = continue loop where - loop (Chunks xs) = case BL.uncons (BL.fromChunks xs) of - Just (char, extra) -> yield (Just char) (toChunks extra) - Nothing -> head - loop EOF = yield Nothing EOF - - --- | @'drop' n@ ignores /n/ bytes of input from the stream. --- --- Since: 0.4.5 - -drop :: Monad m => Integer -> Iteratee B.ByteString m () -drop n | n <= 0 = return () -drop n = continue (loop n) where - loop n' (Chunks xs) = iter where - lazy = BL.fromChunks xs - len = toInteger (BL.length lazy) - iter = if len < n' - then drop (n' - len) - else yield () (toChunks (BL.drop (fromInteger n') lazy)) - loop _ EOF = yield () EOF - - --- | @'dropWhile' p@ ignores input from the stream until the first byte --- which does not match the predicate. --- --- Since: 0.4.5 - -dropWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m () -dropWhile p = continue loop where - loop (Chunks xs) = iter where - lazy = BL.dropWhile p (BL.fromChunks xs) - iter = if BL.null lazy - then continue loop - else yield () (toChunks lazy) - loop EOF = yield () EOF - - --- | @'require' n@ buffers input until at least /n/ bytes are available, or --- throws an error if the stream ends early. --- --- Since: 0.4.5 - -require :: Monad m => Integer -> Iteratee B.ByteString m () -require n | n <= 0 = return () -require n = continue (loop id n) where - loop acc n' (Chunks xs) = iter where - lazy = BL.fromChunks xs - len = toInteger (BL.length lazy) - iter = if len < n' - then continue (loop (acc . (BL.append lazy)) (n' - len)) - else yield () (toChunks (acc lazy)) - loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") - - --- | @'isolate' n@ reads at most /n/ bytes from the stream, and passes them --- to its iteratee. If the iteratee finishes early, bytes continue to be --- consumed from the outer stream until /n/ have been consumed. --- --- Since: 0.4.5 - -isolate :: Monad m => Integer -> Enumeratee B.ByteString B.ByteString m b -isolate n step | n <= 0 = return step -isolate n (Continue k) = continue loop where - loop (Chunks []) = continue loop - loop (Chunks xs) = iter where - lazy = BL.fromChunks xs - len = toInteger (BL.length lazy) - - iter = if len <= n - then k (Chunks xs) >>== isolate (n - len) - else let - (s1, s2) = BL.splitAt (fromInteger n) lazy - in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) - loop EOF = k EOF >>== (\step -> yield step EOF) -isolate n step = drop n >> return step - - --- | Split on bytes satisfying a given predicate. --- --- Since: 0.4.8 - -splitWhen :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b -splitWhen p = loop where - loop = checkDone step - step k = isEOF >>= \eof -> if eof - then yield (Continue k) EOF - else do - lazy <- takeWhile (not . p) - let bytes = B.concat (BL.toChunks lazy) - eof <- isEOF - drop 1 - if BL.null lazy && eof - then yield (Continue k) EOF - else k (Chunks [bytes]) >>== loop - - - --- | Read bytes (in chunks of the given buffer size) from the handle, and --- stream them to an 'Iteratee'. If an exception occurs during file IO, --- enumeration will stop and 'Error' will be returned. Exceptions from the --- iteratee are not caught. --- --- This enumerator blocks until at least one byte is available from the --- handle, and might read less than the maximum buffer size in some --- cases. --- --- The handle should be opened with no encoding, and in 'IO.ReadMode' or --- 'IO.ReadWriteMode'. --- --- Since: 0.4.5 - -enumHandle :: MonadIO m - => Integer -- ^ Buffer size - -> IO.Handle - -> Enumerator B.ByteString m b -enumHandle bufferSize h = checkContinue0 $ \loop k -> do - let intSize = fromInteger bufferSize - - bytes <- tryIO (getBytes h intSize) - if B.null bytes - then continue k - else k (Chunks [bytes]) >>== loop - - --- | Read bytes (in chunks of the given buffer size) from the handle, and --- stream them to an 'Iteratee'. If an exception occurs during file IO, --- enumeration will stop and 'Error' will be returned. Exceptions from the --- iteratee are not caught. --- --- This enumerator blocks until at least one byte is available from the --- handle, and might read less than the maximum buffer size in some --- cases. --- --- The handle should be opened with no encoding, and in 'IO.ReadMode' or --- 'IO.ReadWriteMode'. --- --- If an offset is specified, the handle will be seeked to that offset --- before reading. If the handle cannot be seeked, an error will be --- thrown. --- --- If a maximum count is specified, the number of bytes read will not --- exceed that count. --- --- Since: 0.4.8 - -enumHandleRange :: MonadIO m - => Integer -- ^ Buffer size - -> Maybe Integer -- ^ Offset - -> Maybe Integer -- ^ Maximum count - -> IO.Handle - -> Enumerator B.ByteString m b -enumHandleRange bufferSize offset count h s = seek >> enum where - seek = case offset of - Nothing -> return () - Just off -> tryIO (IO.hSeek h IO.AbsoluteSeek off) - - enum = case count of - Just n -> enumRange n s - Nothing -> enumHandle bufferSize h s - - enumRange = checkContinue1 $ \loop n k -> let - rem = fromInteger (min bufferSize n) - keepGoing = do - bytes <- tryIO (getBytes h rem) - if B.null bytes - then continue k - else feed bytes - feed bs = k (Chunks [bs]) >>== loop (n - (toInteger (B.length bs))) - in if rem <= 0 - then continue k - else keepGoing - -getBytes :: IO.Handle -> Int -> IO B.ByteString -getBytes h n = do - hasInput <- Exc.catch - (IO.hWaitForInput h (-1)) - (\err -> if isEOFError err - then return False - else Exc.throwIO err) - if hasInput - then B.hGetNonBlocking h n - else return B.empty - - --- | Opens a file path in binary mode, and passes the handle to --- 'enumHandle'. The file will be closed when enumeration finishes. --- --- Since: 0.4.5 - -enumFile :: FilePath -> Enumerator B.ByteString IO b -enumFile path = enumFileRange path Nothing Nothing - - --- | Opens a file path in binary mode, and passes the handle to --- 'enumHandleRange'. The file will be closed when enumeration finishes. --- --- Since: 0.4.8 - -enumFileRange :: FilePath - -> Maybe Integer -- ^ Offset - -> Maybe Integer -- ^ Maximum count - -> Enumerator B.ByteString IO b -enumFileRange path offset count step = do - h <- tryIO (IO.openBinaryFile path IO.ReadMode) - let iter = enumHandleRange 4096 offset count h step - Iteratee (Exc.finally (runIteratee iter) (IO.hClose h)) - - --- | Read bytes from a stream and write them to a handle. If an exception --- occurs during file IO, enumeration will stop and 'Error' will be --- returned. --- --- The handle should be opened with no encoding, and in 'IO.WriteMode' or --- 'IO.ReadWriteMode'. --- --- Since: 0.4.5 - -iterHandle :: MonadIO m => IO.Handle - -> Iteratee B.ByteString m () -iterHandle h = continue step where - step EOF = yield () EOF - step (Chunks []) = continue step - step (Chunks bytes) = do - tryIO (CM.mapM_ (B.hPut h) bytes) - continue step - - -toChunks :: BL.ByteString -> Stream B.ByteString -toChunks = Chunks . BL.toChunks diff --git a/hs/Data/Enumerator/IO.hs b/hs/Data/Enumerator/IO.hs deleted file mode 100644 --- a/hs/Data/Enumerator/IO.hs +++ /dev/null @@ -1,51 +0,0 @@ - - ------------------------------------------------------------------------------ --- | --- Module: Data.Enumerator.IO --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Deprecated in 0.4.5: use "Data.Enumerator.Binary" instead --- ------------------------------------------------------------------------------ - -module Data.Enumerator.IO - {-# DEPRECATED "Use 'Data.Enumerator.Binary' instead" #-} - ( enumHandle - , enumFile - , iterHandle - ) where -import qualified Data.Enumerator as E -import qualified Data.Enumerator.Binary as EB -import Control.Monad.IO.Class (MonadIO) -import qualified Data.ByteString as B -import qualified System.IO as IO - -{-# DEPRECATED enumHandle "Use 'Data.Enumerator.Binary.enumHandle' instead" #-} - --- | Deprecated in 0.4.5: use 'EB.enumHandle' instead - -enumHandle :: MonadIO m - => Integer - -> IO.Handle - -> E.Enumerator B.ByteString m b -enumHandle = EB.enumHandle - -{-# DEPRECATED enumFile "Use 'Data.Enumerator.Binary.enumFile' instead" #-} - --- | Deprecated in 0.4.5: use 'EB.enumFile' instead - -enumFile :: FilePath -> E.Enumerator B.ByteString IO b -enumFile = EB.enumFile - -{-# DEPRECATED iterHandle "Use 'Data.Enumerator.Binary.iterHandle' instead" #-} - --- | Deprecated in 0.4.5: use 'EB.iterHandle' instead - -iterHandle :: MonadIO m => IO.Handle - -> E.Iteratee B.ByteString m () -iterHandle = EB.iterHandle diff --git a/hs/Data/Enumerator/List.hs b/hs/Data/Enumerator/List.hs deleted file mode 100644 --- a/hs/Data/Enumerator/List.hs +++ /dev/null @@ -1,495 +0,0 @@ - - ------------------------------------------------------------------------------ --- | --- Module: Data.Enumerator.List --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Data.Enumerator.List as EL --- @ --- --- Since: 0.4.5 --- ------------------------------------------------------------------------------ - -module Data.Enumerator.List ( - - -- * List analogues - - -- ** Folds - fold - , foldM - - -- ** Maps - , Data.Enumerator.List.map - , Data.Enumerator.List.mapM - , Data.Enumerator.List.mapM_ - , Data.Enumerator.List.concatMap - , concatMapM - - -- ** Accumulating maps - , mapAccum - , mapAccumM - , concatMapAccum - , concatMapAccumM - - -- ** Infinite streams - , Data.Enumerator.List.iterate - , iterateM - , Data.Enumerator.List.repeat - , repeatM - - -- ** Bounded streams - , Data.Enumerator.List.replicate - , replicateM - , generateM - , unfold - , unfoldM - - -- ** Filters - , Data.Enumerator.List.filter - , filterM - - -- ** Consumers - , Data.Enumerator.List.take - , takeWhile - , consume - - -- ** Unsorted - , head - , drop - , Data.Enumerator.List.dropWhile - , require - , isolate - , splitWhen - , unique - - ) where - -import Prelude hiding (head, drop, sequence, takeWhile) -import Data.Enumerator hiding ( concatMapM, iterateM, replicateM, head, drop - , foldM, repeatM, generateM, filterM, consume) -import Control.Monad.Trans.Class (lift) -import qualified Control.Monad as CM -import qualified Data.List as L -import Control.Exception (ErrorCall(..)) -import qualified Data.Set - - - --- | Consume the entire input stream with a strict left fold, one element --- at a time. --- --- Since: 0.4.8 - -fold :: Monad m => (b -> a -> b) -> b - -> Iteratee a m b -fold step = continue . loop where - f = L.foldl' step - loop acc stream = case stream of - Chunks [] -> continue (loop acc) - Chunks xs -> continue (loop $! f acc xs) - EOF -> yield acc EOF - - --- | Consume the entire input stream with a strict monadic left fold, one --- element at a time. --- --- Since: 0.4.8 - -foldM :: Monad m => (b -> a -> m b) -> b - -> Iteratee a m b -foldM step = continue . loop where - f = CM.foldM step - - loop acc stream = acc `seq` case stream of - Chunks [] -> continue (loop acc) - Chunks xs -> lift (f acc xs) >>= continue . loop - EOF -> yield acc EOF - - --- | Enumerates a stream of elements by repeatedly applying a function to --- some state. --- --- Similar to 'iterate'. --- --- Since: 0.4.8 - -unfold :: Monad m => (s -> Maybe (a, s)) -> s -> Enumerator a m b -unfold f = checkContinue1 $ \loop s k -> case f s of - Nothing -> continue k - Just (a, s') -> k (Chunks [a]) >>== loop s' - - --- | Enumerates a stream of elements by repeatedly applying a computation to --- some state. --- --- Similar to 'iterateM'. --- --- Since: 0.4.8 - -unfoldM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Enumerator a m b -unfoldM f = checkContinue1 $ \loop s k -> do - fs <- lift (f s) - case fs of - Nothing -> continue k - Just (a, s') -> k (Chunks [a]) >>== loop s' - - --- | @'concatMapM' f@ applies /f/ to each input element and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -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' f@ applies /f/ to each input element and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -concatMap :: Monad m => (ao -> [ai]) - -> Enumeratee ao ai m b -concatMap f = concatMapM (return . f) - - --- | @'map' f@ applies /f/ to each input element and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -map :: Monad m => (ao -> ai) - -> Enumeratee ao ai m b -map f = Data.Enumerator.List.concatMap (\x -> [f x]) - - --- | @'mapM' f@ applies /f/ to each input element and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -mapM :: Monad m => (ao -> m ai) - -> Enumeratee ao ai m b -mapM f = concatMapM (\x -> Prelude.mapM f [x]) - - --- | @'mapM_' f@ applies /f/ to each input element, and discards the results. --- --- Since: 0.4.11 - -mapM_ :: Monad m => (a -> m b) -> Iteratee a m () -mapM_ f = foldM (\_ x -> f x >> return ()) () - - --- | Similar to 'concatMap', but with a stateful step function. --- --- Since: 0.4.11 - -concatMapAccum :: Monad m => (s -> ao -> (s, [ai])) -> s -> Enumeratee ao ai m b -concatMapAccum f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case f s x of - (s', ai) -> k (Chunks ai) >>== - checkDoneEx (Chunks xs) (\k' -> loop s' k' xs) - - --- | Similar to 'concatMapM', but with a stateful step function. --- --- Since: 0.4.11 - -concatMapAccumM :: Monad m => (s -> ao -> m (s, [ai])) -> s -> Enumeratee ao ai m b -concatMapAccumM f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = do - (s', ai) <- lift (f s x) - k (Chunks ai) >>== - checkDoneEx (Chunks xs) (\k' -> loop s' k' xs) - - --- | Similar to 'map', but with a stateful step function. --- --- Since: 0.4.9 - -mapAccum :: Monad m => (s -> ao -> (s, ai)) -> s -> Enumeratee ao ai m b -mapAccum f = concatMapAccum (\s ao -> case f s ao of (s', ai) -> (s', [ai])) - - --- | Similar to 'mapM', but with a stateful step function. --- --- Since: 0.4.9 - -mapAccumM :: Monad m => (s -> ao -> m (s, ai)) -> s -> Enumeratee ao ai m b -mapAccumM f = concatMapAccumM (\s ao -> do - (s', ai) <- f s ao - return (s', [ai])) - - --- | @'iterate' f x@ enumerates an infinite stream of repeated applications --- of /f/ to /x/. --- --- Analogous to 'Prelude.iterate'. --- --- Since: 0.4.8 - -iterate :: Monad m => (a -> a) -> a -> Enumerator a m b -iterate f = checkContinue1 $ \loop s k -> k (Chunks [s]) >>== loop (f s) - - --- | Similar to 'iterate', except the iteration function is monadic. --- --- Since: 0.4.8 - -iterateM :: Monad m => (a -> m a) -> a - -> Enumerator a m b -iterateM f base = worker (return base) where - worker = checkContinue1 $ \loop m_a k -> do - a <- lift m_a - k (Chunks [a]) >>== loop (f a) - - --- | Enumerates an infinite stream of a single element. --- --- Analogous to 'Prelude.repeat'. --- --- Since: 0.4.8 - -repeat :: Monad m => a -> Enumerator a m b -repeat a = checkContinue0 $ \loop k -> k (Chunks [a]) >>== loop - - --- | Enumerates an infinite stream of element. Each element is computed by --- the underlying monad. --- --- Since: 0.4.8 - -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' n m_x@ enumerates a stream of /n/ elements, with each --- element computed by /m_x/. --- --- Since: 0.4.8 - -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' n x@ enumerates a stream containing /n/ copies of /x/. --- --- Analogous to 'Prelude.replicate'. --- --- Since: 0.4.8 - -replicate :: Monad m => Integer -> a - -> Enumerator a m b -replicate maxCount a = replicateM maxCount (return a) - - --- | Like 'repeatM', except the computation may terminate the stream by --- returning 'Nothing'. --- --- Since: 0.4.8 - -generateM :: Monad m => m (Maybe a) - -> Enumerator a m b -generateM getNext = checkContinue0 $ \loop k -> do - next <- lift getNext - case next of - Nothing -> continue k - Just x -> k (Chunks [x]) >>== loop - - --- | Applies a predicate to the stream. The inner iteratee only receives --- elements for which the predicate is @True@. --- --- Since: 0.4.8 - -filter :: Monad m => (a -> Bool) - -> Enumeratee a a m b -filter p = Data.Enumerator.List.concatMap (\x -> [x | p x]) - - --- | Applies a monadic predicate to the stream. The inner iteratee only --- receives elements for which the predicate returns @True@. --- --- Since: 0.4.8 - -filterM :: Monad m => (a -> m Bool) - -> Enumeratee a a m b -filterM p = concatMapM (\x -> CM.filterM p [x]) - - --- | @'take' n@ extracts the next /n/ elements from the stream, as a list. --- --- Since: 0.4.5 - -take :: Monad m => Integer -> Iteratee a m [a] -take n | n <= 0 = return [] -take n = continue (loop id n) where - len = L.genericLength - loop acc n' (Chunks xs) - | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) - | otherwise = let - (xs', extra) = L.genericSplitAt n' xs - in yield (acc xs') (Chunks extra) - loop acc _ EOF = yield (acc []) EOF - - --- | @'takeWhile' p@ extracts input from the stream until the first element --- which does not match the predicate. --- --- Since: 0.4.5 - -takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] -takeWhile p = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = case Prelude.span p xs of - (_, []) -> continue (loop (acc . (xs ++))) - (xs', extra) -> yield (acc xs') (Chunks extra) - loop acc EOF = yield (acc []) EOF - - --- | @'consume' = 'takeWhile' (const True)@ --- --- Since: 0.4.5 - -consume :: Monad m => Iteratee a m [a] -consume = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = continue (loop (acc . (xs ++))) - loop acc EOF = yield (acc []) EOF - - --- | Get the next element from the stream, or 'Nothing' if the stream has --- ended. --- --- Since: 0.4.5 - -head :: Monad m => Iteratee a m (Maybe a) -head = continue loop where - loop (Chunks []) = head - loop (Chunks (x:xs)) = yield (Just x) (Chunks xs) - loop EOF = yield Nothing EOF - - --- | @'drop' n@ ignores /n/ input elements from the stream. --- --- Since: 0.4.5 - -drop :: Monad m => Integer -> Iteratee a m () -drop n | n <= 0 = return () -drop n = continue (loop n) where - loop n' (Chunks xs) = iter where - len = L.genericLength xs - iter = if len < n' - then drop (n' - len) - else yield () (Chunks (L.genericDrop n' xs)) - loop _ EOF = yield () EOF - - --- | @'dropWhile' p@ ignores input from the stream until the first element --- which does not match the predicate. --- --- Since: 0.4.5 - -dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () -dropWhile p = continue loop where - loop (Chunks xs) = case L.dropWhile p xs of - [] -> continue loop - xs' -> yield () (Chunks xs') - loop EOF = yield () EOF - - --- | @'require' n@ buffers input until at least /n/ elements are available, or --- throws an error if the stream ends early. --- --- Since: 0.4.5 - -require :: Monad m => Integer -> Iteratee a m () -require n | n <= 0 = return () -require n = continue (loop id n) where - len = L.genericLength - loop acc n' (Chunks xs) - | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) - | otherwise = yield () (Chunks (acc xs)) - loop _ _ EOF = throwError (ErrorCall "require: Unexpected EOF") - - --- | @'isolate' n@ reads at most /n/ elements from the stream, and passes them --- to its iteratee. If the iteratee finishes early, elements continue to be --- consumed from the outer stream until /n/ have been consumed. --- --- Since: 0.4.5 - -isolate :: Monad m => Integer -> Enumeratee a a m b -isolate n step | n <= 0 = return step -isolate n (Continue k) = continue loop where - len = L.genericLength - - loop (Chunks []) = continue loop - loop (Chunks xs) - | len xs <= n = k (Chunks xs) >>== isolate (n - len xs) - | otherwise = let - (s1, s2) = L.genericSplitAt n xs - in k (Chunks s1) >>== (\step -> yield step (Chunks s2)) - loop EOF = k EOF >>== (\step -> yield step EOF) -isolate n step = drop n >> return step - - --- | Split on elements satisfying a given predicate. --- --- Since: 0.4.8 - -splitWhen :: Monad m => (a -> Bool) -> Enumeratee a [a] m b -splitWhen p = sequence $ do - as <- takeWhile (not . p) - drop 1 - return as - - --- | Remove duplicate elements from a stream, passing through the first --- instance of each value. --- --- Similar to 'nub', but more efficient because it uses a 'Data.Set.Set' --- internally. --- --- Since: 0.4.11 - -unique :: (Ord a, Monad m) => Enumeratee a a m b -unique = concatMapAccum step Data.Set.empty where - step s x = if Data.Set.member x s - then (s, []) - else (Data.Set.insert x s, [x]) diff --git a/hs/Data/Enumerator/List.hs-boot b/hs/Data/Enumerator/List.hs-boot deleted file mode 100644 --- a/hs/Data/Enumerator/List.hs-boot +++ /dev/null @@ -1,23 +0,0 @@ - -module Data.Enumerator.List where -import {-# SOURCE #-} Data.Enumerator -head :: Monad m => Iteratee a m (Maybe a) -drop :: Monad m => Integer -> Iteratee a m () -dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () -takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] -consume :: Monad m => Iteratee a m [a] -fold :: Monad m => (b -> a -> b) -> b -> Iteratee a m b -foldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m b -iterate :: Monad m => (a -> a) -> a -> Enumerator a m b -iterateM :: Monad m => (a -> m a) -> a -> Enumerator a m b -repeat :: Monad m => a -> Enumerator a m b -repeatM :: Monad m => m a -> Enumerator a m b -replicateM :: Monad m => Integer -> m a -> Enumerator a m b -replicate :: Monad m => Integer -> a -> Enumerator a m b -generateM :: Monad m => m (Maybe a) -> Enumerator a m b -map :: Monad m => (ao -> ai) -> Enumeratee ao ai m b -mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m b -concatMap :: Monad m => (ao -> [ai]) -> Enumeratee ao ai m b -concatMapM :: Monad m => (ao -> m [ai]) -> Enumeratee ao ai m b -filter :: Monad m => (a -> Bool) -> Enumeratee a a m b -filterM :: Monad m => (a -> m Bool) -> Enumeratee a a m b diff --git a/hs/Data/Enumerator/Text.hs b/hs/Data/Enumerator/Text.hs deleted file mode 100644 --- a/hs/Data/Enumerator/Text.hs +++ /dev/null @@ -1,855 +0,0 @@ - - ------------------------------------------------------------------------------ --- | --- Module: Data.Enumerator.Text --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Character-oriented alternatives to "Data.Enumerator.List". Note that the --- enumeratees in this module must unpack their inputs to work properly. If --- you do not need to handle leftover input on a char-by-char basis, the --- chunk-oriented versions will be much faster. --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Data.Enumerator.Text as ET --- @ --- --- Since: 0.2 --- ------------------------------------------------------------------------------ - -module Data.Enumerator.Text ( - - -- * IO - enumHandle - , enumFile - , iterHandle - - -- * List analogues - - -- ** Folds - , fold - , foldM - - -- ** Maps - , Data.Enumerator.Text.map - , Data.Enumerator.Text.mapM - , Data.Enumerator.Text.mapM_ - , Data.Enumerator.Text.concatMap - , concatMapM - - -- ** Accumulating maps - , mapAccum - , mapAccumM - , concatMapAccum - , concatMapAccumM - - -- ** Infinite streams - , Data.Enumerator.Text.iterate - , iterateM - , Data.Enumerator.Text.repeat - , repeatM - - -- ** Bounded streams - , Data.Enumerator.Text.replicate - , replicateM - , generateM - , unfold - , unfoldM - - -- ** Filters - , Data.Enumerator.Text.filter - , filterM - - -- ** Consumers - , Data.Enumerator.Text.take - , takeWhile - , consume - - -- ** Unsorted - , Data.Enumerator.Text.head - , Data.Enumerator.Text.drop - , Data.Enumerator.Text.dropWhile - , require - , isolate - , splitWhen - , lines - - -- * Text codecs - , Codec - , encode - , decode - , utf8 - , utf16_le - , utf16_be - , utf32_le - , utf32_be - , ascii - , iso8859_1 - - ) where - -import Prelude hiding (head, drop, takeWhile, lines) -import qualified Prelude -import Data.Enumerator hiding ( head, drop, generateM, filterM, consume - , concatMapM, iterateM, repeatM, replicateM - , foldM) -import Data.Enumerator.Util (tSpanBy, tlSpanBy, reprWord, reprChar, textToStrict) -import Control.Monad.IO.Class (MonadIO) -import qualified Control.Exception as Exc -import Control.Arrow (first) -import Data.Maybe (catMaybes) -import qualified Data.Text as T -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.Text.Encoding as TE -import Data.Word (Word8, Word16) -import Data.Bits ((.&.), (.|.), shiftL) -import qualified System.IO as IO -import System.IO.Error (isEOFError) -import qualified Data.Text.IO as TIO -import Data.Char (ord) -import System.IO.Unsafe (unsafePerformIO) -import qualified Data.Text.Lazy as TL -import qualified Data.Enumerator.List as EL -import qualified Control.Monad as CM -import Control.Monad.Trans.Class (lift) -import Control.Monad (liftM) - - - --- | Consume the entire input stream with a strict left fold, one character --- at a time. --- --- Since: 0.4.8 - -fold :: Monad m => (b -> Char -> b) -> b - -> Iteratee T.Text m b -fold step = EL.fold (T.foldl' step) - - --- | Consume the entire input stream with a strict monadic left fold, one --- character at a time. --- --- Since: 0.4.8 - -foldM :: Monad m => (b -> Char -> m b) -> b - -> Iteratee T.Text m b -foldM step = EL.foldM (\b txt -> CM.foldM step b (T.unpack txt)) - - --- | Enumerates a stream of characters by repeatedly applying a function to --- some state. --- --- Similar to 'iterate'. --- --- Since: 0.4.8 - -unfold :: Monad m => (s -> Maybe (Char, s)) -> s -> Enumerator T.Text m b -unfold f = checkContinue1 $ \loop s k -> case f s of - Nothing -> continue k - Just (c, s') -> k (Chunks [T.singleton c]) >>== loop s' - - --- | Enumerates a stream of characters by repeatedly applying a computation --- to some state. --- --- Similar to 'iterateM'. --- --- Since: 0.4.8 - -unfoldM :: Monad m => (s -> m (Maybe (Char, s))) -> s -> Enumerator T.Text m b -unfoldM f = checkContinue1 $ \loop s k -> do - fs <- lift (f s) - case fs of - Nothing -> continue k - Just (c, s') -> k (Chunks [T.singleton c]) >>== loop s' - - --- | @'map' f@ applies /f/ to each input character and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -map :: Monad m => (Char -> Char) -> Enumeratee T.Text T.Text m b -map f = Data.Enumerator.Text.concatMap (\x -> T.singleton (f x)) - - --- | @'mapM' f@ applies /f/ to each input character and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -mapM :: Monad m => (Char -> m Char) -> Enumeratee T.Text T.Text m b -mapM f = Data.Enumerator.Text.concatMapM (\x -> liftM T.singleton (f x)) - - --- | @'mapM_' f@ applies /f/ to each input character, and discards the --- results. --- --- Since: 0.4.11 - -mapM_ :: Monad m => (Char -> m ()) -> Iteratee T.Text m () -mapM_ f = foldM (\_ x -> f x >> return ()) () - - --- | @'concatMap' f@ applies /f/ to each input character and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -concatMap :: Monad m => (Char -> T.Text) -> Enumeratee T.Text T.Text m b -concatMap f = Data.Enumerator.Text.concatMapM (return . f) - - --- | @'concatMapM' f@ applies /f/ to each input character and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 - -concatMapM :: Monad m => (Char -> m T.Text) -> Enumeratee T.Text T.Text m b -concatMapM f = checkDone (continue . step) where - step k EOF = yield (Continue k) EOF - step k (Chunks xs) = loop k (TL.unpack (TL.fromChunks xs)) - - loop k [] = continue (step k) - loop k (x:xs) = do - fx <- lift (f x) - k (Chunks [fx]) >>== - checkDoneEx (Chunks [T.pack xs]) (\k' -> loop k' xs) - - --- | Similar to 'concatMap', but with a stateful step function. --- --- Since: 0.4.11 - -concatMapAccum :: Monad m => (s -> Char -> (s, T.Text)) -> s -> Enumeratee T.Text T.Text m b -concatMapAccum f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case T.uncons x of - Nothing -> loop s k xs - Just (c, x') -> case f s c of - (s', ai) -> k (Chunks [ai]) >>== - checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) - - --- | Similar to 'concatMapM', but with a stateful step function. --- --- Since: 0.4.11 - -concatMapAccumM :: Monad m => (s -> Char -> m (s, T.Text)) -> s -> Enumeratee T.Text T.Text m b -concatMapAccumM f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case T.uncons x of - Nothing -> loop s k xs - Just (c, x') -> do - (s', ai) <- lift (f s c) - k (Chunks [ai]) >>== - checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) - - --- | Similar to 'map', but with a stateful step function. --- --- Since: 0.4.9 - -mapAccum :: Monad m => (s -> Char -> (s, Char)) -> s -> Enumeratee T.Text T.Text m b -mapAccum f = concatMapAccum (\s c -> case f s c of (s', c') -> (s', T.singleton c')) - - --- | Similar to 'mapM', but with a stateful step function. --- --- Since: 0.4.9 - -mapAccumM :: Monad m => (s -> Char -> m (s, Char)) -> s -> Enumeratee T.Text T.Text m b -mapAccumM f = concatMapAccumM (\s c -> do - (s', c') <- f s c - return (s', T.singleton c')) - - --- | @'iterate' f x@ enumerates an infinite stream of repeated applications --- of /f/ to /x/. --- --- Analogous to 'Prelude.iterate'. --- --- Since: 0.4.8 - -iterate :: Monad m => (Char -> Char) -> Char -> Enumerator T.Text m b -iterate f = checkContinue1 $ \loop s k -> k (Chunks [T.singleton s]) >>== loop (f s) - - --- | Similar to 'iterate', except the iteration function is monadic. --- --- Since: 0.4.8 - -iterateM :: Monad m => (Char -> m Char) -> Char -> Enumerator T.Text m b -iterateM f base = worker (return base) where - worker = checkContinue1 $ \loop m_char k -> do - char <- lift m_char - k (Chunks [T.singleton char]) >>== loop (f char) - - --- | Enumerates an infinite stream of a single character. --- --- Analogous to 'Prelude.repeat'. --- --- Since: 0.4.8 - -repeat :: Monad m => Char -> Enumerator T.Text m b -repeat char = EL.repeat (T.singleton char) - - --- | Enumerates an infinite stream of characters. Each character is computed --- by the underlying monad. --- --- Since: 0.4.8 - -repeatM :: Monad m => m Char -> Enumerator T.Text m b -repeatM next = EL.repeatM (liftM T.singleton next) - - --- | @'replicate' n x@ enumerates a stream containing /n/ copies of /x/. --- --- Since: 0.4.8 - -replicate :: Monad m => Integer -> Char -> Enumerator T.Text m b -replicate n byte = EL.replicate n (T.singleton byte) - - --- | @'replicateM' n m_x@ enumerates a stream of /n/ characters, with each --- character computed by /m_x/. --- --- Since: 0.4.8 - -replicateM :: Monad m => Integer -> m Char -> Enumerator T.Text m b -replicateM n next = EL.replicateM n (liftM T.singleton next) - - --- | Like 'repeatM', except the computation may terminate the stream by --- returning 'Nothing'. --- --- Since: 0.4.8 - -generateM :: Monad m => m (Maybe Char) -> Enumerator T.Text m b -generateM next = EL.generateM (liftM (liftM T.singleton) next) - - --- | Applies a predicate to the stream. The inner iteratee only receives --- characters for which the predicate is @True@. --- --- Since: 0.4.8 - -filter :: Monad m => (Char -> Bool) -> Enumeratee T.Text T.Text m b -filter p = Data.Enumerator.Text.concatMap (\x -> T.pack [x | p x]) - - --- | Applies a monadic predicate to the stream. The inner iteratee only --- receives characters for which the predicate returns @True@. --- --- Since: 0.4.8 - -filterM :: Monad m => (Char -> m Bool) -> Enumeratee T.Text T.Text m b -filterM p = Data.Enumerator.Text.concatMapM (\x -> liftM T.pack (CM.filterM p [x])) - - --- | @'take' n@ extracts the next /n/ characters from the stream, as a lazy --- Text. --- --- Since: 0.4.5 - -take :: Monad m => Integer -> Iteratee T.Text m TL.Text -take n | n <= 0 = return TL.empty -take n = continue (loop id n) where - loop acc n' (Chunks xs) = iter where - lazy = TL.fromChunks xs - len = toInteger (TL.length lazy) - - iter = if len < n' - then continue (loop (acc . (TL.append lazy)) (n' - len)) - else let - (xs', extra) = TL.splitAt (fromInteger n') lazy - in yield (acc xs') (toChunks extra) - loop acc _ EOF = yield (acc TL.empty) EOF - - --- | @'takeWhile' p@ extracts input from the stream until the first character --- which does not match the predicate. --- --- Since: 0.4.5 - -takeWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m TL.Text -takeWhile p = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = iter where - lazy = TL.fromChunks xs - (xs', extra) = tlSpanBy p lazy - iter = if TL.null extra - then continue (loop (acc . (TL.append lazy))) - else yield (acc xs') (toChunks extra) - loop acc EOF = yield (acc TL.empty) EOF - - --- | @'consume' = 'takeWhile' (const True)@ --- --- Since: 0.4.5 - -consume :: Monad m => Iteratee T.Text m TL.Text -consume = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = iter where - lazy = TL.fromChunks xs - iter = continue (loop (acc . (TL.append lazy))) - loop acc EOF = yield (acc TL.empty) EOF - - --- | Get the next character from the stream, or 'Nothing' if the stream has --- ended. --- --- Since: 0.4.5 - -head :: Monad m => Iteratee T.Text m (Maybe Char) -head = continue loop where - loop (Chunks xs) = case TL.uncons (TL.fromChunks xs) of - Just (char, extra) -> yield (Just char) (toChunks extra) - Nothing -> head - loop EOF = yield Nothing EOF - - --- | @'drop' n@ ignores /n/ characters of input from the stream. --- --- Since: 0.4.5 - -drop :: Monad m => Integer -> Iteratee T.Text m () -drop n | n <= 0 = return () -drop n = continue (loop n) where - loop n' (Chunks xs) = iter where - lazy = TL.fromChunks xs - len = toInteger (TL.length lazy) - iter = if len < n' - then drop (n' - len) - else yield () (toChunks (TL.drop (fromInteger n') lazy)) - loop _ EOF = yield () EOF - - --- | @'dropWhile' p@ ignores input from the stream until the first character --- which does not match the predicate. --- --- Since: 0.4.5 - -dropWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m () -dropWhile p = continue loop where - loop (Chunks xs) = iter where - lazy = TL.dropWhile p (TL.fromChunks xs) - iter = if TL.null lazy - then continue loop - else yield () (toChunks lazy) - loop EOF = yield () EOF - - --- | @'require' n@ buffers input until at least /n/ characters are available, --- or throws an error if the stream ends early. --- --- Since: 0.4.5 - -require :: Monad m => Integer -> Iteratee T.Text m () -require n | n <= 0 = return () -require n = continue (loop id n) where - loop acc n' (Chunks xs) = iter where - lazy = TL.fromChunks xs - len = toInteger (TL.length lazy) - iter = if len < n' - then continue (loop (acc . (TL.append lazy)) (n' - len)) - else yield () (toChunks (acc lazy)) - loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") - - --- | @'isolate' n@ reads at most /n/ characters from the stream, and passes --- them to its iteratee. If the iteratee finishes early, characters continue --- to be consumed from the outer stream until /n/ have been consumed. --- --- Since: 0.4.5 - -isolate :: Monad m => Integer -> Enumeratee T.Text T.Text m b -isolate n step | n <= 0 = return step -isolate n (Continue k) = continue loop where - loop (Chunks []) = continue loop - loop (Chunks xs) = iter where - lazy = TL.fromChunks xs - len = toInteger (TL.length lazy) - - iter = if len <= n - then k (Chunks xs) >>== isolate (n - len) - else let - (s1, s2) = TL.splitAt (fromInteger n) lazy - in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) - loop EOF = k EOF >>== (\step -> yield step EOF) -isolate n step = drop n >> return step - - --- | Split on characters satisfying a given predicate. --- --- Since: 0.4.8 - -splitWhen :: Monad m => (Char -> Bool) -> Enumeratee T.Text T.Text m b -splitWhen p = loop where - loop = checkDone step - step k = isEOF >>= \eof -> if eof - then yield (Continue k) EOF - else do - lazy <- takeWhile (not . p) - let text = textToStrict lazy - eof <- isEOF - drop 1 - if TL.null lazy && eof - then yield (Continue k) EOF - else k (Chunks [text]) >>== loop - - --- | @'lines' = 'splitWhen' (== '\n')@ --- --- Since: 0.4.8 - -lines :: Monad m => Enumeratee T.Text T.Text m b -lines = splitWhen (== '\n') - - - --- | Read lines of text from the handle, and stream them to an 'Iteratee'. --- If an exception occurs during file IO, enumeration will stop and 'Error' --- will be returned. Exceptions from the iteratee are not caught. --- --- The handle should be opened with an appropriate text encoding, and --- in 'IO.ReadMode' or 'IO.ReadWriteMode'. --- --- Since: 0.2 - -enumHandle :: MonadIO m => IO.Handle - -> Enumerator T.Text m b -enumHandle h = checkContinue0 $ \loop k -> do - let getText = Exc.catch - (Just `fmap` TIO.hGetLine h) - (\err -> if isEOFError err - then return Nothing - else Exc.throwIO err) - - maybeText <- tryIO getText - case maybeText of - Nothing -> continue k - Just text -> k (Chunks [text]) >>== loop - - - --- | Opens a file path in text mode, and passes the handle to 'enumHandle'. --- The file will be closed when the 'Iteratee' finishes. --- --- Since: 0.2 - -enumFile :: FilePath -> Enumerator T.Text IO b -enumFile path step = do - h <- tryIO (IO.openFile path IO.ReadMode) - Iteratee $ Exc.finally - (runIteratee (enumHandle h step)) - (IO.hClose h) - - --- | Read text from a stream and write it to a handle. If an exception --- occurs during file IO, enumeration will stop and 'Error' will be --- returned. --- --- The handle should be opened with an appropriate text encoding, and --- in 'IO.WriteMode' or 'IO.ReadWriteMode'. --- --- Since: 0.2 - -iterHandle :: MonadIO m => IO.Handle - -> Iteratee T.Text m () -iterHandle h = continue step where - step EOF = yield () EOF - step (Chunks []) = continue step - step (Chunks chunks) = do - tryIO (CM.mapM_ (TIO.hPutStr h) chunks) - continue step - - -data Codec = Codec - { codecName :: T.Text - , codecEncode - :: T.Text - -> (B.ByteString, Maybe (Exc.SomeException, T.Text)) - , codecDecode - :: B.ByteString - -> (T.Text, Either - (Exc.SomeException, B.ByteString) - B.ByteString) - } - -instance Show Codec where - showsPrec d c = showParen (d > 10) $ - showString "Codec " . shows (codecName c) - - --- | Convert text into bytes, using the provided codec. If the codec is --- not capable of representing an input character, an error will be thrown. --- --- Since: 0.2 - -encode :: Monad m => Codec - -> Enumeratee T.Text B.ByteString m b -encode codec = 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) = let - (bytes, extra) = codecEncode codec x - extraChunks = Chunks $ case extra of - Nothing -> xs - Just (_, text) -> text:xs - - checkError k' = case extra of - Nothing -> loop k' xs - Just (exc, _) -> throwError exc - - in if B.null bytes - then checkError k - else k (Chunks [bytes]) >>== - checkDoneEx extraChunks checkError - - --- | Convert bytes into text, using the provided codec. If the codec is --- not capable of decoding an input byte sequence, an error will be thrown. --- --- Since: 0.2 - -decode :: Monad m => Codec - -> Enumeratee B.ByteString T.Text m b -decode codec = checkDone (continue . step B.empty) where - step _ k EOF = yield (Continue k) EOF - step acc k (Chunks xs) = loop acc k xs - - loop acc k [] = continue (step acc k) - loop acc k (x:xs) = let - (text, extra) = codecDecode codec (B.append acc x) - extraChunks = Chunks (either snd id extra : xs) - - checkError k' = case extra of - Left (exc, _) -> throwError exc - Right bytes -> loop bytes k' xs - - in if T.null text - then checkError k - else k (Chunks [text]) >>== - checkDoneEx extraChunks checkError - -byteSplits :: B.ByteString - -> [(B.ByteString, B.ByteString)] -byteSplits bytes = loop (B.length bytes) where - loop 0 = [(B.empty, bytes)] - loop n = B.splitAt n bytes : loop (n - 1) - -splitSlowly :: (B.ByteString -> T.Text) - -> B.ByteString - -> (T.Text, Either - (Exc.SomeException, B.ByteString) - B.ByteString) -splitSlowly dec bytes = valid where - valid = firstValid (Prelude.map decFirst splits) - splits = byteSplits bytes - firstValid = Prelude.head . catMaybes - tryDec = tryEvaluate . dec - - decFirst (a, b) = case tryDec a of - Left _ -> Nothing - Right text -> Just (text, case tryDec b of - Left exc -> Left (exc, b) - - -- this case shouldn't occur, since splitSlowly - -- is only called when parsing failed somewhere - Right _ -> Right B.empty) - -utf8 :: Codec -utf8 = Codec name enc dec where - name = T.pack "UTF-8" - enc text = (TE.encodeUtf8 text, Nothing) - dec bytes = case splitQuickly bytes of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf8 bytes - - splitQuickly bytes = loop 0 >>= maybeDecode where - - required x0 - | x0 .&. 0x80 == 0x00 = 1 - | x0 .&. 0xE0 == 0xC0 = 2 - | x0 .&. 0xF0 == 0xE0 = 3 - | x0 .&. 0xF8 == 0xF0 = 4 - - -- Invalid input; let Text figure it out - | otherwise = 0 - - maxN = B.length bytes - - loop n | n == maxN = Just (TE.decodeUtf8 bytes, B.empty) - loop n = let - req = required (B.index bytes n) - tooLong = first TE.decodeUtf8 (B.splitAt n bytes) - decodeMore = loop $! n + req - in if req == 0 - then Nothing - else if n + req > maxN - then Just tooLong - else decodeMore - -utf16_le :: Codec -utf16_le = Codec name enc dec where - name = T.pack "UTF-16-LE" - enc text = (TE.encodeUtf16LE text, Nothing) - dec bytes = case splitQuickly bytes of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf16LE bytes - - splitQuickly bytes = maybeDecode (loop 0) where - maxN = B.length bytes - - loop n | n == maxN = decodeAll - | (n + 1) == maxN = decodeTo n - loop n = let - req = utf16Required - (B.index bytes 0) - (B.index bytes 1) - decodeMore = loop $! n + req - in if n + req > maxN - then decodeTo n - else decodeMore - - decodeTo n = first TE.decodeUtf16LE (B.splitAt n bytes) - decodeAll = (TE.decodeUtf16LE bytes, B.empty) - -utf16_be :: Codec -utf16_be = Codec name enc dec where - name = T.pack "UTF-16-BE" - enc text = (TE.encodeUtf16BE text, Nothing) - dec bytes = case splitQuickly bytes of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf16BE bytes - - splitQuickly bytes = maybeDecode (loop 0) where - maxN = B.length bytes - - loop n | n == maxN = decodeAll - | (n + 1) == maxN = decodeTo n - loop n = let - req = utf16Required - (B.index bytes 1) - (B.index bytes 0) - decodeMore = loop $! n + req - in if n + req > maxN - then decodeTo n - else decodeMore - - decodeTo n = first TE.decodeUtf16BE (B.splitAt n bytes) - decodeAll = (TE.decodeUtf16BE bytes, B.empty) - -utf16Required :: Word8 -> Word8 -> Int -utf16Required x0 x1 = required where - required = if x >= 0xD800 && x <= 0xDBFF - then 4 - else 2 - x :: Word16 - x = (fromIntegral x1 `shiftL` 8) .|. fromIntegral x0 - -utf32_le :: Codec -utf32_le = Codec name enc dec where - name = T.pack "UTF-32-LE" - enc text = (TE.encodeUtf32LE text, Nothing) - dec bs = case utf32SplitBytes TE.decodeUtf32LE bs of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf32LE bs - -utf32_be :: Codec -utf32_be = Codec name enc dec where - name = T.pack "UTF-32-BE" - enc text = (TE.encodeUtf32BE text, Nothing) - dec bs = case utf32SplitBytes TE.decodeUtf32BE bs of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf32BE bs - -utf32SplitBytes :: (B.ByteString -> T.Text) - -> B.ByteString - -> Maybe (T.Text, B.ByteString) -utf32SplitBytes dec bytes = split where - split = maybeDecode (dec toDecode, extra) - len = B.length bytes - lenExtra = mod len 4 - - lenToDecode = len - lenExtra - (toDecode, extra) = if lenExtra == 0 - then (bytes, B.empty) - else B.splitAt lenToDecode bytes - -ascii :: Codec -ascii = Codec name enc dec where - name = T.pack "ASCII" - enc text = (bytes, extra) where - (safe, unsafe) = tSpanBy (\c -> ord c <= 0x7F) text - bytes = B8.pack (T.unpack safe) - extra = if T.null unsafe - then Nothing - else Just (illegalEnc name (T.head unsafe), unsafe) - - dec bytes = (text, extra) where - (safe, unsafe) = B.span (<= 0x7F) bytes - text = T.pack (B8.unpack safe) - extra = if B.null unsafe - then Right B.empty - else Left (illegalDec name (B.head unsafe), unsafe) - -iso8859_1 :: Codec -iso8859_1 = Codec name enc dec where - name = T.pack "ISO-8859-1" - enc text = (bytes, extra) where - (safe, unsafe) = tSpanBy (\c -> ord c <= 0xFF) text - bytes = B8.pack (T.unpack safe) - extra = if T.null unsafe - then Nothing - else Just (illegalEnc name (T.head unsafe), unsafe) - - dec bytes = (T.pack (B8.unpack bytes), Right B.empty) - -illegalEnc :: T.Text -> Char -> Exc.SomeException -illegalEnc name c = Exc.toException . Exc.ErrorCall $ - concat [ "Codec " - , show name - , " can't encode character " - , reprChar c - ] - -illegalDec :: T.Text -> Word8 -> Exc.SomeException -illegalDec name w = Exc.toException . Exc.ErrorCall $ - concat [ "Codec " - , show name - , " can't decode byte " - , reprWord w - ] - -tryEvaluate :: a -> Either Exc.SomeException a -tryEvaluate = unsafePerformIO . Exc.try . Exc.evaluate - -maybeDecode:: (a, b) -> Maybe (a, b) -maybeDecode (a, b) = case tryEvaluate a of - Left _ -> Nothing - Right _ -> Just (a, b) - - -toChunks :: TL.Text -> Stream T.Text -toChunks = Chunks . TL.toChunks diff --git a/hs/Data/Enumerator/Util.hs b/hs/Data/Enumerator/Util.hs deleted file mode 100644 --- a/hs/Data/Enumerator/Util.hs +++ /dev/null @@ -1,39 +0,0 @@ - -{-# LANGUAGE CPP #-} -module Data.Enumerator.Util where - -import Data.Char (toUpper, intToDigit, ord) -import Data.Word (Word8) -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import Numeric (showIntAtBase) - -pad0 :: Int -> String -> String -pad0 size str = padded where - len = Prelude.length str - padded = if len >= size - then str - else Prelude.replicate (size - len) '0' ++ str - -reprChar :: Char -> String -reprChar c = "U+" ++ (pad0 4 (showIntAtBase 16 (toUpper . intToDigit) (ord c) "")) - -reprWord :: Word8 -> String -reprWord w = "0x" ++ (pad0 2 (showIntAtBase 16 (toUpper . intToDigit) w "")) - -tSpanBy :: (Char -> Bool) -> T.Text -> (T.Text, T.Text) -tlSpanBy :: (Char -> Bool) -> TL.Text -> (TL.Text, TL.Text) -#if MIN_VERSION_text(0,11,0) -tSpanBy = T.span -tlSpanBy = TL.span -#else -tSpanBy = T.spanBy -tlSpanBy = TL.spanBy -#endif - -textToStrict :: TL.Text -> T.Text -#if MIN_VERSION_text(0,8,0) -textToStrict = TL.toStrict -#else -textToStrict = T.concat . TL.toChunks -#endif diff --git a/lib/Data/Enumerator.hs b/lib/Data/Enumerator.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Enumerator.hs @@ -0,0 +1,819 @@ +-- | +-- Module: Data.Enumerator +-- Copyright: 2010-2011 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 Control.Applicative as A +import qualified Control.Exception as Exc +import qualified Control.Monad as CM +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Class (MonadTrans, lift) +import Data.Function (fix) +import Data.List (genericLength, genericSplitAt) +import Data.Monoid (Monoid, mempty, mappend, mconcat) +import Data.Typeable ( Typeable, typeOf + , Typeable1, typeOf1 + , mkTyConApp, mkTyCon) + +import {-# SOURCE #-} qualified Data.Enumerator.List as EL + +-- | 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 diff --git a/lib/Data/Enumerator.hs-boot b/lib/Data/Enumerator.hs-boot new file mode 100644 --- /dev/null +++ b/lib/Data/Enumerator.hs-boot @@ -0,0 +1,12 @@ +module Data.Enumerator where +import qualified Control.Exception as Exc +data Stream a +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) + } +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) diff --git a/lib/Data/Enumerator/Binary.hs b/lib/Data/Enumerator/Binary.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Enumerator/Binary.hs @@ -0,0 +1,832 @@ +-- | +-- Module: Data.Enumerator.Binary +-- Copyright: 2010-2011 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Byte-oriented alternatives to "Data.Enumerator.List". Note that the +-- enumeratees in this module must unpack their inputs to work properly. If +-- you do not need to handle leftover input on a byte-by-byte basis, the +-- chunk-oriented versions will be much faster. +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator.Binary as EB +-- @ +-- +-- Since: 0.4.5 +module Data.Enumerator.Binary + ( + + -- * IO + enumHandle + , enumHandleRange + , enumFile + , enumFileRange + , iterHandle + + -- * List analogues + + -- ** Folds + , fold + , foldM + + -- ** Maps + , Data.Enumerator.Binary.map + , Data.Enumerator.Binary.mapM + , Data.Enumerator.Binary.mapM_ + , Data.Enumerator.Binary.concatMap + , concatMapM + + -- ** Accumulating maps + , mapAccum + , mapAccumM + , concatMapAccum + , concatMapAccumM + + -- ** Infinite streams + , Data.Enumerator.Binary.iterate + , iterateM + , Data.Enumerator.Binary.repeat + , repeatM + + -- ** Bounded streams + , Data.Enumerator.Binary.replicate + , replicateM + , generateM + , unfold + , unfoldM + + -- ** Dropping input + , Data.Enumerator.Binary.drop + , Data.Enumerator.Binary.dropWhile + , Data.Enumerator.Binary.filter + , filterM + + -- ** Consumers + , Data.Enumerator.Binary.head + , head_ + , Data.Enumerator.Binary.take + , takeWhile + , consume + + -- ** Zipping + , zip + , zip3 + , zip4 + , zip5 + , zip6 + , zip7 + , zipWith + , zipWith3 + , zipWith4 + , zipWith5 + , zipWith6 + , zipWith7 + + -- ** Unsorted + , require + , isolate + , splitWhen + + ) where + +import Prelude hiding (head, drop, takeWhile, mapM_, zip, zip3, zipWith, zipWith3) +import qualified Control.Exception as Exc +import qualified Control.Monad as CM +import Control.Monad (liftM) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Trans.Class (lift) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import Data.Monoid (mappend) +import Data.Word (Word8) + +import qualified System.IO as IO +import System.IO.Error (isEOFError) + +import Data.Enumerator hiding ( head, drop, iterateM, repeatM, replicateM + , generateM, filterM, consume, foldM + , concatMapM) +import qualified Data.Enumerator.List as EL + +-- | Consume the entire input stream with a strict left fold, one byte +-- at a time. +-- +-- Since: 0.4.8 +fold :: Monad m => (b -> Word8 -> b) -> b + -> Iteratee B.ByteString m b +fold step = EL.fold (B.foldl' step) + +-- | Consume the entire input stream with a strict monadic left fold, one +-- byte at a time. +-- +-- Since: 0.4.8 +foldM :: Monad m => (b -> Word8 -> m b) -> b + -> Iteratee B.ByteString m b +foldM step = EL.foldM (\b bytes -> CM.foldM step b (B.unpack bytes)) + +-- | Enumerates a stream of bytes by repeatedly applying a function to +-- some state. +-- +-- Similar to 'Data.Enumerator.Binary.iterate'. +-- +-- Since: 0.4.8 +unfold :: Monad m => (s -> Maybe (Word8, s)) -> s -> Enumerator B.ByteString m b +unfold f = checkContinue1 $ \loop s k -> case f s of + Nothing -> continue k + Just (b, s') -> k (Chunks [B.singleton b]) >>== loop s' + +-- | Enumerates a stream of bytes by repeatedly applying a computation to +-- some state. +-- +-- Similar to 'iterateM'. +-- +-- Since: 0.4.8 +unfoldM :: Monad m => (s -> m (Maybe (Word8, s))) -> s -> Enumerator B.ByteString m b +unfoldM f = checkContinue1 $ \loop s k -> do + fs <- lift (f s) + case fs of + Nothing -> continue k + Just (b, s') -> k (Chunks [B.singleton b]) >>== loop s' + +-- | @'Data.Enumerator.Binary.map' f@ applies /f/ to each input byte and +-- feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +map :: Monad m => (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m b +map f = Data.Enumerator.Binary.concatMap (\x -> B.singleton (f x)) + +-- | @'Data.Enumerator.Binary.mapM' f@ applies /f/ to each input byte and +-- feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +mapM :: Monad m => (Word8 -> m Word8) -> Enumeratee B.ByteString B.ByteString m b +mapM f = Data.Enumerator.Binary.concatMapM (\x -> liftM B.singleton (f x)) + +-- | @'Data.Enumerator.Binary.mapM_' f@ applies /f/ to each input byte, and +-- discards the results. +-- +-- Since: 0.4.11 +mapM_ :: Monad m => (Word8 -> m ()) -> Iteratee B.ByteString m () +mapM_ f = foldM (\_ x -> f x >> return ()) () + +-- | @'Data.Enumerator.Binary.concatMap' f@ applies /f/ to each input byte +-- and feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +concatMap :: Monad m => (Word8 -> B.ByteString) -> Enumeratee B.ByteString B.ByteString m b +concatMap f = Data.Enumerator.Binary.concatMapM (return . f) + +-- | @'concatMapM' f@ applies /f/ to each input byte and feeds the +-- resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +concatMapM :: Monad m => (Word8 -> m B.ByteString) -> Enumeratee B.ByteString B.ByteString m b +concatMapM f = checkDone (continue . step) where + step k EOF = yield (Continue k) EOF + step k (Chunks xs) = loop k (BL.unpack (BL.fromChunks xs)) + + loop k [] = continue (step k) + loop k (x:xs) = do + fx <- lift (f x) + k (Chunks [fx]) >>== + checkDoneEx (Chunks [B.pack xs]) (\k' -> loop k' xs) + +-- | Similar to 'Data.Enumerator.Binary.concatMap', but with a stateful step +-- function. +-- +-- Since: 0.4.11 +concatMapAccum :: Monad m => (s -> Word8 -> (s, B.ByteString)) -> s -> Enumeratee B.ByteString B.ByteString m b +concatMapAccum f s0 = checkDone (continue . step s0) where + step _ k EOF = yield (Continue k) EOF + step s k (Chunks xs) = loop s k xs + + loop s k [] = continue (step s k) + loop s k (x:xs) = case B.uncons x of + Nothing -> loop s k xs + Just (b, x') -> case f s b of + (s', ai) -> k (Chunks [ai]) >>== + checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) + +-- | Similar to 'concatMapM', but with a stateful step function. +-- +-- Since: 0.4.11 +concatMapAccumM :: Monad m => (s -> Word8 -> m (s, B.ByteString)) -> s -> Enumeratee B.ByteString B.ByteString m b +concatMapAccumM f s0 = checkDone (continue . step s0) where + step _ k EOF = yield (Continue k) EOF + step s k (Chunks xs) = loop s k xs + + loop s k [] = continue (step s k) + loop s k (x:xs) = case B.uncons x of + Nothing -> loop s k xs + Just (b, x') -> do + (s', ai) <- lift (f s b) + k (Chunks [ai]) >>== + checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) + +-- | Similar to 'Data.Enumerator.Binary.map', but with a stateful step +-- function. +-- +-- Since: 0.4.9 +mapAccum :: Monad m => (s -> Word8 -> (s, Word8)) -> s -> Enumeratee B.ByteString B.ByteString m b +mapAccum f = concatMapAccum (\s w -> case f s w of (s', w') -> (s', B.singleton w')) + +-- | Similar to 'Data.Enumerator.Binary.mapM', but with a stateful step +-- function. +-- +-- Since: 0.4.9 +mapAccumM :: Monad m => (s -> Word8 -> m (s, Word8)) -> s -> Enumeratee B.ByteString B.ByteString m b +mapAccumM f = concatMapAccumM (\s w -> do + (s', w') <- f s w + return (s', B.singleton w')) + +-- | @'Data.Enumerator.Binary.iterate' f x@ enumerates an infinite stream of +-- repeated applications of /f/ to /x/. +-- +-- Analogous to 'Prelude.iterate'. +-- +-- Since: 0.4.8 +iterate :: Monad m => (Word8 -> Word8) -> Word8 -> Enumerator B.ByteString m b +iterate f = checkContinue1 $ \loop s k -> k (Chunks [B.singleton s]) >>== loop (f s) + +-- | Similar to 'Data.Enumerator.Binary.iterate', except the iteration +-- function is monadic. +-- +-- Since: 0.4.8 +iterateM :: Monad m => (Word8 -> m Word8) -> Word8 -> Enumerator B.ByteString m b +iterateM f base = worker (return base) where + worker = checkContinue1 $ \loop m_byte k -> do + byte <- lift m_byte + k (Chunks [B.singleton byte]) >>== loop (f byte) + +-- | Enumerates an infinite stream of a single byte. +-- +-- Analogous to 'Prelude.repeat'. +-- +-- Since: 0.4.8 +repeat :: Monad m => Word8 -> Enumerator B.ByteString m b +repeat byte = EL.repeat (B.singleton byte) + +-- | Enumerates an infinite stream of byte. Each byte is computed by the +-- underlying monad. +-- +-- Since: 0.4.8 +repeatM :: Monad m => m Word8 -> Enumerator B.ByteString m b +repeatM next = EL.repeatM (liftM B.singleton next) + +-- | @'Data.Enumerator.Binary.replicate' n x@ enumerates a stream containing +-- /n/ copies of /x/. +-- +-- Since: 0.4.8 +replicate :: Monad m => Integer -> Word8 -> Enumerator B.ByteString m b +replicate n byte = EL.replicate n (B.singleton byte) + +-- | @'replicateM' n m_x@ enumerates a stream of /n/ bytes, with each byte +-- computed by /m_x/. +-- +-- Since: 0.4.8 +replicateM :: Monad m => Integer -> m Word8 -> Enumerator B.ByteString m b +replicateM n next = EL.replicateM n (liftM B.singleton next) + +-- | Like 'repeatM', except the computation may terminate the stream by +-- returning 'Nothing'. +-- +-- Since: 0.4.8 +generateM :: Monad m => m (Maybe Word8) -> Enumerator B.ByteString m b +generateM next = EL.generateM (liftM (liftM B.singleton) next) + +-- | Applies a predicate to the stream. The inner iteratee only receives +-- characters for which the predicate is @True@. +-- +-- Since: 0.4.8 +filter :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b +filter p = Data.Enumerator.Binary.concatMap (\x -> B.pack [x | p x]) + +-- | Applies a monadic predicate to the stream. The inner iteratee only +-- receives bytes for which the predicate returns @True@. +-- +-- Since: 0.4.8 +filterM :: Monad m => (Word8 -> m Bool) -> Enumeratee B.ByteString B.ByteString m b +filterM p = Data.Enumerator.Binary.concatMapM (\x -> liftM B.pack (CM.filterM p [x])) + +-- | @'Data.Enumerator.Binary.take' n@ extracts the next /n/ bytes from the +-- stream, as a lazy +-- ByteString. +-- +-- Since: 0.4.5 +take :: Monad m => Integer -> Iteratee B.ByteString m BL.ByteString +take n | n <= 0 = return BL.empty +take n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + + iter = if len < n' + then continue (loop (acc . (BL.append lazy)) (n' - len)) + else let + (xs', extra) = BL.splitAt (fromInteger n') lazy + in yield (acc xs') (toChunks extra) + loop acc _ EOF = yield (acc BL.empty) EOF + +-- | @'takeWhile' p@ extracts input from the stream until the first byte which +-- does not match the predicate. +-- +-- Since: 0.4.5 +takeWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m BL.ByteString +takeWhile p = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = iter where + lazy = BL.fromChunks xs + (xs', extra) = BL.span p lazy + iter = if BL.null extra + then continue (loop (acc . (BL.append lazy))) + else yield (acc xs') (toChunks extra) + loop acc EOF = yield (acc BL.empty) EOF + +-- | @'consume' = 'takeWhile' (const True)@ +-- +-- Since: 0.4.5 +consume :: Monad m => Iteratee B.ByteString m BL.ByteString +consume = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = iter where + lazy = BL.fromChunks xs + iter = continue (loop (acc . (BL.append lazy))) + loop acc EOF = yield (acc BL.empty) EOF + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. +-- +-- Analogous to 'Data.List.zip'. +-- +-- Since: 0.4.14 +zip :: Monad m + => Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m (b1, b2) +zip i1 i2 = continue step where + step (Chunks []) = continue step + step stream@(Chunks _) = do + let enumStream s = case s of + Continue k -> k stream + Yield b extra -> yield b (mappend extra stream) + Error err -> throwError err + + s1 <- lift (runIteratee (enumStream ==<< i1)) + s2 <- lift (runIteratee (enumStream ==<< i2)) + + case (s1, s2) of + (Continue k1, Continue k2) -> zip (continue k1) (continue k2) + (Yield b1 _, Continue k2) -> zip (yield b1 (Chunks [])) (continue k2) + (Continue k1, Yield b2 _) -> zip (continue k1) (yield b2 (Chunks [])) + (Yield b1 ex1, Yield b2 ex2) -> yield (b1, b2) (shorter ex1 ex2) + (Error err, _) -> throwError err + (_, Error err) -> throwError err + + step EOF = do + b1 <- enumEOF =<< lift (runIteratee i1) + b2 <- enumEOF =<< lift (runIteratee i2) + return (b1, b2) + + shorter c1@(Chunks xs) c2@(Chunks ys) = let + xs' = B.concat xs + ys' = B.concat ys + in if B.length xs' < B.length ys' + then c1 + else c2 + shorter _ _ = EOF + +-- | Pass input from a stream through three iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip3'. +-- +-- Since: 0.4.14 +zip3 :: Monad m + => Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m (b1, b2, b3) +zip3 i1 i2 i3 = do + (b1, (b2, b3)) <- zip i1 (zip i2 i3) + return (b1, b2, b3) +{-# INLINE zip3 #-} + +-- | Pass input from a stream through four iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip4'. +-- +-- Since: 0.4.14 +zip4 :: Monad m + => Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m b4 + -> Iteratee B.ByteString m (b1, b2, b3, b4) +zip4 i1 i2 i3 i4 = do + (b1, (b2, b3, b4)) <- zip i1 (zip3 i2 i3 i4) + return (b1, b2, b3, b4) +{-# INLINE zip4 #-} + +-- | Pass input from a stream through five iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip5'. +-- +-- Since: 0.4.14 +zip5 :: Monad m + => Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m b4 + -> Iteratee B.ByteString m b5 + -> Iteratee B.ByteString m (b1, b2, b3, b4, b5) +zip5 i1 i2 i3 i4 i5 = do + (b1, (b2, b3, b4, b5)) <- zip i1 (zip4 i2 i3 i4 i5) + return (b1, b2, b3, b4, b5) +{-# INLINE zip5 #-} + +-- | Pass input from a stream through six iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip6'. +-- +-- Since: 0.4.14 +zip6 :: Monad m + => Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m b4 + -> Iteratee B.ByteString m b5 + -> Iteratee B.ByteString m b6 + -> Iteratee B.ByteString m (b1, b2, b3, b4, b5, b6) +zip6 i1 i2 i3 i4 i5 i6 = do + (b1, (b2, b3, b4, b5, b6)) <- zip i1 (zip5 i2 i3 i4 i5 i6) + return (b1, b2, b3, b4, b5, b6) +{-# INLINE zip6 #-} + +-- | Pass input from a stream through seven iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip7'. +-- +-- Since: 0.4.14 +zip7 :: Monad m + => Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m b4 + -> Iteratee B.ByteString m b5 + -> Iteratee B.ByteString m b6 + -> Iteratee B.ByteString m b7 + -> Iteratee B.ByteString m (b1, b2, b3, b4, b5, b6, b7) +zip7 i1 i2 i3 i4 i5 i6 i7 = do + (b1, (b2, b3, b4, b5, b6, b7)) <- zip i1 (zip6 i2 i3 i4 i5 i6 i7) + return (b1, b2, b3, b4, b5, b6, b7) +{-# INLINE zip7 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith'. +-- +-- Since: 0.4.14 +zipWith :: Monad m + => (b1 -> b2 -> c) + -> Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m c +zipWith f i1 i2 = do + (b1, b2) <- zip i1 i2 + return (f b1 b2) +{-# INLINE zipWith #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith3'. +-- +-- Since: 0.4.14 +zipWith3 :: Monad m + => (b1 -> b2 -> b3 -> c) + -> Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m c +zipWith3 f i1 i2 i3 = do + (b1, b2, b3) <- zip3 i1 i2 i3 + return (f b1 b2 b3) +{-# INLINE zipWith3 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith4'. +-- +-- Since: 0.4.14 +zipWith4 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> c) + -> Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m b4 + -> Iteratee B.ByteString m c +zipWith4 f i1 i2 i3 i4 = do + (b1, b2, b3, b4) <- zip4 i1 i2 i3 i4 + return (f b1 b2 b3 b4) +{-# INLINE zipWith4 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith5'. +-- +-- Since: 0.4.14 +zipWith5 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> c) + -> Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m b4 + -> Iteratee B.ByteString m b5 + -> Iteratee B.ByteString m c +zipWith5 f i1 i2 i3 i4 i5 = do + (b1, b2, b3, b4, b5) <- zip5 i1 i2 i3 i4 i5 + return (f b1 b2 b3 b4 b5) +{-# INLINE zipWith5 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith6'. +-- +-- Since: 0.4.14 +zipWith6 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> c) + -> Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m b4 + -> Iteratee B.ByteString m b5 + -> Iteratee B.ByteString m b6 + -> Iteratee B.ByteString m c +zipWith6 f i1 i2 i3 i4 i5 i6 = do + (b1, b2, b3, b4, b5, b6) <- zip6 i1 i2 i3 i4 i5 i6 + return (f b1 b2 b3 b4 b5 b6) +{-# INLINE zipWith6 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith7'. +-- +-- Since: 0.4.14 +zipWith7 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> b7 -> c) + -> Iteratee B.ByteString m b1 + -> Iteratee B.ByteString m b2 + -> Iteratee B.ByteString m b3 + -> Iteratee B.ByteString m b4 + -> Iteratee B.ByteString m b5 + -> Iteratee B.ByteString m b6 + -> Iteratee B.ByteString m b7 + -> Iteratee B.ByteString m c +zipWith7 f i1 i2 i3 i4 i5 i6 i7 = do + (b1, b2, b3, b4, b5, b6, b7) <- zip7 i1 i2 i3 i4 i5 i6 i7 + return (f b1 b2 b3 b4 b5 b6 b7) +{-# INLINE zipWith7 #-} + +-- | Get the next byte from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 +head :: Monad m => Iteratee B.ByteString m (Maybe Word8) +head = continue loop where + loop (Chunks xs) = case BL.uncons (BL.fromChunks xs) of + Just (char, extra) -> yield (Just char) (toChunks extra) + Nothing -> head + loop EOF = yield Nothing EOF + +-- | Get the next element from the stream, or raise an error if the stream +-- has ended. +-- +-- Since: 0.4.14 +head_ :: Monad m => Iteratee B.ByteString m Word8 +head_ = head >>= \x -> case x of + Just x' -> return x' + Nothing -> throwError (Exc.ErrorCall "head_: stream has ended") + +-- | @'drop' n@ ignores /n/ bytes of input from the stream. +-- +-- Since: 0.4.5 +drop :: Monad m => Integer -> Iteratee B.ByteString m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + iter = if len < n' + then drop (n' - len) + else yield () (toChunks (BL.drop (fromInteger n') lazy)) + loop _ EOF = yield () EOF + +-- | @'Data.Enumerator.Binary.dropWhile' p@ ignores input from the stream +-- until the first byte which does not match the predicate. +-- +-- Since: 0.4.5 +dropWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m () +dropWhile p = continue loop where + loop (Chunks xs) = iter where + lazy = BL.dropWhile p (BL.fromChunks xs) + iter = if BL.null lazy + then continue loop + else yield () (toChunks lazy) + loop EOF = yield () EOF + +-- | @'require' n@ buffers input until at least /n/ bytes are available, or +-- throws an error if the stream ends early. +-- +-- Since: 0.4.5 +require :: Monad m => Integer -> Iteratee B.ByteString m () +require n | n <= 0 = return () +require n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + iter = if len < n' + then continue (loop (acc . (BL.append lazy)) (n' - len)) + else yield () (toChunks (acc lazy)) + loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") + +-- | @'isolate' n@ reads at most /n/ bytes from the stream, and passes them +-- to its iteratee. If the iteratee finishes early, bytes continue to be +-- consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 +isolate :: Monad m => Integer -> Enumeratee B.ByteString B.ByteString m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + loop (Chunks []) = continue loop + loop (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + + iter = if len <= n + then k (Chunks xs) >>== isolate (n - len) + else let + (s1, s2) = BL.splitAt (fromInteger n) lazy + in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step + +-- | Split on bytes satisfying a given predicate. +-- +-- Since: 0.4.8 +splitWhen :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b +splitWhen p = loop where + loop = checkDone step + step k = isEOF >>= \eof -> if eof + then yield (Continue k) EOF + else do + lazy <- takeWhile (not . p) + let bytes = B.concat (BL.toChunks lazy) + eof <- isEOF + drop 1 + if BL.null lazy && eof + then yield (Continue k) EOF + else k (Chunks [bytes]) >>== loop + +-- | Read bytes (in chunks of the given buffer size) from the handle, and +-- stream them to an 'Iteratee'. If an exception occurs during file IO, +-- enumeration will stop and 'Error' will be returned. Exceptions from the +-- iteratee are not caught. +-- +-- This enumerator blocks until at least one byte is available from the +-- handle, and might read less than the maximum buffer size in some +-- cases. +-- +-- The handle should be opened with no encoding, and in 'IO.ReadMode' or +-- 'IO.ReadWriteMode'. +-- +-- Since: 0.4.5 +enumHandle :: MonadIO m + => Integer -- ^ Buffer size + -> IO.Handle + -> Enumerator B.ByteString m b +enumHandle bufferSize h = checkContinue0 $ \loop k -> do + let intSize = fromInteger bufferSize + + bytes <- tryIO (getBytes h intSize) + if B.null bytes + then continue k + else k (Chunks [bytes]) >>== loop + +-- | Read bytes (in chunks of the given buffer size) from the handle, and +-- stream them to an 'Iteratee'. If an exception occurs during file IO, +-- enumeration will stop and 'Error' will be returned. Exceptions from the +-- iteratee are not caught. +-- +-- This enumerator blocks until at least one byte is available from the +-- handle, and might read less than the maximum buffer size in some +-- cases. +-- +-- The handle should be opened with no encoding, and in 'IO.ReadMode' or +-- 'IO.ReadWriteMode'. +-- +-- If an offset is specified, the handle will be seeked to that offset +-- before reading. If the handle cannot be seeked, an error will be +-- thrown. +-- +-- If a maximum count is specified, the number of bytes read will not +-- exceed that count. +-- +-- Since: 0.4.8 +enumHandleRange :: MonadIO m + => Integer -- ^ Buffer size + -> Maybe Integer -- ^ Offset + -> Maybe Integer -- ^ Maximum count + -> IO.Handle + -> Enumerator B.ByteString m b +enumHandleRange bufferSize offset count h s = seek >> enum where + seek = case offset of + Nothing -> return () + Just off -> tryIO (IO.hSeek h IO.AbsoluteSeek off) + + enum = case count of + Just n -> enumRange n s + Nothing -> enumHandle bufferSize h s + + enumRange = checkContinue1 $ \loop n k -> let + rem = fromInteger (min bufferSize n) + keepGoing = do + bytes <- tryIO (getBytes h rem) + if B.null bytes + then continue k + else feed bytes + feed bs = k (Chunks [bs]) >>== loop (n - (toInteger (B.length bs))) + in if rem <= 0 + then continue k + else keepGoing + +getBytes :: IO.Handle -> Int -> IO B.ByteString +getBytes h n = do + hasInput <- Exc.catch + (IO.hWaitForInput h (-1)) + (\err -> if isEOFError err + then return False + else Exc.throwIO err) + if hasInput + then B.hGetNonBlocking h n + else return B.empty + +-- | Opens a file path in binary mode, and passes the handle to +-- 'enumHandle'. The file will be closed when enumeration finishes. +-- +-- Since: 0.4.5 +enumFile :: FilePath -> Enumerator B.ByteString IO b +enumFile path = enumFileRange path Nothing Nothing + +-- | Opens a file path in binary mode, and passes the handle to +-- 'enumHandleRange'. The file will be closed when enumeration finishes. +-- +-- Since: 0.4.8 +enumFileRange :: FilePath + -> Maybe Integer -- ^ Offset + -> Maybe Integer -- ^ Maximum count + -> Enumerator B.ByteString IO b +enumFileRange path offset count step = do + h <- tryIO (IO.openBinaryFile path IO.ReadMode) + let iter = enumHandleRange 4096 offset count h step + Iteratee (Exc.finally (runIteratee iter) (IO.hClose h)) + +-- | Read bytes from a stream and write them to a handle. If an exception +-- occurs during file IO, enumeration will stop and 'Error' will be +-- returned. +-- +-- The handle should be opened with no encoding, and in 'IO.WriteMode' or +-- 'IO.ReadWriteMode'. +-- +-- Since: 0.4.5 +iterHandle :: MonadIO m => IO.Handle + -> Iteratee B.ByteString m () +iterHandle h = continue step where + step EOF = yield () EOF + step (Chunks []) = continue step + step (Chunks bytes) = do + tryIO (CM.mapM_ (B.hPut h) bytes) + continue step + + +toChunks :: BL.ByteString -> Stream B.ByteString +toChunks = Chunks . BL.toChunks diff --git a/lib/Data/Enumerator/IO.hs b/lib/Data/Enumerator/IO.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Enumerator/IO.hs @@ -0,0 +1,40 @@ +-- | +-- Module: Data.Enumerator.IO +-- Copyright: 2010-2011 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Deprecated in 0.4.5: use "Data.Enumerator.Binary" instead +module Data.Enumerator.IO + {-# DEPRECATED "Use 'Data.Enumerator.Binary' instead" #-} + ( enumHandle + , enumFile + , iterHandle + ) where +import Control.Monad.IO.Class (MonadIO) +import qualified Data.ByteString as B +import qualified System.IO as IO + +import qualified Data.Enumerator as E +import qualified Data.Enumerator.Binary as EB + +{-# DEPRECATED enumHandle "Use 'Data.Enumerator.Binary.enumHandle' instead" #-} +-- | Deprecated in 0.4.5: use 'EB.enumHandle' instead +enumHandle :: MonadIO m + => Integer + -> IO.Handle + -> E.Enumerator B.ByteString m b +enumHandle = EB.enumHandle + +{-# DEPRECATED enumFile "Use 'Data.Enumerator.Binary.enumFile' instead" #-} +-- | Deprecated in 0.4.5: use 'EB.enumFile' instead +enumFile :: FilePath -> E.Enumerator B.ByteString IO b +enumFile = EB.enumFile + +{-# DEPRECATED iterHandle "Use 'Data.Enumerator.Binary.iterHandle' instead" #-} +-- | Deprecated in 0.4.5: use 'EB.iterHandle' instead +iterHandle :: MonadIO m => IO.Handle + -> E.Iteratee B.ByteString m () +iterHandle = EB.iterHandle diff --git a/lib/Data/Enumerator/List.hs b/lib/Data/Enumerator/List.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Enumerator/List.hs @@ -0,0 +1,703 @@ +-- | +-- Module: Data.Enumerator.List +-- Copyright: 2010-2011 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator.List as EL +-- @ +-- +-- Since: 0.4.5 +module Data.Enumerator.List + ( + + -- * List analogues + + -- ** Folds + fold + , foldM + + -- ** Maps + , Data.Enumerator.List.map + , Data.Enumerator.List.mapM + , Data.Enumerator.List.mapM_ + , Data.Enumerator.List.concatMap + , concatMapM + + -- ** Accumulating maps + , mapAccum + , mapAccumM + , concatMapAccum + , concatMapAccumM + + -- ** Infinite streams + , Data.Enumerator.List.iterate + , iterateM + , Data.Enumerator.List.repeat + , repeatM + + -- ** Bounded streams + , Data.Enumerator.List.replicate + , replicateM + , generateM + , unfold + , unfoldM + + -- ** Dropping input + , drop + , Data.Enumerator.List.dropWhile + , Data.Enumerator.List.filter + , filterM + , unique + + -- ** Consumers + , head + , head_ + , Data.Enumerator.List.take + , takeWhile + , consume + + -- ** Zipping + , zip + , zip3 + , zip4 + , zip5 + , zip6 + , zip7 + , zipWith + , zipWith3 + , zipWith4 + , zipWith5 + , zipWith6 + , zipWith7 + + -- ** Unsorted + , require + , isolate + , splitWhen + + ) where + +import Prelude hiding (head, drop, sequence, takeWhile, zip, zip3, zipWith, zipWith3) +import Control.Exception (ErrorCall(..)) +import qualified Control.Monad as CM +import Control.Monad.Trans.Class (lift) +import qualified Data.List as L +import Data.Monoid (mappend) +import qualified Data.Set + +import Data.Enumerator hiding ( concatMapM, iterateM, replicateM, head, drop + , foldM, repeatM, generateM, filterM, consume + , length) + +-- | Consume the entire input stream with a strict left fold, one element +-- at a time. +-- +-- Since: 0.4.8 +fold :: Monad m => (b -> a -> b) -> b + -> Iteratee a m b +fold step = continue . loop where + f = L.foldl' step + loop acc stream = case stream of + Chunks [] -> continue (loop acc) + Chunks xs -> continue (loop $! f acc xs) + EOF -> yield acc EOF + +-- | Consume the entire input stream with a strict monadic left fold, one +-- element at a time. +-- +-- Since: 0.4.8 +foldM :: Monad m => (b -> a -> m b) -> b + -> Iteratee a m b +foldM step = continue . loop where + f = CM.foldM step + + loop acc stream = acc `seq` case stream of + Chunks [] -> continue (loop acc) + Chunks xs -> lift (f acc xs) >>= continue . loop + EOF -> yield acc EOF + +-- | Enumerates a stream of elements by repeatedly applying a function to +-- some state. +-- +-- Similar to 'Data.Enumerator.List.iterate'. +-- +-- Since: 0.4.8 +unfold :: Monad m => (s -> Maybe (a, s)) -> s -> Enumerator a m b +unfold f = checkContinue1 $ \loop s k -> case f s of + Nothing -> continue k + Just (a, s') -> k (Chunks [a]) >>== loop s' + +-- | Enumerates a stream of elements by repeatedly applying a computation to +-- some state. +-- +-- Similar to 'iterateM'. +-- +-- Since: 0.4.8 +unfoldM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Enumerator a m b +unfoldM f = checkContinue1 $ \loop s k -> do + fs <- lift (f s) + case fs of + Nothing -> continue k + Just (a, s') -> k (Chunks [a]) >>== loop s' + +-- | @'concatMapM' f@ applies /f/ to each input element and feeds the +-- resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +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) + +-- | @'Data.Enumerator.List.concatMap' f@ applies /f/ to each input element +-- and feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +concatMap :: Monad m => (ao -> [ai]) + -> Enumeratee ao ai m b +concatMap f = concatMapM (return . f) + +-- | @'Data.Enumerator.List.map' f@ applies /f/ to each input element and +-- feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +map :: Monad m => (ao -> ai) + -> Enumeratee ao ai m b +map f = Data.Enumerator.List.concatMap (\x -> [f x]) + +-- | @'Data.Enumerator.List.mapM' f@ applies /f/ to each input element and +-- feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +mapM :: Monad m => (ao -> m ai) + -> Enumeratee ao ai m b +mapM f = concatMapM (\x -> Prelude.mapM f [x]) + +-- | @'Data.Enumerator.List.mapM_' f@ applies /f/ to each input element, and +-- discards the results. +-- +-- Since: 0.4.11 +mapM_ :: Monad m => (a -> m b) -> Iteratee a m () +mapM_ f = foldM (\_ x -> f x >> return ()) () + +-- | Similar to 'Data.Enumerator.List.concatMap', but with a stateful step +-- function. +-- +-- Since: 0.4.11 +concatMapAccum :: Monad m => (s -> ao -> (s, [ai])) -> s -> Enumeratee ao ai m b +concatMapAccum f s0 = checkDone (continue . step s0) where + step _ k EOF = yield (Continue k) EOF + step s k (Chunks xs) = loop s k xs + + loop s k [] = continue (step s k) + loop s k (x:xs) = case f s x of + (s', ai) -> k (Chunks ai) >>== + checkDoneEx (Chunks xs) (\k' -> loop s' k' xs) + +-- | Similar to 'concatMapM', but with a stateful step function. +-- +-- Since: 0.4.11 +concatMapAccumM :: Monad m => (s -> ao -> m (s, [ai])) -> s -> Enumeratee ao ai m b +concatMapAccumM f s0 = checkDone (continue . step s0) where + step _ k EOF = yield (Continue k) EOF + step s k (Chunks xs) = loop s k xs + + loop s k [] = continue (step s k) + loop s k (x:xs) = do + (s', ai) <- lift (f s x) + k (Chunks ai) >>== + checkDoneEx (Chunks xs) (\k' -> loop s' k' xs) + +-- | Similar to 'Data.Enumerator.List.map', but with a stateful step function. +-- +-- Since: 0.4.9 +mapAccum :: Monad m => (s -> ao -> (s, ai)) -> s -> Enumeratee ao ai m b +mapAccum f = concatMapAccum (\s ao -> case f s ao of (s', ai) -> (s', [ai])) + +-- | Similar to 'Data.Enumerator.List.mapM', but with a stateful step function. +-- +-- Since: 0.4.9 +mapAccumM :: Monad m => (s -> ao -> m (s, ai)) -> s -> Enumeratee ao ai m b +mapAccumM f = concatMapAccumM (\s ao -> do + (s', ai) <- f s ao + return (s', [ai])) + +-- | @'Data.Enumerator.List.iterate' f x@ enumerates an infinite stream of +-- repeated applications of /f/ to /x/. +-- +-- Analogous to 'Prelude.iterate'. +-- +-- Since: 0.4.8 +iterate :: Monad m => (a -> a) -> a -> Enumerator a m b +iterate f = checkContinue1 $ \loop s k -> k (Chunks [s]) >>== loop (f s) + +-- | Similar to 'Data.Enumerator.List.iterate', except the iteration +-- function is monadic. +-- +-- Since: 0.4.8 +iterateM :: Monad m => (a -> m a) -> a + -> Enumerator a m b +iterateM f base = worker (return base) where + worker = checkContinue1 $ \loop m_a k -> do + a <- lift m_a + k (Chunks [a]) >>== loop (f a) + +-- | Enumerates an infinite stream of a single element. +-- +-- Analogous to 'Prelude.repeat'. +-- +-- Since: 0.4.8 +repeat :: Monad m => a -> Enumerator a m b +repeat a = checkContinue0 $ \loop k -> k (Chunks [a]) >>== loop + +-- | Enumerates an infinite stream of element. Each element is computed by +-- the underlying monad. +-- +-- Since: 0.4.8 +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' n m_x@ enumerates a stream of /n/ elements, with each +-- element computed by /m_x/. +-- +-- Since: 0.4.8 +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 + +-- | @'Data.Enumerator.List.replicate' n x@ enumerates a stream containing +-- /n/ copies of /x/. +-- +-- Analogous to 'Prelude.replicate'. +-- +-- Since: 0.4.8 +replicate :: Monad m => Integer -> a + -> Enumerator a m b +replicate maxCount a = replicateM maxCount (return a) + +-- | Like 'repeatM', except the computation may terminate the stream by +-- returning 'Nothing'. +-- +-- Since: 0.4.8 +generateM :: Monad m => m (Maybe a) + -> Enumerator a m b +generateM getNext = checkContinue0 $ \loop k -> do + next <- lift getNext + case next of + Nothing -> continue k + Just x -> k (Chunks [x]) >>== loop + +-- | Applies a predicate to the stream. The inner iteratee only receives +-- elements for which the predicate is @True@. +-- +-- Since: 0.4.8 +filter :: Monad m => (a -> Bool) + -> Enumeratee a a m b +filter p = Data.Enumerator.List.concatMap (\x -> [x | p x]) + +-- | Applies a monadic predicate to the stream. The inner iteratee only +-- receives elements for which the predicate returns @True@. +-- +-- Since: 0.4.8 +filterM :: Monad m => (a -> m Bool) + -> Enumeratee a a m b +filterM p = concatMapM (\x -> CM.filterM p [x]) + +-- | @'Data.Enumerator.List.take' n@ extracts the next /n/ elements from the +-- stream, as a list. +-- +-- Since: 0.4.5 +take :: Monad m => Integer -> Iteratee a m [a] +take n | n <= 0 = return [] +take n = continue (loop id n) where + len = L.genericLength + loop acc n' (Chunks xs) + | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) + | otherwise = let + (xs', extra) = L.genericSplitAt n' xs + in yield (acc xs') (Chunks extra) + loop acc _ EOF = yield (acc []) EOF + +-- | @'takeWhile' p@ extracts input from the stream until the first element +-- which does not match the predicate. +-- +-- Since: 0.4.5 +takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] +takeWhile p = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = case Prelude.span p xs of + (_, []) -> continue (loop (acc . (xs ++))) + (xs', extra) -> yield (acc xs') (Chunks extra) + loop acc EOF = yield (acc []) EOF + +-- | @'consume' = 'takeWhile' (const True)@ +-- +-- Since: 0.4.5 +consume :: Monad m => Iteratee a m [a] +consume = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = continue (loop (acc . (xs ++))) + loop acc EOF = yield (acc []) EOF + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. +-- +-- Analogous to 'Data.List.zip'. +-- +-- Since: 0.4.14 +zip :: Monad m + => Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m (b1, b2) +zip i1 i2 = continue step where + step (Chunks []) = continue step + step stream@(Chunks _) = do + let enumStream s = case s of + Continue k -> k stream + Yield b extra -> yield b (mappend extra stream) + Error err -> throwError err + + s1 <- lift (runIteratee (enumStream ==<< i1)) + s2 <- lift (runIteratee (enumStream ==<< i2)) + + case (s1, s2) of + (Continue k1, Continue k2) -> zip (continue k1) (continue k2) + (Yield b1 _, Continue k2) -> zip (yield b1 (Chunks [])) (continue k2) + (Continue k1, Yield b2 _) -> zip (continue k1) (yield b2 (Chunks [])) + (Yield b1 ex1, Yield b2 ex2) -> yield (b1, b2) (shorter ex1 ex2) + (Error err, _) -> throwError err + (_, Error err) -> throwError err + + step EOF = do + b1 <- enumEOF =<< lift (runIteratee i1) + b2 <- enumEOF =<< lift (runIteratee i2) + return (b1, b2) + + shorter c1@(Chunks xs) c2@(Chunks ys) = if length xs < length ys + then c1 + else c2 + shorter _ _ = EOF + +-- | Pass input from a stream through three iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip3'. +-- +-- Since: 0.4.14 +zip3 :: Monad m + => Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m (b1, b2, b3) +zip3 i1 i2 i3 = do + (b1, (b2, b3)) <- zip i1 (zip i2 i3) + return (b1, b2, b3) +{-# INLINE zip3 #-} + +-- | Pass input from a stream through four iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip4'. +-- +-- Since: 0.4.14 +zip4 :: Monad m + => Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m b4 + -> Iteratee a m (b1, b2, b3, b4) +zip4 i1 i2 i3 i4 = do + (b1, (b2, b3, b4)) <- zip i1 (zip3 i2 i3 i4) + return (b1, b2, b3, b4) +{-# INLINE zip4 #-} + +-- | Pass input from a stream through five iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip5'. +-- +-- Since: 0.4.14 +zip5 :: Monad m + => Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m b4 + -> Iteratee a m b5 + -> Iteratee a m (b1, b2, b3, b4, b5) +zip5 i1 i2 i3 i4 i5 = do + (b1, (b2, b3, b4, b5)) <- zip i1 (zip4 i2 i3 i4 i5) + return (b1, b2, b3, b4, b5) +{-# INLINE zip5 #-} + +-- | Pass input from a stream through six iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip6'. +-- +-- Since: 0.4.14 +zip6 :: Monad m + => Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m b4 + -> Iteratee a m b5 + -> Iteratee a m b6 + -> Iteratee a m (b1, b2, b3, b4, b5, b6) +zip6 i1 i2 i3 i4 i5 i6 = do + (b1, (b2, b3, b4, b5, b6)) <- zip i1 (zip5 i2 i3 i4 i5 i6) + return (b1, b2, b3, b4, b5, b6) +{-# INLINE zip6 #-} + +-- | Pass input from a stream through seven iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip7'. +-- +-- Since: 0.4.14 +zip7 :: Monad m + => Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m b4 + -> Iteratee a m b5 + -> Iteratee a m b6 + -> Iteratee a m b7 + -> Iteratee a m (b1, b2, b3, b4, b5, b6, b7) +zip7 i1 i2 i3 i4 i5 i6 i7 = do + (b1, (b2, b3, b4, b5, b6, b7)) <- zip i1 (zip6 i2 i3 i4 i5 i6 i7) + return (b1, b2, b3, b4, b5, b6, b7) +{-# INLINE zip7 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith'. +-- +-- Since: 0.4.14 +zipWith :: Monad m + => (b1 -> b2 -> c) + -> Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m c +zipWith f i1 i2 = do + (b1, b2) <- zip i1 i2 + return (f b1 b2) +{-# INLINE zipWith #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith3'. +-- +-- Since: 0.4.14 +zipWith3 :: Monad m + => (b1 -> b2 -> b3 -> c) + -> Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m c +zipWith3 f i1 i2 i3 = do + (b1, b2, b3) <- zip3 i1 i2 i3 + return (f b1 b2 b3) +{-# INLINE zipWith3 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith4'. +-- +-- Since: 0.4.14 +zipWith4 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> c) + -> Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m b4 + -> Iteratee a m c +zipWith4 f i1 i2 i3 i4 = do + (b1, b2, b3, b4) <- zip4 i1 i2 i3 i4 + return (f b1 b2 b3 b4) +{-# INLINE zipWith4 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith5'. +-- +-- Since: 0.4.14 +zipWith5 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> c) + -> Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m b4 + -> Iteratee a m b5 + -> Iteratee a m c +zipWith5 f i1 i2 i3 i4 i5 = do + (b1, b2, b3, b4, b5) <- zip5 i1 i2 i3 i4 i5 + return (f b1 b2 b3 b4 b5) +{-# INLINE zipWith5 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith6'. +-- +-- Since: 0.4.14 +zipWith6 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> c) + -> Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m b4 + -> Iteratee a m b5 + -> Iteratee a m b6 + -> Iteratee a m c +zipWith6 f i1 i2 i3 i4 i5 i6 = do + (b1, b2, b3, b4, b5, b6) <- zip6 i1 i2 i3 i4 i5 i6 + return (f b1 b2 b3 b4 b5 b6) +{-# INLINE zipWith6 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith7'. +-- +-- Since: 0.4.14 +zipWith7 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> b7 -> c) + -> Iteratee a m b1 + -> Iteratee a m b2 + -> Iteratee a m b3 + -> Iteratee a m b4 + -> Iteratee a m b5 + -> Iteratee a m b6 + -> Iteratee a m b7 + -> Iteratee a m c +zipWith7 f i1 i2 i3 i4 i5 i6 i7 = do + (b1, b2, b3, b4, b5, b6, b7) <- zip7 i1 i2 i3 i4 i5 i6 i7 + return (f b1 b2 b3 b4 b5 b6 b7) +{-# INLINE zipWith7 #-} + +-- | Get the next element from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 +head :: Monad m => Iteratee a m (Maybe a) +head = continue loop where + loop (Chunks []) = head + loop (Chunks (x:xs)) = yield (Just x) (Chunks xs) + loop EOF = yield Nothing EOF + +-- | Get the next element from the stream, or raise an error if the stream +-- has ended. +-- +-- Since: 0.4.14 +head_ :: Monad m => Iteratee a m a +head_ = head >>= \x -> case x of + Just x' -> return x' + Nothing -> throwError (ErrorCall "head_: stream has ended") + +-- | @'drop' n@ ignores /n/ input elements from the stream. +-- +-- Since: 0.4.5 +drop :: Monad m => Integer -> Iteratee a m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + len = L.genericLength xs + iter = if len < n' + then drop (n' - len) + else yield () (Chunks (L.genericDrop n' xs)) + loop _ EOF = yield () EOF + +-- | @'Data.Enumerator.List.dropWhile' p@ ignores input from the stream +-- until the first element which does not match the predicate. +-- +-- Since: 0.4.5 +dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () +dropWhile p = continue loop where + loop (Chunks xs) = case L.dropWhile p xs of + [] -> continue loop + xs' -> yield () (Chunks xs') + loop EOF = yield () EOF + +-- | @'require' n@ buffers input until at least /n/ elements are available, or +-- throws an error if the stream ends early. +-- +-- Since: 0.4.5 +require :: Monad m => Integer -> Iteratee a m () +require n | n <= 0 = return () +require n = continue (loop id n) where + len = L.genericLength + loop acc n' (Chunks xs) + | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) + | otherwise = yield () (Chunks (acc xs)) + loop _ _ EOF = throwError (ErrorCall "require: Unexpected EOF") + +-- | @'isolate' n@ reads at most /n/ elements from the stream, and passes them +-- to its iteratee. If the iteratee finishes early, elements continue to be +-- consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 +isolate :: Monad m => Integer -> Enumeratee a a m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + len = L.genericLength + + loop (Chunks []) = continue loop + loop (Chunks xs) + | len xs <= n = k (Chunks xs) >>== isolate (n - len xs) + | otherwise = let + (s1, s2) = L.genericSplitAt n xs + in k (Chunks s1) >>== (\step -> yield step (Chunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step + +-- | Split on elements satisfying a given predicate. +-- +-- Since: 0.4.8 +splitWhen :: Monad m => (a -> Bool) -> Enumeratee a [a] m b +splitWhen p = sequence $ do + as <- takeWhile (not . p) + drop 1 + return as + +-- | Remove duplicate elements from a stream, passing through the first +-- instance of each value. +-- +-- Similar to 'nub', but more efficient because it uses a 'Data.Set.Set' +-- internally. +-- +-- Since: 0.4.11 +unique :: (Ord a, Monad m) => Enumeratee a a m b +unique = concatMapAccum step Data.Set.empty where + step s x = if Data.Set.member x s + then (s, []) + else (Data.Set.insert x s, [x]) diff --git a/lib/Data/Enumerator/List.hs-boot b/lib/Data/Enumerator/List.hs-boot new file mode 100644 --- /dev/null +++ b/lib/Data/Enumerator/List.hs-boot @@ -0,0 +1,22 @@ +module Data.Enumerator.List where +import {-# SOURCE #-} Data.Enumerator +head :: Monad m => Iteratee a m (Maybe a) +drop :: Monad m => Integer -> Iteratee a m () +dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () +takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] +consume :: Monad m => Iteratee a m [a] +fold :: Monad m => (b -> a -> b) -> b -> Iteratee a m b +foldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m b +iterate :: Monad m => (a -> a) -> a -> Enumerator a m b +iterateM :: Monad m => (a -> m a) -> a -> Enumerator a m b +repeat :: Monad m => a -> Enumerator a m b +repeatM :: Monad m => m a -> Enumerator a m b +replicateM :: Monad m => Integer -> m a -> Enumerator a m b +replicate :: Monad m => Integer -> a -> Enumerator a m b +generateM :: Monad m => m (Maybe a) -> Enumerator a m b +map :: Monad m => (ao -> ai) -> Enumeratee ao ai m b +mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m b +concatMap :: Monad m => (ao -> [ai]) -> Enumeratee ao ai m b +concatMapM :: Monad m => (ao -> m [ai]) -> Enumeratee ao ai m b +filter :: Monad m => (a -> Bool) -> Enumeratee a a m b +filterM :: Monad m => (a -> m Bool) -> Enumeratee a a m b diff --git a/lib/Data/Enumerator/Text.hs b/lib/Data/Enumerator/Text.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Enumerator/Text.hs @@ -0,0 +1,1057 @@ +-- | +-- Module: Data.Enumerator.Text +-- Copyright: 2010-2011 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Character-oriented alternatives to "Data.Enumerator.List". Note that the +-- enumeratees in this module must unpack their inputs to work properly. If +-- you do not need to handle leftover input on a char-by-char basis, the +-- chunk-oriented versions will be much faster. +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator.Text as ET +-- @ +-- +-- Since: 0.2 +module Data.Enumerator.Text + ( + + -- * IO + enumHandle + , enumFile + , iterHandle + + -- * List analogues + + -- ** Folds + , fold + , foldM + + -- ** Maps + , Data.Enumerator.Text.map + , Data.Enumerator.Text.mapM + , Data.Enumerator.Text.mapM_ + , Data.Enumerator.Text.concatMap + , concatMapM + + -- ** Accumulating maps + , mapAccum + , mapAccumM + , concatMapAccum + , concatMapAccumM + + -- ** Infinite streams + , Data.Enumerator.Text.iterate + , iterateM + , Data.Enumerator.Text.repeat + , repeatM + + -- ** Bounded streams + , Data.Enumerator.Text.replicate + , replicateM + , generateM + , unfold + , unfoldM + + -- ** Dropping input + , Data.Enumerator.Text.drop + , Data.Enumerator.Text.dropWhile + , Data.Enumerator.Text.filter + , filterM + + -- ** Consumers + , Data.Enumerator.Text.head + , head_ + , Data.Enumerator.Text.take + , takeWhile + , consume + + -- ** Zipping + , zip + , zip3 + , zip4 + , zip5 + , zip6 + , zip7 + , zipWith + , zipWith3 + , zipWith4 + , zipWith5 + , zipWith6 + , zipWith7 + + -- ** Unsorted + , require + , isolate + , splitWhen + , lines + + -- * Text codecs + , Codec + , encode + , decode + , utf8 + , utf16_le + , utf16_be + , utf32_le + , utf32_be + , ascii + , iso8859_1 + + ) where + +import qualified Prelude +import Prelude hiding (head, drop, takeWhile, lines, zip, zip3, zipWith, zipWith3) + +import Control.Arrow (first) +import qualified Control.Exception as Exc +import qualified Control.Monad as CM +import Control.Monad (liftM) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Trans.Class (lift) +import Data.Bits ((.&.), (.|.), shiftL) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import Data.Char (ord) +import Data.Maybe (catMaybes) +import Data.Monoid (mappend) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.IO as TIO +import qualified Data.Text.Lazy as TL +import Data.Word (Word8, Word16) +import qualified System.IO as IO +import System.IO.Error (isEOFError) +import System.IO.Unsafe (unsafePerformIO) + +import Data.Enumerator hiding ( head, drop, generateM, filterM, consume + , concatMapM, iterateM, repeatM, replicateM + , foldM) +import qualified Data.Enumerator.List as EL +import Data.Enumerator.Util (tSpanBy, tlSpanBy, reprWord, reprChar, textToStrict) + +-- | Consume the entire input stream with a strict left fold, one character +-- at a time. +-- +-- Since: 0.4.8 +fold :: Monad m => (b -> Char -> b) -> b + -> Iteratee T.Text m b +fold step = EL.fold (T.foldl' step) + +-- | Consume the entire input stream with a strict monadic left fold, one +-- character at a time. +-- +-- Since: 0.4.8 +foldM :: Monad m => (b -> Char -> m b) -> b + -> Iteratee T.Text m b +foldM step = EL.foldM (\b txt -> CM.foldM step b (T.unpack txt)) + +-- | Enumerates a stream of characters by repeatedly applying a function to +-- some state. +-- +-- Similar to 'Data.Enumerator.Text.iterate'. +-- +-- Since: 0.4.8 +unfold :: Monad m => (s -> Maybe (Char, s)) -> s -> Enumerator T.Text m b +unfold f = checkContinue1 $ \loop s k -> case f s of + Nothing -> continue k + Just (c, s') -> k (Chunks [T.singleton c]) >>== loop s' + +-- | Enumerates a stream of characters by repeatedly applying a computation +-- to some state. +-- +-- Similar to 'iterateM'. +-- +-- Since: 0.4.8 +unfoldM :: Monad m => (s -> m (Maybe (Char, s))) -> s -> Enumerator T.Text m b +unfoldM f = checkContinue1 $ \loop s k -> do + fs <- lift (f s) + case fs of + Nothing -> continue k + Just (c, s') -> k (Chunks [T.singleton c]) >>== loop s' + +-- | @'Data.Enumerator.Text.map' f@ applies /f/ to each input character and +-- feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +map :: Monad m => (Char -> Char) -> Enumeratee T.Text T.Text m b +map f = Data.Enumerator.Text.concatMap (\x -> T.singleton (f x)) + +-- | @'Data.Enumerator.Text.mapM' f@ applies /f/ to each input character +-- and feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +mapM :: Monad m => (Char -> m Char) -> Enumeratee T.Text T.Text m b +mapM f = Data.Enumerator.Text.concatMapM (\x -> liftM T.singleton (f x)) + +-- | @'Data.Enumerator.Text.mapM_' f@ applies /f/ to each input character, +-- and discards the results. +-- +-- Since: 0.4.11 +mapM_ :: Monad m => (Char -> m ()) -> Iteratee T.Text m () +mapM_ f = foldM (\_ x -> f x >> return ()) () + +-- | @'Data.Enumerator.Text.concatMap' f@ applies /f/ to each input +-- character and feeds the resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +concatMap :: Monad m => (Char -> T.Text) -> Enumeratee T.Text T.Text m b +concatMap f = Data.Enumerator.Text.concatMapM (return . f) + +-- | @'concatMapM' f@ applies /f/ to each input character and feeds the +-- resulting outputs to the inner iteratee. +-- +-- Since: 0.4.8 +concatMapM :: Monad m => (Char -> m T.Text) -> Enumeratee T.Text T.Text m b +concatMapM f = checkDone (continue . step) where + step k EOF = yield (Continue k) EOF + step k (Chunks xs) = loop k (TL.unpack (TL.fromChunks xs)) + + loop k [] = continue (step k) + loop k (x:xs) = do + fx <- lift (f x) + k (Chunks [fx]) >>== + checkDoneEx (Chunks [T.pack xs]) (\k' -> loop k' xs) + +-- | Similar to 'Data.Enumerator.Text.concatMap', but with a stateful step +-- function. +-- +-- Since: 0.4.11 +concatMapAccum :: Monad m => (s -> Char -> (s, T.Text)) -> s -> Enumeratee T.Text T.Text m b +concatMapAccum f s0 = checkDone (continue . step s0) where + step _ k EOF = yield (Continue k) EOF + step s k (Chunks xs) = loop s k xs + + loop s k [] = continue (step s k) + loop s k (x:xs) = case T.uncons x of + Nothing -> loop s k xs + Just (c, x') -> case f s c of + (s', ai) -> k (Chunks [ai]) >>== + checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) + +-- | Similar to 'concatMapM', but with a stateful step function. +-- +-- Since: 0.4.11 +concatMapAccumM :: Monad m => (s -> Char -> m (s, T.Text)) -> s -> Enumeratee T.Text T.Text m b +concatMapAccumM f s0 = checkDone (continue . step s0) where + step _ k EOF = yield (Continue k) EOF + step s k (Chunks xs) = loop s k xs + + loop s k [] = continue (step s k) + loop s k (x:xs) = case T.uncons x of + Nothing -> loop s k xs + Just (c, x') -> do + (s', ai) <- lift (f s c) + k (Chunks [ai]) >>== + checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) + +-- | Similar to 'Data.Enumerator.Text.map', but with a stateful step +-- function. +-- +-- Since: 0.4.9 +mapAccum :: Monad m => (s -> Char -> (s, Char)) -> s -> Enumeratee T.Text T.Text m b +mapAccum f = concatMapAccum (\s c -> case f s c of (s', c') -> (s', T.singleton c')) + +-- | Similar to 'Data.Enumerator.Text.mapM', but with a stateful step +-- function. +-- +-- Since: 0.4.9 +mapAccumM :: Monad m => (s -> Char -> m (s, Char)) -> s -> Enumeratee T.Text T.Text m b +mapAccumM f = concatMapAccumM (\s c -> do + (s', c') <- f s c + return (s', T.singleton c')) + +-- | @'Data.Enumerator.Text.iterate' f x@ enumerates an infinite stream of +-- repeated applications of /f/ to /x/. +-- +-- Analogous to 'Prelude.iterate'. +-- +-- Since: 0.4.8 +iterate :: Monad m => (Char -> Char) -> Char -> Enumerator T.Text m b +iterate f = checkContinue1 $ \loop s k -> k (Chunks [T.singleton s]) >>== loop (f s) + +-- | Similar to 'Data.Enumerator.Text.iterate', except the iteration +-- function is monadic. +-- +-- Since: 0.4.8 +iterateM :: Monad m => (Char -> m Char) -> Char -> Enumerator T.Text m b +iterateM f base = worker (return base) where + worker = checkContinue1 $ \loop m_char k -> do + char <- lift m_char + k (Chunks [T.singleton char]) >>== loop (f char) + +-- | Enumerates an infinite stream of a single character. +-- +-- Analogous to 'Prelude.repeat'. +-- +-- Since: 0.4.8 +repeat :: Monad m => Char -> Enumerator T.Text m b +repeat char = EL.repeat (T.singleton char) + +-- | Enumerates an infinite stream of characters. Each character is computed +-- by the underlying monad. +-- +-- Since: 0.4.8 +repeatM :: Monad m => m Char -> Enumerator T.Text m b +repeatM next = EL.repeatM (liftM T.singleton next) + +-- | @'Data.Enumerator.Text.replicate' n x@ enumerates a stream containing +-- /n/ copies of /x/. +-- +-- Since: 0.4.8 +replicate :: Monad m => Integer -> Char -> Enumerator T.Text m b +replicate n byte = EL.replicate n (T.singleton byte) + +-- | @'replicateM' n m_x@ enumerates a stream of /n/ characters, with each +-- character computed by /m_x/. +-- +-- Since: 0.4.8 +replicateM :: Monad m => Integer -> m Char -> Enumerator T.Text m b +replicateM n next = EL.replicateM n (liftM T.singleton next) + +-- | Like 'repeatM', except the computation may terminate the stream by +-- returning 'Nothing'. +-- +-- Since: 0.4.8 +generateM :: Monad m => m (Maybe Char) -> Enumerator T.Text m b +generateM next = EL.generateM (liftM (liftM T.singleton) next) + +-- | Applies a predicate to the stream. The inner iteratee only receives +-- characters for which the predicate is @True@. +-- +-- Since: 0.4.8 +filter :: Monad m => (Char -> Bool) -> Enumeratee T.Text T.Text m b +filter p = Data.Enumerator.Text.concatMap (\x -> T.pack [x | p x]) + +-- | Applies a monadic predicate to the stream. The inner iteratee only +-- receives characters for which the predicate returns @True@. +-- +-- Since: 0.4.8 +filterM :: Monad m => (Char -> m Bool) -> Enumeratee T.Text T.Text m b +filterM p = Data.Enumerator.Text.concatMapM (\x -> liftM T.pack (CM.filterM p [x])) + +-- | @'Data.Enumerator.Text.take' n@ extracts the next /n/ characters from +-- the stream, as a lazy Text. +-- +-- Since: 0.4.5 +take :: Monad m => Integer -> Iteratee T.Text m TL.Text +take n | n <= 0 = return TL.empty +take n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + + iter = if len < n' + then continue (loop (acc . (TL.append lazy)) (n' - len)) + else let + (xs', extra) = TL.splitAt (fromInteger n') lazy + in yield (acc xs') (toChunks extra) + loop acc _ EOF = yield (acc TL.empty) EOF + +-- | @'takeWhile' p@ extracts input from the stream until the first character +-- which does not match the predicate. +-- +-- Since: 0.4.5 +takeWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m TL.Text +takeWhile p = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = iter where + lazy = TL.fromChunks xs + (xs', extra) = tlSpanBy p lazy + iter = if TL.null extra + then continue (loop (acc . (TL.append lazy))) + else yield (acc xs') (toChunks extra) + loop acc EOF = yield (acc TL.empty) EOF + +-- | @'consume' = 'takeWhile' (const True)@ +-- +-- Since: 0.4.5 +consume :: Monad m => Iteratee T.Text m TL.Text +consume = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = iter where + lazy = TL.fromChunks xs + iter = continue (loop (acc . (TL.append lazy))) + loop acc EOF = yield (acc TL.empty) EOF + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. +-- +-- Analogous to 'Data.List.zip'. +-- +-- Since: 0.4.14 +zip :: Monad m + => Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m (b1, b2) +zip i1 i2 = continue step where + step (Chunks []) = continue step + step stream@(Chunks _) = do + let enumStream s = case s of + Continue k -> k stream + Yield b extra -> yield b (mappend extra stream) + Error err -> throwError err + + s1 <- lift (runIteratee (enumStream ==<< i1)) + s2 <- lift (runIteratee (enumStream ==<< i2)) + + case (s1, s2) of + (Continue k1, Continue k2) -> zip (continue k1) (continue k2) + (Yield b1 _, Continue k2) -> zip (yield b1 (Chunks [])) (continue k2) + (Continue k1, Yield b2 _) -> zip (continue k1) (yield b2 (Chunks [])) + (Yield b1 ex1, Yield b2 ex2) -> yield (b1, b2) (shorter ex1 ex2) + (Error err, _) -> throwError err + (_, Error err) -> throwError err + + step EOF = do + b1 <- enumEOF =<< lift (runIteratee i1) + b2 <- enumEOF =<< lift (runIteratee i2) + return (b1, b2) + + shorter c1@(Chunks xs) c2@(Chunks ys) = let + xs' = T.concat xs + ys' = T.concat ys + in if T.length xs' < T.length ys' + then c1 + else c2 + shorter _ _ = EOF + +-- | Pass input from a stream through three iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip3'. +-- +-- Since: 0.4.14 +zip3 :: Monad m + => Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m (b1, b2, b3) +zip3 i1 i2 i3 = do + (b1, (b2, b3)) <- zip i1 (zip i2 i3) + return (b1, b2, b3) +{-# INLINE zip3 #-} + +-- | Pass input from a stream through four iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip4'. +-- +-- Since: 0.4.14 +zip4 :: Monad m + => Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m b4 + -> Iteratee T.Text m (b1, b2, b3, b4) +zip4 i1 i2 i3 i4 = do + (b1, (b2, b3, b4)) <- zip i1 (zip3 i2 i3 i4) + return (b1, b2, b3, b4) +{-# INLINE zip4 #-} + +-- | Pass input from a stream through five iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip5'. +-- +-- Since: 0.4.14 +zip5 :: Monad m + => Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m b4 + -> Iteratee T.Text m b5 + -> Iteratee T.Text m (b1, b2, b3, b4, b5) +zip5 i1 i2 i3 i4 i5 = do + (b1, (b2, b3, b4, b5)) <- zip i1 (zip4 i2 i3 i4 i5) + return (b1, b2, b3, b4, b5) +{-# INLINE zip5 #-} + +-- | Pass input from a stream through six iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip6'. +-- +-- Since: 0.4.14 +zip6 :: Monad m + => Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m b4 + -> Iteratee T.Text m b5 + -> Iteratee T.Text m b6 + -> Iteratee T.Text m (b1, b2, b3, b4, b5, b6) +zip6 i1 i2 i3 i4 i5 i6 = do + (b1, (b2, b3, b4, b5, b6)) <- zip i1 (zip5 i2 i3 i4 i5 i6) + return (b1, b2, b3, b4, b5, b6) +{-# INLINE zip6 #-} + +-- | Pass input from a stream through seven iteratees at once. Excess input is +-- yielded if it was not consumed by any iteratee. +-- +-- Analogous to 'Data.List.zip7'. +-- +-- Since: 0.4.14 +zip7 :: Monad m + => Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m b4 + -> Iteratee T.Text m b5 + -> Iteratee T.Text m b6 + -> Iteratee T.Text m b7 + -> Iteratee T.Text m (b1, b2, b3, b4, b5, b6, b7) +zip7 i1 i2 i3 i4 i5 i6 i7 = do + (b1, (b2, b3, b4, b5, b6, b7)) <- zip i1 (zip6 i2 i3 i4 i5 i6 i7) + return (b1, b2, b3, b4, b5, b6, b7) +{-# INLINE zip7 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith'. +-- +-- Since: 0.4.14 +zipWith :: Monad m + => (b1 -> b2 -> c) + -> Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m c +zipWith f i1 i2 = do + (b1, b2) <- zip i1 i2 + return (f b1 b2) +{-# INLINE zipWith #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith3'. +-- +-- Since: 0.4.14 +zipWith3 :: Monad m + => (b1 -> b2 -> b3 -> c) + -> Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m c +zipWith3 f i1 i2 i3 = do + (b1, b2, b3) <- zip3 i1 i2 i3 + return (f b1 b2 b3) +{-# INLINE zipWith3 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith4'. +-- +-- Since: 0.4.14 +zipWith4 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> c) + -> Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m b4 + -> Iteratee T.Text m c +zipWith4 f i1 i2 i3 i4 = do + (b1, b2, b3, b4) <- zip4 i1 i2 i3 i4 + return (f b1 b2 b3 b4) +{-# INLINE zipWith4 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith5'. +-- +-- Since: 0.4.14 +zipWith5 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> c) + -> Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m b4 + -> Iteratee T.Text m b5 + -> Iteratee T.Text m c +zipWith5 f i1 i2 i3 i4 i5 = do + (b1, b2, b3, b4, b5) <- zip5 i1 i2 i3 i4 i5 + return (f b1 b2 b3 b4 b5) +{-# INLINE zipWith5 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith6'. +-- +-- Since: 0.4.14 +zipWith6 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> c) + -> Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m b4 + -> Iteratee T.Text m b5 + -> Iteratee T.Text m b6 + -> Iteratee T.Text m c +zipWith6 f i1 i2 i3 i4 i5 i6 = do + (b1, b2, b3, b4, b5, b6) <- zip6 i1 i2 i3 i4 i5 i6 + return (f b1 b2 b3 b4 b5 b6) +{-# INLINE zipWith6 #-} + +-- | Pass input from a stream through two iteratees at once. Excess input is +-- yielded if it was not consumed by either iteratee. Output from the +-- iteratees is combined with a user-provided function. +-- +-- Analogous to 'Data.List.zipWith7'. +-- +-- Since: 0.4.14 +zipWith7 :: Monad m + => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> b7 -> c) + -> Iteratee T.Text m b1 + -> Iteratee T.Text m b2 + -> Iteratee T.Text m b3 + -> Iteratee T.Text m b4 + -> Iteratee T.Text m b5 + -> Iteratee T.Text m b6 + -> Iteratee T.Text m b7 + -> Iteratee T.Text m c +zipWith7 f i1 i2 i3 i4 i5 i6 i7 = do + (b1, b2, b3, b4, b5, b6, b7) <- zip7 i1 i2 i3 i4 i5 i6 i7 + return (f b1 b2 b3 b4 b5 b6 b7) +{-# INLINE zipWith7 #-} + +-- | Get the next character from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 +head :: Monad m => Iteratee T.Text m (Maybe Char) +head = continue loop where + loop (Chunks xs) = case TL.uncons (TL.fromChunks xs) of + Just (char, extra) -> yield (Just char) (toChunks extra) + Nothing -> head + loop EOF = yield Nothing EOF + +-- | Get the next element from the stream, or raise an error if the stream +-- has ended. +-- +-- Since: 0.4.14 +head_ :: Monad m => Iteratee T.Text m Char +head_ = head >>= \x -> case x of + Just x' -> return x' + Nothing -> throwError (Exc.ErrorCall "head_: stream has ended") + +-- | @'drop' n@ ignores /n/ characters of input from the stream. +-- +-- Since: 0.4.5 +drop :: Monad m => Integer -> Iteratee T.Text m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + iter = if len < n' + then drop (n' - len) + else yield () (toChunks (TL.drop (fromInteger n') lazy)) + loop _ EOF = yield () EOF + +-- | @'Data.Enumerator.Text.dropWhile' p@ ignores input from the stream +-- until the first character which does not match the predicate. +-- +-- Since: 0.4.5 +dropWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m () +dropWhile p = continue loop where + loop (Chunks xs) = iter where + lazy = TL.dropWhile p (TL.fromChunks xs) + iter = if TL.null lazy + then continue loop + else yield () (toChunks lazy) + loop EOF = yield () EOF + +-- | @'require' n@ buffers input until at least /n/ characters are available, +-- or throws an error if the stream ends early. +-- +-- Since: 0.4.5 +require :: Monad m => Integer -> Iteratee T.Text m () +require n | n <= 0 = return () +require n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + iter = if len < n' + then continue (loop (acc . (TL.append lazy)) (n' - len)) + else yield () (toChunks (acc lazy)) + loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") + +-- | @'isolate' n@ reads at most /n/ characters from the stream, and passes +-- them to its iteratee. If the iteratee finishes early, characters continue +-- to be consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 +isolate :: Monad m => Integer -> Enumeratee T.Text T.Text m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + loop (Chunks []) = continue loop + loop (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + + iter = if len <= n + then k (Chunks xs) >>== isolate (n - len) + else let + (s1, s2) = TL.splitAt (fromInteger n) lazy + in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step + +-- | Split on characters satisfying a given predicate. +-- +-- Since: 0.4.8 +splitWhen :: Monad m => (Char -> Bool) -> Enumeratee T.Text T.Text m b +splitWhen p = loop where + loop = checkDone step + step k = isEOF >>= \eof -> if eof + then yield (Continue k) EOF + else do + lazy <- takeWhile (not . p) + let text = textToStrict lazy + eof <- isEOF + drop 1 + if TL.null lazy && eof + then yield (Continue k) EOF + else k (Chunks [text]) >>== loop + +-- | @'lines' = 'splitWhen' (== '\n')@ +-- +-- Since: 0.4.8 +lines :: Monad m => Enumeratee T.Text T.Text m b +lines = splitWhen (== '\n') + +-- | Read lines of text from the handle, and stream them to an 'Iteratee'. +-- If an exception occurs during file IO, enumeration will stop and 'Error' +-- will be returned. Exceptions from the iteratee are not caught. +-- +-- The handle should be opened with an appropriate text encoding, and +-- in 'IO.ReadMode' or 'IO.ReadWriteMode'. +-- +-- Since: 0.2 +enumHandle :: MonadIO m => IO.Handle + -> Enumerator T.Text m b +enumHandle h = checkContinue0 $ \loop k -> do + let getText = Exc.catch + (Just `fmap` TIO.hGetLine h) + (\err -> if isEOFError err + then return Nothing + else Exc.throwIO err) + + maybeText <- tryIO getText + case maybeText of + Nothing -> continue k + Just text -> k (Chunks [text]) >>== loop + + + +-- | Opens a file path in text mode, and passes the handle to 'enumHandle'. +-- The file will be closed when the 'Iteratee' finishes. +-- +-- Since: 0.2 +enumFile :: FilePath -> Enumerator T.Text IO b +enumFile path step = do + h <- tryIO (IO.openFile path IO.ReadMode) + Iteratee $ Exc.finally + (runIteratee (enumHandle h step)) + (IO.hClose h) + + +-- | Read text from a stream and write it to a handle. If an exception +-- occurs during file IO, enumeration will stop and 'Error' will be +-- returned. +-- +-- The handle should be opened with an appropriate text encoding, and +-- in 'IO.WriteMode' or 'IO.ReadWriteMode'. +-- +-- Since: 0.2 +iterHandle :: MonadIO m => IO.Handle + -> Iteratee T.Text m () +iterHandle h = continue step where + step EOF = yield () EOF + step (Chunks []) = continue step + step (Chunks chunks) = do + tryIO (CM.mapM_ (TIO.hPutStr h) chunks) + continue step + + +data Codec = Codec + { codecName :: T.Text + , codecEncode + :: T.Text + -> (B.ByteString, Maybe (Exc.SomeException, T.Text)) + , codecDecode + :: B.ByteString + -> (T.Text, Either + (Exc.SomeException, B.ByteString) + B.ByteString) + } + +instance Show Codec where + showsPrec d c = showParen (d > 10) $ + showString "Codec " . shows (codecName c) + +-- | Convert text into bytes, using the provided codec. If the codec is +-- not capable of representing an input character, an error will be thrown. +-- +-- Since: 0.2 +encode :: Monad m => Codec + -> Enumeratee T.Text B.ByteString m b +encode codec = 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) = let + (bytes, extra) = codecEncode codec x + extraChunks = Chunks $ case extra of + Nothing -> xs + Just (_, text) -> text:xs + + checkError k' = case extra of + Nothing -> loop k' xs + Just (exc, _) -> throwError exc + + in if B.null bytes + then checkError k + else k (Chunks [bytes]) >>== + checkDoneEx extraChunks checkError + + +-- | Convert bytes into text, using the provided codec. If the codec is +-- not capable of decoding an input byte sequence, an error will be thrown. +-- +-- Since: 0.2 +decode :: Monad m => Codec + -> Enumeratee B.ByteString T.Text m b +decode codec = checkDone (continue . step B.empty) where + step _ k EOF = yield (Continue k) EOF + step acc k (Chunks xs) = loop acc k xs + + loop acc k [] = continue (step acc k) + loop acc k (x:xs) = let + (text, extra) = codecDecode codec (B.append acc x) + extraChunks = Chunks (either snd id extra : xs) + + checkError k' = case extra of + Left (exc, _) -> throwError exc + Right bytes -> loop bytes k' xs + + in if T.null text + then checkError k + else k (Chunks [text]) >>== + checkDoneEx extraChunks checkError + +byteSplits :: B.ByteString + -> [(B.ByteString, B.ByteString)] +byteSplits bytes = loop (B.length bytes) where + loop 0 = [(B.empty, bytes)] + loop n = B.splitAt n bytes : loop (n - 1) + +splitSlowly :: (B.ByteString -> T.Text) + -> B.ByteString + -> (T.Text, Either + (Exc.SomeException, B.ByteString) + B.ByteString) +splitSlowly dec bytes = valid where + valid = firstValid (Prelude.map decFirst splits) + splits = byteSplits bytes + firstValid = Prelude.head . catMaybes + tryDec = tryEvaluate . dec + + decFirst (a, b) = case tryDec a of + Left _ -> Nothing + Right text -> Just (text, case tryDec b of + Left exc -> Left (exc, b) + + -- this case shouldn't occur, since splitSlowly + -- is only called when parsing failed somewhere + Right _ -> Right B.empty) + +utf8 :: Codec +utf8 = Codec name enc dec where + name = T.pack "UTF-8" + enc text = (TE.encodeUtf8 text, Nothing) + dec bytes = case splitQuickly bytes of + Just (text, extra) -> (text, Right extra) + Nothing -> splitSlowly TE.decodeUtf8 bytes + + splitQuickly bytes = loop 0 >>= maybeDecode where + required x0 + | x0 .&. 0x80 == 0x00 = 1 + | x0 .&. 0xE0 == 0xC0 = 2 + | x0 .&. 0xF0 == 0xE0 = 3 + | x0 .&. 0xF8 == 0xF0 = 4 + + -- Invalid input; let Text figure it out + | otherwise = 0 + + maxN = B.length bytes + + loop n | n == maxN = Just (TE.decodeUtf8 bytes, B.empty) + loop n = let + req = required (B.index bytes n) + tooLong = first TE.decodeUtf8 (B.splitAt n bytes) + decodeMore = loop $! n + req + in if req == 0 + then Nothing + else if n + req > maxN + then Just tooLong + else decodeMore + +utf16_le :: Codec +utf16_le = Codec name enc dec where + name = T.pack "UTF-16-LE" + enc text = (TE.encodeUtf16LE text, Nothing) + dec bytes = case splitQuickly bytes of + Just (text, extra) -> (text, Right extra) + Nothing -> splitSlowly TE.decodeUtf16LE bytes + + splitQuickly bytes = maybeDecode (loop 0) where + maxN = B.length bytes + + loop n | n == maxN = decodeAll + | (n + 1) == maxN = decodeTo n + loop n = let + req = utf16Required + (B.index bytes 0) + (B.index bytes 1) + decodeMore = loop $! n + req + in if n + req > maxN + then decodeTo n + else decodeMore + + decodeTo n = first TE.decodeUtf16LE (B.splitAt n bytes) + decodeAll = (TE.decodeUtf16LE bytes, B.empty) + +utf16_be :: Codec +utf16_be = Codec name enc dec where + name = T.pack "UTF-16-BE" + enc text = (TE.encodeUtf16BE text, Nothing) + dec bytes = case splitQuickly bytes of + Just (text, extra) -> (text, Right extra) + Nothing -> splitSlowly TE.decodeUtf16BE bytes + + splitQuickly bytes = maybeDecode (loop 0) where + maxN = B.length bytes + + loop n | n == maxN = decodeAll + | (n + 1) == maxN = decodeTo n + loop n = let + req = utf16Required + (B.index bytes 1) + (B.index bytes 0) + decodeMore = loop $! n + req + in if n + req > maxN + then decodeTo n + else decodeMore + + decodeTo n = first TE.decodeUtf16BE (B.splitAt n bytes) + decodeAll = (TE.decodeUtf16BE bytes, B.empty) + +utf16Required :: Word8 -> Word8 -> Int +utf16Required x0 x1 = required where + required = if x >= 0xD800 && x <= 0xDBFF + then 4 + else 2 + x :: Word16 + x = (fromIntegral x1 `shiftL` 8) .|. fromIntegral x0 + +utf32_le :: Codec +utf32_le = Codec name enc dec where + name = T.pack "UTF-32-LE" + enc text = (TE.encodeUtf32LE text, Nothing) + dec bs = case utf32SplitBytes TE.decodeUtf32LE bs of + Just (text, extra) -> (text, Right extra) + Nothing -> splitSlowly TE.decodeUtf32LE bs + +utf32_be :: Codec +utf32_be = Codec name enc dec where + name = T.pack "UTF-32-BE" + enc text = (TE.encodeUtf32BE text, Nothing) + dec bs = case utf32SplitBytes TE.decodeUtf32BE bs of + Just (text, extra) -> (text, Right extra) + Nothing -> splitSlowly TE.decodeUtf32BE bs + +utf32SplitBytes :: (B.ByteString -> T.Text) + -> B.ByteString + -> Maybe (T.Text, B.ByteString) +utf32SplitBytes dec bytes = split where + split = maybeDecode (dec toDecode, extra) + len = B.length bytes + lenExtra = mod len 4 + + lenToDecode = len - lenExtra + (toDecode, extra) = if lenExtra == 0 + then (bytes, B.empty) + else B.splitAt lenToDecode bytes + +ascii :: Codec +ascii = Codec name enc dec where + name = T.pack "ASCII" + enc text = (bytes, extra) where + (safe, unsafe) = tSpanBy (\c -> ord c <= 0x7F) text + bytes = B8.pack (T.unpack safe) + extra = if T.null unsafe + then Nothing + else Just (illegalEnc name (T.head unsafe), unsafe) + + dec bytes = (text, extra) where + (safe, unsafe) = B.span (<= 0x7F) bytes + text = T.pack (B8.unpack safe) + extra = if B.null unsafe + then Right B.empty + else Left (illegalDec name (B.head unsafe), unsafe) + +iso8859_1 :: Codec +iso8859_1 = Codec name enc dec where + name = T.pack "ISO-8859-1" + enc text = (bytes, extra) where + (safe, unsafe) = tSpanBy (\c -> ord c <= 0xFF) text + bytes = B8.pack (T.unpack safe) + extra = if T.null unsafe + then Nothing + else Just (illegalEnc name (T.head unsafe), unsafe) + + dec bytes = (T.pack (B8.unpack bytes), Right B.empty) + +illegalEnc :: T.Text -> Char -> Exc.SomeException +illegalEnc name c = Exc.toException . Exc.ErrorCall $ + concat [ "Codec " + , show name + , " can't encode character " + , reprChar c + ] + +illegalDec :: T.Text -> Word8 -> Exc.SomeException +illegalDec name w = Exc.toException . Exc.ErrorCall $ + concat [ "Codec " + , show name + , " can't decode byte " + , reprWord w + ] + +tryEvaluate :: a -> Either Exc.SomeException a +tryEvaluate = unsafePerformIO . Exc.try . Exc.evaluate + +maybeDecode:: (a, b) -> Maybe (a, b) +maybeDecode (a, b) = case tryEvaluate a of + Left _ -> Nothing + Right _ -> Just (a, b) + + +toChunks :: TL.Text -> Stream T.Text +toChunks = Chunks . TL.toChunks diff --git a/lib/Data/Enumerator/Util.hs b/lib/Data/Enumerator/Util.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Enumerator/Util.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE CPP #-} +module Data.Enumerator.Util where + +import Data.Char (toUpper, intToDigit, ord) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import Data.Word (Word8) +import Numeric (showIntAtBase) + +pad0 :: Int -> String -> String +pad0 size str = padded where + len = Prelude.length str + padded = if len >= size + then str + else Prelude.replicate (size - len) '0' ++ str + +reprChar :: Char -> String +reprChar c = "U+" ++ (pad0 4 (showIntAtBase 16 (toUpper . intToDigit) (ord c) "")) + +reprWord :: Word8 -> String +reprWord w = "0x" ++ (pad0 2 (showIntAtBase 16 (toUpper . intToDigit) w "")) + +tSpanBy :: (Char -> Bool) -> T.Text -> (T.Text, T.Text) +tlSpanBy :: (Char -> Bool) -> TL.Text -> (TL.Text, TL.Text) +#if MIN_VERSION_text(0,11,0) +tSpanBy = T.span +tlSpanBy = TL.span +#else +tSpanBy = T.spanBy +tlSpanBy = TL.spanBy +#endif + +textToStrict :: TL.Text -> T.Text +#if MIN_VERSION_text(0,8,0) +textToStrict = TL.toStrict +#else +textToStrict = T.concat . TL.toChunks +#endif diff --git a/readme.txt b/readme.txt deleted file mode 100644 --- a/readme.txt +++ /dev/null @@ -1,10 +0,0 @@ -The source code for "enumerator" is literate. To build the library from scratch, -install the "anansi" application and then run: - - anansi -o hs/ src/enumerator.anansi - -To generate the woven PDF, install NoWeb and then run: - - anansi -w -l latex-noweb -o enumerator.tex src/enumerator.anansi - xelatex enumerator.tex - xelatex enumerator.tex diff --git a/scripts/common.bash b/scripts/common.bash --- a/scripts/common.bash +++ b/scripts/common.bash @@ -3,8 +3,6 @@ VERSION=$(awk '/^version:/{print $2}' enumerator.cabal) CABAL_DEV=$(which cabal-dev) -ANANSI=$(which anansi) -XELATEX=$(which xelatex) XZ=$(which xz) require_cabal_dev() @@ -16,48 +14,10 @@ fi } -require_anansi() -{ - if [ -z "$ANANSI" ]; then - echo "Can't find 'anansi' executable; running '$CABAL_DEV install anansi'" - require_cabal_dev - $CABAL_DEV install anansi &> /dev/null - if [ "$?" -ne "0" ]; then - echo "Installation failed; please install Anansi manually somehow" - exit 1 - fi - ANANSI=$(which anansi) - echo "Success; anansi = $ANANSI" - fi -} - -require_xelatex() -{ - if [ -z "$XELATEX" ]; then - echo "Can't find 'xelatex' executable; make sure it exists on your "'$PATH' - exit 1 - fi -} - -make_pdf() -{ - require_anansi - require_xelatex - - rm -f *.{aux,tex,idx,log,out,toc,pdf} - $ANANSI -w -l latex-noweb -o enumerator.tex src/enumerator.anansi || exit 1 - $XELATEX enumerator.tex > /dev/null || exit 1 - $XELATEX enumerator.tex > /dev/null || exit 1 - rm -f *.{aux,tex,idx,log,out,toc} - mv enumerator.pdf "enumerator_$VERSION.pdf" -} - clean_dev_install() { - require_anansi require_cabal_dev - rm -rf hs dist - $ANANSI -o hs src/enumerator.anansi || exit 1 + rm -rf dist $CABAL_DEV install || exit 1 } diff --git a/scripts/dist b/scripts/dist --- a/scripts/dist +++ b/scripts/dist @@ -8,13 +8,11 @@ . scripts/common.bash -require_anansi require_cabal_dev echo "Building dist for enumerator_$VERSION using $CABAL_DEV" -rm -rf hs dist -$ANANSI --noline -o hs src/enumerator.anansi || exit 1 +rm -rf dist $CABAL_DEV configure || exit 1 $CABAL_DEV build || exit 1 $CABAL_DEV sdist || exit 1 @@ -26,16 +24,9 @@ xz -f -C sha256 -9 "enumerator_$VERSION.tar" fi -if [ -n "$XELATEX" ]; then - make_pdf -fi - echo "" echo "============================================================" -if [ -n "$XELATEX" ]; then - echo " woven source : enumerator_$VERSION.pdf" -fi -echo " source tarball (gz) : enumerator_$VERSION.tar.gz" +echo " source archive (gz) : enumerator_$VERSION.tar.gz" if [ -n "$XZ" ]; then echo " source archive (xz) : enumerator_$VERSION.tar.xz" fi diff --git a/scripts/haddock b/scripts/haddock deleted file mode 100644 --- a/scripts/haddock +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/bash -if [ ! -f 'enumerator.cabal' ]; then - echo -n "Can't find enumerator.cabal; please run this script as" - echo -n " ./scripts/haddock from within the enumerator source" - echo " directory" - exit 1 -fi - -. scripts/common.bash - -require_anansi -require_cabal_dev - -rm -rf hs dist -$ANANSI --noline -o hs src/enumerator.anansi || exit 1 -$CABAL_DEV configure || exit 1 -$CABAL_DEV haddock || exit 1 diff --git a/scripts/latex b/scripts/latex deleted file mode 100644 --- a/scripts/latex +++ /dev/null @@ -1,11 +0,0 @@ -#!/bin/bash -if [ ! -f 'enumerator.cabal' ]; then - echo -n "Can't find enumerator.cabal; please run this script as" - echo -n " ./scripts/latex from within the enumerator source" - echo " directory" - exit 1 -fi - -. scripts/common.bash - -make_pdf diff --git a/scripts/run-benchmarks b/scripts/run-benchmarks --- a/scripts/run-benchmarks +++ b/scripts/run-benchmarks @@ -8,12 +8,11 @@ . scripts/common.bash -require_anansi require_cabal_dev clean_dev_install -pushd tests +pushd benchmarks rm -rf dist $CABAL_DEV -s ../cabal-dev install || exit 1 popd diff --git a/scripts/run-tests b/scripts/run-tests --- a/scripts/run-tests +++ b/scripts/run-tests @@ -8,7 +8,6 @@ . scripts/common.bash -require_anansi require_cabal_dev clean_dev_install diff --git a/src/api-docs.anansi b/src/api-docs.anansi deleted file mode 100644 --- a/src/api-docs.anansi +++ /dev/null @@ -1,1344 +0,0 @@ -\onecolumn -\section{Haddock API documentation} - -This section just repeats literate documentation in Haddock syntax. - -:d Data.Enumerator module header ------------------------------------------------------------------------------ --- | --- 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 --- @ --- ------------------------------------------------------------------------------ -: - -:d Data.Enumerator.List module header ------------------------------------------------------------------------------ --- | --- Module: Data.Enumerator.List --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Data.Enumerator.List as EL --- @ --- --- Since: 0.4.5 --- ------------------------------------------------------------------------------ -: - -:d Data.Enumerator.Binary module header ------------------------------------------------------------------------------ --- | --- Module: Data.Enumerator.Binary --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Byte-oriented alternatives to "Data.Enumerator.List". Note that the --- enumeratees in this module must unpack their inputs to work properly. If --- you do not need to handle leftover input on a byte-by-byte basis, the --- chunk-oriented versions will be much faster. --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Data.Enumerator.Binary as EB --- @ --- --- Since: 0.4.5 --- ------------------------------------------------------------------------------ -: - -:d Data.Enumerator.Text module header ------------------------------------------------------------------------------ --- | --- Module: Data.Enumerator.Text --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Character-oriented alternatives to "Data.Enumerator.List". Note that the --- enumeratees in this module must unpack their inputs to work properly. If --- you do not need to handle leftover input on a char-by-char basis, the --- chunk-oriented versions will be much faster. --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Data.Enumerator.Text as ET --- @ --- --- Since: 0.2 --- ------------------------------------------------------------------------------ -: - -:d Data.Enumerator.IO module header ------------------------------------------------------------------------------ --- | --- Module: Data.Enumerator.IO --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Deprecated in 0.4.5: use "Data.Enumerator.Binary" instead --- ------------------------------------------------------------------------------ -: - -:d apidoc Data.Enumerator.($$) --- | @'($$)' = '(==\<\<)'@ --- --- This might be easier to read when passing a chain of iteratees to an --- enumerator. --- --- Since: 0.1.1 -: - -:d apidoc Data.Enumerator.($=) --- | @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 -: - -:d apidoc Data.Enumerator.(=$) --- | @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 -: - -:d apidoc Data.Enumerator.(<==<) --- | @'(\<==\<)' = flip '(>==>)'@ --- --- Since: 0.1.1 -: - -:d apidoc Data.Enumerator.(==<<) --- | @'(==\<\<)' = flip '(\>\>==)'@ -: - -:d apidoc Data.Enumerator.(>==>) --- | @'(>==>)' e1 e2 s = e1 s '>>==' e2@ --- --- Since: 0.1.1 -: - -:d apidoc Data.Enumerator.(>>==) --- | Equivalent to '(>>=)' for @m ('Step' a m b)@; allows 'Iteratee's with --- different input types to be composed. -: - -:d apidoc Data.Enumerator.Continue --- | 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'. -: - -:d apidoc Data.Enumerator.Enumeratee --- | 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@). -: - -:d apidoc Data.Enumerator.Enumerator --- | 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). -: - -:d apidoc Data.Enumerator.Error --- | The 'Iteratee' encountered an error which prevents it from proceeding --- further. -: - -:d apidoc Data.Enumerator.Iteratee --- | 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. -: - -:d apidoc Data.Enumerator.Stream --- | 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. -: - -:d apidoc Data.Enumerator.Yield --- | 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. -: - -:d apidoc Data.Enumerator.break --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.takeWhile' instead -: - -:d apidoc Data.Enumerator.catchError --- | 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 -: - -:d apidoc Data.Enumerator.checkContinue0 --- | 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 -: - -:d apidoc Data.Enumerator.checkContinue1 --- | 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 -: - -:d apidoc Data.Enumerator.checkDone --- | @'checkDone' = 'checkDoneEx' ('Chunks' [])@ --- --- Use this for enumeratees which do not have an input buffer. -: - -:d apidoc Data.Enumerator.checkDoneEx --- | 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 -: - -:d apidoc Data.Enumerator.concatEnums --- | Compose a list of 'Enumerator's using @'(>>==)'@ -: - -:d apidoc Data.Enumerator.concatMap --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.concatMap' instead --- --- Since: 0.4.3 -: - -:d apidoc Data.Enumerator.concatMapM --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.concatMapM' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.consume --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.consume' instead -: - -:d apidoc Data.Enumerator.continue --- | @'continue' k = 'returnI' ('Continue' k)@ -: - -:d apidoc Data.Enumerator.drop --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.drop' instead -: - -:d apidoc Data.Enumerator.dropWhile --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.dropWhile' instead -: - -:d apidoc Data.Enumerator.enumEOF --- | Sends 'EOF' to its iteratee. Most clients should use 'run' or 'run_' --- instead. -: - -:d apidoc Data.Enumerator.enumList --- | @'enumList' n xs@ enumerates /xs/ as a stream, passing /n/ inputs per --- chunk. --- --- Primarily useful for testing and debugging. -: - -:d apidoc Data.Enumerator.filter --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.filter' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.filterM --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.filterM' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.foldl --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.fold' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.foldl' --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.fold' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.foldM --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.foldM' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.generateM --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.generateM' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.head --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.head' instead -: - -:d apidoc Data.Enumerator.isEOF --- | Check whether a stream has reached EOF. Most clients should use --- 'Data.Enumerator.List.head' instead. -: - -:d apidoc Data.Enumerator.iterate --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.iterate' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.iterateM --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.iterateM' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.joinE --- | Flatten an enumerator/enumeratee pair into a single enumerator. -: - -:d apidoc Data.Enumerator.joinI --- | 'joinI' is used to “flatten” 'Enumeratee's into an --- 'Iteratee'. -: - -:d apidoc Data.Enumerator.last --- | Get the last element in the stream, or 'Nothing' if the stream --- has ended. --- --- Consumes the entire stream. -: - -:d apidoc Data.Enumerator.length --- | Get how many elements remained in the stream. --- --- Consumes the entire stream. -: - -:d apidoc Data.Enumerator.liftFoldL --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.fold' instead --- --- Since: 0.1.1 -: - -:d apidoc Data.Enumerator.liftFoldL' --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.fold' instead --- --- Since: 0.1.1 -: - -:d apidoc Data.Enumerator.liftFoldM --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.foldM' instead --- --- Since: 0.1.1 -: - -:d apidoc Data.Enumerator.liftI --- | Deprecated in 0.4.5: use 'Data.Enumerator.continue' instead -: - -:d apidoc Data.Enumerator.liftTrans --- | Lift an 'Iteratee' onto a monad transformer, re-wrapping the --- 'Iteratee'’s inner monadic values. --- --- Since: 0.1.1 -: - -:d apidoc Data.Enumerator.map --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.map' instead -: - -:d apidoc Data.Enumerator.mapM --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.mapM' instead --- --- Since: 0.4.3 -: - -:d apidoc Data.Enumerator.peek --- | Peek at the next element in the stream, or 'Nothing' if the stream --- has ended. -: - -:d apidoc Data.Enumerator.printChunks --- | Print chunks as they're received from the enumerator, optionally --- printing empty chunks. -: - -:d apidoc Data.Enumerator.repeat --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.repeat' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.repeatM --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.repeatM' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.replicate --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.replicate' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.replicateM --- | Deprecated in 0.4.8: use 'Data.Enumerator.List.replicateM' instead --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.returnI --- | @'returnI' step = 'Iteratee' (return step)@ -: - -:d apidoc Data.Enumerator.run --- | Run an iteratee until it finishes, and return either the final value --- (if it succeeded) or the error (if it failed). -: - -:d apidoc Data.Enumerator.run_ --- | Like 'run', except errors are converted to exceptions and thrown. --- Primarily useful for small scripts or other simple cases. --- --- Since: 0.4.1 -: - -:d apidoc Data.Enumerator.sequence --- | Feeds outer input elements into the provided iteratee until it yields --- an inner input, passes that to the inner iteratee, and then loops. -: - -:d apidoc Data.Enumerator.span --- | Deprecated in 0.4.5: use 'Data.Enumerator.List.takeWhile' instead -: - -:d apidoc Data.Enumerator.throwError --- | @'throwError' exc = 'returnI' ('Error' ('Exc.toException' exc))@ -: - -:d apidoc Data.Enumerator.yield --- | @'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. -: - -:d apidoc Data.Enumerator.Binary.concatMap --- | @'concatMap' f@ applies /f/ to each input byte and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.concatMapM --- | @'concatMapM' f@ applies /f/ to each input byte and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.consume --- | @'consume' = 'takeWhile' (const True)@ --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.drop --- | @'drop' n@ ignores /n/ bytes of input from the stream. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.dropWhile --- | @'dropWhile' p@ ignores input from the stream until the first byte --- which does not match the predicate. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.enumFile --- | Opens a file path in binary mode, and passes the handle to --- 'enumHandle'. The file will be closed when enumeration finishes. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.enumFileRange --- | Opens a file path in binary mode, and passes the handle to --- 'enumHandleRange'. The file will be closed when enumeration finishes. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.enumHandle --- | Read bytes (in chunks of the given buffer size) from the handle, and --- stream them to an 'Iteratee'. If an exception occurs during file IO, --- enumeration will stop and 'Error' will be returned. Exceptions from the --- iteratee are not caught. --- --- This enumerator blocks until at least one byte is available from the --- handle, and might read less than the maximum buffer size in some --- cases. --- --- The handle should be opened with no encoding, and in 'IO.ReadMode' or --- 'IO.ReadWriteMode'. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.enumHandleRange --- | Read bytes (in chunks of the given buffer size) from the handle, and --- stream them to an 'Iteratee'. If an exception occurs during file IO, --- enumeration will stop and 'Error' will be returned. Exceptions from the --- iteratee are not caught. --- --- This enumerator blocks until at least one byte is available from the --- handle, and might read less than the maximum buffer size in some --- cases. --- --- The handle should be opened with no encoding, and in 'IO.ReadMode' or --- 'IO.ReadWriteMode'. --- --- If an offset is specified, the handle will be seeked to that offset --- before reading. If the handle cannot be seeked, an error will be --- thrown. --- --- If a maximum count is specified, the number of bytes read will not --- exceed that count. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.filter --- | Applies a predicate to the stream. The inner iteratee only receives --- characters for which the predicate is @True@. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.filterM --- | Applies a monadic predicate to the stream. The inner iteratee only --- receives bytes for which the predicate returns @True@. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.fold --- | Consume the entire input stream with a strict left fold, one byte --- at a time. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.foldM --- | Consume the entire input stream with a strict monadic left fold, one --- byte at a time. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.generateM --- | Like 'repeatM', except the computation may terminate the stream by --- returning 'Nothing'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.head --- | Get the next byte from the stream, or 'Nothing' if the stream has --- ended. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.isolate --- | @'isolate' n@ reads at most /n/ bytes from the stream, and passes them --- to its iteratee. If the iteratee finishes early, bytes continue to be --- consumed from the outer stream until /n/ have been consumed. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.iterate --- | @'iterate' f x@ enumerates an infinite stream of repeated applications --- of /f/ to /x/. --- --- Analogous to 'Prelude.iterate'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.iterateM --- | Similar to 'iterate', except the iteration function is monadic. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.iterHandle --- | Read bytes from a stream and write them to a handle. If an exception --- occurs during file IO, enumeration will stop and 'Error' will be --- returned. --- --- The handle should be opened with no encoding, and in 'IO.WriteMode' or --- 'IO.ReadWriteMode'. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.map --- | @'map' f@ applies /f/ to each input byte and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.mapM --- | @'mapM' f@ applies /f/ to each input byte and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.mapM_ --- | @'mapM_' f@ applies /f/ to each input byte, and discards the results. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.Binary.mapAccum --- | Similar to 'map', but with a stateful step function. --- --- Since: 0.4.9 -: - -:d apidoc Data.Enumerator.Binary.mapAccumM --- | Similar to 'mapM', but with a stateful step function. --- --- Since: 0.4.9 -: - -:d apidoc Data.Enumerator.Binary.concatMapAccum --- | Similar to 'concatMap', but with a stateful step function. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.Binary.concatMapAccumM --- | Similar to 'concatMapM', but with a stateful step function. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.Binary.repeat --- | Enumerates an infinite stream of a single byte. --- --- Analogous to 'Prelude.repeat'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.repeatM --- | Enumerates an infinite stream of byte. Each byte is computed by the --- underlying monad. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.replicate --- | @'replicate' n x@ enumerates a stream containing /n/ copies of /x/. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.replicateM --- | @'replicateM' n m_x@ enumerates a stream of /n/ bytes, with each byte --- computed by /m_x/. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.require --- | @'require' n@ buffers input until at least /n/ bytes are available, or --- throws an error if the stream ends early. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.splitWhen --- | Split on bytes satisfying a given predicate. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.take --- | @'take' n@ extracts the next /n/ bytes from the stream, as a lazy --- ByteString. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.takeWhile --- | @'takeWhile' p@ extracts input from the stream until the first byte which --- does not match the predicate. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Binary.unfold --- | Enumerates a stream of bytes by repeatedly applying a function to --- some state. --- --- Similar to 'iterate'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Binary.unfoldM --- | Enumerates a stream of bytes by repeatedly applying a computation to --- some state. --- --- Similar to 'iterateM'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.IO.enumFile --- | Deprecated in 0.4.5: use 'EB.enumFile' instead -: - -:d apidoc Data.Enumerator.IO.enumHandle --- | Deprecated in 0.4.5: use 'EB.enumHandle' instead -: - -:d apidoc Data.Enumerator.IO.iterHandle --- | Deprecated in 0.4.5: use 'EB.iterHandle' instead -: - -:d apidoc Data.Enumerator.List.concatMap --- | @'concatMap' f@ applies /f/ to each input element and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.concatMapM --- | @'concatMapM' f@ applies /f/ to each input element and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: -:d apidoc Data.Enumerator.List.consume --- | @'consume' = 'takeWhile' (const True)@ --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.List.drop --- | @'drop' n@ ignores /n/ input elements from the stream. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.List.dropWhile --- | @'dropWhile' p@ ignores input from the stream until the first element --- which does not match the predicate. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.List.filter --- | Applies a predicate to the stream. The inner iteratee only receives --- elements for which the predicate is @True@. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.filterM --- | Applies a monadic predicate to the stream. The inner iteratee only --- receives elements for which the predicate returns @True@. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.fold --- | Consume the entire input stream with a strict left fold, one element --- at a time. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.foldM --- | Consume the entire input stream with a strict monadic left fold, one --- element at a time. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.generateM --- | Like 'repeatM', except the computation may terminate the stream by --- returning 'Nothing'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.head --- | Get the next element from the stream, or 'Nothing' if the stream has --- ended. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.List.isolate --- | @'isolate' n@ reads at most /n/ elements from the stream, and passes them --- to its iteratee. If the iteratee finishes early, elements continue to be --- consumed from the outer stream until /n/ have been consumed. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.List.iterate --- | @'iterate' f x@ enumerates an infinite stream of repeated applications --- of /f/ to /x/. --- --- Analogous to 'Prelude.iterate'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.iterateM --- | Similar to 'iterate', except the iteration function is monadic. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.map --- | @'map' f@ applies /f/ to each input element and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.mapM --- | @'mapM' f@ applies /f/ to each input element and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.mapM_ --- | @'mapM_' f@ applies /f/ to each input element, and discards the results. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.List.mapAccum --- | Similar to 'map', but with a stateful step function. --- --- Since: 0.4.9 -: - -:d apidoc Data.Enumerator.List.mapAccumM --- | Similar to 'mapM', but with a stateful step function. --- --- Since: 0.4.9 -: - -:d apidoc Data.Enumerator.List.concatMapAccum --- | Similar to 'concatMap', but with a stateful step function. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.List.concatMapAccumM --- | Similar to 'concatMapM', but with a stateful step function. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.List.repeat --- | Enumerates an infinite stream of a single element. --- --- Analogous to 'Prelude.repeat'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.repeatM --- | Enumerates an infinite stream of element. Each element is computed by --- the underlying monad. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.replicate --- | @'replicate' n x@ enumerates a stream containing /n/ copies of /x/. --- --- Analogous to 'Prelude.replicate'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.replicateM --- | @'replicateM' n m_x@ enumerates a stream of /n/ elements, with each --- element computed by /m_x/. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.require --- | @'require' n@ buffers input until at least /n/ elements are available, or --- throws an error if the stream ends early. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.List.splitWhen --- | Split on elements satisfying a given predicate. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.take --- | @'take' n@ extracts the next /n/ elements from the stream, as a list. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.List.takeWhile --- | @'takeWhile' p@ extracts input from the stream until the first element --- which does not match the predicate. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.List.unfold --- | Enumerates a stream of elements by repeatedly applying a function to --- some state. --- --- Similar to 'iterate'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.unfoldM --- | Enumerates a stream of elements by repeatedly applying a computation to --- some state. --- --- Similar to 'iterateM'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.List.unique --- | Remove duplicate elements from a stream, passing through the first --- instance of each value. --- --- Similar to 'nub', but more efficient because it uses a 'Data.Set.Set' --- internally. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.Text.Codec --- | Since: 0.2 -: - -:d apidoc Data.Enumerator.Text.concatMap --- | @'concatMap' f@ applies /f/ to each input character and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.concatMapM --- | @'concatMapM' f@ applies /f/ to each input character and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.consume --- | @'consume' = 'takeWhile' (const True)@ --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Text.decode --- | Convert bytes into text, using the provided codec. If the codec is --- not capable of decoding an input byte sequence, an error will be thrown. --- --- Since: 0.2 -: - -:d apidoc Data.Enumerator.Text.drop --- | @'drop' n@ ignores /n/ characters of input from the stream. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Text.dropWhile --- | @'dropWhile' p@ ignores input from the stream until the first character --- which does not match the predicate. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Text.encode --- | Convert text into bytes, using the provided codec. If the codec is --- not capable of representing an input character, an error will be thrown. --- --- Since: 0.2 -: - -:d apidoc Data.Enumerator.Text.enumFile --- | Opens a file path in text mode, and passes the handle to 'enumHandle'. --- The file will be closed when the 'Iteratee' finishes. --- --- Since: 0.2 -: - -:d apidoc Data.Enumerator.Text.enumHandle --- | Read lines of text from the handle, and stream them to an 'Iteratee'. --- If an exception occurs during file IO, enumeration will stop and 'Error' --- will be returned. Exceptions from the iteratee are not caught. --- --- The handle should be opened with an appropriate text encoding, and --- in 'IO.ReadMode' or 'IO.ReadWriteMode'. --- --- Since: 0.2 -: - -:d apidoc Data.Enumerator.Text.filter --- | Applies a predicate to the stream. The inner iteratee only receives --- characters for which the predicate is @True@. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.filterM --- | Applies a monadic predicate to the stream. The inner iteratee only --- receives characters for which the predicate returns @True@. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.fold --- | Consume the entire input stream with a strict left fold, one character --- at a time. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.foldM --- | Consume the entire input stream with a strict monadic left fold, one --- character at a time. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.generateM --- | Like 'repeatM', except the computation may terminate the stream by --- returning 'Nothing'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.head --- | Get the next character from the stream, or 'Nothing' if the stream has --- ended. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Text.isolate --- | @'isolate' n@ reads at most /n/ characters from the stream, and passes --- them to its iteratee. If the iteratee finishes early, characters continue --- to be consumed from the outer stream until /n/ have been consumed. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Text.iterate --- | @'iterate' f x@ enumerates an infinite stream of repeated applications --- of /f/ to /x/. --- --- Analogous to 'Prelude.iterate'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.iterateM --- | Similar to 'iterate', except the iteration function is monadic. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.iterHandle --- | Read text from a stream and write it to a handle. If an exception --- occurs during file IO, enumeration will stop and 'Error' will be --- returned. --- --- The handle should be opened with an appropriate text encoding, and --- in 'IO.WriteMode' or 'IO.ReadWriteMode'. --- --- Since: 0.2 -: - -:d apidoc Data.Enumerator.Text.lines --- | @'lines' = 'splitWhen' (== '\n')@ --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.map --- | @'map' f@ applies /f/ to each input character and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.mapM --- | @'mapM' f@ applies /f/ to each input character and feeds the --- resulting outputs to the inner iteratee. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.mapM_ --- | @'mapM_' f@ applies /f/ to each input character, and discards the --- results. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.Text.mapAccum --- | Similar to 'map', but with a stateful step function. --- --- Since: 0.4.9 -: - -:d apidoc Data.Enumerator.Text.mapAccumM --- | Similar to 'mapM', but with a stateful step function. --- --- Since: 0.4.9 -: - -:d apidoc Data.Enumerator.Text.concatMapAccum --- | Similar to 'concatMap', but with a stateful step function. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.Text.concatMapAccumM --- | Similar to 'concatMapM', but with a stateful step function. --- --- Since: 0.4.11 -: - -:d apidoc Data.Enumerator.Text.repeat --- | Enumerates an infinite stream of a single character. --- --- Analogous to 'Prelude.repeat'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.repeatM --- | Enumerates an infinite stream of characters. Each character is computed --- by the underlying monad. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.replicate --- | @'replicate' n x@ enumerates a stream containing /n/ copies of /x/. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.replicateM --- | @'replicateM' n m_x@ enumerates a stream of /n/ characters, with each --- character computed by /m_x/. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.require --- | @'require' n@ buffers input until at least /n/ characters are available, --- or throws an error if the stream ends early. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Text.splitWhen --- | Split on characters satisfying a given predicate. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.take --- | @'take' n@ extracts the next /n/ characters from the stream, as a lazy --- Text. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Text.takeWhile --- | @'takeWhile' p@ extracts input from the stream until the first character --- which does not match the predicate. --- --- Since: 0.4.5 -: - -:d apidoc Data.Enumerator.Text.unfold --- | Enumerates a stream of characters by repeatedly applying a function to --- some state. --- --- Similar to 'iterate'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.Text.unfoldM --- | Enumerates a stream of characters by repeatedly applying a computation --- to some state. --- --- Similar to 'iterateM'. --- --- Since: 0.4.8 -: - -:d apidoc Data.Enumerator.tryIO --- | 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 -: diff --git a/src/compatibility.anansi b/src/compatibility.anansi deleted file mode 100644 --- a/src/compatibility.anansi +++ /dev/null @@ -1,287 +0,0 @@ -\section{Legacy compatibility} - -Version 0.4.5 of this library introduced some substantial reorganization -and renamings; this section implements compatibility shims, so the API -remains stable. - -\subsection{Obsolete functions} - -These are functions which seemed like good ideas, or were defined by other -enumerator/iteratee libraries, but turned out to be basically useless. At -least, I've never figured out what they're good for. - -:d compatibility: obsolete -|apidoc Data.Enumerator.liftTrans| -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) -: - -:d compatibility: obsolete -{-# DEPRECATED liftI "Use 'Data.Enumerator.continue' instead" #-} -|apidoc Data.Enumerator.liftI| -liftI :: Monad m => (Stream a -> Step a m b) - -> Iteratee a m b -liftI k = continue (returnI . k) -: - -:d compatibility: obsolete -|apidoc Data.Enumerator.peek| -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 -: - -:d compatibility: obsolete -|apidoc Data.Enumerator.last| -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 -: - -:d compatibility: obsolete -|apidoc Data.Enumerator.length| -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 -: - -\subsection{Aliases} - -In previous library versions, several list-based iteratees were defined in -{\tt Data.Enumerator}. They are now defined in {\tt Data.Enumerator.List}; -because these functions use core enumerator types, a bit of module -gymnastics is required to get everything compiling properly. - -:f Data/Enumerator.hs-boot -module Data.Enumerator where -import qualified Control.Exception as Exc -data Stream a -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) - } -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) -: - -:f Data/Enumerator/List.hs-boot -module Data.Enumerator.List where -import {-# SOURCE #-} Data.Enumerator -head :: Monad m => Iteratee a m (Maybe a) -drop :: Monad m => Integer -> Iteratee a m () -dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () -takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] -consume :: Monad m => Iteratee a m [a] -fold :: Monad m => (b -> a -> b) -> b -> Iteratee a m b -foldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m b -iterate :: Monad m => (a -> a) -> a -> Enumerator a m b -iterateM :: Monad m => (a -> m a) -> a -> Enumerator a m b -repeat :: Monad m => a -> Enumerator a m b -repeatM :: Monad m => m a -> Enumerator a m b -replicateM :: Monad m => Integer -> m a -> Enumerator a m b -replicate :: Monad m => Integer -> a -> Enumerator a m b -generateM :: Monad m => m (Maybe a) -> Enumerator a m b -map :: Monad m => (ao -> ai) -> Enumeratee ao ai m b -mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m b -concatMap :: Monad m => (ao -> [ai]) -> Enumeratee ao ai m b -concatMapM :: Monad m => (ao -> m [ai]) -> Enumeratee ao ai m b -filter :: Monad m => (a -> Bool) -> Enumeratee a a m b -filterM :: Monad m => (a -> m Bool) -> Enumeratee a a m b -: - -These {\tt .hs-boot} files are enough for {\tt Data.Enumerator} to re-export -the list functions under old names, with appropriate deprecation warnings. - -:d compatibility: aliases -{-# DEPRECATED head "Use 'Data.Enumerator.List.head' instead" #-} -|apidoc Data.Enumerator.head| -head :: Monad m => Iteratee a m (Maybe a) -head = EL.head - -{-# DEPRECATED drop "Use 'Data.Enumerator.List.drop' instead" #-} -|apidoc Data.Enumerator.drop| -drop :: Monad m => Integer -> Iteratee a m () -drop = EL.drop - -{-# DEPRECATED dropWhile "Use 'Data.Enumerator.List.dropWhile' instead" #-} -|apidoc Data.Enumerator.dropWhile| -dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () -dropWhile = EL.dropWhile - -{-# DEPRECATED span "Use 'Data.Enumerator.List.takeWhile' instead" #-} -|apidoc Data.Enumerator.span| -span :: Monad m => (a -> Bool) -> Iteratee a m [a] -span = EL.takeWhile - -{-# DEPRECATED break "Use 'Data.Enumerator.List.takeWhile' instead" #-} -|apidoc Data.Enumerator.break| -break :: Monad m => (a -> Bool) -> Iteratee a m [a] -break p = EL.takeWhile (not . p) - -{-# DEPRECATED consume "Use 'Data.Enumerator.List.consume' instead" #-} -|apidoc Data.Enumerator.consume| -consume :: Monad m => Iteratee a m [a] -consume = EL.consume - -{-# DEPRECATED foldl "Use Data.Enumerator.List.fold instead" #-} -|apidoc Data.Enumerator.foldl| -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" #-} -|apidoc Data.Enumerator.foldl'| -foldl' :: Monad m => (b -> a -> b) -> b -> Iteratee a m b -foldl' = EL.fold - -{-# DEPRECATED foldM "Use Data.Enumerator.List.foldM instead" #-} -|apidoc Data.Enumerator.foldM| -foldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m b -foldM = EL.foldM - -{-# DEPRECATED iterate "Use Data.Enumerator.List.iterate instead" #-} -|apidoc Data.Enumerator.iterate| -iterate :: Monad m => (a -> a) -> a -> Enumerator a m b -iterate = EL.iterate - -{-# DEPRECATED iterateM "Use Data.Enumerator.List.iterateM instead" #-} -|apidoc Data.Enumerator.iterateM| -iterateM :: Monad m => (a -> m a) -> a -> Enumerator a m b -iterateM = EL.iterateM - -{-# DEPRECATED repeat "Use Data.Enumerator.List.repeat instead" #-} -|apidoc Data.Enumerator.repeat| -repeat :: Monad m => a -> Enumerator a m b -repeat = EL.repeat - -{-# DEPRECATED repeatM "Use Data.Enumerator.List.repeatM instead" #-} -|apidoc Data.Enumerator.repeatM| -repeatM :: Monad m => m a -> Enumerator a m b -repeatM = EL.repeatM - -{-# DEPRECATED replicate "Use Data.Enumerator.List.replicate instead" #-} -|apidoc Data.Enumerator.replicate| -replicate :: Monad m => Integer -> a -> Enumerator a m b -replicate = EL.replicate - -{-# DEPRECATED replicateM "Use Data.Enumerator.List.replicateM instead" #-} -|apidoc Data.Enumerator.replicateM| -replicateM :: Monad m => Integer -> m a -> Enumerator a m b -replicateM = EL.replicateM - -{-# DEPRECATED generateM "Use Data.Enumerator.List.generateM instead" #-} -|apidoc Data.Enumerator.generateM| -generateM :: Monad m => m (Maybe a) -> Enumerator a m b -generateM = EL.generateM - -{-# DEPRECATED map "Use Data.Enumerator.List.map instead" #-} -|apidoc Data.Enumerator.map| -map :: Monad m => (ao -> ai) -> Enumeratee ao ai m b -map = EL.map - -{-# DEPRECATED mapM "Use Data.Enumerator.List.mapM instead" #-} -|apidoc Data.Enumerator.mapM| -mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m b -mapM = EL.mapM - -{-# DEPRECATED concatMap "Use Data.Enumerator.List.concatMap instead" #-} -|apidoc Data.Enumerator.concatMap| -concatMap :: Monad m => (ao -> [ai]) -> Enumeratee ao ai m b -concatMap = EL.concatMap - -{-# DEPRECATED concatMapM "Use Data.Enumerator.List.concatMapM instead" #-} -|apidoc Data.Enumerator.concatMapM| -concatMapM :: Monad m => (ao -> m [ai]) -> Enumeratee ao ai m b -concatMapM = EL.concatMapM - -{-# DEPRECATED filter "Use Data.Enumerator.List.filter instead" #-} -|apidoc Data.Enumerator.filter| -filter :: Monad m => (a -> Bool) -> Enumeratee a a m b -filter = EL.filter - -{-# DEPRECATED filterM "Use Data.Enumerator.List.filterM instead" #-} -|apidoc Data.Enumerator.filterM| -filterM :: Monad m => (a -> m Bool) -> Enumeratee a a m b -filterM = EL.filterM -: - -0.4.5 also saw the pure-fold enumerators renamed, to match other functions -based on {\tt Prelude} names. - -:d compatibility: aliases -{-# DEPRECATED liftFoldL "Use Data.Enumerator.List.fold instead" #-} -|apidoc Data.Enumerator.liftFoldL| -liftFoldL :: Monad m => (b -> a -> b) -> b - -> Iteratee a m b -liftFoldL = Data.Enumerator.foldl - -{-# DEPRECATED liftFoldL' "Use Data.Enumerator.List.fold instead" #-} -|apidoc Data.Enumerator.liftFoldL'| -liftFoldL' :: Monad m => (b -> a -> b) -> b - -> Iteratee a m b -liftFoldL' = EL.fold - -{-# DEPRECATED liftFoldM "Use Data.Enumerator.List.foldM instead" #-} -|apidoc Data.Enumerator.liftFoldM| -liftFoldM :: Monad m => (b -> a -> m b) -> b - -> Iteratee a m b -liftFoldM = EL.foldM -: - -Finally, the {\tt Data.Enumerator.IO} module was moved to -{\tt Data.Enumerator.Binary}, and altered to include many more functions -related to binary and {\tt ByteString} processing. - -:f Data/Enumerator/IO.hs -|Data.Enumerator.IO module header| -module Data.Enumerator.IO - {-# DEPRECATED "Use 'Data.Enumerator.Binary' instead" #-} - ( enumHandle - , enumFile - , iterHandle - ) where -import qualified Data.Enumerator as E -import qualified Data.Enumerator.Binary as EB -import Control.Monad.IO.Class (MonadIO) -import qualified Data.ByteString as B -import qualified System.IO as IO - -{-# DEPRECATED enumHandle "Use 'Data.Enumerator.Binary.enumHandle' instead" #-} -|apidoc Data.Enumerator.IO.enumHandle| -enumHandle :: MonadIO m - => Integer - -> IO.Handle - -> E.Enumerator B.ByteString m b -enumHandle = EB.enumHandle - -{-# DEPRECATED enumFile "Use 'Data.Enumerator.Binary.enumFile' instead" #-} -|apidoc Data.Enumerator.IO.enumFile| -enumFile :: FilePath -> E.Enumerator B.ByteString IO b -enumFile = EB.enumFile - -{-# DEPRECATED iterHandle "Use 'Data.Enumerator.Binary.iterHandle' instead" #-} -|apidoc Data.Enumerator.IO.iterHandle| -iterHandle :: MonadIO m => IO.Handle - -> E.Iteratee B.ByteString m () -iterHandle = EB.iterHandle -: diff --git a/src/enumerator.anansi b/src/enumerator.anansi deleted file mode 100644 --- a/src/enumerator.anansi +++ /dev/null @@ -1,92 +0,0 @@ -:# Copyright (C) 2010 John Millikin -:# -:# See license.txt for details - -:option tab-size 8 - -\documentclass{article} - -\usepackage{color} -\usepackage{hyperref} -\usepackage{indentfirst} -\usepackage{amsmath} -\usepackage{multicol} -\usepackage{comment} - -\usepackage{latex/noweb} -\usepackage[margin=3cm]{latex/geometry} - -\usepackage{titlesec} -\newcommand{\subsectionbreak}{\clearpage} - -% \noweboptions{smallcode} - -% Remove boxes from hyperlinks -\hypersetup{ - colorlinks, - linkcolor=blue, - urlcolor=blue, -} - -\newcommand{\io}{{\sc i/o}} - -\title{enumerator\_0.4.9} -\author{John Millikin\\ - \href{mailto:"John Millikin" }{\tt jmillikin@gmail.com}} -\date{March 29, 2011} - -\begin{document} - -\newgeometry{left=1.1cm,top=1cm,right=1.1cm} - -\maketitle - -\setlength{\parskip}{5pt plus 1pt} -\setlength{\columnsep}{0.8cm} - -\begin{multicols}{2} - -:include summary.anansi - -\noindent Homepage: \href{http://john-millikin.com/software/enumerator/} - {\small \tt http://john-millikin.com/software/enumerator/} - -\setlength{\parskip}{0pt plus 1pt} -\tableofcontents -\setlength{\parskip}{4pt plus 1pt} -\end{multicols} - -\restoregeometry - -\newpage -:include types.anansi - -\newpage -:include primitives.anansi - -\newpage -:include list-analogues.anansi - -\newpage -:include io.anansi - -\newpage -:include text-codecs.anansi - -\newpage -:include utilities.anansi - -\appendix - -\newpage -:include public-interface.anansi - -\newpage -:include compatibility.anansi - -% exclude API docs from LaTeX output, since they're generally uninteresting -\begin{comment} -:include api-docs.anansi -\end{comment} - -\end{document} diff --git a/src/io.anansi b/src/io.anansi deleted file mode 100644 --- a/src/io.anansi +++ /dev/null @@ -1,145 +0,0 @@ -\section{IO} - -\subsection{Binary IO} - -{\tt enumHandle} and {\tt enumFile} are rough analogues of -{\tt hGetContents} and {\tt readFile} from the standard library, except -they operate only in binary mode. - -Any exceptions thrown while reading or writing data are caught and reported -using {\tt throwError}, so errors can be handled in pure iteratees. - -:d binary IO -|apidoc Data.Enumerator.Binary.enumHandle| -enumHandle :: MonadIO m - => Integer -- ^ Buffer size - -> IO.Handle - -> Enumerator B.ByteString m b -enumHandle bufferSize h = checkContinue0 $ \loop k -> do - let intSize = fromInteger bufferSize - - bytes <- tryIO (getBytes h intSize) - if B.null bytes - then continue k - else k (Chunks [bytes]) >>== loop -: - -:d binary IO -|apidoc Data.Enumerator.Binary.enumHandleRange| -enumHandleRange :: MonadIO m - => Integer -- ^ Buffer size - -> Maybe Integer -- ^ Offset - -> Maybe Integer -- ^ Maximum count - -> IO.Handle - -> Enumerator B.ByteString m b -enumHandleRange bufferSize offset count h s = seek >> enum where - seek = case offset of - Nothing -> return () - Just off -> tryIO (IO.hSeek h IO.AbsoluteSeek off) - - enum = case count of - Just n -> enumRange n s - Nothing -> enumHandle bufferSize h s - - enumRange = checkContinue1 $ \loop n k -> let - rem = fromInteger (min bufferSize n) - keepGoing = do - bytes <- tryIO (getBytes h rem) - if B.null bytes - then continue k - else feed bytes - feed bs = k (Chunks [bs]) >>== loop (n - (toInteger (B.length bs))) - in if rem <= 0 - then continue k - else keepGoing -: - -:d binary IO -getBytes :: IO.Handle -> Int -> IO B.ByteString -getBytes h n = do - hasInput <- Exc.catch - (IO.hWaitForInput h (-1)) - (\err -> if isEOFError err - then return False - else Exc.throwIO err) - if hasInput - then B.hGetNonBlocking h n - else return B.empty -: - -:d binary IO -|apidoc Data.Enumerator.Binary.enumFile| -enumFile :: FilePath -> Enumerator B.ByteString IO b -enumFile path = enumFileRange path Nothing Nothing -: - -:d binary IO -|apidoc Data.Enumerator.Binary.enumFileRange| -enumFileRange :: FilePath - -> Maybe Integer -- ^ Offset - -> Maybe Integer -- ^ Maximum count - -> Enumerator B.ByteString IO b -enumFileRange path offset count step = do - h <- tryIO (IO.openBinaryFile path IO.ReadMode) - let iter = enumHandleRange 4096 offset count h step - Iteratee (Exc.finally (runIteratee iter) (IO.hClose h)) -: - -:d binary IO -|apidoc Data.Enumerator.Binary.iterHandle| -iterHandle :: MonadIO m => IO.Handle - -> Iteratee B.ByteString m () -iterHandle h = continue step where - step EOF = yield () EOF - step (Chunks []) = continue step - step (Chunks bytes) = do - tryIO (CM.mapM_ (B.hPut h) bytes) - continue step -: - -\subsection{Text IO} - -Reading text is similar to reading bytes, but the enumerators have slightly -different behavior -- instead of reading in fixed-size chunks of data, the -text enumerators read in lines. This matches similar text-based {\sc api}s, -such as Python's {\tt xreadlines()}. - -:d text IO -|apidoc Data.Enumerator.Text.enumHandle| -enumHandle :: MonadIO m => IO.Handle - -> Enumerator T.Text m b -enumHandle h = checkContinue0 $ \loop k -> do - let getText = Exc.catch - (Just `fmap` TIO.hGetLine h) - (\err -> if isEOFError err - then return Nothing - else Exc.throwIO err) - - maybeText <- tryIO getText - case maybeText of - Nothing -> continue k - Just text -> k (Chunks [text]) >>== loop - -: - -:d text IO -|apidoc Data.Enumerator.Text.enumFile| -enumFile :: FilePath -> Enumerator T.Text IO b -enumFile path step = do - h <- tryIO (IO.openFile path IO.ReadMode) - Iteratee $ Exc.finally - (runIteratee (enumHandle h step)) - (IO.hClose h) -: - -:d text IO -|apidoc Data.Enumerator.Text.iterHandle| -iterHandle :: MonadIO m => IO.Handle - -> Iteratee T.Text m () -iterHandle h = continue step where - step EOF = yield () EOF - step (Chunks []) = continue step - step (Chunks chunks) = do - tryIO (CM.mapM_ (TIO.hPutStr h) chunks) - continue step -: diff --git a/src/list-analogues.anansi b/src/list-analogues.anansi deleted file mode 100644 --- a/src/list-analogues.anansi +++ /dev/null @@ -1,925 +0,0 @@ -\section{List analogues} - -\subsection{Folds} - -Since iteratees are semantically a left-fold, there are many existing -folds that can be lifted to iteratees. The {\tt foldl}, {\tt foldl'}, and -{\tt foldM} functions work like their standard library namesakes, but -construct iteratees instead. These iteratees are not as complex as what can -be created using {\tt Yield} and {\tt Continue}, but cover many common cases. - -Each fold consumes input from the stream until {\sc eof}, when it yields its -current accumulator. - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.fold| -fold :: Monad m => (b -> a -> b) -> b - -> Iteratee a m b -fold step = continue . loop where - f = L.foldl' step - loop acc stream = case stream of - Chunks [] -> continue (loop acc) - Chunks xs -> continue (loop $! f acc xs) - EOF -> yield acc EOF -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.foldM| -foldM :: Monad m => (b -> a -> m b) -> b - -> Iteratee a m b -foldM step = continue . loop where - f = CM.foldM step - - loop acc stream = acc `seq` case stream of - Chunks [] -> continue (loop acc) - Chunks xs -> lift (f acc xs) >>= continue . loop - EOF -> yield acc EOF -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.fold| -fold :: Monad m => (b -> Word8 -> b) -> b - -> Iteratee B.ByteString m b -fold step = EL.fold (B.foldl' step) - -|apidoc Data.Enumerator.Binary.foldM| -foldM :: Monad m => (b -> Word8 -> m b) -> b - -> Iteratee B.ByteString m b -foldM step = EL.foldM (\b bytes -> CM.foldM step b (B.unpack bytes)) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.fold| -fold :: Monad m => (b -> Char -> b) -> b - -> Iteratee T.Text m b -fold step = EL.fold (T.foldl' step) - -|apidoc Data.Enumerator.Text.foldM| -foldM :: Monad m => (b -> Char -> m b) -> b - -> Iteratee T.Text m b -foldM step = EL.foldM (\b txt -> CM.foldM step b (T.unpack txt)) -: - -\subsection{Unfolds} - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.unfold| -unfold :: Monad m => (s -> Maybe (a, s)) -> s -> Enumerator a m b -unfold f = checkContinue1 $ \loop s k -> case f s of - Nothing -> continue k - Just (a, s') -> k (Chunks [a]) >>== loop s' -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.unfold| -unfold :: Monad m => (s -> Maybe (Word8, s)) -> s -> Enumerator B.ByteString m b -unfold f = checkContinue1 $ \loop s k -> case f s of - Nothing -> continue k - Just (b, s') -> k (Chunks [B.singleton b]) >>== loop s' -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.unfold| -unfold :: Monad m => (s -> Maybe (Char, s)) -> s -> Enumerator T.Text m b -unfold f = checkContinue1 $ \loop s k -> case f s of - Nothing -> continue k - Just (c, s') -> k (Chunks [T.singleton c]) >>== loop s' -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.unfoldM| -unfoldM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Enumerator a m b -unfoldM f = checkContinue1 $ \loop s k -> do - fs <- lift (f s) - case fs of - Nothing -> continue k - Just (a, s') -> k (Chunks [a]) >>== loop s' -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.unfoldM| -unfoldM :: Monad m => (s -> m (Maybe (Word8, s))) -> s -> Enumerator B.ByteString m b -unfoldM f = checkContinue1 $ \loop s k -> do - fs <- lift (f s) - case fs of - Nothing -> continue k - Just (b, s') -> k (Chunks [B.singleton b]) >>== loop s' -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.unfoldM| -unfoldM :: Monad m => (s -> m (Maybe (Char, s))) -> s -> Enumerator T.Text m b -unfoldM f = checkContinue1 $ \loop s k -> do - fs <- lift (f s) - case fs of - Nothing -> continue k - Just (c, s') -> k (Chunks [T.singleton c]) >>== loop s' -: - -\subsection{Maps} - -Enumeratees are conceptually similar to a monadic {\tt concatMap}; each -outer input element is converted to a list of inner inputs, which are passed -to the inner iteratee. Error handling and performance considerations -make most real-life enumeratees more complex, but some don't need the extra -design. - -The {\tt checkDone} and {\tt checkDoneEx} functions referenced here are -defined later, with other utilities. - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.concatMapM| -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) -: - -Once {\tt concatMapM} is defined, similar enumeratees can be easily created -via small wrappers. - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.concatMap| -concatMap :: Monad m => (ao -> [ai]) - -> Enumeratee ao ai m b -concatMap f = concatMapM (return . f) - -|apidoc Data.Enumerator.List.map| -map :: Monad m => (ao -> ai) - -> Enumeratee ao ai m b -map f = Data.Enumerator.List.concatMap (\x -> [f x]) - -|apidoc Data.Enumerator.List.mapM| -mapM :: Monad m => (ao -> m ai) - -> Enumeratee ao ai m b -mapM f = concatMapM (\x -> Prelude.mapM f [x]) - -|apidoc Data.Enumerator.List.mapM_| -mapM_ :: Monad m => (a -> m b) -> Iteratee a m () -mapM_ f = foldM (\_ x -> f x >> return ()) () -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.map| -map :: Monad m => (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m b -map f = Data.Enumerator.Binary.concatMap (\x -> B.singleton (f x)) - -|apidoc Data.Enumerator.Binary.mapM| -mapM :: Monad m => (Word8 -> m Word8) -> Enumeratee B.ByteString B.ByteString m b -mapM f = Data.Enumerator.Binary.concatMapM (\x -> liftM B.singleton (f x)) - -|apidoc Data.Enumerator.Binary.mapM_| -mapM_ :: Monad m => (Word8 -> m ()) -> Iteratee B.ByteString m () -mapM_ f = foldM (\_ x -> f x >> return ()) () - -|apidoc Data.Enumerator.Binary.concatMap| -concatMap :: Monad m => (Word8 -> B.ByteString) -> Enumeratee B.ByteString B.ByteString m b -concatMap f = Data.Enumerator.Binary.concatMapM (return . f) - -|apidoc Data.Enumerator.Binary.concatMapM| -concatMapM :: Monad m => (Word8 -> m B.ByteString) -> Enumeratee B.ByteString B.ByteString m b -concatMapM f = checkDone (continue . step) where - step k EOF = yield (Continue k) EOF - step k (Chunks xs) = loop k (BL.unpack (BL.fromChunks xs)) - - loop k [] = continue (step k) - loop k (x:xs) = do - fx <- lift (f x) - k (Chunks [fx]) >>== - checkDoneEx (Chunks [B.pack xs]) (\k' -> loop k' xs) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.map| -map :: Monad m => (Char -> Char) -> Enumeratee T.Text T.Text m b -map f = Data.Enumerator.Text.concatMap (\x -> T.singleton (f x)) - -|apidoc Data.Enumerator.Text.mapM| -mapM :: Monad m => (Char -> m Char) -> Enumeratee T.Text T.Text m b -mapM f = Data.Enumerator.Text.concatMapM (\x -> liftM T.singleton (f x)) - -|apidoc Data.Enumerator.Text.mapM_| -mapM_ :: Monad m => (Char -> m ()) -> Iteratee T.Text m () -mapM_ f = foldM (\_ x -> f x >> return ()) () - -|apidoc Data.Enumerator.Text.concatMap| -concatMap :: Monad m => (Char -> T.Text) -> Enumeratee T.Text T.Text m b -concatMap f = Data.Enumerator.Text.concatMapM (return . f) - -|apidoc Data.Enumerator.Text.concatMapM| -concatMapM :: Monad m => (Char -> m T.Text) -> Enumeratee T.Text T.Text m b -concatMapM f = checkDone (continue . step) where - step k EOF = yield (Continue k) EOF - step k (Chunks xs) = loop k (TL.unpack (TL.fromChunks xs)) - - loop k [] = continue (step k) - loop k (x:xs) = do - fx <- lift (f x) - k (Chunks [fx]) >>== - checkDoneEx (Chunks [T.pack xs]) (\k' -> loop k' xs) -: - -\subsection{Accumulating maps} - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.concatMapAccum| -concatMapAccum :: Monad m => (s -> ao -> (s, [ai])) -> s -> Enumeratee ao ai m b -concatMapAccum f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case f s x of - (s', ai) -> k (Chunks ai) >>== - checkDoneEx (Chunks xs) (\k' -> loop s' k' xs) - -|apidoc Data.Enumerator.List.concatMapAccumM| -concatMapAccumM :: Monad m => (s -> ao -> m (s, [ai])) -> s -> Enumeratee ao ai m b -concatMapAccumM f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = do - (s', ai) <- lift (f s x) - k (Chunks ai) >>== - checkDoneEx (Chunks xs) (\k' -> loop s' k' xs) - -|apidoc Data.Enumerator.List.mapAccum| -mapAccum :: Monad m => (s -> ao -> (s, ai)) -> s -> Enumeratee ao ai m b -mapAccum f = concatMapAccum (\s ao -> case f s ao of (s', ai) -> (s', [ai])) - -|apidoc Data.Enumerator.List.mapAccumM| -mapAccumM :: Monad m => (s -> ao -> m (s, ai)) -> s -> Enumeratee ao ai m b -mapAccumM f = concatMapAccumM (\s ao -> do - (s', ai) <- f s ao - return (s', [ai])) -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.concatMapAccum| -concatMapAccum :: Monad m => (s -> Word8 -> (s, B.ByteString)) -> s -> Enumeratee B.ByteString B.ByteString m b -concatMapAccum f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case B.uncons x of - Nothing -> loop s k xs - Just (b, x') -> case f s b of - (s', ai) -> k (Chunks [ai]) >>== - checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) - -|apidoc Data.Enumerator.Binary.concatMapAccumM| -concatMapAccumM :: Monad m => (s -> Word8 -> m (s, B.ByteString)) -> s -> Enumeratee B.ByteString B.ByteString m b -concatMapAccumM f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case B.uncons x of - Nothing -> loop s k xs - Just (b, x') -> do - (s', ai) <- lift (f s b) - k (Chunks [ai]) >>== - checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) - -|apidoc Data.Enumerator.Binary.mapAccum| -mapAccum :: Monad m => (s -> Word8 -> (s, Word8)) -> s -> Enumeratee B.ByteString B.ByteString m b -mapAccum f = concatMapAccum (\s w -> case f s w of (s', w') -> (s', B.singleton w')) - -|apidoc Data.Enumerator.Binary.mapAccumM| -mapAccumM :: Monad m => (s -> Word8 -> m (s, Word8)) -> s -> Enumeratee B.ByteString B.ByteString m b -mapAccumM f = concatMapAccumM (\s w -> do - (s', w') <- f s w - return (s', B.singleton w')) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.concatMapAccum| -concatMapAccum :: Monad m => (s -> Char -> (s, T.Text)) -> s -> Enumeratee T.Text T.Text m b -concatMapAccum f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case T.uncons x of - Nothing -> loop s k xs - Just (c, x') -> case f s c of - (s', ai) -> k (Chunks [ai]) >>== - checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) - -|apidoc Data.Enumerator.Text.concatMapAccumM| -concatMapAccumM :: Monad m => (s -> Char -> m (s, T.Text)) -> s -> Enumeratee T.Text T.Text m b -concatMapAccumM f s0 = checkDone (continue . step s0) where - step _ k EOF = yield (Continue k) EOF - step s k (Chunks xs) = loop s k xs - - loop s k [] = continue (step s k) - loop s k (x:xs) = case T.uncons x of - Nothing -> loop s k xs - Just (c, x') -> do - (s', ai) <- lift (f s c) - k (Chunks [ai]) >>== - checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs)) - -|apidoc Data.Enumerator.Text.mapAccum| -mapAccum :: Monad m => (s -> Char -> (s, Char)) -> s -> Enumeratee T.Text T.Text m b -mapAccum f = concatMapAccum (\s c -> case f s c of (s', c') -> (s', T.singleton c')) - -|apidoc Data.Enumerator.Text.mapAccumM| -mapAccumM :: Monad m => (s -> Char -> m (s, Char)) -> s -> Enumeratee T.Text T.Text m b -mapAccumM f = concatMapAccumM (\s c -> do - (s', c') <- f s c - return (s', T.singleton c')) -: - -\subsection{Infinite streams} - -{\tt iterate} and {\tt iterateM} apply a function repeatedly to the base -input, passing the results through as a stream. - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.iterate| -iterate :: Monad m => (a -> a) -> a -> Enumerator a m b -iterate f = checkContinue1 $ \loop s k -> k (Chunks [s]) >>== loop (f s) -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.iterate| -iterate :: Monad m => (Word8 -> Word8) -> Word8 -> Enumerator B.ByteString m b -iterate f = checkContinue1 $ \loop s k -> k (Chunks [B.singleton s]) >>== loop (f s) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.iterate| -iterate :: Monad m => (Char -> Char) -> Char -> Enumerator T.Text m b -iterate f = checkContinue1 $ \loop s k -> k (Chunks [T.singleton s]) >>== loop (f s) -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.iterateM| -iterateM :: Monad m => (a -> m a) -> a - -> Enumerator a m b -iterateM f base = worker (return base) where - worker = checkContinue1 $ \loop m_a k -> do - a <- lift m_a - k (Chunks [a]) >>== loop (f a) -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.iterateM| -iterateM :: Monad m => (Word8 -> m Word8) -> Word8 -> Enumerator B.ByteString m b -iterateM f base = worker (return base) where - worker = checkContinue1 $ \loop m_byte k -> do - byte <- lift m_byte - k (Chunks [B.singleton byte]) >>== loop (f byte) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.iterateM| -iterateM :: Monad m => (Char -> m Char) -> Char -> Enumerator T.Text m b -iterateM f base = worker (return base) where - worker = checkContinue1 $ \loop m_char k -> do - char <- lift m_char - k (Chunks [T.singleton char]) >>== loop (f char) -: - -{\tt repeat} and {\tt repeatM} create infinite streams, where each input -is a single value. - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.repeat| -repeat :: Monad m => a -> Enumerator a m b -repeat a = checkContinue0 $ \loop k -> k (Chunks [a]) >>== loop -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.repeatM| -repeatM :: Monad m => m a -> Enumerator a m b -repeatM m_a step = do - a <- lift m_a - iterateM (const m_a) a step -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.repeat| -repeat :: Monad m => Word8 -> Enumerator B.ByteString m b -repeat byte = EL.repeat (B.singleton byte) - -|apidoc Data.Enumerator.Binary.repeatM| -repeatM :: Monad m => m Word8 -> Enumerator B.ByteString m b -repeatM next = EL.repeatM (liftM B.singleton next) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.repeat| -repeat :: Monad m => Char -> Enumerator T.Text m b -repeat char = EL.repeat (T.singleton char) - -|apidoc Data.Enumerator.Text.repeatM| -repeatM :: Monad m => m Char -> Enumerator T.Text m b -repeatM next = EL.repeatM (liftM T.singleton next) -: - -\subsection{Bounded streams} - -{\tt replicate} and {\tt replicateM} create streams containing a given -quantity of the input value. - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.replicateM| -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 -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.replicate| -replicate :: Monad m => Integer -> a - -> Enumerator a m b -replicate maxCount a = replicateM maxCount (return a) -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.replicate| -replicate :: Monad m => Integer -> Word8 -> Enumerator B.ByteString m b -replicate n byte = EL.replicate n (B.singleton byte) - -|apidoc Data.Enumerator.Binary.replicateM| -replicateM :: Monad m => Integer -> m Word8 -> Enumerator B.ByteString m b -replicateM n next = EL.replicateM n (liftM B.singleton next) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.replicate| -replicate :: Monad m => Integer -> Char -> Enumerator T.Text m b -replicate n byte = EL.replicate n (T.singleton byte) - -|apidoc Data.Enumerator.Text.replicateM| -replicateM :: Monad m => Integer -> m Char -> Enumerator T.Text m b -replicateM n next = EL.replicateM n (liftM T.singleton next) -: - -{\tt generateM} runs a monadic computation until it returns {\tt Nothing}, -which signals the end of enumeration. - -Note that when the enumerator is finished, it does not send {\tt EOF} to -the iteratee. Instead, it returns a continuation, so additional enumerators -may add their own input to the stream. - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.generateM| -generateM :: Monad m => m (Maybe a) - -> Enumerator a m b -generateM getNext = checkContinue0 $ \loop k -> do - next <- lift getNext - case next of - Nothing -> continue k - Just x -> k (Chunks [x]) >>== loop -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.generateM| -generateM :: Monad m => m (Maybe Word8) -> Enumerator B.ByteString m b -generateM next = EL.generateM (liftM (liftM B.singleton) next) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.generateM| -generateM :: Monad m => m (Maybe Char) -> Enumerator T.Text m b -generateM next = EL.generateM (liftM (liftM T.singleton) next) -: - -\subsection{Filters} - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.filter| -filter :: Monad m => (a -> Bool) - -> Enumeratee a a m b -filter p = Data.Enumerator.List.concatMap (\x -> [x | p x]) -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.filterM| -filterM :: Monad m => (a -> m Bool) - -> Enumeratee a a m b -filterM p = concatMapM (\x -> CM.filterM p [x]) -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.filter| -filter :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b -filter p = Data.Enumerator.Binary.concatMap (\x -> B.pack [x | p x]) - -|apidoc Data.Enumerator.Binary.filterM| -filterM :: Monad m => (Word8 -> m Bool) -> Enumeratee B.ByteString B.ByteString m b -filterM p = Data.Enumerator.Binary.concatMapM (\x -> liftM B.pack (CM.filterM p [x])) -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.filter| -filter :: Monad m => (Char -> Bool) -> Enumeratee T.Text T.Text m b -filter p = Data.Enumerator.Text.concatMap (\x -> T.pack [x | p x]) - -|apidoc Data.Enumerator.Text.filterM| -filterM :: Monad m => (Char -> m Bool) -> Enumeratee T.Text T.Text m b -filterM p = Data.Enumerator.Text.concatMapM (\x -> liftM T.pack (CM.filterM p [x])) -: - -\subsection{Consumers} - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.take| -take :: Monad m => Integer -> Iteratee a m [a] -take n | n <= 0 = return [] -take n = continue (loop id n) where - len = L.genericLength - loop acc n' (Chunks xs) - | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) - | otherwise = let - (xs', extra) = L.genericSplitAt n' xs - in yield (acc xs') (Chunks extra) - loop acc _ EOF = yield (acc []) EOF -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.take| -take :: Monad m => Integer -> Iteratee B.ByteString m BL.ByteString -take n | n <= 0 = return BL.empty -take n = continue (loop id n) where - loop acc n' (Chunks xs) = iter where - lazy = BL.fromChunks xs - len = toInteger (BL.length lazy) - - iter = if len < n' - then continue (loop (acc . (BL.append lazy)) (n' - len)) - else let - (xs', extra) = BL.splitAt (fromInteger n') lazy - in yield (acc xs') (toChunks extra) - loop acc _ EOF = yield (acc BL.empty) EOF -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.take| -take :: Monad m => Integer -> Iteratee T.Text m TL.Text -take n | n <= 0 = return TL.empty -take n = continue (loop id n) where - loop acc n' (Chunks xs) = iter where - lazy = TL.fromChunks xs - len = toInteger (TL.length lazy) - - iter = if len < n' - then continue (loop (acc . (TL.append lazy)) (n' - len)) - else let - (xs', extra) = TL.splitAt (fromInteger n') lazy - in yield (acc xs') (toChunks extra) - loop acc _ EOF = yield (acc TL.empty) EOF -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.takeWhile| -takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] -takeWhile p = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = case Prelude.span p xs of - (_, []) -> continue (loop (acc . (xs ++))) - (xs', extra) -> yield (acc xs') (Chunks extra) - loop acc EOF = yield (acc []) EOF -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.takeWhile| -takeWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m BL.ByteString -takeWhile p = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = iter where - lazy = BL.fromChunks xs - (xs', extra) = BL.span p lazy - iter = if BL.null extra - then continue (loop (acc . (BL.append lazy))) - else yield (acc xs') (toChunks extra) - loop acc EOF = yield (acc BL.empty) EOF -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.takeWhile| -takeWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m TL.Text -takeWhile p = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = iter where - lazy = TL.fromChunks xs - (xs', extra) = tlSpanBy p lazy - iter = if TL.null extra - then continue (loop (acc . (TL.append lazy))) - else yield (acc xs') (toChunks extra) - loop acc EOF = yield (acc TL.empty) EOF -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.consume| -consume :: Monad m => Iteratee a m [a] -consume = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = continue (loop (acc . (xs ++))) - loop acc EOF = yield (acc []) EOF -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.consume| -consume :: Monad m => Iteratee B.ByteString m BL.ByteString -consume = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = iter where - lazy = BL.fromChunks xs - iter = continue (loop (acc . (BL.append lazy))) - loop acc EOF = yield (acc BL.empty) EOF -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.consume| -consume :: Monad m => Iteratee T.Text m TL.Text -consume = continue (loop id) where - loop acc (Chunks []) = continue (loop acc) - loop acc (Chunks xs) = iter where - lazy = TL.fromChunks xs - iter = continue (loop (acc . (TL.append lazy))) - loop acc EOF = yield (acc TL.empty) EOF -: - -\subsection{Unsorted} - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.head| -head :: Monad m => Iteratee a m (Maybe a) -head = continue loop where - loop (Chunks []) = head - loop (Chunks (x:xs)) = yield (Just x) (Chunks xs) - loop EOF = yield Nothing EOF -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.head| -head :: Monad m => Iteratee B.ByteString m (Maybe Word8) -head = continue loop where - loop (Chunks xs) = case BL.uncons (BL.fromChunks xs) of - Just (char, extra) -> yield (Just char) (toChunks extra) - Nothing -> head - loop EOF = yield Nothing EOF -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.head| -head :: Monad m => Iteratee T.Text m (Maybe Char) -head = continue loop where - loop (Chunks xs) = case TL.uncons (TL.fromChunks xs) of - Just (char, extra) -> yield (Just char) (toChunks extra) - Nothing -> head - loop EOF = yield Nothing EOF -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.drop| -drop :: Monad m => Integer -> Iteratee a m () -drop n | n <= 0 = return () -drop n = continue (loop n) where - loop n' (Chunks xs) = iter where - len = L.genericLength xs - iter = if len < n' - then drop (n' - len) - else yield () (Chunks (L.genericDrop n' xs)) - loop _ EOF = yield () EOF -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.drop| -drop :: Monad m => Integer -> Iteratee B.ByteString m () -drop n | n <= 0 = return () -drop n = continue (loop n) where - loop n' (Chunks xs) = iter where - lazy = BL.fromChunks xs - len = toInteger (BL.length lazy) - iter = if len < n' - then drop (n' - len) - else yield () (toChunks (BL.drop (fromInteger n') lazy)) - loop _ EOF = yield () EOF -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.drop| -drop :: Monad m => Integer -> Iteratee T.Text m () -drop n | n <= 0 = return () -drop n = continue (loop n) where - loop n' (Chunks xs) = iter where - lazy = TL.fromChunks xs - len = toInteger (TL.length lazy) - iter = if len < n' - then drop (n' - len) - else yield () (toChunks (TL.drop (fromInteger n') lazy)) - loop _ EOF = yield () EOF -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.dropWhile| -dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () -dropWhile p = continue loop where - loop (Chunks xs) = case L.dropWhile p xs of - [] -> continue loop - xs' -> yield () (Chunks xs') - loop EOF = yield () EOF -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.dropWhile| -dropWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m () -dropWhile p = continue loop where - loop (Chunks xs) = iter where - lazy = BL.dropWhile p (BL.fromChunks xs) - iter = if BL.null lazy - then continue loop - else yield () (toChunks lazy) - loop EOF = yield () EOF -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.dropWhile| -dropWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m () -dropWhile p = continue loop where - loop (Chunks xs) = iter where - lazy = TL.dropWhile p (TL.fromChunks xs) - iter = if TL.null lazy - then continue loop - else yield () (toChunks lazy) - loop EOF = yield () EOF -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.require| -require :: Monad m => Integer -> Iteratee a m () -require n | n <= 0 = return () -require n = continue (loop id n) where - len = L.genericLength - loop acc n' (Chunks xs) - | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) - | otherwise = yield () (Chunks (acc xs)) - loop _ _ EOF = throwError (ErrorCall "require: Unexpected EOF") -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.require| -require :: Monad m => Integer -> Iteratee B.ByteString m () -require n | n <= 0 = return () -require n = continue (loop id n) where - loop acc n' (Chunks xs) = iter where - lazy = BL.fromChunks xs - len = toInteger (BL.length lazy) - iter = if len < n' - then continue (loop (acc . (BL.append lazy)) (n' - len)) - else yield () (toChunks (acc lazy)) - loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.require| -require :: Monad m => Integer -> Iteratee T.Text m () -require n | n <= 0 = return () -require n = continue (loop id n) where - loop acc n' (Chunks xs) = iter where - lazy = TL.fromChunks xs - len = toInteger (TL.length lazy) - iter = if len < n' - then continue (loop (acc . (TL.append lazy)) (n' - len)) - else yield () (toChunks (acc lazy)) - loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") -: - -Note: {\tt isolate} has some odd behavior regarding extra input in the -inner iteratee. Depending on how large the chunks are, extra input might -be returned in the {\tt Step}, or dropped. - -This doesn't matter if {\tt joinI} is used, but might if a user is poking -around inside the {\tt Step}. Eventually, enumeratees will be modified to -avoid exposing its internal iteratee state. - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.isolate| -isolate :: Monad m => Integer -> Enumeratee a a m b -isolate n step | n <= 0 = return step -isolate n (Continue k) = continue loop where - len = L.genericLength - - loop (Chunks []) = continue loop - loop (Chunks xs) - | len xs <= n = k (Chunks xs) >>== isolate (n - len xs) - | otherwise = let - (s1, s2) = L.genericSplitAt n xs - in k (Chunks s1) >>== (\step -> yield step (Chunks s2)) - loop EOF = k EOF >>== (\step -> yield step EOF) -isolate n step = drop n >> return step -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.isolate| -isolate :: Monad m => Integer -> Enumeratee B.ByteString B.ByteString m b -isolate n step | n <= 0 = return step -isolate n (Continue k) = continue loop where - loop (Chunks []) = continue loop - loop (Chunks xs) = iter where - lazy = BL.fromChunks xs - len = toInteger (BL.length lazy) - - iter = if len <= n - then k (Chunks xs) >>== isolate (n - len) - else let - (s1, s2) = BL.splitAt (fromInteger n) lazy - in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) - loop EOF = k EOF >>== (\step -> yield step EOF) -isolate n step = drop n >> return step -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.isolate| -isolate :: Monad m => Integer -> Enumeratee T.Text T.Text m b -isolate n step | n <= 0 = return step -isolate n (Continue k) = continue loop where - loop (Chunks []) = continue loop - loop (Chunks xs) = iter where - lazy = TL.fromChunks xs - len = toInteger (TL.length lazy) - - iter = if len <= n - then k (Chunks xs) >>== isolate (n - len) - else let - (s1, s2) = TL.splitAt (fromInteger n) lazy - in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) - loop EOF = k EOF >>== (\step -> yield step EOF) -isolate n step = drop n >> return step -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.splitWhen| -splitWhen :: Monad m => (a -> Bool) -> Enumeratee a [a] m b -splitWhen p = sequence $ do - as <- takeWhile (not . p) - drop 1 - return as -: - -:d byte-oriented list analogues -|apidoc Data.Enumerator.Binary.splitWhen| -splitWhen :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b -splitWhen p = loop where - loop = checkDone step - step k = isEOF >>= \eof -> if eof - then yield (Continue k) EOF - else do - lazy <- takeWhile (not . p) - let bytes = B.concat (BL.toChunks lazy) - eof <- isEOF - drop 1 - if BL.null lazy && eof - then yield (Continue k) EOF - else k (Chunks [bytes]) >>== loop -: - -:d text-oriented list analogues -|apidoc Data.Enumerator.Text.splitWhen| -splitWhen :: Monad m => (Char -> Bool) -> Enumeratee T.Text T.Text m b -splitWhen p = loop where - loop = checkDone step - step k = isEOF >>= \eof -> if eof - then yield (Continue k) EOF - else do - lazy <- takeWhile (not . p) - let text = textToStrict lazy - eof <- isEOF - drop 1 - if TL.null lazy && eof - then yield (Continue k) EOF - else k (Chunks [text]) >>== loop - -|apidoc Data.Enumerator.Text.lines| -lines :: Monad m => Enumeratee T.Text T.Text m b -lines = splitWhen (== '\n') -: - -:d element-oriented list analogues -|apidoc Data.Enumerator.List.unique| -unique :: (Ord a, Monad m) => Enumeratee a a m b -unique = concatMapAccum step Data.Set.empty where - step s x = if Data.Set.member x s - then (s, []) - else (Data.Set.insert x s, [x]) -: diff --git a/src/primitives.anansi b/src/primitives.anansi deleted file mode 100644 --- a/src/primitives.anansi +++ /dev/null @@ -1,138 +0,0 @@ -\section{Primitives} - -\subsection{Operators} - -Because {\tt Iteratee a m b} is semantically equivalent to -{\tt m (Step a m b)}, several of the monadic combinators ({\tt (>>=)}, -{\tt (>=>)}, etc) are useful to save typing when constructing enumerators -and enumeratees. {\tt (>>==)} corresponds to {\tt (>>=)}, {\tt (>==>)} to -{\tt (>=>)}, and so on. - -:d iteratee operators -infixl 1 >>== -infixr 1 ==<< -infixr 0 $$ -infixr 1 >==> -infixr 1 <==< - -|apidoc Data.Enumerator.(>>==)| -(>>==) :: 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) - -|apidoc Data.Enumerator.(==<<)| -(==<<) :: Monad m - => (Step a m b -> Iteratee a' m b') - -> Iteratee a m b - -> Iteratee a' m b' -(==<<) = flip (>>==) - -|apidoc Data.Enumerator.($$)| -($$) :: Monad m - => (Step a m b -> Iteratee a' m b') - -> Iteratee a m b - -> Iteratee a' m b' -($$) = (==<<) - -|apidoc Data.Enumerator.(>==>)| -(>==>) :: 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 - -|apidoc Data.Enumerator.(<==<)| -(<==<) :: Monad m - => (Step a m b -> Iteratee a' m b') - -> Enumerator a m b - -> Step a m b - -> Iteratee a' m b' -(<==<) = flip (>==>) -: - -\subsection{Running iteratees} - -To simplify running iteratees, {\tt run} sends {\tt EOF} and then examines -the result. It is not possible for the result to be {\tt Continue}, because -{\tt enumEOF} calls {\tt error} for divergent iteratees. - -:d primitives -|apidoc Data.Enumerator.run| -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" -: - -{\tt run\_} is even more simplified; it's used in simple scripts, where the -user doesn't care about error handling. - -:d primitives -|apidoc Data.Enumerator.run_| -run_ :: Monad m => Iteratee a m b -> m b -run_ i = run i >>= either Exc.throw return -: - -\subsection{Error handling} - -Most real-world applications have to deal with error conditions; however, -libraries have various ways of reporting errors. Some throw exceptions, -others use callbacks, and many just use {\tt Either}. Heterogeneous error -handling makes composing code very difficult; therefore, all -enumerator-based code simply uses the standard {\tt Control.Exception} -module and its types. - -Instances for the {\tt MonadError} class are provided in auxiliary -libraries, to avoid extraneous dependencies. - -:d primitives -|apidoc Data.Enumerator.throwError| -throwError :: (Monad m, Exc.Exception e) => e -> Iteratee a m b -throwError exc = returnI (Error (Exc.toException exc)) -: - -Handling errors has a caveat: any input consumed before the error was -thrown can't be recovered. If an iteratee needs to continue parsing after an -error, either buffer the input stream or use a separate framing mechanism. - -This limitation means that {\tt catchError} is mostly only useful for -transforming or logging errors, not ignoring them. - -:d primitives -|apidoc Data.Enumerator.catchError| -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')) -: diff --git a/src/public-interface.anansi b/src/public-interface.anansi deleted file mode 100644 --- a/src/public-interface.anansi +++ /dev/null @@ -1,388 +0,0 @@ -\section{Public interface} - -:f Data/Enumerator.hs -|Data.Enumerator module header| -module Data.Enumerator ( - |Data.Enumerator exports| - ) where -|Data.Enumerator imports| - -|types and instances| -|supplemental instances| -|primitives| -|iteratee operators| -|utilities for testing and debugging| -|unsorted utilities| -|compatibility: obsolete| -|compatibility: aliases| -: - -:f Data/Enumerator/Binary.hs -|Data.Enumerator.Binary module header| -module Data.Enumerator.Binary ( - |Data.Enumerator.Binary exports| - ) where -|Data.Enumerator.Binary imports| -|byte-oriented list analogues| -|binary IO| - -toChunks :: BL.ByteString -> Stream B.ByteString -toChunks = Chunks . BL.toChunks -: - -:f Data/Enumerator/List.hs -|Data.Enumerator.List module header| -module Data.Enumerator.List ( - |Data.Enumerator.List exports| - ) where -|Data.Enumerator.List imports| -|element-oriented list analogues| -: - -:f Data/Enumerator/Text.hs -|Data.Enumerator.Text module header| -module Data.Enumerator.Text ( - |Data.Enumerator.Text exports| - ) where -|Data.Enumerator.Text imports| -|text-oriented list analogues| -|text IO| -|text codecs| - -toChunks :: TL.Text -> Stream T.Text -toChunks = Chunks . TL.toChunks -: - -:d Data.Enumerator imports -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) -: - -:d Data.Enumerator.Binary imports -import Prelude hiding (head, drop, takeWhile, mapM_) -import Data.Enumerator hiding ( head, drop, iterateM, repeatM, replicateM - , generateM, filterM, consume, foldM - , concatMapM) -import Control.Monad.IO.Class (MonadIO) -import qualified Data.ByteString as B -import qualified System.IO as IO -import qualified Control.Exception as Exc -import System.IO.Error (isEOFError) -import Data.Word (Word8) -import qualified Data.Enumerator.List as EL -import qualified Control.Monad as CM -import qualified Data.ByteString.Lazy as BL -import Control.Monad.Trans.Class (lift) -import Control.Monad (liftM) -: - -:d Data.Enumerator.List imports -import Prelude hiding (head, drop, sequence, takeWhile) -import Data.Enumerator hiding ( concatMapM, iterateM, replicateM, head, drop - , foldM, repeatM, generateM, filterM, consume) -import Control.Monad.Trans.Class (lift) -import qualified Control.Monad as CM -import qualified Data.List as L -import Control.Exception (ErrorCall(..)) -import qualified Data.Set -: - -:d Data.Enumerator.Text imports -import Prelude hiding (head, drop, takeWhile, lines) -import qualified Prelude -import Data.Enumerator hiding ( head, drop, generateM, filterM, consume - , concatMapM, iterateM, repeatM, replicateM - , foldM) -import Data.Enumerator.Util (tSpanBy, tlSpanBy, reprWord, reprChar, textToStrict) -import Control.Monad.IO.Class (MonadIO) -import qualified Control.Exception as Exc -import Control.Arrow (first) -import Data.Maybe (catMaybes) -import qualified Data.Text as T -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.Text.Encoding as TE -import Data.Word (Word8, Word16) -import Data.Bits ((.&.), (.|.), shiftL) -import qualified System.IO as IO -import System.IO.Error (isEOFError) -import qualified Data.Text.IO as TIO -import Data.Char (ord) -import System.IO.Unsafe (unsafePerformIO) -import qualified Data.Text.Lazy as TL -import qualified Data.Enumerator.List as EL -import qualified Control.Monad as CM -import Control.Monad.Trans.Class (lift) -import Control.Monad (liftM) -: - -:d Data.Enumerator exports --- * 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 -: - -:d Data.Enumerator.Binary exports --- * IO - enumHandle -, enumHandleRange -, enumFile -, enumFileRange -, iterHandle - --- * List analogues - --- ** Folds -, fold -, foldM - --- ** Maps -, Data.Enumerator.Binary.map -, Data.Enumerator.Binary.mapM -, Data.Enumerator.Binary.mapM_ -, Data.Enumerator.Binary.concatMap -, concatMapM - --- ** Accumulating maps -, mapAccum -, mapAccumM -, concatMapAccum -, concatMapAccumM - --- ** Infinite streams -, Data.Enumerator.Binary.iterate -, iterateM -, Data.Enumerator.Binary.repeat -, repeatM - --- ** Bounded streams -, Data.Enumerator.Binary.replicate -, replicateM -, generateM -, unfold -, unfoldM - --- ** Filters -, Data.Enumerator.Binary.filter -, filterM - --- ** Consumers -, Data.Enumerator.Binary.take -, takeWhile -, consume - --- ** Unsorted -, Data.Enumerator.Binary.head -, Data.Enumerator.Binary.drop -, Data.Enumerator.Binary.dropWhile -, require -, isolate -, splitWhen - -: - -:d Data.Enumerator.List exports --- * List analogues - --- ** Folds - fold -, foldM - --- ** Maps -, Data.Enumerator.List.map -, Data.Enumerator.List.mapM -, Data.Enumerator.List.mapM_ -, Data.Enumerator.List.concatMap -, concatMapM - --- ** Accumulating maps -, mapAccum -, mapAccumM -, concatMapAccum -, concatMapAccumM - --- ** Infinite streams -, Data.Enumerator.List.iterate -, iterateM -, Data.Enumerator.List.repeat -, repeatM - --- ** Bounded streams -, Data.Enumerator.List.replicate -, replicateM -, generateM -, unfold -, unfoldM - --- ** Filters -, Data.Enumerator.List.filter -, filterM - --- ** Consumers -, Data.Enumerator.List.take -, takeWhile -, consume - --- ** Unsorted -, head -, drop -, Data.Enumerator.List.dropWhile -, require -, isolate -, splitWhen -, unique -: - -:d Data.Enumerator.Text exports --- * IO - enumHandle -, enumFile -, iterHandle - --- * List analogues - --- ** Folds -, fold -, foldM - --- ** Maps -, Data.Enumerator.Text.map -, Data.Enumerator.Text.mapM -, Data.Enumerator.Text.mapM_ -, Data.Enumerator.Text.concatMap -, concatMapM - --- ** Accumulating maps -, mapAccum -, mapAccumM -, concatMapAccum -, concatMapAccumM - --- ** Infinite streams -, Data.Enumerator.Text.iterate -, iterateM -, Data.Enumerator.Text.repeat -, repeatM - --- ** Bounded streams -, Data.Enumerator.Text.replicate -, replicateM -, generateM -, unfold -, unfoldM - --- ** Filters -, Data.Enumerator.Text.filter -, filterM - --- ** Consumers -, Data.Enumerator.Text.take -, takeWhile -, consume - --- ** Unsorted -, Data.Enumerator.Text.head -, Data.Enumerator.Text.drop -, Data.Enumerator.Text.dropWhile -, require -, isolate -, splitWhen -, lines - --- * Text codecs -, Codec -, encode -, decode -, utf8 -, utf16_le -, utf16_be -, utf32_le -, utf32_be -, ascii -, iso8859_1 -: diff --git a/src/summary.anansi b/src/summary.anansi deleted file mode 100644 --- a/src/summary.anansi +++ /dev/null @@ -1,41 +0,0 @@ -\section*{Summary} - -Typical buffer-based incremental \io{} is based around a single loop, which -reads data from some source (such as a socket or file), transforms it, and -generates one or more outputs (such as a line count, {\sc http} responses, -or modified file). Although efficient and safe, these loops are all -single-purpose; it is difficult or impossible to compose buffer-based -processing loops. - -Haskell's concept of ``lazy \io{}'' allows pure code to operate on data from -an external source. However, lazy \io{} has several shortcomings. Most notably, -resources such as memory and file handles can be retained for arbitrarily -long periods of time, causing unpredictable performance and error conditions. - -Enumerators are an efficient, predictable, and safe alternative to lazy \io{}. -Discovered by Oleg \mbox{Kiselyov}, they allow large datasets to be processed -in near-constant space by pure code. Although somewhat more complex to write, -using enumerators instead of lazy \io{} produces more correct programs. - -This library contains an enumerator implementation for Haskell, designed to -be both simple and efficient. Three core types are defined, along with -numerous helper functions: - -\begin{itemize} - -\item {\it Iteratee\/}: Data sinks, analogous to left folds. Iteratees consume -a sequence of \emph{input} values, and generate a single \emph{output} value. -Many iteratees are designed to perform side effects (such as printing to -{\tt stdout}), so they can also be used as monad transformers. - -\item {\it Enumerator\/}: Data sources, which generate input sequences. Typical -enumerators read from a file handle, socket, random number generator, or -other external stream. To operate, enumerators are passed an iteratee, and -provide that iteratee with input until either the iteratee has completed its -computation, or {\sc eof}. - -\item {\it Enumeratee\/}: Data transformers, which operate as both enumerators and -iteratees. Enumeratees read from an \emph{outer} enumerator, and provide the -transformed data to an \emph{inner} iteratee. - -\end{itemize} diff --git a/src/text-codecs.anansi b/src/text-codecs.anansi deleted file mode 100644 --- a/src/text-codecs.anansi +++ /dev/null @@ -1,339 +0,0 @@ -\section{Text Codecs} - -Many protocols need the non-blocking input behavior of binary \io{}, but -are defined in terms of unicode characters. The {\tt encode} and -{\tt decode} enumeratees allow text-based protocols to be easily parsed -from a binary input source. - -Most common codecs ({\sc utf-8}, {\sc iso-8859-1}, {\sc ascii}) are -supported; more complex codecs can be implemented by bindings to libraries -such as libicu. - -All of the codecs here are incremental; that is, they try to read as much -data as possible, but no more. This allows iteratees to read partial data -if the input stream contains invalid data. - -:d text codecs -data Codec = Codec - { codecName :: T.Text - , codecEncode - :: T.Text - -> (B.ByteString, Maybe (Exc.SomeException, T.Text)) - , codecDecode - :: B.ByteString - -> (T.Text, Either - (Exc.SomeException, B.ByteString) - B.ByteString) - } - -instance Show Codec where - showsPrec d c = showParen (d > 10) $ - showString "Codec " . shows (codecName c) -: - -:d text codecs -|apidoc Data.Enumerator.Text.encode| -encode :: Monad m => Codec - -> Enumeratee T.Text B.ByteString m b -encode codec = 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) = let - (bytes, extra) = codecEncode codec x - extraChunks = Chunks $ case extra of - Nothing -> xs - Just (_, text) -> text:xs - - checkError k' = case extra of - Nothing -> loop k' xs - Just (exc, _) -> throwError exc - - in if B.null bytes - then checkError k - else k (Chunks [bytes]) >>== - checkDoneEx extraChunks checkError -: - -:d text codecs -|apidoc Data.Enumerator.Text.decode| -decode :: Monad m => Codec - -> Enumeratee B.ByteString T.Text m b -decode codec = checkDone (continue . step B.empty) where - step _ k EOF = yield (Continue k) EOF - step acc k (Chunks xs) = loop acc k xs - - loop acc k [] = continue (step acc k) - loop acc k (x:xs) = let - (text, extra) = codecDecode codec (B.append acc x) - extraChunks = Chunks (either snd id extra : xs) - - checkError k' = case extra of - Left (exc, _) -> throwError exc - Right bytes -> loop bytes k' xs - - in if T.null text - then checkError k - else k (Chunks [text]) >>== - checkDoneEx extraChunks checkError -: - -The variable-width decoders all follow the same basic pattern. First, -they examine their input to calculate how many bytes the decoder -function should accept. Next they try to decode it -- if the input -is valid, decoding is finished. - -If the input is invalid, trying to decode the full input will throw -an exception. When an exception is caught, decoding is passed off to -{\tt splitSlowly} for a more careful parse. The input is reduced until -the decoder can parse something, and the rest of the bytes are stored -for later. An error will only be thrown if the iteratee requires input, -but there are no valid bytes remaining. - -:d text codecs -byteSplits :: B.ByteString - -> [(B.ByteString, B.ByteString)] -byteSplits bytes = loop (B.length bytes) where - loop 0 = [(B.empty, bytes)] - loop n = B.splitAt n bytes : loop (n - 1) -: - -:d text codecs -splitSlowly :: (B.ByteString -> T.Text) - -> B.ByteString - -> (T.Text, Either - (Exc.SomeException, B.ByteString) - B.ByteString) -splitSlowly dec bytes = valid where - valid = firstValid (Prelude.map decFirst splits) - splits = byteSplits bytes - firstValid = Prelude.head . catMaybes - tryDec = tryEvaluate . dec - - decFirst (a, b) = case tryDec a of - Left _ -> Nothing - Right text -> Just (text, case tryDec b of - Left exc -> Left (exc, b) - - -- this case shouldn't occur, since splitSlowly - -- is only called when parsing failed somewhere - Right _ -> Right B.empty) -: - -\subsection{UTF-8} - -:d text codecs -utf8 :: Codec -utf8 = Codec name enc dec where - name = T.pack "UTF-8" - enc text = (TE.encodeUtf8 text, Nothing) - dec bytes = case splitQuickly bytes of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf8 bytes - |utf8 split bytes| -: - -:d utf8 split bytes -splitQuickly bytes = loop 0 >>= maybeDecode where - |utf8 required bytes count| - maxN = B.length bytes - - loop n | n == maxN = Just (TE.decodeUtf8 bytes, B.empty) - loop n = let - req = required (B.index bytes n) - tooLong = first TE.decodeUtf8 (B.splitAt n bytes) - decodeMore = loop $! n + req - in if req == 0 - then Nothing - else if n + req > maxN - then Just tooLong - else decodeMore -: - -:d utf8 required bytes count -required x0 - | x0 .&. 0x80 == 0x00 = 1 - | x0 .&. 0xE0 == 0xC0 = 2 - | x0 .&. 0xF0 == 0xE0 = 3 - | x0 .&. 0xF8 == 0xF0 = 4 - - -- Invalid input; let Text figure it out - | otherwise = 0 -: - -\subsection{UTF-16} - -:d text codecs -utf16_le :: Codec -utf16_le = Codec name enc dec where - name = T.pack "UTF-16-LE" - enc text = (TE.encodeUtf16LE text, Nothing) - dec bytes = case splitQuickly bytes of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf16LE bytes - |utf16-le split bytes| -: - -:d text codecs -utf16_be :: Codec -utf16_be = Codec name enc dec where - name = T.pack "UTF-16-BE" - enc text = (TE.encodeUtf16BE text, Nothing) - dec bytes = case splitQuickly bytes of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf16BE bytes - |utf16-be split bytes| -: - -:d utf16-le split bytes -splitQuickly bytes = maybeDecode (loop 0) where - maxN = B.length bytes - - loop n | n == maxN = decodeAll - | (n + 1) == maxN = decodeTo n - loop n = let - req = utf16Required - (B.index bytes 0) - (B.index bytes 1) - decodeMore = loop $! n + req - in if n + req > maxN - then decodeTo n - else decodeMore - - decodeTo n = first TE.decodeUtf16LE (B.splitAt n bytes) - decodeAll = (TE.decodeUtf16LE bytes, B.empty) -: - -:d utf16-be split bytes -splitQuickly bytes = maybeDecode (loop 0) where - maxN = B.length bytes - - loop n | n == maxN = decodeAll - | (n + 1) == maxN = decodeTo n - loop n = let - req = utf16Required - (B.index bytes 1) - (B.index bytes 0) - decodeMore = loop $! n + req - in if n + req > maxN - then decodeTo n - else decodeMore - - decodeTo n = first TE.decodeUtf16BE (B.splitAt n bytes) - decodeAll = (TE.decodeUtf16BE bytes, B.empty) -: - -:d text codecs -utf16Required :: Word8 -> Word8 -> Int -utf16Required x0 x1 = required where - required = if x >= 0xD800 && x <= 0xDBFF - then 4 - else 2 - x :: Word16 - x = (fromIntegral x1 `shiftL` 8) .|. fromIntegral x0 -: - -\subsection{UTF-32} - -:d text codecs -utf32_le :: Codec -utf32_le = Codec name enc dec where - name = T.pack "UTF-32-LE" - enc text = (TE.encodeUtf32LE text, Nothing) - dec bs = case utf32SplitBytes TE.decodeUtf32LE bs of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf32LE bs - -utf32_be :: Codec -utf32_be = Codec name enc dec where - name = T.pack "UTF-32-BE" - enc text = (TE.encodeUtf32BE text, Nothing) - dec bs = case utf32SplitBytes TE.decodeUtf32BE bs of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf32BE bs -: - -:d text codecs -utf32SplitBytes :: (B.ByteString -> T.Text) - -> B.ByteString - -> Maybe (T.Text, B.ByteString) -utf32SplitBytes dec bytes = split where - split = maybeDecode (dec toDecode, extra) - len = B.length bytes - lenExtra = mod len 4 - - lenToDecode = len - lenExtra - (toDecode, extra) = if lenExtra == 0 - then (bytes, B.empty) - else B.splitAt lenToDecode bytes -: - -\subsection{ASCII} - -:d text codecs -ascii :: Codec -ascii = Codec name enc dec where - name = T.pack "ASCII" - enc text = (bytes, extra) where - (safe, unsafe) = tSpanBy (\c -> ord c <= 0x7F) text - bytes = B8.pack (T.unpack safe) - extra = if T.null unsafe - then Nothing - else Just (illegalEnc name (T.head unsafe), unsafe) - - dec bytes = (text, extra) where - (safe, unsafe) = B.span (<= 0x7F) bytes - text = T.pack (B8.unpack safe) - extra = if B.null unsafe - then Right B.empty - else Left (illegalDec name (B.head unsafe), unsafe) -: - -\subsection{ISO 8859-1} - -:d text codecs -iso8859_1 :: Codec -iso8859_1 = Codec name enc dec where - name = T.pack "ISO-8859-1" - enc text = (bytes, extra) where - (safe, unsafe) = tSpanBy (\c -> ord c <= 0xFF) text - bytes = B8.pack (T.unpack safe) - extra = if T.null unsafe - then Nothing - else Just (illegalEnc name (T.head unsafe), unsafe) - - dec bytes = (T.pack (B8.unpack bytes), Right B.empty) -: - -\subsection*{Encoding Utilities} - -:d text codecs -illegalEnc :: T.Text -> Char -> Exc.SomeException -illegalEnc name c = Exc.toException . Exc.ErrorCall $ - concat [ "Codec " - , show name - , " can't encode character " - , reprChar c - ] -: - -:d text codecs -illegalDec :: T.Text -> Word8 -> Exc.SomeException -illegalDec name w = Exc.toException . Exc.ErrorCall $ - concat [ "Codec " - , show name - , " can't decode byte " - , reprWord w - ] -: - -:d text codecs -tryEvaluate :: a -> Either Exc.SomeException a -tryEvaluate = unsafePerformIO . Exc.try . Exc.evaluate - -maybeDecode:: (a, b) -> Maybe (a, b) -maybeDecode (a, b) = case tryEvaluate a of - Left _ -> Nothing - Right _ -> Just (a, b) -: diff --git a/src/types.anansi b/src/types.anansi deleted file mode 100644 --- a/src/types.anansi +++ /dev/null @@ -1,202 +0,0 @@ -\section{Types and instances} - -\subsection{Input streams} - -A {\tt Stream} is a sequence of chunks generated by an enumerator or -enumeratee. Chunks might be composite values, such as a string, or atomic, -such as a parser event. Allowing a stream to support multiple chunks -slightly complicates iteratee and enumeratee implementation, but greatly -simplifies handling of leftover inputs. - -{\tt (Chunks [])} is a legal value, used when a stream is still active but -no data is currently available. Iteratees and enumeratees often special-case -empty chunks for performance reasons, though they're not required to. - -:d types and instances -|apidoc Data.Enumerator.Stream| -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 -: - -The {\tt Monoid} instance deserves some special attention, because it has -the unexpected behavior that {\tt mappend EOF (Chunks []) == EOF}. Although -it's reasonable that appending chunks to an {\sc eof} stream should provide -a valid stream, such behavior would violate the monoid laws. - -:d types and instances -instance Monoid (Stream a) where - mempty = Chunks mempty - mappend (Chunks xs) (Chunks ys) = Chunks (xs ++ ys) - mappend _ _ = EOF -: - -\subsection{Iteratees} - -The primary data type for this library is {\tt Iteratee}, which consumes -input until it either generates a value or encounters an error. Rather -than requiring all input at once, an iteratee will return {\tt Continue} -when it is capable of processing more data. - -In general, iteratees begin in the {\tt Continue} state. As each chunk is -passed to the continuation, the iteratee may return the next step, which is -one of: - -\begin{itemize} -\item {\tt Continue}: The iteratee is capable of accepting more input. Note -that more input is not required; the iteratee might be able to generate a -value immediately if the stream ends. - -\item {\tt Yield}: The iteratee has received enough input to generate a -result. Included in this value is left-over input, which can be passed to -the next iteratee. - -\item {\tt Error}: The iteratee encountered an error which prevents it from -proceeding further. -\end{itemize} - -:d types and instances -data Step a m b - |apidoc Data.Enumerator.Continue| - = Continue (Stream a -> Iteratee a m b) - - |apidoc Data.Enumerator.Yield| - | Yield b (Stream a) - - |apidoc Data.Enumerator.Error| - | Error Exc.SomeException - -|apidoc Data.Enumerator.Iteratee| -newtype Iteratee a m b = Iteratee - { runIteratee :: m (Step a m b) - } -: - -The pattern {\tt Iteratee (return (} \ldots{\tt ))} shows up a lot, so I define a -couple simple wrappers to save typing: - -:d primitives -|apidoc Data.Enumerator.returnI| -returnI :: Monad m => Step a m b -> Iteratee a m b -returnI step = Iteratee (return step) - -|apidoc Data.Enumerator.yield| -yield :: Monad m => b -> Stream a -> Iteratee a m b -yield x extra = returnI (Yield x extra) - -|apidoc Data.Enumerator.continue| -continue :: Monad m => (Stream a -> Iteratee a m b) -> Iteratee a m b -continue k = returnI (Continue k) -: - -\subsection*{Monad instances} - -Iteratees are monads; by sequencing iteratees, very complex processing may -be applied to arbitrary input streams. Iteratees are also applicative -functors and monad transformers. - -:d types and instances -instance Monad m => Monad (Iteratee a m) where - return x = yield x (Chunks []) - |optimized iteratee bind| -: - -Because iteratees are often used for high-performance software, it is -important that the {\tt (>>=)} method be very efficient. We use a couple -magic-ish features here: - -\begin{itemize} -\item First, the whole {\tt (>>=)} is worker-wrapper transformed so {\tt f} -can be cached when working with {\tt Continue}. This prevents a potential -space leak when working with infinite streams. - -\item Second, the worker is rendered anonymous with {\tt fix}, so it doesn't -incur any additional time overhead. -\end{itemize} - -The end result is a bind implementation with time performance equivalent to -the standard definition, but with significantly reduced memory allocation -rates. - -:d optimized iteratee bind -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) -: - -Most iteratees are used to wrap \io{} operations, so it's sensible to define -instances for typeclasses from {\tt transformers}. - -:d types and instances -instance MonadTrans (Iteratee a) where - lift m = Iteratee (m >>= runIteratee . return) - -instance MonadIO m => MonadIO (Iteratee a m) where - liftIO = lift . liftIO -: - -\subsection{Enumerators} - -Enumerators typically read from an external source (parser, handle, random -number generator, etc). They feed chunks into an iteratee until the source -runs out of data (triggering {\tt EOF}) or the iteratee finishes processing -(yields a value). - -Since {\tt Iteratee} is an alias for {\tt m (Step a m b)}, enumerators can -also be considered step transformers of type -{\tt Step a m b -> m (Step a m b)}. - -:d types and instances -|apidoc Data.Enumerator.Enumerator| -type Enumerator a m b = Step a m b -> Iteratee a m b -: - -Although enumerators can be encoded as a simple step transformer with the -type {\tt Step a m b -> Step a m b}, encoding as a computation allows easier -reasoning about the order of side effects. Consider the case of enumerating -two files: - -:d enumerator example -let iterFoo = enumFile "foo.txt" iterWhatever -let iterBar = enumFile "bar.txt" iterFoo -: - -It's impossible to determine, merely by looking at these lines, which file -will be opened first. In fact, depending on the implementation of -{\tt enumFile}, both files might be open at the same time. If enumerators -return monadic values, the order of events is more clear: - -:d enumerator example -iterFoo <- enumFile "foo.txt" iterWhatever -iterBar <- enumFile "bar.txt" iterFoo -: - -\subsection{Enumeratees} - -In cases where an enumerator acts as both a source and sink, the resulting -type is named an {\tt Enumeratee}. Enumeratees have two input types, -``outer a'' ({\tt ao}) and ``inner a'' ({\tt ai}). - -Enumeratees are encoded as an iteratee stack. The outer iteratee reads from -a stream of \emph{ao} values, transforms them into \emph{ai}, and passes them -to an inner iteratee. This model allows a single outer input to generate many -inner inputs, and vice-versa. - -:d types and instances -|apidoc Data.Enumerator.Enumeratee| -type Enumeratee ao ai m b = Step ai m b -> Iteratee ao m (Step ai m b) -: diff --git a/src/utilities.anansi b/src/utilities.anansi deleted file mode 100644 --- a/src/utilities.anansi +++ /dev/null @@ -1,354 +0,0 @@ -\section{Miscellaneous} - -A few special-case utilities that are used by similar libraries, or were -present in previous versions of {\tt enumerator}, or otherwise don't have a -good place to go. - -Sequencing a fixed set of enumerators is easy, but for more complex -cases, it's useful to have a small utility wrapper. - -:d unsorted utilities -|apidoc Data.Enumerator.concatEnums| -concatEnums :: Monad m => [Enumerator a m b] - -> Enumerator a m b -concatEnums = Prelude.foldl (>==>) returnI -: - -{\tt joinI} is used to ``flatten'' enumeratees, to transform them into an -{\tt Iteratee}. - -:d unsorted utilities -|apidoc Data.Enumerator.joinI| -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 -: - -:d unsorted utilities -infixr 0 =$ - -|apidoc Data.Enumerator.(=$)| -(=$) :: Monad m => Enumeratee ao ai m b -> Iteratee ai m b -> Iteratee ao m b -enum =$ iter = joinI (enum $$ iter) -: - -{\tt joinE} is similar, except it flattens an enumerator/enumeratee pair -into a single enumerator. - -:d unsorted utilities -|apidoc Data.Enumerator.joinE| -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" -: - -:d unsorted utilities -infixr 0 $= - -|apidoc Data.Enumerator.($=)| -($=) :: Monad m - => Enumerator ao m (Step ai m b) - -> Enumeratee ao ai m b - -> Enumerator ai m b -($=) = joinE -: - -{\tt sequence} repeatedly runs its parameter to transform the stream. - -:d unsorted utilities -|apidoc Data.Enumerator.sequence| -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 -: - -:d unsorted utilities -|apidoc Data.Enumerator.enumEOF| -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 {\tt Enumeratee} implementations is to check whether -the inner {\tt Iteratee} has finished, and if so, to return its output. -{\tt checkDone} passes its parameter a continuation if the {\tt Iteratee} -can still consume input, or yields otherwise. - -Oleg's version of {\tt checkDone} has a problem---when the enumeratee has -some sort of input buffer, but the underlying iteratee enters {\tt Yield}, -it will discard the output buffer. {\tt checkDoneEx} corrects this; for -backwards compatibility, {\tt checkDone} remains. - -:d unsorted utilities -|apidoc Data.Enumerator.checkDoneEx| -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 - -|apidoc Data.Enumerator.checkDone| -checkDone :: Monad m => - ((Stream a -> Iteratee a m b) -> Iteratee a' m (Step a m b)) -> - Enumeratee a' a m b -checkDone = checkDoneEx (Chunks []) -: - -:d unsorted utilities -|apidoc Data.Enumerator.isEOF| -isEOF :: Monad m => Iteratee a m Bool -isEOF = continue $ \s -> case s of - EOF -> yield True s - _ -> yield False s -: - -When an enumerator has to interact with the outside world, it usually -catches any exceptions that arise, and propagate them as {\tt Error} steps -instead. {\tt tryIO} encapsulates that pattern. - -:d unsorted utilities -|apidoc Data.Enumerator.tryIO| -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 -: - -Another enumerator pattern that pops up often is a loop that ignores any -non-{\tt Continue} steps. This is especially useful when implementing -most enumerators. It's sort of an analogue to {\tt checkDone}, so I -called it {\tt checkContinue}. It's actually implemented by various -functions ({\tt checkContinue0}, {\tt checkContinue1}, etc), as most -enumerators have some sort of state to pass around. - -:d unsorted utilities -|apidoc Data.Enumerator.checkContinue0| -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 -: - -:d unsorted utilities -|apidoc Data.Enumerator.checkContinue1| -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 -: - -{\tt Data.Enumerator.Util} is a hidden module for functions used by several -public modules, but not logically part of the {\tt enumerator} API. - -:f Data/Enumerator/Util.hs -{-# LANGUAGE CPP #-} -module Data.Enumerator.Util where - -import Data.Char (toUpper, intToDigit, ord) -import Data.Word (Word8) -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import Numeric (showIntAtBase) -: - -:f Data/Enumerator/Util.hs -pad0 :: Int -> String -> String -pad0 size str = padded where - len = Prelude.length str - padded = if len >= size - then str - else Prelude.replicate (size - len) '0' ++ str -: - -:f Data/Enumerator/Util.hs -reprChar :: Char -> String -reprChar c = "U+" ++ (pad0 4 (showIntAtBase 16 (toUpper . intToDigit) (ord c) "")) -: - -:f Data/Enumerator/Util.hs -reprWord :: Word8 -> String -reprWord w = "0x" ++ (pad0 2 (showIntAtBase 16 (toUpper . intToDigit) w "")) -: - -{\tt text-0.11} changed some function names to appease a few bikeshedding -idiots in -cafe; to support it, a bit of compatibility code is needed. - -I had a choice between using the preprocessor, or a separate module plus -some Cabal magic. It turns out that {\tt cabal sdist} doesn't properly -handle multiple source directories selected by flags, so the preprocessor -is used for now. - -:f Data/Enumerator/Util.hs -tSpanBy :: (Char -> Bool) -> T.Text -> (T.Text, T.Text) -tlSpanBy :: (Char -> Bool) -> TL.Text -> (TL.Text, TL.Text) -#if MIN_VERSION_text(0,11,0) -tSpanBy = T.span -tlSpanBy = TL.span -#else -tSpanBy = T.spanBy -tlSpanBy = TL.spanBy -#endif -: - -{\tt text-0.8} added the useful {\tt toStrict} function; this wrapper -lets {\tt enumerator} work with {\tt text-0.7}. - -:f Data/Enumerator/Util.hs -textToStrict :: TL.Text -> T.Text -#if MIN_VERSION_text(0,8,0) -textToStrict = TL.toStrict -#else -textToStrict = T.concat . TL.toChunks -#endif -: - -\subsection{Supplemental instances} - -It can be pretty useful to define {\tt Typeable} instances for iteratees -and streams. For example, they allow iteratee-based libraries to be loaded -dynamically as plugins. - -Normally I'd use the {\tt DeriveDataTypeable} language extension, but -many users have said they find {\tt enumerator} useful in large part -because it doesn't rely on extensions. So instead, the instances are -derived manually. - -:d Data.Enumerator imports -import Data.Typeable ( Typeable, typeOf - , Typeable1, typeOf1 - , mkTyConApp, mkTyCon) -: - -:d supplemental instances --- | Since: 0.4.8 -instance Typeable1 Stream where - typeOf1 _ = mkTyConApp tyCon [] where - tyCon = mkTyCon "Data.Enumerator.Stream" -: - -:d supplemental instances --- | 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] -: - -:d supplemental instances --- | 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] -: - -It's probably possible to define {\tt Functor} and {\tt Applicative} -instances for {\tt Iteratee} without a {\tt Monad} constraint, but I haven't -bothered, since every useful operation requires {\tt m} to be a Monad anyway. - -:d supplemental instances -instance Monad m => Functor (Iteratee a m) where - fmap = CM.liftM -: - -:d supplemental instances -instance Monad m => A.Applicative (Iteratee a m) where - pure = return - (<*>) = CM.ap -: - -:d supplemental instances -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 -: - -\subsection{Testing and debugging} - -Debugging enumerator-based code is mostly a question of what inputs are -being passed around. {\tt printChunks} prints out exactly what chunks are -being sent from an enumerator. - -:d utilities for testing and debugging -|apidoc Data.Enumerator.printChunks| -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 -: - -Another small, useful enumerator separates an input list into chunks, and -sends them to the iteratee. This is useful for testing iteratees in pure -code. - -:d Data.Enumerator imports -import Data.List (genericSplitAt) -: - -:d utilities for testing and debugging -|apidoc Data.Enumerator.enumList| -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 -: diff --git a/tests/Benchmarks.hs b/tests/Benchmarks.hs deleted file mode 100644 --- a/tests/Benchmarks.hs +++ /dev/null @@ -1,98 +0,0 @@ --- Copyright (C) 2010-2011 John Millikin --- --- See license.txt for details -module Main where - -import Criterion.Types -import qualified Criterion.Config as C -import qualified Criterion.Main as C -import qualified Progression.Config as P -import qualified Progression.Main as P - -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.ByteString.Lazy as BL - -import qualified Data.Text as T -import qualified Data.Text as TL - -import Data.Enumerator hiding (map, replicate) -import qualified Data.Enumerator as E -import qualified Data.Enumerator.List as EL -import qualified Data.Enumerator.Binary as EB -import qualified Data.Enumerator.Text as ET - -import Control.DeepSeq -import Data.Functor.Identity -import System.Environment -import System.Exit -import System.IO - -instance NFData B.ByteString - -instance NFData BL.ByteString where - rnf a = rnf (BL.toChunks a) - -bytes_100 :: B.ByteString -bytes_100 = B.replicate 100 0x61 - -chars_100 :: T.Text -chars_100 = T.replicate 100 (T.singleton 'a') - -bench_binary :: Iteratee B.ByteString Identity b -> b -bench_binary iter = runIdentity (run_ (enum $$ iter)) where - enum = enumList 2 (replicate 1000 bytes_100) - -bench_text :: Iteratee T.Text Identity b -> b -bench_text iter = runIdentity (run_ (enum $$ iter)) where - enum = enumList 2 (replicate 1000 chars_100) - -bench_bind :: Iteratee Int Identity b -> b -bench_bind iter = runIdentity (run_ (enum 10000 $$ iter)) where - enum 0 step = returnI step - enum n (Continue k) = k (Chunks [n]) >>== enum (n - 1) - enum _ step = returnI step - -bench_enumFile :: Maybe Integer -> Iteratee B.ByteString IO b -> IO b -bench_enumFile limit iter = run_ (EB.enumFileRange "/dev/zero" Nothing limit $$ iter) - -iterUnit :: Monad m => Iteratee a m () -iterUnit = continue loop where - loop EOF = yield () EOF - loop (Chunks _) = continue loop - -iterUnitTo :: Monad m => Int -> Iteratee a m () -iterUnitTo n | n <= 0 = yield () EOF -iterUnitTo n = continue check where - check EOF = yield () EOF - check (Chunks _) = iterUnitTo (n - 1) - -benchmarks :: [Benchmark] -benchmarks = - [ bgroup "general" - [ bench "bind" (nf bench_bind iterUnit) - ] - , bgroup "binary" - [ bench "takeWhile" (nf bench_binary (EB.takeWhile (const True))) - , bench "consume" (nf bench_binary EB.consume) - , bench "enumFile-nolimit" (nfIO (bench_enumFile Nothing (iterUnitTo 10000))) - , bench "enumFile-limit" (nfIO (bench_enumFile (Just 1000000000) (iterUnitTo 10000))) - ] - , bgroup "text" - [ bench "takeWhile" (nf bench_text (ET.takeWhile (const True))) - , bench "consume" (nf bench_text ET.consume) - ] - ] - -main :: IO () -main = do - args <- getArgs - case args of - "progression":extra -> withArgs extra $ P.defaultMain (bgroup "all" benchmarks) - "criterion":extra -> withArgs extra $ let - config = C.defaultConfig { C.cfgPerformGC = C.ljust True } - in C.defaultMainWith config (return ()) benchmarks - _ -> do - name <- getProgName - hPutStrLn stderr $ concat ["Usage: ", name, " "] - exitFailure diff --git a/tests/Properties.hs b/tests/Properties.hs deleted file mode 100644 --- a/tests/Properties.hs +++ /dev/null @@ -1,818 +0,0 @@ --- Copyright (C) 2010 John Millikin --- --- See license.txt for details -module Main (tests, main) where - -import Control.Concurrent -import qualified Control.Exception as Exc -import Control.Monad.IO.Class (liftIO) -import Data.Bits ((.&.)) -import Data.Char (chr) -import qualified Data.List as L -import qualified Data.List.Split as LS -import Data.Monoid (mappend, mempty, mconcat) -import Data.Functor.Identity (Identity, runIdentity) -import Data.String (IsString, fromString) -import Data.Word (Word8) - -import Data.Enumerator (($$), (>>==)) -import qualified Data.Enumerator as E -import qualified Data.Enumerator.Binary as EB -import qualified Data.Enumerator.Text as ET -import qualified Data.Enumerator.List as EL - -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Char8 as B8 -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Encoding as TE - -import Test.QuickCheck hiding ((.&.)) -import Test.QuickCheck.Property (morallyDubiousIOProperty) -import Test.QuickCheck.Poly (A, B, C) -import qualified Test.Framework as F -import Test.Framework.Providers.QuickCheck2 (testProperty) - -tests :: [F.Test] -tests = - [ test_StreamInstances - , test_Text - , test_ListAnalogues - , test_Other - ] - -main :: IO () -main = F.defaultMain tests - --- Stream instances {{{ - -test_StreamInstances :: F.Test -test_StreamInstances = F.testGroup "Stream Instances" - [ test_StreamMonoid - , test_StreamFunctor - , test_StreamMonad - ] - -test_StreamMonoid :: F.Test -test_StreamMonoid = F.testGroup "Monoid Stream" props where - props = [ testProperty "law 1" prop_law1 - , testProperty "law 2" prop_law2 - , testProperty "law 3" prop_law3 - , testProperty "law 4" prop_law4 - ] - - prop_law1 :: E.Stream A -> Bool - prop_law1 x = mappend mempty x == x - - prop_law2 :: E.Stream A -> Bool - prop_law2 x = mappend x mempty == x - - prop_law3 :: E.Stream A -> E.Stream A -> E.Stream A -> Bool - prop_law3 x y z = mappend x (mappend y z) == mappend (mappend x y) z - - prop_law4 :: [E.Stream A] -> Bool - prop_law4 xs = mconcat xs == foldr mappend mempty xs - -test_StreamFunctor :: F.Test -test_StreamFunctor = F.testGroup "Functor Stream" props where - props = [ testProperty "law 1" prop_law1 - , testProperty "law 2" prop_law2 - ] - - prop_law1 :: E.Stream A -> Bool - prop_law1 x = fmap id x == id x - - prop_law2 :: E.Stream A -> Blind (B -> C) -> Blind (A -> B) -> Bool - prop_law2 x (Blind f) (Blind g) = fmap (f . g) x == (fmap f . fmap g) x - -test_StreamMonad :: F.Test -test_StreamMonad = F.testGroup "Monad Stream" props where - props = [ testProperty "law 1" prop_law1 - , testProperty "law 2" prop_law2 - , testProperty "law 3" prop_law3 - ] - - prop_law1 :: A -> Blind (A -> E.Stream B) -> Bool - prop_law1 a (Blind f) = (return a >>= f) == f a - - prop_law2 :: E.Stream A -> Bool - prop_law2 m = (m >>= return) == m - - prop_law3 :: E.Stream A -> Blind (A -> E.Stream B) -> Blind (B -> E.Stream C) -> Bool - prop_law3 m (Blind f) (Blind g) = ((m >>= f) >>= g) == (m >>= (\x -> f x >>= g)) - --- }}} - --- Generic properties {{{ - -test_Enumeratee :: String -> E.Enumeratee A A Identity (Maybe A) -> F.Test -test_Enumeratee name enee = F.testGroup name props where - props = [ testProperty "incremental" prop_incremental - , testProperty "nest errors" prop_nest_errors - ] - - prop_incremental (Positive n) (NonEmpty xs) = let - result = runIdentity (E.run_ iter) - expected = (Just (head xs), tail xs) - - iter = E.enumList n xs $$ do - a <- E.joinI (enee $$ EL.head) - b <- EL.consume - return (a, b) - - in result == expected - - prop_nest_errors (Positive n) (NonEmpty xs) = let - result = runIdentity (E.run_ iter) - - iter = E.enumList n xs $$ do - _ <- enee $$ E.throwError (Exc.ErrorCall "") - EL.consume - - in result == xs - --- }}} - --- Text encoding / decoding {{{ - -test_Text :: F.Test -test_Text = F.testGroup "Text" - [ test_Encoding - , test_Decoding - ] - -test_Encoding :: F.Test -test_Encoding = F.testGroup "Encoding" - [ test_Encode_ASCII - , test_Encode_ISO8859 - ] - -test_Encode_ASCII :: F.Test -test_Encode_ASCII = F.testGroup "ASCII" props where - props = [ testProperty "works" (forAll genASCII prop_works) - , testProperty "error" prop_error - , testProperty "lazy" prop_lazy - ] - - encode iter input = - runIdentity . E.run $ - E.enumList 1 input $$ - E.joinI (ET.encode ET.ascii $$ iter) - - prop_works bytes = result == map B.singleton words where - Right result = encode EL.consume (map T.singleton chars) - - chars = B8.unpack bytes - words = B.unpack bytes - - prop_error = isLeft (encode EL.consume input) where - isLeft = either (const True) (const False) - input = [T.pack "\x61\xFF"] - - prop_lazy = either (const False) (== expected) result where - result = encode EL.head input - input = [T.pack "\x61\xFF"] - expected = Just (B.singleton 0x61) - -test_Encode_ISO8859 :: F.Test -test_Encode_ISO8859 = F.testGroup "ISO-8859-1" props where - props = [ testProperty "works" (forAll genISO8859 prop_works) - , testProperty "error" prop_error - , testProperty "lazy" prop_lazy - ] - - encode iter input = - runIdentity . E.run $ - E.enumList 1 input $$ - E.joinI (ET.encode ET.iso8859_1 $$ iter) - - prop_works bytes = result == map B.singleton words where - Right result = encode EL.consume (map T.singleton chars) - - chars = B8.unpack bytes - words = B.unpack bytes - - prop_error = isLeft (encode EL.consume input) where - isLeft = either (const True) (const False) - input = [T.pack "\x61\xFF5E"] - - prop_lazy = either (const False) (== expected) result where - result = encode EL.head input - input = [T.pack "\x61\xFF5E"] - expected = Just (B.singleton 0x61) - -test_Decoding :: F.Test -test_Decoding = F.testGroup "Decoding" - [ test_Decode_ASCII - , test_Decode_UTF8 - , test_Decode_UTF16_BE - , test_Decode_UTF16_LE - , test_Decode_UTF32_BE - , test_Decode_UTF32_LE - ] - -test_Decode_ASCII :: F.Test -test_Decode_ASCII = F.testGroup "ASCII" props where - props = [ testProperty "works" (forAll genASCII prop_works) - , testProperty "error" prop_error - , testProperty "lazy" prop_lazy - ] - - decode iter input = - runIdentity . E.run $ - E.enumList 1 input $$ - E.joinI (ET.decode ET.ascii $$ iter) - - prop_works text = result == map T.singleton chars where - Right result = decode EL.consume (map B.singleton bytes) - - bytes = B.unpack (TE.encodeUtf8 text) - chars = T.unpack text - - prop_error = isLeft (decode EL.consume input) where - isLeft = either (const True) (const False) - input = [B.pack [0xFF]] - - prop_lazy = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x61, 0xFF]] - expected = Just (T.pack "a") - -test_Decode_UTF8 :: F.Test -test_Decode_UTF8 = F.testGroup "UTF-8" props where - props = [ testProperty "works" prop_works - , testProperty "error" prop_error - , testProperty "lazy" prop_lazy - , testProperty "incremental" prop_incremental - ] - - decode iter input = - runIdentity . E.run $ - E.enumList 1 input $$ - E.joinI (ET.decode ET.utf8 $$ iter) - - prop_works text = result == map T.singleton chars where - Right result = decode EL.consume (map B.singleton bytes) - - bytes = B.unpack (TE.encodeUtf8 text) - chars = T.unpack text - - prop_error = isLeft (decode EL.consume input) where - isLeft = either (const True) (const False) - input = [B.pack [0x61, 0x80]] - - prop_lazy = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x61, 0x80]] - expected = Just (T.pack "a") - - prop_incremental = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x61, 0xC2, 0xC2]] - expected = Just (T.pack "a") - -test_Decode_UTF16_BE :: F.Test -test_Decode_UTF16_BE = F.testGroup "UTF-16-BE" props where - props = [ testProperty "works" prop_works - , testProperty "lazy" prop_lazy - , testProperty "error" prop_error - , testProperty "incremental" prop_incremental - ] - - decode iter input = - runIdentity . E.run $ - E.enumList 1 input $$ - E.joinI (ET.decode ET.utf16_be $$ iter) - - prop_works text = result == map T.singleton chars where - Right result = decode EL.consume (map B.singleton bytes) - - bytes = B.unpack (TE.encodeUtf16BE text) - chars = T.unpack text - - prop_lazy = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x00, 0x61, 0xDD, 0x1E]] - expected = Just (T.pack "a") - - prop_error = isLeft (decode EL.consume input) where - isLeft = either (const True) (const False) - input = [B.pack [0x00, 0x61, 0xDD, 0x1E]] - - prop_incremental = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x00, 0x61, 0xD8, 0x34, 0xD8, 0xD8]] - expected = Just (T.pack "a") - -test_Decode_UTF16_LE :: F.Test -test_Decode_UTF16_LE = F.testGroup "UTF-16-LE" props where - props = [ testProperty "works" prop_works - , testProperty "lazy" prop_lazy - , testProperty "error" prop_error - , testProperty "incremental" prop_incremental - ] - - decode iter input = - runIdentity . E.run $ - E.enumList 1 input $$ - E.joinI (ET.decode ET.utf16_le $$ iter) - - prop_works text = result == map T.singleton chars where - Right result = decode EL.consume (map B.singleton bytes) - - bytes = B.unpack (TE.encodeUtf16LE text) - chars = T.unpack text - - prop_lazy = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x61, 0x00, 0x1E, 0xDD]] - expected = Just (T.pack "a") - - prop_error = isLeft (decode EL.consume input) where - isLeft = either (const True) (const False) - input = [B.pack [0x61, 0x00, 0x1E, 0xDD]] - - prop_incremental = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x61, 0x00, 0x34, 0xD8, 0xD8, 0xD8]] - expected = Just (T.pack "a") - -test_Decode_UTF32_BE :: F.Test -test_Decode_UTF32_BE = F.testGroup "UTF-32-BE" props where - props = [ testProperty "works" prop_works - , testProperty "lazy" prop_lazy - , testProperty "error" prop_error - ] - - decode iter input = - runIdentity . E.run $ - E.enumList 1 input $$ - E.joinI (ET.decode ET.utf32_be $$ iter) - - prop_works text = result == map T.singleton chars where - Right result = decode EL.consume (map B.singleton bytes) - - bytes = B.unpack (TE.encodeUtf32BE text) - chars = T.unpack text - - prop_lazy = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x00, 0x00, 0x00, 0x61, 0xFF, 0xFF]] - expected = Just (T.pack "a") - - prop_error = isLeft (decode EL.consume input) where - isLeft = either (const True) (const False) - input = [B.pack [0xFF, 0xFF, 0xFF, 0xFF]] - -test_Decode_UTF32_LE :: F.Test -test_Decode_UTF32_LE = F.testGroup "UTF-32-LE" props where - props = [ testProperty "works" prop_works - , testProperty "lazy" prop_lazy - , testProperty "error" prop_error - ] - - decode iter input = - runIdentity . E.run $ - E.enumList 1 input $$ - E.joinI (ET.decode ET.utf32_le $$ iter) - - prop_works text = result == map T.singleton chars where - Right result = decode EL.consume (map B.singleton bytes) - - bytes = B.unpack (TE.encodeUtf32LE text) - chars = T.unpack text - - prop_lazy = either (const False) (== expected) result where - result = decode EL.head input - input = [B.pack [0x61, 0x00, 0x00, 0x00, 0xFF, 0xFF]] - expected = Just (T.pack "a") - - prop_error = isLeft (decode EL.consume input) where - isLeft = either (const True) (const False) - input = [B.pack [0xFF, 0xFF, 0xFF, 0xFF]] - --- }}} - --- List analogues {{{ - -test_ListAnalogues :: F.Test -test_ListAnalogues = F.testGroup "list analogues" - [ test_Consume - , test_Head - , test_Drop - , test_Take - , test_Require - , test_Isolate - , test_SplitWhen - , test_Map - , test_ConcatMap - , test_MapM - , test_ConcatMapM - , test_MapAccum - , test_MapAccumM - , test_Filter - , test_FilterM - ] - -check :: Eq b => E.Iteratee a Identity b -> ([a] -> Either Exc.ErrorCall b) -> [a] -> Bool -check iter plain xs = expected == run iter xs where - expected = case plain xs of - Left exc -> Left (Just exc) - Right x -> Right x - - run iter xs = case runIdentity (E.run (E.enumList 1 xs $$ iter)) of - Left exc -> Left (Exc.fromException exc) - Right x -> Right x - -testListAnalogue name iterList plainList iterText plainText iterBytes plainBytes = F.testGroup name tests where - tests = [ testProperty "list" prop_List - , testProperty "text" prop_Text - , testProperty "bytes" prop_Bytes - ] - - prop_List :: [A] -> Bool - prop_List xs = check iterList plainList xs - - prop_Text xs = check iterText (plainText . TL.fromChunks) xs - prop_Bytes xs = check iterBytes (plainBytes . BL.fromChunks) xs - -testListAnalogueN name iterList plainList iterText plainText iterBytes plainBytes = F.testGroup name tests where - tests = [ testProperty "list" prop_List - , testProperty "text" prop_Text - , testProperty "bytes" prop_Bytes - ] - - prop_List :: Positive Integer -> [A] -> Bool - prop_List (Positive n) xs = check (iterList n) (plainList n) xs - - prop_Text (Positive n) xs = check (iterText n) (plainText n . TL.fromChunks) xs - prop_Bytes (Positive n) xs = check (iterBytes n) (plainBytes n . BL.fromChunks) xs - -testListAnalogueX name iterList plainList iterText plainText iterBytes plainBytes = F.testGroup name tests where - tests = [ testProperty "list" prop_List - , testProperty "text" prop_Text - , testProperty "bytes" prop_Bytes - ] - - prop_List :: A -> [A] -> Bool - prop_List x xs = check (iterList x) (plainList x) xs - - prop_Text x xs = check (iterText x) (plainText x . TL.fromChunks) xs - prop_Bytes x xs = check (iterBytes x) (plainBytes x . BL.fromChunks) xs - -test_Consume :: F.Test -test_Consume = testListAnalogue "consume" - EL.consume Right - ET.consume Right - EB.consume Right - -test_Head :: F.Test -test_Head = testListAnalogue "head" - (do - x <- EL.head - extra <- EL.consume - return (x, extra) - ) - (\xs -> Right $ case xs of - [] -> (Nothing, []) - (x:xs') -> (Just x, xs')) - (do - x <- ET.head - extra <- ET.consume - return (x, extra) - ) - (\text -> Right $ case TL.uncons text of - Nothing -> (Nothing, TL.empty) - Just (x, extra) -> (Just x, extra)) - (do - x <- EB.head - extra <- EB.consume - return (x, extra) - ) - (\bytes -> Right $ case BL.uncons bytes of - Nothing -> (Nothing, BL.empty) - Just (x, extra) -> (Just x, extra)) - -test_Drop :: F.Test -test_Drop = testListAnalogueN "drop" - (\n -> EL.drop n >> EL.consume) - (\n -> Right . L.genericDrop n) - (\n -> ET.drop n >> ET.consume) - (\n -> Right . TL.drop (fromInteger n)) - (\n -> EB.drop n >> EB.consume) - (\n -> Right . BL.drop (fromInteger n)) - -test_Take :: F.Test -test_Take = testListAnalogueN "take" - (\n -> do - xs <- EL.take n - extra <- EL.consume - return (xs, extra)) - (\n -> Right . L.genericSplitAt n) - (\n -> do - xs <- ET.take n - extra <- ET.consume - return (xs, extra)) - (\n -> Right . TL.splitAt (fromInteger n)) - (\n -> do - xs <- EB.take n - extra <- EB.consume - return (xs, extra)) - (\n -> Right . BL.splitAt (fromInteger n)) - -test_Require :: F.Test -test_Require = testListAnalogueN "require" - (\n -> do - EL.require n - EL.consume) - (\n xs -> if n > toInteger (length xs) - then Left (Exc.ErrorCall "require: Unexpected EOF") - else Right xs) - (\n -> do - ET.require n - ET.consume) - (\n xs -> if n > toInteger (TL.length xs) - then Left (Exc.ErrorCall "require: Unexpected EOF") - else Right xs) - (\n -> do - EB.require n - EB.consume) - (\n xs -> if n > toInteger (BL.length xs) - then Left (Exc.ErrorCall "require: Unexpected EOF") - else Right xs) - -test_Isolate :: F.Test -test_Isolate = testListAnalogue "isolate" - (do - x <- E.joinI (EL.isolate 2 $$ EL.head) - extra <- EL.consume - return (x, extra)) - (\xs -> Right $ case xs of - [] -> (Nothing, []) - (x:[]) -> (Just x, []) - (x:_:xs') -> (Just x, xs')) - (do - x <- E.joinI (ET.isolate 2 $$ ET.head) - extra <- ET.consume - return (x, extra)) - (\text -> Right $ case TL.unpack text of - [] -> (Nothing, TL.empty) - (x:[]) -> (Just x, TL.empty) - (x:_:xs') -> (Just x, TL.pack xs')) - (do - x <- E.joinI (EB.isolate 2 $$ EB.head) - extra <- EB.consume - return (x, extra)) - (\bytes -> Right $ case BL.unpack bytes of - [] -> (Nothing, BL.empty) - (x:[]) -> (Just x, BL.empty) - (x:_:xs) -> (Just x, BL.pack xs)) - -test_SplitWhen :: F.Test -test_SplitWhen = testListAnalogueX "splitWhen" - (\x -> do - xs <- E.joinI (EL.splitWhen (== x) $$ EL.consume) - extra <- EL.consume - return (xs, extra)) - (\x xs -> let - split = LS.split . LS.dropFinalBlank . LS.dropDelims . LS.whenElt - in Right (split (== x) xs, [])) - (\c -> do - xs <- E.joinI (ET.splitWhen (== c) $$ EL.consume) - extra <- EL.consume - return (xs, extra)) - (\c text -> let - split = LS.split . LS.dropFinalBlank . LS.dropDelims . LS.whenElt - chars = TL.unpack text - in Right (map T.pack (split (== c) chars), [])) - (\x -> do - xs <- E.joinI (EB.splitWhen (== x) $$ EL.consume) - extra <- EL.consume - return (xs, extra)) - (\x bytes -> let - split = LS.split . LS.dropFinalBlank . LS.dropDelims . LS.whenElt - words = BL.unpack bytes - in Right (map B.pack (split (== x) words), [])) - -test_Map :: F.Test -test_Map = test_Enumeratee "map" (EL.map id) - -test_ConcatMap :: F.Test -test_ConcatMap = test_Enumeratee "concatMap" (EL.concatMap (:[])) - -test_MapM :: F.Test -test_MapM = test_Enumeratee "mapM" (EL.mapM return) - -test_ConcatMapM :: F.Test -test_ConcatMapM = test_Enumeratee "concatMapM" (EL.concatMapM (\x -> return [x])) - -test_MapAccum :: F.Test -test_MapAccum = testListAnalogue "mapAccum" - (do - let enee = EL.mapAccum (\s ao -> (s+1, (s, ao))) 10 - a <- E.joinI (enee $$ EL.head) - b <- EL.consume - return (a, b)) - (\xs -> Right $ case xs of - [] -> (Nothing, []) - (x:xs') -> (Just (10, x), xs')) - (do - let enee = ET.mapAccum (\s ao -> (s+1, succ ao)) 10 - a <- E.joinI (enee $$ EL.head) - b <- ET.consume - return (a, b)) - (\text -> Right $ case TL.uncons text of - Nothing -> (Nothing, TL.empty) - Just (c, text') -> (Just (T.singleton (succ c)), text')) - (do - let enee = EB.mapAccum (\s ao -> (s+1, ao + s)) 10 - a <- E.joinI (enee $$ EL.head) - b <- EB.consume - return (a, b)) - (\bytes -> Right $ case BL.uncons bytes of - Nothing -> (Nothing, BL.empty) - Just (b, bytes') -> (Just (B.singleton (b + 10)), bytes')) - - -test_MapAccumM :: F.Test -test_MapAccumM = testListAnalogue "mapAccumM" - (do - let enee = EL.mapAccumM (\s ao -> return (s+1, (s, ao))) 10 - a <- E.joinI (enee $$ EL.head) - b <- EL.consume - return (a, b)) - (\xs -> Right $ case xs of - [] -> (Nothing, []) - (x:xs') -> (Just (10, x), xs')) - (do - let enee = ET.mapAccumM (\s ao -> return (s+1, succ ao)) 10 - a <- E.joinI (enee $$ EL.head) - b <- ET.consume - return (a, b)) - (\text -> Right $ case TL.uncons text of - Nothing -> (Nothing, TL.empty) - Just (c, text') -> (Just (T.singleton (succ c)), text')) - (do - let enee = EB.mapAccumM (\s ao -> return (s+1, ao + s)) 10 - a <- E.joinI (enee $$ EL.head) - b <- EB.consume - return (a, b)) - (\bytes -> Right $ case BL.uncons bytes of - Nothing -> (Nothing, BL.empty) - Just (b, bytes') -> (Just (B.singleton (b + 10)), bytes')) - -test_Filter :: F.Test -test_Filter = test_Enumeratee "filter" (EL.filter (\_ -> True)) - -test_FilterM :: F.Test -test_FilterM = test_Enumeratee "filterM" (EL.filterM (\_ -> return True)) - --- }}} - --- Specific functions - -test_Other :: F.Test -test_Other = F.testGroup "Other" - [ test_Sequence - , test_joinE - , test_CatchError_WithoutContinue - , test_CatchError_NotDivergent - , test_CatchError_Interleaved - ] - -test_Sequence :: F.Test -test_Sequence = testProperty "sequence" prop where - prop :: Positive Integer -> [A] -> Bool - prop (Positive n) xs = result == expected where - result = runIdentity (E.run_ iter) - expected = map Just xs - - iter = E.enumList n xs $$ E.joinI (E.sequence EL.head $$ EL.consume) - -test_joinE :: F.Test -test_joinE = testProperty "joinE" prop where - prop :: [Integer] -> Bool - prop xs = result == expected where - result = runIdentity (E.run_ iter) - expected = map (* 10) xs - - iter = (E.joinE (E.enumList 1 xs) (EL.map (* 10))) $$ EL.consume - -test_CatchError_WithoutContinue :: F.Test -test_CatchError_WithoutContinue = testProperty "catchError/without-continue" test where - test = case runIdentity (E.run (E.enumList 1 [] $$ iter)) of - Left err -> Exc.fromException err == Just (Exc.ErrorCall "require: Unexpected EOF") - Right _ -> False - iter = E.catchError - (E.throwError (Exc.ErrorCall "error")) - (\_ -> EL.require 1) - -test_CatchError_NotDivergent :: F.Test -test_CatchError_NotDivergent = testProperty "catchError/not-divergent" test where - test = case runIdentity (E.run (E.enumList 1 [] $$ iter)) of - Left err -> Exc.fromException err == Just (Exc.ErrorCall "require: Unexpected EOF") - Right _ -> False - iter = E.catchError - (do - EL.head - E.throwError (Exc.ErrorCall "error")) - (\_ -> EL.require 1) - -test_CatchError_Interleaved :: F.Test -test_CatchError_Interleaved = testProperty "catchError/interleaved" prop where - prop = within 1000000 (morallyDubiousIOProperty io) - io = do - mvar <- newEmptyMVar - E.run_ (enumMVar mvar $$ E.catchError (iter mvar) onError) - enumMVar mvar = loop where - loop (E.Continue k) = do - x <- liftIO (takeMVar mvar) - k (E.Chunks [x]) >>== loop - loop step = E.returnI step - iter mvar = do - liftIO (putMVar mvar ()) - EL.head - return True - onError err = return False - --- misc - -genASCII :: IsString a => Gen a -genASCII = fmap fromString string where - string = sized $ \n -> do - k <- choose (0,n) - sequence [ char | _ <- [1..k] ] - - char = chr `fmap` choose (0,0x7F) - -genISO8859 :: IsString a => Gen a -genISO8859 = fmap fromString string where - string = sized $ \n -> do - k <- choose (0,n) - sequence [ char | _ <- [1..k] ] - - char = chr `fmap` choose (0,0xFF) - -genUnicode :: IsString a => Gen a -genUnicode = fmap fromString string where - string = sized $ \n -> do - k <- choose (0,n) - sequence [ char | _ <- [1..k] ] - - excluding :: [a -> Bool] -> Gen a -> Gen a - excluding bad gen = loop where - loop = do - x <- gen - if or (map ($ x) bad) - then loop - else return x - - reserved = [lowSurrogate, highSurrogate, noncharacter] - lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF - highSurrogate c = c >= 0xD800 && c <= 0xDBFF - noncharacter c = masked == 0xFFFE || masked == 0xFFFF where - masked = c .&. 0xFFFF - - ascii = choose (0,0x7F) - plane0 = choose (0xF0, 0xFFFF) - plane1 = oneof [ choose (0x10000, 0x10FFF) - , choose (0x11000, 0x11FFF) - , choose (0x12000, 0x12FFF) - , choose (0x13000, 0x13FFF) - , choose (0x1D000, 0x1DFFF) - , choose (0x1F000, 0x1FFFF) - ] - plane2 = oneof [ choose (0x20000, 0x20FFF) - , choose (0x21000, 0x21FFF) - , choose (0x22000, 0x22FFF) - , choose (0x23000, 0x23FFF) - , choose (0x24000, 0x24FFF) - , choose (0x25000, 0x25FFF) - , choose (0x26000, 0x26FFF) - , choose (0x27000, 0x27FFF) - , choose (0x28000, 0x28FFF) - , choose (0x29000, 0x29FFF) - , choose (0x2A000, 0x2AFFF) - , choose (0x2B000, 0x2BFFF) - , choose (0x2F000, 0x2FFFF) - ] - plane14 = choose (0xE0000, 0xE0FFF) - planes = [ascii, plane0, plane1, plane2, plane14] - - char = chr `fmap` excluding reserved (oneof planes) - -instance Arbitrary a => Arbitrary (E.Stream a) where - arbitrary = frequency - [ (10, return E.EOF) - , (90, fmap E.Chunks arbitrary) - ] - -instance Arbitrary T.Text where - arbitrary = genUnicode - -instance Arbitrary B.ByteString where - arbitrary = genUnicode - -instance Eq Exc.ErrorCall where - (Exc.ErrorCall s1) == (Exc.ErrorCall s2) = s1 == s2 diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,936 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- Copyright (C) 2010 John Millikin +-- +-- See license.txt for details +module Main (tests, main) where + +import Control.Concurrent +import qualified Control.Exception as Exc +import Control.Monad.IO.Class (liftIO) +import Data.Bits ((.&.)) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as BL +import Data.Char (chr) +import Data.Functor.Identity (Identity, runIdentity) +import qualified Data.List as L +import qualified Data.List.Split as LS +import Data.Monoid (mappend, mempty, mconcat) +import Data.String (IsString, fromString) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy as TL +import Data.Word (Word8) +import System.Timeout (timeout) + +import Test.Chell +import Test.Chell.QuickCheck +import Test.QuickCheck hiding ((.&.), property, within) +import Test.QuickCheck.Poly (A, B, C) + +import Data.Enumerator (($$), (>>==)) +import qualified Data.Enumerator as E +import qualified Data.Enumerator.Binary as EB +import qualified Data.Enumerator.Text as ET +import qualified Data.Enumerator.List as EL + +tests :: [Suite] +tests = + [ suite_StreamInstances + , suite_Text + , suite_ListAnalogues + , suite_Other + ] + +main :: IO () +main = Test.Chell.defaultMain tests + +-- Stream instances {{{ + +suite_StreamInstances :: Suite +suite_StreamInstances = suite "stream-instances" + [ suite_StreamMonoid + , suite_StreamFunctor + , suite_StreamMonad + ] + +suite_StreamMonoid :: Suite +suite_StreamMonoid = suite "monoid" props where + props = [ property "law-1" prop_law1 + , property "law-2" prop_law2 + , property "law-3" prop_law3 + , property "law-4" prop_law4 + ] + + prop_law1 :: E.Stream A -> Bool + prop_law1 x = mappend mempty x == x + + prop_law2 :: E.Stream A -> Bool + prop_law2 x = mappend x mempty == x + + prop_law3 :: E.Stream A -> E.Stream A -> E.Stream A -> Bool + prop_law3 x y z = mappend x (mappend y z) == mappend (mappend x y) z + + prop_law4 :: [E.Stream A] -> Bool + prop_law4 xs = mconcat xs == foldr mappend mempty xs + +suite_StreamFunctor :: Suite +suite_StreamFunctor = suite "functor" props where + props = [ property "law-1" prop_law1 + , property "law-2" prop_law2 + ] + + prop_law1 :: E.Stream A -> Bool + prop_law1 x = fmap id x == id x + + prop_law2 :: E.Stream A -> Blind (B -> C) -> Blind (A -> B) -> Bool + prop_law2 x (Blind f) (Blind g) = fmap (f . g) x == (fmap f . fmap g) x + +suite_StreamMonad :: Suite +suite_StreamMonad = suite "Monad Stream" props where + props = [ property "law-1" prop_law1 + , property "law-2" prop_law2 + , property "law-3" prop_law3 + ] + + prop_law1 :: A -> Blind (A -> E.Stream B) -> Bool + prop_law1 a (Blind f) = (return a >>= f) == f a + + prop_law2 :: E.Stream A -> Bool + prop_law2 m = (m >>= return) == m + + prop_law3 :: E.Stream A -> Blind (A -> E.Stream B) -> Blind (B -> E.Stream C) -> Bool + prop_law3 m (Blind f) (Blind g) = ((m >>= f) >>= g) == (m >>= (\x -> f x >>= g)) + +-- }}} + +-- Generic properties {{{ + +test_Enumeratee :: T.Text -> E.Enumeratee A A Identity (Maybe A) -> Suite +test_Enumeratee name enee = suite name props where + props = [ property "incremental" prop_incremental + , property "nest-errors" prop_nest_errors + ] + + prop_incremental (Positive n) (NonEmpty xs) = let + result = runIdentity (E.run_ iter) + expected = (Just (head xs), tail xs) + + iter = E.enumList n xs $$ do + a <- E.joinI (enee $$ EL.head) + b <- EL.consume + return (a, b) + + in result == expected + + prop_nest_errors (Positive n) (NonEmpty xs) = let + result = runIdentity (E.run_ iter) + + iter = E.enumList n xs $$ do + _ <- enee $$ E.throwError (Exc.ErrorCall "") + EL.consume + + in result == xs + +-- }}} + +-- Text encoding / decoding {{{ + +suite_Text :: Suite +suite_Text = suite "text" + [ suite_Encoding + , suite_Decoding + ] + +suite_Encoding :: Suite +suite_Encoding = suite "encoding" + [ suite_Encode_ASCII + , suite_Encode_ISO8859 + ] + +suite_Encode_ASCII :: Suite +suite_Encode_ASCII = suite "ascii" props where + props = [ property "works" (forAll genASCII prop_works) + , property "error" prop_error + , property "lazy" prop_lazy + ] + + encode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.encode ET.ascii $$ iter) + + prop_works bytes = result == map B.singleton words where + Right result = encode EL.consume (map T.singleton chars) + + chars = B8.unpack bytes + words = B.unpack bytes + + prop_error = isLeft (encode EL.consume input) where + isLeft = either (const True) (const False) + input = [T.pack "\x61\xFF"] + + prop_lazy = either (const False) (== expected) result where + result = encode EL.head input + input = [T.pack "\x61\xFF"] + expected = Just (B.singleton 0x61) + +suite_Encode_ISO8859 :: Suite +suite_Encode_ISO8859 = suite "iso-8859-1" props where + props = [ property "works" (forAll genISO8859 prop_works) + , property "error" prop_error + , property "lazy" prop_lazy + ] + + encode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.encode ET.iso8859_1 $$ iter) + + prop_works bytes = result == map B.singleton words where + Right result = encode EL.consume (map T.singleton chars) + + chars = B8.unpack bytes + words = B.unpack bytes + + prop_error = isLeft (encode EL.consume input) where + isLeft = either (const True) (const False) + input = [T.pack "\x61\xFF5E"] + + prop_lazy = either (const False) (== expected) result where + result = encode EL.head input + input = [T.pack "\x61\xFF5E"] + expected = Just (B.singleton 0x61) + +suite_Decoding :: Suite +suite_Decoding = suite "decoding" + [ suite_Decode_ASCII + , suite_Decode_UTF8 + , suite_Decode_UTF16_BE + , suite_Decode_UTF16_LE + , suite_Decode_UTF32_BE + , suite_Decode_UTF32_LE + ] + +suite_Decode_ASCII :: Suite +suite_Decode_ASCII = suite "ascii" props where + props = [ property "works" (forAll genASCII prop_works) + , property "error" prop_error + , property "lazy" prop_lazy + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.ascii $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf8 text) + chars = T.unpack text + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0xFF]] + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0xFF]] + expected = Just (T.pack "a") + +suite_Decode_UTF8 :: Suite +suite_Decode_UTF8 = suite "utf-8" props where + props = [ property "works" prop_works + , property "error" prop_error + , property "lazy" prop_lazy + , property "incremental" prop_incremental + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf8 $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf8 text) + chars = T.unpack text + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0x61, 0x80]] + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0x80]] + expected = Just (T.pack "a") + + prop_incremental = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0xC2, 0xC2]] + expected = Just (T.pack "a") + +suite_Decode_UTF16_BE :: Suite +suite_Decode_UTF16_BE = suite "utf-16-be" props where + props = [ property "works" prop_works + , property "lazy" prop_lazy + , property "error" prop_error + , property "incremental" prop_incremental + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf16_be $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf16BE text) + chars = T.unpack text + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x00, 0x61, 0xDD, 0x1E]] + expected = Just (T.pack "a") + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0x00, 0x61, 0xDD, 0x1E]] + + prop_incremental = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x00, 0x61, 0xD8, 0x34, 0xD8, 0xD8]] + expected = Just (T.pack "a") + +suite_Decode_UTF16_LE :: Suite +suite_Decode_UTF16_LE = suite "utf-16-le" props where + props = [ property "works" prop_works + , property "lazy" prop_lazy + , property "error" prop_error + , property "incremental" prop_incremental + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf16_le $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf16LE text) + chars = T.unpack text + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0x00, 0x1E, 0xDD]] + expected = Just (T.pack "a") + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0x61, 0x00, 0x1E, 0xDD]] + + prop_incremental = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0x00, 0x34, 0xD8, 0xD8, 0xD8]] + expected = Just (T.pack "a") + +suite_Decode_UTF32_BE :: Suite +suite_Decode_UTF32_BE = suite "utf-32-be" props where + props = [ property "works" prop_works + , property "lazy" prop_lazy + , property "error" prop_error + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf32_be $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf32BE text) + chars = T.unpack text + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x00, 0x00, 0x00, 0x61, 0xFF, 0xFF]] + expected = Just (T.pack "a") + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0xFF, 0xFF, 0xFF, 0xFF]] + +suite_Decode_UTF32_LE :: Suite +suite_Decode_UTF32_LE = suite "utf-32-le" props where + props = [ property "works" prop_works + , property "lazy" prop_lazy + , property "error" prop_error + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf32_le $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf32LE text) + chars = T.unpack text + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0x00, 0x00, 0x00, 0xFF, 0xFF]] + expected = Just (T.pack "a") + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0xFF, 0xFF, 0xFF, 0xFF]] + +-- }}} + +-- List analogues {{{ + +suite_ListAnalogues :: Suite +suite_ListAnalogues = suite "list-analogues" + [ suite_Consume + , suite_Head + , suite_Drop + , suite_Take + , suite_Require + , suite_Isolate + , suite_SplitWhen + , suite_Map + , suite_ConcatMap + , suite_MapM + , suite_ConcatMapM + , suite_MapAccum + , suite_MapAccumM + , suite_Filter + , suite_FilterM + ] + +check :: Eq b => E.Iteratee a Identity b -> ([a] -> Either Exc.ErrorCall b) -> [a] -> Bool +check iter plain xs = expected == run iter xs where + expected = case plain xs of + Left exc -> Left (Just exc) + Right x -> Right x + + run iter xs = case runIdentity (E.run (E.enumList 1 xs $$ iter)) of + Left exc -> Left (Exc.fromException exc) + Right x -> Right x + +testListAnalogue name iterList plainList iterText plainText iterBytes plainBytes = suite name tests where + tests = [ property "list" prop_List + , property "text" prop_Text + , property "bytes" prop_Bytes + ] + + prop_List :: [A] -> Bool + prop_List xs = check iterList plainList xs + + prop_Text xs = check iterText (plainText . TL.fromChunks) xs + prop_Bytes xs = check iterBytes (plainBytes . BL.fromChunks) xs + +testListAnalogueN name iterList plainList iterText plainText iterBytes plainBytes = suite name tests where + tests = [ property "list" prop_List + , property "text" prop_Text + , property "bytes" prop_Bytes + ] + + prop_List :: Positive Integer -> [A] -> Bool + prop_List (Positive n) xs = check (iterList n) (plainList n) xs + + prop_Text (Positive n) xs = check (iterText n) (plainText n . TL.fromChunks) xs + prop_Bytes (Positive n) xs = check (iterBytes n) (plainBytes n . BL.fromChunks) xs + +testListAnalogueX name iterList plainList iterText plainText iterBytes plainBytes = suite name tests where + tests = [ property "list" prop_List + , property "text" prop_Text + , property "bytes" prop_Bytes + ] + + prop_List :: A -> [A] -> Bool + prop_List x xs = check (iterList x) (plainList x) xs + + prop_Text x xs = check (iterText x) (plainText x . TL.fromChunks) xs + prop_Bytes x xs = check (iterBytes x) (plainBytes x . BL.fromChunks) xs + +suite_Consume :: Suite +suite_Consume = testListAnalogue "consume" + EL.consume Right + ET.consume Right + EB.consume Right + +suite_Head :: Suite +suite_Head = testListAnalogue "head" + (do + x <- EL.head + extra <- EL.consume + return (x, extra) + ) + (\xs -> Right $ case xs of + [] -> (Nothing, []) + (x:xs') -> (Just x, xs')) + (do + x <- ET.head + extra <- ET.consume + return (x, extra) + ) + (\text -> Right $ case TL.uncons text of + Nothing -> (Nothing, TL.empty) + Just (x, extra) -> (Just x, extra)) + (do + x <- EB.head + extra <- EB.consume + return (x, extra) + ) + (\bytes -> Right $ case BL.uncons bytes of + Nothing -> (Nothing, BL.empty) + Just (x, extra) -> (Just x, extra)) + +suite_Drop :: Suite +suite_Drop = testListAnalogueN "drop" + (\n -> EL.drop n >> EL.consume) + (\n -> Right . L.genericDrop n) + (\n -> ET.drop n >> ET.consume) + (\n -> Right . TL.drop (fromInteger n)) + (\n -> EB.drop n >> EB.consume) + (\n -> Right . BL.drop (fromInteger n)) + +suite_Take :: Suite +suite_Take = testListAnalogueN "take" + (\n -> do + xs <- EL.take n + extra <- EL.consume + return (xs, extra)) + (\n -> Right . L.genericSplitAt n) + (\n -> do + xs <- ET.take n + extra <- ET.consume + return (xs, extra)) + (\n -> Right . TL.splitAt (fromInteger n)) + (\n -> do + xs <- EB.take n + extra <- EB.consume + return (xs, extra)) + (\n -> Right . BL.splitAt (fromInteger n)) + +suite_Require :: Suite +suite_Require = testListAnalogueN "require" + (\n -> do + EL.require n + EL.consume) + (\n xs -> if n > toInteger (length xs) + then Left (Exc.ErrorCall "require: Unexpected EOF") + else Right xs) + (\n -> do + ET.require n + ET.consume) + (\n xs -> if n > toInteger (TL.length xs) + then Left (Exc.ErrorCall "require: Unexpected EOF") + else Right xs) + (\n -> do + EB.require n + EB.consume) + (\n xs -> if n > toInteger (BL.length xs) + then Left (Exc.ErrorCall "require: Unexpected EOF") + else Right xs) + +suite_Isolate :: Suite +suite_Isolate = testListAnalogue "isolate" + (do + x <- E.joinI (EL.isolate 2 $$ EL.head) + extra <- EL.consume + return (x, extra)) + (\xs -> Right $ case xs of + [] -> (Nothing, []) + (x:[]) -> (Just x, []) + (x:_:xs') -> (Just x, xs')) + (do + x <- E.joinI (ET.isolate 2 $$ ET.head) + extra <- ET.consume + return (x, extra)) + (\text -> Right $ case TL.unpack text of + [] -> (Nothing, TL.empty) + (x:[]) -> (Just x, TL.empty) + (x:_:xs') -> (Just x, TL.pack xs')) + (do + x <- E.joinI (EB.isolate 2 $$ EB.head) + extra <- EB.consume + return (x, extra)) + (\bytes -> Right $ case BL.unpack bytes of + [] -> (Nothing, BL.empty) + (x:[]) -> (Just x, BL.empty) + (x:_:xs) -> (Just x, BL.pack xs)) + +suite_SplitWhen :: Suite +suite_SplitWhen = testListAnalogueX "splitWhen" + (\x -> do + xs <- E.joinI (EL.splitWhen (== x) $$ EL.consume) + extra <- EL.consume + return (xs, extra)) + (\x xs -> let + split = LS.split . LS.dropFinalBlank . LS.dropDelims . LS.whenElt + in Right (split (== x) xs, [])) + (\c -> do + xs <- E.joinI (ET.splitWhen (== c) $$ EL.consume) + extra <- EL.consume + return (xs, extra)) + (\c text -> let + split = LS.split . LS.dropFinalBlank . LS.dropDelims . LS.whenElt + chars = TL.unpack text + in Right (map T.pack (split (== c) chars), [])) + (\x -> do + xs <- E.joinI (EB.splitWhen (== x) $$ EL.consume) + extra <- EL.consume + return (xs, extra)) + (\x bytes -> let + split = LS.split . LS.dropFinalBlank . LS.dropDelims . LS.whenElt + words = BL.unpack bytes + in Right (map B.pack (split (== x) words), [])) + +suite_Map :: Suite +suite_Map = test_Enumeratee "map" (EL.map id) + +suite_ConcatMap :: Suite +suite_ConcatMap = test_Enumeratee "concatMap" (EL.concatMap (:[])) + +suite_MapM :: Suite +suite_MapM = test_Enumeratee "mapM" (EL.mapM return) + +suite_ConcatMapM :: Suite +suite_ConcatMapM = test_Enumeratee "concatMapM" (EL.concatMapM (\x -> return [x])) + +suite_MapAccum :: Suite +suite_MapAccum = testListAnalogue "mapAccum" + (do + let enee = EL.mapAccum (\s ao -> (s+1, (s, ao))) 10 + a <- E.joinI (enee $$ EL.head) + b <- EL.consume + return (a, b)) + (\xs -> Right $ case xs of + [] -> (Nothing, []) + (x:xs') -> (Just (10, x), xs')) + (do + let enee = ET.mapAccum (\s ao -> (s+1, succ ao)) 10 + a <- E.joinI (enee $$ EL.head) + b <- ET.consume + return (a, b)) + (\text -> Right $ case TL.uncons text of + Nothing -> (Nothing, TL.empty) + Just (c, text') -> (Just (T.singleton (succ c)), text')) + (do + let enee = EB.mapAccum (\s ao -> (s+1, ao + s)) 10 + a <- E.joinI (enee $$ EL.head) + b <- EB.consume + return (a, b)) + (\bytes -> Right $ case BL.uncons bytes of + Nothing -> (Nothing, BL.empty) + Just (b, bytes') -> (Just (B.singleton (b + 10)), bytes')) + + +suite_MapAccumM :: Suite +suite_MapAccumM = testListAnalogue "mapAccumM" + (do + let enee = EL.mapAccumM (\s ao -> return (s+1, (s, ao))) 10 + a <- E.joinI (enee $$ EL.head) + b <- EL.consume + return (a, b)) + (\xs -> Right $ case xs of + [] -> (Nothing, []) + (x:xs') -> (Just (10, x), xs')) + (do + let enee = ET.mapAccumM (\s ao -> return (s+1, succ ao)) 10 + a <- E.joinI (enee $$ EL.head) + b <- ET.consume + return (a, b)) + (\text -> Right $ case TL.uncons text of + Nothing -> (Nothing, TL.empty) + Just (c, text') -> (Just (T.singleton (succ c)), text')) + (do + let enee = EB.mapAccumM (\s ao -> return (s+1, ao + s)) 10 + a <- E.joinI (enee $$ EL.head) + b <- EB.consume + return (a, b)) + (\bytes -> Right $ case BL.uncons bytes of + Nothing -> (Nothing, BL.empty) + Just (b, bytes') -> (Just (B.singleton (b + 10)), bytes')) + +suite_Filter :: Suite +suite_Filter = test_Enumeratee "filter" (EL.filter (\_ -> True)) + +suite_FilterM :: Suite +suite_FilterM = test_Enumeratee "filterM" (EL.filterM (\_ -> return True)) + +-- }}} + +-- Specific functions + +suite_Other :: Suite +suite_Other = suite "other" + [ test_Sequence + , test_joinE + , suite "catchError" + [ test test_CatchError_WithoutContinue + , test test_CatchError_NotDivergent + , test test_CatchError_Interleaved + ] + , test test_Zip + , test test_ZipBytes + , test test_ZipText + ] + +test_Sequence :: Suite +test_Sequence = property "sequence" prop where + prop :: Positive Integer -> [A] -> Bool + prop (Positive n) xs = result == expected where + result = runIdentity (E.run_ iter) + expected = map Just xs + + iter = E.enumList n xs $$ E.joinI (E.sequence EL.head $$ EL.consume) + +test_joinE :: Suite +test_joinE = property "joinE" prop where + prop :: [Integer] -> Bool + prop xs = result == expected where + result = runIdentity (E.run_ iter) + expected = map (* 10) xs + + iter = (E.joinE (E.enumList 1 xs) (EL.map (* 10))) $$ EL.consume + +test_CatchError_WithoutContinue :: Test +test_CatchError_WithoutContinue = assertions "without-continue" $ do + let iter = E.catchError + (E.throwError (Exc.ErrorCall "error")) + (\_ -> EL.require 1) + + res <- E.run (E.enumList 1 [] $$ iter) + $assert (left res) + + let Left err = res + $assert $ equal (Exc.fromException err) (Just (Exc.ErrorCall "require: Unexpected EOF")) + +test_CatchError_NotDivergent :: Test +test_CatchError_NotDivergent = assertions "not-divergent" $ do + let iter = E.catchError + (do + EL.head + E.throwError (Exc.ErrorCall "error")) + (\_ -> EL.require 1) + + res <- E.run (E.enumList 1 [] $$ iter) + $assert (left res) + + let Left err = res + $assert $ equal (Exc.fromException err) (Just (Exc.ErrorCall "require: Unexpected EOF")) + +test_CatchError_Interleaved :: Test +test_CatchError_Interleaved = within 1000 $ assertions "interleaved" $ do + let enumMVar mvar = EL.repeatM (liftIO (takeMVar mvar)) + let iter mvar = do + liftIO (putMVar mvar ()) + EL.head + return True + let onError err = return False + + mvar <- liftIO newEmptyMVar + E.run_ (enumMVar mvar $$ E.catchError (iter mvar) onError) + +test_Zip :: Test +test_Zip = assertions "zip" $ do + let iterTup = do + Just x <- EL.head + Just y <- EL.head + return (x, y) + let iterTupFlip = do + Just x <- EL.head + Just y <- EL.head + return (y, x) + + let check i1 i2 = E.run_ (E.enumList 4 [1, 2, 3, 4, 5] $$ do + (x, y) <- EL.zip i1 i2 + extra <- EL.consume + return (x, y, extra)) + + -- Both sides have same behavior + (tup, tup2, extra) <- check iterTup iterTupFlip + $expect (equal tup (1, 2)) + $expect (equal tup2 (2, 1)) + $expect (equal extra [3, 4, 5]) + + -- First side has more extra data + (took, tup, extra) <- check (EL.take 1) iterTup + $expect (equal took [1]) + $expect (equal tup (1, 2)) + $expect (equal extra [3, 4, 5]) + + -- Second side has more extra data + (tup, took, extra) <- check iterTup (EL.take 1) + $expect (equal tup (1, 2)) + $expect (equal took [1]) + $expect (equal extra [3, 4, 5]) + +test_ZipBytes :: Test +test_ZipBytes = assertions "zip-bytes" $ do + let iterTup = do + Just x <- EB.head + Just y <- EB.head + return (x, y) + let iterTupFlip = do + Just x <- EB.head + Just y <- EB.head + return (y, x) + + let check i1 i2 = E.run_ (E.enumList 2 ["abc", "def", "ghi"] $$ do + (x, y) <- EB.zip i1 i2 + extra <- EL.consume + return (x, y, extra)) + + -- Both sides have same behavior + (tup, tup2, extra) <- check iterTup iterTupFlip + $expect (equal tup (0x61, 0x62)) + $expect (equal tup2 (0x62, 0x61)) + $expect (equal extra ["c", "def", "ghi"]) + + -- First side has more extra data + (took, tup, extra) <- check (EB.take 1) iterTup + $expect (equal took "a") + $expect (equal tup (0x61, 0x62)) + $expect (equal extra ["c", "def", "ghi"]) + + -- Second side has more extra data + (tup, took, extra) <- check iterTup (EB.take 1) + $expect (equal tup (0x61, 0x62)) + $expect (equal took "a") + $expect (equal extra ["c", "def", "ghi"]) + +test_ZipText :: Test +test_ZipText = assertions "zip-text" $ do + let iterTup = do + Just x <- ET.head + Just y <- ET.head + return (x, y) + let iterTupFlip = do + Just x <- ET.head + Just y <- ET.head + return (y, x) + + let check i1 i2 = E.run_ (E.enumList 2 ["abc", "def", "ghi"] $$ do + (x, y) <- ET.zip i1 i2 + extra <- EL.consume + return (x, y, extra)) + + -- Both sides have same behavior + (tup, tup2, extra) <- check iterTup iterTupFlip + $expect (equal tup ('a', 'b')) + $expect (equal tup2 ('b', 'a')) + $expect (equal extra ["c", "def", "ghi"]) + + -- First side has more extra data + (took, tup, extra) <- check (ET.take 1) iterTup + $expect (equal took "a") + $expect (equal tup ('a', 'b')) + $expect (equal extra ["c", "def", "ghi"]) + + -- Second side has more extra data + (tup, took, extra) <- check iterTup (ET.take 1) + $expect (equal tup ('a', 'b')) + $expect (equal took "a") + $expect (equal extra ["c", "def", "ghi"]) + +-- misc + +genASCII :: IsString a => Gen a +genASCII = fmap fromString string where + string = sized $ \n -> do + k <- choose (0,n) + sequence [ char | _ <- [1..k] ] + + char = chr `fmap` choose (0,0x7F) + +genISO8859 :: IsString a => Gen a +genISO8859 = fmap fromString string where + string = sized $ \n -> do + k <- choose (0,n) + sequence [ char | _ <- [1..k] ] + + char = chr `fmap` choose (0,0xFF) + +genUnicode :: IsString a => Gen a +genUnicode = fmap fromString string where + string = sized $ \n -> do + k <- choose (0,n) + sequence [ char | _ <- [1..k] ] + + excluding :: [a -> Bool] -> Gen a -> Gen a + excluding bad gen = loop where + loop = do + x <- gen + if or (map ($ x) bad) + then loop + else return x + + reserved = [lowSurrogate, highSurrogate, noncharacter] + lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF + highSurrogate c = c >= 0xD800 && c <= 0xDBFF + noncharacter c = masked == 0xFFFE || masked == 0xFFFF where + masked = c .&. 0xFFFF + + ascii = choose (0,0x7F) + plane0 = choose (0xF0, 0xFFFF) + plane1 = oneof [ choose (0x10000, 0x10FFF) + , choose (0x11000, 0x11FFF) + , choose (0x12000, 0x12FFF) + , choose (0x13000, 0x13FFF) + , choose (0x1D000, 0x1DFFF) + , choose (0x1F000, 0x1FFFF) + ] + plane2 = oneof [ choose (0x20000, 0x20FFF) + , choose (0x21000, 0x21FFF) + , choose (0x22000, 0x22FFF) + , choose (0x23000, 0x23FFF) + , choose (0x24000, 0x24FFF) + , choose (0x25000, 0x25FFF) + , choose (0x26000, 0x26FFF) + , choose (0x27000, 0x27FFF) + , choose (0x28000, 0x28FFF) + , choose (0x29000, 0x29FFF) + , choose (0x2A000, 0x2AFFF) + , choose (0x2B000, 0x2BFFF) + , choose (0x2F000, 0x2FFFF) + ] + plane14 = choose (0xE0000, 0xE0FFF) + planes = [ascii, plane0, plane1, plane2, plane14] + + char = chr `fmap` excluding reserved (oneof planes) + +instance Arbitrary a => Arbitrary (E.Stream a) where + arbitrary = frequency + [ (10, return E.EOF) + , (90, fmap E.Chunks arbitrary) + ] + +instance Arbitrary T.Text where + arbitrary = genUnicode + +instance Arbitrary B.ByteString where + arbitrary = genUnicode + +instance Eq Exc.ErrorCall where + (Exc.ErrorCall s1) == (Exc.ErrorCall s2) = s1 == s2 + +-- | Require a test to complete within /n/ milliseconds. +within :: Int -> Test -> Test +within time (Test name io) = Test name $ \opts -> do + res <- timeout (time * 1000) (io opts) + case res of + Just res' -> return res' + Nothing -> return (TestAborted [] (T.pack ("Test timed out after " ++ show time ++ " milliseconds"))) diff --git a/tests/enumerator-tests.cabal b/tests/enumerator-tests.cabal --- a/tests/enumerator-tests.cabal +++ b/tests/enumerator-tests.cabal @@ -4,30 +4,16 @@ cabal-version: >= 1.6 executable enumerator_tests - main-is: Properties.hs + main-is: Tests.hs ghc-options: -Wall -O2 build-depends: base > 3 && < 5 - , transformers , bytestring - , text + , chell >= 0.1 && < 0.2 + , chell-quickcheck >= 0.1 && < 0.2 , enumerator + , QuickCheck , split - , QuickCheck == 2.4.* - , test-framework >= 0.2 && < 0.4 - , test-framework-quickcheck2 == 0.2.9 - -executable enumerator_benchmarks - main-is: Benchmarks.hs - ghc-options: -Wall -O2 - - build-depends: - base > 3 && < 5 - , transformers - , bytestring , text - , enumerator - , criterion - , progression - , deepseq + , transformers