enumerator-0.4.19/0000755000000000000000000000000011740377455012171 5ustar0000000000000000enumerator-0.4.19/enumerator.cabal0000644000000000000000000001315111740377455015337 0ustar0000000000000000name: enumerator version: 0.4.19 license: MIT license-file: license.txt author: John Millikin maintainer: jmillikin@gmail.com copyright: 2010-2011 John Millikin, 2011 Mikhail Vorozhtsov build-type: Simple cabal-version: >= 1.6 category: Data, Enumerator stability: experimental homepage: https://john-millikin.com/software/enumerator/ bug-reports: mailto:jmillikin@gmail.com synopsis: Reliable, high-performance processing with left-fold enumerators description: Typical buffer–based incremental I/O 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, 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 I/O” allows pure code to operate on data from an external source. However, lazy I/O 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 I/O. Discovered by Oleg 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 I/O 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: . * /Iteratee/: Data sinks, analogous to left folds. Iteratees consume a sequence of /input/ values, and generate a single /output/ value. Many iteratees are designed to perform side effects (such as printing to @stdout@), so they can also be used as monad transformers. . * /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 EOF. . * /Enumeratee/: Data transformers, which operate as both enumerators and iteratees. Enumeratees read from an /outer/ enumerator, and provide the transformed data to an /inner/ iteratee. extra-source-files: benchmarks/enumerator-benchmarks.cabal benchmarks/Benchmarks.hs -- examples/cat.hs examples/wc.hs -- scripts/common.bash scripts/dist scripts/run-benchmarks scripts/run-coverage scripts/run-tests -- tests/enumerator-tests.cabal tests/data/ascii-crlf.txt tests/data/ascii-lf.txt tests/data/utf8-crlf.txt tests/data/utf8-lf.txt tests/EnumeratorTests.hs tests/EnumeratorTests/Binary.hs tests/EnumeratorTests/Binary/Consume.hs tests/EnumeratorTests/Binary/Drop.hs tests/EnumeratorTests/Binary/Fold.hs tests/EnumeratorTests/Binary/Handle.hs tests/EnumeratorTests/Binary/Isolate.hs tests/EnumeratorTests/Binary/Iterate.hs tests/EnumeratorTests/Binary/Map.hs tests/EnumeratorTests/Binary/Repeat.hs tests/EnumeratorTests/Binary/Replicate.hs tests/EnumeratorTests/Binary/Require.hs tests/EnumeratorTests/Binary/Split.hs tests/EnumeratorTests/Binary/Unfold.hs tests/EnumeratorTests/Binary/Util.hs tests/EnumeratorTests/Binary/Zip.hs tests/EnumeratorTests/CatchError.hs tests/EnumeratorTests/Compatibility.hs tests/EnumeratorTests/Instances.hs tests/EnumeratorTests/Join.hs tests/EnumeratorTests/List.hs tests/EnumeratorTests/List/Consume.hs tests/EnumeratorTests/List/Drop.hs tests/EnumeratorTests/List/Fold.hs tests/EnumeratorTests/List/Isolate.hs tests/EnumeratorTests/List/Iterate.hs tests/EnumeratorTests/List/Map.hs tests/EnumeratorTests/List/Repeat.hs tests/EnumeratorTests/List/Replicate.hs tests/EnumeratorTests/List/Require.hs tests/EnumeratorTests/List/Split.hs tests/EnumeratorTests/List/Unfold.hs tests/EnumeratorTests/List/Unique.hs tests/EnumeratorTests/List/Util.hs tests/EnumeratorTests/List/Zip.hs tests/EnumeratorTests/Misc.hs tests/EnumeratorTests/Sequence.hs tests/EnumeratorTests/Stream.hs tests/EnumeratorTests/Text.hs tests/EnumeratorTests/Text/Codecs.hs tests/EnumeratorTests/Text/Consume.hs tests/EnumeratorTests/Text/Drop.hs tests/EnumeratorTests/Text/Fold.hs tests/EnumeratorTests/Text/Handle.hs tests/EnumeratorTests/Text/Isolate.hs tests/EnumeratorTests/Text/Iterate.hs tests/EnumeratorTests/Text/Map.hs tests/EnumeratorTests/Text/Repeat.hs tests/EnumeratorTests/Text/Replicate.hs tests/EnumeratorTests/Text/Require.hs tests/EnumeratorTests/Text/Split.hs tests/EnumeratorTests/Text/Unfold.hs tests/EnumeratorTests/Text/Util.hs tests/EnumeratorTests/Text/Zip.hs tests/EnumeratorTests/Trans.hs tests/EnumeratorTests/Util.hs source-repository head type: bazaar location: https://john-millikin.com/software/enumerator/ source-repository this type: bazaar location: https://john-millikin.com/branches/enumerator/0.4/ tag: enumerator_0.4.19 library ghc-options: -Wall -O2 hs-source-dirs: lib build-depends: base >= 4.0 && < 5.0 , transformers >= 0.2 , bytestring >= 0.9 , containers >= 0.1 , text >= 0.7 exposed-modules: Data.Enumerator Data.Enumerator.Binary Data.Enumerator.Internal Data.Enumerator.IO Data.Enumerator.List Data.Enumerator.Text Data.Enumerator.Trans other-modules: Data.Enumerator.Compatibility Data.Enumerator.Util enumerator-0.4.19/Setup.hs0000644000000000000000000000005611740377455013626 0ustar0000000000000000import Distribution.Simple main = defaultMain enumerator-0.4.19/license.txt0000644000000000000000000000204111740377455014351 0ustar0000000000000000Copyright (c) 2010 John Millikin Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. enumerator-0.4.19/lib/0000755000000000000000000000000011740377455012737 5ustar0000000000000000enumerator-0.4.19/lib/Data/0000755000000000000000000000000011740377455013610 5ustar0000000000000000enumerator-0.4.19/lib/Data/Enumerator.hs0000644000000000000000000002763711740377455016304 0ustar0000000000000000-- | -- Module: Data.Enumerator -- Copyright: 2010-2011 John Millikin -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- -- For compatibility reasons, this module should imported qualified: -- -- @ -- import qualified Data.Enumerator as E -- @ module Data.Enumerator ( -- * Types Iteratee , Enumerator , Enumeratee -- * Running iteratees , run , run_ -- * Operators -- | Compatibility note: Most of these will be obsoleted by -- version 0.5. Please make sure your @.cabal@ files have a -- @<0.5@ limit on the @enumerator@ dependency. , (>>==) , (==<<) , ($$) , (>==>) , (<==<) , (=$) , ($=) , (=$=) -- * Error handling , throwError , catchError -- * Miscellaneous , concatEnums , joinI , joinE , Data.Enumerator.sequence , isEOF , tryIO , liftTrans -- * Testing and debugging , printChunks , enumList , enumLists , runLists , runLists_ -- * Internal interfaces -- | This module export will be removed in version 0.5. If you -- depend on internal implementation details, please import -- @"Data.Enumerator.Internal"@ directly. , module Data.Enumerator.Internal -- Obsolete and pointless , peek , Data.Enumerator.last , Data.Enumerator.length -- Legacy compatibility -- These legacy compatibility functions will be removed in -- version 0.5. , module Data.Enumerator.Compatibility ) where 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.Functor.Identity (Identity, runIdentity) import Data.List (genericLength, genericSplitAt) import Data.Enumerator.Compatibility import Data.Enumerator.Internal -- | Run an iteratee until it finishes, and return either the final value -- (if it succeeded) or the error (if it failed). -- -- > import Data.Enumerator -- > import Data.Enumerator.List as EL -- > -- > main = do -- > result <- run (EL.iterate succ 'A' $$ EL.take 5) -- > case result of -- > Left exc -> putStrLn ("Got an exception: " ++ show exc) -- > Right chars -> putStrLn ("Got characters: " ++ show chars) 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. -- -- > import Data.Enumerator -- > import Data.Enumerator.List as EL -- > -- > main = do -- > chars <- run_ (EL.iterate succ 'A' $$ EL.take 5) -- > putStrLn ("Got characters: " ++ show chars) -- -- Since: 0.4.1 run_ :: Monad m => Iteratee a m b -> m b run_ i = run i >>= either Exc.throw return -- | The moral equivalent of 'Exc.throwIO' for iteratees. 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: Within the error handler, it is difficult or impossible to know -- how much input the original iteratee has consumed. Users are strongly -- advised to wrap all uses of @catchError@ with an appropriate isolation -- enumeratee, such as @Data.Enumerator.List.isolate@ or -- @Data.Enumerator.Binary.isolate@, which will handle input framing even -- in the face of unexpected errors. -- -- 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')) -- | 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. This is primarily useful for testing, debugging, and REPL -- exploration. -- -- Compatibility note: In version 0.5, 'enumList' will be changed to the -- type: -- -- > enumList :: Monad m => [a] -> Enumerator a m b 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 -- | @'enumLists' xs@ enumerates /xs/ as a stream, where each element is a -- separate chunk. This is primarily useful for testing and debugging. -- -- Since: 0.4.15 enumLists :: Monad m => [[a]] -> Enumerator a m b enumLists (xs:xss) (Continue k) = k (Chunks xs) >>== enumLists xss enumLists _ step = returnI step -- | Run an iteratee with the given input, and return either the final value -- (if it succeeded) or the error (if it failed). -- -- Since: 0.4.15 runLists :: [[a]] -> Iteratee a Identity b -> Either Exc.SomeException b runLists lists iter = runIdentity (run (enumLists lists $$ iter)) -- | Like 'runLists', except errors are converted to exceptions and thrown. -- -- Since: 0.4.15 runLists_ :: [[a]] -> Iteratee a Identity b -> b runLists_ lists iter = runIdentity (run_ (enumLists lists $$ iter)) -- | Compose a list of 'Enumerator's using @('>==>').@ concatEnums :: Monad m => [Enumerator a m b] -> Enumerator a m b concatEnums = Prelude.foldl (>==>) returnI -- | “Wraps” an iteratee /inner/ in an enumeratee /wrapper/. -- The resulting iteratee will consume /wrapper/’s input type and -- yield /inner/’s output type. -- -- See the documentation for ('=$'). -- -- @joinI (enum $$ iter) = enum =$ iter@ 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 =$ -- | “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 @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) -- | “Wraps” an enumerator /inner/ in an enumeratee /wrapper/. -- The resulting enumerator will generate /wrapper/’s output type. -- -- See the documentation for ('$='). -- -- @joinE enum enee = enum $= enee@ -- -- Since: 0.4.5 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" infixl 1 $= -- | “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 -- -- Compatibility note: in version 0.4.15, the associativity of @($=)@ was -- changed from @infixr 0@ to @infixl 1@. -- -- Since: 0.4.9 ($=) :: Monad m => Enumerator ao m (Step ai m b) -> Enumeratee ao ai m b -> Enumerator ai m b ($=) = joinE -- | Composes two enumeratees. -- -- Note that if the inner enumeratee yields left-over input, this will be -- discarded. -- -- Example: converting bytes into lower-case text: -- -- > import Data.ByteString -- > import Data.Text -- > import Data.Enumerator.List as EnumList -- > import Data.Enumerator.Text -- > -- > decodeAndLower :: Monad m => Enumeratee ByteString Text m b -- > decodeAndLower = decode utf8 =$= EnumList.map toLower -- -- Since: 0.4.17 (=$=) :: Monad m => Enumeratee a1 a2 m (Step a3 m b) -> Enumeratee a2 a3 m b -> Enumeratee a1 a3 m b e1 =$= e2 = \s -> joinI (e1 $$ e2 s) infixl 1 =$= -- | 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 -- | Check whether a stream has reached EOF. Note that if the stream is not -- at EOF, @isEOF@ may cause data to be read from the enumerator. 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 passed to 'throwError'. -- -- 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 -- | Lift an 'Iteratee' onto a monad transformer, re-wrapping its -- 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) -- | 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 enumerator-0.4.19/lib/Data/Enumerator.hs-boot0000644000000000000000000000060111740377455017223 0ustar0000000000000000module 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) enumerator-0.4.19/lib/Data/Enumerator/0000755000000000000000000000000011740377455015731 5ustar0000000000000000enumerator-0.4.19/lib/Data/Enumerator/IO.hs0000644000000000000000000000243711740377455016602 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} -- | -- 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 enumerator-0.4.19/lib/Data/Enumerator/Compatibility.hs0000644000000000000000000001542011740377455021100 0ustar0000000000000000-- | -- Module: Data.Enumerator.Compatibility -- Copyright: 2010-2011 John Millikin -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- -- Shims for compatibility with earlier versions of the Enumerator library. module Data.Enumerator.Compatibility ( liftI , head , drop , dropWhile , span , break , consume , foldl , foldl' , foldM , iterate , iterateM , repeat , repeatM , replicate , replicateM , generateM , map , mapM , concatMap , concatMapM , filter , filterM , liftFoldL , liftFoldL' , liftFoldM ) where import qualified Prelude import Prelude (Bool, Integer, Maybe, Monad, not, (.)) import Data.Enumerator.Internal import {-# SOURCE #-} qualified Data.Enumerator.List as EL {-# 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) {-# 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 = 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 enumerator-0.4.19/lib/Data/Enumerator/Text.hs0000644000000000000000000010203011740377455017205 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- 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 , isolateWhile , 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.Internal import Data.Enumerator (isEOF, tryIO, throwError) 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]) (`loop` 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) >>== (`yield` toChunks s2) loop EOF = k EOF >>== (`yield` EOF) isolate n step = drop n >> return step -- | @'isolateWhile' p@ reads characters from the stream until /p/ is false, and -- passes them to its iteratee. If the iteratee finishes early, characters -- continue to be consumed from the outer stream until /p/ is false. -- -- Since: 0.4.16 isolateWhile :: Monad m => (Char -> Bool) -> Enumeratee T.Text T.Text m b isolateWhile p (Continue k) = continue loop where loop (Chunks []) = continue loop loop (Chunks xs) = iter where lazy = TL.fromChunks xs (s1, s2) = tlSpanBy p lazy iter = if TL.null s2 then k (Chunks xs) >>== isolateWhile p else k (toChunks s1) >>== (`yield` toChunks s2) loop EOF = k EOF >>== (`yield` EOF) isolateWhile p step = Data.Enumerator.Text.dropWhile p >> 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 a 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'. -- -- This function may be significantly slower than using -- @Data.Enumerator.Binary.enumHandle@, due to the additional overhead of -- decoding input data to Unicode. Users who can depend on their input files -- being in a certain encoding (such as UTF8) are encouraged to use binary -- input and 'decode'. -- -- Changed in 0.4.18: Lines streamed from 'enumHandle' and 'enumFile' now -- include their trailing newline. -- -- Since: 0.2 enumHandle :: MonadIO m => IO.Handle -> Enumerator T.Text m b enumHandle h = checkContinue0 $ \loop k -> do maybeText <- tryIO (textGetLine h) case maybeText of Nothing -> continue k Just text -> k (Chunks [text]) >>== loop textGetLine :: IO.Handle -> IO (Maybe T.Text) textGetLine h = loop [] where #if MIN_VERSION_base(4,2,0) pack = T.pack #else pack = TE.decodeUtf8 . B8.pack #endif loop acc = Exc.catch (do c <- IO.hGetChar h if c == '\n' then return (Just (pack (reverse (c:acc)))) else loop (c:acc)) (\err -> if isEOFError err then case acc of [] -> return Nothing _ -> return (Just (pack (reverse acc))) else Exc.throwIO err) -- | Read lines of text from a file, 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 file will be opened in text mode, and will be closed when the -- 'Iteratee' finishes. -- -- This function may be significantly slower than using -- @Data.Enumerator.Binary.enumFile@, due to the additional overhead of -- decoding input data to Unicode. Users who can depend on their input files -- being in a certain encoding (such as UTF8) are encouraged to use binary -- input and 'decode'. -- -- Changed in 0.4.18: Lines streamed from 'enumHandle' and 'enumFile' now -- include their trailing newline. -- -- 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 acc k EOF = if B.null acc then yield (Continue k) EOF else throwError (Exc.ErrorCall "Unexpected EOF while decoding") 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 $ case extra of Right bytes | B.null bytes -> xs Right bytes -> bytes:xs Left (_, bytes) -> bytes: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 n) (B.index bytes (n + 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 (n + 1)) (B.index bytes n) 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 enumerator-0.4.19/lib/Data/Enumerator/List.hs0000644000000000000000000005047711740377455017215 0ustar0000000000000000-- | -- 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 , isolateWhile , 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 (sequence, throwError) import Data.Enumerator.Internal -- | 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) (`loop` 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) >>== (`yield` Chunks s2) loop EOF = k EOF >>== (`yield` EOF) isolate n step = drop n >> return step -- | @'isolateWhile' p@ reads elements from the stream until /p/ is false, and -- passes them to its iteratee. If the iteratee finishes early, elements -- continue to be consumed from the outer stream until /p/ is false. -- -- Since: 0.4.16 isolateWhile :: Monad m => (a -> Bool) -> Enumeratee a a m b isolateWhile p (Continue k) = continue loop where loop (Chunks []) = continue loop loop (Chunks xs) = case Prelude.span p xs of (_, []) -> k (Chunks xs) >>== isolateWhile p (s1, s2) -> k (Chunks s1) >>== (`yield` Chunks s2) loop EOF = k EOF >>== (`yield` EOF) isolateWhile p step = Data.Enumerator.List.dropWhile p >> 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]) enumerator-0.4.19/lib/Data/Enumerator/List.hs-boot0000644000000000000000000000216711740377455020147 0ustar0000000000000000module Data.Enumerator.List where import Data.Enumerator.Internal 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 enumerator-0.4.19/lib/Data/Enumerator/Internal.hs0000644000000000000000000002453411740377455020051 0ustar0000000000000000-- | -- Module: Data.Enumerator.Internal -- Copyright: 2010-2011 John Millikin -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- -- Core enumerator types, and some useful primitives. -- -- Be careful when using the functions defined in this module, as they will -- allow you to create iteratees which violate the monad laws. module Data.Enumerator.Internal ( Stream (..) , Iteratee (..) , Step (..) , Enumerator , Enumeratee -- * Primitives , returnI , continue , yield -- * Operators , (>>==) , (==<<) , ($$) , (>==>) , (<==<) -- * Miscellaneous , enumEOF , checkContinue0 , checkContinue1 , checkDoneEx , checkDone ) 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.Monoid (Monoid, mempty, mappend, mconcat) import Data.Typeable ( Typeable, typeOf , Typeable1, typeOf1 , mkTyConApp, mkTyCon) -- | 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; an iteratee consumes -- chunks of input from a stream until it either yields a value or -- encounters an error. -- -- Compatibility note: @Iteratee@ will become abstract in @enumerator_0.5@. If -- you depend on internal implementation details, please import -- @"Data.Enumerator.Internal"@. -- 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 -- | Enumerators are sources of data, to be consumed by iteratees. -- Enumerators typically read from an external source (parser, handle, -- random generator, etc), then feed chunks into an tteratee until: -- -- * The input source runs out of data. -- -- * The iteratee yields a result value. -- -- * The iteratee throws an exception. -- 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)@. type Enumerator a m b = Step a m b -> Iteratee a m b -- | An enumeratee acts as a stream adapter; place one between an enumerator -- and an iteratee, and it changes the type or contents of the input stream. -- -- Most users will want to combine enumerators, enumeratees, and iteratees -- using the stream combinators @joinI@ and @joinE@, or their operator aliases -- @(=$)@ and @($=)@. These combinators are used to manage how left-over input -- is passed between elements of the data processing pipeline. 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) infixl 1 >>== infixr 1 ==<< infixr 0 $$ infixr 1 >==> infixr 1 <==< -- | The most primitive stream operator. @iter >>== enum@ returns a new -- iteratee which will read from @enum@ before continuing. (>>==) :: 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 is somewhat easier to read when constructing an iteratee from many -- processing stages. You can treat it like @('$')@, and read the data flow -- from left to right. -- -- Since: 0.1.1 ($$) :: Monad m => (Step a m b -> Iteratee a' m b') -> Iteratee a m b -> Iteratee a' m b' ($$) = (==<<) -- | @('>==>') enum1 enum2 step = enum1 step '>>==' enum2@ -- -- The moral equivalent of @('CM.>=>')@ for iteratees. -- -- 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 (>==>) -- | 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) = returnI (Error 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 []) -- | 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 enumerator-0.4.19/lib/Data/Enumerator/Util.hs0000644000000000000000000000177311740377455017212 0ustar0000000000000000{-# 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 enumerator-0.4.19/lib/Data/Enumerator/Binary.hs0000644000000000000000000006500111740377455017513 0ustar0000000000000000-- | -- 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 , isolateWhile , 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.Internal import Data.Enumerator (isEOF, throwError, tryIO) 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]) (`loop` 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) >>== (`yield` toChunks s2) loop EOF = k EOF >>== (`yield` EOF) isolate n step = drop n >> return step -- | @'isolateWhile' p@ reads bytes from the stream until /p/ is false, and -- passes them to its iteratee. If the iteratee finishes early, bytes -- continue to be consumed from the outer stream until /p/ is false. -- -- Since: 0.4.16 isolateWhile :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b isolateWhile p (Continue k) = continue loop where loop (Chunks []) = continue loop loop (Chunks xs) = iter where lazy = BL.fromChunks xs (s1, s2) = BL.span p lazy iter = if BL.null s2 then k (Chunks xs) >>== isolateWhile p else k (toChunks s1) >>== (`yield` toChunks s2) loop EOF = k EOF >>== (`yield` EOF) isolateWhile p step = Data.Enumerator.Binary.dropWhile p >> 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 enumerator-0.4.19/lib/Data/Enumerator/Trans.hs0000644000000000000000000001571711740377455017367 0ustar0000000000000000-- | -- Module: Data.Enumerator.Trans -- Copyright: 2011 Mikhail Vorozhtsov -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- -- This module provides functions for running monad transformers within -- iteratees. Most types defined in the \"transformers\" library are -- supported. -- -- Functions suffixed with an apostrophe (@'@) apply to the strict variant -- of their transformer type. -- -- Since: 0.4.16 module Data.Enumerator.Trans ( -- * IdentityT runIdentityI -- * MaybeT , runMaybeI -- * ErrorT , runErrorI -- * ReaderT , runReaderI -- * StateT -- ** Lazy , runStateI , evalStateI -- ** Strict , runStateI' , evalStateI' -- * WriterT -- ** Lazy , runWriterI , execWriterI -- ** Strict , runWriterI' , execWriterI' -- * RWST -- ** Lazy , runRWSI , evalRWSI , execRWSI -- ** Strict , runRWSI' , evalRWSI' , execRWSI' ) where import Data.Monoid (Monoid(..)) import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Control.Monad.Trans.Error import Control.Monad.Trans.Reader import qualified Control.Monad.Trans.State.Lazy as L import qualified Control.Monad.Trans.State.Strict as S import qualified Control.Monad.Trans.Writer.Lazy as L import qualified Control.Monad.Trans.Writer.Strict as S import qualified Control.Monad.Trans.RWS.Lazy as L import qualified Control.Monad.Trans.RWS.Strict as S import Data.Enumerator (Stream(..), Step(..), Iteratee(..)) -- | Lifted version of 'runIdentityT' -- -- Since: 0.4.16 runIdentityI :: Monad m => Iteratee a (IdentityT m) b -> Iteratee a m b runIdentityI it = Iteratee $ do step <- runIdentityT $ runIteratee it return $ case step of Continue k -> Continue $ runIdentityI . k Yield x cs -> Yield x cs Error e -> Error e -- | Lifted version of 'runMaybeT' -- -- Since: 0.4.16 runMaybeI :: Monad m => Iteratee a (MaybeT m) b -> Iteratee a m (Maybe b) runMaybeI it = Iteratee $ do mStep <- runMaybeT $ runIteratee it return $ case mStep of Nothing -> Yield Nothing $ Chunks [] Just step -> case step of Continue k -> Continue $ runMaybeI . k Yield x cs -> Yield (Just x) cs Error e -> Error e -- | Lifted version of 'runErrorT' -- -- Since: 0.4.16 runErrorI :: (Error e, Monad m) => Iteratee a (ErrorT e m) b -> Iteratee a m (Either e b) runErrorI it = Iteratee $ do mStep <- runErrorT $ runIteratee it return $ case mStep of Left e -> Yield (Left e) $ Chunks [] Right step -> case step of Continue k -> Continue $ runErrorI . k Yield x cs -> Yield (Right x) cs Error e -> Error e -- | Lifted version of 'runReaderT' -- -- Since: 0.4.16 runReaderI :: Monad m => r -> Iteratee a (ReaderT r m) b -> Iteratee a m b runReaderI r it = Iteratee $ do step <- runReaderT (runIteratee it) r return $ case step of Continue k -> Continue $ runReaderI r . k Yield x cs -> Yield x cs Error e -> Error e -- | Lifted version of (lazy) 'L.runStateT' -- -- Since: 0.4.16 runStateI :: Monad m => s -> Iteratee a (L.StateT s m) b -> Iteratee a m (b, s) runStateI s it = Iteratee $ do ~(step, s') <- L.runStateT (runIteratee it) s return $ case step of Continue k -> Continue $ runStateI s' . k Yield x cs -> Yield (x, s') cs Error e -> Error e -- | Lifted version of (lazy) 'L.evalStateT' -- -- Since: 0.4.16 evalStateI :: Monad m => s -> Iteratee a (L.StateT s m) b -> Iteratee a m b evalStateI s = fmap fst . runStateI s -- | Lifted version of (strict) 'S.runStateT' -- -- Since: 0.4.16 runStateI' :: Monad m => s -> Iteratee a (S.StateT s m) b -> Iteratee a m (b, s) runStateI' s it = Iteratee $ do (step, s') <- S.runStateT (runIteratee it) s return $ case step of Continue k -> Continue $ runStateI' s' . k Yield x cs -> Yield (x, s') cs Error e -> Error e -- | Lifted version of (strict) 'S.evalStateT' -- -- Since: 0.4.16 evalStateI' :: Monad m => s -> Iteratee a (S.StateT s m) b -> Iteratee a m b evalStateI' s = fmap fst . runStateI' s -- | Lifted version of (lazy) 'L.runWriterT' -- -- Since: 0.4.16 runWriterI :: (Monoid w, Monad m) => Iteratee a (L.WriterT w m) b -> Iteratee a m (b, w) runWriterI it0 = go mempty it0 where go w it = Iteratee $ do ~(step, w') <- L.runWriterT $ runIteratee it return $ case step of Continue k -> Continue $ go (w `mappend` w') . k Yield x cs -> Yield (x, w `mappend` w') cs Error e -> Error e -- | Lifted version of (lazy) 'L.execWriterT' -- -- Since: 0.4.16 execWriterI :: (Monoid w, Monad m) => Iteratee a (L.WriterT w m) b -> Iteratee a m w execWriterI = fmap snd . runWriterI -- | Lifted version of (strict) 'S.runWriterT' -- -- Since: 0.4.16 runWriterI' :: (Monoid w, Monad m) => Iteratee a (S.WriterT w m) b -> Iteratee a m (b, w) runWriterI' it0 = go mempty it0 where go w it = Iteratee $ do (step, w') <- S.runWriterT $ runIteratee it return $ case step of Continue k -> Continue $ go (w `mappend` w') . k Yield x cs -> Yield (x, w `mappend` w') cs Error e -> Error e -- | Lifted version of (strict) 'L.execWriterT' -- -- Since: 0.4.16 execWriterI' :: (Monoid w, Monad m) => Iteratee a (S.WriterT w m) b -> Iteratee a m w execWriterI' = fmap snd . runWriterI' -- | Lifted version of (lazy) 'L.runRWST' -- -- Since: 0.4.16 runRWSI :: (Monoid w, Monad m) => r -> s -> Iteratee a (L.RWST r w s m) b -> Iteratee a m (b, s, w) runRWSI r s0 it0 = go s0 mempty it0 where go s w it = Iteratee $ do ~(step, s', w') <- L.runRWST (runIteratee it) r s return $ case step of Continue k -> Continue $ go s' (w `mappend` w') . k Yield x cs -> Yield (x, s', w `mappend` w') cs Error e -> Error e -- | Lifted version of (lazy) 'L.evalRWST' -- -- Since: 0.4.16 evalRWSI :: (Monoid w, Monad m) => r -> s -> Iteratee a (L.RWST r w s m) b -> Iteratee a m (b, w) evalRWSI r s = fmap (\(x, _, w) -> (x, w)) . runRWSI r s -- | Lifted version of (lazy) 'L.execRWST' -- -- Since: 0.4.16 execRWSI :: (Monoid w, Monad m) => r -> s -> Iteratee a (L.RWST r w s m) b -> Iteratee a m (s, w) execRWSI r s = fmap (\(_, s', w) -> (s', w)) . runRWSI r s -- | Lifted version of (strict) 'S.runRWST' -- -- Since: 0.4.16 runRWSI' :: (Monoid w, Monad m) => r -> s -> Iteratee a (S.RWST r w s m) b -> Iteratee a m (b, s, w) runRWSI' r s0 it0 = go s0 mempty it0 where go s w it = Iteratee $ do (step, s', w') <- S.runRWST (runIteratee it) r s return $ case step of Continue k -> Continue $ go s' (w `mappend` w') . k Yield x cs -> Yield (x, s', w `mappend` w') cs Error e -> Error e -- | Lifted version of (strict) 'S.evalRWST' -- -- Since: 0.4.16 evalRWSI' :: (Monoid w, Monad m) => r -> s -> Iteratee a (S.RWST r w s m) b -> Iteratee a m (b, w) evalRWSI' r s = fmap (\(x, _, w) -> (x, w)) . runRWSI' r s -- | Lifted version of (strict) 'S.execRWST' -- -- Since: 0.4.16 execRWSI' :: (Monoid w, Monad m) => r -> s -> Iteratee a (S.RWST r w s m) b -> Iteratee a m (s, w) execRWSI' r s = fmap (\(_, s', w) -> (s', w)) . runRWSI' r s enumerator-0.4.19/tests/0000755000000000000000000000000011740377455013333 5ustar0000000000000000enumerator-0.4.19/tests/EnumeratorTests.hs0000644000000000000000000000230211740377455017030 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module Main ( tests , main ) where import Test.Chell (Suite, defaultMain) import EnumeratorTests.Binary (test_Binary) import EnumeratorTests.CatchError (test_CatchError) import EnumeratorTests.Compatibility (test_Compatibility) import EnumeratorTests.Instances (test_Instances) import EnumeratorTests.Join import EnumeratorTests.List (test_List) import EnumeratorTests.Misc import EnumeratorTests.Sequence (test_Sequence) import EnumeratorTests.Stream (test_Stream) import EnumeratorTests.Text (test_Text) import EnumeratorTests.Trans (test_Trans) tests :: [Suite] tests = [ test_Binary , test_CatchError , test_Compatibility , test_ConcatEnums , test_EnumEOF , test_Instances , test_JoinE , test_JoinI , test_JoinOperatorAssociativity , test_Last , test_Length , test_LiftTrans , test_List , test_Peek , test_PrintChunks , test_Sequence , test_Stream , test_Text , test_Trans , test_TryIO ] main :: IO () main = Test.Chell.defaultMain tests enumerator-0.4.19/tests/enumerator-tests.cabal0000644000000000000000000000154111740377455017641 0ustar0000000000000000name: enumerator-tests version: 0 build-type: Simple cabal-version: >= 1.6 data-files: data/ascii-crlf.txt data/ascii-lf.txt data/utf8-crlf.txt data/utf8-lf.txt flag coverage default: False manual: True flag test-io-functions default: True executable enumerator_tests main-is: EnumeratorTests.hs ghc-options: -Wall hs-source-dirs: ../lib,. if flag(coverage) ghc-options: -fhpc if flag(test-io-functions) build-depends: base >= 4.2 && < 5.0 , knob >= 0.1 && < 0.2 if !os(windows) build-depends: silently else build-depends: base >= 4.0 && < 5.0 if os(windows) cpp-options: -DCABAL_OS_WINDOWS build-depends: bytestring , chell >= 0.2 && < 0.3 , chell-quickcheck >= 0.1 && < 0.2 , containers , QuickCheck , split , text , transformers enumerator-0.4.19/tests/data/0000755000000000000000000000000011740377455014244 5ustar0000000000000000enumerator-0.4.19/tests/data/utf8-crlf.txt0000644000000000000000000000015211740377455016615 0ustar0000000000000000hello world 你好世界 مرحبا العالم こんにちは世界 வணக்கம் enumerator-0.4.19/tests/data/ascii-lf.txt0000644000000000000000000000001511740377455016470 0ustar0000000000000000hello world enumerator-0.4.19/tests/data/utf8-lf.txt0000644000000000000000000000014111740377455016266 0ustar0000000000000000hello world 你好世界 مرحبا العالم こんにちは世界 வணக்கம் enumerator-0.4.19/tests/data/ascii-crlf.txt0000644000000000000000000000002011740377455017011 0ustar0000000000000000hello world enumerator-0.4.19/tests/EnumeratorTests/0000755000000000000000000000000011740377455016477 5ustar0000000000000000enumerator-0.4.19/tests/EnumeratorTests/Misc.hs0000644000000000000000000000724611740377455017737 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Misc ( test_ConcatEnums , test_EnumEOF , test_Last , test_Length , test_LiftTrans , test_Peek , test_TryIO , test_PrintChunks ) where import Control.Exception import Control.Monad.Trans.Reader import Control.Monad.IO.Class import Data.Functor.Identity import Test.Chell #ifdef MIN_VERSION_silently import System.IO.Silently (capture) #endif import Data.Enumerator (($$), (<==<)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import EnumeratorTests.Util (equalExc) test_ConcatEnums :: Suite test_ConcatEnums = assertions "concatEnums" $ do let enum = E.concatEnums [ E.enumLists [['A']] , E.enumLists [['B']] , E.enumLists [['C']] ] $expect $ equal ['A', 'B', 'C'] (runIdentity (E.run_ (enum $$ EL.consume))) $expect $ equal ['A', 'B'] (runIdentity (E.run_ (E.enumLists [['B']] <==< E.enumLists [['A']] $$ EL.consume))) test_EnumEOF :: Suite test_EnumEOF = assertions "enumEOF" $ do let iter = E.continue (\_ -> iter) $expect $ throwsEq (ErrorCall "enumEOF: divergent iteratee") (E.runIteratee (E.enumEOF $$ iter)) test_Last :: Suite test_Last = assertions "last" $ do $expect $ equal (Nothing :: Maybe Char, []) (E.runLists_ [[]] $ do x <- E.last extra <- EL.consume return (x, extra)) $expect $ equal (Just 'E', []) (E.runLists_ [['A', 'B'], ['C', 'D'], ['E']] $ do x <- E.last extra <- EL.consume return (x, extra)) test_Length :: Suite test_Length = assertions "length" $ do $expect $ equal 5 (E.runLists_ [['A', 'B'], ['C', 'D'], ['E']] E.length) test_LiftTrans :: Suite test_LiftTrans = assertions "liftTrans" $ do let iter1 :: E.Iteratee Char Identity (Maybe Char) iter1 = EL.head let iter2 :: Bool -> E.Iteratee Char (ReaderT Int Identity) (Maybe Char, [Char]) iter2 bad = do x <- E.liftTrans (if bad then E.throwError (ErrorCall "failed") else iter1) xs <- EL.consume return (x, xs) $expect $ equal (Just 'A', ['B', 'C', 'D', 'E']) (runIdentity (runReaderT (E.run_ (E.enumList 1 ['A'..'E'] $$ iter2 False)) 0)) $expect $ equalExc (ErrorCall "failed") (runIdentity (runReaderT (E.run (E.enumList 1 ['A'..'E'] $$ iter2 True)) 0)) test_Peek :: Suite test_Peek = assertions "peek" $ do $expect $ equal (Nothing :: Maybe Char, []) (E.runLists_ [] $ do x <- E.peek extra <- EL.consume return (x, extra)) $expect $ equal (Just 'A', ['A', 'B', 'C', 'D', 'E']) (E.runLists_ [[], ['A', 'B'], ['C', 'D'], ['E']] $ do x <- E.peek extra <- EL.consume return (x, extra)) $expect $ equal (Just 'A', ['A']) (E.runLists_ [['A']] $ do x <- E.peek extra <- EL.consume return (x, extra)) test_TryIO :: Suite test_TryIO = assertions "tryIO" $ do do res <- E.run (E.tryIO (return 'A')) $expect (right res) let Right res' = res $expect (equal 'A' res') do res <- E.run (E.tryIO (throwIO (ErrorCall "failed"))) $expect (equalExc (ErrorCall "failed") res) test_PrintChunks :: Suite #ifdef MIN_VERSION_silently test_PrintChunks = assertions "printChunks" $ do do (stdout, _) <- liftIO (capture (E.run_ (E.enumLists [[], ['A', 'B'], ['C']] $$ E.printChunks False))) $expect (equal stdout "\"AB\"\n\"C\"\nEOF\n") do (stdout, _) <- liftIO (capture (E.run_ (E.enumLists [[], ['A', 'B'], ['C']] $$ E.printChunks True))) $expect (equal stdout "\"\"\n\"AB\"\n\"C\"\nEOF\n") #else test_PrintChunks = skipIf True (assertions "printChunks" (return ())) #endif enumerator-0.4.19/tests/EnumeratorTests/Compatibility.hs0000644000000000000000000001140411740377455021644 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Compatibility ( test_Compatibility ) where import Data.Functor.Identity (Identity, runIdentity) import Data.Text (Text) import Test.Chell import qualified Data.Enumerator as E import Data.Enumerator (($$), (=$)) import qualified Data.Enumerator.List as EL compatIter :: (Eq a, Show a) => Text -> E.Iteratee Char Identity a -> E.Iteratee Char Identity a -> Suite compatIter name i1 i2 = assertions name $ do let run i = E.runLists_ [[], ['A', 'B'], ['C', 'D'], ['E']] $ do x <- i y <- EL.consume return (x, y) $expect (equal (run i1) (run i2)) compatEnum :: (Eq a, Show a) => Text -> E.Enumerator a Identity [a] -> E.Enumerator a Identity [a] -> Suite compatEnum name e1 e2 = assertions name $ do let run e = runIdentity (E.run_ (e $$ EL.take 10)) $expect (equal (run e1) (run e2)) compatEnee :: (Eq ai, Show ai) => Text -> E.Enumeratee Char ai Identity [ai] -> E.Enumeratee Char ai Identity [ai] -> Suite compatEnee name e1 e2 = assertions name $ do let run e = E.runLists_ [[], ['A', 'B'], ['C', 'D'], ['E']] (e =$ EL.consume) $expect (equal (run e1) (run e2)) $([d||]) test_Compatibility :: Suite test_Compatibility = suite "compatibility" [ test_Head , test_Drop , test_DropWhile , test_Span , test_Break , test_Consume , test_Foldl , test_Foldl' , test_FoldM , test_Iterate , test_IterateM , test_Repeat , test_RepeatM , test_Replicate , test_ReplicateM , test_GenerateM , test_Map , test_MapM , test_ConcatMap , test_ConcatMapM , test_Filter , test_FilterM , test_LiftFoldL , test_LiftFoldL' , test_LiftFoldM , test_LiftI ] test_Head :: Suite test_Head = compatIter "head" E.head EL.head test_Drop :: Suite test_Drop = compatIter "drop" (E.drop 1) (EL.drop 1) test_DropWhile :: Suite test_DropWhile = compatIter "dropWhile" (E.dropWhile (< 'C')) (EL.dropWhile (< 'C')) test_Span :: Suite test_Span = compatIter "span" (E.span (< 'C')) (EL.takeWhile (< 'C')) test_Break :: Suite test_Break = compatIter "break" (E.break (> 'C')) (EL.takeWhile (<= 'C')) test_Consume :: Suite test_Consume = compatIter "consume" E.consume EL.consume test_Foldl :: Suite test_Foldl = compatIter "foldl" (E.foldl (flip (:)) []) (EL.fold (flip (:)) []) test_LiftFoldL :: Suite test_LiftFoldL = compatIter "liftFoldL" (E.liftFoldL (flip (:)) []) (EL.fold (flip (:)) []) test_Foldl' :: Suite test_Foldl' = compatIter "foldl'" (E.foldl' (flip (:)) []) (EL.fold (flip (:)) []) test_LiftFoldL' :: Suite test_LiftFoldL' = compatIter "liftFoldl'" (E.liftFoldL' (flip (:)) []) (EL.fold (flip (:)) []) test_FoldM :: Suite test_FoldM = compatIter "foldM" (E.foldM (\xs x -> return (x:xs)) []) (EL.foldM (\xs x -> return (x:xs)) []) test_LiftFoldM :: Suite test_LiftFoldM = compatIter "liftFoldM" (E.liftFoldM (\xs x -> return (x:xs)) []) (EL.foldM (\xs x -> return (x:xs)) []) test_Iterate :: Suite test_Iterate = compatEnum "iterate" (E.iterate succ 'A') (EL.iterate succ 'A') test_IterateM :: Suite test_IterateM = compatEnum "iterateM" (E.iterateM (return . succ) 'A') (EL.iterateM (return . succ) 'A') test_Repeat :: Suite test_Repeat = compatEnum "repeat" (E.repeat 'A') (EL.repeat 'A') test_RepeatM :: Suite test_RepeatM = compatEnum "repeatM" (E.repeatM (return 'A')) (EL.repeatM (return 'A')) test_Replicate :: Suite test_Replicate = compatEnum "replicate" (E.replicate 5 'A') (EL.replicate 5 'A') test_ReplicateM :: Suite test_ReplicateM = compatEnum "replicateM" (E.replicateM 5 (return 'A')) (EL.replicateM 5 (return 'A')) test_GenerateM :: Suite test_GenerateM = compatEnum "generateM" (E.generateM (return (Just 'A'))) (EL.generateM (return (Just 'A'))) test_Map :: Suite test_Map = compatEnee "map" (E.map succ) (EL.map succ) test_MapM :: Suite test_MapM = compatEnee "mapM" (E.mapM (return . succ)) (EL.mapM (return . succ)) test_ConcatMap :: Suite test_ConcatMap = compatEnee "concatMap" (E.concatMap (\x -> [succ x])) (EL.concatMap (\x -> [succ x])) test_ConcatMapM :: Suite test_ConcatMapM = compatEnee "concatMapM" (E.concatMapM (\x -> return [succ x])) (EL.concatMapM (\x -> return [succ x])) test_Filter :: Suite test_Filter = compatEnee "filter" (E.filter (< 'C')) (EL.filter (< 'C')) test_FilterM :: Suite test_FilterM = compatEnee "filterM" (E.filterM (return . (< 'C'))) (EL.filterM (return . (< 'C'))) test_LiftI :: Suite test_LiftI = compatIter "liftI" (E.liftI (\s -> E.Yield s (E.Chunks []))) (E.continue (\s -> E.yield s (E.Chunks []))) enumerator-0.4.19/tests/EnumeratorTests/CatchError.hs0000644000000000000000000000543411740377455021075 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.CatchError ( test_CatchError ) where import Control.Concurrent import qualified Control.Exception as Exc import Control.Monad.IO.Class (liftIO) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import EnumeratorTests.Util (equalExc, within) test_CatchError :: Suite test_CatchError = suite "catchError" [ test_WithoutContinue , test_NotDivergent , test_Interleaved , test_YieldImmediately , test_HandleError , test_HandleEOF , test_GotStream ] test_WithoutContinue :: Suite test_WithoutContinue = assertions "without-continue" $ do $expect $ equalExc (Exc.ErrorCall "require: Unexpected EOF") (E.runLists [] $ E.catchError (E.throwError (Exc.ErrorCall "error")) (\_ -> EL.require 1)) test_NotDivergent :: Suite test_NotDivergent = assertions "not-divergent" $ do $expect $ equalExc (Exc.ErrorCall "require: Unexpected EOF") (E.runLists [] $ E.catchError (do _ <- EL.head E.throwError (Exc.ErrorCall "error")) (\_ -> EL.require 1)) test_Interleaved :: Suite test_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 _ = return False mvar <- liftIO newEmptyMVar E.run_ (enumMVar mvar $$ E.catchError (iter mvar) onError) test_YieldImmediately :: Suite test_YieldImmediately = assertions "yield-immediately" $ do $expect $ equal 'A' (E.runLists_ [['A']] $ do E.catchError (return 'A') (\_ -> return 'B')) test_HandleError :: Suite test_HandleError = assertions "handle-error" $ do $expect $ equal "error" (E.runLists_ [] $ E.catchError (EL.head >> E.throwError (Exc.ErrorCall "error")) (\err -> return (show err))) $expect $ equal "error" (E.runLists_ [['A']] $ E.catchError (E.throwError (Exc.ErrorCall "error")) (\err -> return (show err))) $expect $ equal "error" (E.runLists_ [['A'], ['B'], ['C']] $ E.catchError (EL.drop 1 >> E.throwError (Exc.ErrorCall "error")) (\err -> return (show err))) test_HandleEOF :: Suite test_HandleEOF = assertions "handle-eof" $ do $expect $ equal (Nothing, Nothing) (E.runLists_ [] $ do x <- E.catchError EL.head (\_ -> return (Just 'B')) y <- EL.head return (x, y)) test_GotStream :: Suite test_GotStream = assertions "got-stream" $ do $expect $ equal (Just 'B') (E.runLists_ [['A'], ['B'], ['C']] $ E.catchError (do _ <- EL.head _ <- EL.head E.throwError (Exc.ErrorCall "error")) (\_ -> EL.head)) enumerator-0.4.19/tests/EnumeratorTests/Text.hs0000644000000000000000000000276411740377455017770 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text ( test_Text ) where import Test.Chell import EnumeratorTests.Text.Codecs import EnumeratorTests.Text.Consume import EnumeratorTests.Text.Drop import EnumeratorTests.Text.Fold import EnumeratorTests.Text.Handle import EnumeratorTests.Text.Isolate import EnumeratorTests.Text.Iterate import EnumeratorTests.Text.Map import EnumeratorTests.Text.Repeat import EnumeratorTests.Text.Replicate import EnumeratorTests.Text.Require import EnumeratorTests.Text.Split import EnumeratorTests.Text.Unfold import EnumeratorTests.Text.Zip test_Text :: Suite test_Text = suite "text" [ test_TextCodecs , test_Consume , test_ConcatMap , test_ConcatMapM , test_ConcatMapAccum , test_ConcatMapAccumM , test_Drop , test_DropWhile , test_EnumFile , test_EnumHandle , test_Filter , test_FilterM , test_Fold , test_FoldM , test_GenerateM , test_Head , test_Head_ , test_Isolate , test_IsolateWhile , test_Iterate , test_IterateM , test_IterHandle , test_Lines , test_Map , test_MapM , test_MapM_ , test_MapAccum , test_MapAccumM , test_Repeat , test_RepeatM , test_Replicate , test_ReplicateM , test_Require , test_SplitWhen , test_Take , test_TakeWhile , test_Unfold , test_UnfoldM , test_Zip ] enumerator-0.4.19/tests/EnumeratorTests/List.hs0000644000000000000000000000257611740377455017760 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List ( test_List ) where import Test.Chell import EnumeratorTests.List.Consume import EnumeratorTests.List.Drop import EnumeratorTests.List.Fold import EnumeratorTests.List.Isolate import EnumeratorTests.List.Iterate import EnumeratorTests.List.Map import EnumeratorTests.List.Repeat import EnumeratorTests.List.Replicate import EnumeratorTests.List.Require import EnumeratorTests.List.Split import EnumeratorTests.List.Unfold import EnumeratorTests.List.Unique import EnumeratorTests.List.Zip test_List :: Suite test_List = suite "list" [ test_Consume , test_ConcatMap , test_ConcatMapM , test_ConcatMapAccum , test_ConcatMapAccumM , test_Drop , test_DropWhile , test_Fold , test_FoldM , test_Filter , test_FilterM , test_GenerateM , test_Head , test_Head_ , test_Isolate , test_IsolateWhile , test_Iterate , test_IterateM , test_Map , test_MapM , test_MapM_ , test_MapAccum , test_MapAccumM , test_Repeat , test_RepeatM , test_Replicate , test_ReplicateM , test_Require , test_SplitWhen , test_Take , test_TakeWhile , test_Unfold , test_UnfoldM , test_Unique , test_Zip ] enumerator-0.4.19/tests/EnumeratorTests/Sequence.hs0000644000000000000000000000147711740377455020614 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Sequence ( test_Sequence ) where import Data.Functor.Identity (Identity, runIdentity) import Test.Chell import Test.Chell.QuickCheck import Test.QuickCheck hiding (property) import Test.QuickCheck.Poly (A) import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL 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) enumerator-0.4.19/tests/EnumeratorTests/Util.hs0000644000000000000000000001060711740377455017754 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Util ( check , equalExc , todo , within , genASCII , genISO8859_1 , genUnicode ) where import qualified Control.Exception as Exc import Data.Bits ((.&.)) import qualified Data.ByteString as B import Data.Char (chr) import Data.Functor.Identity (Identity, runIdentity) import Data.String (IsString, fromString) import qualified Data.Text as T import System.Timeout (timeout) import Test.Chell import Test.QuickCheck hiding ((.&.), within) import Data.Enumerator (($$)) import qualified Data.Enumerator as E check :: Eq b => E.Iteratee a Identity b -> ([a] -> Either Exc.ErrorCall b) -> [a] -> Bool check iter plain xs = expected == run where expected = case plain xs of Left exc -> Left (Just exc) Right x -> Right x run = case runIdentity (E.run (E.enumList 1 xs $$ iter)) of Left exc -> Left (Exc.fromException exc) Right x -> Right x todo :: T.Text -> Suite todo name = skipIf True (assertions name (return ())) 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_1 :: IsString a => Gen a genISO8859_1 = 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 -> Suite -> Suite within time s = suite (suiteName s) (map wrapTest (suiteTests s)) where wrapTest (Test name io) = test $ 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"))) equalExc :: (Eq exc, Exc.Exception exc) => exc -> Either Exc.SomeException a -> Assertion equalExc expected funResult = Assertion (return result) where failed :: String -> AssertionResult failed str = AssertionFailed (T.pack ("equalExc: " ++ show str)) result = case funResult of Right _ -> failed "received Right" Left exc -> case Exc.fromException exc of Nothing -> failed ("received unexpected exception: " ++ show exc) Just exc' -> if expected == exc' then AssertionPassed else failed (show expected ++ " /= " ++ show exc') enumerator-0.4.19/tests/EnumeratorTests/Join.hs0000644000000000000000000000522311740377455017734 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Join ( test_JoinE , test_JoinI , test_JoinOperatorAssociativity ) where import Control.Exception import Data.Char (toLower) import Data.Functor.Identity (Identity, runIdentity) import Test.Chell import Data.Enumerator (($$), ($=), (=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import EnumeratorTests.Util (equalExc) test_JoinE :: Suite test_JoinE = suite "joinE" [ test_JoinE_Success , test_JoinE_Error , test_JoinE_Divergent ] test_JoinE_Success :: Suite test_JoinE_Success = assertions "success" $ do let enum :: Monad m => E.Enumerator Char m b enum = E.joinE (E.enumLists [['A', 'B', 'C']]) (EL.map toLower) $expect $ equal ['a', 'b', 'c'] (runIdentity (E.run_ (enum $$ EL.consume))) test_JoinE_Error :: Suite test_JoinE_Error = assertions "error" $ do let enum :: Monad m => E.Enumerator Char m b enum = E.joinE (E.enumLists [['A', 'B', 'C']]) (E.sequence (E.throwError (ErrorCall "foo"))) $expect $ equalExc (ErrorCall "foo") (runIdentity (E.run (enum $$ EL.consume))) test_JoinE_Divergent :: Suite test_JoinE_Divergent = assertions "divergent" $ do let enum :: Monad m => E.Enumerator Char m b enum = E.joinE (E.enumLists [['A', 'B', 'C']]) (EL.map toLower) let diverg :: Monad m => E.Iteratee a m b diverg = E.continue (\_ -> diverg) $expect $ throwsEq (ErrorCall "enumEOF: divergent iteratee") (E.run_ (enum $$ diverg)) test_JoinI :: Suite test_JoinI = assertions "joinI" $ do let enum :: Monad m => E.Enumerator Char m b enum = E.enumLists [['A', 'B', 'C']] let diverg :: Monad m => E.Iteratee a m b diverg = E.continue (\_ -> diverg) $expect $ equal ['a', 'b', 'c'] (runIdentity (E.run_ (enum $$ E.joinI (EL.map toLower $$ EL.consume)))) $expect $ equalExc (ErrorCall "foo") (runIdentity (E.run (enum $$ E.joinI (EL.map toLower $$ E.throwError (ErrorCall "foo"))))) $expect $ throwsEq (ErrorCall "joinI: divergent iteratee") (E.run_ (enum $$ E.joinI (EL.map toLower $$ diverg))) test_JoinOperatorAssociativity :: Suite test_JoinOperatorAssociativity = assertions "join-operator-associativity" $ do let xs = ['A', 'B', 'C'] let enum = E.enumList 1 xs let enee = EL.map id let iter = EL.consume xs1 <- E.run_ $ enum $$ enee =$ enee =$ iter xs2 <- E.run_ $ enum $= enee $$ enee =$ iter xs3 <- E.run_ $ enum $= enee $= enee $$ iter $expect (equal xs xs1) $expect (equal xs xs2) $expect (equal xs xs3) return () enumerator-0.4.19/tests/EnumeratorTests/Binary.hs0000644000000000000000000000272111740377455020261 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary ( test_Binary ) where import Test.Chell import EnumeratorTests.Binary.Consume import EnumeratorTests.Binary.Drop import EnumeratorTests.Binary.Fold import EnumeratorTests.Binary.Handle import EnumeratorTests.Binary.Isolate import EnumeratorTests.Binary.Iterate import EnumeratorTests.Binary.Map import EnumeratorTests.Binary.Repeat import EnumeratorTests.Binary.Replicate import EnumeratorTests.Binary.Require import EnumeratorTests.Binary.Split import EnumeratorTests.Binary.Unfold import EnumeratorTests.Binary.Zip test_Binary :: Suite test_Binary = suite "binary" [ test_Consume , test_ConcatMap , test_ConcatMapM , test_ConcatMapAccum , test_ConcatMapAccumM , test_Drop , test_DropWhile , test_EnumHandle , test_EnumHandleRange , test_Filter , test_FilterM , test_Fold , test_FoldM , test_GenerateM , test_Head , test_Head_ , test_Isolate , test_IsolateWhile , test_Iterate , test_IterateM , test_IterHandle , test_Map , test_MapM , test_MapM_ , test_MapAccum , test_MapAccumM , test_Repeat , test_RepeatM , test_Replicate , test_ReplicateM , test_Require , test_SplitWhen , test_Take , test_TakeWhile , test_Unfold , test_UnfoldM , test_Zip ] enumerator-0.4.19/tests/EnumeratorTests/Instances.hs0000644000000000000000000000307011740377455020762 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Instances ( test_Instances ) where import Control.Applicative (pure, (<*>)) import Data.Functor.Identity (runIdentity) import Data.Typeable (typeOf) import Test.Chell import Data.Enumerator test_Instances :: Suite test_Instances = suite "instances" [ test_Typeable , test_Functor , test_Applicative ] test_Typeable :: Suite test_Typeable = suite "typeable" [ test_TypeableStream , test_TypeableIteratee , test_TypeableStep ] test_TypeableStream :: Suite test_TypeableStream = assertions "stream" $ do let x = undefined :: Stream Char $expect $ equal "Data.Enumerator.Stream Char" (show (typeOf x)) test_TypeableIteratee :: Suite test_TypeableIteratee = assertions "iteratee" $ do let x = undefined :: Iteratee Char Maybe Int $expect $ equal "Data.Enumerator.Iteratee Char Maybe Int" (show (typeOf x)) test_TypeableStep :: Suite test_TypeableStep = assertions "step" $ do let x = undefined :: Step Char Maybe Int $expect $ equal "Data.Enumerator.Step Char Maybe Int" (show (typeOf x)) test_Functor :: Suite test_Functor = assertions "functor" $ do $expect $ equal 'B' (runIdentity (run_ (fmap succ (return 'A')))) test_Applicative :: Suite test_Applicative = assertions "applicative" $ do $expect $ equal 'A' (runIdentity (run_ (pure 'A'))) $expect $ equal 'B' (runIdentity (run_ (pure succ <*> pure 'A'))) enumerator-0.4.19/tests/EnumeratorTests/Stream.hs0000644000000000000000000000450011740377455020265 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010-2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Stream ( test_Stream ) where import Control.Applicative (pure, (<*>)) import Data.Monoid (mappend, mempty, mconcat) import Test.Chell import Test.Chell.QuickCheck import Test.QuickCheck hiding (property) import Test.QuickCheck.Poly (A, B, C) import qualified Data.Enumerator as E import EnumeratorTests.Util () test_Stream :: Suite test_Stream = suite "stream" [ test_Monoid , test_Functor , test_Monad , test_Applicative ] test_Monoid :: Suite test_Monoid = suite "monoid" [ property "law-1" prop_MonoidLaw1 , property "law-2" prop_MonoidLaw2 , property "law-3" prop_MonoidLaw3 , property "law-4" prop_MonoidLaw4 ] prop_MonoidLaw1 :: E.Stream A -> Bool prop_MonoidLaw1 x = mappend mempty x == x prop_MonoidLaw2 :: E.Stream A -> Bool prop_MonoidLaw2 x = mappend x mempty == x prop_MonoidLaw3 :: E.Stream A -> E.Stream A -> E.Stream A -> Bool prop_MonoidLaw3 x y z = mappend x (mappend y z) == mappend (mappend x y) z prop_MonoidLaw4 :: [E.Stream A] -> Bool prop_MonoidLaw4 xs = mconcat xs == foldr mappend mempty xs test_Functor :: Suite test_Functor = suite "functor" [ property "law-1" prop_FunctorLaw1 , property "law-2" prop_FunctorLaw2 ] prop_FunctorLaw1 :: E.Stream A -> Bool prop_FunctorLaw1 x = fmap id x == id x prop_FunctorLaw2 :: E.Stream A -> Blind (B -> C) -> Blind (A -> B) -> Bool prop_FunctorLaw2 x (Blind f) (Blind g) = fmap (f . g) x == (fmap f . fmap g) x test_Monad :: Suite test_Monad = suite "monad" [ property "law-1" prop_MonadLaw1 , property "law-2" prop_MonadLaw2 , property "law-3" prop_MonadLaw3 ] prop_MonadLaw1 :: A -> Blind (A -> E.Stream B) -> Bool prop_MonadLaw1 a (Blind f) = (return a >>= f) == f a prop_MonadLaw2 :: E.Stream A -> Bool prop_MonadLaw2 m = (m >>= return) == m prop_MonadLaw3 :: E.Stream A -> Blind (A -> E.Stream B) -> Blind (B -> E.Stream C) -> Bool prop_MonadLaw3 m (Blind f) (Blind g) = ((m >>= f) >>= g) == (m >>= (\x -> f x >>= g)) test_Applicative :: Suite test_Applicative = assertions "applicative" $ do $expect (equal (E.Chunks ['A']) (pure 'A')) $expect (equal (E.Chunks ['B']) (pure succ <*> E.Chunks ['A'])) enumerator-0.4.19/tests/EnumeratorTests/Trans.hs0000644000000000000000000002274511740377455020134 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Trans ( test_Trans ) where import Control.Exception import Control.Monad (mzero) import Control.Monad.Trans.Class (lift) import qualified Control.Monad.Trans.Error as ErrorT import qualified Control.Monad.Trans.Reader as ReaderT import qualified Control.Monad.Trans.State.Lazy as StateT_L import qualified Control.Monad.Trans.State.Strict as StateT_S import qualified Control.Monad.Trans.Writer.Lazy as WriterT_L import qualified Control.Monad.Trans.Writer.Strict as WriterT_S import qualified Control.Monad.Trans.RWS.Lazy as RWST_L import qualified Control.Monad.Trans.RWS.Strict as RWST_S import Test.Chell import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Trans as ET import EnumeratorTests.Util (equalExc) test_Trans :: Suite test_Trans = suite "transformers" [ test_RunIdentityI , test_RunMaybeI , test_RunErrorI , test_RunReaderI , test_RunStateI , test_EvalStateI , test_RunWriterI , test_ExecWriterI , test_RunRWSI , test_EvalRWSI , test_ExecRWSI ] test_RunIdentityI :: Suite test_RunIdentityI = assertions "runIdentityI" $ do $expect $ equal (['a'], ['b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.runIdentityI (EL.take 1) extra <- EL.consume return (x, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runIdentityI (E.throwError (ErrorCall "err"))) test_RunMaybeI :: Suite test_RunMaybeI = assertions "runMaybeI" $ do $expect $ equal (Just ['a'], ['b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.runMaybeI (EL.take 1) extra <- EL.consume return (x, extra)) $expect $ equal (Nothing :: Maybe [Char], ['a', 'b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.runMaybeI (lift mzero) extra <- EL.consume return (x, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runMaybeI (E.throwError (ErrorCall "err"))) test_RunErrorI :: Suite test_RunErrorI = assertions "runErrorI" $ do $expect $ equal (Right ['a'] :: Either String [Char], ['b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.runErrorI (EL.take 1) extra <- EL.consume return (x, extra)) $expect $ equal (Left "err" :: Either String [Char], ['a', 'b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.runErrorI (lift (ErrorT.throwError "err")) extra <- EL.consume return (x, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runErrorI $ do _ <- E.throwError (ErrorCall "err") lift (ErrorT.throwError ("err2" :: String))) test_RunReaderI :: Suite test_RunReaderI = assertions "runReaderI" $ do $expect $ equal ((['a'], 'A'), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.runReaderI 'A' $ do x <- EL.take 1 y <- lift ReaderT.ask return (x, y) extra <- EL.consume return (xy, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runReaderI 'A' (E.throwError (ErrorCall "err"))) test_RunStateI :: Suite test_RunStateI = suite "runStateI" [ test_RunStateI_Lazy , test_RunStateI_Strict ] test_RunStateI_Lazy :: Suite test_RunStateI_Lazy = assertions "lazy" $ do $expect $ equal (((['a'], 'A'), 'B'), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.runStateI 'A' $ do x <- EL.take 1 y <- lift StateT_L.get lift (StateT_L.put 'B') return (x, y) extra <- EL.consume return (xy, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runStateI 'A' (E.throwError (ErrorCall "err"))) test_RunStateI_Strict :: Suite test_RunStateI_Strict = assertions "strict" $ do $expect $ equal (((['a'], 'A'), 'B'), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.runStateI' 'A' $ do x <- EL.take 1 y <- lift StateT_S.get lift (StateT_S.put 'B') return (x, y) extra <- EL.consume return (xy, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runStateI' 'A' (E.throwError (ErrorCall "err"))) test_EvalStateI :: Suite test_EvalStateI = suite "evalStateI" [ test_EvalStateI_Lazy , test_EvalStateI_Strict ] test_EvalStateI_Lazy :: Suite test_EvalStateI_Lazy = assertions "lazy" $ do $expect $ equal ((['a'], 'A'), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.evalStateI 'A' $ do x <- EL.take 1 y <- lift StateT_L.get lift (StateT_L.put 'B') return (x, y) extra <- EL.consume return (xy, extra)) test_EvalStateI_Strict :: Suite test_EvalStateI_Strict = assertions "strict" $ do $expect $ equal ((['a'], 'A'), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.evalStateI' 'A' $ do x <- EL.take 1 y <- lift StateT_S.get lift (StateT_S.put 'B') return (x, y) extra <- EL.consume return (xy, extra)) test_RunWriterI :: Suite test_RunWriterI = suite "runWriterI" [ test_RunWriterI_Lazy , test_RunWriterI_Strict ] test_RunWriterI_Lazy :: Suite test_RunWriterI_Lazy = assertions "lazy" $ do $expect $ equal ((['a'], ['A', 'B']), ['b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.runWriterI $ do lift (WriterT_L.tell ['A']) x <- EL.take 1 lift (WriterT_L.tell ['B']) return x extra <- EL.consume return (x, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runWriterI $ do _ <- E.throwError (ErrorCall "err") lift (WriterT_L.tell ['A'])) test_RunWriterI_Strict :: Suite test_RunWriterI_Strict = assertions "strict" $ do $expect $ equal ((['a'], ['A', 'B']), ['b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.runWriterI' $ do lift (WriterT_S.tell ['A']) x <- EL.take 1 lift (WriterT_S.tell ['B']) return x extra <- EL.consume return (x, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runWriterI' $ do _ <- E.throwError (ErrorCall "err") lift (WriterT_S.tell ['A'])) test_ExecWriterI :: Suite test_ExecWriterI = suite "execWriterI" [ test_ExecWriterI_Lazy , test_ExecWriterI_Strict ] test_ExecWriterI_Lazy :: Suite test_ExecWriterI_Lazy = assertions "lazy" $ do $expect $ equal (['A', 'B'], ['b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.execWriterI $ do lift (WriterT_L.tell ['A']) x <- EL.take 1 lift (WriterT_L.tell ['B']) return x extra <- EL.consume return (x, extra)) test_ExecWriterI_Strict :: Suite test_ExecWriterI_Strict = assertions "strict" $ do $expect $ equal (['A', 'B'], ['b']) (E.runLists_ [['a'], ['b']] $ do x <- ET.execWriterI' $ do lift (WriterT_S.tell ['A']) x <- EL.take 1 lift (WriterT_S.tell ['B']) return x extra <- EL.consume return (x, extra)) test_RunRWSI :: Suite test_RunRWSI = suite "runRWSI" [ test_RunRWSI_Lazy , test_RunRWSI_Strict ] test_RunRWSI_Lazy :: Suite test_RunRWSI_Lazy = assertions "lazy" $ do $expect $ equal (((['a'], 'A'), 'B', ['Y', 'Z']), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.runRWSI 'A' 'A' $ do lift (RWST_L.tell ['Y']) x <- EL.take 1 y <- lift RWST_L.ask lift (RWST_L.modify succ) lift (RWST_L.tell ['Z']) return (x, y) extra <- EL.consume return (xy, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runRWSI 'A' 'A' $ do _ <- E.throwError (ErrorCall "err") lift (RWST_L.tell ['Y'])) test_RunRWSI_Strict :: Suite test_RunRWSI_Strict = assertions "strict" $ do $expect $ equal (((['a'], 'A'), 'B', ['Y', 'Z']), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.runRWSI' 'A' 'A' $ do lift (RWST_S.tell ['Y']) x <- EL.take 1 y <- lift RWST_S.ask lift (RWST_S.modify succ) lift (RWST_S.tell ['Z']) return (x, y) extra <- EL.consume return (xy, extra)) $expect $ equalExc (ErrorCall "err") (E.runLists [] $ ET.runRWSI' 'A' 'A' $ do _ <- E.throwError (ErrorCall "err") lift (RWST_S.tell ['Y'])) test_EvalRWSI :: Suite test_EvalRWSI = suite "evalRWSI" [ test_EvalRWSI_Lazy , test_EvalRWSI_Strict ] test_EvalRWSI_Lazy :: Suite test_EvalRWSI_Lazy = assertions "lazy" $ do $expect $ equal (((['a'], 'A'), ['Y', 'Z']), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.evalRWSI 'A' 'Z' $ do lift (RWST_L.tell ['Y']) x <- EL.take 1 y <- lift RWST_L.ask z <- lift RWST_L.get lift (RWST_L.tell [z]) return (x, y) extra <- EL.consume return (xy, extra)) test_EvalRWSI_Strict :: Suite test_EvalRWSI_Strict = assertions "strict" $ do $expect $ equal (((['a'], 'A'), ['Y', 'Z']), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.evalRWSI' 'A' 'Z' $ do lift (RWST_S.tell ['Y']) x <- EL.take 1 y <- lift RWST_S.ask z <- lift RWST_S.get lift (RWST_S.tell [z]) return (x, y) extra <- EL.consume return (xy, extra)) test_ExecRWSI :: Suite test_ExecRWSI = suite "execRWSI" [ test_ExecRWSI_Lazy , test_ExecRWSI_Strict ] test_ExecRWSI_Lazy :: Suite test_ExecRWSI_Lazy = assertions "lazy" $ do $expect $ equal (('B', ['Y', 'Z']), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.execRWSI 'Z' 'A' $ do lift (RWST_L.tell ['Y']) x <- EL.take 1 y <- lift RWST_L.ask lift (RWST_L.modify succ) lift (RWST_L.tell [y]) return (x, y) extra <- EL.consume return (xy, extra)) test_ExecRWSI_Strict :: Suite test_ExecRWSI_Strict = assertions "strict" $ do $expect $ equal (('B', ['Y', 'Z']), ['b']) (E.runLists_ [['a'], ['b']] $ do xy <- ET.execRWSI' 'Z' 'A' $ do lift (RWST_S.tell ['Y']) x <- EL.take 1 y <- lift RWST_S.ask lift (RWST_S.modify succ) lift (RWST_S.tell [y]) return (x, y) extra <- EL.consume return (xy, extra)) enumerator-0.4.19/tests/EnumeratorTests/Text/0000755000000000000000000000000011740377455017423 5ustar0000000000000000enumerator-0.4.19/tests/EnumeratorTests/Text/Repeat.hs0000644000000000000000000000223511740377455021201 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Repeat ( test_Repeat , test_RepeatM , test_GenerateM ) where import Control.Monad.Trans.State import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET test_Repeat :: Suite test_Repeat = assertions "repeat" $ do $expect $ equal ["A", "A", "A"] (runIdentity (E.run_ (ET.repeat 'A' $$ EL.take 3))) test_RepeatM :: Suite test_RepeatM = assertions "repeatM" $ do let step = do c <- get put (succ c) return c $expect $ equal ["A", "B", "C"] (evalState (E.run_ (ET.repeatM step $$ EL.take 3)) 'A') test_GenerateM :: Suite test_GenerateM = assertions "generateM" $ do let step = do c <- get if c > 'C' then return Nothing else do put (succ c) return (Just c) $expect $ equal ["A", "B", "C"] (evalState (E.run_ (ET.generateM step $$ EL.consume)) 'A') enumerator-0.4.19/tests/EnumeratorTests/Text/Consume.hs0000644000000000000000000000452211740377455021373 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Consume ( test_Consume , test_Head , test_Head_ , test_Take , test_TakeWhile ) where import Control.Exception import Test.Chell import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET import EnumeratorTests.Util (equalExc) test_Consume :: Suite test_Consume = assertions "consume" $ do $expect $ equal ("ABC", Nothing) (E.runLists_ [[], ["A", "B"], ["C"]] $ do xs <- ET.consume h <- EL.head return (xs, h)) test_Head :: Suite test_Head = assertions "head" $ do $expect $ equal (Just 'A', ["BC", "DE"]) (E.runLists_ [[], ["ABC", "DE"]] $ do x <- ET.head extra <- EL.consume return (x, extra)) $expect $ equal (Nothing :: Maybe Char, []) (E.runLists_ [] $ do x <- ET.head extra <- EL.consume return (x, extra)) test_Head_ :: Suite test_Head_ = assertions "head_" $ do $expect $ equal ('A', ["BC", "DE"]) (E.runLists_ [["ABC"], ["DE"]] $ do x <- ET.head_ extra <- EL.consume return (x, extra)) $expect $ equalExc (ErrorCall "head_: stream has ended") (E.runLists [] $ do x <- ET.head_ extra <- EL.consume return (x, extra)) test_Take :: Suite test_Take = assertions "take" $ do $expect $ equal ("ABC", ["D", "E"]) (E.runLists_ [["A", "B"], ["C", "D"], ["E"]] $ do x <- ET.take 3 extra <- EL.consume return (x, extra)) $expect $ equal ("AB", []) (E.runLists_ [["A"], ["B"]] $ do x <- ET.take 3 extra <- EL.consume return (x, extra)) $expect $ equal ("", ["A", "B"]) (E.runLists_ [["A"], ["B"]] $ do x <- ET.take 0 extra <- EL.consume return (x, extra)) test_TakeWhile :: Suite test_TakeWhile = assertions "takeWhile" $ do $expect $ equal ("ABC", ["D", "E"]) (E.runLists_ [[], ["A", "B"], ["C", "D"], ["E"]] $ do x <- ET.takeWhile (< 'D') extra <- EL.consume return (x, extra)) $expect $ equal ("AB", []) (E.runLists_ [["A"], ["B"]] $ do x <- ET.takeWhile (< 'D') extra <- EL.consume return (x, extra)) $expect $ equal ("", ["A", "B"]) (E.runLists_ [["A"], ["B"]] $ do x <- ET.takeWhile (< 'A') extra <- EL.consume return (x, extra)) enumerator-0.4.19/tests/EnumeratorTests/Text/Split.hs0000644000000000000000000000311211740377455021047 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Split ( test_SplitWhen , test_Lines ) where import qualified Data.List.Split as LS import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Test.Chell import Test.Chell.QuickCheck import Data.Enumerator ((=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET import EnumeratorTests.Text.Util test_SplitWhen :: Suite test_SplitWhen = suite "splitWhen" [ prop_SplitWhen , test_HandleEmpty ] prop_SplitWhen :: Suite prop_SplitWhen = property "model" $ prop_TextX (\c -> do xs <- 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), [])) test_HandleEmpty :: Suite test_HandleEmpty = assertions "empty" $ do $expect $ equal ([], Nothing) (E.runLists_ [[""]] $ do xs <- ET.splitWhen (== ',') =$ EL.consume extra <- EL.head return (xs, extra)) test_Lines :: Suite test_Lines = assertions "lines" $ do $expect $ equal ["abc", "def"] (E.runLists_ [["abc\ndef"]] (ET.lines =$ EL.consume)) $expect $ equal ["abc", "def"] (E.runLists_ [["abc\ndef\n"]] (ET.lines =$ EL.consume)) $expect $ equal ["abc", "def", ""] (E.runLists_ [["abc\ndef\n\n"]] (ET.lines =$ EL.consume)) enumerator-0.4.19/tests/EnumeratorTests/Text/Unfold.hs0000644000000000000000000000165211740377455021212 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Unfold ( test_Unfold , test_UnfoldM ) where import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET test_Unfold :: Suite test_Unfold = assertions "unfold" $ do let step x = if x > 'C' then Nothing else Just (x, succ x) $expect $ equal ["A", "B", "C"] (runIdentity (E.run_ (ET.unfold step 'A' $$ EL.consume))) test_UnfoldM :: Suite test_UnfoldM = assertions "unfoldM" $ do let step x = return $ if x > 'C' then Nothing else Just (x, succ x) $expect $ equal ["A", "B", "C"] (runIdentity (E.run_ (ET.unfoldM step 'A' $$ EL.consume))) enumerator-0.4.19/tests/EnumeratorTests/Text/Fold.hs0000644000000000000000000000230311740377455020641 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Fold ( test_Fold , test_FoldM ) where import Control.Monad (foldM) import Data.Functor.Identity (runIdentity) import qualified Data.Text import Data.Text (Text) import Test.Chell import Test.Chell.QuickCheck import Test.QuickCheck.Poly import Test.QuickCheck.Modifiers import qualified Data.Enumerator as E import qualified Data.Enumerator.Text as ET import EnumeratorTests.Util () test_Fold :: Suite test_Fold = property "fold" prop_Fold prop_Fold :: Blind (B -> Char -> B) -> B -> Text -> Bool prop_Fold (Blind f) z text = result == expected where result = E.runLists_ [[text]] (ET.fold f z) expected = Data.Text.foldl' f z text test_FoldM :: Suite test_FoldM = property "foldM" prop_FoldM prop_FoldM :: Blind (B -> Char -> B) -> B -> Text -> Bool prop_FoldM (Blind f) z text = result == expected where result = E.runLists_ [[text]] (ET.foldM f' z) expected = runIdentity (foldM f' z (Data.Text.unpack text)) f' b a = return (f b a) enumerator-0.4.19/tests/EnumeratorTests/Text/Codecs.hs0000644000000000000000000002362211740377455021164 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Codecs ( test_TextCodecs ) where import Prelude hiding (words) import Control.Exception (ErrorCall(..)) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import Data.Char (ord) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE import Test.Chell import Test.Chell.QuickCheck import Test.QuickCheck hiding (property) 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 EnumeratorTests.Util test_TextCodecs :: Suite test_TextCodecs = suite "codecs" [ test_ASCII , test_ISO8859_1 , test_UTF8 , test_UTF16_BE , test_UTF16_LE , test_UTF32_BE , test_UTF32_LE ] test_ASCII :: Suite test_ASCII = suite "ascii" [ property "encode" (forAll genASCII (prop_Encode ET.ascii encodeASCII)) , property "decode" (forAll genASCII (prop_Decode ET.ascii decodeASCII)) , assertions "show" $ do $expect $ equal "Codec \"ASCII\"" (show ET.ascii) , assertions "encode-invalid" $ do $expect $ equalExc (ErrorCall "Codec \"ASCII\" can't encode character U+00FF") (E.runLists [["\xFF"]] (ET.encode ET.ascii =$ EB.consume)) , assertions "decode-invalid" $ do $expect $ equalExc (ErrorCall "Codec \"ASCII\" can't decode byte 0xFF") (E.runLists [["\xFF"]] (ET.decode ET.ascii =$ ET.consume)) , skipIf True $ assertions "lazy.broken" $ do $expect $ equal (Just 0x61, ["b"]) (E.runLists_ [["", "ab"]] (do x <- ET.encode ET.ascii =$ EB.head y <- EL.consume return (x, y))) , assertions "lazy" $ do $expect $ equal (Just 0x61, ["b"]) (E.runLists_ [[""], ["a"], ["b"]] $ do x <- ET.encode ET.ascii =$ EB.head y <- EL.consume return (x, y)) $expect $ equal (Just 0x61, ["\xFF"]) (E.runLists_ [[""], ["a\xFF"]] $ do x <- ET.encode ET.ascii =$ EB.head y <- EL.consume return (x, y)) $expect $ equal (Just 'a', ["b"]) (E.runLists_ [[""], ["a"], ["b"]] $ do x <- ET.decode ET.ascii =$ ET.head y <- EL.consume return (x, y)) $expect $ equal (Just 'a', ["\xFF"]) (E.runLists_ [[""], ["a\xFF"]] $ do x <- ET.decode ET.ascii =$ ET.head y <- EL.consume return (x, y)) ] encodeASCII :: T.Text -> B.ByteString encodeASCII text = if T.any (\c -> ord c > 127) text then error "encodeASCII: input contains non-ASCII characters." else B8.pack (T.unpack text) decodeASCII :: B.ByteString -> T.Text decodeASCII bytes = if B.any (> 127) bytes then error "decodeASCII: input contains non-ASCII characters." else T.pack (B8.unpack bytes) test_ISO8859_1 :: Suite test_ISO8859_1 = suite "iso8859-1" [ property "encode" (forAll genISO8859_1 (prop_Encode ET.iso8859_1 encodeISO8859_1)) , property "decode" (forAll genISO8859_1 (prop_Decode ET.iso8859_1 decodeISO8859_1)) , assertions "show" $ do $expect $ equal "Codec \"ISO-8859-1\"" (show ET.iso8859_1) , assertions "encode-invalid" $ do $expect $ equalExc (ErrorCall "Codec \"ISO-8859-1\" can't encode character U+01FF") (E.runLists [["\x1FF"]] (ET.encode ET.iso8859_1 =$ EB.consume)) , assertions "lazy" $ do $expect $ equal (Just 0x61, ["b"]) (E.runLists_ [[""], ["a"], ["b"]] $ do x <- ET.encode ET.iso8859_1 =$ EB.head y <- EL.consume return (x, y)) $expect $ equal (Just 0x61, ["\x1FF"]) (E.runLists_ [[""], ["a\x1FF"]] $ do x <- ET.encode ET.iso8859_1 =$ EB.head y <- EL.consume return (x, y)) $expect $ equal (Just 'a', ["b"]) (E.runLists_ [[""], ["a"], ["b"]] $ do x <- ET.decode ET.iso8859_1 =$ ET.head y <- EL.consume return (x, y)) ] encodeISO8859_1 :: T.Text -> B.ByteString encodeISO8859_1 text = if T.any (\c -> ord c > 255) text then error "encodeASCII: input contains non-ISO8859-1 characters." else B8.pack (T.unpack text) decodeISO8859_1 :: B.ByteString -> T.Text decodeISO8859_1 bytes = T.pack (B8.unpack bytes) test_UTF8 :: Suite test_UTF8 = suite "utf8" [ property "encode" (prop_Encode ET.utf8 TE.encodeUtf8) , property "decode" (prop_Decode ET.utf8 TE.decodeUtf8 . TE.encodeUtf8) , assertions "show" $ do $expect $ equal "Codec \"UTF-8\"" (show ET.utf8) , assertions "decode-invalid" $ do $expect $ equalExc (TE.DecodeError "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream" (Just 0xFF)) (E.runLists [["\xFF"]] (ET.decode ET.utf8 =$ ET.consume)) $expect $ equalExc (ErrorCall "Unexpected EOF while decoding") (E.runLists [["\xF0"]] (ET.decode ET.utf8 =$ ET.consume)) , assertions "lazy" $ do $expect $ equal (Just 'a', ["\xEF\xBD"]) (E.runLists_ [["a\xEF\xBD"]] $ do x <- ET.decode ET.utf8 =$ ET.head y <- EL.consume return (x, y)) ] test_UTF16_BE :: Suite test_UTF16_BE = suite "utf16-be" [ property "encode" (prop_Encode ET.utf16_be TE.encodeUtf16BE) , property "decode" (prop_Decode ET.utf16_be TE.decodeUtf16BE . TE.encodeUtf16BE) , assertions "show" $ do $expect $ equal "Codec \"UTF-16-BE\"" (show ET.utf16_be) , assertions "decode-invalid" $ do $expect $ equalExc (TE.DecodeError "Data.Text.Encoding.Fusion.streamUtf16BE: Invalid UTF-16BE stream" Nothing) (E.runLists [["\xDD\x1E"]] (ET.decode ET.utf16_be =$ ET.consume)) $expect $ equalExc (ErrorCall "Unexpected EOF while decoding") (E.runLists [["\xD8\x00"]] (ET.decode ET.utf16_be =$ ET.consume)) , assertions "lazy" $ do $expect $ equal (Just 'a', ["\x00"]) (E.runLists_ [["\x00\x61\x00"]] $ do x <- ET.decode ET.utf16_be =$ ET.head y <- EL.consume return (x, y)) $expect $ equal (Just 'a', ["\xDD\x1E"]) (E.runLists_ [["\x00\x61\xDD\x1E"]] $ do x <- ET.decode ET.utf16_be =$ ET.head y <- EL.consume return (x, y)) ] test_UTF16_LE :: Suite test_UTF16_LE = suite "utf16-le" [ property "encode" (prop_Encode ET.utf16_le TE.encodeUtf16LE) , property "decode" (prop_Decode ET.utf16_le TE.decodeUtf16LE . TE.encodeUtf16LE) , assertions "show" $ do $expect $ equal "Codec \"UTF-16-LE\"" (show ET.utf16_le) , assertions "decode-invalid" $ do $expect $ equalExc (TE.DecodeError "Data.Text.Encoding.Fusion.streamUtf16LE: Invalid UTF-16LE stream" Nothing) (E.runLists [["\x1E\xDD"]] (ET.decode ET.utf16_le =$ ET.consume)) $expect $ equalExc (ErrorCall "Unexpected EOF while decoding") (E.runLists [["\x00\xD8"]] (ET.decode ET.utf16_le =$ ET.consume)) , assertions "lazy" $ do $expect $ equal (Just 'a', ["\x00"]) (E.runLists_ [["\x61\x00\x00"]] $ do x <- ET.decode ET.utf16_le =$ ET.head y <- EL.consume return (x, y)) $expect $ equal (Just 'a', ["\x1E\xDD"]) (E.runLists_ [["\x61\x00\x1E\xDD"]] $ do x <- ET.decode ET.utf16_le =$ ET.head y <- EL.consume return (x, y)) ] test_UTF32_BE :: Suite test_UTF32_BE = suite "utf32-be" [ property "encode" (prop_Encode ET.utf32_be TE.encodeUtf32BE) , property "decode" (prop_Decode ET.utf32_be TE.decodeUtf32BE . TE.encodeUtf32BE) , assertions "show" $ do $expect $ equal "Codec \"UTF-32-BE\"" (show ET.utf32_be) , assertions "decode-invalid" $ do $expect $ equalExc (TE.DecodeError "Data.Text.Encoding.Fusion.streamUtf32BE: Invalid UTF-32BE stream" Nothing) (E.runLists [["\xFF\xFF\xFF\xFF"]] (ET.decode ET.utf32_be =$ ET.consume)) $expect $ equalExc (ErrorCall "Unexpected EOF while decoding") (E.runLists [["\x00\x00"]] (ET.decode ET.utf32_be =$ ET.consume)) , assertions "lazy" $ do $expect $ equal (Just 'a', ["\x00"]) (E.runLists_ [["\x00\x00\x00\x61\x00"]] $ do x <- ET.decode ET.utf32_be =$ ET.head y <- EL.consume return (x, y)) $expect $ equal (Just 'a', ["\xFF\xFF\xFF\xFF"]) (E.runLists_ [["\x00\x00\x00\x61\xFF\xFF\xFF\xFF"]] $ do x <- ET.decode ET.utf32_be =$ ET.head y <- EL.consume return (x, y)) ] test_UTF32_LE :: Suite test_UTF32_LE = suite "utf32-le" [ property "encode" (prop_Encode ET.utf32_le TE.encodeUtf32LE) , property "decode" (prop_Decode ET.utf32_le TE.decodeUtf32LE . TE.encodeUtf32LE) , assertions "show" $ do $expect $ equal "Codec \"UTF-32-LE\"" (show ET.utf32_le) , assertions "decode-invalid" $ do $expect $ equalExc (TE.DecodeError "Data.Text.Encoding.Fusion.streamUtf32LE: Invalid UTF-32LE stream" Nothing) (E.runLists [["\xFF\xFF\xFF\xFF"]] (ET.decode ET.utf32_le =$ ET.consume)) $expect $ equalExc (ErrorCall "Unexpected EOF while decoding") (E.runLists [["\x00\x00"]] (ET.decode ET.utf32_le =$ ET.consume)) , assertions "lazy" $ do $expect $ equal (Just 'a', ["\x00"]) (E.runLists_ [["\x61\x00\x00\x00\x00"]] $ do x <- ET.decode ET.utf32_le =$ ET.head y <- EL.consume return (x, y)) $expect $ equal (Just 'a', ["\xFF\xFF\xFF\xFF"]) (E.runLists_ [["\x61\x00\x00\x00\xFF\xFF\xFF\xFF"]] $ do x <- ET.decode ET.utf32_le =$ ET.head y <- EL.consume return (x, y)) ] prop_Encode :: ET.Codec -> (T.Text -> B.ByteString) -> T.Text -> Bool prop_Encode codec model text = encoded == model text where lazy = E.runLists_ [[text]] (ET.encode codec =$ EB.consume) encoded = B.concat (BL.toChunks lazy) prop_Decode :: ET.Codec -> (B.ByteString -> T.Text) -> B.ByteString -> Bool prop_Decode codec model bytes = decoded == model bytes where lazy = E.runLists_ [[bytes]] (ET.decode codec =$ ET.consume) decoded = TL.toStrict lazy enumerator-0.4.19/tests/EnumeratorTests/Text/Isolate.hs0000644000000000000000000000526611740377455021370 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Isolate ( test_Isolate , test_IsolateWhile ) where import qualified Data.Text.Lazy as TL import Test.Chell import Test.Chell.QuickCheck import Data.Enumerator (($$), (=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET import EnumeratorTests.Text.Util (prop_Text) test_Isolate :: Suite test_Isolate = suite "isolate" [ prop_Isolate , test_Isolate_DropExtra , test_Isolate_HandleEOF , test_Isolate_BadParameter ] prop_Isolate :: Suite prop_Isolate = property "model" $ prop_Text (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')) test_Isolate_DropExtra :: Suite test_Isolate_DropExtra = assertions "drop-extra" $ do $expect $ equal (Just 'A', ["C"]) (E.runLists_ [[], ["A"], ["B"], ["C"]] $ do x <- ET.isolate 2 =$ ET.head extra <- EL.consume return (x, extra)) $expect $ equal (Just 'A', ["C"]) (E.runLists_ [["A", "B", "C"]] $ do x <- ET.isolate 2 =$ ET.head extra <- EL.consume return (x, extra)) test_Isolate_HandleEOF :: Suite test_Isolate_HandleEOF = assertions "handle-eof" $ do $expect $ equal (Nothing :: Maybe Char, []) (E.runLists_ [] $ do x <- ET.isolate 2 =$ ET.head extra <- EL.consume return (x, extra)) test_Isolate_BadParameter :: Suite test_Isolate_BadParameter = assertions "bad-parameter" $ do $expect $ equal (Nothing, ["A", "B", "C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do x <- ET.isolate 0 =$ ET.head extra <- EL.consume return (x, extra)) test_IsolateWhile :: Suite test_IsolateWhile = suite "isolateWhile" [ test_IsolateWhile_DropExtra , test_IsolateWhile_HandleEOF ] test_IsolateWhile_DropExtra :: Suite test_IsolateWhile_DropExtra = assertions "drop-extra" $ do $expect $ equal (Just 'A', ["C"]) (E.runLists_ [[], ["A"], ["B"], ["C"]] $ do x <- ET.isolateWhile (< 'C') =$ ET.head extra <- EL.consume return (x, extra)) $expect $ equal (Just 'A', ["C"]) (E.runLists_ [["A", "B", "C"]] $ do x <- ET.isolateWhile (< 'C') =$ ET.head extra <- EL.consume return (x, extra)) test_IsolateWhile_HandleEOF :: Suite test_IsolateWhile_HandleEOF = assertions "handle-eof" $ do $expect $ equal (Nothing :: Maybe Char, []) (E.runLists_ [] $ do x <- ET.isolateWhile (< 'C') =$ ET.head extra <- EL.consume return (x, extra)) enumerator-0.4.19/tests/EnumeratorTests/Text/Require.hs0000644000000000000000000000305111740377455021372 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Require ( test_Require ) where import qualified Control.Exception as Exc import qualified Data.Text.Lazy as TL import Test.Chell import Test.Chell.QuickCheck import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET import EnumeratorTests.Text.Util import EnumeratorTests.Util (equalExc) test_Require :: Suite test_Require = suite "require" [ prop_Require , test_YieldsInput , test_HandleEOF , test_BadParameter ] prop_Require :: Suite prop_Require = property "model" $ prop_TextN (\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) test_YieldsInput :: Suite test_YieldsInput = assertions "yields-input" $ do $expect $ equal ["A", "B", "C"] (E.runLists_ [["A"], ["B"], ["C"]] $ do ET.require 2 EL.consume) $expect $ equal ["A", "B", "C"] (E.runLists_ [["A", "B", "C"]] $ do ET.require 2 EL.consume) test_HandleEOF :: Suite test_HandleEOF = assertions "handle-eof" $ do $expect $ equalExc (Exc.ErrorCall "require: Unexpected EOF") (E.runLists [] $ do ET.require 2 EL.consume) test_BadParameter :: Suite test_BadParameter = assertions "bad-parameter" $ do $expect $ equal [] (E.runLists_ [] $ do ET.require 0 EL.consume) enumerator-0.4.19/tests/EnumeratorTests/Text/Util.hs0000644000000000000000000000234211740377455020675 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Util ( prop_Text , prop_TextN , prop_TextX ) where import Control.Exception (ErrorCall) import Data.Text (Text) import qualified Data.Text.Lazy as TL import Data.Functor.Identity (Identity) import Test.QuickCheck hiding (property) import Data.Enumerator (Iteratee) import EnumeratorTests.Util (check) prop_Text :: Eq b => Iteratee Text Identity b -> (TL.Text -> Either ErrorCall b) -> [Text] -> Bool prop_Text iter plain = check iter (plain . TL.fromChunks) prop_TextN :: Eq b => (Integer -> Iteratee Text Identity b) -> (Integer -> TL.Text -> Either ErrorCall b) -> Positive Integer -> [Text] -> Bool prop_TextN iter plain (Positive n) = check (iter n) (plain n . TL.fromChunks) prop_TextX :: Eq b => (Char -> Iteratee Text Identity b) -> (Char -> TL.Text -> Either ErrorCall b) -> Char -> [Text] -> Bool prop_TextX iter plain x = check (iter x) (plain x . TL.fromChunks) enumerator-0.4.19/tests/EnumeratorTests/Text/Replicate.hs0000644000000000000000000000177311740377455021677 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Replicate ( test_Replicate , test_ReplicateM ) where import Control.Monad.Trans.State import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET test_Replicate :: Suite test_Replicate = assertions "replicate" $ do $expect $ equal ["A", "A", "A"] (runIdentity (E.run_ (ET.replicate 3 'A' $$ EL.consume))) test_ReplicateM :: Suite test_ReplicateM = assertions "replicateM" $ do let step = do c <- get put (succ c) return c $expect $ equal ["A", "B", "C"] (evalState (E.run_ (ET.replicateM 3 step $$ EL.consume)) 'A') $expect $ equal ["A", "B"] (evalState (E.run_ (ET.replicateM 3 step $$ EL.take 2)) 'A') enumerator-0.4.19/tests/EnumeratorTests/Text/Handle.hs0000644000000000000000000000715211740377455021157 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Handle ( test_EnumHandle , test_EnumFile , test_IterHandle ) where import Test.Chell #ifdef MIN_VERSION_knob import Data.Knob #else import EnumeratorTests.Util (todo) #endif import Control.Monad.IO.Class (liftIO) import Data.Text (Text, replace) import qualified System.IO as IO import qualified Data.Enumerator as E import Data.Enumerator (($$)) import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET import Paths_enumerator_tests (getDataFileName) test_EnumHandle :: Suite test_EnumHandle = suite "enumHandle" [ test_EnumHandle_AsciiLF , test_EnumHandle_AsciiCRLF , test_EnumHandle_Utf8LF , test_EnumHandle_Utf8CRLF ] --- define locally, because it's not present in GHC 6.10 data Newline = LF | CRLF deriving (Show, Eq) nativeNewline :: Newline #if MIN_VERSION_base(4,2,0) nativeNewline = case IO.nativeNewline of IO.LF -> LF IO.CRLF -> CRLF #else #ifdef CABAL_OS_WINDOWS nativeNewline = CRLF #else nativeNewline = LF #endif #endif runEnumHandle :: String -> Assertions [Text] runEnumHandle name = do path <- liftIO (getDataFileName name) chunks <- liftIO (IO.withFile path IO.ReadMode (\h -> do #if MIN_VERSION_base(4,2,0) IO.hSetEncoding h IO.utf8 #endif E.run_ (ET.enumHandle h $$ EL.consume))) return chunks test_EnumHandle_AsciiLF :: Suite test_EnumHandle_AsciiLF = assertions "ascii-lf" $ do chunks <- runEnumHandle "data/ascii-lf.txt" $expect (equalItems [ "hello\n" , "\n" , "world\n" ] chunks) test_EnumHandle_AsciiCRLF :: Suite test_EnumHandle_AsciiCRLF = assertions "ascii-crlf" $ do chunks <- runEnumHandle "data/ascii-crlf.txt" let rawLines = [ "hello\r\n" , "\r\n" , "world\r\n" ] let expected = case nativeNewline of CRLF -> map (replace "\r\n" "\n") rawLines LF -> rawLines $expect (equalItems expected chunks) test_EnumHandle_Utf8LF :: Suite test_EnumHandle_Utf8LF = assertions "utf8-lf" $ do chunks <- runEnumHandle "data/utf8-lf.txt" $expect (equalItems [ "hello world\n" , "\n" , "\20320\22909\19990\30028\n" , "\n" , "\1605\1585\1581\1576\1575 \1575\1604\1593\1575\1604\1605\n" , "\n" , "\12371\12435\12395\12385\12399\19990\30028\n" , "\n" , "\2997\2979\2965\3021\2965\2990\3021\n" ] chunks) test_EnumHandle_Utf8CRLF :: Suite test_EnumHandle_Utf8CRLF = assertions "utf8-crlf" $ do chunks <- runEnumHandle "data/utf8-crlf.txt" let rawLines = [ "hello world\r\n" , "\r\n" , "\20320\22909\19990\30028\r\n" , "\r\n" , "\1605\1585\1581\1576\1575 \1575\1604\1593\1575\1604\1605\r\n" , "\r\n" , "\12371\12435\12395\12385\12399\19990\30028\r\n" , "\r\n" , "\2997\2979\2965\3021\2965\2990\3021\r\n" ] let expected = case nativeNewline of CRLF -> map (replace "\r\n" "\n") rawLines LF -> rawLines $expect (equalItems expected chunks) test_EnumFile :: Suite test_EnumFile = assertions "enumFile" $ do path <- liftIO (getDataFileName "data/ascii-lf.txt") chunks <- liftIO (E.run_ (ET.enumFile path $$ EL.consume)) $expect (equal [ "hello\n" , "\n" , "world\n" ] chunks) #ifdef MIN_VERSION_knob test_IterHandle :: Suite test_IterHandle = assertions "iterHandle" $ do knob <- newKnob "" withFileHandle knob "" IO.WriteMode $ \h -> do E.run_ (E.enumLists [[], ["A", "B"], ["C"]] $$ ET.iterHandle h) bytes <- Data.Knob.getContents knob $expect (equal bytes "ABC") #else test_IterHandle :: Suite test_IterHandle = todo "iterHandle" #endif enumerator-0.4.19/tests/EnumeratorTests/Text/Iterate.hs0000644000000000000000000000150611740377455021356 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Iterate ( test_Iterate , test_IterateM ) where import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET test_Iterate :: Suite test_Iterate = assertions "iterate" $ do $expect $ equal ["A", "B", "C"] (runIdentity (E.run_ (ET.iterate succ 'A' $$ EL.take 3))) test_IterateM :: Suite test_IterateM = assertions "iterateM" $ do let succM = return . succ $expect $ equal ["A", "B", "C"] (runIdentity (E.run_ (ET.iterateM succM 'A' $$ EL.take 3))) enumerator-0.4.19/tests/EnumeratorTests/Text/Drop.hs0000644000000000000000000000261411740377455020666 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Drop ( test_Drop , test_DropWhile , test_Filter , test_FilterM ) where import Test.Chell import Data.Enumerator ((=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET test_Drop :: Suite test_Drop = assertions "drop" $ do $expect $ equal ["ABCDE"] (E.runLists_ [["ABCDE"]] $ do ET.drop 0 EL.consume) $expect $ equal ["CDE"] (E.runLists_ [["ABCDE"]] $ do ET.drop 2 EL.consume) $expect $ equal ["CDE"] (E.runLists_ [["A"], ["BCDE"]] $ do ET.drop 2 EL.consume) test_DropWhile :: Suite test_DropWhile = assertions "dropWhile" $ do $expect $ equal ["CDE"] (E.runLists_ [["ABCDE"]] $ do ET.dropWhile (< 'C') EL.consume) $expect $ equal [] (E.runLists_ [["ABCDE"]] $ do ET.dropWhile (\_ -> True) EL.consume) test_Filter :: Suite test_Filter = assertions "filter" $ do $expect $ equal ["A", "B", "", "D", "E"] (E.runLists_ [["ABCDE"]] $ do ET.filter (/= 'C') =$ EL.consume) test_FilterM :: Suite test_FilterM = assertions "filterM" $ do $expect $ equal ["A", "B", "", "D", "E"] (E.runLists_ [["ABCDE"]] $ do ET.filterM (\x -> return (x /= 'C')) =$ EL.consume) enumerator-0.4.19/tests/EnumeratorTests/Text/Map.hs0000644000000000000000000000763311740377455020505 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Map ( test_Map , test_MapM , test_MapM_ , test_ConcatMap , test_ConcatMapM , test_ConcatMapAccum , test_ConcatMapAccumM , test_MapAccum , test_MapAccumM ) where import Control.Monad.Trans.Writer (execWriter, tell) import Data.Char (chr, ord, toLower) import qualified Data.Text as T import Test.Chell import Data.Enumerator (($$), (=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET test_Map :: Suite test_Map = assertions "map" $ do $expect $ equal ["a", "b"] (E.runLists_ [["AB"]] (ET.map toLower =$ EL.consume)) $expect $ equal (["a", "b"], ["CDEF", "GH"]) (E.runLists_ [["ABCD", "EF"], ["GH"]] $ do xs <- ET.map toLower =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_MapM :: Suite test_MapM = assertions "mapM" $ do $expect $ equal ["a", "b"] (E.runLists_ [["AB"]] (ET.mapM (return . toLower) =$ EL.consume)) $expect $ equal (["a", "b"], ["CDEF", "GH"]) (E.runLists_ [["ABCD", "EF"], ["GH"]] $ do xs <- ET.mapM (return . toLower) =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_MapM_ :: Suite test_MapM_ = assertions "mapM_" $ do $expect $ equal ['A', 'B'] (execWriter (E.run_ (E.enumLists [["AB"]] $$ ET.mapM_ (\x -> tell [x])))) test_ConcatMap :: Suite test_ConcatMap = assertions "concatMap" $ do $expect $ equal ["Aa", "Bb"] (E.runLists_ [["AB"]] (ET.concatMap (\x -> T.pack [x, toLower x]) =$ EL.consume)) $expect $ equal (["Aa", "Bb"], ["CDEF", "GH"]) (E.runLists_ [["ABCD", "EF"], ["GH"]] $ do xs <- ET.concatMap (\x -> T.pack [x, toLower x]) =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_ConcatMapM :: Suite test_ConcatMapM = assertions "concatMapM" $ do $expect $ equal ["Aa", "Bb"] (E.runLists_ [["AB"]] (ET.concatMapM (\x -> return (T.pack [x, toLower x])) =$ EL.consume)) $expect $ equal (["Aa", "Bb"], ["CDEF", "GH"]) (E.runLists_ [["ABCD", "EF"], ["GH"]] $ do xs <- ET.concatMapM (\x -> return (T.pack [x, toLower x])) =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_MapAccum :: Suite test_MapAccum = assertions "mapAccum" $ do let step s ao = (s + 1, chr (ord ao + s)) $expect $ equal ["B", "D", "F"] (E.runLists_ [["A", "B"], ["C"]] $ do ET.mapAccum step 1 =$ EL.consume) $expect $ equal ("B", ["", "B", "C"]) (E.runLists_ [["A", "B"], ["C"]] $ do xs <- ET.mapAccum step 1 =$ ET.take 1 extra <- EL.consume return (xs, extra)) test_MapAccumM :: Suite test_MapAccumM = assertions "mapAccumM" $ do let step s ao = return (s + 1, chr (ord ao + s)) $expect $ equal ["B", "D", "F"] (E.runLists_ [["A", "B"], ["C"]] $ do ET.mapAccumM step 1 =$ EL.consume) $expect $ equal ("B", ["", "B", "C"]) (E.runLists_ [["A", "B"], ["C"]] $ do xs <- ET.mapAccumM step 1 =$ ET.take 1 extra <- EL.consume return (xs, extra)) test_ConcatMapAccum :: Suite test_ConcatMapAccum = assertions "concatMapAccum" $ do let step s ao = (s + 1, T.replicate s (T.pack [ao])) $expect $ equal ["A", "BB", "CCC"] (E.runLists_ [["A", "B"], ["C"]] $ do ET.concatMapAccum step 1 =$ EL.consume) $expect $ equal ("AB", ["", "C"]) (E.runLists_ [["A", "B"], ["C"]] $ do xs <- ET.concatMapAccum step 1 =$ ET.take 2 extra <- EL.consume return (xs, extra)) test_ConcatMapAccumM :: Suite test_ConcatMapAccumM = assertions "concatMapAccumM" $ do let step s ao = return (s + 1, T.replicate s (T.pack [ao])) $expect $ equal ["A", "BB", "CCC"] (E.runLists_ [["A", "B"], ["C"]] $ do ET.concatMapAccumM step 1 =$ EL.consume) $expect $ equal ("AB", ["", "C"]) (E.runLists_ [["A", "B"], ["C"]] $ do xs <- ET.concatMapAccumM step 1 =$ ET.take 2 extra <- EL.consume return (xs, extra)) enumerator-0.4.19/tests/EnumeratorTests/Text/Zip.hs0000644000000000000000000001073111740377455020523 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Text.Zip ( test_Zip ) where import qualified Control.Exception as Exc import Data.Functor.Identity (Identity) import Data.Text (Text) import Test.Chell import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Text as ET import EnumeratorTests.Util (equalExc) test_ZipN :: (Eq b, Show b) => Text -> E.Iteratee Text Identity b -> b -> Suite test_ZipN name iter expected = assertions name $ do $expect $ equal expected (E.runLists_ [[], ["A"], ["B"]] iter) $([d||]) test_Zip :: Suite test_Zip = suite "zip" [ test_ContinueContinue , test_YieldContinue , test_ContinueYield , test_YieldYield , test_ErrorFirst , test_ErrorSecond , test_HandleEOF , test_Zip3 , test_Zip4 , test_Zip5 , test_Zip6 , test_Zip7 , test_ZipWith , test_ZipWith3 , test_ZipWith4 , test_ZipWith5 , test_ZipWith6 , test_ZipWith7 ] test_ContinueContinue :: Suite test_ContinueContinue = assertions "continue-continue" $ do $expect $ equal ("AB", "AB", ["C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do (x, y) <- ET.zip (ET.take 2) (ET.take 2) extra <- EL.consume return (x, y, extra)) test_YieldContinue :: Suite test_YieldContinue = assertions "yield-continue" $ do $expect $ equal ("A", "AB", ["C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do (x, y) <- ET.zip (ET.take 1) (ET.take 2) extra <- EL.consume return (x, y, extra)) test_ContinueYield :: Suite test_ContinueYield = assertions "continue-yield" $ do $expect $ equal ("AB", "A", ["C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do (x, y) <- ET.zip (ET.take 2) (ET.take 1) extra <- EL.consume return (x, y, extra)) test_YieldYield :: Suite test_YieldYield = assertions "yield-yield" $ do $expect $ equal ("A", "A", ["B", "C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do (x, y) <- ET.zip (ET.take 1) (ET.take 1) extra <- EL.consume return (x, y, extra)) test_ErrorFirst :: Suite test_ErrorFirst = assertions "error-first" $ do $expect $ equalExc (Exc.ErrorCall "error") (E.runLists [["A"], ["B"], ["C"]] $ do ET.zip (E.throwError (Exc.ErrorCall "error")) (ET.take 1)) test_ErrorSecond :: Suite test_ErrorSecond = assertions "error-second" $ do $expect $ equalExc (Exc.ErrorCall "error") (E.runLists [["A"], ["B"], ["C"]] $ do ET.zip (ET.take 1) (E.throwError (Exc.ErrorCall "error"))) test_HandleEOF :: Suite test_HandleEOF = assertions "handle-eof" $ do $expect $ equal ("A", "AB", []) (E.runLists_ [["A"], ["B"]] $ do (x, y) <- ET.zip (ET.take 1) (ET.take 3) extra <- EL.consume return (x, y, extra)) test_Zip3 :: Suite test_Zip3 = test_ZipN "zip3" (ET.zip3 ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A') test_Zip4 :: Suite test_Zip4 = test_ZipN "zip4" (ET.zip4 ET.head ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A', Just 'A') test_Zip5 :: Suite test_Zip5 = test_ZipN "zip5" (ET.zip5 ET.head ET.head ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_Zip6 :: Suite test_Zip6 = test_ZipN "zip6" (ET.zip6 ET.head ET.head ET.head ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_Zip7 :: Suite test_Zip7 = test_ZipN "zip7" (ET.zip7 ET.head ET.head ET.head ET.head ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_ZipWith :: Suite test_ZipWith = test_ZipN "zipWith" (ET.zipWith (,) ET.head ET.head) (Just 'A', Just 'A') test_ZipWith3 :: Suite test_ZipWith3 = test_ZipN "zipWith3" (ET.zipWith3 (,,) ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A') test_ZipWith4 :: Suite test_ZipWith4 = test_ZipN "zipWith4" (ET.zipWith4 (,,,) ET.head ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A', Just 'A') test_ZipWith5 :: Suite test_ZipWith5 = test_ZipN "zipWith5" (ET.zipWith5 (,,,,) ET.head ET.head ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_ZipWith6 :: Suite test_ZipWith6 = test_ZipN "zipWith6" (ET.zipWith6 (,,,,,) ET.head ET.head ET.head ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_ZipWith7 :: Suite test_ZipWith7 = test_ZipN "zipWith7" (ET.zipWith7 (,,,,,,) ET.head ET.head ET.head ET.head ET.head ET.head ET.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') enumerator-0.4.19/tests/EnumeratorTests/Binary/0000755000000000000000000000000011740377455017723 5ustar0000000000000000enumerator-0.4.19/tests/EnumeratorTests/Binary/Repeat.hs0000644000000000000000000000224511740377455021502 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Repeat ( test_Repeat , test_RepeatM , test_GenerateM ) where import Control.Monad.Trans.State import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL test_Repeat :: Suite test_Repeat = assertions "repeat" $ do $expect $ equal ["A", "A", "A"] (runIdentity (E.run_ (EB.repeat 0x41 $$ EL.take 3))) test_RepeatM :: Suite test_RepeatM = assertions "repeatM" $ do let step = do c <- get put (succ c) return c $expect $ equal ["A", "B", "C"] (evalState (E.run_ (EB.repeatM step $$ EL.take 3)) 0x41) test_GenerateM :: Suite test_GenerateM = assertions "generateM" $ do let step = do c <- get if c > 0x43 then return Nothing else do put (succ c) return (Just c) $expect $ equal ["A", "B", "C"] (evalState (E.run_ (EB.generateM step $$ EL.consume)) 0x41) enumerator-0.4.19/tests/EnumeratorTests/Binary/Consume.hs0000644000000000000000000000457711740377455021705 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Consume ( test_Consume , test_Head , test_Head_ , test_Take , test_TakeWhile ) where import Control.Exception import Data.Word (Word8) import Test.Chell import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Binary as EB import EnumeratorTests.Util (equalExc) test_Consume :: Suite test_Consume = assertions "consume" $ do $expect $ equal ("ABC", Nothing) (E.runLists_ [[], ["A", "B"], ["C"]] $ do xs <- EB.consume h <- EL.head return (xs, h)) test_Head :: Suite test_Head = assertions "head" $ do $expect $ equal (Just 0x41, ["BC", "DE"]) (E.runLists_ [[], ["ABC", "DE"]] $ do x <- EB.head extra <- EL.consume return (x, extra)) $expect $ equal (Nothing :: Maybe Word8, []) (E.runLists_ [] $ do x <- EB.head extra <- EL.consume return (x, extra)) test_Head_ :: Suite test_Head_ = assertions "head_" $ do $expect $ equal (0x41, ["BC", "DE"]) (E.runLists_ [["ABC"], ["DE"]] $ do x <- EB.head_ extra <- EL.consume return (x, extra)) $expect $ equalExc (ErrorCall "head_: stream has ended") (E.runLists [] $ do x <- EB.head_ extra <- EL.consume return (x, extra)) test_Take :: Suite test_Take = assertions "take" $ do $expect $ equal ("ABC", ["D", "E"]) (E.runLists_ [["A", "B"], ["C", "D"], ["E"]] $ do x <- EB.take 3 extra <- EL.consume return (x, extra)) $expect $ equal ("AB", []) (E.runLists_ [["A"], ["B"]] $ do x <- EB.take 3 extra <- EL.consume return (x, extra)) $expect $ equal ("", ["A", "B"]) (E.runLists_ [["A"], ["B"]] $ do x <- EB.take 0 extra <- EL.consume return (x, extra)) test_TakeWhile :: Suite test_TakeWhile = assertions "takeWhile" $ do $expect $ equal ("ABC", ["D", "E"]) (E.runLists_ [[], ["A", "B"], ["C", "D"], ["E"]] $ do x <- EB.takeWhile (< 0x44) extra <- EL.consume return (x, extra)) $expect $ equal ("AB", []) (E.runLists_ [["A"], ["B"]] $ do x <- EB.takeWhile (< 0x44) extra <- EL.consume return (x, extra)) $expect $ equal ("", ["A", "B"]) (E.runLists_ [["A"], ["B"]] $ do x <- EB.takeWhile (< 0x41) extra <- EL.consume return (x, extra)) enumerator-0.4.19/tests/EnumeratorTests/Binary/Split.hs0000644000000000000000000000241711740377455021356 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Split ( test_SplitWhen ) where import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.List.Split as LS import Test.Chell import Test.Chell.QuickCheck import Data.Enumerator (($$), (=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import qualified Data.Enumerator.Binary as EB import EnumeratorTests.Binary.Util test_SplitWhen :: Suite test_SplitWhen = suite "splitWhen" [ prop_SplitWhen , test_HandleEmpty ] prop_SplitWhen :: Suite prop_SplitWhen = property "model" $ prop_BytesX (\c -> do xs <- E.joinI (EB.splitWhen (== c) $$ EL.consume) extra <- EL.consume return (xs, extra)) (\c text -> let split = LS.split . LS.dropFinalBlank . LS.dropDelims . LS.whenElt chars = BL.unpack text in Right (map B.pack (split (== c) chars), [])) test_HandleEmpty :: Suite test_HandleEmpty = assertions "empty" $ do $expect $ equal ([], Nothing) (E.runLists_ [[""]] $ do xs <- EB.splitWhen (== 0x2C) =$ EL.consume extra <- EL.head return (xs, extra)) enumerator-0.4.19/tests/EnumeratorTests/Binary/Unfold.hs0000644000000000000000000000166311740377455021514 0ustar0000000000000000 {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Unfold ( test_Unfold , test_UnfoldM ) where import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL test_Unfold :: Suite test_Unfold = assertions "unfold" $ do let step x = if x > 0x43 then Nothing else Just (x, succ x) $expect $ equal ["A", "B", "C"] (runIdentity (E.run_ (EB.unfold step 0x41 $$ EL.consume))) test_UnfoldM :: Suite test_UnfoldM = assertions "unfoldM" $ do let step x = return $ if x > 0x43 then Nothing else Just (x, succ x) $expect $ equal ["A", "B", "C"] (runIdentity (E.run_ (EB.unfoldM step 0x41 $$ EL.consume))) enumerator-0.4.19/tests/EnumeratorTests/Binary/Fold.hs0000644000000000000000000000242611740377455021147 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Fold ( test_Fold , test_FoldM ) where import Control.Monad (foldM) import qualified Data.ByteString import Data.ByteString (ByteString) import Data.Functor.Identity (runIdentity) import Data.Word (Word8) import Test.Chell import Test.Chell.QuickCheck import Test.QuickCheck.Poly import Test.QuickCheck.Modifiers import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import EnumeratorTests.Util () test_Fold :: Suite test_Fold = property "fold" prop_Fold prop_Fold :: Blind (B -> Word8 -> B) -> B -> ByteString -> Bool prop_Fold (Blind f) z text = result == expected where result = E.runLists_ [[text]] (EB.fold f z) expected = Data.ByteString.foldl' f z text test_FoldM :: Suite test_FoldM = property "foldM" prop_FoldM prop_FoldM :: Blind (B -> Word8 -> B) -> B -> ByteString -> Bool prop_FoldM (Blind f) z text = result == expected where result = E.runLists_ [[text]] (EB.foldM f' z) expected = runIdentity (foldM f' z (Data.ByteString.unpack text)) f' b a = return (f b a) enumerator-0.4.19/tests/EnumeratorTests/Binary/Isolate.hs0000644000000000000000000000536011740377455021663 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Isolate ( test_Isolate , test_IsolateWhile ) where import qualified Data.ByteString.Lazy as BL import Data.Word (Word8) import Test.Chell import Test.Chell.QuickCheck import Data.Enumerator (($$), (=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL import EnumeratorTests.Binary.Util (prop_Bytes) test_Isolate :: Suite test_Isolate = suite "isolate" [ prop_Isolate , test_Isolate_DropExtra , test_Isolate_HandleEOF , test_Isolate_BadParameter ] prop_Isolate :: Suite prop_Isolate = property "model" $ prop_Bytes (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_Isolate_DropExtra :: Suite test_Isolate_DropExtra = assertions "drop-extra" $ do $expect $ equal (Just 0x41, ["C"]) (E.runLists_ [[], ["A"], ["B"], ["C"]] $ do x <- EB.isolate 2 =$ EB.head extra <- EL.consume return (x, extra)) $expect $ equal (Just 0x41, ["C"]) (E.runLists_ [["A", "B", "C"]] $ do x <- EB.isolate 2 =$ EB.head extra <- EL.consume return (x, extra)) test_Isolate_HandleEOF :: Suite test_Isolate_HandleEOF = assertions "handle-eof" $ do $expect $ equal (Nothing :: Maybe Word8, []) (E.runLists_ [] $ do x <- EB.isolate 2 =$ EB.head extra <- EL.consume return (x, extra)) test_Isolate_BadParameter :: Suite test_Isolate_BadParameter = assertions "bad-parameter" $ do $expect $ equal (Nothing, ["A", "B", "C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do x <- EB.isolate 0 =$ EB.head extra <- EL.consume return (x, extra)) test_IsolateWhile :: Suite test_IsolateWhile = suite "isolateWhile" [ test_IsolateWhile_DropExtra , test_IsolateWhile_HandleEOF ] test_IsolateWhile_DropExtra :: Suite test_IsolateWhile_DropExtra = assertions "drop-extra" $ do $expect $ equal (Just 0x41, ["C"]) (E.runLists_ [[], ["A"], ["B"], ["C"]] $ do x <- EB.isolateWhile (< 0x43) =$ EB.head extra <- EL.consume return (x, extra)) $expect $ equal (Just 0x41, ["C"]) (E.runLists_ [["A", "B", "C"]] $ do x <- EB.isolateWhile (< 0x43) =$ EB.head extra <- EL.consume return (x, extra)) test_IsolateWhile_HandleEOF :: Suite test_IsolateWhile_HandleEOF = assertions "handle-eof" $ do $expect $ equal (Nothing :: Maybe Word8, []) (E.runLists_ [] $ do x <- EB.isolateWhile (< 0x43) =$ EB.head extra <- EL.consume return (x, extra)) enumerator-0.4.19/tests/EnumeratorTests/Binary/Require.hs0000644000000000000000000000307011740377455021673 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Require ( test_Require ) where import qualified Control.Exception as Exc import qualified Data.ByteString.Lazy as BL import Test.Chell import Test.Chell.QuickCheck import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL import EnumeratorTests.Binary.Util test_Require :: Suite test_Require = suite "require" [ prop_Require , test_YieldsInput , test_HandleEOF , test_BadParameter ] prop_Require :: Suite prop_Require = property "model" $ prop_BytesN (\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_YieldsInput :: Suite test_YieldsInput = assertions "yields-input" $ do $expect $ equal ["A", "B", "C"] (E.runLists_ [["A"], ["B"], ["C"]] $ do EB.require 2 EL.consume) $expect $ equal ["A", "B", "C"] (E.runLists_ [["A", "B", "C"]] $ do EB.require 2 EL.consume) test_HandleEOF :: Suite test_HandleEOF = assertions "handle-eof" $ do $expect $ throwsEq (Exc.ErrorCall "require: Unexpected EOF") (E.run_ (E.enumLists [] $$ do EB.require 2 EL.consume)) test_BadParameter :: Suite test_BadParameter = assertions "bad-parameter" $ do $expect $ equal [] (E.runLists_ [] $ do EB.require 0 EL.consume) enumerator-0.4.19/tests/EnumeratorTests/Binary/Util.hs0000644000000000000000000000245011740377455021175 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Util ( prop_Bytes , prop_BytesN , prop_BytesX ) where import Control.Exception (ErrorCall) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Functor.Identity (Identity) import Test.QuickCheck hiding (property) import Data.Enumerator (Iteratee) import EnumeratorTests.Util (check) prop_Bytes :: Eq b => Iteratee ByteString Identity b -> (BL.ByteString -> Either ErrorCall b) -> [ByteString] -> Bool prop_Bytes iter plain = check iter (plain . BL.fromChunks) prop_BytesN :: Eq b => (t -> Iteratee ByteString Identity b) -> (t -> BL.ByteString -> Either ErrorCall b) -> Positive t -> [ByteString] -> Bool prop_BytesN iter plain (Positive n) = check (iter n) (plain n . BL.fromChunks) prop_BytesX :: Eq b => (t -> Iteratee ByteString Identity b) -> (t -> BL.ByteString -> Either ErrorCall b) -> t -> [ByteString] -> Bool prop_BytesX iter plain x = check (iter x) (plain x . BL.fromChunks) enumerator-0.4.19/tests/EnumeratorTests/Binary/Replicate.hs0000644000000000000000000000200211740377455022161 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Replicate ( test_Replicate , test_ReplicateM ) where import Control.Monad.Trans.State import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL test_Replicate :: Suite test_Replicate = assertions "replicate" $ do $expect $ equal ["A", "A", "A"] (runIdentity (E.run_ (EB.replicate 3 0x41 $$ EL.consume))) test_ReplicateM :: Suite test_ReplicateM = assertions "replicateM" $ do let step = do c <- get put (succ c) return c $expect $ equal ["A", "B", "C"] (evalState (E.run_ (EB.replicateM 3 step $$ EL.consume)) 0x41) $expect $ equal ["A", "B"] (evalState (E.run_ (EB.replicateM 3 step $$ EL.take 2)) 0x41) enumerator-0.4.19/tests/EnumeratorTests/Binary/Handle.hs0000644000000000000000000000457411740377455021464 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Handle ( test_EnumHandle , test_EnumHandleRange , test_IterHandle ) where import Test.Chell #ifdef MIN_VERSION_knob import Data.Knob import qualified System.IO as IO import qualified Data.Enumerator as E import Data.Enumerator (($$)) import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL test_EnumHandle :: Suite test_EnumHandle = assertions "enumHandle" $ do knob <- newKnob "01234567" chunks <- withFileHandle knob "" IO.ReadMode $ \h -> do E.run_ (EB.enumHandle 3 h $$ EL.consume) $expect (equal chunks ["012", "345", "67"]) test_EnumHandleRange :: Suite test_EnumHandleRange = assertions "enumHandleRange" $ do knob <- newKnob "01234567" -- no offset or count do chunks <- withFileHandle knob "" IO.ReadMode $ \h -> do E.run_ (EB.enumHandleRange 3 Nothing Nothing h $$ EL.consume) $expect (equal chunks ["012", "345", "67"]) -- offset do chunks <- withFileHandle knob "" IO.ReadMode $ \h -> do E.run_ (EB.enumHandleRange 3 (Just 1) Nothing h $$ EL.consume) $expect (equal chunks ["123", "456", "7"]) -- count do chunks <- withFileHandle knob "" IO.ReadMode $ \h -> do E.run_ (EB.enumHandleRange 3 Nothing (Just 7) h $$ EL.consume) $expect (equal chunks ["012", "345", "6"]) -- count beyond EOF do chunks <- withFileHandle knob "" IO.ReadMode $ \h -> do E.run_ (EB.enumHandleRange 3 Nothing (Just 10) h $$ EL.consume) $expect (equal chunks ["012", "345", "67"]) -- offset + count do chunks <- withFileHandle knob "" IO.ReadMode $ \h -> do E.run_ (EB.enumHandleRange 3 (Just 1) (Just 6) h $$ EL.consume) $expect (equal chunks ["123", "456"]) test_IterHandle :: Suite test_IterHandle = assertions "iterHandle" $ do knob <- newKnob "" withFileHandle knob "" IO.WriteMode $ \h -> do E.run_ (E.enumLists [[], ["A", "B"], ["C"]] $$ EB.iterHandle h) bytes <- Data.Knob.getContents knob $expect (equal bytes "ABC") #else import EnumeratorTests.Util (todo) test_EnumHandle :: Suite test_EnumHandle = todo "enumHandle" test_EnumHandleRange :: Suite test_EnumHandleRange = todo "enumHandleRange" test_IterHandle :: Suite test_IterHandle = todo "iterHandle" #endif enumerator-0.4.19/tests/EnumeratorTests/Binary/Iterate.hs0000644000000000000000000000151411740377455021655 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Iterate ( test_Iterate , test_IterateM ) where import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL test_Iterate :: Suite test_Iterate = assertions "iterate" $ do $expect $ equal ["A", "B", "C"] (runIdentity (E.run_ (EB.iterate succ 0x41 $$ EL.take 3))) test_IterateM :: Suite test_IterateM = assertions "iterateM" $ do let succM = return . succ $expect $ equal ["A", "B", "C"] (runIdentity (E.run_ (EB.iterateM succM 0x41 $$ EL.take 3))) enumerator-0.4.19/tests/EnumeratorTests/Binary/Drop.hs0000644000000000000000000000262311740377455021166 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Drop ( test_Drop , test_DropWhile , test_Filter , test_FilterM ) where import Test.Chell import Data.Enumerator ((=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL test_Drop :: Suite test_Drop = assertions "drop" $ do $expect $ equal ["ABCDE"] (E.runLists_ [["ABCDE"]] $ do EB.drop 0 EL.consume) $expect $ equal ["CDE"] (E.runLists_ [["ABCDE"]] $ do EB.drop 2 EL.consume) $expect $ equal ["CDE"] (E.runLists_ [["A"], ["BCDE"]] $ do EB.drop 2 EL.consume) test_DropWhile :: Suite test_DropWhile = assertions "dropWhile" $ do $expect $ equal ["CDE"] (E.runLists_ [["ABCDE"]] $ do EB.dropWhile (< 0x43) EL.consume) $expect $ equal [] (E.runLists_ [["ABCDE"]] $ do EB.dropWhile (\_ -> True) EL.consume) test_Filter :: Suite test_Filter = assertions "filter" $ do $expect $ equal ["A", "B", "", "D", "E"] (E.runLists_ [["ABCDE"]] $ do EB.filter (/= 0x43) =$ EL.consume) test_FilterM :: Suite test_FilterM = assertions "filterM" $ do $expect $ equal ["A", "B", "", "D", "E"] (E.runLists_ [["ABCDE"]] $ do EB.filterM (\x -> return (x /= 0x43)) =$ EL.consume) enumerator-0.4.19/tests/EnumeratorTests/Binary/Map.hs0000644000000000000000000000756111740377455021005 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Map ( test_Map , test_MapM , test_MapM_ , test_ConcatMap , test_ConcatMapM , test_ConcatMapAccum , test_ConcatMapAccumM , test_MapAccum , test_MapAccumM ) where import Control.Monad.Trans.Writer (execWriter, tell) import qualified Data.ByteString as B import Test.Chell import Data.Enumerator (($$), (=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL test_Map :: Suite test_Map = assertions "map" $ do $expect $ equal ["a", "b"] (E.runLists_ [["AB"]] $ do EB.map (+ 0x20) =$ EL.consume) $expect $ equal (["a", "b"], ["CDEF", "GH"]) (E.runLists_ [["ABCD", "EF"], ["GH"]] $ do xs <- EB.map (+ 0x20) =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_MapM :: Suite test_MapM = assertions "mapM" $ do $expect $ equal ["a", "b"] (E.runLists_ [["AB"]] $ do EB.mapM (\x -> return (x + 0x20)) =$ EL.consume) $expect $ equal (["a", "b"], ["CDEF", "GH"]) (E.runLists_ [["ABCD", "EF"], ["GH"]] $ do xs <- EB.mapM (\x -> return (x + 0x20)) =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_MapM_ :: Suite test_MapM_ = assertions "mapM_" $ do $expect $ equal [0x41, 0x42] (execWriter (E.run_ (E.enumLists [["AB"]] $$ EB.mapM_ (\x -> tell [x])))) test_ConcatMap :: Suite test_ConcatMap = assertions "concatMap" $ do $expect $ equal ["Aa", "Bb"] (E.runLists_ [["AB"]] $ do EB.concatMap (\x -> B.pack [x, x + 0x20]) =$ EL.consume) $expect $ equal (["Aa", "Bb"], ["CDEF", "GH"]) (E.runLists_ [["ABCD", "EF"], ["GH"]] $ do xs <- EB.concatMap (\x -> B.pack [x, x + 0x20]) =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_ConcatMapM :: Suite test_ConcatMapM = assertions "concatMapM" $ do $expect $ equal ["Aa", "Bb"] (E.runLists_ [["AB"]] $ do EB.concatMapM (\x -> return (B.pack [x, x + 0x20])) =$ EL.consume) $expect $ equal (["Aa", "Bb"], ["CDEF", "GH"]) (E.runLists_ [["ABCD", "EF"], ["GH"]] $ do xs <- EB.concatMapM (\x -> return (B.pack [x, x + 0x20])) =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_MapAccum :: Suite test_MapAccum = assertions "mapAccum" $ do let step s ao = (s + 1, ao + s) $expect $ equal ["B", "D", "F"] (E.runLists_ [["A", "B"], ["C"]] $ do EB.mapAccum step 1 =$ EL.consume) $expect $ equal ("B", ["", "B", "C"]) (E.runLists_ [["A", "B"], ["C"]] $ do xs <- EB.mapAccum step 1 =$ EB.take 1 extra <- EL.consume return (xs, extra)) test_MapAccumM :: Suite test_MapAccumM = assertions "mapAccumM" $ do let step s ao = return (s + 1, ao + s) $expect $ equal ["B", "D", "F"] (E.runLists_ [["A", "B"], ["C"]] $ do EB.mapAccumM step 1 =$ EL.consume) $expect $ equal ("B", ["", "B", "C"]) (E.runLists_ [["A", "B"], ["C"]] $ do xs <- EB.mapAccumM step 1 =$ EB.take 1 extra <- EL.consume return (xs, extra)) test_ConcatMapAccum :: Suite test_ConcatMapAccum = assertions "concatMapAccum" $ do let step s ao = (s + 1, B.replicate s ao) $expect $ equal ["A", "BB", "CCC"] (E.runLists_ [["A", "B"], ["C"]] $ do EB.concatMapAccum step 1 =$ EL.consume) $expect $ equal ("AB", ["", "C"]) (E.runLists_ [["A", "B"], ["C"]] $ do xs <- EB.concatMapAccum step 1 =$ EB.take 2 extra <- EL.consume return (xs, extra)) test_ConcatMapAccumM :: Suite test_ConcatMapAccumM = assertions "concatMapAccumM" $ do let step s ao = return (s + 1, B.replicate s ao) $expect $ equal ["A", "BB", "CCC"] (E.runLists_ [["A", "B"], ["C"]] $ do EB.concatMapAccumM step 1 =$ EL.consume) $expect $ equal ("AB", ["", "C"]) (E.runLists_ [["A", "B"], ["C"]] $ do xs <- EB.concatMapAccumM step 1 =$ EB.take 2 extra <- EL.consume return (xs, extra)) enumerator-0.4.19/tests/EnumeratorTests/Binary/Zip.hs0000644000000000000000000001110511740377455021017 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.Binary.Zip ( test_Zip ) where import qualified Control.Exception as Exc import Data.ByteString (ByteString) import Data.Functor.Identity (Identity) import Data.Text (Text) import Test.Chell import qualified Data.Enumerator as E import qualified Data.Enumerator.Binary as EB import qualified Data.Enumerator.List as EL import EnumeratorTests.Util (equalExc) test_ZipN :: (Eq b, Show b) => Text -> E.Iteratee ByteString Identity b -> b -> Suite test_ZipN name iter expected = assertions name $ do $expect $ equal expected (E.runLists_ [[], ["A"], ["B"]] iter) $([d||]) test_Zip :: Suite test_Zip = suite "zip" [ test_ContinueContinue , test_YieldContinue , test_ContinueYield , test_YieldYield , test_ErrorFirst , test_ErrorSecond , test_HandleEOF , test_Zip3 , test_Zip4 , test_Zip5 , test_Zip6 , test_Zip7 , test_ZipWith , test_ZipWith3 , test_ZipWith4 , test_ZipWith5 , test_ZipWith6 , test_ZipWith7 ] test_ContinueContinue :: Suite test_ContinueContinue = assertions "continue-continue" $ do $expect $ equal ("AB", "AB", ["C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do (x, y) <- EB.zip (EB.take 2) (EB.take 2) extra <- EL.consume return (x, y, extra)) test_YieldContinue :: Suite test_YieldContinue = assertions "yield-continue" $ do $expect $ equal ("A", "AB", ["C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do (x, y) <- EB.zip (EB.take 1) (EB.take 2) extra <- EL.consume return (x, y, extra)) test_ContinueYield :: Suite test_ContinueYield = assertions "continue-yield" $ do $expect $ equal ("AB", "A", ["C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do (x, y) <- EB.zip (EB.take 2) (EB.take 1) extra <- EL.consume return (x, y, extra)) test_YieldYield :: Suite test_YieldYield = assertions "yield-yield" $ do $expect $ equal ("A", "A", ["B", "C"]) (E.runLists_ [["A"], ["B"], ["C"]] $ do (x, y) <- EB.zip (EB.take 1) (EB.take 1) extra <- EL.consume return (x, y, extra)) test_ErrorFirst :: Suite test_ErrorFirst = assertions "error-first" $ do $expect $ equalExc (Exc.ErrorCall "error") (E.runLists [["A"], ["B"], ["C"]] $ do EB.zip (E.throwError (Exc.ErrorCall "error")) (EB.take 1)) test_ErrorSecond :: Suite test_ErrorSecond = assertions "error-second" $ do $expect $ equalExc (Exc.ErrorCall "error") (E.runLists [["A"], ["B"], ["C"]] $ do EB.zip (EB.take 1) (E.throwError (Exc.ErrorCall "error"))) test_HandleEOF :: Suite test_HandleEOF = assertions "handle-eof" $ do $expect $ equal ("A", "AB", []) (E.runLists_ [["A"], ["B"]] $ do (x, y) <- EB.zip (EB.take 1) (EB.take 3) extra <- EL.consume return (x, y, extra)) test_Zip3 :: Suite test_Zip3 = test_ZipN "zip3" (EB.zip3 EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41) test_Zip4 :: Suite test_Zip4 = test_ZipN "zip4" (EB.zip4 EB.head EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41, Just 0x41) test_Zip5 :: Suite test_Zip5 = test_ZipN "zip5" (EB.zip5 EB.head EB.head EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41) test_Zip6 :: Suite test_Zip6 = test_ZipN "zip6" (EB.zip6 EB.head EB.head EB.head EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41) test_Zip7 :: Suite test_Zip7 = test_ZipN "zip7" (EB.zip7 EB.head EB.head EB.head EB.head EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41) test_ZipWith :: Suite test_ZipWith = test_ZipN "zipWith" (EB.zipWith (,) EB.head EB.head) (Just 0x41, Just 0x41) test_ZipWith3 :: Suite test_ZipWith3 = test_ZipN "zipWith3" (EB.zipWith3 (,,) EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41) test_ZipWith4 :: Suite test_ZipWith4 = test_ZipN "zipWith4" (EB.zipWith4 (,,,) EB.head EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41, Just 0x41) test_ZipWith5 :: Suite test_ZipWith5 = test_ZipN "zipWith5" (EB.zipWith5 (,,,,) EB.head EB.head EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41) test_ZipWith6 :: Suite test_ZipWith6 = test_ZipN "zipWith6" (EB.zipWith6 (,,,,,) EB.head EB.head EB.head EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41) test_ZipWith7 :: Suite test_ZipWith7 = test_ZipN "zipWith7" (EB.zipWith7 (,,,,,,) EB.head EB.head EB.head EB.head EB.head EB.head EB.head) (Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41, Just 0x41) enumerator-0.4.19/tests/EnumeratorTests/List/0000755000000000000000000000000011740377455017412 5ustar0000000000000000enumerator-0.4.19/tests/EnumeratorTests/List/Repeat.hs0000644000000000000000000000216111740377455021166 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Repeat ( test_Repeat , test_RepeatM , test_GenerateM ) where import Control.Monad.Trans.State import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL test_Repeat :: Suite test_Repeat = assertions "repeat" $ do $expect $ equal ['A', 'A', 'A'] (runIdentity (E.run_ (EL.repeat 'A' $$ EL.take 3))) test_RepeatM :: Suite test_RepeatM = assertions "repeatM" $ do let step = do c <- get put (succ c) return c $expect $ equal ['A', 'B', 'C'] (evalState (E.run_ (EL.repeatM step $$ EL.take 3)) 'A') test_GenerateM :: Suite test_GenerateM = assertions "generateM" $ do let step = do c <- get if c > 'C' then return Nothing else do put (succ c) return (Just c) $expect $ equal ['A', 'B', 'C'] (evalState (E.run_ (EL.generateM step $$ EL.consume)) 'A') enumerator-0.4.19/tests/EnumeratorTests/List/Consume.hs0000644000000000000000000000452611740377455021366 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Consume ( test_Consume , test_Head , test_Head_ , test_Take , test_TakeWhile ) where import Control.Exception import Test.Chell import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import EnumeratorTests.Util (equalExc) test_Consume :: Suite test_Consume = assertions "consume" $ do $expect $ equal (['A', 'B', 'C'], Nothing) (E.runLists_ [[], ['A', 'B'], ['C']] $ do xs <- EL.consume h <- EL.head return (xs, h)) test_Head :: Suite test_Head = assertions "head" $ do $expect $ equal (Just 'A', ['B', 'C']) (E.runLists_ [[], ['A', 'B'], ['C']] $ do x <- EL.head extra <- EL.consume return (x, extra)) $expect $ equal (Nothing :: Maybe Char, []) (E.runLists_ [] $ do x <- EL.head extra <- EL.consume return (x, extra)) test_Head_ :: Suite test_Head_ = assertions "head_" $ do $expect $ equal ('A', ['B', 'C']) (E.runLists_ [[], ['A', 'B'], ['C']] $ do x <- EL.head_ extra <- EL.consume return (x, extra)) $expect $ equalExc (ErrorCall "head_: stream has ended") (E.runLists [] $ do x <- EL.head_ extra <- EL.consume return (x, extra)) test_Take :: Suite test_Take = assertions "take" $ do $expect $ equal (['A', 'B', 'C'], ['D', 'E']) (E.runLists_ [['A', 'B'], ['C', 'D'], ['E']] $ do x <- EL.take 3 extra <- EL.consume return (x, extra)) $expect $ equal (['A', 'B'], []) (E.runLists_ [['A'], ['B']] $ do x <- EL.take 3 extra <- EL.consume return (x, extra)) $expect $ equal ([], ['A', 'B']) (E.runLists_ [['A'], ['B']] $ do x <- EL.take 0 extra <- EL.consume return (x, extra)) test_TakeWhile :: Suite test_TakeWhile = assertions "takeWhile" $ do $expect $ equal (['A', 'B', 'C'], ['D', 'E']) (E.runLists_ [[], ['A', 'B'], ['C', 'D'], ['E']] $ do x <- EL.takeWhile (< 'D') extra <- EL.consume return (x, extra)) $expect $ equal (['A', 'B'], []) (E.runLists_ [['A'], ['B']] $ do x <- EL.takeWhile (< 'D') extra <- EL.consume return (x, extra)) $expect $ equal ([], ['A', 'B']) (E.runLists_ [['A'], ['B']] $ do x <- EL.takeWhile (< 'A') extra <- EL.consume return (x, extra)) enumerator-0.4.19/tests/EnumeratorTests/List/Unique.hs0000644000000000000000000000105011740377455021210 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Unique ( test_Unique ) where import Test.Chell import Data.Enumerator ((=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL test_Unique :: Suite test_Unique = assertions "unique" $ do $expect $ equal ['B', 'A', 'C'] (E.runLists_ [['B'], ['A'], ['B'], ['C'], ['A']] $ do EL.unique =$ EL.consume) enumerator-0.4.19/tests/EnumeratorTests/List/Split.hs0000644000000000000000000000131411740377455021040 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Split ( test_SplitWhen ) where import qualified Data.List.Split as LS import Test.Chell import Test.Chell.QuickCheck import Data.Enumerator ((=$)) import qualified Data.Enumerator.List as EL import EnumeratorTests.List.Util test_SplitWhen :: Suite test_SplitWhen = property "splitWhen" $ prop_ListX (\x -> do xs <- 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, [])) enumerator-0.4.19/tests/EnumeratorTests/List/Unfold.hs0000644000000000000000000000157611740377455021206 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Unfold ( test_Unfold , test_UnfoldM ) where import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL test_Unfold :: Suite test_Unfold = assertions "unfold" $ do let step x = if x > 'C' then Nothing else Just (x, succ x) $expect $ equal ['A', 'B', 'C'] (runIdentity (E.run_ (EL.unfold step 'A' $$ EL.consume))) test_UnfoldM :: Suite test_UnfoldM = assertions "unfoldM" $ do let step x = return $ if x > 'C' then Nothing else Just (x, succ x) $expect $ equal ['A', 'B', 'C'] (runIdentity (E.run_ (EL.unfoldM step 'A' $$ EL.consume))) enumerator-0.4.19/tests/EnumeratorTests/List/Fold.hs0000644000000000000000000000372011740377455020634 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Fold ( test_Fold , test_FoldM ) where import qualified Control.Exception as Exception import Control.Monad (foldM) import Data.Functor.Identity (runIdentity) import Data.List (foldl') import Test.Chell import Test.Chell.QuickCheck import Test.QuickCheck.Poly import Test.QuickCheck.Modifiers import qualified Data.Enumerator as E import Data.Enumerator (($$)) import qualified Data.Enumerator.List as EL import EnumeratorTests.List.Util () test_Fold :: Suite test_Fold = suite "fold" [ property "model" prop_Fold , test_FoldStrict , test_Fold_EOF ] prop_Fold :: Blind (B -> A -> B) -> B -> [A] -> Bool prop_Fold (Blind f) z xs = result == expected where result = E.runLists_ [xs] (EL.fold f z) expected = foldl' f z xs test_FoldStrict :: Suite test_FoldStrict = assertions "strict" $ do let exc = Exception.ErrorCall "fail-step" let step _ x = case x of 'C' -> Exception.throw exc _ -> 'a' $expect $ throwsEq exc (E.run_ (E.enumList 1 ['A', 'B', 'C'] $$ EL.fold step 'a')) $expect $ throwsEq exc (E.run_ (E.enumList 3 ['A', 'B', 'C'] $$ EL.fold step 'a')) test_Fold_EOF :: Suite test_Fold_EOF = assertions "eof" $ do $expect $ equal Nothing (E.runLists_ [] $ do _ <- EL.fold (++) ['A'] EL.head) test_FoldM :: Suite test_FoldM = suite "foldM" [ property "model" prop_FoldM , test_FoldM_EOF ] prop_FoldM :: Blind (B -> A -> B) -> B -> [A] -> Bool prop_FoldM (Blind f) z xs = result == expected where result = E.runLists_ [xs] (EL.foldM f' z) expected = runIdentity (foldM f' z xs) f' b a = return (f b a) test_FoldM_EOF :: Suite test_FoldM_EOF = assertions "eof" $ do $expect $ equal Nothing (E.runLists_ [] $ do _ <- EL.foldM (\x y -> return (x ++ y)) ['A'] EL.head) enumerator-0.4.19/tests/EnumeratorTests/List/Isolate.hs0000644000000000000000000000504511740377455021352 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Isolate ( test_Isolate , test_IsolateWhile ) where import Test.Chell import Test.Chell.QuickCheck import Data.Enumerator ((=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import EnumeratorTests.List.Util test_Isolate :: Suite test_Isolate = suite "isolate" [ prop_Isolate , test_Isolate_DropExtra , test_Isolate_HandleEOF , test_Isolate_BadParameter ] prop_Isolate :: Suite prop_Isolate = property "model" $ prop_List (do x <- 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')) test_Isolate_DropExtra :: Suite test_Isolate_DropExtra = assertions "drop-extra" $ do $expect $ equal (Just 'A', ['C']) (E.runLists_ [[], ['A'], ['B'], ['C']] $ do x <- EL.isolate 2 =$ EL.head extra <- EL.consume return (x, extra)) $expect $ equal (Just 'A', ['C']) (E.runLists_ [['A', 'B', 'C']] $ do x <- EL.isolate 2 =$ EL.head extra <- EL.consume return (x, extra)) test_Isolate_HandleEOF :: Suite test_Isolate_HandleEOF = assertions "handle-eof" $ do $expect $ equal (Nothing :: Maybe Char, []) (E.runLists_ [] $ do x <- EL.isolate 2 =$ EL.head extra <- EL.consume return (x, extra)) test_Isolate_BadParameter :: Suite test_Isolate_BadParameter = assertions "bad-parameter" $ do $expect $ equal (Nothing, ['A', 'B', 'C']) (E.runLists_ [['A'], ['B'], ['C']] $ do x <- EL.isolate 0 =$ EL.head extra <- EL.consume return (x, extra)) test_IsolateWhile :: Suite test_IsolateWhile = suite "isolateWhile" [ test_IsolateWhile_DropExtra , test_IsolateWhile_HandleEOF ] test_IsolateWhile_DropExtra :: Suite test_IsolateWhile_DropExtra = assertions "drop-extra" $ do $expect $ equal (Just 'A', ['C']) (E.runLists_ [[], ['A'], ['B'], ['C']] $ do x <- EL.isolateWhile (< 'C') =$ EL.head extra <- EL.consume return (x, extra)) $expect $ equal (Just 'A', ['C']) (E.runLists_ [['A', 'B', 'C']] $ do x <- EL.isolateWhile (< 'C') =$ EL.head extra <- EL.consume return (x, extra)) test_IsolateWhile_HandleEOF :: Suite test_IsolateWhile_HandleEOF = assertions "handle-eof" $ do $expect $ equal (Nothing :: Maybe Char, []) (E.runLists_ [] $ do x <- EL.isolateWhile (< 'C') =$ EL.head extra <- EL.consume return (x, extra)) enumerator-0.4.19/tests/EnumeratorTests/List/Require.hs0000644000000000000000000000275511740377455021373 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Require ( test_Require ) where import qualified Control.Exception as Exc import Test.Chell import Test.Chell.QuickCheck import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import EnumeratorTests.List.Util (prop_ListN) import EnumeratorTests.Util (equalExc) test_Require :: Suite test_Require = suite "require" [ prop_Require , test_YieldsInput , test_HandleEOF , test_BadParameter ] prop_Require :: Suite prop_Require = property "model" $ prop_ListN (\n -> do EL.require n EL.consume) (\n xs -> if n > toInteger (length xs) then Left (Exc.ErrorCall "require: Unexpected EOF") else Right xs) test_YieldsInput :: Suite test_YieldsInput = assertions "yields-input" $ do $expect $ equal ['A', 'B', 'C'] (E.runLists_ [['A'], ['B'], ['C']] $ do EL.require 2 EL.consume) $expect $ equal ['A', 'B', 'C'] (E.runLists_ [['A', 'B', 'C']] $ do EL.require 2 EL.consume) test_HandleEOF :: Suite test_HandleEOF = assertions "handle-eof" $ do $expect $ equalExc (Exc.ErrorCall "require: Unexpected EOF") (E.runLists [] $ do EL.require 2 EL.consume) test_BadParameter :: Suite test_BadParameter = assertions "bad-parameter" $ do $expect $ equal ([] :: [Char]) (E.runLists_ [] $ do EL.require 0 EL.consume) enumerator-0.4.19/tests/EnumeratorTests/List/Util.hs0000644000000000000000000000423411740377455020666 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Util ( test_Enumeratee , prop_List , prop_ListN , prop_ListX ) where import qualified Control.Exception as Exc import Data.Functor.Identity (Identity, runIdentity) import qualified Data.Text as T import Test.Chell import Test.Chell.QuickCheck import Test.QuickCheck hiding (property) import Test.QuickCheck.Poly (A) import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import EnumeratorTests.Util (check) 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 prop_List :: Eq b => E.Iteratee A Identity b -> ([A] -> Either Exc.ErrorCall b) -> [A] -> Bool prop_List iter plain = prop where prop :: [A] -> Bool prop = check iter plain prop_ListN :: Eq b => (Integer -> E.Iteratee A Identity b) -> (Integer -> [A] -> Either Exc.ErrorCall b) -> Positive Integer -> [A] -> Bool prop_ListN iter plain = prop where prop :: Positive Integer -> [A] -> Bool prop (Positive n) = check (iter n) (plain n) prop_ListX :: Eq b => (A -> E.Iteratee A Identity b) -> (A -> [A] -> Either Exc.ErrorCall b) -> A -> [A] -> Bool prop_ListX iter plain = prop where prop :: A -> [A] -> Bool prop x = check (iter x) (plain x) enumerator-0.4.19/tests/EnumeratorTests/List/Replicate.hs0000644000000000000000000000205011740377455021653 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Replicate ( test_Replicate , test_ReplicateM ) where import Control.Monad.Trans.State import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL test_Replicate :: Suite test_Replicate = assertions "replicate" $ do $expect $ equal ['A', 'A', 'A'] (runIdentity (E.run_ (EL.replicate 3 'A' $$ EL.consume))) $expect $ equal ['A', 'A'] (runIdentity (E.run_ (EL.replicate 3 'A' $$ EL.take 2))) test_ReplicateM :: Suite test_ReplicateM = assertions "replicateM" $ do let step = do c <- get put (succ c) return c $expect $ equal ['A', 'B', 'C'] (evalState (E.run_ (EL.replicateM 3 step $$ EL.consume)) 'A') $expect $ equal ['A', 'B'] (evalState (E.run_ (EL.replicateM 3 step $$ EL.take 2)) 'A') enumerator-0.4.19/tests/EnumeratorTests/List/Iterate.hs0000644000000000000000000000143211740377455021343 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Iterate ( test_Iterate , test_IterateM ) where import Data.Functor.Identity (runIdentity) import Test.Chell import Data.Enumerator (($$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL test_Iterate :: Suite test_Iterate = assertions "iterate" $ do $expect $ equal ['A', 'B', 'C'] (runIdentity (E.run_ (EL.iterate succ 'A' $$ EL.take 3))) test_IterateM :: Suite test_IterateM = assertions "iterateM" $ do let succM = return . succ $expect $ equal ['A', 'B', 'C'] (runIdentity (E.run_ (EL.iterateM succM 'A' $$ EL.take 3))) enumerator-0.4.19/tests/EnumeratorTests/List/Drop.hs0000644000000000000000000000277111740377455020661 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Drop ( test_Drop , test_DropWhile , test_Filter , test_FilterM ) where import Test.Chell import Data.Enumerator ((=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL test_Drop :: Suite test_Drop = assertions "drop" $ do $expect $ equal ['A', 'B', 'C', 'D', 'E'] (E.runLists_ [['A'], ['B'], ['C'], ['D'], ['E']] $ do EL.drop 0 EL.consume) $expect $ equal ['C', 'D', 'E'] (E.runLists_ [['A'], ['B'], ['C'], ['D'], ['E']] $ do EL.drop 2 EL.consume) $expect $ equal [] (E.runLists_ [['A']] $ do EL.drop 2 EL.consume) test_DropWhile :: Suite test_DropWhile = assertions "dropWhile" $ do $expect $ equal ['C', 'D', 'E'] (E.runLists_ [['A'], ['B'], ['C'], ['D'], ['E']] $ do EL.dropWhile (< 'C') EL.consume) $expect $ equal [] (E.runLists_ [['A'], ['B'], ['C'], ['D'], ['E']] $ do EL.dropWhile (\_ -> True) EL.consume) test_Filter :: Suite test_Filter = assertions "filter" $ do $expect $ equal ['A', 'B', 'D', 'E'] (E.runLists_ [['A'], ['B'], ['C'], ['D'], ['E']] $ do EL.filter (/= 'C') =$ EL.consume) test_FilterM :: Suite test_FilterM = assertions "filterM" $ do $expect $ equal ['A', 'B', 'D', 'E'] (E.runLists_ [['A'], ['B'], ['C'], ['D'], ['E']] $ do EL.filterM (\x -> return (x /= 'C')) =$ EL.consume) enumerator-0.4.19/tests/EnumeratorTests/List/Map.hs0000644000000000000000000000755311740377455020475 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Map ( test_Map , test_MapM , test_MapM_ , test_ConcatMap , test_ConcatMapM , test_ConcatMapAccum , test_ConcatMapAccumM , test_MapAccum , test_MapAccumM ) where import Control.Monad.Trans.Writer (execWriter, tell) import Data.Char (chr, ord, toLower) import Test.Chell import Data.Enumerator (($$), (=$)) import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL test_Map :: Suite test_Map = assertions "map" $ do $expect $ equal ['a', 'b', 'c'] (E.runLists_ [['A', 'B'], ['C']] $ do EL.map toLower =$ EL.consume) $expect $ equal (['a'], ['B', 'C']) (E.runLists_ [['A', 'B'], ['C']] $ do xs <- EL.map toLower =$ EL.take 1 extra <- EL.consume return (xs, extra)) test_MapM :: Suite test_MapM = assertions "mapM" $ do let step = return . toLower $expect $ equal ['a', 'b', 'c'] (E.runLists_ [['A', 'B'], ['C']] $ do EL.mapM step =$ EL.consume) $expect $ equal (['a'], ['B', 'C']) (E.runLists_ [['A', 'B'], ['C']] $ do xs <- EL.mapM step =$ EL.take 1 extra <- EL.consume return (xs, extra)) test_MapM_ :: Suite test_MapM_ = assertions "mapM_" $ do $expect $ equal ['A', 'B', 'C'] (execWriter (E.run_ (E.enumList 1 ['A', 'B', 'C'] $$ EL.mapM_ (\x -> tell [x])))) test_ConcatMap :: Suite test_ConcatMap = assertions "concatMap" $ do let step ao = [ao, toLower ao] $expect $ equal ['A', 'a', 'B', 'b', 'C', 'c'] (E.runLists_ [['A', 'B'], ['C']] $ do EL.concatMap step =$ EL.consume) $expect $ equal (['A', 'a'], ['B', 'C']) (E.runLists_ [['A', 'B'], ['C']] $ do xs <- EL.concatMap step =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_ConcatMapM :: Suite test_ConcatMapM = assertions "concatMapM" $ do let step ao = return [ao, toLower ao] $expect $ equal ['A', 'a', 'B', 'b', 'C', 'c'] (E.runLists_ [['A', 'B'], ['C']] $ do EL.concatMapM step =$ EL.consume) $expect $ equal (['A', 'a'], ['B', 'C']) (E.runLists_ [['A', 'B'], ['C']] $ do xs <- EL.concatMapM step =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_MapAccum :: Suite test_MapAccum = assertions "mapAccum" $ do let step s ao = (s + 1, chr (ord ao + s)) $expect $ equal ['B', 'D', 'F'] (E.runLists_ [['A', 'B'], ['C']] $ do EL.mapAccum step 1 =$ EL.consume) $expect $ equal (['B'], ['B', 'C']) (E.runLists_ [['A', 'B'], ['C']] $ do xs <- EL.mapAccum step 1 =$ EL.take 1 extra <- EL.consume return (xs, extra)) test_MapAccumM :: Suite test_MapAccumM = assertions "mapAccumM" $ do let step s ao = return (s + 1, chr (ord ao + s)) $expect $ equal ['B', 'D', 'F'] (E.runLists_ [['A', 'B'], ['C']] $ do EL.mapAccumM step 1 =$ EL.consume) $expect $ equal (['B'], ['B', 'C']) (E.runLists_ [['A', 'B'], ['C']] $ do xs <- EL.mapAccumM step 1 =$ EL.take 1 extra <- EL.consume return (xs, extra)) test_ConcatMapAccum :: Suite test_ConcatMapAccum = assertions "concatMapAccum" $ do let step s ao = (s + 1, replicate s ao) $expect $ equal ['A', 'B', 'B', 'C', 'C', 'C'] (E.runLists_ [['A', 'B'], ['C']] $ do EL.concatMapAccum step 1 =$ EL.consume) $expect $ equal (['A', 'B'], ['C']) (E.runLists_ [['A', 'B'], ['C']] $ do xs <- EL.concatMapAccum step 1 =$ EL.take 2 extra <- EL.consume return (xs, extra)) test_ConcatMapAccumM :: Suite test_ConcatMapAccumM = assertions "concatMapAccumM" $ do let step s ao = return (s + 1, replicate s ao) $expect $ equal ['A', 'B', 'B', 'C', 'C', 'C'] (E.runLists_ [['A', 'B'], ['C']] $ do EL.concatMapAccumM step 1 =$ EL.consume) $expect $ equal (['A', 'B'], ['C']) (E.runLists_ [['A', 'B'], ['C']] $ do xs <- EL.concatMapAccumM step 1 =$ EL.take 2 extra <- EL.consume return (xs, extra)) enumerator-0.4.19/tests/EnumeratorTests/List/Zip.hs0000644000000000000000000001131411740377455020510 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2010 John Millikin -- -- See license.txt for details module EnumeratorTests.List.Zip ( test_Zip ) where import qualified Control.Exception as Exc import Data.Functor.Identity (Identity) import Data.Text (Text) import Test.Chell import qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL import EnumeratorTests.List.Util () import EnumeratorTests.Util (equalExc) test_ZipN :: (Eq b, Show b) => Text -> E.Iteratee Char Identity b -> b -> Suite test_ZipN name iter expected = assertions name $ do $expect $ equal expected (E.runLists_ [[], ['A'], ['B']] iter) $([d||]) test_Zip :: Suite test_Zip = suite "zip" [ test_ContinueContinue , test_YieldContinue , test_ContinueYield , test_YieldYield , test_ErrorFirst , test_ErrorSecond , test_HandleEOF , test_Zip3 , test_Zip4 , test_Zip5 , test_Zip6 , test_Zip7 , test_ZipWith , test_ZipWith3 , test_ZipWith4 , test_ZipWith5 , test_ZipWith6 , test_ZipWith7 ] test_ContinueContinue :: Suite test_ContinueContinue = assertions "continue-continue" $ do $expect $ equal (['A', 'B'], ['A', 'B'], ['C']) (E.runLists_ [['A'], ['B'], ['C']] $ do (x, y) <- EL.zip (EL.take 2) (EL.take 2) extra <- EL.consume return (x, y, extra)) test_YieldContinue :: Suite test_YieldContinue = assertions "yield-continue" $ do $expect $ equal (['A'], ['A', 'B'], ['C']) (E.runLists_ [['A'], ['B'], ['C']] $ do (x, y) <- EL.zip (EL.take 1) (EL.take 2) extra <- EL.consume return (x, y, extra)) test_ContinueYield :: Suite test_ContinueYield = assertions "continue-yield" $ do $expect $ equal (['A', 'B'], ['A'], ['C']) (E.runLists_ [['A'], ['B'], ['C']] $ do (x, y) <- EL.zip (EL.take 2) (EL.take 1) extra <- EL.consume return (x, y, extra)) test_YieldYield :: Suite test_YieldYield = assertions "yield-yield" $ do $expect $ equal (['A'], ['A'], ['B', 'C']) (E.runLists_ [['A'], ['B'], ['C']] $ do (x, y) <- EL.zip (EL.take 1) (EL.take 1) extra <- EL.consume return (x, y, extra)) test_ErrorFirst :: Suite test_ErrorFirst = assertions "error-first" $ do $expect $ equalExc (Exc.ErrorCall "error") (E.runLists [['A'], ['B'], ['C']] $ do EL.zip (E.throwError (Exc.ErrorCall "error")) (EL.take 1)) test_ErrorSecond :: Suite test_ErrorSecond = assertions "error-second" $ do $expect $ equalExc (Exc.ErrorCall "error") (E.runLists [['A'], ['B'], ['C']] $ do EL.zip (EL.take 1) (E.throwError (Exc.ErrorCall "error"))) test_HandleEOF :: Suite test_HandleEOF = assertions "handle-eof" $ do $expect $ equal (['A'], ['A', 'B'], []) (E.runLists_ [['A'], ['B']] $ do (x, y) <- EL.zip (EL.take 1) (EL.take 3) extra <- EL.consume return (x, y, extra)) $expect $ equal (['a'], ['b'], []) (E.runLists_ [['A'], ['B']] $ do (x, y) <- EL.zip (E.yield ['a'] (E.Chunks [])) (E.yield ['b'] E.EOF) extra <- EL.consume return (x, y, extra)) test_Zip3 :: Suite test_Zip3 = test_ZipN "zip3" (EL.zip3 EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A') test_Zip4 :: Suite test_Zip4 = test_ZipN "zip4" (EL.zip4 EL.head EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A', Just 'A') test_Zip5 :: Suite test_Zip5 = test_ZipN "zip5" (EL.zip5 EL.head EL.head EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_Zip6 :: Suite test_Zip6 = test_ZipN "zip6" (EL.zip6 EL.head EL.head EL.head EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_Zip7 :: Suite test_Zip7 = test_ZipN "zip7" (EL.zip7 EL.head EL.head EL.head EL.head EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_ZipWith :: Suite test_ZipWith = test_ZipN "zipWith" (EL.zipWith (,) EL.head EL.head) (Just 'A', Just 'A') test_ZipWith3 :: Suite test_ZipWith3 = test_ZipN "zipWith3" (EL.zipWith3 (,,) EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A') test_ZipWith4 :: Suite test_ZipWith4 = test_ZipN "zipWith4" (EL.zipWith4 (,,,) EL.head EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A', Just 'A') test_ZipWith5 :: Suite test_ZipWith5 = test_ZipN "zipWith5" (EL.zipWith5 (,,,,) EL.head EL.head EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_ZipWith6 :: Suite test_ZipWith6 = test_ZipN "zipWith6" (EL.zipWith6 (,,,,,) EL.head EL.head EL.head EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') test_ZipWith7 :: Suite test_ZipWith7 = test_ZipN "zipWith7" (EL.zipWith7 (,,,,,,) EL.head EL.head EL.head EL.head EL.head EL.head EL.head) (Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A', Just 'A') enumerator-0.4.19/scripts/0000755000000000000000000000000011740377455013660 5ustar0000000000000000enumerator-0.4.19/scripts/common.bash0000644000000000000000000000067011740377455016012 0ustar0000000000000000PATH="$PATH:$PWD/cabal-dev/bin/" VERSION=$(awk '/^version:/{print $2}' enumerator.cabal) CABAL_DEV=$(which cabal-dev) XZ=$(which xz) require_cabal_dev() { if [ -z "$CABAL_DEV" ]; then echo "Can't find 'cabal-dev' executable; make sure it exists on your "'$PATH' echo "Cowardly refusing to fuck with the global package database" exit 1 fi } clean_dev_install() { require_cabal_dev rm -rf dist $CABAL_DEV install || exit 1 } enumerator-0.4.19/scripts/dist0000755000000000000000000000171411740377455014554 0ustar0000000000000000#!/bin/bash if [ ! -f 'enumerator.cabal' ]; then echo -n "Can't find enumerator.cabal; please run this script as" echo -n " ./scripts/dist from within the enumerator source" echo " directory" exit 1 fi . scripts/common.bash require_cabal_dev echo "Building dist for enumerator_$VERSION using $CABAL_DEV" rm -rf dist $CABAL_DEV configure || exit 1 $CABAL_DEV build || exit 1 $CABAL_DEV sdist || exit 1 mv "dist/enumerator-$VERSION.tar.gz" "./enumerator_$VERSION.tar.gz" ln -f "./enumerator_$VERSION.tar.gz" "./enumerator-$VERSION.tar.gz" if [ -n "$XZ" ]; then gzip -dfc "enumerator_$VERSION.tar.gz" > "enumerator_$VERSION.tar" xz -f -C sha256 -9 "enumerator_$VERSION.tar" fi echo "" echo "============================================================" echo " source archive (gz) : enumerator_$VERSION.tar.gz" if [ -n "$XZ" ]; then echo " source archive (xz) : enumerator_$VERSION.tar.xz" fi echo "============================================================" enumerator-0.4.19/scripts/run-coverage0000755000000000000000000000531311740377455016205 0ustar0000000000000000#!/bin/bash if [ ! -f 'enumerator.cabal' ]; then echo -n "Can't find enumerator.cabal; please run this script as" echo -n " ./scripts/run-coverage from within the enumerator source" echo " directory" exit 1 fi . scripts/common.bash require_cabal_dev pushd tests $CABAL_DEV -s ../cabal-dev install --flags="coverage" || exit 1 popd rm -f enumerator_tests.tix cabal-dev/bin/enumerator_tests $@ EXCLUDES="\ --exclude=Main \ --exclude=EnumeratorTests.Binary \ --exclude=EnumeratorTests.Binary.Consume \ --exclude=EnumeratorTests.Binary.Drop \ --exclude=EnumeratorTests.Binary.Fold \ --exclude=EnumeratorTests.Binary.Handle \ --exclude=EnumeratorTests.Binary.Isolate \ --exclude=EnumeratorTests.Binary.Iterate \ --exclude=EnumeratorTests.Binary.Map \ --exclude=EnumeratorTests.Binary.Repeat \ --exclude=EnumeratorTests.Binary.Replicate \ --exclude=EnumeratorTests.Binary.Require \ --exclude=EnumeratorTests.Binary.Split \ --exclude=EnumeratorTests.Binary.Unfold \ --exclude=EnumeratorTests.Binary.Util \ --exclude=EnumeratorTests.Binary.Zip \ --exclude=EnumeratorTests.CatchError \ --exclude=EnumeratorTests.Compatibility \ --exclude=EnumeratorTests.Instances \ --exclude=EnumeratorTests.Join \ --exclude=EnumeratorTests.List \ --exclude=EnumeratorTests.List.Consume \ --exclude=EnumeratorTests.List.Drop \ --exclude=EnumeratorTests.List.Fold \ --exclude=EnumeratorTests.List.Isolate \ --exclude=EnumeratorTests.List.Iterate \ --exclude=EnumeratorTests.List.Map \ --exclude=EnumeratorTests.List.Repeat \ --exclude=EnumeratorTests.List.Replicate \ --exclude=EnumeratorTests.List.Require \ --exclude=EnumeratorTests.List.Split \ --exclude=EnumeratorTests.List.Unfold \ --exclude=EnumeratorTests.List.Unique \ --exclude=EnumeratorTests.List.Util \ --exclude=EnumeratorTests.List.Zip \ --exclude=EnumeratorTests.Misc \ --exclude=EnumeratorTests.Sequence \ --exclude=EnumeratorTests.Stream \ --exclude=EnumeratorTests.Text \ --exclude=EnumeratorTests.Text.Codecs \ --exclude=EnumeratorTests.Text.Consume \ --exclude=EnumeratorTests.Text.Drop \ --exclude=EnumeratorTests.Text.Fold \ --exclude=EnumeratorTests.Text.Handle \ --exclude=EnumeratorTests.Text.Isolate \ --exclude=EnumeratorTests.Text.Iterate \ --exclude=EnumeratorTests.Text.Map \ --exclude=EnumeratorTests.Text.Repeat \ --exclude=EnumeratorTests.Text.Replicate \ --exclude=EnumeratorTests.Text.Require \ --exclude=EnumeratorTests.Text.Split \ --exclude=EnumeratorTests.Text.Unfold \ --exclude=EnumeratorTests.Text.Util \ --exclude=EnumeratorTests.Text.Zip \ --exclude=EnumeratorTests.Trans \ --exclude=EnumeratorTests.Util" hpc markup --srcdir=src/ --srcdir=tests/ enumerator_tests.tix --destdir=hpc-markup $EXCLUDES > /dev/null hpc report --srcdir=src/ --srcdir=tests/ enumerator_tests.tix $EXCLUDES enumerator-0.4.19/scripts/run-benchmarks0000755000000000000000000000061511740377455016527 0ustar0000000000000000#!/bin/bash if [ ! -f 'enumerator.cabal' ]; then echo -n "Can't find enumerator.cabal; please run this script as" echo -n " ./scripts/run-benchmarks from within the enumerator source" echo " directory" exit 1 fi . scripts/common.bash require_cabal_dev clean_dev_install pushd benchmarks rm -rf dist $CABAL_DEV -s ../cabal-dev install || exit 1 popd cabal-dev/bin/enumerator_benchmarks $@ enumerator-0.4.19/scripts/run-tests0000755000000000000000000000057711740377455015563 0ustar0000000000000000#!/bin/bash if [ ! -f 'enumerator.cabal' ]; then echo -n "Can't find enumerator.cabal; please run this script as" echo -n " ./scripts/run-tests from within the enumerator source" echo " directory" exit 1 fi . scripts/common.bash require_cabal_dev # clean_dev_install pushd tests # rm -rf dist $CABAL_DEV -s ../cabal-dev install || exit 1 popd cabal-dev/bin/enumerator_tests enumerator-0.4.19/examples/0000755000000000000000000000000011740377455014007 5ustar0000000000000000enumerator-0.4.19/examples/cat.hs0000644000000000000000000000215011740377455015110 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Copyright: 2010 John Millikin -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- ----------------------------------------------------------------------------- module Main (main) where import Data.Enumerator import Data.Enumerator.Binary (enumFile, enumHandle, iterHandle) import System.IO (stdin, stdout) import System.Environment (getArgs) main :: IO () main = do -- Our example enumlates standard /bin/cat, where if the argument list -- is empty, data is echoed from stdin. args <- getArgs let enum = if null args then enumHandle 1 stdin else concatEnums (Prelude.map enumFile args) -- 'run' sends an EOF to an iteratee and returns its output, which -- is either a 'Yield' or an 'Error'. res <- run (enum $$ iterHandle stdout) -- Finally, 'run' has returned either an error or the iteratee's -- result. 'iterHandle' doesn't return a useful result, so as long -- as it succeeded the actual value is ignored. case res of Left err -> putStrLn $ "ERROR: " ++ show err Right _ -> return () enumerator-0.4.19/examples/wc.hs0000644000000000000000000000555211740377455014763 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Copyright: 2010 John Millikin -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- ----------------------------------------------------------------------------- module Main (main) where import Control.Monad (unless, forM_) import Data.ByteString (ByteString) import System.Console.GetOpt import System.IO import System.Environment import System.Exit import Data.Enumerator as E import qualified Data.Enumerator.Binary as Binary import qualified Data.Enumerator.Text as Text -- support wc modes -c (bytes), -m (characters), and -l (lines) -- iterBytes simply counts how many bytes are in each chunk, accumulates this -- count, and returns it when EOF is received. iterBytes :: Monad m => Iteratee ByteString m Integer iterBytes = Binary.fold (\acc _ -> acc + 1) 0 -- iterLines is similar, except it only counts newlines ('\n') iterLines :: Monad m => Iteratee ByteString m Integer iterLines = Binary.fold step 0 where step acc 0xA = acc + 1 step acc _ = acc -- iterChars is a bit more complicated. It has to decode the input (for now, -- assuming UTF-8) before performing any counting. Leftover bytes, not part -- of a valid UTF-8 character, are yielded as surplus -- -- Note the use of (=$). This lets an enumeratee send data directly to an -- iteratee, without worrying about leftover input. iterChars :: Monad m => Iteratee ByteString m Integer iterChars = Text.decode Text.utf8 =$ Text.fold (\acc _ -> acc + 1) 0 main :: IO () main = do (mode, files) <- getMode -- Exactly matching wc's output is too annoying, so this example -- will just print one line per file, and support counting at most -- one statistic per run let iter = case mode of OptionBytes -> iterBytes OptionLines -> iterLines OptionChars -> iterChars forM_ files $ \filename -> do putStr (filename ++ ": ") eitherStat <- run (Binary.enumFile filename $$ iter) putStrLn $ case eitherStat of Left err -> "ERROR: " ++ show err Right stat -> show stat -- uninteresting option parsing follows data Option = OptionBytes | OptionChars | OptionLines optionInfo :: [OptDescr Option] optionInfo = [ Option ['c'] ["bytes"] (NoArg OptionBytes) "count bytes" , Option ['m'] ["chars"] (NoArg OptionChars) "count characters" , Option ['l'] ["lines"] (NoArg OptionLines) "count lines" ] usage :: String -> String usage name = "Usage: " ++ name ++ " [FILES]" getMode :: IO (Option, [FilePath]) getMode = do args <- getArgs let (options, files, errors) = getOpt Permute optionInfo args unless (null errors && not (null options) && not (null files)) $ do name <- getProgName hPutStrLn stderr $ concat errors hPutStrLn stderr $ usageInfo (usage name) optionInfo exitFailure return (Prelude.head options, files) enumerator-0.4.19/benchmarks/0000755000000000000000000000000011740377455014306 5ustar0000000000000000enumerator-0.4.19/benchmarks/Benchmarks.hs0000644000000000000000000000573211740377455016726 0ustar0000000000000000-- 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 enumerator-0.4.19/benchmarks/enumerator-benchmarks.cabal0000644000000000000000000000047411740377455021573 0ustar0000000000000000name: 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