diff --git a/Examples/cat.hs b/Examples/cat.hs deleted file mode 100644 --- a/Examples/cat.hs +++ /dev/null @@ -1,122 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- ------------------------------------------------------------------------------ -module Main (main) where -import Prelude as Prelude -import Control.Exception as E -import Data.Enumerator -import qualified Data.ByteString as B -import qualified Foreign as F -import System.IO -import System.IO.Error (isEOFError) -import System.Environment (getArgs) - --- The following definitions of 'enumHandle', 'enumFile', and 'iterHandle' are --- copied from "Data.Enumerator.IO", with additional comments so they're easier --- to understand. - -enumHandle :: Integer -- ^ Buffer size - -> Handle - -> Enumerator B.ByteString IO b -enumHandle bufferSize h = Iteratee . loop where - intSize = fromInteger bufferSize - - -- If more input is required before the enumerator's iteratee can - -- yield a result, feed it from the handle. - loop (Continue k) = do - -- While not strictly necessary to proper operation, catching - -- exceptions here allows more unified exception handling when - -- the enumerator/iteratee is run. - eitherBytes <- E.try $ do - - -- The enumerator must function normally when the - -- handle is something like a slow file, or network - -- socket; if there's not enough data to fill the - -- buffer yet, a partial read is returned. - hasInput <- E.catch - (hWaitForInput h (1)) - (\err -> if isEOFError err - then return False - else E.throwIO err) - - -- An EOF is represented by the empty bytestring - if hasInput - then B.hGetNonBlocking h intSize - else return B.empty - - case eitherBytes of - -- Interacting with the socket threw an IO error of - -- some sort - Left err -> return $ Error err - - -- The socket has reached EOF; pass control to the - -- next enumerator - Right bytes | B.null bytes -> return (Continue k) - - -- Bytes were read successfully; feed them to the - -- iteratee and continue looping - Right bytes -> runIteratee (k (Chunks [bytes])) >>= loop - - -- If a different step is received ('Error' or 'Yield'), just pass - -- it through. - loop step = return step - -enumFile :: FilePath -> Enumerator B.ByteString IO b -enumFile path s = Iteratee $ do - -- Opening the file can be performed either inside or outside of the - -- Iteratee. Inside allows exceptions to be caught and propagated - -- through the 'Error' step constructor. - eitherH <- E.try $ openBinaryFile path ReadMode - case eitherH of - Left err -> return $ Error err - Right h -> finally - (runIteratee (enumHandle 4096 h s)) - (hClose h) - --- 'iterHandle' is the opposite of 'enumHandle', in that it *writes to* a --- handle instead of reading from it. An enumerator is a source, an iteratee --- is a sink. -iterHandle :: Handle -> Iteratee B.ByteString IO () - --- Most iteratees start in the 'Continue' state, as they need some --- input before they can produce any value. -iterHandle h = continue step where - - -- This iteratee produces no value; its only purpose is its - -- side-effects. When 'EOF' is received, it simply yields (). - step EOF = yield () EOF - - -- When some chunks are received from the Enumeratee, they're written - -- to the handle. Any exceptions are caught and reported, as in - -- 'enumHandle'. - step (Chunks bytes) = Iteratee $ do - eitherErr <- E.try $ mapM_ (B.hPut h) bytes - return $ case eitherErr of - Left err -> Error err - _ -> Continue step - -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 () diff --git a/Examples/enumerator-wcl.hs b/Examples/enumerator-wcl.hs deleted file mode 100644 --- a/Examples/enumerator-wcl.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Main (main) where -import Data.Enumerator -import Data.Enumerator.IO -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import System.IO -import System.Environment - -iterLines :: Monad m => Iteratee e B.ByteString m Integer -iterLines = continue (step 0) where - step acc EOF = yield acc EOF - step acc (Chunks xs) = continue $ step $! foldl foldStep acc xs - foldStep acc bytes = acc + countChar '\n' bytes - -countChar :: Char -> B.ByteString -> Integer -countChar c = B8.foldl (\acc c' -> if c' == c then acc + 1 else acc) 0 - -main :: IO () -main = do - filename:_ <- getArgs - h <- openBinaryFile filename ReadMode - run (iterLines >>== enumHandle 4096 h) >>= print diff --git a/Examples/iteratee-wcl.hs b/Examples/iteratee-wcl.hs deleted file mode 100644 --- a/Examples/iteratee-wcl.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Main (main) where -import Data.Iteratee -import Data.Iteratee.IO -import Data.Iteratee.WrappedByteString -import Data.Word (Word8) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import System.IO -import System.Environment - -iterLines :: Monad m => IterateeG WrappedByteString Word8 m Integer -iterLines = IterateeG (step 0) where - step acc s@(EOF _) = return $ Done acc s - step acc (Chunk wrapped) = return $ Cont (IterateeG (step $! acc')) Nothing where - acc' = acc + countChar '\n' (unWrap wrapped) - -countChar :: Char -> B.ByteString -> Integer -countChar c = B8.foldl (\acc c' -> if c' == c then acc + 1 else acc) 0 - -main :: IO () -main = do - filename:_ <- getArgs - h <- openBinaryFile filename ReadMode - enumHandle h iterLines >>= run >>= print diff --git a/Examples/lazy-bytestring-wcl.hs b/Examples/lazy-bytestring-wcl.hs deleted file mode 100644 --- a/Examples/lazy-bytestring-wcl.hs +++ /dev/null @@ -1,16 +0,0 @@ -import qualified Data.ByteString.Lazy as B -import qualified Data.ByteString.Lazy.Char8 as B8 -import System.IO -import System.Environment - -countChar :: Char -> B.ByteString -> Integer -countChar c = B8.foldl' (\acc c' -> if c' == c then acc + 1 else acc) 0 - -countHandle :: Handle -> IO Integer -countHandle h = fmap (countChar '\n') (B.hGetContents h) - -main :: IO () -main = do - filename:_ <- getArgs - h <- openBinaryFile filename ReadMode - countHandle h >>= print diff --git a/Examples/skip.hs b/Examples/skip.hs deleted file mode 100644 --- a/Examples/skip.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Main where -import Prelude hiding (head) -import Data.Enumerator -import Control.Monad.Trans.Class - -skip :: Monad m => Enumeratee a a m b -skip (Continue k) = do - x <- head - _ <- head -- the one we're skipping - case x of - Nothing -> return $ Continue k - Just y -> do - newStep <- lift $ runIteratee $ k $ Chunks [y] - skip newStep -skip step = return step - diff --git a/Examples/strict-bytestring-wcl.hs b/Examples/strict-bytestring-wcl.hs deleted file mode 100644 --- a/Examples/strict-bytestring-wcl.hs +++ /dev/null @@ -1,21 +0,0 @@ -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import System.IO -import System.Environment - -countChar :: Char -> B.ByteString -> Integer -countChar c = B8.foldl' (\acc c' -> if c' == c then acc + 1 else acc) 0 - -countHandle :: Handle -> IO Integer -countHandle h = loop 0 where - loop acc = do - bytes <- B.hGet h 4096 - if B.null bytes - then return acc - else let acc' = acc + countChar '\n' bytes in loop $! acc' - -main :: IO () -main = do - filename:_ <- getArgs - h <- openBinaryFile filename ReadMode - countHandle h >>= print diff --git a/Examples/wc.hs b/Examples/wc.hs deleted file mode 100644 --- a/Examples/wc.hs +++ /dev/null @@ -1,108 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- ------------------------------------------------------------------------------ -module Main (main) where -import Data.Enumerator -import qualified Data.Enumerator.IO as EIO -import qualified Data.Enumerator.Text as ET -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.Text as T - --- support imports -import Control.Exception as E -import Data.List -import Control.Monad (unless, forM_) -import System.IO -import System.Console.GetOpt -import System.Environment -import System.Exit - --- 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 B.ByteString m Integer -iterBytes = continue (step 0) where - step acc EOF = yield acc EOF - step acc (Chunks xs) = continue $ step $! foldl' foldStep acc xs - foldStep acc bytes = acc + toInteger (B.length bytes) - --- iterLines is similar, except it only counts newlines ('\n') --- --- Because it's basically the same as 'iterBytes', we use it to demonstrate --- the 'liftFoldL\'' helper function. - -iterLines :: Monad m => Iteratee B.ByteString m Integer -iterLines = liftFoldL' step 0 where - step acc bytes = acc + countChar '\n' bytes - countChar c = B8.foldl (\acc c' -> if c' == c then acc + 1 else acc) 0 - --- 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 joinI. 'ET.decode' is an enumeratee, which means it returns --- an iteratee yielding an inner step. 'joinI' "collapses" an enumeratee's --- return value, much as 'join' does to monadic values. - -iterChars :: Monad m => Iteratee B.ByteString m Integer -iterChars = joinI (ET.decode ET.utf8 $$ count) where - count = liftFoldL' (\acc t -> acc + toInteger (T.length t)) 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 ++ ": " - - -- see cat.hs for commented implementation of 'Data.Enumerator.IO.enumFile' - eitherStat <- run (EIO.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) diff --git a/enumerator.cabal b/enumerator.cabal --- a/enumerator.cabal +++ b/enumerator.cabal @@ -1,6 +1,6 @@ name: enumerator -version: 0.4.4 -synopsis: Implementation of Oleg Kiselyov's left-fold enumerators +version: 0.4.5 +synopsis: Reliable, high-performance processing with left-fold enumerators license: MIT license-file: license.txt author: John Millikin @@ -15,27 +15,78 @@ tested-with: GHC==6.12.1 description: - Based on Oleg Kiselyov's IterateeM: + 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: - Examples/*.hs readme.txt + -- + src/api-docs.anansi + src/binary.anansi + src/compat.anansi + src/enumerator.anansi + src/list.anansi + src/primitives.anansi + src/text.anansi + src/types.anansi + src/util.anansi + -- + examples/cat.hs + examples/wc.hs + -- + scripts/cabal-dist + scripts/run-tests + -- + tests/enumerator-tests.cabal + tests/Properties.hs source-repository head type: bazaar location: http://john-millikin.com/software/enumerator/ --- text-0.11 changed some function names to appease a few bikeshedding idiots --- in -cafe; to support it, a special compatibility module is needed. -flag text-names-broken - library - ghc-options: -Wall + ghc-options: -Wall -O2 hs-source-dirs: hs build-depends: transformers >= 0.2 && < 0.3 , bytestring >= 0.9 && < 0.10 + , text >= 0.7 && < 0.12 if impl(ghc >= 6.10) build-depends: @@ -45,20 +96,12 @@ base >= 3 && < 4 , extensible-exceptions >= 0.1 && < 0.2 - if flag(text-names-broken) - hs-source-dirs: hs/text-0.11 - build-depends: - text >= 0.11 && < 0.12 - else - hs-source-dirs: hs/text-0.10 - build-depends: - text >= 0.7 && < 0.11 - exposed-modules: Data.Enumerator - Data.Enumerator.IO + Data.Enumerator.Binary Data.Enumerator.Text + Data.Enumerator.List + Data.Enumerator.IO other-modules: Data.Enumerator.Util - Data.Enumerator.Text.Compat diff --git a/examples/cat.hs b/examples/cat.hs new file mode 100644 --- /dev/null +++ b/examples/cat.hs @@ -0,0 +1,123 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +----------------------------------------------------------------------------- +module Main (main) where +import Prelude as Prelude +import Control.Exception as E +import Control.Monad.IO.Class (liftIO) +import Data.Enumerator +import qualified Data.ByteString as B +import qualified Foreign as F +import System.IO +import System.IO.Error (isEOFError) +import System.Environment (getArgs) + +-- The following definitions of 'enumHandle', 'enumFile', and 'iterHandle' are +-- copied from "Data.Enumerator.Binary", with additional comments so they're +-- easier to understand. + +enumHandle :: Integer -- ^ Buffer size + -> Handle + -> Enumerator B.ByteString IO b +enumHandle bufferSize h = loop where + intSize = fromInteger bufferSize + + -- If more input is required before the enumerator's iteratee can + -- yield a result, feed it from the handle. + loop (Continue k) = do + -- While not strictly necessary to proper operation, catching + -- exceptions here allows more unified exception handling when + -- the enumerator/iteratee is run. + eitherBytes <- liftIO $ E.try $ do + + -- The enumerator must function normally when the + -- handle is something like a slow file, or network + -- socket; if there's not enough data to fill the + -- buffer yet, a partial read is returned. + hasInput <- E.catch + (hWaitForInput h (1)) + (\err -> if isEOFError err + then return False + else E.throwIO err) + + -- An EOF is represented by the empty bytestring + if hasInput + then B.hGetNonBlocking h intSize + else return B.empty + + case eitherBytes of + -- Interacting with the socket threw an IO error of + -- some sort + Left err -> throwError (err :: E.SomeException) + + -- The socket has reached EOF; pass control to the + -- next enumerator + Right bytes | B.null bytes -> continue k + + -- Bytes were read successfully; feed them to the + -- iteratee and continue looping + Right bytes -> k (Chunks [bytes]) >>== loop + + -- If a different step is received ('Error' or 'Yield'), just pass + -- it through. + loop step = returnI step + +enumFile :: FilePath -> Enumerator B.ByteString IO b +enumFile path s = do + -- Opening the file can be performed either inside or outside of the + -- Iteratee. Inside allows exceptions to be caught and propagated + -- through the 'Error' step constructor. + eitherH <- liftIO (E.try (openBinaryFile path ReadMode)) + case eitherH of + Left err -> throwError (err :: E.SomeException) + Right h -> Iteratee $ finally + (runIteratee (enumHandle 4096 h s)) + (hClose h) + +-- 'iterHandle' is the opposite of 'enumHandle', in that it *writes to* a +-- handle instead of reading from it. An enumerator is a source, an iteratee +-- is a sink. +iterHandle :: Handle -> Iteratee B.ByteString IO () + +-- Most iteratees start in the 'Continue' state, as they need some +-- input before they can produce any value. +iterHandle h = continue step where + + -- This iteratee produces no value; its only purpose is its + -- side-effects. When 'EOF' is received, it simply yields (). + step EOF = yield () EOF + + -- When some chunks are received from the Enumeratee, they're written + -- to the handle. Any exceptions are caught and reported, as in + -- 'enumHandle'. + step (Chunks bytes) = do + eitherErr <- liftIO (E.try (mapM_ (B.hPut h) bytes)) + case eitherErr of + Left err -> throwError (err :: E.SomeException) + _ -> continue step + +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 () diff --git a/examples/wc.hs b/examples/wc.hs new file mode 100644 --- /dev/null +++ b/examples/wc.hs @@ -0,0 +1,108 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +----------------------------------------------------------------------------- +module Main (main) where +import Data.Enumerator as E +import qualified Data.Enumerator.Binary as EB +import qualified Data.Enumerator.Text as ET +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T + +-- support imports +import Control.Exception as E +import Data.List +import Control.Monad (unless, forM_) +import System.IO +import System.Console.GetOpt +import System.Environment +import System.Exit + +-- 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 B.ByteString m Integer +iterBytes = continue (step 0) where + step acc EOF = yield acc EOF + step acc (Chunks xs) = continue $ step $! Data.List.foldl' foldStep acc xs + foldStep acc bytes = acc + toInteger (B.length bytes) + +-- iterLines is similar, except it only counts newlines ('\n') +-- +-- Because it's basically the same as 'iterBytes', we use it to demonstrate +-- the 'liftFoldL\'' helper function. + +iterLines :: Monad m => Iteratee B.ByteString m Integer +iterLines = E.foldl' step 0 where + step acc bytes = acc + countChar '\n' bytes + countChar c = B8.foldl (\acc c' -> if c' == c then acc + 1 else acc) 0 + +-- 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 joinI. 'ET.decode' is an enumeratee, which means it returns +-- an iteratee yielding an inner step. 'joinI' "collapses" an enumeratee's +-- return value, much as 'join' does to monadic values. + +iterChars :: Monad m => Iteratee B.ByteString m Integer +iterChars = joinI (ET.decode ET.utf8 $$ count) where + count = E.foldl' (\acc t -> acc + toInteger (T.length t)) 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 ++ ": " + + -- see cat.hs for commented implementation of 'Data.Enumerator.IO.enumFile' + eitherStat <- run (EB.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) diff --git a/hs/Data/Enumerator.hs b/hs/Data/Enumerator.hs --- a/hs/Data/Enumerator.hs +++ b/hs/Data/Enumerator.hs @@ -1,3 +1,5 @@ + + ----------------------------------------------------------------------------- -- | -- Module: Data.Enumerator @@ -7,105 +9,185 @@ -- Maintainer: jmillikin@gmail.com -- Portability: portable -- --- An implementation of Oleg Kiselyov’s left-fold enumerators +-- Core enumerator types, and some useful primitives. -- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator as E +-- @ +-- ----------------------------------------------------------------------------- + module Data.Enumerator ( - -- * Types + + -- * Core + -- ** Types Stream (..) - , Step (..) , Iteratee (..) + , Step (..) , Enumerator , Enumeratee - -- * Primitives - -- ** Combinators - -- | These are common patterns which occur whenever iteratees are - -- being defined. + , returnI , yield , continue - , throwError - , catchError - , liftI + + -- ** Operators , (>>==) , (==<<) , ($$) , (>==>) , (<==<) - -- ** Iteratees - , run - , run_ - , consume - , isEOF - , liftTrans - , liftFoldL - , liftFoldL' - , liftFoldM - , printChunks - -- ** Enumerators - , enumEOF - , enumList - , concatEnums - -- ** Enumeratees - , checkDone - , checkDoneEx + + -- * Primitives + + -- ** Error handling + , throwError + , catchError + + -- ** Iteratees + , Data.Enumerator.foldl + , Data.Enumerator.foldl' + , Data.Enumerator.foldM + + -- ** Enumerators + , Data.Enumerator.iterate + , iterateM + , Data.Enumerator.repeat + , repeatM + , Data.Enumerator.replicate + , replicateM + , generateM + + -- ** Enumeratees , Data.Enumerator.map , Data.Enumerator.concatMap + , Data.Enumerator.filter , Data.Enumerator.mapM - , Data.Enumerator.sequence + , concatMapM + , Data.Enumerator.filterM + + -- ** Debugging + , printChunks + + -- * Misc. utilities + + , concatEnums + , joinI - -- * Parser combinators - -- | Oleg’s original @IterateeM.hs@ includes some basic iteratees - -- for parsing, so this section ports them to the new interface. However, - -- in practice most parsing will be performed with enumerator-based - -- interfaces to existing parser libraries (such as Parsec or Attoparsec). - , Data.Enumerator.head + , joinE + , Data.Enumerator.sequence + , enumList + + , enumEOF + , run + , run_ + + , checkDone + , checkDoneEx + + , isEOF + + -- * Compatibility + + -- ** Obsolete functions + , liftTrans + , liftI , peek , Data.Enumerator.last , Data.Enumerator.length + + -- ** Deprecated aliases + , Data.Enumerator.head , Data.Enumerator.drop , Data.Enumerator.dropWhile - , span + , Data.Enumerator.span , Data.Enumerator.break + , Data.Enumerator.consume + + , liftFoldL + , liftFoldL' + , liftFoldM + ) where -import Data.List (genericDrop, genericLength, genericSplitAt) -import qualified Control.Exception as E + +import qualified Prelude as Prelude +import Prelude hiding ( + + concatMap, + + ) + import Data.Monoid (Monoid, mempty, mappend, mconcat) + +import qualified Control.Exception as Exc + +import Control.Monad.Trans.Class (MonadTrans, lift) +import Control.Monad.IO.Class (MonadIO, liftIO) + import qualified Control.Applicative as A -import Control.Monad (liftM, ap) -import qualified Control.Monad.IO.Class as MIO -import qualified Control.Monad.Trans.Class as MT -import qualified Data.List as DataList -import Control.Monad (foldM) -import Prelude hiding (span) -import qualified Prelude as Prelude --- | Not to be confused with types from the @Stream@ or --- @stream-fusion@ packages, a 'Stream' is a sequence of chunks --- generated by an 'Enumerator'. In contrast to Oleg’s implementation, --- this stream does not support error handling -- errors encountered --- while generating a stream are reported in the 'Step' type instead. +import qualified Control.Monad as CM + +import Data.List (foldl') + +import Data.List (genericSplitAt) + +import Data.List (genericLength) + +import {-# SOURCE #-} qualified Data.Enumerator.List as EL + + +-- | A 'Stream' is a sequence of chunks generated by an 'Enumerator'. -- --- @(Chunks [])@ is used to indicate that a stream is still active, but +-- @('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 Functor Stream where + fmap f (Chunks xs) = Chunks (fmap f xs) + fmap _ EOF = EOF + +instance A.Applicative Stream where + pure = return + (<*>) = CM.ap + +instance Monoid (Stream a) where + mempty = Chunks mempty + mappend (Chunks xs) (Chunks ys) = Chunks (xs ++ ys) + mappend _ _ = EOF + data Step a m b + -- | 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' has received enough input to generate a result. - -- Included in this value is left-over input, which can be passed to + + -- | 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 E.SomeException + | Error Exc.SomeException + + -- | The primary data type for this library, which consumes -- input from a 'Stream' until it either generates a value or encounters -- an error. Rather than requiring all input at once, an iteratee will @@ -115,9 +197,31 @@ -- 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) } + + +-- | @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)@ + +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) + + -- | While 'Iteratee's consume data, enumerators generate it. Since -- @'Iteratee'@ is an alias for @m ('Step' a m b)@, 'Enumerator's can -- be considered step transformers of type @@ -127,321 +231,607 @@ -- random generator, etc). They feed chunks into an 'Iteratee' until the -- source runs out of data (triggering 'EOF') or the iteratee finishes -- processing ('Yield's a value). + type Enumerator a m b = Step a m b -> Iteratee a m b + -- | In cases where an enumerator acts as both a source and sink, the resulting -- type is named an 'Enumeratee'. Enumeratees have two input types, -- “outer a” (@aOut@) and “inner a” (@aIn@). -type Enumeratee aOut aIn m b = Step aIn m b -> Iteratee aOut m (Step aIn m b) -instance Monoid (Stream a) where - mempty = Chunks mempty - mappend (Chunks xs) (Chunks ys) = Chunks $ mappend xs ys - mappend _ _ = EOF -instance Functor Stream where - fmap f (Chunks xs) = Chunks $ fmap f xs - fmap _ EOF = EOF +type Enumeratee ao ai m b = Step ai m b + -> Iteratee ao m (Step ai m b) -instance Monad Stream where - return = Chunks . return - Chunks xs >>= f = mconcat $ fmap f xs - EOF >>= _ = EOF -instance Monad m => Monad (Iteratee a m) where - return x = Iteratee . return $ Yield x $ Chunks [] - {-# INLINE return #-} - - m >>= f = Iteratee $ runIteratee m >>= - \r1 -> case r1 of - Continue k -> return $ Continue ((>>= f) . k) - Error err -> return $ Error err - Yield x (Chunks []) -> runIteratee $ f x - Yield x chunk -> runIteratee (f x) >>= - \r2 -> case r2 of - Continue k -> runIteratee $ k chunk - Error err -> return $ Error err - Yield x' _ -> return $ Yield x' chunk -instance Monad m => Functor (Iteratee a m) where - fmap = liftM - {-# INLINE fmap #-} +infixl 1 >>== -instance Monad m => A.Applicative (Iteratee a m) where - pure = return - {-# INLINE pure #-} - - (<*>) = ap - {-# INLINE (<*>) #-} -instance MT.MonadTrans (Iteratee a) where - lift m = Iteratee $ m >>= runIteratee . return - {-# INLINE lift #-} -instance MIO.MonadIO m => MIO.MonadIO (Iteratee a m) where - liftIO = MT.lift . MIO.liftIO - {-# INLINE liftIO #-} --- | Lift an 'Iteratee' onto a monad transformer, re-wrapping the --- 'Iteratee'’s inner monadic values. -liftTrans :: (Monad m, MT.MonadTrans t, Monad (t m)) => - Iteratee a m b -> Iteratee a (t m) b -liftTrans iter = Iteratee $ do - step <- MT.lift $ runIteratee iter - return $ case step of - Yield x cs -> Yield x cs - Error err -> Error err - Continue k -> Continue (liftTrans . k) --- | @returnI x = Iteratee (return x)@ -returnI :: Monad m => Step a m b -> Iteratee a m b -returnI = Iteratee . return -{-# INLINE returnI #-} - --- | @yield x chunk = returnI (Yield x chunk)@ -yield :: Monad m => b -> Stream a -> Iteratee a m b -yield x chunk = returnI (Yield x chunk) -{-# INLINE yield #-} - --- | @continue k = returnI (Continue k)@ -continue :: Monad m => (Stream a -> Iteratee a m b) -> Iteratee a m b -continue = returnI . Continue -{-# INLINE continue #-} - --- | @throwError err = returnI (Error err)@ -throwError :: (Monad m, E.Exception e) => e -> Iteratee a m b -throwError = returnI . Error . E.toException -{-# INLINE throwError #-} +-- | Equivalent to '(>>=)' for @m ('Step' a m b)@; allows 'Iteratee's with +-- different input types to be composed. --- | @liftI f = continue (returnI . f)@ -liftI :: Monad m => (Stream a -> Step a m b) -> Iteratee a m b -liftI k = continue $ returnI . k -{-# INLINE liftI #-} -catchError :: Monad m => Iteratee a m b -> (E.SomeException -> Iteratee a m b) -> Iteratee a m b -catchError iter h = iter >>== step where - step (Yield b as) = yield b as - step (Error err) = h err - step (Continue k) = continue (\stream -> k stream >>== step) -infixl 1 >>== +(>>==) :: Monad m + => Iteratee a m b + -> (Step a m b -> Iteratee a' m b') + -> Iteratee a' m b' +i >>== f = Iteratee (runIteratee i >>= runIteratee . f) --- | Equivalent to (>>=), but allows 'Iteratee's with different input types --- to be composed. -(>>==) :: Monad m => - Iteratee a m b -> - (Step a m b -> Iteratee a' m b') -> - Iteratee a' m b' -i >>== f = Iteratee $ runIteratee i >>= runIteratee . f -{-# INLINE (>>==) #-} infixr 1 ==<< + -- | @(==\<\<) = flip (\>\>==)@ -(==<<):: Monad m => - (Step a m b -> Iteratee a' m b') -> - Iteratee a m b -> - Iteratee a' m b' + +(==<<) :: Monad m + => (Step a m b -> Iteratee a' m b') + -> Iteratee a m b + -> Iteratee a' m b' (==<<) = flip (>>==) -{-# INLINE (==<<) #-} + infixr 0 $$ + -- | @($$) = (==\<\<)@ -- -- This might be easier to read when passing a chain of iteratees to an -- enumerator. -($$):: Monad m => - (Step a m b -> Iteratee a' m b') -> - Iteratee a m b -> - Iteratee a' m b' +-- +-- Since: 0.1.1 + +($$) :: Monad m + => (Step a m b -> Iteratee a' m b') + -> Iteratee a m b + -> Iteratee a' m b' ($$) = (==<<) -{-# INLINE ($$) #-} + infixr 1 >==> + -- | @(>==>) e1 e2 s = e1 s >>== e2@ -(>==>) :: Monad m => - Enumerator a m b -> - (Step a m b -> Iteratee a' m b') -> - Step a m b -> - Iteratee a' m b' +-- +-- 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 -{-# INLINE (>==>) #-} + infixr 1 <==< + -- | @(\<==\<) = flip (>==>)@ -(<==<) :: Monad m => - (Step a m b -> Iteratee a' m b') -> - Enumerator a m b -> - Step a m b -> - Iteratee a' m b' +-- +-- 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 (>==>) -{-# INLINE (<==<) #-} --- | Consume all input until 'EOF', then return consumed input as a list. -consume :: Monad m => Iteratee a m [a] -consume = liftI $ step id where - step acc chunk = case chunk of - Chunks [] -> Continue $ returnI . step acc - Chunks xs -> Continue $ returnI . (step $ acc . (xs ++)) - EOF -> Yield (acc []) EOF --- | Return 'True' if the next 'Stream' is 'EOF'. -isEOF :: Monad m => Iteratee a m Bool -isEOF = liftI $ \c -> case c of - EOF -> Yield True c - _ -> Yield False c --- | Lifts a pure left fold into an iteratee. -liftFoldL :: Monad m => (b -> a -> b) -> b -> Iteratee a m b -liftFoldL f = liftI . step where - step acc chunk = case chunk of - Chunks [] -> Continue $ returnI . step acc - Chunks xs -> Continue $ returnI . step (Prelude.foldl f acc xs) - EOF -> Yield acc EOF --- | As 'liftFoldL', but strict in its accumulator. -liftFoldL' :: Monad m => (b -> a -> b) -> b -> Iteratee a m b -liftFoldL' f = liftI . step where - fold = DataList.foldl' f - step acc chunk = case chunk of - Chunks [] -> Continue $ returnI . step acc - Chunks xs -> Continue $ returnI . (step $! fold acc xs) - EOF -> Yield acc EOF --- | Lifts a monadic left fold into an iteratee. -liftFoldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m b -liftFoldM f = continue . step where - step acc chunk = case chunk of - Chunks [] -> continue $ step acc - Chunks xs -> Iteratee $ liftM (Continue . step) (foldM f acc xs) + +instance Monad m => Monad (Iteratee a m) where + return x = yield x (Chunks []) + + m >>= f = Iteratee $ runIteratee m >>= + \r1 -> case r1 of + Continue k -> return (Continue ((>>= f) . k)) + Error err -> return (Error err) + Yield x (Chunks []) -> runIteratee (f x) + Yield x extra -> runIteratee (f x) >>= + \r2 -> case r2 of + Continue k -> runIteratee (k extra) + Error err -> return (Error err) + Yield x' _ -> return (Yield x' extra) + +instance MonadTrans (Iteratee a) where + lift m = Iteratee (m >>= runIteratee . return) + +instance MonadIO m => MonadIO (Iteratee a m) where + liftIO = lift . liftIO + +instance Monad m => Functor (Iteratee a m) where + fmap = CM.liftM + +instance Monad m => A.Applicative (Iteratee a m) where + pure = return + (<*>) = CM.ap + + +-- | @throwError exc = 'returnI' ('Error' ('Exc.toException' exc))@ + +throwError :: (Monad m, Exc.Exception e) => e + -> Iteratee a m b +throwError exc = returnI (Error (Exc.toException exc)) + + +-- | Runs the iteratee, and calls an exception handler if an 'Error' is +-- returned. By handling errors within the enumerator library, and requiring +-- all errors to be represented by 'Exc.SomeException', libraries with +-- varying error types can be easily composed. +-- +-- Since: 0.1.1 + +catchError :: Monad m => Iteratee a m b + -> (Exc.SomeException -> Iteratee a m b) + -> Iteratee a m b +catchError iter h = iter >>== step where + step (Yield b as) = yield b as + step (Error err) = h err + step (Continue k) = continue (\s -> k s >>== step) + + +-- | Run the entire input stream through a pure left fold, yielding when +-- there is no more input. +-- +-- 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 + + +-- | Run the entire input stream through a pure strict left fold, yielding +-- when there is no more input. +-- +-- Since: 0.4.5 + +foldl' :: Monad m => (b -> a -> b) -> b + -> Iteratee a m b +foldl' step = continue . loop where + fold = Data.List.foldl' step + loop acc stream = case stream of + Chunks [] -> continue (loop acc) + Chunks xs -> continue (loop (fold acc xs)) + EOF -> yield acc EOF + + +-- | Run the entire input stream through a monadic left fold, yielding +-- when there is no more input. +-- +-- Since: 0.4.5 + +foldM :: Monad m => (b -> a -> m b) -> b + -> Iteratee a m b +foldM step = continue . loop where + fold acc = lift . CM.foldM step acc + + loop acc stream = case stream of + Chunks [] -> continue (loop acc) + Chunks xs -> fold acc xs >>= continue . loop + EOF -> yield acc EOF + + +-- | @iterate f x@ enumerates an infinite stream of repeated applications +-- of /f/ to /x/. +-- +-- Analogous to 'Prelude.iterate'. +-- +-- Since: 0.4.5 + +iterate :: Monad m => (a -> a) -> a -> Enumerator a m b +iterate f = loop where + loop a (Continue k) = k (Chunks [a]) >>== loop (f a) + loop _ step = returnI step + + +-- | Similar to 'iterate', except the iteration function is monadic. +-- +-- Since: 0.4.5 + +iterateM :: Monad m => (a -> m a) -> a + -> Enumerator a m b +iterateM f base = loop (return base) where + loop m_a (Continue k) = do + a <- lift m_a + k (Chunks [a]) >>== loop (f a) + loop _ step = returnI step + + +-- | Enumerates an infinite stream of the provided value. +-- +-- Analogous to 'Prelude.repeat'. +-- +-- Since: 0.4.5 + +repeat :: Monad m => a -> Enumerator a m b +repeat a = Data.Enumerator.iterate (const a) a + + +-- | Enumerates an infinite stream by running the provided computation and +-- passing each result to the iteratee. +-- +-- Since: 0.4.5 + +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/ input elements; each +-- element is generated by running the input computation /m_x/ once. +-- +-- Since: 0.4.5 + +replicateM :: Monad m => Integer -> m a + -> Enumerator a m b +replicateM maxCount getNext = loop maxCount where + loop 0 step = returnI step + loop n (Continue k) = do + next <- lift getNext + k (Chunks [next]) >>== loop (n - 1) + loop _ step = returnI step + + +-- | @replicate n x = 'replicateM' n (return x)@ +-- +-- Analogous to 'Prelude.replicate'. +-- +-- Since: 0.4.5 + +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.5 + +generateM :: Monad m => m (Maybe a) + -> Enumerator a m b +generateM getNext = loop where + loop (Continue k) = do + next <- lift getNext + case next of + Nothing -> continue k + Just x -> k (Chunks [x]) >>== loop + loop step = returnI step + + +-- | @concatMapM f@ applies /f/ to each input element and feeds the +-- resulting outputs to the inner iteratee. +-- +-- Since: 0.4.5 + +concatMapM :: Monad m => (ao -> m [ai]) + -> Enumeratee ao ai m b +concatMapM f = checkDone (continue . step) where + step k EOF = yield (Continue k) EOF + step k (Chunks xs) = loop k xs + + loop k [] = continue (step k) + loop k (x:xs) = do + fx <- lift (f x) + k (Chunks fx) >>== + checkDoneEx (Chunks xs) (\k' -> loop k' xs) + + +-- | @concatMap f = 'concatMapM' (return . f)@ +-- +-- Since: 0.4.3 + +concatMap :: Monad m => (ao -> [ai]) + -> Enumeratee ao ai m b +concatMap f = concatMapM (return . f) + + +-- | @map f = 'concatMap' (\x -> 'Prelude.map' f [x])@ + +map :: Monad m => (ao -> ai) + -> Enumeratee ao ai m b +map f = concatMap (\x -> Prelude.map f [x]) + + +-- | @filter p = 'concatMap' (\x -> 'Prelude.filter' p [x])@ +-- +-- Since: 0.4.5 + +filter :: Monad m => (a -> Bool) + -> Enumeratee a a m b +filter p = concatMap (\x -> Prelude.filter p [x]) + + +-- | @mapM f = 'concatMapM' (\x -> 'Prelude.mapM' f [x])@ +-- +-- Since: 0.4.3 + +mapM :: Monad m => (ao -> m ai) + -> Enumeratee ao ai m b +mapM f = concatMapM (\x -> Prelude.mapM f [x]) + + +-- | @filterM p = 'concatMapM' (\x -> 'CM.filterM' p [x])@ +-- +-- Since: 0.4.5 + +filterM :: Monad m => (a -> m Bool) + -> Enumeratee a a m b +filterM p = concatMapM (\x -> CM.filterM p [x]) + + +-- | 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 + + +-- | Compose a list of 'Enumerator's using @'(>>==)'@ + +concatEnums :: Monad m => [Enumerator a m b] + -> Enumerator a m b +concatEnums = Prelude.foldl (>==>) returnI + + +-- | 'joinI' is used to “flatten” 'Enumeratee's into an +-- 'Iteratee'. + +joinI :: Monad m => Iteratee a m (Step a' m b) + -> Iteratee a m b +joinI outer = outer >>= check where + check (Continue k) = k EOF >>== \s -> case s of + Continue _ -> error "joinI: divergent iteratee" + _ -> check s + check (Yield x _) = return x + check (Error e) = throwError e + + +-- | Flatten an enumerator/enumeratee pair into a single enumerator. + +joinE :: Monad m + => Enumerator ao m (Step ai m b) + -> Enumeratee ao ai m b + -> Enumerator ai m b +joinE enum enee s = Iteratee $ do + step <- runIteratee (enumEOF $$ enum $$ enee s) + case step of + Error err -> return (Error err) + Yield x _ -> return x + Continue _ -> error "joinE: divergent iteratee" + + +-- | 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 + + +-- | @enumList n xs@ enumerates /xs/ as a stream, passing /n/ inputs per +-- chunk. +-- +-- Primarily useful for testing and debugging. + +enumList :: Monad m => Integer -> [a] -> Enumerator a m b +enumList n = loop where + loop xs (Continue k) | not (null xs) = let + (s1, s2) = genericSplitAt n xs + in k (Chunks s1) >>== loop s2 + loop _ step = returnI step + + -- | Run an iteratee until it finishes, and return either the final value -- (if it succeeded) or the error (if it failed). -run :: Monad m => Iteratee a m b -> m (Either E.SomeException b) + +run :: Monad m => Iteratee a m b + -> m (Either Exc.SomeException b) run i = do mStep <- runIteratee $ enumEOF ==<< i case mStep of Error err -> return $ Left err Yield x _ -> return $ Right x Continue _ -> error "run: divergent iteratee" -run_ :: Monad m => Iteratee a m b -> m b -run_ i = run i >>= either E.throw return --- | Print chunks as they're received from the enumerator, optionally --- printing empty chunks. -printChunks :: (MIO.MonadIO m, Show a) => Bool -> Iteratee a m () -printChunks printEmpty = continue step where - step (Chunks []) | not printEmpty = continue step - step (Chunks xs) = MIO.liftIO (print xs) >> continue step - step EOF = MIO.liftIO (putStrLn "EOF") >> yield () EOF --- | The most primitive enumerator; simply sends 'EOF'. The iteratee must --- either yield a value or throw an error continuing receiving 'EOF' will --- not terminate with any useful value. + + +-- | docs TODO + enumEOF :: Monad m => Enumerator a m b enumEOF (Yield x _) = yield x EOF enumEOF (Error err) = throwError err enumEOF (Continue k) = k EOF >>== check where check (Continue _) = error "enumEOF: divergent iteratee" check s = enumEOF s --- | Another small, useful enumerator separates an input list into chunks, --- and sends them to the iteratee. This is useful for testing iteratees in pure --- code. -enumList :: Monad m => Integer -> [a] -> Enumerator a m b -enumList n xs (Continue k) | not (null xs) = k chunk >>== loop where - (s1, s2) = genericSplitAt n xs - chunk = Chunks s1 - loop = enumList n s2 -enumList _ _ step = returnI step --- | Compose a list of 'Enumerator's using '(>>==)' -concatEnums :: Monad m => [Enumerator a m b] -> Enumerator a m b -concatEnums = foldl (>==>) returnI -{-# INLINE concatEnums #-} --- | 'joinI' is used to “flatten” 'Enumeratee's into an --- 'Iteratee'. -joinI :: Monad m => Iteratee a m (Step a' m b) -> Iteratee a m b -joinI outer = outer >>= check where - check (Continue k) = k EOF >>== \s -> case s of - Continue _ -> error "joinI: divergent iteratee" - _ -> check s - check (Yield x _) = return x - check (Error e) = throwError e + + +-- | Like 'run', except errors are converted to exceptions and thrown. +-- Primarily useful for small scripts or other simple cases. +-- +-- Since: 0.4.1 + +run_ :: Monad m => Iteratee a m b -> m b +run_ i = run i >>= either Exc.throw return + + -- | 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 extra _ (Yield x chunk) = returnI (Yield (Yield x chunk) extra) -checkDoneEx _ f (Continue k) = f k -checkDoneEx _ _ (Error err) = throwError err -{-# INLINE checkDoneEx #-} +checkDoneEx _ f (Continue k) = f k +checkDoneEx extra _ step = yield step extra --- | @checkDone = checkDoneEx (Chunks [])@ + +-- | @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 []) -{-# INLINE checkDone #-} -map :: Monad m => (ao -> ai) -> Enumeratee ao ai m b -map f = loop where - loop = checkDone $ continue . step - step k EOF = yield (Continue k) EOF - step k (Chunks []) = continue $ step k - step k (Chunks xs) = k (Chunks (Prelude.map f xs)) >>== loop -concatMap :: Monad m => (ao -> [ai]) -> Enumeratee ao ai m b -concatMap f = loop where - loop = checkDone $ continue . step - step k EOF = yield (Continue k) EOF - step k (Chunks []) = continue $ step k - step k (Chunks xs) = k (Chunks (Prelude.concatMap f xs)) >>== loop -mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m b -mapM 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 <- MT.lift (f x) - k (Chunks [fx]) >>== checkDoneEx (Chunks xs) (\k' -> loop k' xs) -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 -head :: Monad m => Iteratee a m (Maybe a) -head = liftI step where - step (Chunks []) = Continue $ returnI . step - step (Chunks (x:xs)) = Yield (Just x) (Chunks xs) - step EOF = Yield Nothing EOF + + +-- | docs TODO + +isEOF :: Monad m => Iteratee a m Bool +isEOF = continue $ \s -> case s of + EOF -> yield True s + _ -> yield False s + + +-- | Lift an 'Iteratee' onto a monad transformer, re-wrapping the +-- 'Iteratee'’s inner monadic values. +-- +-- Since: 0.1.1 + +liftTrans :: (Monad m, MonadTrans t, Monad (t m)) => + Iteratee a m b -> Iteratee a (t m) b +liftTrans iter = Iteratee $ do + step <- lift (runIteratee iter) + return $ case step of + Yield x cs -> Yield x cs + Error err -> Error err + Continue k -> Continue (liftTrans . k) + +{-# DEPRECATED liftI + "Use 'Data.Enumerator.continue' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.continue' instead + +liftI :: Monad m => (Stream a -> Step a m b) + -> Iteratee a m b +liftI k = continue (returnI . k) + + +-- | Peek at the next element in the stream, or 'Nothing' if the stream +-- has ended. + peek :: Monad m => Iteratee a m (Maybe a) -peek = liftI step where - step (Chunks []) = Continue $ returnI . step - step chunk@(Chunks (x:_)) = Yield (Just x) chunk - step chunk = Yield Nothing chunk +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 = liftI $ step Nothing where - step ret (Chunks xs) = let - ret' = case xs of - [] -> ret - _ -> Just $ Prelude.last xs - in Continue $ returnI . step ret' - step ret EOF = Yield ret EOF +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 = liftI $ step 0 where - step n (Chunks xs) = Continue $ returnI . step (n + genericLength xs) - step n EOF = Yield n EOF -drop :: Monad m => Integer -> Iteratee a m () -drop 0 = return () -drop n = liftI $ step n where - step n' (Chunks xs) - | len xs < n' = Continue $ returnI . step (n' - len xs) - | otherwise = Yield () $ Chunks $ genericDrop n' xs - step _ EOF = Yield () EOF +length = continue (loop 0) where len = genericLength + loop n (Chunks xs) = continue (loop (n + len xs)) + loop n EOF = yield n EOF + +{-# DEPRECATED head + "Use 'Data.Enumerator.List.head' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.head' instead + +head :: Monad m => Iteratee a m (Maybe a) +head = EL.head + +{-# DEPRECATED drop + "Use 'Data.Enumerator.List.drop' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.drop' instead + +drop :: Monad m => Integer -> Iteratee a m () +drop = EL.drop + +{-# DEPRECATED dropWhile + "Use 'Data.Enumerator.List.dropWhile' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.dropWhile' instead + dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () -dropWhile p = liftI step where - step (Chunks xs) = case Prelude.dropWhile p xs of - [] -> Continue $ returnI . step - xs' -> Yield () $ Chunks xs' - step EOF = Yield () EOF +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 f = liftI $ step [] where - step acc (Chunks xs) = case Prelude.span f xs of - (_, []) -> Continue $ returnI . step (acc ++ xs) - (head', tail') -> Yield (acc ++ head') (Chunks tail') - step acc EOF = Yield acc EOF +span = EL.takeWhile --- | @break p = 'span' (not . p)@ +{-# 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 = span $ not . p +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 liftFoldL + "Use 'Data.Enumerator.foldl' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.foldl' instead +-- +-- Since: 0.1.1 + +liftFoldL :: Monad m => (b -> a -> b) -> b + -> Iteratee a m b +liftFoldL = Data.Enumerator.foldl + +{-# DEPRECATED liftFoldL' + "Use 'Data.Enumerator.foldl' ' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.foldl'' instead +-- +-- Since: 0.1.1 + +liftFoldL' :: Monad m => (b -> a -> b) -> b + -> Iteratee a m b +liftFoldL' = Data.Enumerator.foldl' + +{-# DEPRECATED liftFoldM + "Use 'Data.Enumerator.foldM' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.foldM' instead +-- +-- Since: 0.1.1 + +liftFoldM :: Monad m => (b -> a -> m b) -> b + -> Iteratee a m b +liftFoldM = Data.Enumerator.foldM diff --git a/hs/Data/Enumerator.hs-boot b/hs/Data/Enumerator.hs-boot new file mode 100644 --- /dev/null +++ b/hs/Data/Enumerator.hs-boot @@ -0,0 +1,11 @@ + +module Data.Enumerator where +import qualified Control.Exception as Exc +data Stream a +data Step a m b + = Continue (Stream a -> Iteratee a m b) + | Yield b (Stream a) + | Error Exc.SomeException +newtype Iteratee a m b = Iteratee + { runIteratee :: m (Step a m b) + } diff --git a/hs/Data/Enumerator/Binary.hs b/hs/Data/Enumerator/Binary.hs new file mode 100644 --- /dev/null +++ b/hs/Data/Enumerator/Binary.hs @@ -0,0 +1,254 @@ + + +----------------------------------------------------------------------------- +-- | +-- Module: Data.Enumerator.Binary +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator.Binary as EB +-- @ +-- +-- Since: 0.4.5 +-- +----------------------------------------------------------------------------- + +module Data.Enumerator.Binary ( + + -- * Binary IO + enumHandle + , enumFile + , iterHandle + + -- * List analogues + , Data.Enumerator.Binary.head + , Data.Enumerator.Binary.drop + , Data.Enumerator.Binary.dropWhile + , Data.Enumerator.Binary.take + , Data.Enumerator.Binary.takeWhile + , Data.Enumerator.Binary.consume + , require + , isolate + + ) where +import Prelude hiding (head, drop, takeWhile) +import Data.Enumerator hiding (head, drop) +import qualified Data.ByteString as B + +import Data.Enumerator.Util (tryStep) +import qualified Control.Exception as Exc +import Control.Monad.IO.Class (MonadIO) +import qualified System.IO as IO +import System.IO.Error (isEOFError) + +import Data.Word (Word8) +import qualified Data.ByteString.Lazy as BL + + +-- | 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'. + +enumHandle :: MonadIO m + => Integer -- ^ Buffer size + -> IO.Handle + -> Enumerator B.ByteString m b +enumHandle bufferSize h = loop where + loop (Continue k) = withBytes $ \bytes -> + if B.null bytes + then continue k + else k (Chunks [bytes]) >>== loop + + loop step = returnI step + + intSize = fromInteger bufferSize + withBytes = tryStep $ 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 intSize + else return B.empty + + +-- | Opens a file path in binary mode, and passes the handle to 'enumHandle'. +-- The file will be closed when the 'Iteratee' finishes. + +enumFile :: FilePath -> Enumerator B.ByteString IO b +enumFile path = enum where + withHandle = tryStep (IO.openBinaryFile path IO.ReadMode) + enum step = withHandle $ \h -> do + Iteratee $ Exc.finally + (runIteratee (enumHandle 4096 h step)) + (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'. + +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) = let + put = mapM_ (B.hPut h) bytes + in tryStep put (\_ -> continue step) + +toChunks :: BL.ByteString -> Stream B.ByteString +toChunks = Chunks . BL.toChunks + + +-- | Get the next byte from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 + +head :: Monad m => Iteratee B.ByteString m (Maybe Word8) +head = continue loop where + loop (Chunks xs) = case BL.uncons (BL.fromChunks xs) of + Just (char, extra) -> yield (Just char) (toChunks extra) + Nothing -> head + loop EOF = yield Nothing EOF + + +-- | @drop n@ ignores /n/ bytes of input from the stream. +-- +-- Since: 0.4.5 + +drop :: Monad m => Integer -> Iteratee B.ByteString m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + iter = if len < n' + then drop (n' - len) + else yield () (toChunks (BL.drop (fromInteger n') lazy)) + loop _ EOF = yield () EOF + + +-- | @dropWhile p@ ignores input from the stream until the first byte which +-- does not match the predicate. +-- +-- Since: 0.4.5 + +dropWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m () +dropWhile p = continue loop where + loop (Chunks xs) = iter where + lazy = BL.dropWhile p (BL.fromChunks xs) + iter = if BL.null lazy + then continue loop + else yield () (toChunks lazy) + loop EOF = yield () EOF + + +-- | @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 + + +-- | Read all remaining input from the stream, and return as a lazy +-- ByteString. +-- +-- 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 + + +-- | @require n@ buffers input until at least /n/ bytes are available, or +-- throws an error if the stream ends early. +-- +-- Since: 0.4.5 + +require :: Monad m => Integer -> Iteratee B.ByteString m () +require n | n <= 0 = return () +require n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + iter = if len < n' + then continue (loop (acc . (BL.append lazy)) (n' - len)) + else yield () (toChunks (acc lazy)) + loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") + + +-- | @isolate n@ reads at most /n/ bytes from the stream, and passes them +-- to its iteratee. If the iteratee finishes early, bytes continue to be +-- consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 + +isolate :: Monad m => Integer -> Enumeratee B.ByteString B.ByteString m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + loop (Chunks []) = continue loop + loop (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + + iter = if len <= n + then k (Chunks xs) >>== isolate (n - len) + else let + (s1, s2) = BL.splitAt (fromInteger n) lazy + in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step diff --git a/hs/Data/Enumerator/IO.hs b/hs/Data/Enumerator/IO.hs --- a/hs/Data/Enumerator/IO.hs +++ b/hs/Data/Enumerator/IO.hs @@ -1,3 +1,5 @@ + + ----------------------------------------------------------------------------- -- | -- Module: Data.Enumerator.IO @@ -7,71 +9,47 @@ -- Maintainer: jmillikin@gmail.com -- Portability: portable -- --- Enumerator-based IO +-- 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 Data.Enumerator -import Data.Enumerator.Util +import qualified Data.Enumerator as E +import qualified Data.Enumerator.Binary as EB import Control.Monad.IO.Class (MonadIO) -import qualified Control.Exception as E import qualified Data.ByteString as B import qualified System.IO as IO -import System.IO.Error (isEOFError) --- | 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'. + +{-# DEPRECATED enumHandle + "Use 'Data.Enumerator.Binary.enumHandle' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.Binary.enumHandle' instead + enumHandle :: MonadIO m - => Integer -- ^ Buffer size + => Integer -> IO.Handle - -> Enumerator B.ByteString m b -enumHandle bufferSize h = Iteratee . loop where - loop (Continue k) = withBytes $ \bytes -> if B.null bytes - then return $ Continue k - else runIteratee (k (Chunks [bytes])) >>= loop - - loop step = return step - - intSize = fromInteger bufferSize - withBytes = tryStep $ do - hasInput <- E.catch - (IO.hWaitForInput h (-1)) - (\err -> if isEOFError err - then return False - else E.throwIO err) - if hasInput - then B.hGetNonBlocking h intSize - else return B.empty --- | Opens a file path in binary mode, and passes the handle to 'enumHandle'. --- The file will be closed when the 'Iteratee' finishes. -enumFile :: FilePath -> Enumerator B.ByteString IO b -enumFile path s = Iteratee io where - withHandle = tryStep (IO.openBinaryFile path IO.ReadMode) - io = withHandle $ \h -> E.finally - (runIteratee (enumHandle 4096 h s)) - (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'. -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) = Iteratee io where - put = mapM_ (B.hPut h) bytes - io = tryStep put (\_ -> return $ Continue step) + -> E.Enumerator B.ByteString m b +enumHandle = EB.enumHandle + +{-# DEPRECATED enumFile + "Use 'Data.Enumerator.Binary.enumFile' instead" #-} + +-- | Deprecated in 0.4.5: use 'Data.Enumerator.Binary.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 'Data.Enumerator.Binary.iterHandle' instead + +iterHandle :: MonadIO m => IO.Handle + -> E.Iteratee B.ByteString m () +iterHandle = EB.iterHandle diff --git a/hs/Data/Enumerator/List.hs b/hs/Data/Enumerator/List.hs new file mode 100644 --- /dev/null +++ b/hs/Data/Enumerator/List.hs @@ -0,0 +1,154 @@ + + +----------------------------------------------------------------------------- +-- | +-- Module: Data.Enumerator.List +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator.List as EL +-- @ +-- +-- Since: 0.4.5 +-- +----------------------------------------------------------------------------- + +module Data.Enumerator.List ( + + head + , drop + , dropWhile + , take + , takeWhile + , consume + , require + , isolate + + ) where +import Data.Enumerator hiding (consume, head, peek, drop, dropWhile) +import Control.Exception (ErrorCall(..)) +import Prelude hiding (head, drop, dropWhile, take, takeWhile) +import qualified Data.List as L + + +-- | Get the next element from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 + +head :: Monad m => Iteratee a m (Maybe a) +head = continue loop where + loop (Chunks []) = head + loop (Chunks (x:xs)) = yield (Just x) (Chunks xs) + loop EOF = yield Nothing EOF + + +-- | @drop n@ ignores /n/ input elements from the stream. +-- +-- Since: 0.4.5 + +drop :: Monad m => Integer -> Iteratee a m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + len = L.genericLength xs + iter = if len < n' + then drop (n' - len) + else yield () (Chunks (L.genericDrop n' xs)) + loop _ EOF = yield () EOF + + +-- | @dropWhile p@ ignores input from the stream until the first element +-- which does not match the predicate. +-- +-- Since: 0.4.5 + +dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () +dropWhile p = continue loop where + loop (Chunks xs) = case L.dropWhile p xs of + [] -> continue loop + xs' -> yield () (Chunks xs') + loop EOF = yield () EOF + + +-- | @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 + + +-- | Read all remaining input elements from the stream, and return as a list. +-- +-- 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 + + +-- | @require n@ buffers input until at least /n/ elements are available, or +-- throws an error if the stream ends early. +-- +-- Since: 0.4.5 + +require :: Monad m => Integer -> Iteratee a m () +require n | n <= 0 = return () +require n = continue (loop id n) where + len = L.genericLength + loop acc n' (Chunks xs) + | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) + | otherwise = yield () (Chunks (acc xs)) + loop _ _ EOF = throwError (ErrorCall "require: Unexpected EOF") + + +-- | @isolate n@ reads at most /n/ elements from the stream, and passes them +-- to its iteratee. If the iteratee finishes early, elements continue to be +-- consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 + +isolate :: Monad m => Integer -> Enumeratee a a m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + len = L.genericLength + + loop (Chunks []) = continue loop + loop (Chunks xs) + | len xs <= n = k (Chunks xs) >>== isolate (n - len xs) + | otherwise = let + (s1, s2) = L.genericSplitAt n xs + in k (Chunks s1) >>== (\step -> yield step (Chunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step diff --git a/hs/Data/Enumerator/List.hs-boot b/hs/Data/Enumerator/List.hs-boot new file mode 100644 --- /dev/null +++ b/hs/Data/Enumerator/List.hs-boot @@ -0,0 +1,8 @@ + +module Data.Enumerator.List where +import {-# SOURCE #-} Data.Enumerator +head :: Monad m => Iteratee a m (Maybe a) +drop :: Monad m => Integer -> Iteratee a m () +dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () +takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] +consume :: Monad m => Iteratee a m [a] diff --git a/hs/Data/Enumerator/Text.hs b/hs/Data/Enumerator/Text.hs --- a/hs/Data/Enumerator/Text.hs +++ b/hs/Data/Enumerator/Text.hs @@ -1,3 +1,5 @@ + + ----------------------------------------------------------------------------- -- | -- Module: Data.Enumerator.Text @@ -7,123 +9,381 @@ -- Maintainer: jmillikin@gmail.com -- Portability: portable -- --- Enumerator-based text IO +-- This module is intended to be imported qualified: -- +-- @ +-- import qualified Data.Enumerator.Text as ET +-- @ +-- +-- Since: 0.2 +-- ----------------------------------------------------------------------------- + module Data.Enumerator.Text ( - -- * Enumerators and iteratees + + -- * Text IO enumHandle , enumFile , iterHandle + + -- * List analogues + , Data.Enumerator.Text.head + , Data.Enumerator.Text.drop + , Data.Enumerator.Text.dropWhile + , Data.Enumerator.Text.take + , Data.Enumerator.Text.takeWhile + , Data.Enumerator.Text.consume + , require + , isolate + -- * Codecs , Codec , encode , decode + , utf8 + , utf16_le , utf16_be + , utf32_le , utf32_be + , ascii + , iso8859_1 + ) where -import qualified Data.Enumerator.Text.Compat as TC -import Control.Monad.IO.Class (MonadIO) -import qualified Control.Exception as E +import qualified Prelude +import Prelude hiding (head, drop, takeWhile) +import Data.Enumerator hiding (head, drop) import qualified Data.Text as T -import qualified Data.Text.IO as T + +import Data.Enumerator.Util (tryStep) +import qualified Data.Text.IO as TIO + +import qualified Control.Exception as Exc +import Control.Monad.IO.Class (MonadIO) import qualified System.IO as IO import System.IO.Error (isEOFError) -import Control.Arrow (first) -import Data.Bits ((.&.)) + +import qualified Data.Text.Lazy as TL + import qualified Data.ByteString as B +import Data.Enumerator.Util (tSpanBy, tlSpanBy, reprWord, reprChar) + +import Control.Arrow (first) +import Data.Bits ((.&.), (.|.), shiftL) +import Data.Char (ord) +import Data.Word (Word8, Word16) import qualified Data.ByteString.Char8 as B8 import qualified Data.Text.Encoding as TE -import Data.Bits ((.|.), shiftL) -import Data.Word (Word16) -import Prelude as Prelude -import Numeric (showIntAtBase) -import Data.Char (toUpper, intToDigit, ord) -import Data.Word (Word8) + +import Data.Maybe (catMaybes) + import System.IO.Unsafe (unsafePerformIO) -import Data.Enumerator -import Data.Enumerator.Util + + -- | Read lines of text from the handle, and stream them to an 'Iteratee'. -- If an exception occurs during file IO, enumeration will stop and 'Error' -- will be returned. Exceptions from the iteratee are not caught. -- -- The handle should be opened with an appropriate text encoding, and -- in 'IO.ReadMode' or 'IO.ReadWriteMode'. -enumHandle :: MonadIO m => IO.Handle -> Enumerator T.Text m b -enumHandle h = Iteratee . loop where - loop (Continue k) = withText $ \maybeText -> case maybeText of - Nothing -> return $ Continue k - Just text -> runIteratee (k (Chunks [text])) >>= loop +-- +-- Since: 0.2 + +enumHandle :: MonadIO m => IO.Handle + -> Enumerator T.Text m b +enumHandle h = loop where + loop (Continue k) = withText $ \maybeText -> + case maybeText of + Nothing -> continue k + Just text -> k (Chunks [text]) >>== loop - loop step = return step - withText = tryStep $ E.catch - (Just `fmap` T.hGetLine h) + loop step = returnI step + withText = tryStep $ Exc.catch + (Just `fmap` TIO.hGetLine h) (\err -> if isEOFError err then return Nothing - else E.throwIO err) + else Exc.throwIO err) + + -- | Opens a file path in text mode, and passes the handle to 'enumHandle'. -- The file will be closed when the 'Iteratee' finishes. +-- +-- Since: 0.2 + enumFile :: FilePath -> Enumerator T.Text IO b -enumFile path s = Iteratee io where +enumFile path = enum where withHandle = tryStep (IO.openFile path IO.ReadMode) - io = withHandle $ \h -> E.finally - (runIteratee (enumHandle h s)) + enum step = withHandle $ \h -> 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'. -iterHandle :: MonadIO m => IO.Handle -> Iteratee T.Text m () +-- +-- 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) = Iteratee io where - put = mapM_ (T.hPutStr h) chunks - io = tryStep put (\_ -> return $ Continue step) + step (Chunks chunks) = let + put = mapM_ (TIO.hPutStr h) chunks + in tryStep put (\_ -> continue step) + +toChunks :: TL.Text -> Stream T.Text +toChunks = Chunks . TL.toChunks + + +-- | Get the next character from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 + +head :: Monad m => Iteratee T.Text m (Maybe Char) +head = continue loop where + loop (Chunks xs) = case TL.uncons (TL.fromChunks xs) of + Just (char, extra) -> yield (Just char) (toChunks extra) + Nothing -> head + loop EOF = yield Nothing EOF + + +-- | @drop n@ ignores /n/ characters of input from the stream. +-- +-- Since: 0.4.5 + +drop :: Monad m => Integer -> Iteratee T.Text m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + iter = if len < n' + then drop (n' - len) + else yield () (toChunks (TL.drop (fromInteger n') lazy)) + loop _ EOF = yield () EOF + + +-- | @dropWhile p@ ignores input from the stream until the first character +-- which does not match the predicate. +-- +-- Since: 0.4.5 + +dropWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m () +dropWhile p = continue loop where + loop (Chunks xs) = iter where + lazy = TL.dropWhile p (TL.fromChunks xs) + iter = if TL.null lazy + then continue loop + else yield () (toChunks lazy) + loop EOF = yield () EOF + + +-- | @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 + + +-- | Read all remaining input from the stream, and return as a lazy +-- Text. +-- +-- 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 + + +-- | @require n@ buffers input until at least /n/ characters are available, +-- or throws an error if the stream ends early. +-- +-- Since: 0.4.5 + +require :: Monad m => Integer -> Iteratee T.Text m () +require n | n <= 0 = return () +require n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + iter = if len < n' + then continue (loop (acc . (TL.append lazy)) (n' - len)) + else yield () (toChunks (acc lazy)) + loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") + + +-- | @isolate n@ reads at most /n/ characters from the stream, and passes +-- them to its iteratee. If the iteratee finishes early, characters continue +-- to be consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 + +isolate :: Monad m => Integer -> Enumeratee T.Text T.Text m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + loop (Chunks []) = continue loop + loop (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + + iter = if len <= n + then k (Chunks xs) >>== isolate (n - len) + else let + (s1, s2) = TL.splitAt (fromInteger n) lazy + in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step + data Codec = Codec { codecName :: T.Text - , codecEncode :: [T.Text] -> Either E.SomeException [B.ByteString] - , codecDecode :: B.ByteString -> Either E.SomeException (T.Text, B.ByteString) + , 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) -encode :: Monad m => Codec -> Enumeratee T.Text B.ByteString m b -encode codec = loop where - loop = checkDone $ continue . step + + +-- | 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 []) = continue $ step k - step k (Chunks xs) = case codecEncode codec xs of - Left err -> throwError err - Right byteChunks -> k (Chunks byteChunks) >>== loop -decode :: Monad m => Codec -> Enumeratee B.ByteString T.Text m b -decode codec = loop B.empty where - dec = codecDecode codec + step k (Chunks xs) = loop k xs - loop acc = checkDoneEx (Chunks [acc]) (continue . step acc) - step acc k EOF = yield (Continue k) $ if B.null acc - then EOF - else Chunks [acc] - step acc k (Chunks []) = continue $ step acc k - step acc k (Chunks xs) = case dec (B.concat (acc:xs)) of - Left err -> throwError err - Right (text, extra) -> if T.null text - then continue $ step extra k - else k (Chunks [text]) >>== loop extra + loop k [] = continue (step k) + loop k (x:xs) = let + (bytes, extra) = codecEncode codec x + extraChunks = Chunks $ case extra of + Nothing -> xs + Just (_, text) -> text:xs + + checkError k' = case extra of + Nothing -> loop k' xs + Just (exc, _) -> throwError exc + + in if B.null bytes + then checkError k + else k (Chunks [bytes]) >>== + checkDoneEx extraChunks checkError + + +-- | Convert bytes into text, using the provided codec. If the codec is +-- not capable of decoding an input byte sequence, an error will be thrown. +-- +-- Since: 0.2 + +decode :: Monad m => Codec + -> Enumeratee B.ByteString T.Text m b +decode codec = checkDone (continue . step B.empty) where + step _ k EOF = yield (Continue k) EOF + step acc k (Chunks xs) = loop acc k xs + + loop acc k [] = continue (step acc k) + loop acc k (x:xs) = let + (text, extra) = codecDecode codec (B.append acc x) + extraChunks = Chunks (either snd id extra : xs) + + checkError k' = case extra of + Left (exc, _) -> throwError exc + Right bytes -> loop bytes k' xs + + in if T.null text + then checkError k + else k (Chunks [text]) >>== + checkDoneEx extraChunks checkError + +byteSplits :: B.ByteString + -> [(B.ByteString, B.ByteString)] +byteSplits bytes = loop (B.length bytes) where + loop 0 = [(B.empty, bytes)] + loop n = B.splitAt n bytes : loop (n - 1) + +splitSlowly :: (B.ByteString -> T.Text) + -> B.ByteString + -> (T.Text, Either + (Exc.SomeException, B.ByteString) + B.ByteString) +splitSlowly dec bytes = valid where + valid = firstValid (Prelude.map decFirst splits) + splits = byteSplits bytes + firstValid = Prelude.head . catMaybes + tryDec = tryEvaluate . dec + + decFirst (a, b) = case tryDec a of + Left _ -> Nothing + Right text -> Just (text, case tryDec b of + Left exc -> Left (exc, b) + + -- this case shouldn't occur, since splitSlowly + -- is only called when parsing failed somewhere + Right _ -> Right B.empty) + utf8 :: Codec utf8 = Codec name enc dec where name = T.pack "UTF-8" - enc = Right . Prelude.map TE.encodeUtf8 - dec = unsafeTryDec . splitBytes - splitBytes bytes = loop 0 where + 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 @@ -131,47 +391,71 @@ | x0 .&. 0xF8 == 0xF0 = 4 -- Invalid input; let Text figure it out - | otherwise = 1 + | otherwise = 0 + maxN = B.length bytes - loop n | n == maxN = (TE.decodeUtf8 bytes, B.empty) + 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 + req = required (B.index bytes n) + tooLong = first TE.decodeUtf8 (B.splitAt n bytes) decodeMore = loop $! n + req - in if req > maxN then tooLong else decodeMore + 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 = Right . Prelude.map TE.encodeUtf16LE - dec = unsafeTryDec . splitBytes - splitBytes bytes = loop 0 where + 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 = (TE.decodeUtf16LE bytes, B.empty) + loop n | n == maxN = decodeAll | (n + 1) == maxN = decodeTo n loop n = let - req = utf16Required (B.index bytes 0) (B.index bytes 1) + req = utf16Required + (B.index bytes 0) + (B.index bytes 1) decodeMore = loop $! n + req - in if req > maxN then decodeTo n else decodeMore + in if n + req > maxN + then decodeTo n + else decodeMore - decodeTo n = first TE.decodeUtf16LE $ B.splitAt n bytes + 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 = Right . Prelude.map TE.encodeUtf16BE - dec = unsafeTryDec . splitBytes - splitBytes bytes = loop 0 where + 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 = (TE.decodeUtf16BE bytes, B.empty) + loop n | n == maxN = decodeAll | (n + 1) == maxN = decodeTo n loop n = let - req = utf16Required (B.index bytes 1) (B.index bytes 0) + req = utf16Required + (B.index bytes 1) + (B.index bytes 0) decodeMore = loop $! n + req - in if req > maxN then decodeTo n else decodeMore + in if n + req > maxN + then decodeTo n + else decodeMore - decodeTo n = first TE.decodeUtf16BE $ B.splitAt n bytes + 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 @@ -179,61 +463,85 @@ 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 = Right . Prelude.map TE.encodeUtf32LE - dec = unsafeTryDec . utf32SplitBytes TE.decodeUtf32LE - + 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 = Right . Prelude.map TE.encodeUtf32BE - dec = unsafeTryDec . utf32SplitBytes TE.decodeUtf32BE -utf32SplitBytes :: (B.ByteString -> a) -> B.ByteString -> (a, B.ByteString) -utf32SplitBytes dec bytes = (dec toDecode, extra) where + 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 (mapEither enc) dec where +ascii = Codec name enc dec where name = T.pack "ASCII" - enc t = case TC.findBy (\c -> ord c > 0x7F) t of - Nothing -> Right . B8.pack . T.unpack $ t - Just c -> illegalEnc name c - dec bytes = case B.find (\w -> w > 0x7F) bytes of - Nothing -> Right (T.pack (B8.unpack bytes), B.empty) - Just w -> illegalDec name w + 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 (mapEither enc) dec where +iso8859_1 = Codec name enc dec where name = T.pack "ISO-8859-1" - enc t = case TC.findBy (\c -> ord c > 0xFF) t of - Nothing -> Right . B8.pack . T.unpack $ t - Just c -> illegalEnc name c - dec bytes = Right (T.pack (B8.unpack bytes), B.empty) -illegalEnc :: T.Text -> Char -> Either E.SomeException a -illegalEnc name c = Left . E.toException . E.ErrorCall $ msg "" where - len = Prelude.length - pad str | len str < 4 = replicate (4 - len str) '0' ++ str - | otherwise = str - hex = "U+" ++ pad (showIntAtBase 16 (toUpper . intToDigit) (ord c) "") - msg = (s "Codec " . shows name . s " can't encode character " . s hex) - s = showString -illegalDec :: T.Text -> Word8 -> Either E.SomeException a -illegalDec name w = Left . E.toException . E.ErrorCall $ msg "" where - len = Prelude.length - pad str | len str < 2 = replicate (2 - len str) '0' ++ str - | otherwise = str - hex = "0x" ++ pad (showIntAtBase 16 (toUpper . intToDigit) w "") - msg = (s "Codec " . shows name . s " can't decode byte " . s hex) - s = showString -unsafeTryDec :: (a, b) -> Either E.SomeException (a, b) -unsafeTryDec (a, b) = unsafePerformIO $ do - tried <- E.try $ E.evaluate a - return $ case tried of - Left err -> Left err - Right _ -> Right (a, b) + 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) diff --git a/hs/Data/Enumerator/Util.hs b/hs/Data/Enumerator/Util.hs --- a/hs/Data/Enumerator/Util.hs +++ b/hs/Data/Enumerator/Util.hs @@ -1,20 +1,43 @@ + +{-# LANGUAGE CPP #-} module Data.Enumerator.Util where import Data.Enumerator + +import Data.Char (toUpper, intToDigit, ord) +import Data.Word (Word8) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Control.Exception as E +import qualified Control.Exception as Exc +import Numeric (showIntAtBase) -tryStep :: MonadIO m => IO t -> (t -> m (Step a m b)) -> m (Step a m b) +tryStep :: MonadIO m => IO t -> (t -> Iteratee a m b) -> Iteratee a m b tryStep get io = do - tried <- liftIO (E.try get) + tried <- liftIO (Exc.try get) case tried of Right t -> io t - Left err -> return $ Error err -{-# INLINE tryStep #-} + Left err -> throwError (err :: Exc.SomeException) -mapEither :: (a -> Either e b) -> [a] -> Either e [b] -mapEither f = loop [] where - loop acc [] = Right (reverse acc) - loop acc (a:as) = case f a of - Left err -> Left err - Right b -> loop (b:acc) as -{-# INLINE mapEither #-} +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 diff --git a/hs/text-0.10/Data/Enumerator/Text/Compat.hs b/hs/text-0.10/Data/Enumerator/Text/Compat.hs deleted file mode 100644 --- a/hs/text-0.10/Data/Enumerator/Text/Compat.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Data.Enumerator.Text.Compat - ( findBy - ) where -import qualified Data.Text as T -findBy :: (Char -> Bool) -> T.Text -> Maybe Char -findBy = T.findBy diff --git a/hs/text-0.11/Data/Enumerator/Text/Compat.hs b/hs/text-0.11/Data/Enumerator/Text/Compat.hs deleted file mode 100644 --- a/hs/text-0.11/Data/Enumerator/Text/Compat.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Data.Enumerator.Text.Compat - ( findBy - ) where -import qualified Data.Text as T -findBy :: (Char -> Bool) -> T.Text -> Maybe Char -findBy = T.find diff --git a/readme.txt b/readme.txt --- a/readme.txt +++ b/readme.txt @@ -1,10 +1,10 @@ The source code for "enumerator" is literate. To build the library from scratch, install the "anansi" application and then run: - anansi -o hs/ enumerator.anansi + anansi -o hs/ src/enumerator.anansi To generate the woven PDF, install NoWeb and then run: - anansi -w -l latex-noweb -o enumerator.tex enumerator.anansi + anansi -w -l latex-noweb -o enumerator.tex src/enumerator.anansi xelatex enumerator.tex xelatex enumerator.tex diff --git a/scripts/cabal-dist b/scripts/cabal-dist new file mode 100644 --- /dev/null +++ b/scripts/cabal-dist @@ -0,0 +1,57 @@ +#!/bin/bash +if [ ! -f 'enumerator.cabal' ]; then + echo -n "Can't find enumerator.cabal; please run this script as" + echo -n " ./scripts/cabal-dist from within the enumerator source" + echo " directory" + exit 1 +fi + +XZ=$(which xz) +XELATEX=$(which xelatex) +if [ -d 'cabal-dev' ]; then + CABAL=$(which cabal-dev) + PATH="$PATH:$PWD/cabal-dev/bin/" +else + CABAL=$(which cabal) +fi + +ANANSI=$(which anansi) +if [ -z "$ANANSI" ]; then + echo "Can't find 'anansi' executable; make sure it exists on your "'$PATH' + exit 1 +fi + +VERSION=$(awk '/^version:/{print $2}' enumerator.cabal) + +echo "Building dist for enumerator-$VERSION using $CABAL" + +rm -rf hs dist +anansi --noline -o hs src/enumerator.anansi || exit 1 +$CABAL configure || exit 1 +$CABAL build || exit 1 +$CABAL sdist || exit 1 +mv "dist/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 + +if [ -n "$XELATEX" ]; then + rm -f *.{aux,tex,idx,log,out,toc,pdf} + anansi -w -l latex-noweb -o enumerator.tex src/enumerator.anansi || exit 1 + xelatex enumerator.tex > /dev/null || exit 1 + xelatex enumerator.tex > /dev/null || exit 1 + + mv enumerator.pdf "enumerator_$VERSION.pdf" +fi + +echo "" +echo "============================================================" +if [ -n "$XELATEX" ]; then + echo " woven source : enumerator_$VERSION.pdf" +fi +echo " source tarball (gz) : enumerator_$VERSION.tar.gz" +if [ -n "$XZ" ]; then + echo " source archive (xz) : enumerator_$VERSION.tar.xz" +fi +echo "============================================================" diff --git a/scripts/run-tests b/scripts/run-tests new file mode 100644 --- /dev/null +++ b/scripts/run-tests @@ -0,0 +1,31 @@ +#!/bin/bash +if [ ! -f 'enumerator.cabal' ]; then + echo -n "Can't find enumerator.cabal; please run this script as" + echo -n " ./scripts/make-tests from within the enumerator source" + echo " directory" + exit 1 +fi + +CABAL=$(which cabal-dev) +if [ -z "$CABAL" ]; then + echo -n "Can't find 'cabal-dev'; cowardly refusing to fuck with the" + echo " global package database" +fi +PATH="$PATH:$PWD/cabal-dev/bin/" + +ANANSI=$(which anansi) +if [ -z "$ANANSI" ]; then + echo "Can't find 'anansi' executable; make sure it exists on your "'$PATH' + exit 1 +fi + +rm -rf hs dist +anansi -o hs src/enumerator.anansi || exit 1 + +$CABAL install || exit 1 + +pushd tests +$CABAL -s ../cabal-dev install || exit 1 +popd + +cabal-dev/bin/enumerator_tests diff --git a/src/api-docs.anansi b/src/api-docs.anansi new file mode 100644 --- /dev/null +++ b/src/api-docs.anansi @@ -0,0 +1,711 @@ +\onecolumn +\section{Haddock API documentation} + +This section just repeats literate documentation in Haddock syntax. + +:d Data.Enumerator module header +----------------------------------------------------------------------------- +-- | +-- Module: Data.Enumerator +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Core enumerator types, and some useful primitives. +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator as E +-- @ +-- +----------------------------------------------------------------------------- +: + +:d Data.Enumerator.List module header +----------------------------------------------------------------------------- +-- | +-- Module: Data.Enumerator.List +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator.List as EL +-- @ +-- +-- Since: 0.4.5 +-- +----------------------------------------------------------------------------- +: + +:d Data.Enumerator.Binary module header +----------------------------------------------------------------------------- +-- | +-- Module: Data.Enumerator.Binary +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator.Binary as EB +-- @ +-- +-- Since: 0.4.5 +-- +----------------------------------------------------------------------------- +: + +:d Data.Enumerator.Text module header +----------------------------------------------------------------------------- +-- | +-- Module: Data.Enumerator.Text +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Data.Enumerator.Text as ET +-- @ +-- +-- Since: 0.2 +-- +----------------------------------------------------------------------------- +: + +:d Data.Enumerator.IO module header +----------------------------------------------------------------------------- +-- | +-- Module: Data.Enumerator.IO +-- Copyright: 2010 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Deprecated in 0.4.5: use "Data.Enumerator.Binary" instead +-- +----------------------------------------------------------------------------- +: + +:d apidoc Data.Enumerator.($$) +-- | @($$) = (==\<\<)@ +-- +-- This might be easier to read when passing a chain of iteratees to an +-- enumerator. +-- +-- Since: 0.1.1 +: + +:d apidoc Data.Enumerator.(<==<) +-- | @(\<==\<) = flip (>==>)@ +-- +-- Since: 0.1.1 +: + +:d apidoc Data.Enumerator.(==<<) +-- | @(==\<\<) = flip (\>\>==)@ +: + +:d apidoc Data.Enumerator.(>==>) +-- | @(>==>) e1 e2 s = e1 s >>== e2@ +-- +-- Since: 0.1.1 +: + +:d apidoc Data.Enumerator.(>>==) +-- | Equivalent to '(>>=)' for @m ('Step' a m b)@; allows 'Iteratee's with +-- different input types to be composed. +: + +:d apidoc Data.Enumerator.Continue +-- | The 'Iteratee' is capable of accepting more input. Note that more input +-- is not necessarily required; the 'Iteratee' might be able to generate a +-- value immediately if it receives 'EOF'. +: + +:d apidoc Data.Enumerator.Enumeratee +-- | In cases where an enumerator acts as both a source and sink, the resulting +-- type is named an 'Enumeratee'. Enumeratees have two input types, +-- “outer a” (@aOut@) and “inner a” (@aIn@). +: + +:d apidoc Data.Enumerator.Enumerator +-- | While 'Iteratee's consume data, enumerators generate it. Since +-- @'Iteratee'@ is an alias for @m ('Step' a m b)@, 'Enumerator's can +-- be considered step transformers of type +-- @'Step' a m b -> m ('Step' a m b)@. +-- +-- 'Enumerator's typically read from an external source (parser, handle, +-- random generator, etc). They feed chunks into an 'Iteratee' until the +-- source runs out of data (triggering 'EOF') or the iteratee finishes +-- processing ('Yield's a value). +: + +:d apidoc Data.Enumerator.Error +-- | The 'Iteratee' encountered an error which prevents it from proceeding +-- further. +: + +:d apidoc Data.Enumerator.Iteratee +-- | The primary data type for this library, which consumes +-- input from a 'Stream' until it either generates a value or encounters +-- an error. Rather than requiring all input at once, an iteratee will +-- return 'Continue' when it is capable of processing more data. +-- +-- In general, iteratees begin in the 'Continue' state. As each chunk is +-- passed to the continuation, the iteratee returns the next step: +-- 'Continue' for more data, 'Yield' when it's finished, or 'Error' to +-- abort processing. +: + +:d apidoc Data.Enumerator.Stream +-- | A 'Stream' is a sequence of chunks generated by an 'Enumerator'. +-- +-- @('Chunks' [])@ is used to indicate that a stream is still active, but +-- currently has no available data. Iteratees should ignore empty chunks. +: + +:d apidoc Data.Enumerator.Yield +-- | The 'Iteratee' cannot receive any more input, and has generated a +-- result. Included in this value is left-over input, which can be passed to +-- composed 'Iteratee's. +: + +:d apidoc Data.Enumerator.break +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.takeWhile' instead +: + +:d apidoc Data.Enumerator.catchError +-- | Runs the iteratee, and calls an exception handler if an 'Error' is +-- returned. By handling errors within the enumerator library, and requiring +-- all errors to be represented by 'Exc.SomeException', libraries with +-- varying error types can be easily composed. +-- +-- Since: 0.1.1 +: + +:d apidoc Data.Enumerator.checkDone +-- | @checkDone = 'checkDoneEx' ('Chunks' [])@ +-- +-- Use this for enumeratees which do not have an input buffer. +: + +:d apidoc Data.Enumerator.checkDoneEx +-- | A common pattern in 'Enumeratee' implementations is to check whether +-- the inner 'Iteratee' has finished, and if so, to return its output. +-- 'checkDone' passes its parameter a continuation if the 'Iteratee' +-- can still consume input, or yields otherwise. +-- +-- Since: 0.4.3 +: + +:d apidoc Data.Enumerator.concatEnums +-- | Compose a list of 'Enumerator's using @'(>>==)'@ +: + +:d apidoc Data.Enumerator.concatMap +-- | @concatMap f = 'concatMapM' (return . f)@ +-- +-- Since: 0.4.3 +: + +:d apidoc Data.Enumerator.concatMapM +-- | @concatMapM f@ applies /f/ to each input element and feeds the +-- resulting outputs to the inner iteratee. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.consume +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.consume' instead +: + +:d apidoc Data.Enumerator.continue +-- | @continue k = 'returnI' ('Continue' k)@ +: + +:d apidoc Data.Enumerator.drop +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.drop' instead +: + +:d apidoc Data.Enumerator.dropWhile +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.dropWhile' instead +: + +:d apidoc Data.Enumerator.enumEOF +-- | docs TODO +: + +:d apidoc Data.Enumerator.enumList +-- | @enumList n xs@ enumerates /xs/ as a stream, passing /n/ inputs per +-- chunk. +-- +-- Primarily useful for testing and debugging. +: + +:d apidoc Data.Enumerator.filter +-- | @filter p = 'concatMap' (\x -> 'Prelude.filter' p [x])@ +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.filterM +-- | @filterM p = 'concatMapM' (\x -> 'CM.filterM' p [x])@ +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.foldl +-- | Run the entire input stream through a pure left fold, yielding when +-- there is no more input. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.foldl' +-- | Run the entire input stream through a pure strict left fold, yielding +-- when there is no more input. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.foldM +-- | Run the entire input stream through a monadic left fold, yielding +-- when there is no more input. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.generateM +-- | Like 'repeatM', except the computation may terminate the stream by +-- returning 'Nothing'. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.head +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.head' instead +: + +:d apidoc Data.Enumerator.isEOF +-- | docs TODO +: + +:d apidoc Data.Enumerator.iterate +-- | @iterate f x@ enumerates an infinite stream of repeated applications +-- of /f/ to /x/. +-- +-- Analogous to 'Prelude.iterate'. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.iterateM +-- | Similar to 'iterate', except the iteration function is monadic. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.joinE +-- | Flatten an enumerator/enumeratee pair into a single enumerator. +: + +:d apidoc Data.Enumerator.joinI +-- | 'joinI' is used to “flatten” 'Enumeratee's into an +-- 'Iteratee'. +: + +:d apidoc Data.Enumerator.last +-- | Get the last element in the stream, or 'Nothing' if the stream +-- has ended. +-- +-- Consumes the entire stream. +: + +:d apidoc Data.Enumerator.length +-- | Get how many elements remained in the stream. +-- +-- Consumes the entire stream. +: + +:d apidoc Data.Enumerator.liftFoldL +-- | Deprecated in 0.4.5: use 'Data.Enumerator.foldl' instead +-- +-- Since: 0.1.1 +: + +:d apidoc Data.Enumerator.liftFoldL' +-- | Deprecated in 0.4.5: use 'Data.Enumerator.foldl'' instead +-- +-- Since: 0.1.1 +: + +:d apidoc Data.Enumerator.liftFoldM +-- | Deprecated in 0.4.5: use 'Data.Enumerator.foldM' instead +-- +-- Since: 0.1.1 +: + +:d apidoc Data.Enumerator.liftI +-- | Deprecated in 0.4.5: use 'Data.Enumerator.continue' instead +: + +:d apidoc Data.Enumerator.liftTrans +-- | Lift an 'Iteratee' onto a monad transformer, re-wrapping the +-- 'Iteratee'’s inner monadic values. +-- +-- Since: 0.1.1 +: + +:d apidoc Data.Enumerator.map +-- | @map f = 'concatMap' (\x -> 'Prelude.map' f [x])@ +: + +:d apidoc Data.Enumerator.mapM +-- | @mapM f = 'concatMapM' (\x -> 'Prelude.mapM' f [x])@ +-- +-- Since: 0.4.3 +: + +:d apidoc Data.Enumerator.peek +-- | Peek at the next element in the stream, or 'Nothing' if the stream +-- has ended. +: + +:d apidoc Data.Enumerator.printChunks +-- | Print chunks as they're received from the enumerator, optionally +-- printing empty chunks. +: + +:d apidoc Data.Enumerator.repeat +-- | Enumerates an infinite stream of the provided value. +-- +-- Analogous to 'Prelude.repeat'. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.repeatM +-- | Enumerates an infinite stream by running the provided computation and +-- passing each result to the iteratee. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.replicate +-- | @replicate n x = 'replicateM' n (return x)@ +-- +-- Analogous to 'Prelude.replicate'. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.replicateM +-- | @replicateM n m_x@ enumerates a stream of /n/ input elements; each +-- element is generated by running the input computation /m_x/ once. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.returnI +-- | @returnI step = 'Iteratee' (return step)@ +: + +:d apidoc Data.Enumerator.run +-- | Run an iteratee until it finishes, and return either the final value +-- (if it succeeded) or the error (if it failed). +: + +:d apidoc Data.Enumerator.run_ +-- | Like 'run', except errors are converted to exceptions and thrown. +-- Primarily useful for small scripts or other simple cases. +-- +-- Since: 0.4.1 +: + +:d apidoc Data.Enumerator.sequence +-- | Feeds outer input elements into the provided iteratee until it yields +-- an inner input, passes that to the inner iteratee, and then loops. +: + +:d apidoc Data.Enumerator.span +-- | Deprecated in 0.4.5: use 'Data.Enumerator.List.takeWhile' instead +: + +:d apidoc Data.Enumerator.throwError +-- | @throwError exc = 'returnI' ('Error' ('Exc.toException' exc))@ +: + +:d apidoc Data.Enumerator.yield +-- | @yield x extra = 'returnI' ('Yield' x extra)@ +: + +:d apidoc Data.Enumerator.Binary.consume +-- | Read all remaining input from the stream, and return as a lazy +-- ByteString. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Binary.drop +-- | @drop n@ ignores /n/ bytes of input from the stream. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Binary.dropWhile +-- | @dropWhile p@ ignores input from the stream until the first byte which +-- does not match the predicate. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Binary.enumFile +-- | Opens a file path in binary mode, and passes the handle to 'enumHandle'. +-- The file will be closed when the 'Iteratee' finishes. +: + +:d apidoc Data.Enumerator.Binary.enumHandle +-- | Read bytes (in chunks of the given buffer size) from the handle, and +-- stream them to an 'Iteratee'. If an exception occurs during file IO, +-- enumeration will stop and 'Error' will be returned. Exceptions from the +-- iteratee are not caught. +-- +-- This enumerator blocks until at least one byte is available from the +-- handle, and might read less than the maximum buffer size in some +-- cases. +-- +-- The handle should be opened with no encoding, and in 'IO.ReadMode' or +-- 'IO.ReadWriteMode'. +: + +:d apidoc Data.Enumerator.Binary.head +-- | Get the next byte from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Binary.isolate +-- | @isolate n@ reads at most /n/ bytes from the stream, and passes them +-- to its iteratee. If the iteratee finishes early, bytes continue to be +-- consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Binary.iterHandle +-- | Read bytes from a stream and write them to a handle. If an exception +-- occurs during file IO, enumeration will stop and 'Error' will be +-- returned. +-- +-- The handle should be opened with no encoding, and in 'IO.WriteMode' or +-- 'IO.ReadWriteMode'. +: + +:d apidoc Data.Enumerator.Binary.require +-- | @require n@ buffers input until at least /n/ bytes are available, or +-- throws an error if the stream ends early. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Binary.take +-- | @take n@ extracts the next /n/ bytes from the stream, as a lazy +-- ByteString. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Binary.takeWhile +-- | @takeWhile p@ extracts input from the stream until the first byte which +-- does not match the predicate. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.IO.enumFile +-- | Deprecated in 0.4.5: use 'Data.Enumerator.Binary.enumFile' instead +: + +:d apidoc Data.Enumerator.IO.enumHandle +-- | Deprecated in 0.4.5: use 'Data.Enumerator.Binary.enumHandle' instead +: + +:d apidoc Data.Enumerator.IO.iterHandle +-- | Deprecated in 0.4.5: use 'Data.Enumerator.Binary.iterHandle' instead +: + +:d apidoc Data.Enumerator.List.consume +-- | Read all remaining input elements from the stream, and return as a list. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.List.drop +-- | @drop n@ ignores /n/ input elements from the stream. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.List.dropWhile +-- | @dropWhile p@ ignores input from the stream until the first element +-- which does not match the predicate. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.List.head +-- | Get the next element from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.List.isolate +-- | @isolate n@ reads at most /n/ elements from the stream, and passes them +-- to its iteratee. If the iteratee finishes early, elements continue to be +-- consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.List.require +-- | @require n@ buffers input until at least /n/ elements are available, or +-- throws an error if the stream ends early. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.List.take +-- | @take n@ extracts the next /n/ elements from the stream, as a list. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.List.takeWhile +-- | @takeWhile p@ extracts input from the stream until the first element +-- which does not match the predicate. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Text.Codec +-- | docs TODO +-- +-- Since: 0.2 +: + +:d apidoc Data.Enumerator.Text.consume +-- | Read all remaining input from the stream, and return as a lazy +-- Text. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Text.decode +-- | Convert bytes into text, using the provided codec. If the codec is +-- not capable of decoding an input byte sequence, an error will be thrown. +-- +-- Since: 0.2 +: + +:d apidoc Data.Enumerator.Text.drop +-- | @drop n@ ignores /n/ characters of input from the stream. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Text.dropWhile +-- | @dropWhile p@ ignores input from the stream until the first character +-- which does not match the predicate. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Text.encode +-- | Convert text into bytes, using the provided codec. If the codec is +-- not capable of representing an input character, an error will be thrown. +-- +-- Since: 0.2 +: + +:d apidoc Data.Enumerator.Text.enumFile +-- | Opens a file path in text mode, and passes the handle to 'enumHandle'. +-- The file will be closed when the 'Iteratee' finishes. +-- +-- Since: 0.2 +: + +:d apidoc Data.Enumerator.Text.enumHandle +-- | Read lines of text from the handle, and stream them to an 'Iteratee'. +-- If an exception occurs during file IO, enumeration will stop and 'Error' +-- will be returned. Exceptions from the iteratee are not caught. +-- +-- The handle should be opened with an appropriate text encoding, and +-- in 'IO.ReadMode' or 'IO.ReadWriteMode'. +-- +-- Since: 0.2 +: + +:d apidoc Data.Enumerator.Text.head +-- | Get the next character from the stream, or 'Nothing' if the stream has +-- ended. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Text.isolate +-- | @isolate n@ reads at most /n/ characters from the stream, and passes +-- them to its iteratee. If the iteratee finishes early, characters continue +-- to be consumed from the outer stream until /n/ have been consumed. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Text.iterHandle +-- | Read text from a stream and write it to a handle. If an exception +-- occurs during file IO, enumeration will stop and 'Error' will be +-- returned. +-- +-- The handle should be opened with an appropriate text encoding, and +-- in 'IO.WriteMode' or 'IO.ReadWriteMode'. +-- +-- Since: 0.2 +: + +:d apidoc Data.Enumerator.Text.require +-- | @require n@ buffers input until at least /n/ characters are available, +-- or throws an error if the stream ends early. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Text.take +-- | @take n@ extracts the next /n/ characters from the stream, as a lazy +-- Text. +-- +-- Since: 0.4.5 +: + +:d apidoc Data.Enumerator.Text.takeWhile +-- | @takeWhile p@ extracts input from the stream until the first character +-- which does not match the predicate. +-- +-- Since: 0.4.5 +: diff --git a/src/binary.anansi b/src/binary.anansi new file mode 100644 --- /dev/null +++ b/src/binary.anansi @@ -0,0 +1,222 @@ +\section{Binary} + +:f Data/Enumerator/Binary.hs +|Data.Enumerator.Binary module header| +module Data.Enumerator.Binary ( + |Data.Enumerator.Binary exports| + ) where +import Prelude hiding (head, drop, takeWhile) +import Data.Enumerator hiding (head, drop) +import qualified Data.ByteString as B +|Data.Enumerator.Binary imports| +: + +\subsection{IO} + +{\tt enumHandle} and {\tt enumFile} are rough analogues of +{\tt hGetContents} and {\tt readFile} from the standard library, except +they operate only in binary mode. + +Any exceptions thrown while reading or writing data are caught and reported +using {\tt throwError}, so errors can be handled in pure iteratees. + +:d Data.Enumerator.Binary imports +import Data.Enumerator.Util (tryStep) +import qualified Control.Exception as Exc +import Control.Monad.IO.Class (MonadIO) +import qualified System.IO as IO +import System.IO.Error (isEOFError) +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.enumHandle| +enumHandle :: MonadIO m + => Integer -- ^ Buffer size + -> IO.Handle + -> Enumerator B.ByteString m b +enumHandle bufferSize h = loop where + loop (Continue k) = withBytes $ \bytes -> + if B.null bytes + then continue k + else k (Chunks [bytes]) >>== loop + + loop step = returnI step + + intSize = fromInteger bufferSize + withBytes = tryStep $ 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 intSize + else return B.empty +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.enumFile| +enumFile :: FilePath -> Enumerator B.ByteString IO b +enumFile path = enum where + withHandle = tryStep (IO.openBinaryFile path IO.ReadMode) + enum step = withHandle $ \h -> do + Iteratee $ Exc.finally + (runIteratee (enumHandle 4096 h step)) + (IO.hClose h) +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.iterHandle| +iterHandle :: MonadIO m => IO.Handle + -> Iteratee B.ByteString m () +iterHandle h = continue step where + step EOF = yield () EOF + step (Chunks []) = continue step + step (Chunks bytes) = let + put = mapM_ (B.hPut h) bytes + in tryStep put (\_ -> continue step) +: + +:d Data.Enumerator.Binary exports + -- * Binary IO + enumHandle +, enumFile +, iterHandle +: + +\subsection{List analogues} + +:d Data.Enumerator.Binary imports +import Data.Word (Word8) +import qualified Data.ByteString.Lazy as BL +: + +:f Data/Enumerator/Binary.hs +toChunks :: BL.ByteString -> Stream B.ByteString +toChunks = Chunks . BL.toChunks +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.head| +head :: Monad m => Iteratee B.ByteString m (Maybe Word8) +head = continue loop where + loop (Chunks xs) = case BL.uncons (BL.fromChunks xs) of + Just (char, extra) -> yield (Just char) (toChunks extra) + Nothing -> head + loop EOF = yield Nothing EOF +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.drop| +drop :: Monad m => Integer -> Iteratee B.ByteString m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + iter = if len < n' + then drop (n' - len) + else yield () (toChunks (BL.drop (fromInteger n') lazy)) + loop _ EOF = yield () EOF +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.dropWhile| +dropWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m () +dropWhile p = continue loop where + loop (Chunks xs) = iter where + lazy = BL.dropWhile p (BL.fromChunks xs) + iter = if BL.null lazy + then continue loop + else yield () (toChunks lazy) + loop EOF = yield () EOF +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.take| +take :: Monad m => Integer -> Iteratee B.ByteString m BL.ByteString +take n | n <= 0 = return BL.empty +take n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + + iter = if len < n' + then continue (loop (acc . (BL.append lazy)) (n' - len)) + else let + (xs', extra) = BL.splitAt (fromInteger n') lazy + in yield (acc xs') (toChunks extra) + loop acc _ EOF = yield (acc BL.empty) EOF +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.takeWhile| +takeWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m BL.ByteString +takeWhile p = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = iter where + lazy = BL.fromChunks xs + (xs', extra) = BL.span p lazy + iter = if BL.null extra + then continue (loop (acc . (BL.append lazy))) + else yield (acc xs') (toChunks extra) + loop acc EOF = yield (acc BL.empty) EOF +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.consume| +consume :: Monad m => Iteratee B.ByteString m BL.ByteString +consume = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = iter where + lazy = BL.fromChunks xs + iter = continue (loop (acc . (BL.append lazy))) + loop acc EOF = yield (acc BL.empty) EOF +: + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.require| +require :: Monad m => Integer -> Iteratee B.ByteString m () +require n | n <= 0 = return () +require n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + iter = if len < n' + then continue (loop (acc . (BL.append lazy)) (n' - len)) + else yield () (toChunks (acc lazy)) + loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") +: + +Same caveats as {\tt Data.Enumerator.List.isolate} + +:f Data/Enumerator/Binary.hs +|apidoc Data.Enumerator.Binary.isolate| +isolate :: Monad m => Integer -> Enumeratee B.ByteString B.ByteString m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + loop (Chunks []) = continue loop + loop (Chunks xs) = iter where + lazy = BL.fromChunks xs + len = toInteger (BL.length lazy) + + iter = if len <= n + then k (Chunks xs) >>== isolate (n - len) + else let + (s1, s2) = BL.splitAt (fromInteger n) lazy + in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step +: + +:d Data.Enumerator.Binary exports +-- * List analogues +, Data.Enumerator.Binary.head +, Data.Enumerator.Binary.drop +, Data.Enumerator.Binary.dropWhile +, Data.Enumerator.Binary.take +, Data.Enumerator.Binary.takeWhile +, Data.Enumerator.Binary.consume +, require +, isolate +: diff --git a/src/compat.anansi b/src/compat.anansi new file mode 100644 --- /dev/null +++ b/src/compat.anansi @@ -0,0 +1,237 @@ +\section{Compatibility} + +Version 0.4.5 of this library introduced some substantial reorganization +and renamings; this section implements compatibility shims, so the API +remains stable. + +:d Data.Enumerator exports +-- * Compatibility +: + +\subsection{Obsolete functions} + +These are functions which seemed like good ideas, or were defined by other +enumerator/iteratee libraries, but turned out to be basically useless. At +least, I've never figured out what they're good for. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.liftTrans| +liftTrans :: (Monad m, MonadTrans t, Monad (t m)) => + Iteratee a m b -> Iteratee a (t m) b +liftTrans iter = Iteratee $ do + step <- lift (runIteratee iter) + return $ case step of + Yield x cs -> Yield x cs + Error err -> Error err + Continue k -> Continue (liftTrans . k) +: + +:f Data/Enumerator.hs +{-# DEPRECATED liftI + "Use 'Data.Enumerator.continue' instead" #-} +|apidoc Data.Enumerator.liftI| +liftI :: Monad m => (Stream a -> Step a m b) + -> Iteratee a m b +liftI k = continue (returnI . k) +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.peek| +peek :: Monad m => Iteratee a m (Maybe a) +peek = continue loop where + loop (Chunks []) = continue loop + loop chunk@(Chunks (x:_)) = yield (Just x) chunk + loop EOF = yield Nothing EOF +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.last| +last :: Monad m => Iteratee a m (Maybe a) +last = continue (loop Nothing) where + loop ret (Chunks xs) = continue . loop $ case xs of + [] -> ret + _ -> Just (Prelude.last xs) + loop ret EOF = yield ret EOF +: + +:d Data.Enumerator imports +import Data.List (genericLength) +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.length| +length :: Monad m => Iteratee a m Integer +length = continue (loop 0) where + len = genericLength + loop n (Chunks xs) = continue (loop (n + len xs)) + loop n EOF = yield n EOF +: + +:d Data.Enumerator exports +-- ** Obsolete functions +, liftTrans +, liftI +, peek +, Data.Enumerator.last +, Data.Enumerator.length +: + +\subsection{Aliases} + +In previous library versions, several list-based iteratees were defined in +{\tt Data.Enumerator}. They are now defined in {\tt Data.Enumerator.List}; +because these functions use core enumerator types, a bit of module +gymnastics is required to get everything compiling properly. + +:f Data/Enumerator.hs-boot +module Data.Enumerator where +import qualified Control.Exception as Exc +data Stream a +data Step a m b + = Continue (Stream a -> Iteratee a m b) + | Yield b (Stream a) + | Error Exc.SomeException +newtype Iteratee a m b = Iteratee + { runIteratee :: m (Step a m b) + } +: + +:f Data/Enumerator/List.hs-boot +module Data.Enumerator.List where +import {-# SOURCE #-} Data.Enumerator +head :: Monad m => Iteratee a m (Maybe a) +drop :: Monad m => Integer -> Iteratee a m () +dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () +takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] +consume :: Monad m => Iteratee a m [a] +: + +:d Data.Enumerator imports +import {-# SOURCE #-} qualified Data.Enumerator.List as EL +: + +These {\tt .hs-boot} files are enough for {\tt Data.Enumerator} to re-export +the list functions under old names, with appropriate deprecation warnings. + +:f Data/Enumerator.hs +{-# DEPRECATED head + "Use 'Data.Enumerator.List.head' instead" #-} +|apidoc Data.Enumerator.head| +head :: Monad m => Iteratee a m (Maybe a) +head = EL.head + +{-# DEPRECATED drop + "Use 'Data.Enumerator.List.drop' instead" #-} +|apidoc Data.Enumerator.drop| +drop :: Monad m => Integer -> Iteratee a m () +drop = EL.drop + +{-# DEPRECATED dropWhile + "Use 'Data.Enumerator.List.dropWhile' instead" #-} +|apidoc Data.Enumerator.dropWhile| +dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () +dropWhile = EL.dropWhile + +{-# DEPRECATED span + "Use 'Data.Enumerator.List.takeWhile' instead" #-} +|apidoc Data.Enumerator.span| +span :: Monad m => (a -> Bool) -> Iteratee a m [a] +span = EL.takeWhile + +{-# DEPRECATED break + "Use 'Data.Enumerator.List.takeWhile' instead" #-} +|apidoc Data.Enumerator.break| +break :: Monad m => (a -> Bool) -> Iteratee a m [a] +break p = EL.takeWhile (not . p) + +{-# DEPRECATED consume + "Use 'Data.Enumerator.List.consume' instead" #-} +|apidoc Data.Enumerator.consume| +consume :: Monad m => Iteratee a m [a] +consume = EL.consume +: + +:d Data.Enumerator exports +-- ** Deprecated aliases +, Data.Enumerator.head +, Data.Enumerator.drop +, Data.Enumerator.dropWhile +, Data.Enumerator.span +, Data.Enumerator.break +, Data.Enumerator.consume +: + +0.4.5 also saw the pure-fold enumerators renamed, to match other functions +based on {\tt Prelude} names. + +:f Data/Enumerator.hs +{-# DEPRECATED liftFoldL + "Use 'Data.Enumerator.foldl' instead" #-} +|apidoc Data.Enumerator.liftFoldL| +liftFoldL :: Monad m => (b -> a -> b) -> b + -> Iteratee a m b +liftFoldL = Data.Enumerator.foldl + +{-# DEPRECATED liftFoldL' + "Use 'Data.Enumerator.foldl' ' instead" #-} +|apidoc Data.Enumerator.liftFoldL'| +liftFoldL' :: Monad m => (b -> a -> b) -> b + -> Iteratee a m b +liftFoldL' = Data.Enumerator.foldl' + +{-# DEPRECATED liftFoldM + "Use 'Data.Enumerator.foldM' instead" #-} +|apidoc Data.Enumerator.liftFoldM| +liftFoldM :: Monad m => (b -> a -> m b) -> b + -> Iteratee a m b +liftFoldM = Data.Enumerator.foldM +: + +:d Data.Enumerator exports +, liftFoldL +, liftFoldL' +, liftFoldM +: + +\clearpage +Finally, the {\tt Data.Enumerator.IO} module was moved to +{\tt Data.Enumerator.Binary}, and altered to include many more functions +related to binary and {\tt ByteString} processing. + +:f Data/Enumerator/IO.hs +|Data.Enumerator.IO module header| +module Data.Enumerator.IO + {-# DEPRECATED + "Use 'Data.Enumerator.Binary' instead" #-} + ( enumHandle + , enumFile + , iterHandle + ) where +import qualified Data.Enumerator as E +import qualified Data.Enumerator.Binary as EB +import Control.Monad.IO.Class (MonadIO) +import qualified Data.ByteString as B +import qualified System.IO as IO + +{-# DEPRECATED enumHandle + "Use 'Data.Enumerator.Binary.enumHandle' instead" #-} +|apidoc Data.Enumerator.IO.enumHandle| +enumHandle :: MonadIO m + => Integer + -> IO.Handle + -> E.Enumerator B.ByteString m b +enumHandle = EB.enumHandle + +{-# DEPRECATED enumFile + "Use 'Data.Enumerator.Binary.enumFile' instead" #-} +|apidoc Data.Enumerator.IO.enumFile| +enumFile :: FilePath -> E.Enumerator B.ByteString IO b +enumFile = EB.enumFile + +{-# DEPRECATED iterHandle + "Use 'Data.Enumerator.Binary.iterHandle' instead" #-} +|apidoc Data.Enumerator.IO.iterHandle| +iterHandle :: MonadIO m => IO.Handle + -> E.Iteratee B.ByteString m () +iterHandle = EB.iterHandle +: diff --git a/src/enumerator.anansi b/src/enumerator.anansi new file mode 100644 --- /dev/null +++ b/src/enumerator.anansi @@ -0,0 +1,119 @@ +:# Copyright (C) 2010 John Millikin +:# +:# See license.txt for details + +:option tab-size 2 + +\documentclass{article} + +\usepackage{color} +\usepackage{hyperref} +\usepackage{noweb} +\usepackage{indentfirst} +\usepackage{amsmath} +\usepackage{multicol} + +\noweboptions{smallcode} + +% Smaller margins +\usepackage[left=1cm,top=1cm,right=1cm]{geometry} + +% Remove boxes from hyperlinks +\hypersetup{ + colorlinks, + linkcolor=blue, + urlcolor=blue, +} + +\newcommand{\io}{{\sc i/o}} + +\title{enumerator\_0.4.5} +\author{John Millikin\\ + \href{mailto:"John Millikin" }{\tt jmillikin@gmail.com}} +\date{January 10, 2011} + +\begin{document} + +\maketitle + +\setlength{\parskip}{5pt plus 1pt} + +\begin{multicols}{2} +\section*{Abstract} + +Typical buffer-based incremental \io{} is based around a single loop, which +reads data from some source (such as a socket or file), transforms it, and +generates one or more outputs (such as a line count, {\sc http} responses, +or modified file). Although efficient and safe, these loops are all +single-purpose; it is difficult or impossible to compose buffer-based +processing loops. + +Haskell's concept of ``lazy \io{}'' allows pure code to operate on data from +an external source. However, lazy \io{} has several shortcomings. Most notably, +resources such as memory and file handles can be retained for arbitrarily +long periods of time, causing unpredictable performance and error conditions. + +Enumerators are an efficient, predictable, and safe alternative to lazy \io{}. +Discovered by Oleg \mbox{Kiselyov}, they allow large datasets to be processed +in near-constant space by pure code. Although somewhat more complex to write, +using enumerators instead of lazy \io{} produces more correct programs. + +This library contains an enumerator implementation for Haskell, designed to +be both simple and efficient. Three core types are defined, along with +numerous helper functions: + +\begin{itemize} + +\item {\it Iteratee\/}: Data sinks, analogous to left folds. Iteratees consume +a sequence of \emph{input} values, and generate a single \emph{output} value. +Many iteratees are designed to perform side effects (such as printing to +{\tt stdout}), so they can also be used as monad transformers. + +\item {\it Enumerator\/}: Data sources, which generate input sequences. Typical +enumerators read from a file handle, socket, random number generator, or +other external stream. To operate, enumerators are passed an iteratee, and +provide that iteratee with input until either the iteratee has completed its +computation, or {\sc eof}. + +\item {\it Enumeratee\/}: Data transformers, which operate as both enumerators and +iteratees. Enumeratees read from an \emph{outer} enumerator, and provide the +transformed data to an \emph{inner} iteratee. + +\end{itemize} + +\noindent Homepage: \href{http://john-millikin.com/software/enumerator/} + {\small \tt http://john-millikin.com/software/enumerator/} + +\setlength{\parskip}{0pt plus 1pt} +\tableofcontents +\setlength{\parskip}{4pt plus 1pt} +\end{multicols} + +\newpage +\begin{multicols*}{2} +:include types.anansi + +\newpage +:include primitives.anansi +\end{multicols*} + +\newpage +:include list.anansi + +\newpage +:include binary.anansi + +\newpage +:include text.anansi + +\newpage +:include util.anansi + +\newpage +\begin{multicols*}{2} +:include compat.anansi +\end{multicols*} + +:include api-docs.anansi + +\end{document} diff --git a/src/list.anansi b/src/list.anansi new file mode 100644 --- /dev/null +++ b/src/list.anansi @@ -0,0 +1,155 @@ +\section{Lists} + +:f Data/Enumerator/List.hs +|Data.Enumerator.List module header| +module Data.Enumerator.List ( + |Data.Enumerator.List exports| + ) where +import Data.Enumerator hiding (consume, head, peek, drop, dropWhile) +import Control.Exception (ErrorCall(..)) +import Prelude hiding (head, drop, dropWhile, take, takeWhile) +import qualified Data.List as L +: + +:f Data/Enumerator/List.hs +|apidoc Data.Enumerator.List.head| +head :: Monad m => Iteratee a m (Maybe a) +head = continue loop where + loop (Chunks []) = head + loop (Chunks (x:xs)) = yield (Just x) (Chunks xs) + loop EOF = yield Nothing EOF +: + +:f Data/Enumerator/List.hs +|apidoc Data.Enumerator.List.drop| +drop :: Monad m => Integer -> Iteratee a m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + len = L.genericLength xs + iter = if len < n' + then drop (n' - len) + else yield () (Chunks (L.genericDrop n' xs)) + loop _ EOF = yield () EOF +: + +:f Data/Enumerator/List.hs +|apidoc Data.Enumerator.List.dropWhile| +dropWhile :: Monad m => (a -> Bool) -> Iteratee a m () +dropWhile p = continue loop where + loop (Chunks xs) = case L.dropWhile p xs of + [] -> continue loop + xs' -> yield () (Chunks xs') + loop EOF = yield () EOF +: + +:f Data/Enumerator/List.hs +|apidoc Data.Enumerator.List.take| +take :: Monad m => Integer -> Iteratee a m [a] +take n | n <= 0 = return [] +take n = continue (loop id n) where + len = L.genericLength + loop acc n' (Chunks xs) + | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) + | otherwise = let + (xs', extra) = L.genericSplitAt n' xs + in yield (acc xs') (Chunks extra) + loop acc _ EOF = yield (acc []) EOF +: + +:f Data/Enumerator/List.hs +|apidoc Data.Enumerator.List.takeWhile| +takeWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] +takeWhile p = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = case Prelude.span p xs of + (_, []) -> continue (loop (acc . (xs ++))) + (xs', extra) -> yield (acc xs') (Chunks extra) + loop acc EOF = yield (acc []) EOF +: + +:# NOTE: peeking properly is currently impossible with the current design of +:# 'Stream'. Once it's updated to support EOF with "final data", peek can be +:# re-enabled +:# +:# :d Data/Enumerator/List.hs +:# |apidoc Data.Enumerator.List.peek| +:# peek :: Monad m => Integer -> Iteratee a m [a] +:# peek n | n <= 0 = return [] +:# peek 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' = L.genericTake n' xs +:# in yield (acc xs') (Chunks (acc xs)) +:# loop acc _ EOF = yield (acc []) EOF +:# : +:# +:# :d Data/Enumerator/List.hs (disabled) +:# |apidoc Data.Enumerator.List.peekWhile| +:# peekWhile :: Monad m => (a -> Bool) -> Iteratee a m [a] +:# peekWhile 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', _) -> yield (acc xs') (Chunks (acc xs)) +:# loop acc EOF = yield (acc []) EOF +:# : + +:f Data/Enumerator/List.hs +|apidoc Data.Enumerator.List.consume| +consume :: Monad m => Iteratee a m [a] +consume = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = continue (loop (acc . (xs ++))) + loop acc EOF = yield (acc []) EOF +: + +:f Data/Enumerator/List.hs +|apidoc Data.Enumerator.List.require| +require :: Monad m => Integer -> Iteratee a m () +require n | n <= 0 = return () +require n = continue (loop id n) where + len = L.genericLength + loop acc n' (Chunks xs) + | len xs < n' = continue (loop (acc . (xs ++)) (n' - len xs)) + | otherwise = yield () (Chunks (acc xs)) + loop _ _ EOF = throwError (ErrorCall "require: Unexpected EOF") +: + +Note: {\tt isolate} has some odd behavior regarding extra input in the +inner iteratee. Depending on how large the chunks are, extra input might +be returned in the {\tt Step}, or dropped. + +This doesn't matter if {\tt joinI} is used, but might if a user is poking +around inside the {\tt Step}. Eventually, enumeratees will be modified to +avoid exposing its internal iteratee state. + +:f Data/Enumerator/List.hs +|apidoc Data.Enumerator.List.isolate| +isolate :: Monad m => Integer -> Enumeratee a a m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + len = L.genericLength + + loop (Chunks []) = continue loop + loop (Chunks xs) + | len xs <= n = k (Chunks xs) >>== isolate (n - len xs) + | otherwise = let + (s1, s2) = L.genericSplitAt n xs + in k (Chunks s1) >>== (\step -> yield step (Chunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step +: + +:d Data.Enumerator.List exports + head +, drop +, dropWhile +, take +, takeWhile +, consume +, require +, isolate +: diff --git a/src/primitives.anansi b/src/primitives.anansi new file mode 100644 --- /dev/null +++ b/src/primitives.anansi @@ -0,0 +1,316 @@ +\section{Primitives} + +:d Data.Enumerator exports +-- * Primitives +: + +\subsection{Error handling} + +Most real-world applications have to deal with error conditions; however, +libraries have various ways of reporting errors. Some throw exceptions, +others use callbacks, and many just use {\tt Either}. Heterogeneous error +handling makes composing code very difficult; therefore, all +enumerator-based code simply uses the standard {\tt Control.Exception} +module and its types. + +Instances for the {\tt MonadError} class are provided in auxiliary +libraries, to avoid extraneous dependencies. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.throwError| +throwError :: (Monad m, Exc.Exception e) => e + -> Iteratee a m b +throwError exc = returnI (Error (Exc.toException exc)) +: + +Handling errors has a caveat: any input consumed before the error was +thrown can't be recovered. If an iteratee needs to continue parsing after an +error, either buffer the input stream or use a separate framing mechanism. + +This limitation means that {\tt catchError} is mostly only useful for +transforming or logging errors, not ignoring them. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.catchError| +catchError :: Monad m => Iteratee a m b + -> (Exc.SomeException -> Iteratee a m b) + -> Iteratee a m b +catchError iter h = iter >>== step where + step (Yield b as) = yield b as + step (Error err) = h err + step (Continue k) = continue (\s -> k s >>== step) +: + +:d Data.Enumerator exports +-- ** Error handling +, throwError +, catchError +: + +\subsection{Iteratees} + +Since iteratees are semantically a left-fold, there are many existing +folds that can be lifted to iteratees. The {\tt foldl}, {\tt foldl'}, and +{\tt foldM} functions work like their standard library namesakes, but +construct iteratees instead. These iteratees are not as complex as what can +be created using {\tt Yield} and {\tt Continue}, but cover many common cases. + +Each fold consumes input from the stream until {\sc eof}, when it yields its +current accumulator. + +:d Data.Enumerator imports +import Data.List (foldl') +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.foldl| +foldl :: Monad m => (b -> a -> b) -> b + -> Iteratee a m b +foldl step = continue . loop where + fold = Prelude.foldl step + loop acc stream = case stream of + Chunks [] -> continue (loop acc) + Chunks xs -> continue (loop (fold acc xs)) + EOF -> yield acc EOF +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.foldl'| +foldl' :: Monad m => (b -> a -> b) -> b + -> Iteratee a m b +foldl' step = continue . loop where + fold = Data.List.foldl' step + loop acc stream = case stream of + Chunks [] -> continue (loop acc) + Chunks xs -> continue (loop (fold acc xs)) + EOF -> yield acc EOF +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.foldM| +foldM :: Monad m => (b -> a -> m b) -> b + -> Iteratee a m b +foldM step = continue . loop where + fold acc = lift . CM.foldM step acc + + loop acc stream = case stream of + Chunks [] -> continue (loop acc) + Chunks xs -> fold acc xs >>= continue . loop + EOF -> yield acc EOF +: + +:d Data.Enumerator exports +-- ** Iteratees +, Data.Enumerator.foldl +, Data.Enumerator.foldl' +, Data.Enumerator.foldM +: + +\subsection{Enumerators} + +At their simplest, enumerators just check to see whether their received step +can accept any more input. If so, input is generated somehow, fed to the step, +and its result checked again. Most enumerators are defined using a +worker/wrapper pair, for efficiency and readability. + +Here we define a number of enumerators based on functions from +{\tt Data.List}. Each generator has a monadic and non-monadic form, to +demonstrate how side effects might be ordered with respect to the iteratee's +processing. + +{\tt iterate} and {\tt iterateM} apply a function repeatedly to the base +input, passing the results through as a stream. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.iterate| +iterate :: Monad m => (a -> a) -> a -> Enumerator a m b +iterate f = loop where + loop a (Continue k) = k (Chunks [a]) >>== loop (f a) + loop _ step = returnI step +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.iterateM| +iterateM :: Monad m => (a -> m a) -> a + -> Enumerator a m b +iterateM f base = loop (return base) where + loop m_a (Continue k) = do + a <- lift m_a + k (Chunks [a]) >>== loop (f a) + loop _ step = returnI step +: + +{\tt repeat} and {\tt repeatM} create infinite streams, where each input +is a single value. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.repeat| +repeat :: Monad m => a -> Enumerator a m b +repeat a = Data.Enumerator.iterate (const a) a +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.repeatM| +repeatM :: Monad m => m a -> Enumerator a m b +repeatM m_a step = do + a <- lift m_a + iterateM (const m_a) a step +: + +{\tt replicate} and {\tt replicateM} create streams containing a given +quantity of the input value. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.replicateM| +replicateM :: Monad m => Integer -> m a + -> Enumerator a m b +replicateM maxCount getNext = loop maxCount where + loop 0 step = returnI step + loop n (Continue k) = do + next <- lift getNext + k (Chunks [next]) >>== loop (n - 1) + loop _ step = returnI step +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.replicate| +replicate :: Monad m => Integer -> a + -> Enumerator a m b +replicate maxCount a = replicateM maxCount (return a) +: + +{\tt generateM} runs a monadic computation until it returns {\tt Nothing}, +which signals the end of enumeration. + +Note that when the enumerator is finished, it does not send {\tt EOF} to +the iteratee. Instead, it returns a continuation, so additional enumerators +may add their own input to the stream. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.generateM| +generateM :: Monad m => m (Maybe a) + -> Enumerator a m b +generateM getNext = loop where + loop (Continue k) = do + next <- lift getNext + case next of + Nothing -> continue k + Just x -> k (Chunks [x]) >>== loop + loop step = returnI step +: + +:d Data.Enumerator exports +-- ** Enumerators +, Data.Enumerator.iterate +, iterateM +, Data.Enumerator.repeat +, repeatM +, Data.Enumerator.replicate +, replicateM +, generateM +: + +\subsection{Enumeratees} + +Enumeratees are conceptually similar to a monadic {\tt concatMap}; each +outer input element is converted to a list of inner inputs, which are passed +to the inner iteratee. Error handling and performance considerations +make most real-life enumeratees more complex, but some don't need the extra +design. + +The {\tt checkDone} and {\tt checkDoneEx} functions referenced here are +defined later, with other utilities. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.concatMapM| +concatMapM :: Monad m => (ao -> m [ai]) + -> Enumeratee ao ai m b +concatMapM f = checkDone (continue . step) where + step k EOF = yield (Continue k) EOF + step k (Chunks xs) = loop k xs + + loop k [] = continue (step k) + loop k (x:xs) = do + fx <- lift (f x) + k (Chunks fx) >>== + checkDoneEx (Chunks xs) (\k' -> loop k' xs) +: + +Once {\tt concatMapM} is defined, similar enumeratees can be easily created +via small wrappers. + +:d excluded Prelude imports +concatMap, +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.concatMap| +concatMap :: Monad m => (ao -> [ai]) + -> Enumeratee ao ai m b +concatMap f = concatMapM (return . f) +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.map| +map :: Monad m => (ao -> ai) + -> Enumeratee ao ai m b +map f = concatMap (\x -> Prelude.map f [x]) +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.filter| +filter :: Monad m => (a -> Bool) + -> Enumeratee a a m b +filter p = concatMap (\x -> Prelude.filter p [x]) +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.mapM| +mapM :: Monad m => (ao -> m ai) + -> Enumeratee ao ai m b +mapM f = concatMapM (\x -> Prelude.mapM f [x]) +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.filterM| +filterM :: Monad m => (a -> m Bool) + -> Enumeratee a a m b +filterM p = concatMapM (\x -> CM.filterM p [x]) +: + +:d Data.Enumerator exports +-- ** Enumeratees +, Data.Enumerator.map +, Data.Enumerator.concatMap +, Data.Enumerator.filter +, Data.Enumerator.mapM +, concatMapM +, Data.Enumerator.filterM +: + +\subsection{Debugging} + +Debugging enumerator-based code is mostly a question of what inputs are +being passed around. {\tt printChunks} prints out exactly what chunks are +being sent from an enumerator. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.printChunks| +printChunks :: (MonadIO m, Show a) + => Bool -- ^ Print empty chunks + -> Iteratee a m () +printChunks printEmpty = continue loop where + loop (Chunks xs) = do + let hide = null xs && not printEmpty + CM.unless hide (liftIO (print xs)) + continue loop + + loop EOF = do + liftIO (putStrLn "EOF") + yield () EOF +: + +:d Data.Enumerator exports +-- ** Debugging +, printChunks +: diff --git a/src/text.anansi b/src/text.anansi new file mode 100644 --- /dev/null +++ b/src/text.anansi @@ -0,0 +1,608 @@ +\section{Text} + +:f Data/Enumerator/Text.hs +|Data.Enumerator.Text module header| +module Data.Enumerator.Text ( + |Data.Enumerator.Text exports| + ) where +import qualified Prelude +import Prelude hiding (head, drop, takeWhile) +import Data.Enumerator hiding (head, drop) +import qualified Data.Text as T +|Data.Enumerator.Text imports| +: + +\subsection{IO} + +Reading text is similar to reading bytes, but the enumerators have slightly +different behavior -- instead of reading in fixed-size chunks of data, the +text enumerators read in lines. This matches similar text-based {\sc api}s, +such as Python's {\tt xreadlines()}. + +:d Data.Enumerator.Text imports +import Data.Enumerator.Util (tryStep) +import qualified Data.Text.IO as TIO + +import qualified Control.Exception as Exc +import Control.Monad.IO.Class (MonadIO) +import qualified System.IO as IO +import System.IO.Error (isEOFError) +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.enumHandle| +enumHandle :: MonadIO m => IO.Handle + -> Enumerator T.Text m b +enumHandle h = loop where + loop (Continue k) = withText $ \maybeText -> + case maybeText of + Nothing -> continue k + Just text -> k (Chunks [text]) >>== loop + + loop step = returnI step + withText = tryStep $ Exc.catch + (Just `fmap` TIO.hGetLine h) + (\err -> if isEOFError err + then return Nothing + else Exc.throwIO err) +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.enumFile| +enumFile :: FilePath -> Enumerator T.Text IO b +enumFile path = enum where + withHandle = tryStep (IO.openFile path IO.ReadMode) + enum step = withHandle $ \h -> Iteratee $ Exc.finally + (runIteratee (enumHandle h step)) + (IO.hClose h) +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.iterHandle| +iterHandle :: MonadIO m => IO.Handle + -> Iteratee T.Text m () +iterHandle h = continue step where + step EOF = yield () EOF + step (Chunks []) = continue step + step (Chunks chunks) = let + put = mapM_ (TIO.hPutStr h) chunks + in tryStep put (\_ -> continue step) +: + +:d Data.Enumerator.Text exports + -- * Text IO + enumHandle +, enumFile +, iterHandle +: + +\subsection{List analogues} + +:d Data.Enumerator.Text imports +import qualified Data.Text.Lazy as TL +: + +:f Data/Enumerator/Text.hs +toChunks :: TL.Text -> Stream T.Text +toChunks = Chunks . TL.toChunks +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.head| +head :: Monad m => Iteratee T.Text m (Maybe Char) +head = continue loop where + loop (Chunks xs) = case TL.uncons (TL.fromChunks xs) of + Just (char, extra) -> yield (Just char) (toChunks extra) + Nothing -> head + loop EOF = yield Nothing EOF +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.drop| +drop :: Monad m => Integer -> Iteratee T.Text m () +drop n | n <= 0 = return () +drop n = continue (loop n) where + loop n' (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + iter = if len < n' + then drop (n' - len) + else yield () (toChunks (TL.drop (fromInteger n') lazy)) + loop _ EOF = yield () EOF +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.dropWhile| +dropWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m () +dropWhile p = continue loop where + loop (Chunks xs) = iter where + lazy = TL.dropWhile p (TL.fromChunks xs) + iter = if TL.null lazy + then continue loop + else yield () (toChunks lazy) + loop EOF = yield () EOF +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.take| +take :: Monad m => Integer -> Iteratee T.Text m TL.Text +take n | n <= 0 = return TL.empty +take n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + + iter = if len < n' + then continue (loop (acc . (TL.append lazy)) (n' - len)) + else let + (xs', extra) = TL.splitAt (fromInteger n') lazy + in yield (acc xs') (toChunks extra) + loop acc _ EOF = yield (acc TL.empty) EOF +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.takeWhile| +takeWhile :: Monad m => (Char -> Bool) -> Iteratee T.Text m TL.Text +takeWhile p = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = iter where + lazy = TL.fromChunks xs + (xs', extra) = tlSpanBy p lazy + iter = if TL.null extra + then continue (loop (acc . (TL.append lazy))) + else yield (acc xs') (toChunks extra) + loop acc EOF = yield (acc TL.empty) EOF +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.consume| +consume :: Monad m => Iteratee T.Text m TL.Text +consume = continue (loop id) where + loop acc (Chunks []) = continue (loop acc) + loop acc (Chunks xs) = iter where + lazy = TL.fromChunks xs + iter = continue (loop (acc . (TL.append lazy))) + loop acc EOF = yield (acc TL.empty) EOF +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.require| +require :: Monad m => Integer -> Iteratee T.Text m () +require n | n <= 0 = return () +require n = continue (loop id n) where + loop acc n' (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + iter = if len < n' + then continue (loop (acc . (TL.append lazy)) (n' - len)) + else yield () (toChunks (acc lazy)) + loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF") +: + +Same caveats as {\tt Data.Enumerator.List.isolate} + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.isolate| +isolate :: Monad m => Integer -> Enumeratee T.Text T.Text m b +isolate n step | n <= 0 = return step +isolate n (Continue k) = continue loop where + loop (Chunks []) = continue loop + loop (Chunks xs) = iter where + lazy = TL.fromChunks xs + len = toInteger (TL.length lazy) + + iter = if len <= n + then k (Chunks xs) >>== isolate (n - len) + else let + (s1, s2) = TL.splitAt (fromInteger n) lazy + in k (toChunks s1) >>== (\step -> yield step (toChunks s2)) + loop EOF = k EOF >>== (\step -> yield step EOF) +isolate n step = drop n >> return step +: + +:d Data.Enumerator.Text exports +-- * List analogues +, Data.Enumerator.Text.head +, Data.Enumerator.Text.drop +, Data.Enumerator.Text.dropWhile +, Data.Enumerator.Text.take +, Data.Enumerator.Text.takeWhile +, Data.Enumerator.Text.consume +, require +, isolate +: + +\subsection{Codecs} + +Many protocols need the non-blocking input behavior of binary \io{}, but +are defined in terms of unicode characters. The {\tt encode} and +{\tt decode} enumeratees allow text-based protocols to be easily parsed +from a binary input source. + +Most common codecs ({\sc utf-8}, {\sc iso-8859-1}, {\sc ascii}) are +supported; more complex codecs can be implemented by bindings to libraries +such as libicu. + +All of the codecs here are incremental; that is, they try to read as much +data as possible, but no more. This allows iteratees to read partial data +if the input stream contains invalid data. + +:d Data.Enumerator.Text imports +import qualified Data.ByteString as B +import Data.Enumerator.Util (tSpanBy, tlSpanBy, reprWord, reprChar) +: + +:d Data.Enumerator.Text exports + -- * Codecs +, Codec +, encode +, decode +|text codec exports| +: + +:f Data/Enumerator/Text.hs +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) +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.encode| +encode :: Monad m => Codec + -> Enumeratee T.Text B.ByteString m b +encode codec = checkDone (continue . step) where + step k EOF = yield (Continue k) EOF + step k (Chunks xs) = loop k xs + + loop k [] = continue (step k) + loop k (x:xs) = let + (bytes, extra) = codecEncode codec x + extraChunks = Chunks $ case extra of + Nothing -> xs + Just (_, text) -> text:xs + + checkError k' = case extra of + Nothing -> loop k' xs + Just (exc, _) -> throwError exc + + in if B.null bytes + then checkError k + else k (Chunks [bytes]) >>== + checkDoneEx extraChunks checkError +: + +:f Data/Enumerator/Text.hs +|apidoc Data.Enumerator.Text.decode| +decode :: Monad m => Codec + -> Enumeratee B.ByteString T.Text m b +decode codec = checkDone (continue . step B.empty) where + step _ k EOF = yield (Continue k) EOF + step acc k (Chunks xs) = loop acc k xs + + loop acc k [] = continue (step acc k) + loop acc k (x:xs) = let + (text, extra) = codecDecode codec (B.append acc x) + extraChunks = Chunks (either snd id extra : xs) + + checkError k' = case extra of + Left (exc, _) -> throwError exc + Right bytes -> loop bytes k' xs + + in if T.null text + then checkError k + else k (Chunks [text]) >>== + checkDoneEx extraChunks checkError +: + +Most of the codecs here need to perform at least basic bitbashing, to +calculate how many input bytes will be needed for the next character. + +:d Data.Enumerator.Text imports +import Control.Arrow (first) +import Data.Bits ((.&.), (.|.), shiftL) +import Data.Char (ord) +import Data.Word (Word8, Word16) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text.Encoding as TE +: + +The variable-width decoders all follow the same basic pattern. First, +they examine their input to calculate how many bytes the decoder +function should accept. Next they try to decode it -- if the input +is valid, decoding is finished. + +If the input is invalid, trying to decode the full input will throw +an exception. When an exception is caught, decoding is passed off to +{\tt splitSlowly} for a more careful parse. The input is reduced until +the decoder can parse something, and the rest of the bytes are stored +for later. An error will only be thrown if the iteratee requires input, +but there are no valid bytes remaining. + +:f Data/Enumerator/Text.hs +byteSplits :: B.ByteString + -> [(B.ByteString, B.ByteString)] +byteSplits bytes = loop (B.length bytes) where + loop 0 = [(B.empty, bytes)] + loop n = B.splitAt n bytes : loop (n - 1) +: + +:d Data.Enumerator.Text imports +import Data.Maybe (catMaybes) +: + +:f Data/Enumerator/Text.hs +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) +: + +\subsubsection{UTF-8} + +:d text codec exports +, utf8 +: + +:f Data/Enumerator/Text.hs +utf8 :: Codec +utf8 = Codec name enc dec where + name = T.pack "UTF-8" + enc text = (TE.encodeUtf8 text, Nothing) + dec bytes = case splitQuickly bytes of + Just (text, extra) -> (text, Right extra) + Nothing -> splitSlowly TE.decodeUtf8 bytes + |utf8 split bytes| +: + +:d utf8 split bytes +splitQuickly bytes = loop 0 >>= maybeDecode where + |utf8 required bytes count| + maxN = B.length bytes + + loop n | n == maxN = Just (TE.decodeUtf8 bytes, B.empty) + loop n = let + req = required (B.index bytes n) + tooLong = first TE.decodeUtf8 (B.splitAt n bytes) + decodeMore = loop $! n + req + in if req == 0 + then Nothing + else if n + req > maxN + then Just tooLong + else decodeMore +: + +:d utf8 required bytes count +required x0 + | x0 .&. 0x80 == 0x00 = 1 + | x0 .&. 0xE0 == 0xC0 = 2 + | x0 .&. 0xF0 == 0xE0 = 3 + | x0 .&. 0xF8 == 0xF0 = 4 + + -- Invalid input; let Text figure it out + | otherwise = 0 +: + +\subsubsection{UTF-16} + +:d text codec exports +, utf16_le +, utf16_be +: + +:f Data/Enumerator/Text.hs +utf16_le :: Codec +utf16_le = Codec name enc dec where + name = T.pack "UTF-16-LE" + enc text = (TE.encodeUtf16LE text, Nothing) + dec bytes = case splitQuickly bytes of + Just (text, extra) -> (text, Right extra) + Nothing -> splitSlowly TE.decodeUtf16LE bytes + |utf16-le split bytes| +: + +:f Data/Enumerator/Text.hs +utf16_be :: Codec +utf16_be = Codec name enc dec where + name = T.pack "UTF-16-BE" + enc text = (TE.encodeUtf16BE text, Nothing) + dec bytes = case splitQuickly bytes of + Just (text, extra) -> (text, Right extra) + Nothing -> splitSlowly TE.decodeUtf16BE bytes + |utf16-be split bytes| +: + +:d utf16-le split bytes +splitQuickly bytes = maybeDecode (loop 0) where + maxN = B.length bytes + + loop n | n == maxN = decodeAll + | (n + 1) == maxN = decodeTo n + loop n = let + req = utf16Required + (B.index bytes 0) + (B.index bytes 1) + decodeMore = loop $! n + req + in if n + req > maxN + then decodeTo n + else decodeMore + + decodeTo n = first TE.decodeUtf16LE (B.splitAt n bytes) + decodeAll = (TE.decodeUtf16LE bytes, B.empty) +: + +:d utf16-be split bytes +splitQuickly bytes = maybeDecode (loop 0) where + maxN = B.length bytes + + loop n | n == maxN = decodeAll + | (n + 1) == maxN = decodeTo n + loop n = let + req = utf16Required + (B.index bytes 1) + (B.index bytes 0) + decodeMore = loop $! n + req + in if n + req > maxN + then decodeTo n + else decodeMore + + decodeTo n = first TE.decodeUtf16BE (B.splitAt n bytes) + decodeAll = (TE.decodeUtf16BE bytes, B.empty) +: + +:f Data/Enumerator/Text.hs +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 +: + +\subsubsection{UTF-32} + +:d text codec exports +, utf32_le +, utf32_be +: + +:f Data/Enumerator/Text.hs +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 +: + +:f Data/Enumerator/Text.hs +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 +: + +\subsubsection{ASCII} + +:d text codec exports +, ascii +: + +:f Data/Enumerator/Text.hs +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) +: + +\subsubsection{ISO 8859-1} + +:d text codec exports +, iso8859_1 +: + +:f Data/Enumerator/Text.hs +iso8859_1 :: Codec +iso8859_1 = Codec name enc dec where + name = T.pack "ISO-8859-1" + enc text = (bytes, extra) where + (safe, unsafe) = tSpanBy (\c -> ord c <= 0xFF) text + bytes = B8.pack (T.unpack safe) + extra = if T.null unsafe + then Nothing + else Just (illegalEnc name (T.head unsafe), unsafe) + + dec bytes = (T.pack (B8.unpack bytes), Right B.empty) +: + +\subsection{Encoding Utilities} + +:f Data/Enumerator/Text.hs +illegalEnc :: T.Text -> Char -> Exc.SomeException +illegalEnc name c = Exc.toException . Exc.ErrorCall $ + concat [ "Codec " + , show name + , " can't encode character " + , reprChar c + ] +: + +:f Data/Enumerator/Text.hs +illegalDec :: T.Text -> Word8 -> Exc.SomeException +illegalDec name w = Exc.toException . Exc.ErrorCall $ + concat [ "Codec " + , show name + , " can't decode byte " + , reprWord w + ] +: + +:d Data.Enumerator.Text imports +import System.IO.Unsafe (unsafePerformIO) +: + +:f Data/Enumerator/Text.hs +tryEvaluate :: a -> Either Exc.SomeException a +tryEvaluate = unsafePerformIO . Exc.try . Exc.evaluate + +maybeDecode:: (a, b) -> Maybe (a, b) +maybeDecode (a, b) = case tryEvaluate a of + Left _ -> Nothing + Right _ -> Just (a, b) +: diff --git a/src/types.anansi b/src/types.anansi new file mode 100644 --- /dev/null +++ b/src/types.anansi @@ -0,0 +1,337 @@ +\section{Core types} + +Most of this library's types and functions are exported from the +{\tt Data.Enumerator} module. + +:f Data/Enumerator.hs +|Data.Enumerator module header| +module Data.Enumerator ( + |Data.Enumerator exports| + ) where +|Data.Enumerator imports| +: + +\noindent A few utility functions share names with functions from the Prelude, so +those are removed from the default namespace. + +:d Data.Enumerator imports +import qualified Prelude as Prelude +import Prelude hiding ( + |excluded Prelude imports| + ) +: + +:d Data.Enumerator exports +-- * Core +-- ** Types + Stream (..) +, Iteratee (..) +, Step (..) +, Enumerator +, Enumeratee +: + +\subsection{Input streams} + +A {\tt Stream} is a sequence of chunks generated by an enumerator or +enumeratee. Chunks might be composite values, such as a string, or atomic, +such as a parser event. Allowing a stream to support multiple chunks +slightly complicates iteratee and enumeratee implementation, but greatly +simplifies handling of leftover inputs. + +{\tt (Chunks [])} is a legal value, used when a stream is still active but +no data is currently available. Iteratees and enumeratees often special-case +empty chunks for performance reasons, though they're not required to. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.Stream| +data Stream a + = Chunks [a] + | EOF + deriving (Show, Eq) + +instance Monad Stream where + return = Chunks . return + Chunks xs >>= f = mconcat (fmap f xs) + EOF >>= _ = EOF + +instance Functor Stream where + fmap f (Chunks xs) = Chunks (fmap f xs) + fmap _ EOF = EOF + +instance A.Applicative Stream where + pure = return + (<*>) = CM.ap +: + +The {\tt Monoid} instance deserves some special attention, because it has +the unexpected behavior that {\tt mappend EOF (Chunks []) == EOF}. Although +it's reasonable that appending chunks to an {\sc eof} stream should provide +a valid stream, such behavior would violate the monoid laws. + +:d Data.Enumerator imports +import Data.Monoid (Monoid, mempty, mappend, mconcat) +: + +:f Data/Enumerator.hs +instance Monoid (Stream a) where + mempty = Chunks mempty + mappend (Chunks xs) (Chunks ys) = Chunks (xs ++ ys) + mappend _ _ = EOF +: + +\subsection{Iteratees} + +The primary data type for this library is {\tt Iteratee}, which consumes +input until it either generates a value or encounters an error. Rather +than requiring all input at once, an iteratee will return {\tt Continue} +when it is capable of processing more data. + +In general, iteratees begin in the {\tt Continue} state. As each chunk is +passed to the continuation, the iteratee may return the next step, which is +one of: + +\begin{itemize} +\item {\tt Continue}: The iteratee is capable of accepting more input. Note +that more input is not required; the iteratee might be able to generate a +value immediately if the stream ends. + +\item {\tt Yield}: The iteratee has received enough input to generate a +result. Included in this value is left-over input, which can be passed to +the next iteratee. + +\item {\tt Error}: The iteratee encountered an error which prevents it from +proceeding further. +\end{itemize} + +:d Data.Enumerator imports +import qualified Control.Exception as Exc +: + +:f Data/Enumerator.hs +data Step a m b + |apidoc Data.Enumerator.Continue| + = Continue (Stream a -> Iteratee a m b) + + |apidoc Data.Enumerator.Yield| + | Yield b (Stream a) + + |apidoc Data.Enumerator.Error| + | Error Exc.SomeException + +|apidoc Data.Enumerator.Iteratee| +newtype Iteratee a m b = Iteratee + { runIteratee :: m (Step a m b) + } +: + +Users often need to construct iteratees which only yield or continue, +so we define some helper functions to save typing: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.returnI| +returnI :: Monad m => Step a m b -> Iteratee a m b +returnI step = Iteratee (return step) + +|apidoc Data.Enumerator.yield| +yield :: Monad m => b -> Stream a -> Iteratee a m b +yield x extra = returnI (Yield x extra) + +|apidoc Data.Enumerator.continue| +continue :: Monad m => (Stream a -> Iteratee a m b) + -> Iteratee a m b +continue k = returnI (Continue k) +: + +:d Data.Enumerator exports +, returnI +, yield +, continue +: + +\subsection{Enumerators} + +Enumerators typically read from an external source (parser, handle, random +number generator, etc). They feed chunks into an iteratee until the source +runs out of data (triggering {\tt EOF}) or the iteratee finishes processing +(yields a value). + +Since {\tt Iteratee} is an alias for {\tt m (Step a m b)}, enumerators can +also be considered step transformers of type +{\tt Step a m b -> m (Step a m b)}. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.Enumerator| +type Enumerator a m b = Step a m b -> Iteratee a m b +: + +Although enumerators can be encoded as a simple step transformer with the +type {\tt Step a m b -> Step a m b}, encoding as a computation allows easier +reasoning about the order of side effects. Consider the case of enumerating +two files: + +:d enumerator example +let iterFoo = enumFile "foo.txt" iterWhatever +let iterBar = enumFile "bar.txt" iterFoo +: + +It's impossible to determine, merely by looking at these lines, which file +will be opened first. In fact, depending on the implementation of +{\tt enumFile}, both files might be open at the same time. If enumerators +return monadic values, the order of events is more clear: + +:d enumerator example +iterFoo <- enumFile "foo.txt" iterWhatever +iterBar <- enumFile "bar.txt" iterFoo +: + +\subsection{Enumeratees} + +In cases where an enumerator acts as both a source and sink, the resulting +type is named an {\tt Enumeratee}. Enumeratees have two input types, +``outer a'' ({\tt ao}) and ``inner a'' ({\tt ai}). + +Enumeratees are encoded as an iteratee stack. The outer iteratee reads from +a stream of \emph{ao} values, transforms them into \emph{ai}, and passes them +to an inner iteratee. This model allows a single outer input to generate many +inner inputs, and vice-versa. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.Enumeratee| +type Enumeratee ao ai m b = Step ai m b + -> Iteratee ao m (Step ai m b) +: + +\subsection{Operators} + +Because {\tt Iteratee a m b} is semantically equivalent to +{\tt m (Step a m b)}, several of the monadic combinators ({\tt (>>=)}, +{\tt (>=>)}, etc) are useful to save typing when constructing enumerators +and enumeratees. {\tt (>>==)} corresponds to {\tt (>>=)}, {\tt (>==>)} to +{\tt (>=>)}, and so on. + +For compatibility, {\tt (==<<)} is aliased to {\tt (\$\$)}. + +:f Data/Enumerator.hs +infixl 1 >>== + +|apidoc Data.Enumerator.(>>==)| +(>>==) :: Monad m + => Iteratee a m b + -> (Step a m b -> Iteratee a' m b') + -> Iteratee a' m b' +i >>== f = Iteratee (runIteratee i >>= runIteratee . f) +: + +:f Data/Enumerator.hs +infixr 1 ==<< + +|apidoc Data.Enumerator.(==<<)| +(==<<) :: Monad m + => (Step a m b -> Iteratee a' m b') + -> Iteratee a m b + -> Iteratee a' m b' +(==<<) = flip (>>==) +: + +:f Data/Enumerator.hs +infixr 0 $$ + +|apidoc Data.Enumerator.($$)| +($$) :: Monad m + => (Step a m b -> Iteratee a' m b') + -> Iteratee a m b + -> Iteratee a' m b' +($$) = (==<<) +: + +:f Data/Enumerator.hs +infixr 1 >==> + +|apidoc Data.Enumerator.(>==>)| +(>==>) :: Monad m + => Enumerator a m b + -> (Step a m b -> Iteratee a' m b') + -> Step a m b + -> Iteratee a' m b' +(>==>) e1 e2 s = e1 s >>== e2 +: + +:f Data/Enumerator.hs +infixr 1 <==< + +|apidoc Data.Enumerator.(<==<)| +(<==<) :: Monad m + => (Step a m b -> Iteratee a' m b') + -> Enumerator a m b + -> Step a m b + -> Iteratee a' m b' +(<==<) = flip (>==>) +: + +:d Data.Enumerator exports +-- ** Operators +, (>>==) +, (==<<) +, ($$) +, (>==>) +, (<==<) +: + +\subsection{Iteratees as Monads} + +Iteratees are monads; by sequencing iteratees, very complex processing may +be applied to arbitrary input streams. Iteratees are also applicative +functors and monad transformers. + +:f Data/Enumerator.hs +instance Monad m => Monad (Iteratee a m) where + return x = yield x (Chunks []) + + m >>= f = Iteratee $ runIteratee m >>= + \r1 -> case r1 of + Continue k -> return (Continue ((>>= f) . k)) + Error err -> return (Error err) + Yield x (Chunks []) -> runIteratee (f x) + Yield x extra -> runIteratee (f x) >>= + \r2 -> case r2 of + Continue k -> runIteratee (k extra) + Error err -> return (Error err) + Yield x' _ -> return (Yield x' extra) +: + +Most iteratees are used to wrap \io{} operations, so it's sensible to define +instances for typeclasses from {\tt transformers}. + +:d Data.Enumerator imports +import Control.Monad.Trans.Class (MonadTrans, lift) +import Control.Monad.IO.Class (MonadIO, liftIO) +: + +:f Data/Enumerator.hs +instance MonadTrans (Iteratee a) where + lift m = Iteratee (m >>= runIteratee . return) + +instance MonadIO m => MonadIO (Iteratee a m) where + liftIO = lift . liftIO +: + +It's probably possible to define {\tt Functor} and {\tt Applicative} +instances for {\tt Iteratee} without a {\tt Monad} constraint, but I haven't +bothered, since every useful operation requires {\tt m} to be a Monad anyway. + +:d Data.Enumerator imports +import qualified Control.Applicative as A +import qualified Control.Monad as CM +: + +:f Data/Enumerator.hs +instance Monad m => Functor (Iteratee a m) where + fmap = CM.liftM +: + +:f Data/Enumerator.hs +instance Monad m => A.Applicative (Iteratee a m) where + pure = return + (<*>) = CM.ap +: diff --git a/src/util.anansi b/src/util.anansi new file mode 100644 --- /dev/null +++ b/src/util.anansi @@ -0,0 +1,250 @@ +\section{Misc. utilities} + +A few special-case utilities that are used by similar libraries, or were +present in previous versions of {\tt enumerator}, or otherwise don't have a +good place to go. + +:d Data.Enumerator exports +-- * Misc. utilities +: + +\subsection{Enumeratees} + +Sequencing a fixed set of enumerators is easy, but for more complex +cases, it's useful to have a small utility wrapper. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.concatEnums| +concatEnums :: Monad m => [Enumerator a m b] + -> Enumerator a m b +concatEnums = Prelude.foldl (>==>) returnI +: + +:d Data.Enumerator exports +, concatEnums +: + +{\tt joinI} is used to ``flatten'' enumeratees, to transform them into an +{\tt Iteratee}. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.joinI| +joinI :: Monad m => Iteratee a m (Step a' m b) + -> Iteratee a m b +joinI outer = outer >>= check where + check (Continue k) = k EOF >>== \s -> case s of + Continue _ -> error "joinI: divergent iteratee" + _ -> check s + check (Yield x _) = return x + check (Error e) = throwError e +: + +{\tt joinE} is similar, except it flattens an enumerator/enumeratee pair +into a single enumerator. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.joinE| +joinE :: Monad m + => Enumerator ao m (Step ai m b) + -> Enumeratee ao ai m b + -> Enumerator ai m b +joinE enum enee s = Iteratee $ do + step <- runIteratee (enumEOF $$ enum $$ enee s) + case step of + Error err -> return (Error err) + Yield x _ -> return x + Continue _ -> error "joinE: divergent iteratee" +: + +{\tt sequence} repeatedly runs its parameter to transform the stream. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.sequence| +sequence :: Monad m => Iteratee ao m ai + -> Enumeratee ao ai m b +sequence i = loop where + loop = checkDone check + check k = isEOF >>= \f -> if f + then yield (Continue k) EOF + else step k + step k = i >>= \v -> k (Chunks [v]) >>== loop +: + +Another small, useful enumerator separates an input list into chunks, and +sends them to the iteratee. This is useful for testing iteratees in pure +code. + +:d Data.Enumerator imports +import Data.List (genericSplitAt) +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.enumList| +enumList :: Monad m => Integer -> [a] -> Enumerator a m b +enumList n = loop where + loop xs (Continue k) | not (null xs) = let + (s1, s2) = genericSplitAt n xs + in k (Chunks s1) >>== loop s2 + loop _ step = returnI step +: + +:d Data.Enumerator exports +, joinI +, joinE +, Data.Enumerator.sequence +, enumList +: + +\subsection{Running iteratees} + +To simplify running iteratees, {\tt run} sends {\tt EOF} and then examines +the result. It is not possible for the result to be {\tt Continue}, because +{\tt enumEOF} calls {\tt error} for divergent iteratees. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.run| +run :: Monad m => Iteratee a m b + -> m (Either Exc.SomeException b) +run i = do + mStep <- runIteratee $ enumEOF ==<< i + case mStep of + Error err -> return $ Left err + Yield x _ -> return $ Right x + Continue _ -> error "run: divergent iteratee" +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.enumEOF| +enumEOF :: Monad m => Enumerator a m b +enumEOF (Yield x _) = yield x EOF +enumEOF (Error err) = throwError err +enumEOF (Continue k) = k EOF >>== check where + check (Continue _) = error "enumEOF: divergent iteratee" + check s = enumEOF s +: + +{\tt run\_} is even more simplified; it's used in simple scripts, where the +user doesn't care about error handling. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.run_| +run_ :: Monad m => Iteratee a m b -> m b +run_ i = run i >>= either Exc.throw return +: + +:d Data.Enumerator exports +, enumEOF +, run +, run_ +: + +\subsection{{\tt checkDone} and {\tt checkDoneEx}} + +A common pattern in {\tt Enumeratee} implementations is to check whether +the inner {\tt Iteratee} has finished, and if so, to return its output. +{\tt checkDone} passes its parameter a continuation if the {\tt Iteratee} +can still consume input, or yields otherwise. + +Oleg's version of {\tt checkDone} has a problem---when the enumeratee has +some sort of input buffer, but the underlying iteratee enters {\tt Yield}, +it will discard the output buffer. {\tt checkDoneEx} corrects this; for +backwards compatibility, {\tt checkDone} remains. + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.checkDoneEx| +checkDoneEx :: Monad m => + Stream a' -> + ((Stream a -> Iteratee a m b) -> Iteratee a' m (Step a m b)) -> + Enumeratee a' a m b +checkDoneEx _ f (Continue k) = f k +checkDoneEx extra _ step = yield step extra + +|apidoc Data.Enumerator.checkDone| +checkDone :: Monad m => + ((Stream a -> Iteratee a m b) -> Iteratee a' m (Step a m b)) -> + Enumeratee a' a m b +checkDone = checkDoneEx (Chunks []) +: + +:d Data.Enumerator exports +, checkDone +, checkDoneEx +: + +:f Data/Enumerator.hs +|apidoc Data.Enumerator.isEOF| +isEOF :: Monad m => Iteratee a m Bool +isEOF = continue $ \s -> case s of + EOF -> yield True s + _ -> yield False s +: + +:d Data.Enumerator exports +, isEOF +: + +{\tt Data.Enumerator.Util} is a hidden module for functions used by several +public modules, but not logically part of the {\tt enumerator} API. + +:f Data/Enumerator/Util.hs +{-# LANGUAGE CPP #-} +module Data.Enumerator.Util where +import Data.Enumerator + +import Data.Char (toUpper, intToDigit, ord) +import Data.Word (Word8) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + +import Control.Monad.IO.Class (MonadIO, liftIO) +import qualified Control.Exception as Exc +import Numeric (showIntAtBase) +: + +:f Data/Enumerator/Util.hs +tryStep :: MonadIO m => IO t -> (t -> Iteratee a m b) -> Iteratee a m b +tryStep get io = do + tried <- liftIO (Exc.try get) + case tried of + Right t -> io t + Left err -> throwError (err :: Exc.SomeException) +: + +:f Data/Enumerator/Util.hs +pad0 :: Int -> String -> String +pad0 size str = padded where + len = Prelude.length str + padded = if len >= size + then str + else Prelude.replicate (size - len) '0' ++ str +: + +:f Data/Enumerator/Util.hs +reprChar :: Char -> String +reprChar c = "U+" ++ (pad0 4 (showIntAtBase 16 (toUpper . intToDigit) (ord c) "")) +: + +:f Data/Enumerator/Util.hs +reprWord :: Word8 -> String +reprWord w = "0x" ++ (pad0 2 (showIntAtBase 16 (toUpper . intToDigit) w "")) +: + +{\tt text-0.11} changed some function names to appease a few bikeshedding +idiots in -cafe; to support it, a bit of compatibility code is needed. + +I had a choice between using the preprocessor, or a separate module plus +some Cabal magic. It turns out that {\tt cabal sdist} doesn't properly +handle multiple source directories selected by flags, so the preprocessor +is used for now. + +:f Data/Enumerator/Util.hs +tSpanBy :: (Char -> Bool) -> T.Text -> (T.Text, T.Text) +tlSpanBy :: (Char -> Bool) -> TL.Text -> (TL.Text, TL.Text) +#if MIN_VERSION_text(0,11,0) +tSpanBy = T.span +tlSpanBy = TL.span +#else +tSpanBy = T.spanBy +tlSpanBy = TL.spanBy +#endif +: diff --git a/tests/Properties.hs b/tests/Properties.hs new file mode 100644 --- /dev/null +++ b/tests/Properties.hs @@ -0,0 +1,816 @@ +-- Copyright (C) 2010 John Millikin +-- +-- See license.txt for details +module Main (tests, main) where + +import Data.Enumerator (($$)) +import qualified Data.Enumerator as E +import qualified Data.Enumerator.Binary as EB +import qualified Data.Enumerator.Text as ET +import qualified Data.Enumerator.List as EL + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Encoding as TE + +import Test.QuickCheck hiding ((.&.)) +import Test.QuickCheck.Poly +import qualified Test.Framework as F +import Test.Framework.Providers.QuickCheck2 (testProperty) + +import Control.Applicative +import Control.Exception +import Control.Monad +import Data.Bits +import Data.Char (chr) +import Data.Monoid +import Data.Functor.Identity +import Data.String + +tests :: [F.Test] +tests = + [ test_StreamInstances + , test_Primitives + , test_Text + , test_ListAnalogues + , test_Other + ] + +main :: IO () +main = F.defaultMain tests + +-- Stream instances {{{ + +test_StreamInstances :: F.Test +test_StreamInstances = F.testGroup "Stream Instances" + [ test_StreamMonoid + , test_StreamFunctor + , test_StreamApplicative + , test_StreamMonad + ] + +test_StreamMonoid :: F.Test +test_StreamMonoid = F.testGroup "Monoid Stream" props where + props = [ testProperty "law 1" prop_law1 + , testProperty "law 2" prop_law2 + , testProperty "law 3" prop_law3 + , testProperty "law 4" prop_law4 + ] + + prop_law1 :: E.Stream A -> Bool + prop_law1 x = mappend mempty x == x + + prop_law2 :: E.Stream A -> Bool + prop_law2 x = mappend x mempty == x + + prop_law3 :: E.Stream A -> E.Stream A -> E.Stream A -> Bool + prop_law3 x y z = mappend x (mappend y z) == mappend (mappend x y) z + + prop_law4 :: [E.Stream A] -> Bool + prop_law4 xs = mconcat xs == foldr mappend mempty xs + +test_StreamFunctor :: F.Test +test_StreamFunctor = F.testGroup "Functor Stream" props where + props = [ testProperty "law 1" prop_law1 + , testProperty "law 2" prop_law2 + ] + + prop_law1 :: E.Stream A -> Bool + prop_law1 x = fmap id x == id x + + prop_law2 :: E.Stream A -> Blind (B -> C) -> Blind (A -> B) -> Bool + prop_law2 x (Blind f) (Blind g) = fmap (f . g) x == (fmap f . fmap g) x + +test_StreamApplicative :: F.Test +test_StreamApplicative = F.testGroup "Applicative Stream" props where + props = [ testProperty "law 1" prop_law1 + , testProperty "law 2" prop_law2 + , testProperty "law 3" prop_law3 + , testProperty "law 4" prop_law4 + , testProperty "law 5" prop_law5 + ] + + prop_law1 :: E.Stream A -> Bool + prop_law1 v = (pure id <*> v) == v + + prop_law2 :: Blind (E.Stream (B -> C)) -> Blind (E.Stream (A -> B)) -> E.Stream A -> Bool + prop_law2 (Blind u) (Blind v) w = (pure (.) <*> u <*> v <*> w) == (u <*> (v <*> w)) + + prop_law3 :: Blind (A -> B) -> A -> Bool + prop_law3 (Blind f) x = (pure f <*> pure x) == (pure (f x) `asTypeOf` E.Chunks [B 0]) + + prop_law4 :: Blind (E.Stream (A -> B)) -> A -> Bool + prop_law4 (Blind u) y = (u <*> pure y) == (pure ($ y) <*> u) + + prop_law5 :: Blind (A -> B) -> E.Stream A -> Bool + prop_law5 (Blind f) x = (fmap f x) == (pure f <*> x) + +test_StreamMonad :: F.Test +test_StreamMonad = F.testGroup "Monad Stream" props where + props = [ testProperty "law 1" prop_law1 + , testProperty "law 2" prop_law2 + , testProperty "law 3" prop_law3 + ] + + prop_law1 :: A -> Blind (A -> E.Stream B) -> Bool + prop_law1 a (Blind f) = (return a >>= f) == f a + + prop_law2 :: E.Stream A -> Bool + prop_law2 m = (m >>= return) == m + + prop_law3 :: E.Stream A -> Blind (A -> E.Stream B) -> Blind (B -> E.Stream C) -> Bool + prop_law3 m (Blind f) (Blind g) = ((m >>= f) >>= g) == (m >>= (\x -> f x >>= g)) + +-- }}} + +-- Generic properties {{{ + +test_Enumeratee :: String -> E.Enumeratee A A Identity (Maybe A) -> F.Test +test_Enumeratee name enee = F.testGroup name props where + props = [ testProperty "incremental" prop_incremental + , testProperty "nest errors" prop_nest_errors + ] + + prop_incremental (Positive n) (NonEmpty xs) = let + result = runIdentity (E.run_ iter) + expected = (Just (head xs), tail xs) + + iter = E.enumList n xs $$ do + a <- E.joinI (enee $$ EL.head) + b <- EL.consume + return (a, b) + + in result == expected + + prop_nest_errors (Positive n) (NonEmpty xs) = let + result = runIdentity (E.run_ iter) + + iter = E.enumList n xs $$ do + a <- enee $$ E.throwError (ErrorCall "") + EL.consume + + in result == xs + +-- }}} + +-- Primitives {{{ + +test_Primitives :: F.Test +test_Primitives = F.testGroup "Primitives" + [ test_Map + , test_ConcatMap + , test_MapM + , test_ConcatMapM + , test_Filter + , test_FilterM + ] + +test_Map :: F.Test +test_Map = test_Enumeratee "map" (E.map id) + +test_ConcatMap :: F.Test +test_ConcatMap = test_Enumeratee "concatMap" (E.concatMap (:[])) + +test_MapM :: F.Test +test_MapM = test_Enumeratee "mapM" (E.mapM return) + +test_ConcatMapM :: F.Test +test_ConcatMapM = test_Enumeratee "concatMapM" (E.concatMapM (\x -> return [x])) + +test_Filter :: F.Test +test_Filter = test_Enumeratee "filter" (E.filter (\_ -> True)) + +test_FilterM :: F.Test +test_FilterM = test_Enumeratee "filterM" (E.filterM (\_ -> return True)) + +-- }}} + +-- Text encoding / decoding {{{ + +test_Text :: F.Test +test_Text = F.testGroup "Text" + [ test_Encoding + , test_Decoding + ] + +test_Encoding :: F.Test +test_Encoding = F.testGroup "Encoding" + [ test_Encode_ASCII + , test_Encode_ISO8859 + ] + +test_Encode_ASCII :: F.Test +test_Encode_ASCII = F.testGroup "ASCII" props where + props = [ testProperty "works" (forAll genASCII prop_works) + , testProperty "error" prop_error + , testProperty "lazy" prop_lazy + ] + + encode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.encode ET.ascii $$ iter) + + prop_works bytes = result == map B.singleton words where + Right result = encode EL.consume (map T.singleton chars) + + chars = B8.unpack bytes + words = B.unpack bytes + + prop_error = isLeft (encode EL.consume input) where + isLeft = either (const True) (const False) + input = [T.pack "\x61\xFF"] + + prop_lazy = either (const False) (== expected) result where + result = encode EL.head input + input = [T.pack "\x61\xFF"] + expected = Just (B.singleton 0x61) + +test_Encode_ISO8859 :: F.Test +test_Encode_ISO8859 = F.testGroup "ISO-8859-1" props where + props = [ testProperty "works" (forAll genISO8859 prop_works) + , testProperty "error" prop_error + , testProperty "lazy" prop_lazy + ] + + encode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.encode ET.iso8859_1 $$ iter) + + prop_works bytes = result == map B.singleton words where + Right result = encode EL.consume (map T.singleton chars) + + chars = B8.unpack bytes + words = B.unpack bytes + + prop_error = isLeft (encode EL.consume input) where + isLeft = either (const True) (const False) + input = [T.pack "\x61\xFF5E"] + + prop_lazy = either (const False) (== expected) result where + result = encode EL.head input + input = [T.pack "\x61\xFF5E"] + expected = Just (B.singleton 0x61) + +test_Decoding :: F.Test +test_Decoding = F.testGroup "Decoding" + [ test_Decode_ASCII + , test_Decode_UTF8 + , test_Decode_UTF16_BE + , test_Decode_UTF16_LE + , test_Decode_UTF32_BE + , test_Decode_UTF32_LE + ] + +test_Decode_ASCII :: F.Test +test_Decode_ASCII = F.testGroup "ASCII" props where + props = [ testProperty "works" (forAll genASCII prop_works) + , testProperty "error" prop_error + , testProperty "lazy" prop_lazy + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.ascii $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf8 text) + chars = T.unpack text + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0xFF]] + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0xFF]] + expected = Just (T.pack "a") + +test_Decode_UTF8 :: F.Test +test_Decode_UTF8 = F.testGroup "UTF-8" props where + props = [ testProperty "works" prop_works + , testProperty "error" prop_error + , testProperty "lazy" prop_lazy + , testProperty "incremental" prop_incremental + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf8 $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf8 text) + chars = T.unpack text + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0x61, 0x80]] + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0x80]] + expected = Just (T.pack "a") + + prop_incremental = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0xC2, 0xC2]] + expected = Just (T.pack "a") + +test_Decode_UTF16_BE :: F.Test +test_Decode_UTF16_BE = F.testGroup "UTF-16-BE" props where + props = [ testProperty "works" prop_works + , testProperty "lazy" prop_lazy + , testProperty "error" prop_error + , testProperty "incremental" prop_incremental + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf16_be $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf16BE text) + chars = T.unpack text + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x00, 0x61, 0xDD, 0x1E]] + expected = Just (T.pack "a") + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0x00, 0x61, 0xDD, 0x1E]] + + prop_incremental = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x00, 0x61, 0xD8, 0x34, 0xD8, 0xD8]] + expected = Just (T.pack "a") + +test_Decode_UTF16_LE :: F.Test +test_Decode_UTF16_LE = F.testGroup "UTF-16-LE" props where + props = [ testProperty "works" prop_works + , testProperty "lazy" prop_lazy + , testProperty "error" prop_error + , testProperty "incremental" prop_incremental + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf16_le $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf16LE text) + chars = T.unpack text + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0x00, 0x1E, 0xDD]] + expected = Just (T.pack "a") + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0x61, 0x00, 0x1E, 0xDD]] + + prop_incremental = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0x00, 0x34, 0xD8, 0xD8, 0xD8]] + expected = Just (T.pack "a") + +test_Decode_UTF32_BE :: F.Test +test_Decode_UTF32_BE = F.testGroup "UTF-32-BE" props where + props = [ testProperty "works" prop_works + , testProperty "lazy" prop_lazy + , testProperty "error" prop_error + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf32_be $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf32BE text) + chars = T.unpack text + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x00, 0x00, 0x00, 0x61, 0xFF, 0xFF]] + expected = Just (T.pack "a") + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0xFF, 0xFF, 0xFF, 0xFF]] + +test_Decode_UTF32_LE :: F.Test +test_Decode_UTF32_LE = F.testGroup "UTF-32-LE" props where + props = [ testProperty "works" prop_works + , testProperty "lazy" prop_lazy + , testProperty "error" prop_error + ] + + decode iter input = + runIdentity . E.run $ + E.enumList 1 input $$ + E.joinI (ET.decode ET.utf32_le $$ iter) + + prop_works text = result == map T.singleton chars where + Right result = decode EL.consume (map B.singleton bytes) + + bytes = B.unpack (TE.encodeUtf32LE text) + chars = T.unpack text + + prop_lazy = either (const False) (== expected) result where + result = decode EL.head input + input = [B.pack [0x61, 0x00, 0x00, 0x00, 0xFF, 0xFF]] + expected = Just (T.pack "a") + + prop_error = isLeft (decode EL.consume input) where + isLeft = either (const True) (const False) + input = [B.pack [0xFF, 0xFF, 0xFF, 0xFF]] + +-- }}} + +-- List analogues {{{ + +test_ListAnalogues :: F.Test +test_ListAnalogues = F.testGroup "list analogues" + [ test_ListConsume + , test_ListHead + , test_ListDrop + , test_ListTake + -- , test_ListPeek + , test_ListRequire + , test_ListIsolate + + , test_BinaryConsume + , test_BinaryHead + , test_BinaryDrop + , test_BinaryTake + , test_BinaryRequire + , test_BinaryIsolate + + , test_TextConsume + , test_TextHead + , test_TextDrop + , test_TextTake + , test_TextRequire + , test_TextIsolate + ] + +test_ListConsume :: F.Test +test_ListConsume = testProperty "List.consume" prop where + prop :: [A] -> Bool + prop xs = result == xs where + result = runIdentity (E.run_ iter) + iter = E.enumList 1 xs $$ EL.consume + +test_ListHead :: F.Test +test_ListHead = testProperty "List.head" prop where + prop :: [A] -> Bool + prop xs = result == expected where + result = runIdentity (E.run_ iter) + expected = case xs of + [] -> (Nothing, []) + (x:xs') -> (Just x, xs') + + iter = E.enumList 1 xs $$ do + x <- EL.head + extra <- EL.consume + return (x, extra) + +test_ListDrop :: F.Test +test_ListDrop = testProperty "List.drop" prop where + prop :: Positive Integer -> [A] -> Bool + prop (Positive n) xs = result == expected where + result = runIdentity (E.run_ iter) + expected = drop (fromInteger n) xs + + iter = E.enumList 1 xs $$ do + EL.drop n + EL.consume + +test_ListTake :: F.Test +test_ListTake = testProperty "List.take" prop where + prop :: Positive Integer -> [A] -> Bool + prop (Positive n) xs = result == expected where + result = runIdentity (E.run_ iter) + expected = splitAt (fromInteger n) xs + + iter = E.enumList 1 xs $$ do + xs <- EL.take n + extra <- EL.consume + return (xs, extra) + +{- +test_ListPeek :: F.Test +test_ListPeek = testProperty "List.peek" prop where + prop :: Positive Integer -> [A] -> Bool + prop (Positive n) xs = result == expected where + result = runIdentity (E.run_ iter) + expected = (take (fromInteger n) xs, xs) + + iter = E.enumList 1 xs $$ do + xs <- EL.peek n + extra <- EL.consume + return (xs, extra) +-} + +test_ListRequire :: F.Test +test_ListRequire = testProperty "List.require" prop where + prop :: Positive Integer -> [A] -> Bool + prop (Positive n) xs = result == expected where + result = case runIdentity (E.run iter) of + Left exc -> Left (show exc) + Right x -> Right x + expected = if n > toInteger (length xs) + then Left "require: Unexpected EOF" + else Right xs + + iter = E.enumList 1 xs $$ do + EL.require n + EL.consume + +test_ListIsolate :: F.Test +test_ListIsolate = testProperty "List.isolate" prop where + prop :: Positive Integer -> [A] -> Bool + prop (Positive n) xs = result == expected where + result = runIdentity (E.run_ iter) + expected = case xs of + [] -> (Nothing, []) + (x:[]) -> (Just x, []) + (x:_:xs') -> (Just x, xs') + + iter = E.enumList 1 xs $$ do + x <- E.joinI (EL.isolate 2 $$ EL.head) + extra <- EL.consume + return (x, extra) + +test_BinaryConsume :: F.Test +test_BinaryConsume = testProperty "Binary.consume" prop where + prop ts = result == BL.fromChunks ts where + result = runIdentity (E.run_ iter) + iter = E.enumList 1 ts $$ EB.consume + +test_BinaryHead :: F.Test +test_BinaryHead = testProperty "Binary.head" prop where + prop ts = result == expected where + result = runIdentity (E.run_ iter) + expected = case BL.uncons (BL.fromChunks ts) of + Nothing -> (Nothing, BL.empty) + Just (x, extra) -> (Just x, extra) + + iter = E.enumList 1 ts $$ do + x <- EB.head + extra <- EB.consume + return (x, extra) + +test_BinaryDrop :: F.Test +test_BinaryDrop = testProperty "Binary.drop" prop where + prop :: Positive Integer -> [B.ByteString] -> Bool + prop (Positive n) ts = result == expected where + result = runIdentity (E.run_ iter) + expected = BL.drop (fromInteger n) (BL.fromChunks ts) + + iter = E.enumList 1 ts $$ do + EB.drop n + EB.consume + +test_BinaryTake :: F.Test +test_BinaryTake = testProperty "Binary.take" prop where + prop :: Positive Integer -> [B.ByteString] -> Bool + prop (Positive n) ts = result == expected where + result = runIdentity (E.run_ iter) + expected = BL.splitAt (fromInteger n) (BL.fromChunks ts) + + iter = E.enumList 1 ts $$ do + xs <- EB.take n + extra <- EB.consume + return (xs, extra) + +test_BinaryRequire :: F.Test +test_BinaryRequire = testProperty "Binary.require" prop where + prop :: Positive Integer -> [B.ByteString] -> Bool + prop (Positive n) ts = result == expected where + result = case runIdentity (E.run iter) of + Left exc -> Left (show exc) + Right x -> Right x + lazy = BL.fromChunks ts + expected = if n > toInteger (BL.length lazy) + then Left "require: Unexpected EOF" + else Right lazy + + iter = E.enumList 1 ts $$ do + EB.require n + EB.consume + +test_BinaryIsolate :: F.Test +test_BinaryIsolate = testProperty "Binary.isolate" prop where + prop :: Positive Integer -> [B.ByteString] -> Bool + prop (Positive n) ts = result == expected where + result = runIdentity (E.run_ iter) + expected = case BL.unpack (BL.fromChunks ts) of + [] -> (Nothing, BL.empty) + (x:[]) -> (Just x, BL.empty) + (x:_:xs') -> (Just x, BL.pack xs') + + iter = E.enumList 1 ts $$ do + x <- E.joinI (EB.isolate 2 $$ EB.head) + extra <- EB.consume + return (x, extra) + +test_TextConsume :: F.Test +test_TextConsume = testProperty "Text.consume" prop where + prop ts = result == TL.fromChunks ts where + result = runIdentity (E.run_ iter) + iter = E.enumList 1 ts $$ ET.consume + +test_TextHead :: F.Test +test_TextHead = testProperty "Text.head" prop where + prop ts = result == expected where + result = runIdentity (E.run_ iter) + expected = case TL.uncons (TL.fromChunks ts) of + Nothing -> (Nothing, TL.empty) + Just (x, extra) -> (Just x, extra) + + iter = E.enumList 1 ts $$ do + x <- ET.head + extra <- ET.consume + return (x, extra) + +test_TextDrop :: F.Test +test_TextDrop = testProperty "Text.drop" prop where + prop :: Positive Integer -> [T.Text] -> Bool + prop (Positive n) ts = result == expected where + result = runIdentity (E.run_ iter) + expected = TL.drop (fromInteger n) (TL.fromChunks ts) + + iter = E.enumList 1 ts $$ do + ET.drop n + ET.consume + +test_TextTake :: F.Test +test_TextTake = testProperty "Text.take" prop where + prop :: Positive Integer -> [T.Text] -> Bool + prop (Positive n) ts = result == expected where + result = runIdentity (E.run_ iter) + expected = TL.splitAt (fromInteger n) (TL.fromChunks ts) + + iter = E.enumList 1 ts $$ do + xs <- ET.take n + extra <- ET.consume + return (xs, extra) + +test_TextRequire :: F.Test +test_TextRequire = testProperty "Text.require" prop where + prop :: Positive Integer -> [T.Text] -> Bool + prop (Positive n) ts = result == expected where + result = case runIdentity (E.run iter) of + Left exc -> Left (show exc) + Right x -> Right x + lazy = TL.fromChunks ts + expected = if n > toInteger (TL.length lazy) + then Left "require: Unexpected EOF" + else Right lazy + + iter = E.enumList 1 ts $$ do + ET.require n + ET.consume + +test_TextIsolate :: F.Test +test_TextIsolate = testProperty "Text.isolate" prop where + prop :: Positive Integer -> [T.Text] -> Bool + prop (Positive n) ts = result == expected where + result = runIdentity (E.run_ iter) + expected = case TL.unpack (TL.fromChunks ts) of + [] -> (Nothing, TL.empty) + (x:[]) -> (Just x, TL.empty) + (x:_:xs') -> (Just x, TL.pack xs') + + iter = E.enumList 1 ts $$ do + x <- E.joinI (ET.isolate 2 $$ ET.head) + extra <- ET.consume + return (x, extra) + +-- }}} + +-- Specific functions + +test_Other :: F.Test +test_Other = F.testGroup "Other" + [ test_Sequence + , test_joinE + ] + +test_Sequence :: F.Test +test_Sequence = testProperty "sequence" prop where + prop :: Positive Integer -> [A] -> Bool + prop (Positive n) xs = result == expected where + result = runIdentity (E.run_ iter) + expected = map Just xs + + iter = E.enumList n xs $$ E.joinI (E.sequence EL.head $$ EL.consume) + +test_joinE :: F.Test +test_joinE = testProperty "joinE" prop where + prop :: [Integer] -> Bool + prop xs = result == expected where + result = runIdentity (E.run_ iter) + expected = map (* 10) xs + + iter = (E.joinE (E.enumList 1 xs) (E.map (* 10))) $$ EL.consume + +-- misc + +genASCII :: IsString a => Gen a +genASCII = fmap fromString string where + string = sized $ \n -> do + k <- choose (0,n) + sequence [ char | _ <- [1..k] ] + + char = chr `fmap` choose (0,0x7F) + +genISO8859 :: IsString a => Gen a +genISO8859 = fmap fromString string where + string = sized $ \n -> do + k <- choose (0,n) + sequence [ char | _ <- [1..k] ] + + char = chr `fmap` choose (0,0xFF) + +genUnicode :: IsString a => Gen a +genUnicode = fmap fromString string where + string = sized $ \n -> do + k <- choose (0,n) + sequence [ char | _ <- [1..k] ] + + excluding :: [a -> Bool] -> Gen a -> Gen a + excluding bad gen = loop where + loop = do + x <- gen + if or (map ($ x) bad) + then loop + else return x + + reserved = [lowSurrogate, highSurrogate, noncharacter] + lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF + highSurrogate c = c >= 0xD800 && c <= 0xDBFF + noncharacter c = masked == 0xFFFE || masked == 0xFFFF where + masked = c .&. 0xFFFF + + ascii = choose (0,0x7F) + plane0 = choose (0xF0, 0xFFFF) + plane1 = oneof [ choose (0x10000, 0x10FFF) + , choose (0x11000, 0x11FFF) + , choose (0x12000, 0x12FFF) + , choose (0x13000, 0x13FFF) + , choose (0x1D000, 0x1DFFF) + , choose (0x1F000, 0x1FFFF) + ] + plane2 = oneof [ choose (0x20000, 0x20FFF) + , choose (0x21000, 0x21FFF) + , choose (0x22000, 0x22FFF) + , choose (0x23000, 0x23FFF) + , choose (0x24000, 0x24FFF) + , choose (0x25000, 0x25FFF) + , choose (0x26000, 0x26FFF) + , choose (0x27000, 0x27FFF) + , choose (0x28000, 0x28FFF) + , choose (0x29000, 0x29FFF) + , choose (0x2A000, 0x2AFFF) + , choose (0x2B000, 0x2BFFF) + , choose (0x2F000, 0x2FFFF) + ] + plane14 = choose (0xE0000, 0xE0FFF) + planes = [ascii, plane0, plane1, plane2, plane14] + + char = chr `fmap` excluding reserved (oneof planes) + +instance Arbitrary a => Arbitrary (E.Stream a) where + arbitrary = frequency + [ (10, return E.EOF) + , (90, fmap E.Chunks arbitrary) + ] + +instance Arbitrary T.Text where + arbitrary = genUnicode + +instance Arbitrary B.ByteString where + arbitrary = genUnicode diff --git a/tests/enumerator-tests.cabal b/tests/enumerator-tests.cabal new file mode 100644 --- /dev/null +++ b/tests/enumerator-tests.cabal @@ -0,0 +1,17 @@ +name: enumerator-tests +version: 0 +build-type: Simple +cabal-version: >= 1.6 + +executable enumerator_tests + main-is: Properties.hs + + build-depends: + base > 3 && < 5 + , transformers + , bytestring + , text + , enumerator + , QuickCheck == 2.4.* + , test-framework >= 0.2 && < 0.4 + , test-framework-quickcheck2 == 0.2.9