iteratee 0.6.0.1 → 0.8.9.6
raw patch · 26 files changed
Files
- CONTRIBUTORS +5/−0
- Examples/word.hs +2/−2
- bench/BenchAll.hs +7/−0
- bench/BenchBase.hs +243/−0
- bench/BenchIO.hs +80/−0
- iteratee.cabal +72/−43
- src/Data/Iteratee.hs +43/−2
- src/Data/Iteratee/Base.hs +117/−27
- src/Data/Iteratee/Base/ReadableChunk.hs +5/−0
- src/Data/Iteratee/Binary.hs +140/−48
- src/Data/Iteratee/Char.hs +38/−9
- src/Data/Iteratee/Exception.hs +3/−0
- src/Data/Iteratee/IO.hs +63/−23
- src/Data/Iteratee/IO/Fd.hs +52/−18
- src/Data/Iteratee/IO/Handle.hs +47/−22
- src/Data/Iteratee/IO/Interact.hs +28/−0
- src/Data/Iteratee/Iteratee.hs +312/−41
- src/Data/Iteratee/ListLike.hs +754/−175
- src/Data/Iteratee/PTerm.hs +282/−0
- src/Data/Iteratee/Parallel.hs +127/−0
- src/Data/NullPoint.hs +3/−0
- src/Data/Nullable.hs +8/−4
- tests/QCUtils.hs +4/−0
- tests/benchmarkHandle.hs +0/−50
- tests/benchmarks.hs +0/−188
- tests/testIteratee.hs +330/−15
CONTRIBUTORS view
@@ -1,16 +1,21 @@ Thanks to the following individuals for contributing to this project. Oleg Kiselyov+Michael Baikov Gregory Collins+Nick Ingolia Brian Lewis+Alex Lang John Lato Antoine Latter Ben M Echo Nolan Conrad Parker+Akio Takano Paulo Tanimoto Magnus Therning Johan Tibell Bas van Dijk Valery Vorotyntsev+Maciej Wos Edward Yang
Examples/word.hs view
@@ -12,7 +12,7 @@ import Data.Word import Data.Char import Data.ListLike as LL-import System+import System.Environment -- | An iteratee to calculate the number of characters in a stream.@@ -44,7 +44,7 @@ -- The iteratees combined with enumPair are run in parallel. -- Any number of iteratees can be joined with multiple enumPair's. twoIter :: Monad m => I.Iteratee BC.ByteString m (Int, Int)-twoIter = numLines2 `I.enumPair` numChars+twoIter = numLines2 `I.zip` numChars main = do f:_ <- getArgs
+ bench/BenchAll.hs view
@@ -0,0 +1,7 @@+module Main where++import Criterion.Main+import BenchBase (allByteStringBenches)+import BenchIO (ioBenches)++main = defaultMain (allByteStringBenches: ioBenches)
+ bench/BenchBase.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes, KindSignatures, NoMonomorphismRestriction #-}++-- some basic benchmarking of iteratee++module BenchBase where++import Data.Iteratee+import qualified Data.Iteratee.ListLike as I+import qualified Data.Iteratee.Parallel as I+import qualified Data.Iteratee.Binary as I+import Data.Iteratee.ListLike (enumPureNChunk, stream2list, stream2stream)+import Data.Word+import Data.Monoid+import qualified Data.ByteString as BS+import Control.Applicative+import Control.DeepSeq+import Control.Monad.Identity+import Control.Monad+import qualified Data.ListLike as LL++import Criterion.Main++main = defaultMain [allListBenches, allByteStringBenches]++-- -------------------------------------------------------------+-- helper functions and data++-- |Hold information about a benchmark. This allows each+-- benchmark (and baseline) to be created independently of the stream types,+-- for easy comparison of different streams.+-- BDList is for creating baseline comparison functions. Although the name+-- is BDList, it will work for any stream type (e.g. bytestrings).+data BD a b s (m :: * -> *) = BDIter1 String (a -> b) (Iteratee s m a) + | BDIterN String Int (a -> b) (Iteratee s m a)+ | BDList String (s -> b) s++id1 name i = BDIter1 name id i+idN name i = BDIterN name 5 id i+idNx name sz i = BDIterN name sz id i+idNl name i = BDIterN name 1000 id i++defTotalSize = 10000++makeList name f = BDList name f [1..defTotalSize]++makeBench :: BD n eval [Int] Identity -> Benchmark+makeBench (BDIter1 n eval i) = bench n $+ proc eval runIdentity (enumPure1Chunk [1..defTotalSize]) i+makeBench (BDIterN n csize eval i) = bench n $+ proc eval runIdentity (enumPureNChunk [1..defTotalSize] csize) i+makeBench (BDList n f l) = bench n $ whnf f l++packedBS :: BS.ByteString+packedBS = (BS.pack [1..defTotalSize])++makeBenchBS (BDIter1 n eval i) = bench n $+ proc eval runIdentity (enumPure1Chunk packedBS) i+makeBenchBS (BDIterN n csize eval i) = bench n $+ proc eval runIdentity (enumPureNChunk packedBS csize) i+makeBenchBS (BDList n f l) = error "makeBenchBS can't be called on BDList"++proc :: (Functor m, Monad m)+ => (a -> b) --function to force evaluation of result+ -> (m a -> a)+ -> I.Enumerator s m a+ -> I.Iteratee s m a+ -> Pure+proc eval runner enum iter = whnf (eval . runner . (I.run <=< enum)) iter++-- -------------------------------------------------------------+-- benchmark groups+makeGroup n = bgroup n . map makeBench++makeGroupBS :: String -> [BD t t1 BS.ByteString Identity] -> Benchmark+makeGroupBS n = bgroup n . map makeBenchBS++listbench = makeGroup "stream2List" (slistBenches :: [BD [Int] () [Int] Identity])+streambench = makeGroup "stream" (streamBenches :: [BD [Int] () [Int] Identity])+breakbench = makeGroup "break" $ break0 : break0' : breakBenches+headsbench = makeGroup "heads" headsBenches+dropbench = makeGroup "drop" $ drop0 : dropBenches+zipbench = makeGroup "zip" $ zipBenches+consbench = makeGroup "consumed" consBenches+lengthbench = makeGroup "length" listBenches+takebench = makeGroup "take" $ take0 : takeBenches+takeUpTobench = makeGroup "takeUpTo" takeUpToBenches+groupbench = makeGroup "group" groupBenches+mapbench = makeGroup "map" $ mapBenches+foldbench = makeGroup "fold" $ foldBenches+convbench = makeGroup "convStream" convBenches+miscbench = makeGroup "other" miscBenches++listbenchbs = makeGroupBS "stream2List" slistBenches+streambenchbs = makeGroupBS "stream" streamBenches+breakbenchbs = makeGroupBS "break" breakBenches+headsbenchbs = makeGroupBS "heads" headsBenches+dropbenchbs = makeGroupBS "drop" dropBenches+zipbenchbs = makeGroupBS "zip" zipBenches+consbenchbs = makeGroupBS "consumed" consBenches+lengthbenchbs = makeGroupBS "length" listBenches+takebenchbs = makeGroupBS "take" takeBenches+takeUpTobenchbs = makeGroupBS "takeUpTo" takeUpToBenches+groupbenchbs = makeGroupBS "group" groupBenches+mapbenchbs = makeGroupBS "map" mapBenches+foldbenchbs = makeGroupBS "fold" $ foldBenches+convbenchbs = makeGroupBS "convStream" convBenches+miscbenchbs = makeGroupBS "other" miscBenches++endian2benchbs = makeGroupBS "2" endian2Benches+endian3benchbs = makeGroupBS "3" endian3Benches+endian4benchbs = makeGroupBS "4" endian4Benches+endian8benchbs = makeGroupBS "8" endian8Benches+endianbenchbs = bgroup "endian" [endian2benchbs, endian3benchbs, endian4benchbs, endian8benchbs]+++allListBenches = bgroup "list" [listbench, streambench, breakbench, headsbench, dropbench, zipbench, lengthbench, takebench, takeUpTobench, groupbench, mapbench, foldbench, convbench, miscbench, consbench]++allByteStringBenches = bgroup "bytestring" [listbenchbs, streambenchbs, breakbenchbs, headsbenchbs, dropbenchbs, zipbenchbs, lengthbenchbs, takebenchbs, takeUpTobenchbs, groupbenchbs, mapbenchbs, foldbenchbs, convbenchbs, endianbenchbs, miscbenchbs, consbenchbs]++list0 = makeList "list one go" deepseq+list1 = BDIter1 "stream2list one go" (flip deepseq ()) stream2list+list2 = BDIterN "stream2list chunk by 4" 4 (flip deepseq ()) stream2list+list3 = BDIterN "stream2list chunk by 1024" 1024 (flip deepseq ()) stream2list+slistBenches = [list1, list2, list3]++stream1 = BDIter1 "stream2stream one go" (flip deepseq ()) stream2stream+stream2 = BDIterN "stream2stream chunk by 4" 4 (flip deepseq ()) stream2stream+stream3 = BDIterN "stream2stream chunk by 1024" 1024 (flip deepseq ()) stream2stream+streamBenches = [stream1, stream2, stream3]++break0 = makeList "break early list" (fst . Prelude.break (>5))+break0' = makeList "break never list" (fst . Prelude.break (<0))+break1 = id1 "break early one go" (I.break (>5))+break2 = id1 "break never" (I.break (<0)) -- not ever true.+break3 = idN "break early chunked" (I.break (>500))+break4 = idN "break never chunked" (I.break (<0)) -- not ever true+break5 = idN "break late chunked" (I.break (>8000))+breakBenches = [break1, break2, break3, break4, break5]++heads1 = id1 "heads null" (I.heads $ LL.fromList [])+heads2 = id1 "heads 1" (I.heads $ LL.fromList [1])+heads3 = id1 "heads 100" (I.heads $ LL.fromList [1..100])+heads4 = idN "heads 100 over chunks" (I.heads $ LL.fromList [1..100])+headsBenches = [heads1, heads2, heads3, heads4]++benchpeek = id1 "peek" I.peek+benchskip = id1 "skipToEof" (I.skipToEof >> return Nothing)+miscBenches = [benchpeek, benchskip]++drop0 = makeList "drop plain (list only)"+ ( flip seq () . Prelude.drop 100)+drop1 = id1 "drop null" (I.drop 0)+drop2 = id1 "drop plain" (I.drop 100)+drop3 = idN "drop over chunks" (I.drop 100)++dropw0 = makeList "dropWhile all (list only)" (Prelude.dropWhile (const True))+dropw1 = id1 "dropWhile all" (I.dropWhile (const True))+dropw2 = idN "dropWhile all chunked" (I.dropWhile (const True))+dropw3 = id1 "dropWhile small" (I.dropWhile ( < 100))+dropw4 = id1 "dropWhile large" (I.dropWhile ( < 6000))+dropBenches = [drop1, drop2, drop3, dropw1, dropw2, dropw3, dropw4]++b_zip0 = idN "zip balanced" (I.zip (I.dropWhile (<100)) (I.dropWhile (<200))+ >> identity)+b_zip1 = idN "zip unbalanced" (I.zip (I.dropWhile (<8000)) (I.head) >> identity)+b_zip2 = idN "zip unbalanced 2" (I.zip identity I.length >> identity)+b_zip3 = idN "zip complete" (I.zip identity identity >> identity)+b_zip4 = idN "zip nonterminating" (I.zip I.length I.stream2stream >> identity)+zipBenches = [b_zip0, b_zip1, b_zip2, b_zip3, b_zip4 ]++consumed0 = idN "countConsumed" (I.countConsumed (I.foldl' (+) 0))+consumed1 = idN "countConsumed baseline (`I.enumWith` I.length)" (I.foldl' (+) 0 `I.enumWith` I.length)+consBenches = [consumed0, consumed1]+++l1 = makeList "length of list" Prelude.length+l2 = id1 "length single iteratee" I.length+l3 = idN "length chunked" I.length+listBenches = [l2, l3]++take0 = makeList "take length of list long" (Prelude.length . Prelude.take 1000)+take1 = id1 "take head short one go" (I.joinI $ I.take 20 I.head)+take2 = id1 "take head long one go" (I.joinI $ I.take 1000 I.head)+take3 = idN "take head short chunked" (I.joinI $ I.take 20 I.head)+take4 = idN "take head long chunked" (I.joinI $ I.take 1000 I.head)+take5 = id1 "take length long one go" (I.joinI $ I.take 1000 I.length)+take6 = idN "take length long chunked" (I.joinI $ I.take 1000 I.length)+takeBenches = [take1, take2, take3, take4, take5, take6]++takeUpTo1 = id1 "takeUpTo head short one go" (I.joinI $ I.take 20 I.head)+takeUpTo2 = id1 "takeUpTo head long one go" (I.joinI $ I.takeUpTo 1000 I.head)+takeUpTo3 = idN "takeUpTo head short chunked" (I.joinI $ I.takeUpTo 20 I.head)+takeUpTo4 = idN "takeUpTo head long chunked" (I.joinI $ I.takeUpTo 1000 I.head)+takeUpTo5 = id1 "takeUpTo length long one go" (I.joinI $ I.takeUpTo 1000 I.length)+takeUpTo6 = idN "takeUpTo length long chunked" (I.joinI $ I.takeUpTo 1000 I.length)+takeUpToBenches = [takeUpTo1, takeUpTo2, takeUpTo3, takeUpTo4, takeUpTo5, takeUpTo6]++group1 = id1 "group split" (I.joinI $ (I.group 24 ><> I.mapStream LL.length) I.length)+group2 = idN "group coalesce" (I.joinI $ (I.group 512 ><> I.mapStream LL.length) I.length)+groupBenches = [group1,group2]++map1 = id1 "map length one go" (I.joinI $ I.rigidMapStream id I.length)+map2 = idN "map length chunked" (I.joinI $ I.rigidMapStream id I.length)+map3 = id1 "map head one go" (I.joinI $ I.rigidMapStream id I.head)+map4 = idN "map head chunked" (I.joinI $ I.rigidMapStream id I.head)+mapBenches = [map1, map2, map3, map4]++foldB1 = idNl "foldl' sum" (I.foldl' (+) 0)+foldB2 = idNl "mapReduce foldl' 2 sum" (getSum <$> I.mapReduce 2 (Sum . LL.foldl' (+) 0))+foldB3 = idNl "mapReduce foldl' 4 sum" (getSum <$> I.mapReduce 4 (Sum . LL.foldl' (+) 0))+foldBenches = [foldB1, foldB2, foldB3]++conv1 = idN "convStream id head chunked" (I.joinI . I.convStream idChunk $ I.head)+conv2 = idN "convStream id length chunked" (I.joinI . I.convStream idChunk $ I.length)+idChunk = I.liftI step+ where+ step (I.Chunk xs)+ | LL.null xs = idChunk+ | True = idone xs (I.Chunk mempty)+convBenches = [conv1, conv2]++#if MIN_VERSION_bytestring(0,10,0)+#else+instance NFData BS.ByteString where+#endif++instance NFData a => NFData (Sum a) where+ rnf (Sum a) = rnf a++endianRead2_1 = id1 "endianRead2 single" (I.endianRead2 MSB)+endianRead2_2 = idNx "endianRead2 chunked" 1 (I.endianRead2 MSB)+endianRead3_1 = id1 "endianRead3 single" (I.endianRead3 MSB)+endianRead3_2 = idNx "endianRead3 chunked" 2 (I.endianRead3 MSB)+endianRead4_1 = id1 "endianRead4 single" (I.endianRead4 MSB)+endianRead4_2 = idNx "endianRead4 chunked" 2 (I.endianRead4 MSB)+endianRead8_1 = id1 "endianRead8 single" (I.endianRead8 MSB)+endianRead8_2 = idN "endianRead8 chunked" (I.endianRead8 MSB)+endianRead8_3 = idNx "endianRead8 multiple chunked" 2 (I.endianRead8 MSB)+endian2Benches = [endianRead2_1, endianRead2_2]+endian3Benches = [endianRead3_1, endianRead3_2]+endian4Benches = [endianRead4_1, endianRead4_2]+endian8Benches = [endianRead8_1, endianRead8_2, endianRead8_3]
+ bench/BenchIO.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE BangPatterns #-}++module BenchIO where++import Prelude hiding (null, length)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Criterion.Main+import Data.Monoid+import Data.Word+import Data.Iteratee+import Data.Iteratee.Parallel+import Data.Iteratee.Base.ReadableChunk+import Data.Iteratee.IO.Fd (fileDriverFd)+import Data.Iteratee.IO.Handle (fileDriverHandle)++bufSize = 65536+file = "/usr/share/dict/words"++length' :: Monad m => Iteratee ByteString m Int+length' = length++testFdString :: IO ()+testFdString = fileDriverFd bufSize len file >> return ()+ where+ len :: Monad m => Iteratee String m Int+ len = length++testFdByte :: IO ()+testFdByte = fileDriverFd bufSize len file >> return ()+ where+ len :: Monad m => Iteratee ByteString m Int+ len = length++testHdString :: IO ()+testHdString = fileDriverHandle bufSize len file >> return ()+ where+ len :: Monad m => Iteratee String m Int+ len = length++testHdByte :: IO ()+testHdByte = fileDriverHandle bufSize len file >> return ()+ where+ len :: Monad m => Iteratee ByteString m Int+ len = length++testFdMapReduce :: Int -> IO ()+testFdMapReduce n = fileDriverFd bufSize sum file >> return ()+ where+ sum :: Iteratee ByteString IO Word8+ sum = getSum `fmap` mapReduce n (Sum . B.foldl' (+) 0)++testFdFold :: IO ()+testFdFold = fileDriverFd bufSize sum file >> return ()+ where+ sum :: Iteratee ByteString IO Word8+ sum = foldl' (+) 0++main = defaultMain (stringIO ++ ioBenches)++stringIO =+ [ bgroup "String"+ [bench "Fd" testFdString+ ,bench "Hd with String" testHdString+ ]+ ]++ioBenches =+ [bgroup "ByteString" [+ bench "Fd" testFdByte+ ,bench "Hd" testHdByte+ ]++ ,bgroup "folds" [+ bench "Fd/fold" testFdFold+ ,bench "Fd/mapReduce 2" $ testFdMapReduce 2+ ,bench "Fd/mapReduce 4" $ testFdMapReduce 4+ ,bench "Fd/mapReduce 8" $ testFdMapReduce 8+ ]+ ]
iteratee.cabal view
@@ -1,19 +1,21 @@ name: iteratee-version: 0.6.0.1+version: 0.8.9.6 synopsis: Iteratee-based I/O description: The Iteratee monad provides strict, safe, and functional I/O. In addition to pure Iteratee processors, file IO and combinator functions are provided.++ See @Data.Iteratee@ for full documentation. category: System, Data author: Oleg Kiselyov, John W. Lato maintainer: John W. Lato <jwlato@gmail.com> license: BSD3 license-file: LICENSE-homepage: http://inmachina.net/~jwlato/haskell/iteratee-tested-with: GHC == 6.12.3+homepage: http://www.tiresiaspress.us/haskell/iteratee+tested-with: GHC == 7.6.0, GHC == 7.4.2 stability: experimental -cabal-version: >= 1.6+cabal-version: >= 1.10 build-type: Simple extra-source-files:@@ -23,25 +25,13 @@ Examples/*.lhs Examples/*.txt tests/*.hs--flag splitBase- description: Use the split-up base package.--flag buildTests- description: Build test executables.- default: False+ bench/*.hs library+ default-language: Haskell2010 hs-source-dirs: src - if flag(splitBase)- build-depends:- base >= 3 && < 6- else- build-depends:- base < 3- if os(windows) cpp-options: -DUSE_WINDOWS exposed-modules:@@ -55,11 +45,15 @@ unix >= 2 && < 3 build-depends:- ListLike >= 1.0 && < 3,- MonadCatchIO-transformers > 0.2 && < 0.3,- bytestring >= 0.9 && < 0.10,- containers >= 0.2 && < 0.5,- transformers >= 0.2 && < 0.3+ base >= 3 && < 6,+ ListLike >= 3.0 && < 5,+ monad-control == 0.3.* ,+ bytestring >= 0.9 && < 0.11,+ containers >= 0.2 && < 0.6,+ exceptions >= 0.3 && < 0.7,+ parallel >= 2 && < 4,+ transformers >= 0.2 && < 0.5,+ transformers-base >= 0.4 && < 0.5 exposed-modules: Data.Nullable@@ -73,41 +67,76 @@ Data.Iteratee.Exception Data.Iteratee.IO Data.Iteratee.IO.Handle+ Data.Iteratee.IO.Interact Data.Iteratee.Iteratee Data.Iteratee.ListLike+ Data.Iteratee.Parallel+ Data.Iteratee.PTerm other-modules: Data.Iteratee.IO.Base - ghc-options: -Wall+ ghc-options: -Wall -O2 if impl(ghc >= 6.8) ghc-options: -fwarn-tabs -executable testIteratee- hs-source-dirs:- src- tests-+Test-Suite testIteratee+ default-language: Haskell2010+ type: exitcode-stdio-1.0 main-is: testIteratee.hs-- other-modules:- QCUtils+ hs-source-dirs: tests src - if flag(buildTests)+ if os(windows)+ cpp-options: -DUSE_WINDOWS+ else+ cpp-options: -DUSE_POSIX build-depends:+ unix >= 2 && < 3++ build-depends:+ base,+ bytestring,+ iteratee,+ exceptions,+ monad-control,+ mtl,+ ListLike,+ transformers,+ transformers-base,+ HUnit >= 1.2 , QuickCheck >= 2 && < 3,- test-framework >= 0.3 && < 0.4,- test-framework-quickcheck2 >= 0.2 && < 0.3- else- buildable: False+ test-framework >= 0.3 && < 0.9,+ test-framework-quickcheck2 >= 0.2 && < 0.4,+ test-framework-hunit >= 0.2 && < 0.4 - if flag(splitBase)- build-depends:- base >= 3 && < 5+benchmark bench-all+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: BenchAll.hs++ if os(windows)+ cpp-options: -DUSE_WINDOWS else+ cpp-options: -DUSE_POSIX build-depends:- base < 3+ unix >= 2 && < 3 + build-depends:+ iteratee,+ bytestring,+ monad-control,+ exceptions,+ mtl,+ ListLike,+ transformers,+ transformers-base,+ base >= 3 && < 6,+ criterion >= 0.6 && < 0.9,+ deepseq >= 1.2 && < 2,+ mtl+ ghc-options: -O2+ source-repository head- type: darcs- location: http://inmachina.net/~jwlato/haskell/iteratee+ type: git+ location: http://www.tiresiaspress.us/haskell/iteratee
src/Data/Iteratee.hs view
@@ -1,12 +1,52 @@-{- | Provide iteratee-based IO as described in Oleg Kiselyov's paper http://okmij.org/ftp/Haskell/Iteratee/.+{- | Provide iteratee-based IO as described in Oleg Kiselyov's paper 'http://okmij.org/ftp/Haskell/Iteratee/'. -Oleg's original code uses lists to store buffers of data for reading in the iteratee. This package allows the use of arbitrary types through use of the StreamChunk type class. See Data.Iteratee.WrappedByteString for implementation details.+Oleg's original code uses lists to store buffers of data for reading in the iteratee. This package allows the use of arbitrary types through use of the ListLike type class. +Iteratees can be thought of as stream processor combinators. Iteratees are combined to run in sequence or in parallel, and then processed by enumerators. The result of the enumeration is another iteratee, which may then be used again, or have the result obtained via the 'run' function.++> -- count the number of bytes in a file, reading at most 8192 bytes at a time+> import Data.Iteratee as I+> import Data.Iteratee.IO+> import Data.ByteString+> +> byteCounter :: Monad m => Iteratee ByteString m Int+> byteCounter = I.length+> +> countBytes = do+> i' <- enumFile 8192 "/usr/share/dict/words" byteCounter+> result <- run i'+> print result++Iteratees can be combined to perform much more complex tasks. The iteratee monad allows for sequencing iteratee operations.++> iter2 = do+> I.drop 4+> I.head++In addition to enumerations over files and Handles, enumerations can be programmatically generated.++> get5thElement = enumPure1Chunk [1..10] iter2 >>= run >>= print++Iteratees can also work as stream transformers, called 'Enumeratee's. A very simple example is provided by 'Data.Iteratee.ListLike.filter'. When working with enumeratees, it's very common to collaps the nested iteratee with 'joinI'.++This function returns the 5th element greater than 5.++> iterfilt = joinI $ I.filter (>5) iter2+> find5thOver5 = enumPure1Chunk [10,1,4,6,7,4,2,8,5,9::Int] iterfilt >>= run >>= print++Another common use of iteratees is 'takeUpTo', which guarantees that an iteratee consumes a bounded number of elements. This is often useful when parsing data. You can check how much data an iteratee has consumed with 'enumWith'++> iter3 :: (Num el, Ord el, Monad m) => Iteratee [el] m (el,Int)+> iter3 = joinI (I.takeUpTo 100 (enumWith iterfilt I.length))++Many more functions are provided, and there are many other useful ways to combine iteratees and enumerators.+ -} module Data.Iteratee ( module Data.Iteratee.Binary, module Data.Iteratee.ListLike,+ module Data.Iteratee.PTerm, fileDriver, fileDriverVBuf, fileDriverRandom,@@ -18,3 +58,4 @@ import Data.Iteratee.Binary import Data.Iteratee.IO import Data.Iteratee.ListLike+import Data.Iteratee.PTerm
src/Data/Iteratee/Base.hs view
@@ -1,5 +1,12 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, Rank2Types,- DeriveDataTypeable, ExistentialQuantification #-}+{-# LANGUAGE CPP+ ,TypeFamilies+ ,MultiParamTypeClasses+ ,FlexibleContexts+ ,FlexibleInstances+ ,UndecidableInstances+ ,Rank2Types+ ,DeriveDataTypeable+ ,ExistentialQuantification #-} -- |Monadic Iteratees: -- incremental input parsers, processors and transformers@@ -17,6 +24,8 @@ ,run ,tryRun ,mapIteratee+ ,ilift+ ,ifold -- ** Creating Iteratees ,idone ,icont@@ -26,25 +35,26 @@ -- ** Stream Functions ,setEOF -- * Classes- ,module Data.NullPoint- ,module Data.Nullable- ,module Data.Iteratee.Base.LooseMap+ ,module X ) where -import Prelude hiding (null, catch)-import Data.Iteratee.Base.LooseMap+import Prelude hiding (null) import Data.Iteratee.Exception-import Data.Nullable-import Data.NullPoint+import Data.Iteratee.Base.LooseMap as X+import Data.Nullable as X+import Data.NullPoint as X++import Data.Maybe import Data.Monoid +import Control.Monad (liftM, join)+import Control.Monad.Base import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Control.Monad.CatchIO (MonadCatchIO (..), Exception (..),- catch, block, toException, fromException)+import Control.Monad.Trans.Control+import Control.Monad.Catch as CIO import Control.Applicative hiding (empty)-import Control.Exception (SomeException) import qualified Control.Exception as E import Data.Data @@ -105,13 +115,13 @@ -- ---------------------------------------------- -idone :: Monad m => a -> Stream s -> Iteratee s m a+idone :: a -> Stream s -> Iteratee s m a idone a s = Iteratee $ \onDone _ -> onDone a s icont :: (Stream s -> Iteratee s m a) -> Maybe SomeException -> Iteratee s m a icont k e = Iteratee $ \_ onCont -> onCont k e -liftI :: Monad m => (Stream s -> Iteratee s m a) -> Iteratee s m a+liftI :: (Stream s -> Iteratee s m a) -> Iteratee s m a liftI k = Iteratee $ \_ onCont -> onCont k Nothing -- Monadic versions, frequently used by enumerators@@ -125,7 +135,7 @@ -> m (Iteratee s m a) icontM k e = return $ Iteratee $ \_ onCont -> onCont k e -instance (Functor m, Monad m) => Functor (Iteratee s m) where+instance (Functor m) => Functor (Iteratee s m) where fmap f m = Iteratee $ \onDone onCont -> let od = onDone . f oc = onCont . (fmap f .)@@ -133,32 +143,78 @@ instance (Functor m, Monad m, Nullable s) => Applicative (Iteratee s m) where pure x = idone x (Chunk empty)+ {-# INLINE (<*>) #-} m <*> a = m >>= flip fmap a instance (Monad m, Nullable s) => Monad (Iteratee s m) where {-# INLINE return #-} return x = Iteratee $ \onDone _ -> onDone x (Chunk empty) {-# INLINE (>>=) #-}- m >>= f = Iteratee $ \onDone onCont ->- let m_done a (Chunk s)- | null s = runIter (f a) onDone onCont- m_done a stream = runIter (f a) (const . flip onDone stream) f_cont- where f_cont k Nothing = runIter (k stream) onDone onCont- f_cont k e = onCont k e- in runIter m m_done (onCont . ((>>= f) .))+ (>>=) = bindIteratee +{-# INLINE bindIteratee #-}+bindIteratee :: (Monad m, Nullable s)+ => Iteratee s m a+ -> (a -> Iteratee s m b)+ -> Iteratee s m b+bindIteratee = self+ where+ self m f = Iteratee $ \onDone onCont ->+ let m_done a (Chunk s)+ | nullC s = runIter (f a) onDone onCont+ m_done a stream = runIter (f a) (const . flip onDone stream) f_cont+ where f_cont k Nothing = runIter (k stream) onDone onCont+ f_cont k e = onCont k e+ in runIter m m_done (onCont . (flip self f .))+ instance NullPoint s => MonadTrans (Iteratee s) where lift m = Iteratee $ \onDone _ -> m >>= flip onDone (Chunk empty) +instance (MonadBase b m, Nullable s, NullPoint s) => MonadBase b (Iteratee s m) where+ liftBase = lift . liftBase+ instance (MonadIO m, Nullable s, NullPoint s) => MonadIO (Iteratee s m) where liftIO = lift . liftIO -instance (MonadCatchIO m, Nullable s, NullPoint s) =>- MonadCatchIO (Iteratee s m) where- m `catch` f = Iteratee $ \od oc -> runIter m od oc `catch` (\e -> runIter (f e) od oc)- block = mapIteratee block- unblock = mapIteratee unblock+instance (MonadThrow m, Nullable s, NullPoint s) =>+ MonadThrow (Iteratee s m) where+ throwM e = lift $ CIO.throwM e +instance (MonadCatch m, Nullable s, NullPoint s) =>+ MonadCatch (Iteratee s m) where+ m `catch` f = Iteratee $ \od oc -> runIter m od oc `CIO.catch` (\e -> runIter (f e) od oc)++-- prior to exceptions-0.6, these were part of MonadCatch+#if MIN_VERSION_exceptions(0,6,0)+instance (MonadMask m, Nullable s, NullPoint s) =>+ MonadMask (Iteratee s m) where+#endif+ mask q = Iteratee $ \od oc -> CIO.mask $ \u -> runIter (q $ ilift u) od oc+ uninterruptibleMask q = Iteratee $ \od oc -> CIO.uninterruptibleMask $ \u -> runIter (q $ ilift u) od oc++instance forall s. (NullPoint s, Nullable s) => MonadTransControl (Iteratee s) where+ newtype StT (Iteratee s) x =+ StIter { unStIter :: Either (x, Stream s) (Maybe SomeException) }+ liftWith f = lift $ f $ \t -> liftM StIter+ (runIter t (\x s -> return $ Left (x,s))+ (\_ e -> return $ Right e) )+ restoreT = join . lift . liftM+ (either (uncurry idone)+ (te . fromMaybe (iterStrExc+ "iteratee: error in MonadTransControl instance"))+ . unStIter )+ {-# INLINE liftWith #-}+ {-# INLINE restoreT #-}++instance (MonadBaseControl b m, Nullable s) => MonadBaseControl b (Iteratee s m) where+ newtype StM (Iteratee s m) a =+ StMIter { unStMIter :: ComposeSt (Iteratee s) m a}+ liftBaseWith = defaultLiftBaseWith StMIter+ restoreM = defaultRestoreM unStMIter++te :: SomeException -> Iteratee s m a+te e = icont (const (te e)) (Just e)+ -- |Send 'EOF' to the @Iteratee@ and disregard the unconsumed part of the -- stream. If the iteratee is in an exception state, that exception is -- thrown with 'Control.Exception.throw'. Iteratees that do not terminate@@ -176,6 +232,7 @@ -- Note that only internal iteratee exceptions will be returned; exceptions -- thrown with @Control.Exception.throw@ or @Control.Monad.CatchIO.throw@ will -- not be returned.+-- -- See 'Data.Iteratee.Exception.IFException' for details. tryRun :: (Exception e, Monad m) => Iteratee s m a -> m (Either e a) tryRun iter = runIter iter onDone onCont@@ -193,3 +250,36 @@ -> Iteratee s m a -> Iteratee s n b mapIteratee f = lift . f . run+{-# DEPRECATED mapIteratee "This function will be removed, compare to 'ilift'" #-}++-- | Lift a computation in the inner monad of an iteratee.+-- +-- A simple use would be to lift a logger iteratee to a monad stack.+-- +-- > logger :: Iteratee String IO ()+-- > logger = mapChunksM_ putStrLn+-- > +-- > loggerG :: MonadIO m => Iteratee String m ()+-- > loggerG = ilift liftIO logger+-- +-- A more complex example would involve lifting an iteratee to work with+-- interleaved streams. See the example at 'Data.Iteratee.ListLike.merge'.+ilift ::+ (Monad m, Monad n)+ => (forall r. m r -> n r)+ -> Iteratee s m a+ -> Iteratee s n a+ilift f i = Iteratee $ \od oc ->+ let onDone a str = return $ Left (a,str)+ onCont k mErr = return $ Right (ilift f . k, mErr)+ in f (runIter i onDone onCont) >>= either (uncurry od) (uncurry oc)++-- | Lift a computation in the inner monad of an iteratee, while threading+-- through an accumulator.+ifold :: (Monad m, Monad n) => (forall r. m r -> acc -> n (r, acc))+ -> acc -> Iteratee s m a -> Iteratee s n (a, acc)+ifold f acc i = Iteratee $ \ od oc -> do+ (r, acc') <- flip f acc $+ runIter i (curry $ return . Left) (curry $ return . Right)+ either (uncurry (od . flip (,) acc'))+ (uncurry (oc . (ifold f acc .))) r
src/Data/Iteratee/Base/ReadableChunk.hs view
@@ -13,6 +13,7 @@ import Prelude hiding (head, tail, dropWhile, length, splitAt ) import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L import Data.Word import Control.Monad.IO.Class import Foreign.C@@ -45,3 +46,7 @@ instance ReadableChunk B.ByteString Word8 where readFromPtr buf l = liftIO $ B.packCStringLen (castPtr buf, l)++instance ReadableChunk L.ByteString Word8 where+ readFromPtr buf l = liftIO $+ return . L.fromChunks . (:[]) =<< readFromPtr buf l
src/Data/Iteratee/Binary.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, BangPatterns #-} -- |Monadic Iteratees: -- incremental input parsers, processors, and transformers@@ -13,61 +13,59 @@ ,endianRead3 ,endianRead3i ,endianRead4+ ,endianRead8+ -- ** bytestring specializations+ -- | In current versions of @iteratee@ there is no difference between the+ -- bytestring specializations and polymorphic functions. They exist+ -- for compatibility.+ ,readWord16be_bs+ ,readWord16le_bs+ ,readWord32be_bs+ ,readWord32le_bs+ ,readWord64be_bs+ ,readWord64le_bs ) where import Data.Iteratee.Base import qualified Data.Iteratee.ListLike as I import qualified Data.ListLike as LL+import qualified Data.ByteString as B import Data.Word import Data.Bits import Data.Int - -- ------------------------------------------------------------------------ -- Binary Random IO Iteratees -- Iteratees to read unsigned integers written in Big- or Little-endian ways --- |Indicate endian-ness.+-- | Indicate endian-ness. data Endian = MSB -- ^ Most Significant Byte is first (big-endian) | LSB -- ^ Least Significan Byte is first (little-endian) deriving (Eq, Ord, Show, Enum) endianRead2- :: (Nullable s, LL.ListLike s Word8, Monad m) =>- Endian- -> Iteratee s m Word16-endianRead2 e = do- c1 <- I.head- c2 <- I.head- case e of- MSB -> return $ (fromIntegral c1 `shiftL` 8) .|. fromIntegral c2- LSB -> return $ (fromIntegral c2 `shiftL` 8) .|. fromIntegral c1+ :: (Nullable s, LL.ListLike s Word8, Monad m)+ => Endian+ -> Iteratee s m Word16+endianRead2 e = endianReadN e 2 word16'+{-# INLINE endianRead2 #-} endianRead3- :: (Nullable s, LL.ListLike s Word8, Monad m) =>- Endian- -> Iteratee s m Word32-endianRead3 e = do- c1 <- I.head- c2 <- I.head- c3 <- I.head- case e of- MSB -> return $ (((fromIntegral c1- `shiftL` 8) .|. fromIntegral c2)- `shiftL` 8) .|. fromIntegral c3- LSB -> return $ (((fromIntegral c3- `shiftL` 8) .|. fromIntegral c2)- `shiftL` 8) .|. fromIntegral c1+ :: (Nullable s, LL.ListLike s Word8, Monad m)+ => Endian+ -> Iteratee s m Word32+endianRead3 e = endianReadN e 3 (word32' . (0:))+{-# INLINE endianRead3 #-} -- |Read 3 bytes in an endian manner. If the first bit is set (negative), -- set the entire first byte so the Int32 will be negative as -- well. endianRead3i- :: (Nullable s, LL.ListLike s Word8, Monad m) =>- Endian- -> Iteratee s m Int32+ :: (Nullable s, LL.ListLike s Word8, Monad m)+ => Endian+ -> Iteratee s m Int32 endianRead3i e = do c1 <- I.head c2 <- I.head@@ -82,24 +80,118 @@ in return $ (((fromIntegral c3 `shiftL` 8) .|. fromIntegral c2) `shiftL` 8) .|. fromIntegral m+{-# INLINE endianRead3i #-} endianRead4- :: (Nullable s, LL.ListLike s Word8, Monad m) =>- Endian- -> Iteratee s m Word32-endianRead4 e = do- c1 <- I.head- c2 <- I.head- c3 <- I.head- c4 <- I.head- case e of- MSB -> return $- (((((fromIntegral c1- `shiftL` 8) .|. fromIntegral c2)- `shiftL` 8) .|. fromIntegral c3)- `shiftL` 8) .|. fromIntegral c4- LSB -> return $- (((((fromIntegral c4- `shiftL` 8) .|. fromIntegral c3)- `shiftL` 8) .|. fromIntegral c2)- `shiftL` 8) .|. fromIntegral c1+ :: (Nullable s, LL.ListLike s Word8, Monad m)+ => Endian+ -> Iteratee s m Word32+endianRead4 e = endianReadN e 4 word32'+{-# INLINE endianRead4 #-}++endianRead8+ :: (Nullable s, LL.ListLike s Word8, Monad m)+ => Endian+ -> Iteratee s m Word64+endianRead8 e = endianReadN e 8 word64'+{-# INLINE endianRead8 #-}++-- This function does all the parsing work, depending upon provided arguments+endianReadN ::+ (Nullable s, LL.ListLike s Word8, Monad m)+ => Endian+ -> Int+ -> ([Word8] -> b)+ -> Iteratee s m b+endianReadN MSB n0 cnct = liftI (step n0 [])+ where+ step !n acc (Chunk c)+ | LL.null c = liftI (step n acc)+ | LL.length c >= n = let (this,next) = LL.splitAt n c+ !result = cnct $ acc ++ LL.toList this+ in idone result (Chunk next)+ | otherwise = liftI (step (n - LL.length c) (acc ++ LL.toList c))+ step !n acc (EOF Nothing) = icont (step n acc) (Just $ toException EofException)+ step !n acc (EOF (Just e)) = icont (step n acc) (Just e)+endianReadN LSB n0 cnct = liftI (step n0 [])+ where+ step !n acc (Chunk c)+ | LL.null c = liftI (step n acc)+ | LL.length c >= n = let (this,next) = LL.splitAt n c+ !result = cnct $ reverse (LL.toList this) ++ acc+ in idone result (Chunk next)+ | otherwise = liftI (step (n - LL.length c)+ (reverse (LL.toList c) ++ acc))+ step !n acc (EOF Nothing) = icont (step n acc)+ (Just $ toException EofException)+ step !n acc (EOF (Just e)) = icont (step n acc) (Just e)+{-# INLINE endianReadN #-}++-- As of now, the polymorphic code is as fast as the best specializations+-- I have found, so these just call out. They may be improved in the+-- future, or possibly deprecated.+-- JWL, 2012-01-16++readWord16be_bs :: Monad m => Iteratee B.ByteString m Word16+readWord16be_bs = endianRead2 MSB+{-# INLINE readWord16be_bs #-}++readWord16le_bs :: Monad m => Iteratee B.ByteString m Word16+readWord16le_bs = endianRead2 LSB+{-# INLINE readWord16le_bs #-}++readWord32be_bs :: Monad m => Iteratee B.ByteString m Word32+readWord32be_bs = endianRead4 MSB+{-# INLINE readWord32be_bs #-}++readWord32le_bs :: Monad m => Iteratee B.ByteString m Word32+readWord32le_bs = endianRead4 LSB+{-# INLINE readWord32le_bs #-}++readWord64be_bs :: Monad m => Iteratee B.ByteString m Word64+readWord64be_bs = endianRead8 MSB+{-# INLINE readWord64be_bs #-}++readWord64le_bs :: Monad m => Iteratee B.ByteString m Word64+readWord64le_bs = endianRead8 LSB+{-# INLINE readWord64le_bs #-}++word16' :: [Word8] -> Word16+word16' [c1,c2] = word16 c1 c2+word16' _ = error "iteratee: internal error in word16'"++word16 :: Word8 -> Word8 -> Word16+word16 c1 c2 = (fromIntegral c1 `shiftL` 8) .|. fromIntegral c2+{-# INLINE word16 #-}++word32' :: [Word8] -> Word32+word32' [c1,c2,c3,c4] = word32 c1 c2 c3 c4+word32' _ = error "iteratee: internal error in word32'"++word32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32+word32 c1 c2 c3 c4 =+ (fromIntegral c1 `shiftL` 24) .|.+ (fromIntegral c2 `shiftL` 16) .|.+ (fromIntegral c3 `shiftL` 8) .|.+ fromIntegral c4+{-# INLINE word32 #-}++word64' :: [Word8] -> Word64+word64' [c1,c2,c3,c4,c5,c6,c7,c8] = word64 c1 c2 c3 c4 c5 c6 c7 c8+word64' _ = error "iteratee: internal error in word64'"+{-# INLINE word64' #-}++word64+ :: Word8 -> Word8 -> Word8 -> Word8 + -> Word8 -> Word8 -> Word8 -> Word8 + -> Word64+word64 c1 c2 c3 c4 c5 c6 c7 c8 =+ (fromIntegral c1 `shiftL` 56) .|.+ (fromIntegral c2 `shiftL` 48) .|.+ (fromIntegral c3 `shiftL` 40) .|.+ (fromIntegral c4 `shiftL` 32) .|.+ (fromIntegral c5 `shiftL` 24) .|.+ (fromIntegral c6 `shiftL` 16) .|.+ (fromIntegral c7 `shiftL` 8) .|.+ fromIntegral c8+{-# INLINE word64 #-}
src/Data/Iteratee/Char.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} -- | Utilities for Char-based iteratee processing. module Data.Iteratee.Char ( -- * Word and Line processors printLines+ ,printLinesUnterminated ,enumLines ,enumLinesBS ,enumWords@@ -26,16 +27,44 @@ -- |Print lines as they are received. This is the first `impure' iteratee -- with non-trivial actions during chunk processing+--+-- Only lines ending with a newline are printed,+-- data terminated with EOF is not printed. printLines :: Iteratee String IO () printLines = lines'- where+ where lines' = I.break (`elem` "\r\n") >>= \l -> terminators >>= check l check _ 0 = return () check "" _ = return () check l _ = liftIO (putStrLn l) >> lines'- terminators = heads "\r\n" >>= \l -> if l == 0 then heads "\n" else return l +-- |Print lines as they are received.+--+-- All lines are printed, including a line with a terminating EOF.+-- If the final line is terminated by EOF without a newline,+-- no newline is printed.+-- this function should be used in preference to printLines when possible,+-- as it is more efficient with long lines.+printLinesUnterminated :: forall s el.+ (Eq el, Nullable s, LL.StringLike s, LL.ListLike s el)+ => Iteratee s IO ()+printLinesUnterminated = lines'+ where+ lines' = do+ joinI $ I.breakE (`LL.elem` t1) (I.mapChunksM_ (putStr . LL.toString))+ terminators >>= check+ check 0 = return ()+ check _ = liftIO (putStrLn "") >> lines'+ t1 :: s+ t1 = LL.fromString "\r\n" +terminators :: (Eq el, Nullable s, LL.StringLike s, LL.ListLike s el)+ => Iteratee s IO Int+terminators = do+ l <- heads (LL.fromString "\r\n")+ if l == 0 then heads (LL.fromString "\n") else return l++ -- |Convert the stream of characters to the stream of lines, and -- apply the given iteratee to enumerate the latter. -- The stream of lines is normally terminated by the empty line.@@ -54,12 +83,12 @@ step (Chunk xs) | LL.null xs = getter | lChar xs = idone (LL.lines xs) mempty- | True = icont (step' xs) Nothing+ | otherwise = icont (step' xs) Nothing step _str = getter step' xs (Chunk ys) | LL.null ys = icont (step' xs) Nothing | lChar ys = idone (LL.lines . mappend xs $ ys) mempty- | True = let w' = LL.lines $ mappend xs ys+ | otherwise = let w' = LL.lines $ mappend xs ys ws = init w' ck = last w' in idone ws (Chunk ck)@@ -85,12 +114,12 @@ step (Chunk xs) | BC.null xs = getter | lChar xs = idone (BC.words xs) (Chunk BC.empty)- | True = icont (step' xs) Nothing+ | otherwise = icont (step' xs) Nothing step str = idone mempty str step' xs (Chunk ys) | BC.null ys = icont (step' xs) Nothing | lChar ys = idone (BC.words . BC.append xs $ ys) mempty- | True = let w' = BC.words . BC.append xs $ ys+ | otherwise = let w' = BC.words . BC.append xs $ ys ws = init w' ck = last w' in idone ws (Chunk ck)@@ -109,12 +138,12 @@ step (Chunk xs) | BC.null xs = getter | lChar xs = idone (BC.lines xs) (Chunk BC.empty)- | True = icont (step' xs) Nothing+ | otherwise = icont (step' xs) Nothing step str = idone mempty str step' xs (Chunk ys) | BC.null ys = icont (step' xs) Nothing | lChar ys = idone (BC.lines . BC.append xs $ ys) mempty- | True = let w' = BC.lines $ BC.append xs ys+ | otherwise = let w' = BC.lines $ BC.append xs ys ws = init w' ck = last w' in idone ws (Chunk ck)
src/Data/Iteratee/Exception.hs view
@@ -40,6 +40,7 @@ module Data.Iteratee.Exception ( -- * Exception types IFException (..)+ ,Exception (..) -- from Control.Exception -- ** Enumerator exceptions ,EnumException (..) ,DivergentException (..)@@ -55,6 +56,8 @@ ,enStrExc ,iterStrExc ,wrapIterExc+ ,iterExceptionToException+ ,iterExceptionFromException ) where
src/Data/Iteratee/IO.hs view
@@ -1,16 +1,21 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} -- |Random and Binary IO with generic Iteratees. module Data.Iteratee.IO(+ -- * Data+ defaultBufSize, -- * File enumerators -- ** Handle-based enumerators- enumHandle,- enumHandleRandom,+ H.enumHandle,+ H.enumHandleRandom,+ enumFile,+ enumFileRandom, #if defined(USE_POSIX) -- ** FileDescriptor based enumerators- enumFd,- enumFdRandom,+ FD.enumFd,+ FD.enumFdRandom, #endif -- * Iteratee drivers -- These are FileDescriptor-based on POSIX systems, otherwise they are@@ -27,54 +32,75 @@ import Data.Iteratee.Base.ReadableChunk import Data.Iteratee.Iteratee import Data.Iteratee.Binary()-import Data.Iteratee.IO.Handle+import qualified Data.Iteratee.IO.Handle as H #if defined(USE_POSIX)-import Data.Iteratee.IO.Fd+import qualified Data.Iteratee.IO.Fd as FD #endif -import Control.Monad.CatchIO+import Control.Monad.Catch+import Control.Monad.IO.Class +#if MIN_VERSION_exceptions(0,6,0)+#else+type MonadMask = MonadCatch+#endif++-- | The default buffer size. defaultBufSize :: Int defaultBufSize = 1024 -- If Posix is available, use the fileDriverRandomFd as fileDriverRandom. Otherwise, use a handle-based variant. #if defined(USE_POSIX) +enumFile+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>+ Int+ -> FilePath+ -> Enumerator s m a+enumFile = FD.enumFile++enumFileRandom+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>+ Int+ -> FilePath+ -> Enumerator s m a+enumFileRandom = FD.enumFileRandom+ -- |Process a file using the given Iteratee. This function wraps -- enumFd as a convenience. fileDriver- :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) => Iteratee s m a -> FilePath -> m a-fileDriver = fileDriverFd defaultBufSize+fileDriver = FD.fileDriverFd defaultBufSize -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf- :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a-fileDriverVBuf = fileDriverFd+fileDriverVBuf = FD.fileDriverFd -- |Process a file using the given Iteratee. This function wraps -- enumFdRandom as a convenience. fileDriverRandom- :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) => Iteratee s m a -> FilePath -> m a-fileDriverRandom = fileDriverRandomFd defaultBufSize+fileDriverRandom = FD.fileDriverRandomFd defaultBufSize fileDriverRandomVBuf- :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a-fileDriverRandomVBuf = fileDriverRandomFd+fileDriverRandomVBuf = FD.fileDriverRandomFd #else @@ -84,36 +110,50 @@ -- |Process a file using the given Iteratee. This function wraps -- @enumHandle@ as a convenience. fileDriver ::- (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) => Iteratee s m a -> FilePath -> m a-fileDriver = fileDriverHandle defaultBufSize+fileDriver = H.fileDriverHandle defaultBufSize -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf ::- (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a-fileDriverVBuf = fileDriverHandle+fileDriverVBuf = H.fileDriverHandle -- |Process a file using the given Iteratee. This function wraps -- @enumRandomHandle@ as a convenience. fileDriverRandom- :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) => Iteratee s m a -> FilePath -> m a-fileDriverRandom = fileDriverRandomHandle defaultBufSize+fileDriverRandom = H.fileDriverRandomHandle defaultBufSize fileDriverRandomVBuf- :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a-fileDriverRandomVBuf = fileDriverRandomHandle+fileDriverRandomVBuf = H.fileDriverRandomHandle++enumFile+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>+ Int+ -> FilePath+ -> Enumerator s m a+enumFile = H.enumFile++enumFileRandom+ :: (MonadIO m, MonadMask m, NullPoint s, ReadableChunk s el) =>+ Int+ -> FilePath+ -> Enumerator s m a+enumFileRandom = H.enumFileRandom #endif
src/Data/Iteratee/IO/Fd.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE ConstraintKinds #-} -- |Random and Binary IO with generic Iteratees, using File Descriptors for IO. -- when available, these are the preferred functions for performing IO as they@@ -11,6 +12,8 @@ enumFd ,enumFdCatch ,enumFdRandom+ ,enumFile+ ,enumFileRandom -- * Iteratee drivers ,fileDriverFd ,fileDriverRandomFd@@ -25,9 +28,10 @@ import Data.Iteratee.Binary() import Data.Iteratee.IO.Base +import Control.Concurrent (yield) import Control.Exception import Control.Monad-import Control.Monad.CatchIO as CIO+import Control.Monad.Catch as CIO import Control.Monad.IO.Class import Foreign.Ptr@@ -37,8 +41,13 @@ import System.IO (SeekMode(..)) import System.Posix hiding (FileOffset)-import GHC.Conc +#if MIN_VERSION_exceptions(0,6,0)+#else+type MonadMask = MonadCatch+#endif++ -- ------------------------------------------------------------------------ -- Binary Random IO enumerators @@ -50,11 +59,10 @@ -> st -> m (Either SomeException ((Bool, st), s)) makefdCallback p bufsize fd st = do- liftIO $ GHC.Conc.threadWaitRead fd n <- liftIO $ myfdRead fd (castPtr p) bufsize case n of- Left _ -> return $ Left undefined- Right 0 -> return $ Right ((False, st), empty)+ Left _ -> return $ Left (error "myfdRead failed")+ Right 0 -> liftIO yield >> return (Right ((False, st), empty)) Right n' -> liftM (\s -> Right ((True, st), s)) $ readFromPtr p (fromIntegral n') @@ -62,33 +70,34 @@ -- over the entire contents of a file, in order, unless stopped by -- the iteratee. In particular, seeking is not supported. enumFd- :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m) =>+ :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) => Int -> Fd -> Enumerator s m a-enumFd bs fd iter = do+enumFd bs fd iter = let bufsize = bs * (sizeOf (undefined :: el))- p <- liftIO $ mallocBytes bufsize- enumFromCallback (makefdCallback p (fromIntegral bufsize) fd) () iter+ in CIO.bracket (liftIO $ mallocBytes bufsize)+ (liftIO . free)+ (\p -> enumFromCallback (makefdCallback p (fromIntegral bufsize) fd) () iter) -- |A variant of enumFd that catches exceptions raised by the @Iteratee@. enumFdCatch- :: forall e s el m a.(IException e, NullPoint s, ReadableChunk s el, MonadIO m)+ :: forall e s el m a.(IException e, NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) => Int -> Fd -> (e -> m (Maybe EnumException)) -> Enumerator s m a-enumFdCatch bs fd handler iter = do+enumFdCatch bs fd handler iter = let bufsize = bs * (sizeOf (undefined :: el))- p <- liftIO $ mallocBytes bufsize- enumFromCallbackCatch (makefdCallback p (fromIntegral bufsize) fd)- handler () iter+ in CIO.bracket (liftIO $ mallocBytes bufsize)+ (liftIO . free)+ (\p -> enumFromCallbackCatch (makefdCallback p (fromIntegral bufsize) fd) handler () iter) -- |The enumerator of a POSIX File Descriptor: a variation of @enumFd@ that -- supports RandomIO (seek requests). enumFdRandom- :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m) =>+ :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) => Int -> Fd -> Enumerator s m a@@ -101,7 +110,7 @@ . liftIO . myfdSeek fd AbsoluteSeek $ fromIntegral off fileDriver- :: (MonadCatchIO m, ReadableChunk s el) =>+ :: (MonadIO m, MonadMask m, ReadableChunk s el) => (Int -> Fd -> Enumerator s m a) -> Int -> Iteratee s m a@@ -114,7 +123,7 @@ -- |Process a file using the given @Iteratee@. fileDriverFd- :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>+ :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) => Int -- ^Buffer size (number of elements) -> Iteratee s m a -> FilePath@@ -123,11 +132,36 @@ -- |A version of fileDriverFd that supports seeking. fileDriverRandomFd- :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>+ :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a fileDriverRandomFd = fileDriver enumFdRandom++enumFile' :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) =>+ (Int -> Fd -> Enumerator s m a)+ -> Int -- ^Buffer size+ -> FilePath+ -> Enumerator s m a+enumFile' enumf bufsize filepath iter = CIO.bracket+ (liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags)+ (liftIO . closeFd)+ (flip (enumf bufsize) iter)++enumFile ::+ (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el)+ => Int -- ^Buffer size+ -> FilePath+ -> Enumerator s m a+enumFile = enumFile' enumFd++enumFileRandom ::+ (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el)+ => Int -- ^Buffer size+ -> FilePath+ -> Enumerator s m a+enumFileRandom = enumFile' enumFdRandom+ #endif
src/Data/Iteratee/IO/Handle.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ScopedTypeVariables #-} -- |Random and Binary IO with generic Iteratees. These functions use Handles@@ -10,6 +12,8 @@ enumHandle ,enumHandleCatch ,enumHandleRandom+ ,enumFile+ ,enumFileRandom -- * Iteratee drivers ,fileDriverHandle ,fileDriverRandomHandle@@ -23,7 +27,7 @@ import Control.Exception import Control.Monad-import Control.Monad.CatchIO as CIO+import Control.Monad.Catch as CIO import Control.Monad.IO.Class import Foreign.Ptr@@ -32,12 +36,16 @@ import System.IO +#if MIN_VERSION_exceptions(0,6,0)+#else+type MonadMask = MonadCatch+#endif -- ------------------------------------------------------------------------ -- Binary Random IO enumerators makeHandleCallback ::- (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ (MonadIO m, MonadCatch m, NullPoint s, ReadableChunk s el) => Ptr el -> Int -> Handle@@ -57,14 +65,15 @@ -- the iteratee. In particular, seeking is not supported. -- Data is read into a buffer of the specified size. enumHandle ::- forall s el m a.(NullPoint s, ReadableChunk s el, MonadCatchIO m) =>+ forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) => Int -- ^Buffer size (number of elements per read) -> Handle -> Enumerator s m a-enumHandle bs h i = do+enumHandle bs h i = let bufsize = bs * sizeOf (undefined :: el)- p <- liftIO $ mallocBytes bufsize- enumFromCallback (makeHandleCallback p bufsize h) () i+ in CIO.bracket (liftIO $ mallocBytes bufsize)+ (liftIO . free)+ (\p -> enumFromCallback (makeHandleCallback p bufsize h) () i) -- |An enumerator of a file handle that catches exceptions raised by -- the Iteratee.@@ -73,22 +82,23 @@ forall e s el m a.(IException e, NullPoint s, ReadableChunk s el,- MonadCatchIO m) =>+ MonadIO m, MonadMask m) => Int -- ^Buffer size (number of elements per read) -> Handle -> (e -> m (Maybe EnumException)) -> Enumerator s m a-enumHandleCatch bs h handler i = do+enumHandleCatch bs h handler i = let bufsize = bs * sizeOf (undefined :: el)- p <- liftIO $ mallocBytes bufsize- enumFromCallbackCatch (makeHandleCallback p bufsize h) handler () i+ in CIO.bracket (liftIO $ mallocBytes bufsize)+ (liftIO . free)+ (\p -> enumFromCallbackCatch (makeHandleCallback p bufsize h) handler () i) -- |The enumerator of a Handle: a variation of enumHandle that -- supports RandomIO (seek requests). -- Data is read into a buffer of the specified size. enumHandleRandom ::- forall s el m a.(NullPoint s, ReadableChunk s el, MonadCatchIO m) =>+ forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadMask m) => Int -- ^ Buffer size (number of elements per read) -> Handle -> Enumerator s m a@@ -103,33 +113,48 @@ -- ---------------------------------------------- -- File Driver wrapper functions. -fileDriver :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>+enumFile' :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) => (Int -> Handle -> Enumerator s m a) -> Int -- ^Buffer size- -> Iteratee s m a -> FilePath- -> m a-fileDriver enumf bufsize iter filepath = CIO.bracket+ -> Enumerator s m a+enumFile' enumf bufsize filepath iter = CIO.bracket (liftIO $ openBinaryFile filepath ReadMode) (liftIO . hClose)- (run <=< flip (enumf bufsize) iter)+ (flip (enumf bufsize) iter) +enumFile ::+ (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el)+ => Int -- ^Buffer size+ -> FilePath+ -> Enumerator s m a+enumFile = enumFile' enumHandle++enumFileRandom ::+ (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el)+ => Int -- ^Buffer size+ -> FilePath+ -> Enumerator s m a+enumFileRandom = enumFile' enumHandleRandom+ -- |Process a file using the given @Iteratee@. This function wraps -- @enumHandle@ as a convenience. fileDriverHandle- :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>- Int -- ^Buffer size (number of elements)+ :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) =>+ Int -- ^Buffer size (number of elements) -> Iteratee s m a -> FilePath -> m a-fileDriverHandle = fileDriver enumHandle+fileDriverHandle bufsize iter filepath =+ enumFile bufsize filepath iter >>= run -- |A version of @fileDriverHandle@ that supports seeking. fileDriverRandomHandle- :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>- Int+ :: (NullPoint s, MonadIO m, MonadMask m, ReadableChunk s el) =>+ Int -- ^ Buffer size (number of elements) -> Iteratee s m a -> FilePath -> m a-fileDriverRandomHandle = fileDriver enumHandleRandom+fileDriverRandomHandle bufsize iter filepath =+ enumFileRandom bufsize filepath iter >>= run
+ src/Data/Iteratee/IO/Interact.hs view
@@ -0,0 +1,28 @@+module Data.Iteratee.IO.Interact (+ ioIter+)+where++import Control.Monad.IO.Class+import Data.Iteratee++-- | Use an IO function to choose what iteratee to run.+-- -- Typically this function handles user interaction and+-- -- returns with a simple iteratee such as 'head' or 'seek'.+-- --+-- -- The IO function takes a value of type 'a' as input, and+-- -- should return 'Right a' to continue, or 'Left b'+-- -- to terminate. Upon termination, ioIter will return 'Done b'.+-- --+-- -- The second argument to 'ioIter' is used as the initial input+-- -- to the IO function, and on each successive iteration the+-- -- previously returned value is used as input. Put another way,+-- -- the value of type 'a' is used like a fold accumulator.+-- -- The value of type 'b' is typically some form of control code+-- -- that the application uses to signal the reason for termination.+ioIter :: (MonadIO m, Nullable s)+ => (a -> IO (Either b (Iteratee s m a)))+ -> a+ -> Iteratee s m b+ioIter f a = either return (>>= ioIter f) =<< liftIO (f a)+{-# INLINE ioIter #-}
src/Data/Iteratee/Iteratee.hs view
@@ -1,21 +1,35 @@-{-# LANGUAGE KindSignatures, FlexibleContexts, ScopedTypeVariables, DeriveDataTypeable #-}+{-# LANGUAGE KindSignatures+ ,RankNTypes+ ,FlexibleContexts+ ,ScopedTypeVariables+ ,BangPatterns+ ,DeriveDataTypeable #-} -- |Monadic and General Iteratees: -- incremental input parsers, processors and transformers module Data.Iteratee.Iteratee ( -- * Types+ EnumerateeHandler -- ** Error handling- throwErr+ ,throwErr ,throwRecoverableErr ,checkErr -- ** Basic Iteratees ,identity ,skipToEof ,isStreamFinished+ -- ** Chunkwise Iteratees+ ,mapChunksM_+ ,foldChunksM+ ,getChunk+ ,getChunks -- ** Nested iteratee combinators+ ,mapChunks+ ,mapChunksM ,convStream ,unfoldConvStream+ ,unfoldConvStreamCheck ,joinI ,joinIM -- * Enumerators@@ -26,12 +40,22 @@ ,enumEof ,enumErr ,enumPure1Chunk+ ,enumList ,enumCheckIfDone ,enumFromCallback ,enumFromCallbackCatch -- ** Enumerator Combinators ,(>>>) ,eneeCheckIfDone+ ,eneeCheckIfDoneHandle+ ,eneeCheckIfDoneIgnore+ ,eneeCheckIfDonePass+ ,mergeEnums+ -- ** Enumeratee Combinators+ ,($=)+ ,(=$)+ ,(><>)+ ,(<><) -- * Misc. ,seek ,FileOffset@@ -46,6 +70,7 @@ import Data.Iteratee.Base import Control.Exception+import Control.Monad.Trans.Class import Data.Maybe import Data.Typeable @@ -60,13 +85,12 @@ -- Disregard the input first and then propagate the error. This error -- cannot be handled by 'enumFromCallbackCatch', although it can be cleared -- by 'checkErr'.-throwErr :: (Monad m) => SomeException -> Iteratee s m a+throwErr :: SomeException -> Iteratee s m a throwErr e = icont (const (throwErr e)) (Just e) -- |Report and propagate a recoverable error. This error can be handled by -- both 'enumFromCallbackCatch' and 'checkErr'. throwRecoverableErr ::- (Monad m) => SomeException -> (Stream s -> Iteratee s m a) -> Iteratee s m a@@ -78,7 +102,7 @@ -- @Left SomeException@. 'checkErr' is useful for iteratees that may not -- terminate, such as @Data.Iteratee.head@ with an empty stream. checkErr ::- (Monad m, NullPoint s) =>+ (NullPoint s) => Iteratee s m a -> Iteratee s m (Either SomeException a) checkErr iter = Iteratee $ \onDone onCont ->@@ -91,20 +115,22 @@ -- Parser combinators -- |The identity iteratee. Doesn't do any processing of input.-identity :: (Monad m, NullPoint s) => Iteratee s m ()+identity :: (NullPoint s) => Iteratee s m () identity = idone () (Chunk empty) -- |Get the stream status of an iteratee.-isStreamFinished :: Monad m => Iteratee s m (Maybe SomeException)+isStreamFinished :: (Nullable s) => Iteratee s m (Maybe SomeException) isStreamFinished = liftI check where+ check s@(Chunk xs)+ | nullC xs = isStreamFinished+ | otherwise = idone Nothing s check s@(EOF e) = idone (Just $ fromMaybe (toException EofException) e) s- check s = idone Nothing s {-# INLINE isStreamFinished #-} -- |Skip the rest of the stream-skipToEof :: (Monad m) => Iteratee s m ()+skipToEof :: Iteratee s m () skipToEof = icont check Nothing where check (Chunk _) = skipToEof@@ -112,10 +138,54 @@ -- |Seek to a position in the stream-seek :: (Monad m, NullPoint s) => FileOffset -> Iteratee s m ()+seek :: (NullPoint s) => FileOffset -> Iteratee s m () seek o = throwRecoverableErr (toException $ SeekException o) (const identity) +-- | Map a monadic function over the chunks of the stream and ignore the+-- result. Useful for creating efficient monadic iteratee consumers, e.g.+-- +-- > logger = mapChunksM_ (liftIO . putStrLn)+-- +-- these can be efficiently run in parallel with other iteratees via+-- @Data.Iteratee.ListLike.zip@.+mapChunksM_ :: (Monad m, Nullable s) => (s -> m b) -> Iteratee s m ()+mapChunksM_ f = liftI step+ where+ step (Chunk xs)+ | nullC xs = liftI step+ | otherwise = lift (f xs) >> liftI step+ step s@(EOF _) = idone () s+{-# INLINE mapChunksM_ #-} +-- | A fold over chunks+foldChunksM :: (Monad m, Nullable s) => (a -> s -> m a) -> a -> Iteratee s m a+foldChunksM f = liftI . go+ where+ go a (Chunk c) = lift (f a c) >>= liftI . go+ go a e = idone a e+{-# INLINE foldChunksM #-}++-- | Get the current chunk from the stream.+getChunk :: (Nullable s, NullPoint s) => Iteratee s m s+getChunk = liftI step+ where+ step (Chunk xs)+ | nullC xs = liftI step+ | otherwise = idone xs $ Chunk empty+ step (EOF Nothing) = throwErr $ toException EofException+ step (EOF (Just e)) = throwErr e+{-# INLINE getChunk #-}++-- | Get a list of all chunks from the stream.+getChunks :: (Nullable s) => Iteratee s m [s]+getChunks = liftI (step id)+ where+ step acc (Chunk xs)+ | nullC xs = liftI (step acc)+ | otherwise = liftI (step $ acc . (xs:))+ step acc stream = idone (acc []) stream+{-# INLINE getChunks #-}+ -- --------------------------------------------------- -- The converters show a different way of composing two iteratees: -- `vertical' rather than `horizontal'@@ -127,32 +197,118 @@ -- The following pattern appears often in Enumeratee code {-# INLINE eneeCheckIfDone #-} +-- | Utility function for creating enumeratees. Typical usage is demonstrated+-- by the @breakE@ definition.+-- +-- > breakE+-- > :: (Monad m, LL.ListLike s el, NullPoint s)+-- > => (el -> Bool)+-- > -> Enumeratee s s m a+-- > breakE cpred = eneeCheckIfDone (liftI . step)+-- > where+-- > step k (Chunk s)+-- > | LL.null s = liftI (step k)+-- > | otherwise = case LL.break cpred s of+-- > (str', tail')+-- > | LL.null tail' -> eneeCheckIfDone (liftI . step) . k $ Chunk str'+-- > | otherwise -> idone (k $ Chunk str') (Chunk tail')+-- > step k stream = idone (k stream) stream+-- eneeCheckIfDone :: (Monad m, NullPoint elo) => ((Stream eli -> Iteratee eli m a) -> Iteratee elo m (Iteratee eli m a)) -> Enumeratee elo eli m a-eneeCheckIfDone f inner = Iteratee $ \od oc -> - let on_done x s = od (idone x s) (Chunk empty)- on_cont k Nothing = runIter (f k) od oc- on_cont _ (Just e) = runIter (throwErr e) od oc- in runIter inner on_done on_cont+eneeCheckIfDone f = eneeCheckIfDonePass f'+ where+ f' k Nothing = f k+ f' k (Just e) = throwRecoverableErr e (\s -> joinIM $ enumChunk s $ eneeCheckIfDone f (liftI k)) +type EnumerateeHandler eli elo m a =+ (Stream eli -> Iteratee eli m a)+ -> SomeException+ -> Iteratee elo m (Iteratee eli m a) +-- | The same as eneeCheckIfDonePass, with one extra argument:+-- a handler which is used+-- to process any exceptions in a separate method.+eneeCheckIfDoneHandle+ :: (NullPoint elo)+ => EnumerateeHandler eli elo m a+ -> ((Stream eli -> Iteratee eli m a)+ -> Maybe SomeException+ -> Iteratee elo m (Iteratee eli m a)+ )+ -> Enumeratee elo eli m a+eneeCheckIfDoneHandle h f inner = Iteratee $ \od oc ->+ let onDone x s = od (idone x s) (Chunk empty)+ onCont k Nothing = runIter (f k Nothing) od oc+ onCont k (Just e) = runIter (h k e) od oc+ in runIter inner onDone onCont+{-# INLINABLE eneeCheckIfDoneHandle #-}++eneeCheckIfDonePass+ :: (NullPoint elo)+ => ((Stream eli -> Iteratee eli m a)+ -> Maybe SomeException+ -> Iteratee elo m (Iteratee eli m a)+ )+ -> Enumeratee elo eli m a+eneeCheckIfDonePass f = eneeCheckIfDoneHandle (\k e -> f k (Just e)) f+{-# INLINABLE eneeCheckIfDonePass #-}++eneeCheckIfDoneIgnore+ :: (NullPoint elo)+ => ((Stream eli -> Iteratee eli m a)+ -> Maybe SomeException+ -> Iteratee elo m (Iteratee eli m a)+ )+ -> Enumeratee elo eli m a+eneeCheckIfDoneIgnore f = eneeCheckIfDoneHandle (\k _ -> f k Nothing) f++-- | Convert one stream into another with the supplied mapping function.+-- This function operates on whole chunks at a time, contrasting to+-- @mapStream@ which operates on single elements.+-- +-- > unpacker :: Enumeratee B.ByteString [Word8] m a+-- > unpacker = mapChunks B.unpack+-- +mapChunks :: (NullPoint s) => (s -> s') -> Enumeratee s s' m a+mapChunks f = eneeCheckIfDonePass (icont . step)+ where+ step k (Chunk xs) = eneeCheckIfDonePass (icont . step) . k . Chunk $ f xs+ step k str@(EOF mErr) = idone (k $ EOF mErr) str+{-# INLINE mapChunks #-}++-- | Convert a stream of @s@ to a stream of @s'@ using the supplied function.+mapChunksM+ :: (Monad m, NullPoint s, Nullable s)+ => (s -> m s')+ -> Enumeratee s s' m a+mapChunksM f = eneeCheckIfDonePass (icont . step)+ where+ step k (Chunk xs) = lift (f xs) >>=+ eneeCheckIfDonePass (icont . step) . k . Chunk+ step k str@(EOF mErr) = idone (k $ EOF mErr) str+{-# INLINE mapChunksM #-}+ -- |Convert one stream into another, not necessarily in lockstep.+-- -- The transformer mapStream maps one element of the outer stream -- to one element of the nested stream. The transformer below is more -- general: it may take several elements of the outer stream to produce -- one element of the inner stream, or the other way around. -- The transformation from one stream to the other is specified as--- Iteratee s el s'.+-- Iteratee s m s'. convStream :: (Monad m, Nullable s) => Iteratee s m s' -> Enumeratee s s' m a-convStream fi = eneeCheckIfDone check+convStream fi = eneeCheckIfDonePass check where- check k = isStreamFinished >>= maybe (step k) (idone (liftI k) . EOF . Just)- step k = fi >>= convStream fi . k . Chunk+ check k (Just e) = throwRecoverableErr e (const identity) >> check k Nothing+ check k _ = isStreamFinished >>= maybe (step k) (idone (liftI k) . EOF . Just)+ step k = fi >>= eneeCheckIfDonePass check . k . Chunk+{-# INLINABLE convStream #-} -- |The most general stream converter. Given a function to produce iteratee -- transformers and an initial state, convert the stream using iteratees@@ -162,31 +318,67 @@ (acc -> Iteratee s m (acc, s')) -> acc -> Enumeratee s s' m a-unfoldConvStream f acc = eneeCheckIfDone check+unfoldConvStream f acc0 = eneeCheckIfDonePass (check acc0) where- check k = isStreamFinished >>= maybe (step k) (idone (liftI k) . EOF . Just)- step k = f acc >>= \(acc', s') -> unfoldConvStream f acc' . k . Chunk $ s'+ check acc k (Just e) = throwRecoverableErr e (const identity) >> check acc k Nothing+ check acc k _ = isStreamFinished >>=+ maybe (step acc k) (idone (liftI k) . EOF . Just)+ step acc k = f acc >>= \(acc', s') ->+ eneeCheckIfDonePass (check acc') . k . Chunk $ s'+{-# INLINABLE unfoldConvStream #-} +unfoldConvStreamCheck+ :: (Monad m, Nullable elo)+ => (((Stream eli -> Iteratee eli m a)+ -> Maybe SomeException+ -> Iteratee elo m (Iteratee eli m a)+ )+ -> Enumeratee elo eli m a+ )+ -> (acc -> Iteratee elo m (acc, eli))+ -> acc+ -> Enumeratee elo eli m a+unfoldConvStreamCheck checkDone f acc0 = checkDone (check acc0)+ where+ check acc k mX = isStreamFinished >>=+ maybe (step acc k mX) (idone (icont k mX) . EOF . Just)+ step acc k Nothing = f acc >>= \(acc', s') ->+ (checkDone (check acc') . k $ Chunk s')+ step acc k (Just ex) = throwRecoverableErr ex $ \str' ->+ let i = f acc >>= \(acc', s') ->+ (checkDone (check acc') . k $ Chunk s')+ in joinIM $ enumChunk str' i+{-# INLINABLE unfoldConvStreamCheck #-} +-- | Collapse a nested iteratee. The inner iteratee is terminated by @EOF@.+-- Errors are propagated through the result.+-- +-- The stream resumes from the point of the outer iteratee; any remaining+-- input in the inner iteratee will be lost.+-- Differs from 'Control.Monad.join' in that the inner iteratee is terminated,+-- and may have a different stream type than the result. joinI :: (Monad m, Nullable s) => Iteratee s m (Iteratee s' m a) -> Iteratee s m a joinI = (>>= \inner -> Iteratee $ \od oc ->- let on_done x _ = od x (Chunk empty)- on_cont k Nothing = runIter (k (EOF Nothing)) on_done on_cont'- on_cont _ (Just e) = runIter (throwErr e) od oc- on_cont' _ e = runIter (throwErr (fromMaybe excDivergent e)) od oc- in runIter inner on_done on_cont)+ let onDone x _ = od x (Chunk empty)+ onCont k Nothing = runIter (k (EOF Nothing)) onDone onCont'+ onCont _ (Just e) = runIter (throwErr e) od oc+ onCont' _ e = runIter (throwErr (fromMaybe excDivergent e)) od oc+ in runIter inner onDone onCont)+{-# INLINE joinI #-} +-- | Lift an iteratee inside a monad to an iteratee. joinIM :: (Monad m) => m (Iteratee s m a) -> Iteratee s m a joinIM mIter = Iteratee $ \od oc -> mIter >>= \iter -> runIter iter od oc -- ------------------------------------------------------------------------ -- Enumerators--- |Each enumerator takes an iteratee and returns an iteratee+-- | Each enumerator takes an iteratee and returns an iteratee+-- -- an Enumerator is an iteratee transformer. -- The enumerator normally stops when the stream is terminated -- or when the iteratee moves to the done state, whichever comes first.@@ -227,13 +419,75 @@ -- |The composition of two enumerators: essentially the functional composition+-- -- It is convenient to flip the order of the arguments of the composition -- though: in e1 >>> e2, e1 is executed first (>>>) :: (Monad m) => Enumerator s m a -> Enumerator s m a -> Enumerator s m a (e1 >>> e2) i = e1 i >>= e2+ -- I think (>>>) is identical to (>=>)... --- |The pure 1-chunk enumerator+infixr 0 =$++-- | Combines an Enumeratee from @s@ to @s'@ and an Iteratee that+-- consumes @s'@ into an Iteratee which consumes @s@+(=$)+ :: (Nullable s, Nullable s', Monad m)+ => Enumeratee s s' m a+ -> Iteratee s' m a+ -> Iteratee s m a+(=$) = (.) joinI++infixl 1 $=++-- | Combines Enumerator which produces stream of @s@ and @Enumeratee@+-- which transforms stream of @s@ to stream+-- of @s'@ to into Enumerator which produces stream of @s'@+($=)+ :: (Nullable s, Nullable s', Monad m)+ => (forall a. Enumerator s m a)+ -> Enumeratee s s' m b+ -> Enumerator s' m b+($=) enum enee iter = enum (enee iter) >>= run+++-- | Enumeratee composition+-- Run the second enumeratee within the first. In this example, stream2list+-- is run within the 'take 10', which is itself run within 'take 15', resulting+-- in 15 elements being consumed+-- +-- >>> run =<< enumPure1Chunk [1..1000 :: Int] (joinI $ (I.take 15 ><> I.take 10) I.stream2list)+-- [1,2,3,4,5,6,7,8,9,10]+-- +(><>) ::+ (Nullable s1, Monad m)+ => (forall x . Enumeratee s1 s2 m x)+ -> Enumeratee s2 s3 m a+ -> Enumeratee s1 s3 m a+f ><> g = joinI . f . g++-- | enumeratee composition with the arguments flipped, see '><>'+(<><) ::+ (Nullable s1, Monad m)+ => Enumeratee s2 s3 m a+ -> (forall x. Enumeratee s1 s2 m x)+ -> Enumeratee s1 s3 m a+f <>< g = joinI . g . f++-- | Combine enumeration over two streams. The merging enumeratee would+-- typically be the result of 'Data.Iteratee.ListLike.merge' or+-- 'Data.Iteratee.ListLike.mergeByChunks' (see @merge@ for example).+mergeEnums :: + (Nullable s2, Nullable s1, Monad m)+ => Enumerator s1 m a -- ^ inner enumerator+ -> Enumerator s2 (Iteratee s1 m) a -- ^ outer enumerator+ -> Enumeratee s2 s1 (Iteratee s1 m) a -- ^ merging enumeratee+ -> Enumerator s1 m a+mergeEnums e1 e2 etee i = e1 $ e2 (joinI . etee $ ilift lift i) >>= run+{-# INLINE mergeEnums #-}++-- | The pure 1-chunk enumerator+-- -- It passes a given list of elements to the iteratee in one chunk -- This enumerator does no IO and is useful for testing of base parsing enumPure1Chunk :: (Monad m) => s -> Enumerator s m a@@ -242,7 +496,21 @@ onCont k Nothing = return $ k $ Chunk str onCont k e = return $ icont k e --- |Checks if an iteratee has finished.+-- | Enumerate chunks from a list+-- +enumList :: (Monad m) => [s] -> Enumerator s m a+enumList chunks = go chunks+ where+ go [] i = return i+ go xs' i = runIter i idoneM (onCont xs')+ where+ onCont (x:xs) k Nothing = go xs . k $ Chunk x+ onCont _ _ (Just e) = return $ throwErr e+ onCont _ k Nothing = return $ icont k Nothing+{-# INLINABLE enumList #-}++-- | Checks if an iteratee has finished.+-- -- This enumerator runs the iteratee, performing any monadic actions. -- If the result is True, the returned iteratee is done. enumCheckIfDone :: (Monad m) => Iteratee s m a -> m (Bool, Iteratee s m a)@@ -273,21 +541,24 @@ -- |Create an enumerator from a callback function with an exception handler. -- The exception handler is called if an iteratee reports an exception.-enumFromCallbackCatch ::- (IException e, Monad m, NullPoint s) =>- (st -> m (Either SomeException ((Bool, st), s)))+enumFromCallbackCatch+ :: (IException e, Monad m, NullPoint s)+ => (st -> m (Either SomeException ((Bool, st), s))) -> (e -> m (Maybe EnumException)) -> st -> Enumerator s m a enumFromCallbackCatch c handler = loop where- loop st iter = runIter iter idoneM (on_cont st)- on_cont st k Nothing = c st >>=- either (return . k . EOF . Just) (uncurry check)- where- check (b,st') = if b then loop st' . k . Chunk else return . k . Chunk- on_cont st k j@(Just e) = case fromException e of- Just e' -> handler e' >>= maybe (loop st . k $ Chunk empty)- (return . icont k . Just) . fmap toException+ loop st iter = runIter iter idoneM (onCont st)+ check k (True, st') = loop st' . k . Chunk+ check k (False,_st') = return . k . Chunk+ onCont st k Nothing = c st >>=+ either (return . k . EOF . Just) (uncurry (check k))+ onCont st k j@(Just e) = case fromException e of+ Just e' -> handler e' >>=+ maybe (loop st . k $ Chunk empty)+ (return . icont k . Just) . fmap toException Nothing -> return (icont k j)+{-# INLINE enumFromCallbackCatch #-}+
src/Data/Iteratee/ListLike.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE FlexibleContexts, BangPatterns #-}+{-# LANGUAGE FlexibleContexts, BangPatterns, TupleSections, ScopedTypeVariables #-} -- |Monadic Iteratees: -- incremental input parsers, processors and transformers---+-- -- This module provides many basic iteratees from which more complicated -- iteratees can be built. In general these iteratees parallel those in -- @Data.List@, with some additions.@@ -18,16 +18,27 @@ ,dropWhile ,drop ,head+ ,tryHead+ ,last ,heads ,peek ,roll ,length+ ,chunkLength+ ,takeFromChunk -- ** Nested iteratee combinators+ ,breakE ,take ,takeUpTo+ ,takeWhile+ ,takeWhileE ,mapStream ,rigidMapStream ,filter+ ,group+ ,groupBy+ ,merge+ ,mergeByChunks -- ** Folds ,foldl ,foldl'@@ -41,33 +52,46 @@ ,enumPureNChunk -- ** Enumerator Combinators ,enumPair- -- * Classes+ ,enumWith+ ,zip+ ,zip3+ ,zip4+ ,zip5+ ,sequence_+ ,countConsumed+ ,greedy+ -- ** Monadic functions+ ,mapM_+ ,foldM+ -- * Re-exported modules ,module Data.Iteratee.Iteratee ) where -import Prelude hiding (null, head, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product)+import Prelude hiding (mapM_, null, head, last, drop, dropWhile, take, takeWhile, break, foldl, foldl1, length, filter, sum, product, zip, zip3, sequence_) +import qualified Prelude as Prelude++import Data.List (partition) import qualified Data.ListLike as LL import qualified Data.ListLike.FoldableLL as FLL import Data.Iteratee.Iteratee import Data.Monoid-import Control.Applicative+import Control.Applicative ((<$>), (<*>), (<*))+import Control.Monad (liftM, liftM2, mplus, (<=<)) import Control.Monad.Trans.Class import Data.Word (Word8) import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as BC - -- Useful combinators for implementing iteratees and enumerators -- | Check if a stream has received 'EOF'.-isFinished :: (Monad m, Nullable s) => Iteratee s m Bool+isFinished :: (Nullable s) => Iteratee s m Bool isFinished = liftI check where check c@(Chunk xs)- | null xs = liftI check- | True = idone False c+ | nullC xs = liftI check+ | otherwise = idone False c check s@(EOF _) = idone True s {-# INLINE isFinished #-} @@ -77,23 +101,13 @@ -- |Read a stream to the end and return all of its elements as a list. -- This iteratee returns all data from the stream *strictly*. stream2list :: (Monad m, Nullable s, LL.ListLike s el) => Iteratee s m [el]-stream2list = liftI (step [])- where- step acc (Chunk ls)- | null ls = liftI (step acc)- | True = liftI (step (acc ++ LL.toList ls))- step acc str = idone acc str+stream2list = liftM (concatMap LL.toList) getChunks {-# INLINE stream2list #-} -- |Read a stream to the end and return all of its elements as a stream. -- This iteratee returns all data from the stream *strictly*. stream2stream :: (Monad m, Nullable s, Monoid s) => Iteratee s m s-stream2stream = icont (step mempty) Nothing- where- step acc (Chunk ls)- | null ls = icont (step acc) Nothing- | True = icont (step (acc `mappend` ls)) Nothing- step acc str = idone acc str+stream2stream = liftM mconcat getChunks {-# INLINE stream2stream #-} @@ -105,51 +119,84 @@ -- predicate. -- If the stream is not terminated, the first character of the remaining stream -- satisfies the predicate.---+-- +-- N.B. 'breakE' should be used in preference to @break@.+-- @break@ will retain all data until the predicate is met, which may+-- result in a space leak.+-- -- The analogue of @List.break@ -break :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m s+break :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m s break cpred = icont (step mempty) Nothing where step bfr (Chunk str) | LL.null str = icont (step bfr) Nothing- | True = case LL.break cpred str of+ | otherwise = case LL.break cpred str of (str', tail') | LL.null tail' -> icont (step (bfr `mappend` str)) Nothing- | True -> idone (bfr `mappend` str') (Chunk tail')+ | otherwise -> idone (bfr `mappend` str') (Chunk tail') step bfr stream = idone bfr stream {-# INLINE break #-} -- |Attempt to read the next element of the stream and return it--- Raise a (recoverable) error if the stream is terminated---+-- Raise a (recoverable) error if the stream is terminated.+-- -- The analogue of @List.head@-head :: (Monad m, LL.ListLike s el) => Iteratee s m el+-- +-- Because @head@ can raise an error, it shouldn't be used when constructing+-- iteratees for @convStream@. Use @tryHead@ instead.+head :: (LL.ListLike s el) => Iteratee s m el head = liftI step where step (Chunk vec) | LL.null vec = icont step Nothing- | True = idone (LL.head vec) (Chunk $ LL.tail vec)+ | otherwise = idone (LL.head vec) (Chunk $ LL.tail vec) step stream = icont step (Just (setEOF stream)) {-# INLINE head #-} +-- | Similar to @head@, except it returns @Nothing@ if the stream+-- is terminated.+tryHead :: (LL.ListLike s el) => Iteratee s m (Maybe el)+tryHead = liftI step+ where+ step (Chunk vec)+ | LL.null vec = liftI step+ | otherwise = idone (Just $ LL.head vec) (Chunk $ LL.tail vec)+ step stream = idone Nothing stream+{-# INLINE tryHead #-} +-- |Attempt to read the last element of the stream and return it+-- Raise a (recoverable) error if the stream is terminated+-- +-- The analogue of @List.last@+last :: (LL.ListLike s el, Nullable s) => Iteratee s m el+last = liftI (step Nothing)+ where+ step l (Chunk xs)+ | nullC xs = liftI (step l)+ | otherwise = liftI $ step (Just $ LL.last xs)+ step l s@(EOF _) = case l of+ Nothing -> icont (step l) . Just . setEOF $ s+ Just x -> idone x s+{-# INLINE last #-}++ -- |Given a sequence of characters, attempt to match them against -- the characters on the stream. Return the count of how many -- characters matched. The matched characters are removed from the -- stream.--- For example, if the stream contains "abd", then (heads "abc")--- will remove the characters "ab" and return 2.+-- For example, if the stream contains 'abd', then (heads 'abc')+-- will remove the characters 'ab' and return 2. heads :: (Monad m, Nullable s, LL.ListLike s el, Eq el) => s -> Iteratee s m Int-heads st | null st = return 0+heads st | nullC st = return 0 heads st = loop 0 st where loop cnt xs- | null xs = return cnt- | True = liftI (step cnt xs)- step cnt str (Chunk xs) | null xs = liftI (step cnt str)- step cnt str stream | null str = idone cnt stream+ | nullC xs = return cnt+ | otherwise = liftI (step cnt xs)+ step cnt str (Chunk xs) | nullC xs = liftI (step cnt str)+ step cnt str stream | nullC str = idone cnt stream step cnt str s@(Chunk xs) = if LL.head str == LL.head xs then step (succ cnt) (LL.tail str) (Chunk $ LL.tail xs)@@ -161,31 +208,31 @@ -- |Look ahead at the next element of the stream, without removing -- it from the stream. -- Return @Just c@ if successful, return @Nothing@ if the stream is--- terminated by EOF.-peek :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe el)+-- terminated by 'EOF'.+peek :: (LL.ListLike s el) => Iteratee s m (Maybe el) peek = liftI step where step s@(Chunk vec) | LL.null vec = liftI step- | True = idone (Just $ LL.head vec) s+ | otherwise = idone (Just $ LL.head vec) s step stream = idone Nothing stream {-# INLINE peek #-} --- | Return a chunk of `t' elements length, while consuming `d' elements--- from the stream. Useful for creating a "rolling average" with convStream.-roll :: (Monad m, Functor m, Nullable s, LL.ListLike s el, LL.ListLike s' s) =>- Int- -> Int+-- | Return a chunk of @t@ elements length while consuming @d@ elements+-- from the stream. Useful for creating a 'rolling average' with+-- 'convStream'.+roll+ :: (Monad m, Functor m, Nullable s, LL.ListLike s el, LL.ListLike s' s)+ => Int -- ^ length of chunk (t)+ -> Int -- ^ amount to consume (d) -> Iteratee s m s' roll t d | t > d = liftI step where step (Chunk vec)- | LL.length vec >= d =- idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec) | LL.length vec >= t =- idone (LL.singleton $ LL.take t vec) mempty <* drop (d-LL.length vec)+ idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec) | LL.null vec = liftI step- | True = liftI (step' vec)+ | otherwise = liftI (step' vec) step stream = idone LL.empty stream step' v1 (Chunk vec) = step . Chunk $ v1 `mappend` vec step' v1 stream = idone (LL.singleton v1) stream@@ -195,58 +242,106 @@ -- |Drop n elements of the stream, if there are that many.---+-- -- The analogue of @List.drop@-drop :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()-drop 0 = return ()+drop :: (Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()+drop 0 = idone () (Chunk empty) drop n' = liftI (step n') where step n (Chunk str)- | LL.length str <= n = liftI (step (n - LL.length str))- | True = idone () (Chunk (LL.drop n str))- step _ stream = idone () stream+ | LL.length str < n = liftI (step (n - LL.length str))+ | otherwise = idone () (Chunk (LL.drop n str))+ step _ stream = idone () stream {-# INLINE drop #-} -- |Skip all elements while the predicate is true.---+-- -- The analogue of @List.dropWhile@-dropWhile :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m ()+dropWhile :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m () dropWhile p = liftI step where step (Chunk str) | LL.null left = liftI step- | True = idone () (Chunk left)+ | otherwise = idone () (Chunk left) where left = LL.dropWhile p str step stream = idone () stream {-# INLINE dropWhile #-} --- |Return the total length of the remaining part of the stream.+-- | Return the total length of the remaining part of the stream.+-- -- This forces evaluation of the entire stream.---+-- -- The analogue of @List.length@-length :: (Monad m, Num a, LL.ListLike s el) => Iteratee s m a+length :: (Num a, LL.ListLike s el) => Iteratee s m a length = liftI (step 0) where- step !i (Chunk xs) = liftI (step $ i + LL.length xs)- step !i stream = idone (fromIntegral i) stream+ step !i (Chunk xs) = liftI (step $ i + fromIntegral (LL.length xs))+ step !i stream = idone i stream {-# INLINE length #-} +-- | Get the length of the current chunk, or @Nothing@ if 'EOF'.+-- +-- This function consumes no input.+chunkLength :: (LL.ListLike s el) => Iteratee s m (Maybe Int)+chunkLength = liftI step+ where+ step s@(Chunk xs) = idone (Just $ LL.length xs) s+ step stream = idone Nothing stream+{-# INLINE chunkLength #-} +-- | Take @n@ elements from the current chunk, or the whole chunk if+-- @n@ is greater.+takeFromChunk ::+ (Nullable s, LL.ListLike s el)+ => Int+ -> Iteratee s m s+takeFromChunk n | n <= 0 = idone empty (Chunk empty)+takeFromChunk n = liftI step+ where+ step (Chunk xs) = let (h,t) = LL.splitAt n xs in idone h $ Chunk t+ step stream = idone empty stream+{-# INLINE takeFromChunk #-}+ -- --------------------------------------------------- -- The converters show a different way of composing two iteratees: -- `vertical' rather than `horizontal' +-- |Takes an element predicate and an iteratee, running the iteratee+-- on all elements of the stream until the predicate is met.+-- +-- the following rule relates @break@ to @breakE@+-- @break@ pred === @joinI@ (@breakE@ pred stream2stream)+-- +-- @breakE@ should be used in preference to @break@ whenever possible.+breakE+ :: (LL.ListLike s el, NullPoint s)+ => (el -> Bool)+ -> Enumeratee s s m a+breakE cpred = eneeCheckIfDonePass (icont . step)+ where+ step k (Chunk s)+ | LL.null s = liftI (step k)+ | otherwise = case LL.break cpred s of+ (str', tail')+ | LL.null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'+ | otherwise -> idone (k $ Chunk str') (Chunk tail')+ step k stream = idone (liftI k) stream+{-# INLINE breakE #-}+ -- |Read n elements from a stream and apply the given iteratee to the -- stream of the read elements. Unless the stream is terminated early, we -- read exactly n elements, even if the iteratee has accepted fewer.---+-- -- The analogue of @List.take@-take :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a+take ::+ (Monad m, Nullable s, LL.ListLike s el)+ => Int -- ^ number of elements to consume+ -> Enumeratee s s m a take n' iter- | n' <= 0 = return iter- | True = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)+ | n' <= 0 = return iter+ | otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc) where on_done od oc x _ = runIter (drop n' >> return (return x)) od oc on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)@@ -255,188 +350,423 @@ step n k (Chunk str) | LL.null str = liftI (step n k) | LL.length str <= n = take (n - LL.length str) $ k (Chunk str)- | True = idone (k (Chunk s1)) (Chunk s2)+ | otherwise = idone (k (Chunk s1)) (Chunk s2) where (s1, s2) = LL.splitAt n str- step _n k stream = idone (k stream) stream-{-# SPECIALIZE take :: Monad m => Int -> Enumeratee [el] [el] m a #-}-{-# SPECIALIZE take :: Monad m => Int -> Enumeratee B.ByteString B.ByteString m a #-}-{-# SPECIALIZE take :: Monad m => Int -> Enumeratee BC.ByteString BC.ByteString m a #-}+ step _n k stream = idone (liftI k) stream+{-# INLINE take #-} -- |Read n elements from a stream and apply the given iteratee to the -- stream of the read elements. If the given iteratee accepted fewer -- elements, we stop.--- This is the variation of `take' with the early termination+-- This is the variation of 'take' with the early termination -- of processing of the outer stream once the processing of the inner stream -- finished early.------ N.B. If the inner iteratee finishes early, remaining data within the current--- chunk will be dropped.+-- +-- Iteratees composed with 'takeUpTo' will consume only enough elements to+-- reach a done state. Any remaining data will be available in the outer+-- stream.+-- +-- > > let iter = do+-- > h <- joinI $ takeUpTo 5 I.head+-- > t <- stream2list+-- > return (h,t)+-- > +-- > > enumPureNChunk [1..10::Int] 3 iter >>= run >>= print+-- > (1,[2,3,4,5,6,7,8,9,10])+-- > +-- > > enumPureNChunk [1..10::Int] 7 iter >>= run >>= print+-- > (1,[2,3,4,5,6,7,8,9,10])+-- +-- in each case, @I.head@ consumes only one element, returning the remaining+-- 4 elements to the outer stream takeUpTo :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a takeUpTo i iter- | i <= 0 = return iter+ | i <= 0 = idone iter (Chunk empty) | otherwise = Iteratee $ \od oc -> runIter iter (onDone od oc) (onCont od oc) where- onDone od oc x _ = runIter (return (return x)) od oc+ onDone od oc x str = runIter (idone (return x) str) od oc onCont od oc k Nothing = if i == 0 then od (liftI k) (Chunk mempty) else runIter (liftI (step i k)) od oc onCont od oc _ (Just e) = runIter (throwErr e) od oc step n k (Chunk str)- | LL.null str = liftI (step n k)- | LL.length str <= n = takeUpTo (n - LL.length str) $ k (Chunk str)- | True = idone (k (Chunk s1)) (Chunk s2)- where (s1, s2) = LL.splitAt n str- step _ k stream = idone (k stream) stream-{-# SPECIALIZE takeUpTo :: Monad m => Int -> Enumeratee [el] [el] m a #-}-{-# SPECIALIZE takeUpTo :: Monad m => Int -> Enumeratee B.ByteString B.ByteString m a #-}+ | LL.null str = liftI (step n k)+ | LL.length str < n = takeUpTo (n - LL.length str) $ k (Chunk str)+ | otherwise =+ -- check to see if the inner iteratee has completed, and if so,+ -- grab any remaining stream to put it in the outer iteratee.+ -- the outer iteratee is always complete at this stage, although+ -- the inner may not be.+ let (s1, s2) = LL.splitAt n str+ in Iteratee $ \od' _ -> do+ res <- runIter (k (Chunk s1)) (\a s -> return $ Left (a, s))+ (\k' e -> return $ Right (k',e))+ case res of+ Left (a,Chunk s1') -> od' (return a)+ (Chunk $ s1' `LL.append` s2)+ Left (a,s') -> od' (idone a s') (Chunk s2)+ Right (k',e) -> od' (icont k' e) (Chunk s2)+ step _ k stream = idone (liftI k) stream+{-# INLINE takeUpTo #-} +-- | Takes an element predicate and returns the (possibly empty)+-- prefix of the stream. All characters+-- in the string will satisfy the character predicate. If the stream+-- is not terminated, the first character of the+-- remaining stream will not satisfy the predicate.+-- +-- The analogue of @List.takeWhile@, see also @break@ and @takeWhileE@+takeWhile :: (LL.ListLike s el ) => (el -> Bool) -> Iteratee s m s+takeWhile = break . (not .)+{-# INLINEABLE takeWhile #-} +-- |Takes an element predicate and an iteratee, running the iteratee+-- on all elements of the stream while the predicate is met.+-- +-- This is preferred to @takeWhile@.+takeWhileE+ :: (LL.ListLike s el, NullPoint s)+ => (el -> Bool)+ -> Enumeratee s s m a+takeWhileE = breakE . (not .)+{-# INLINEABLE takeWhileE #-}+ -- |Map the stream: another iteratee transformer--- Given the stream of elements of the type @el@ and the function @el->el'@,+-- Given the stream of elements of the type @el@ and the function @(el->el')@, -- build a nested stream of elements of the type @el'@ and apply the -- given iteratee to it.---+-- -- The analog of @List.map@-mapStream ::- (Monad m,- LL.ListLike (s el) el,- LL.ListLike (s el') el',- NullPoint (s el),- LooseMap s el el') =>- (el -> el')- -> Enumeratee (s el) (s el') m a-mapStream f = eneeCheckIfDone (liftI . step)- where- step k (Chunk xs)- | LL.null xs = liftI (step k)- | True = mapStream f $ k (Chunk $ lMap f xs)- step k s = idone (liftI k) s-{-# SPECIALIZE mapStream :: Monad m => (el -> el') -> Enumeratee [el] [el'] m a #-}+mapStream+ :: (LL.ListLike (s el) el+ ,LL.ListLike (s el') el'+ ,NullPoint (s el)+ ,LooseMap s el el')+ => (el -> el')+ -> Enumeratee (s el) (s el') m a+mapStream f = mapChunks (lMap f)+{-# SPECIALIZE mapStream :: (el -> el') -> Enumeratee [el] [el'] m a #-} -- |Map the stream rigidly.---+-- -- Like 'mapStream', but the element type cannot change. -- This function is necessary for @ByteString@ and similar types -- that cannot have 'LooseMap' instances, and may be more efficient.-rigidMapStream ::- (Monad m, LL.ListLike s el, NullPoint s) =>- (el -> el)+rigidMapStream+ :: (LL.ListLike s el, NullPoint s)+ => (el -> el) -> Enumeratee s s m a-rigidMapStream f = eneeCheckIfDone (liftI . step)- where- step k (Chunk xs)- | LL.null xs = liftI (step k)- | True = rigidMapStream f $ k (Chunk $ LL.rigidMap f xs)- step k s = idone (liftI k) s-{-# SPECIALIZE rigidMapStream :: Monad m => (el -> el) -> Enumeratee [el] [el] m a #-}-{-# SPECIALIZE rigidMapStream :: Monad m => (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-}+rigidMapStream f = mapChunks (LL.rigidMap f)+{-# SPECIALIZE rigidMapStream :: (el -> el) -> Enumeratee [el] [el] m a #-}+{-# SPECIALIZE rigidMapStream :: (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-} -- |Creates an 'enumeratee' with only elements from the stream that -- satisfy the predicate function. The outer stream is completely consumed.---+-- -- The analogue of @List.filter@-filter ::- (Monad m, Nullable s, LL.ListLike s el) =>- (el -> Bool)+filter+ :: (Monad m, Functor m, Nullable s, LL.ListLike s el)+ => (el -> Bool) -> Enumeratee s s m a-filter p = convStream f'- where- f' = icont step Nothing- step (Chunk xs)- | LL.null xs = f'- | True = idone (LL.filter p xs) mempty- step _ = f'+filter p = convStream (LL.filter p <$> getChunk) {-# INLINE filter #-} +-- |Creates an 'Enumeratee' in which elements from the stream are+-- grouped into @sz@-sized blocks. The final block may be smaller+-- than \sz\.+group+ :: (LL.ListLike s el, Monad m, Nullable s)+ => Int -- ^ size of group+ -> Enumeratee s [s] m a+group cksz iinit = liftI (step 0 id iinit)+ where+ -- there are two cases to consider for performance purposes:+ -- 1 - grouping lots of small chunks into bigger chunks+ -- 2 - breaking large chunks into smaller pieces+ -- case 2 is easier, simply split a chunk into as many pieces as necessary+ -- and pass them to the inner iteratee as one list. @gsplit@ does this.+ --+ -- case 1 is a bit harder, need to hold onto each chunk and coalesce them+ -- after enough have been received. Currently using a difference list+ -- for this, i.e ([s] -> [s])+ --+ -- not using eneeCheckIfDone because that loses final chunks at EOF+ step sz pfxd icur (Chunk s)+ | LL.null s = liftI (step sz pfxd icur)+ | LL.length s + sz < cksz = liftI (step (sz+LL.length s) (pfxd . (s:)) icur)+ | otherwise =+ let (full, rest) = gsplit . mconcat $ pfxd [s]+ pfxd' = if LL.null rest then id else (rest:)+ onDone x str = return $ Left (x,str)+ onCont k Nothing = return . Right . Left . k $ Chunk full+ onCont k e = return . Right $ Right (liftI k, e)+ in do+ res <- lift $ runIter icur onDone onCont+ case res of+ Left (x,str) -> idone (idone x str) (Chunk rest)+ Right (Left inext) -> liftI $ step (LL.length rest) pfxd' inext+ Right (Right (inext, e)) -> icont (step (LL.length rest)+ pfxd' inext)+ e+ step _ pfxd icur mErr = case pfxd [] of+ [] -> idone icur mErr+ rest -> do+ inext <- lift $ enumPure1Chunk [mconcat rest] icur+ idone inext mErr+ gsplit ls = case LL.splitAt cksz ls of+ (g, rest) | LL.null rest -> if LL.length g == cksz+ then ([g], LL.empty)+ else ([], g)+ | otherwise -> let (grest, leftover) = gsplit rest+ g' = g : grest+ in (g', leftover)+++-- | Creates an 'enumeratee' in which elements are grouped into+-- contiguous blocks that are equal according to a predicate.+-- +-- The analogue of 'List.groupBy'+groupBy+ :: (LL.ListLike s el, Monad m, Nullable s)+ => (el -> el -> Bool)+ -> Enumeratee s [s] m a+groupBy same iinit = liftI $ go iinit (const True, id)+ where + -- As in group, need to handle grouping efficiently when we're fed+ -- many small chunks.+ -- + -- Move the accumulation of groups by chunks into an accumulator+ -- that runs through gsplit, which is pfx / partial here. When we+ -- get a chunk, use gsplit to retrieve any full chunks and get the+ -- carried accumulator.+ -- + -- At the end, "finish" the accumulator and handle the last chunk,+ -- unless the stream was entirely empty and there is no+ -- accumulator.+ go icurr pfx (Chunk s) = case gsplit pfx s of+ ([], partial) -> liftI $ go icurr partial+ (full, partial) -> do+ -- if the inner iteratee is done, the outer iteratee needs to be+ -- notified to terminate.+ -- if the inner iteratee is in an error state, that error should+ -- be lifted to the outer iteratee+ let onCont k Nothing = return $ Right $ Left $ k $ Chunk full+ onCont k e = return $ Right $ Right (liftI k, e)+ onDone x str = return $ Left (x,str)+ res <- lift $ runIter icurr onDone onCont+ case res of+ Left (x,str) -> idone (idone x str) (Chunk (mconcat $ snd partial []))+ Right (Left inext) -> liftI $ go inext partial+ Right (Right (inext,e)) -> icont (go inext partial) e+ go icurr (_inpfx, pfxd) (EOF mex) = case pfxd [] of+ [] -> lift . enumChunk (EOF mex) $ icurr+ rest -> do inext <- lift . enumPure1Chunk [mconcat rest] $ icurr+ lift . enumChunk (EOF mex) $ inext+ -- Here, gsplit carries an accumulator consisting of a predicate+ -- "inpfx" that indicates whether a new element belongs in the+ -- growing group, and a difference list to ultimately generate the+ -- group.+ --+ -- The initial accumulator is a group that can accept anything and+ -- is empty.+ -- + -- New chunks are split into groups. The cases are ++ -- 0. Trivially, empty chunk++ -- 1. One chunk, in the currently growing group: continue the+ -- current prefix (and generate a new predicate, in case we had+ -- the initial predicate+ + -- 2. One chunk, but not in the current group: finish the+ -- current group and return a new accumulator for the+ -- newly-started gorup+ + -- 3. Multiple chunks, the first of which completes the+ -- currently growing group+ + -- 4. Multiple chunks, the first of which is a new group+ -- separate from the currently-growing group+ gsplit (inpfx, pfxd) curr = case llGroupBy same curr of+ [] -> ([], (inpfx, pfxd))+ [g0] | inpfx (LL.head g0) -> ([], (same $ LL.head g0, pfxd . (g0 :)))+ | otherwise -> ([mconcat $ pfxd []], (same $ LL.head g0, pfxd . (g0 :)))+ (g0:grest@(_:_)) | inpfx (LL.head g0) -> let glast = Prelude.last grest+ gfirst = mconcat $ (pfxd . (g0 :)) []+ gdone = gfirst : Prelude.init grest+ in ( gdone, (same (LL.head glast), (glast :)) )+ | otherwise -> let glast = Prelude.last grest+ gfirst = mconcat $ pfxd []+ gdone = gfirst : Prelude.init grest+ in ( gdone, (same (LL.head glast), (glast :)) )+ llGroupBy eq l -- Copied from Data.ListLike, avoid spurious (Eq el) constraint+ | LL.null l = []+ | otherwise = (LL.cons x ys):(llGroupBy eq zs)+ where (ys, zs) = LL.span (eq x) xs+ x = LL.head l+ xs = LL.tail l++{-# INLINE groupBy #-}++-- | @merge@ offers another way to nest iteratees: as a monad stack.+-- This allows for the possibility of interleaving data from multiple+-- streams.+-- +-- > -- print each element from a stream of lines.+-- > logger :: (MonadIO m) => Iteratee [ByteString] m ()+-- > logger = mapM_ (liftIO . putStrLn . B.unpack)+-- >+-- > -- combine alternating lines from two sources+-- > -- To see how this was derived, follow the types from+-- > -- 'ileaveLines logger' and work outwards.+-- > run =<< enumFile 10 "file1" (joinI $ enumLinesBS $+-- > ( enumFile 10 "file2" . joinI . enumLinesBS $ joinI+-- > (ileaveLines logger)) >>= run)+-- > +-- > ileaveLines :: (Functor m, Monad m)+-- > => Enumeratee [ByteString] [ByteString] (Iteratee [ByteString] m)+-- > [ByteString]+-- > ileaveLines = merge (\l1 l2 ->+-- > [B.pack "f1:\n\t" ,l1 ,B.pack "f2:\n\t" ,l2 ]+-- > +-- > +-- +merge ::+ (LL.ListLike s1 el1+ ,LL.ListLike s2 el2+ ,Nullable s1+ ,Nullable s2+ ,Monad m+ ,Functor m)+ => (el1 -> el2 -> b)+ -> Enumeratee s2 b (Iteratee s1 m) a+merge f = convStream $ f <$> lift head <*> head+{-# INLINE merge #-}++-- | A version of merge which operates on chunks instead of elements.+-- +-- mergeByChunks offers more control than 'merge'. 'merge' terminates+-- when the first stream terminates, however mergeByChunks will continue+-- until both streams are exhausted.+-- +-- 'mergeByChunks' guarantees that both chunks passed to the merge function+-- will have the same number of elements, although that number may vary+-- between calls.+mergeByChunks ::+ (Nullable c2, Nullable c1+ ,NullPoint c2, NullPoint c1+ ,LL.ListLike c1 el1, LL.ListLike c2 el2+ ,Functor m, Monad m)+ => (c1 -> c2 -> c3) -- ^ merge function+ -> (c1 -> c3)+ -> (c2 -> c3)+ -> Enumeratee c2 c3 (Iteratee c1 m) a+mergeByChunks f f1 f2 = unfoldConvStream iter (0 :: Int)+ where+ iter 1 = (1,) . f1 <$> lift getChunk+ iter 2 = (2,) . f2 <$> getChunk+ iter _ = do+ ml1 <- lift chunkLength+ ml2 <- chunkLength+ case (ml1, ml2) of+ (Just l1, Just l2) -> do+ let tval = min l1 l2+ c1 <- lift $ takeFromChunk tval+ c2 <- takeFromChunk tval+ return (0, f c1 c2)+ (Just _, Nothing) -> iter 1+ (Nothing, _) -> iter 2+{-# INLINE mergeByChunks #-}+ -- ------------------------------------------------------------------------ -- Folds -- | Left-associative fold.---+-- -- The analogue of @List.foldl@-foldl ::- (Monad m, LL.ListLike s el, FLL.FoldableLL s el) =>- (a -> el -> a)+foldl+ :: (LL.ListLike s el, FLL.FoldableLL s el)+ => (a -> el -> a) -> a -> Iteratee s m a foldl f i = liftI (step i) where step acc (Chunk xs) | LL.null xs = liftI (step acc)- | True = liftI (step $ FLL.foldl f acc xs)+ | otherwise = liftI (step $ FLL.foldl f acc xs) step acc stream = idone acc stream {-# INLINE foldl #-} -- | Left-associative fold that is strict in the accumulator. -- This function should be used in preference to 'foldl' whenever possible.---+-- -- The analogue of @List.foldl'@.-foldl' ::- (Monad m, LL.ListLike s el, FLL.FoldableLL s el) =>- (a -> el -> a)+foldl'+ :: (LL.ListLike s el, FLL.FoldableLL s el)+ => (a -> el -> a) -> a -> Iteratee s m a foldl' f i = liftI (step i) where step acc (Chunk xs) | LL.null xs = liftI (step acc)- | True = liftI (step $! FLL.foldl' f acc xs)+ | otherwise = liftI (step $! FLL.foldl' f acc xs) step acc stream = idone acc stream {-# INLINE foldl' #-} -- | Variant of foldl with no base case. Requires at least one element -- in the stream.---+-- -- The analogue of @List.foldl1@.-foldl1 ::- (Monad m, LL.ListLike s el, FLL.FoldableLL s el) =>- (el -> el -> el)+foldl1+ :: (LL.ListLike s el, FLL.FoldableLL s el)+ => (el -> el -> el) -> Iteratee s m el foldl1 f = liftI step where step (Chunk xs) -- After the first chunk, just use regular foldl. | LL.null xs = liftI step- | True = foldl f $ FLL.foldl1 f xs+ | otherwise = foldl f $ FLL.foldl1 f xs step stream = icont step (Just (setEOF stream)) {-# INLINE foldl1 #-} -- | Strict variant of 'foldl1'.-foldl1' ::- (Monad m, LL.ListLike s el, FLL.FoldableLL s el) =>- (el -> el -> el)+foldl1'+ :: (LL.ListLike s el, FLL.FoldableLL s el)+ => (el -> el -> el) -> Iteratee s m el foldl1' f = liftI step where step (Chunk xs) -- After the first chunk, just use regular foldl'. | LL.null xs = liftI step- | True = foldl' f $ FLL.foldl1 f xs+ | otherwise = foldl' f $ FLL.foldl1 f xs step stream = icont step (Just (setEOF stream)) {-# INLINE foldl1' #-} -- | Sum of a stream.-sum :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el+sum :: (LL.ListLike s el, Num el) => Iteratee s m el sum = liftI (step 0) where step acc (Chunk xs) | LL.null xs = liftI (step acc)- | True = liftI (step $! acc + LL.sum xs)+ | otherwise = liftI (step $! acc + LL.sum xs) step acc str = idone acc str {-# INLINE sum #-} -- | Product of a stream.-product :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el+product :: (LL.ListLike s el, Num el) => Iteratee s m el product = liftI (step 1) where step acc (Chunk xs) | LL.null xs = liftI (step acc)- | True = liftI (step $! acc * LL.product xs)+ | otherwise = liftI (step $! acc * LL.product xs) step acc str = idone acc str {-# INLINE product #-} @@ -445,51 +775,300 @@ -- Zips -- |Enumerate two iteratees over a single stream simultaneously.---+-- Deprecated, use `Data.Iteratee.ListLike.zip` instead.+-- -- Compare to @zip@.-enumPair ::- (Monad m, Nullable s, LL.ListLike s el) =>- Iteratee s m a+{-# DEPRECATED enumPair "use Data.Iteratee.ListLike.zip" #-}+enumPair+ :: (Monad m, Nullable s, LL.ListLike s el)+ => Iteratee s m a -> Iteratee s m b- -> Iteratee s m (a,b)-enumPair i1 i2 = Iteratee $ \od oc -> runIter i1 (onDone od oc) (onCont od oc)+ -> Iteratee s m (a, b)+enumPair = zip++-- |Enumerate two iteratees over a single stream simultaneously.+-- +-- Compare to @List.zip@.+zip+ :: (Monad m, Nullable s, LL.ListLike s el)+ => Iteratee s m a+ -> Iteratee s m b+ -> Iteratee s m (a, b)+zip x0 y0 = do+ -- need to check if both iteratees are initially finished. If so,+ -- we don't want to push a chunk which will be dropped+ (a', x') <- lift $ runIter x0 od oc+ (b', y') <- lift $ runIter y0 od oc+ case checkDone a' b' of+ Just (Right (a,b,s)) -> idone (a,b) s -- 's' may be EOF, needs to stay+ Just (Left (Left a)) -> liftM (a,) y'+ Just (Left (Right b)) -> liftM (,b) x'+ Nothing -> liftI (step x' y') where- onDone od oc x s = runIter i2 (oD12 od oc x s) (onCont' od oc x)- oD12 od oc x1 s1 x2 s2 = runIter (idone (x1,x2) (longest s1 s2)) od oc- onCont od oc k mErr = runIter (icont (step k) mErr) od oc+ step x y (Chunk xs) | nullC xs = liftI (step x y)+ step x y (Chunk xs) = do+ (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x+ (b', y') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs y+ case checkDone a' b' of+ Just (Right (a,b,s)) -> idone (a,b) s+ Just (Left (Left a)) -> liftM (a,) y'+ Just (Left (Right b)) -> liftM (,b) x'+ Nothing -> liftI (step x' y')+ step x y (EOF err) = joinIM $ case err of+ Nothing -> (liftM2.liftM2) (,) (enumEof x) (enumEof y)+ Just e -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)++ od a s = return (Just (a, s), idone a s)+ oc k e = return (Nothing , icont k e)++ checkDone r1 r2 = case (r1, r2) of+ (Just (a, s1), Just (b,s2)) -> Just $ Right (a, b, shorter s1 s2)+ (Just (a, _), Nothing) -> Just . Left $ Left a+ (Nothing, Just (b, _)) -> Just . Left $ Right b+ (Nothing, Nothing) -> Nothing++ shorter c1@(Chunk xs) c2@(Chunk ys)+ | LL.length xs < LL.length ys = c1+ | otherwise = c2+ shorter e@(EOF _) _ = e+ shorter _ e@(EOF _) = e+{-# INLINE zip #-}++zip3+ :: (Monad m, Nullable s, LL.ListLike s el)+ => Iteratee s m a -> Iteratee s m b+ -> Iteratee s m c -> Iteratee s m (a, b, c)+zip3 a b c = zip a (zip b c) >>=+ \(r1, (r2, r3)) -> return (r1, r2, r3)+{-# INLINE zip3 #-}++zip4+ :: (Monad m, Nullable s, LL.ListLike s el)+ => Iteratee s m a -> Iteratee s m b+ -> Iteratee s m c -> Iteratee s m d+ -> Iteratee s m (a, b, c, d)+zip4 a b c d = zip a (zip3 b c d) >>=+ \(r1, (r2, r3, r4)) -> return (r1, r2, r3, r4)+{-# INLINE zip4 #-}++zip5+ :: (Monad m, Nullable s, LL.ListLike s el)+ => Iteratee s m a -> Iteratee s m b+ -> Iteratee s m c -> Iteratee s m d+ -> Iteratee s m e -> Iteratee s m (a, b, c, d, e)+zip5 a b c d e = zip a (zip4 b c d e) >>=+ \(r1, (r2, r3, r4, r5)) -> return (r1, r2, r3, r4, r5)+{-# INLINE zip5 #-}++-- | Enumerate over two iteratees in parallel as long as the first iteratee+-- is still consuming input. The second iteratee will be terminated with EOF+-- when the first iteratee has completed. An example use is to determine+-- how many elements an iteratee has consumed:+-- +-- > snd <$> enumWith (dropWhile (<5)) length+-- +-- Compare to @zip@+enumWith+ :: (Monad m, Nullable s, LL.ListLike s el)+ => Iteratee s m a+ -> Iteratee s m b+ -> Iteratee s m (a, b)+enumWith i1 i2 = do+ -- as with zip, first check to see if the initial iteratee is complete,+ -- otherwise data would be dropped.+ -- running the second iteratee as well to prevent a monadic effect mismatch+ -- although I think that would be highly unlikely to happen in common+ -- code+ (a', x') <- lift $ runIter i1 od oc+ (_, y') <- lift $ runIter i2 od oc+ case a' of+ Just (a, s) -> flip idone s =<< lift (liftM (a,) $ run i2)+ Nothing -> go x' y'+ where+ od a s = return (Just (a, s), idone a s)+ oc k e = return (Nothing , icont k e)++ getUsed xs (Chunk ys) = LL.take (LL.length xs - LL.length ys) xs+ getUsed xs (EOF _) = xs++ go x y = liftI step where- onCont' od oc x1 k mErr = runIter (icont (step2 x1 k) mErr) od oc- step k c@(Chunk str)- | null str = liftI (step k)- | True = lift (enumPure1Chunk str i2) >>= enumPair (k c)- step k s@(EOF Nothing) = lift (enumEof i2) >>= enumPair (k s)- step k s@(EOF (Just e)) = lift (enumErr e i2) >>= enumPair (k s)- step2 x1 k (Chunk str)- | null str = liftI (step2 x1 k)- step2 x1 k str = enumPair (return x1) (k str)- longest c1@(Chunk xs) c2@(Chunk ys) = if LL.length xs > LL.length ys- then c1 else c2- longest e@(EOF _) _ = e- longest _ e@(EOF _) = e-{-# INLINE enumPair #-}+ step (Chunk xs) | nullC xs = liftI step+ step (Chunk xs) = do+ (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x+ case a' of+ Just (a, s) -> do+ b <- lift $ run =<< enumPure1Chunk (getUsed xs s) y+ idone (a, b) s+ Nothing -> lift (enumPure1Chunk xs y) >>= go x'+ step (EOF err) = joinIM $ case err of+ Nothing -> (liftM2.liftM2) (,) (enumEof x) (enumEof y)+ Just e -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)+{-# INLINE enumWith #-} +-- |Enumerate a list of iteratees over a single stream simultaneously+-- and discard the results. This is a different behavior than Prelude's+-- sequence_ which runs iteratees in the list one after the other.+-- +-- Compare to @Prelude.sequence_@.+sequence_+ :: (Monad m, LL.ListLike s el, Nullable s)+ => [Iteratee s m a]+ -> Iteratee s m ()+sequence_ = self+ where+ self is = liftI step+ where+ step (Chunk xs) | LL.null xs = liftI step+ step s@(Chunk _) = do+ -- give a chunk to each iteratee+ is' <- lift $ mapM (enumChunk s) is+ -- filter done iteratees+ (done, notDone) <- lift $ partition fst `liftM` mapM enumCheckIfDone is'+ if Prelude.null notDone+ then idone () <=< remainingStream $ map snd done+ else self $ map snd notDone+ step s@(EOF _) = do+ s' <- remainingStream <=< lift $ mapM (enumChunk s) is+ case s' of+ EOF (Just e) -> throwErr e+ _ -> idone () s' + -- returns the unconsumed part of the stream; "sequence_ is" consumes as+ -- much of the stream as the iteratee in is that consumes the most; e.g.+ -- sequence_ [I.head, I.last] consumes whole stream+ remainingStream+ :: (Monad m, Nullable s, LL.ListLike s el)+ => [Iteratee s m a] -> Iteratee s m (Stream s)+ remainingStream is = lift $+ return . Prelude.foldl1 shorter <=< mapM (\i -> runIter i od oc) $ is+ where+ od _ s = return s+ oc _ e = return $ case e of+ Nothing -> mempty+ _ -> EOF e++ -- return the shorter one of two streams; errors are propagated with the+ -- priority given to the "left"+ shorter c1@(Chunk xs) c2@(Chunk ys)+ | LL.length xs < LL.length ys = c1+ | otherwise = c2+ shorter (EOF e1 ) (EOF e2 ) = EOF (e1 `mplus` e2)+ shorter e@(EOF _) _ = e+ shorter _ e@(EOF _) = e++-- |Transform an iteratee into one that keeps track of how much data it+-- consumes.+countConsumed :: forall a s el m n.+ (Monad m, LL.ListLike s el, Nullable s, Integral n) =>+ Iteratee s m a+ -> Iteratee s m (a, n)+countConsumed i = go 0 (const i) (Chunk empty)+ where+ go :: n -> (Stream s -> Iteratee s m a) -> Stream s+ -> Iteratee s m (a, n)+ go !n f str@(EOF _) = (, n) `liftM` f str+ go !n f str@(Chunk c) = Iteratee rI+ where+ newLen = n + fromIntegral (LL.length c)+ rI od oc = runIter (f str) onDone onCont+ where+ onDone a str'@(Chunk c') =+ od (a, newLen - fromIntegral (LL.length c')) str'+ onDone a str'@(EOF _) = od (a, n) str'+ onCont f' mExc = oc (go newLen f') mExc+{-# INLINE countConsumed #-}+ -- ------------------------------------------------------------------------ -- Enumerators -- |The pure n-chunk enumerator -- It passes a given stream of elements to the iteratee in @n@-sized chunks.-enumPureNChunk ::- (Monad m, LL.ListLike s el) => s -> Int -> Enumerator s m a+enumPureNChunk :: (Monad m, LL.ListLike s el) => s -> Int -> Enumerator s m a enumPureNChunk str n iter | LL.null str = return iter | n > 0 = enum' str iter- | True = error $ "enumPureNChunk called with n==" ++ show n+ | otherwise = error $ "enumPureNChunk called with n==" ++ show n where enum' str' iter' | LL.null str' = return iter'- | True = let (s1, s2) = LL.splitAt n str'+ | otherwise = let (s1, s2) = LL.splitAt n str' on_cont k Nothing = enum' s2 . k $ Chunk s1 on_cont k e = return $ icont k e in runIter iter' idoneM on_cont {-# INLINE enumPureNChunk #-}++-- | Convert an iteratee to a \"greedy\" version.+--+-- When a chunk is received, repeatedly run the input iteratee+-- until the entire chunk is consumed, then the outputs+-- are combined (via 'mconcat').+--+-- > > let l = [1..5::Int]+-- > > run =<< enumPure1Chunk l (joinI (take 2 stream2list))+-- > [1,2]+-- > > run =<< enumPure1Chunk l (greedy $ joinI (I.take 2 stream2list))+-- > [1,2,3,4,5]+--+-- Note that a greedy iteratee will consume the entire input chunk and force+-- the next chunk before returning a value. A portion of the second chunk may+-- be consumed.+-- +-- 'greedy' may be useful on the first parameter of 'convStream', e.g.+-- +-- > convStream (greedy someIter)+--+-- to create more efficient converters.+greedy ::+ (Monad m, Functor m, LL.ListLike s el', Monoid a) =>+ Iteratee s m a+ -> Iteratee s m a+greedy iter' = liftI (step [] iter')+ where+ step acc iter (Chunk str)+ | LL.null str = liftI (step acc iter)+ | otherwise = joinIM $ do+ i2 <- enumPure1Chunk str iter+ result <- runIter i2 (\a s -> return $ Left (a,s))+ (\k e -> return $ Right (icont k e))+ case result of+ Left (a, Chunk resS)+ | LL.null resS+ || LL.length resS == LL.length str -> return $+ idone (mconcat $ reverse (a:acc)) (Chunk resS)+ Left (a, stream) -> return $ step (a:acc) iter stream+ Right i -> return $ fmap (mconcat . reverse . (:acc)) i+ step acc iter stream = joinIM $+ enumChunk stream (fmap (mconcat . reverse . (:acc)) iter)+{-# INLINE greedy #-}++-- ------------------------------------------------------------------------+-- Monadic functions++-- | Map a monadic function over the elements of the stream and ignore the+-- result.+mapM_+ :: (Monad m, LL.ListLike s el, Nullable s)+ => (el -> m b)+ -> Iteratee s m ()+mapM_ f = liftI step+ where+ step (Chunk xs) | LL.null xs = liftI step+ step (Chunk xs) = lift (LL.mapM_ f xs) >> liftI step+ step s@(EOF _) = idone () s+{-# INLINE mapM_ #-}++-- |The analogue of @Control.Monad.foldM@+foldM+ :: (Monad m, LL.ListLike s b, Nullable s)+ => (a -> b -> m a)+ -> a+ -> Iteratee s m a+foldM f e = liftI step+ where+ step (Chunk xs) | LL.null xs = liftI step+ step (Chunk xs) = do+ x <- lift $ f e (LL.head xs)+ joinIM $ enumPure1Chunk (LL.tail xs) (foldM f x)+ step (EOF _) = return e+{-# INLINE foldM #-}
+ src/Data/Iteratee/PTerm.hs view
@@ -0,0 +1,282 @@+{-# LANGUAGE KindSignatures+ ,RankNTypes+ ,FlexibleContexts+ ,ScopedTypeVariables+ ,BangPatterns+ ,DeriveDataTypeable #-}++-- | Enumeratees - pass terminals variant.+-- +-- Provides enumeratees that pass terminal markers ('EOF') to the inner+-- 'iteratee'.+-- +-- Most enumeratees, upon receipt of @EOF@, will enter a done state and return+-- the inner iteratee without sending @EOF@ to it. This allows for composing+-- enumerators as in:+-- +-- > myEnum extraData i = do+-- > nested <- enumFile "file" (mapChunks unpacker i)+-- > inner <- run nested+-- > enumList extraData inner+-- +-- if @mapChunks unpacker@ sent 'EOF' to the inner iteratee @i@, there would+-- be no way to submit extra data to it after 'run'ing the result from+-- @enumFile@.+-- +-- In certain cases, this is not the desired behavior. Consider:+-- +-- > consumer :: Iteratee String IO ()+-- > consumer = liftI (go 0)+-- > where+-- > go c (Chunk xs) = liftIO (putStr s) >> liftI (go c)+-- > go 10 e = liftIO (putStr "10 loops complete")+-- > >> idone () (Chunk "")+-- > go n e = I.seek 0 >> liftI (go (n+1))+--+-- The @consumer@ iteratee does not complete until after it has received +-- 10 @EOF@s. If you attempt to use it in a standard enumeratee, it will+-- never terminate. When the outer enumeratee is terminated, the inner+-- iteratee will remain in a @cont@ state, but in general there is no longer+-- any valid data for the continuation. The enumeratee itself must pass the+-- EOF marker to the inner iteratee and remain in a cont state until the inner+-- iteratee signals its completion.+-- +-- All enumeratees in this module will pass 'EOF' terminators to the inner+-- iteratees.++module Data.Iteratee.PTerm (+ -- * Nested iteratee combinators+ mapChunksPT+ ,mapChunksMPT+ ,convStreamPT+ ,unfoldConvStreamPT+ ,unfoldConvStreamCheckPT+ -- * ListLike analog functions+ ,breakEPT+ ,takePT+ ,takeUpToPT+ ,takeWhileEPT+ ,mapStreamPT+ ,rigidMapStreamPT+ ,filterPT+)+where++import Prelude hiding (head, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product)++import Data.Iteratee.Iteratee+import Data.Iteratee.ListLike (drop)++import qualified Data.ListLike as LL++import Control.Applicative ((<$>))+import Control.Exception+import Control.Monad.Trans.Class++import qualified Data.ByteString as B+import Data.Monoid+import Data.Word (Word8)++-- ---------------------------------------------------+-- The converters show a different way of composing two iteratees:+-- `vertical' rather than `horizontal'++-- | Convert one stream into another with the supplied mapping function.+-- +-- A version of 'mapChunks' that sends 'EOF's to the inner iteratee.+-- +mapChunksPT :: (NullPoint s) => (s -> s') -> Enumeratee s s' m a+mapChunksPT f = eneeCheckIfDonePass (icont . step)+ where+ step k (Chunk xs) = eneeCheckIfDonePass (icont . step) . k . Chunk $ f xs+ step k (EOF mErr) = eneeCheckIfDonePass (icont . step) . k $ EOF mErr+{-# INLINE mapChunksPT #-}++-- | Convert a stream of @s@ to a stream of @s'@ using the supplied function.+-- +-- A version of 'mapChunksM' that sends 'EOF's to the inner iteratee.+mapChunksMPT+ :: (Monad m, NullPoint s, Nullable s)+ => (s -> m s')+ -> Enumeratee s s' m a+mapChunksMPT f = eneeCheckIfDonePass (icont . step)+ where+ step k (Chunk xs) = lift (f xs) >>=+ eneeCheckIfDonePass (icont . step) . k . Chunk+ step k (EOF mErr) = eneeCheckIfDonePass (icont . step) . k $ EOF mErr+{-# INLINE mapChunksMPT #-}++-- |Convert one stream into another, not necessarily in lockstep.+-- +-- A version of 'convStream' that sends 'EOF's to the inner iteratee.+convStreamPT+ :: (Monad m, Nullable s, NullPoint s')+ => Iteratee s m s'+ -> Enumeratee s s' m a+convStreamPT fi = go+ where+ go = eneeCheckIfDonePass check+ check k (Just e) = throwRecoverableErr e (const identity)+ >> go (k $ Chunk empty)+ check k _ = isStreamFinished >>= maybe (step k)+ (\e -> case fromException e of+ Just EofException -> go . k $ EOF Nothing+ Nothing -> go . k . EOF $ Just e)+ step k = fi >>= go . k . Chunk+{-# INLINABLE convStreamPT #-}++-- |The most general stream converter.+-- +-- A version of 'unfoldConvStream' that sends 'EOF's to the inner iteratee.+unfoldConvStreamPT ::+ (Monad m, Nullable s, NullPoint s') =>+ (acc -> Iteratee s m (acc, s'))+ -> acc+ -> Enumeratee s s' m a+unfoldConvStreamPT f acc0 = go acc0+ where+ go acc = eneeCheckIfDonePass (check acc)+ check acc k (Just e) = throwRecoverableErr e (const identity)+ >> go acc (k $ Chunk empty)+ check acc k _ = isStreamFinished >>= maybe (step acc k)+ (\e -> case fromException e of+ Just EofException -> go acc . k $ EOF Nothing+ Nothing -> go acc . k . EOF $ Just e)+ step acc k = f acc >>= \(acc', s') -> go acc' . k $ Chunk s'+{-+ check acc k _ = isStreamFinished >>=+ maybe (step acc k) (idone (liftI k) . EOF . Just)+ step acc k = f acc >>= \(acc', s') ->+ go acc' . k . Chunk $ s'+-}++-- | A version of 'unfoldConvStreamCheck' that sends 'EOF's+-- to the inner iteratee.+unfoldConvStreamCheckPT+ :: (Monad m, Nullable elo)+ => (((Stream eli -> Iteratee eli m a)+ -> Maybe SomeException+ -> Iteratee elo m (Iteratee eli m a)+ )+ -> Enumeratee elo eli m a+ )+ -> (acc -> Iteratee elo m (acc, eli))+ -> acc+ -> Enumeratee elo eli m a+unfoldConvStreamCheckPT checkDone f acc0 = checkDone (check acc0)+ where+ check acc k mX = step acc k mX+ step acc k Nothing = f acc >>= \(acc', s') ->+ (checkDone (check acc') . k $ Chunk s')+ step acc k (Just ex) = throwRecoverableErr ex $ \str' ->+ let i = f acc >>= \(acc', s') ->+ (checkDone (check acc') . k $ Chunk s')+ in joinIM $ enumChunk str' i+{-# INLINABLE unfoldConvStreamCheckPT #-}++-- -------------------------------------+-- ListLike variants++-- | A variant of 'Data.Iteratee.ListLike.breakE' that passes 'EOF's.+breakEPT+ :: (LL.ListLike s el, NullPoint s)+ => (el -> Bool)+ -> Enumeratee s s m a+breakEPT cpred = eneeCheckIfDonePass (icont . step)+ where+ step k (Chunk s)+ | LL.null s = liftI (step k)+ | otherwise = case LL.break cpred s of+ (str', tail')+ | LL.null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'+ | otherwise -> idone (k $ Chunk str') (Chunk tail')+ step k stream = idone (k stream) stream+{-# INLINE breakEPT #-}++-- | A variant of 'Data.Iteratee.ListLike.take' that passes 'EOF's.+takePT ::+ (Monad m, Nullable s, LL.ListLike s el)+ => Int -- ^ number of elements to consume+ -> Enumeratee s s m a+takePT n' iter+ | n' <= 0 = return iter+ | otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)+ where+ on_done od oc x _ = runIter (drop n' >> return (return x)) od oc+ on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)+ else runIter (liftI (step n' k)) od oc+ on_cont od oc _ (Just e) = runIter (drop n' >> throwErr e) od oc+ step n k (Chunk str)+ | LL.null str = liftI (step n k)+ | LL.length str <= n = takePT (n - LL.length str) $ k (Chunk str)+ | otherwise = idone (k (Chunk s1)) (Chunk s2)+ where (s1, s2) = LL.splitAt n str+ step _n k stream = idone (k stream) stream+{-# INLINE takePT #-}++-- | A variant of 'Data.Iteratee.ListLike.takeUpTo' that passes 'EOF's.+takeUpToPT :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a+takeUpToPT i iter+ | i <= 0 = idone iter (Chunk empty)+ | otherwise = Iteratee $ \od oc ->+ runIter iter (onDone od oc) (onCont od oc)+ where+ onDone od oc x str = runIter (idone (return x) str) od oc+ onCont od oc k Nothing = if i == 0 then od (liftI k) (Chunk mempty)+ else runIter (liftI (step i k)) od oc+ onCont od oc _ (Just e) = runIter (throwErr e) od oc+ step n k (Chunk str)+ | LL.null str = liftI (step n k)+ | LL.length str < n = takeUpToPT (n - LL.length str) $ k (Chunk str)+ | otherwise =+ -- check to see if the inner iteratee has completed, and if so,+ -- grab any remaining stream to put it in the outer iteratee.+ -- the outer iteratee is always complete at this stage, although+ -- the inner may not be.+ let (s1, s2) = LL.splitAt n str+ in Iteratee $ \od' _ -> do+ res <- runIter (k (Chunk s1)) (\a s -> return $ Left (a, s))+ (\k' e -> return $ Right (k',e))+ case res of+ Left (a,Chunk s1') -> od' (return a)+ (Chunk $ s1' `LL.append` s2)+ Left (a,s') -> od' (idone a s') (Chunk s2)+ Right (k',e) -> od' (icont k' e) (Chunk s2)+ step _ k stream = idone (k stream) stream+{-# INLINE takeUpToPT #-}++-- | A variant of 'Data.Iteratee.ListLike.takeWhileE' that passes 'EOF's.+takeWhileEPT+ :: (LL.ListLike s el, NullPoint s)+ => (el -> Bool)+ -> Enumeratee s s m a+takeWhileEPT = breakEPT . (not .)+{-# INLINEABLE takeWhileEPT #-}++-- | A variant of 'Data.Iteratee.ListLike.mapStream' that passes 'EOF's.+mapStreamPT+ :: (LL.ListLike (s el) el+ ,LL.ListLike (s el') el'+ ,NullPoint (s el)+ ,LooseMap s el el')+ => (el -> el')+ -> Enumeratee (s el) (s el') m a+mapStreamPT f = mapChunksPT (lMap f)+{-# SPECIALIZE mapStreamPT :: (el -> el') -> Enumeratee [el] [el'] m a #-}++-- | A variant of 'Data.Iteratee.ListLike.rigidMapStream' that passes 'EOF's.+rigidMapStreamPT+ :: (LL.ListLike s el, NullPoint s)+ => (el -> el)+ -> Enumeratee s s m a+rigidMapStreamPT f = mapChunksPT (LL.rigidMap f)+{-# SPECIALIZE rigidMapStreamPT :: (el -> el) -> Enumeratee [el] [el] m a #-}+{-# SPECIALIZE rigidMapStreamPT :: (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-}++-- | A variant of 'Data.Iteratee.ListLike.filter' that passes 'EOF's.+filterPT+ :: (Monad m, Functor m, Nullable s, LL.ListLike s el)+ => (el -> Bool)+ -> Enumeratee s s m a+filterPT p = convStreamPT (LL.filter p <$> getChunk)+{-# INLINE filterPT #-}
+ src/Data/Iteratee/Parallel.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE NoMonomorphismRestriction, BangPatterns #-}++module Data.Iteratee.Parallel (+ psequence_+ -- ,psequence+ ,parE+ ,parI+ ,liftParI+ ,mapReduce+)++where++import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Iteratee as I hiding (mapM_, zip, filter)+import qualified Data.ListLike as LL++import Data.Monoid++import Control.Concurrent+import Control.Parallel+import Control.Monad++-- | Transform usual Iteratee into parallel composable one, introducing+-- one step extra delay.+-- +-- Ex - time spent in Enumerator working on x'th packet+-- Ix - time spent in Iteratee working on x'th packet+-- z - last packet, y = (z-1)'th packet+-- +-- regular Iteratee: E0 - I0, E1 - I1, E2 - I2 .. Ez -> Iz+-- parallel Iteratee: E0, E1, E2, .. Ez+-- \_ I0\_ I1\_ .. Iy\__ Iz+-- +parI :: (Nullable s, Monoid s) => Iteratee s IO a -> Iteratee s IO a+parI = liftI . firstStep+ where+ -- first step, here we fork separete thread for the next chain and at the+ -- same time ask for more date from the previous chain+ firstStep iter chunk = do+ var <- liftIO newEmptyMVar+ _ <- sideStep var chunk iter+ liftI $ go var++ -- somewhere in the middle, we are getting iteratee from previous step,+ -- feeding it with some new data, asking for more data and starting+ -- more processing in separete thread+ go var chunk@(Chunk _) = do+ iter <- liftIO $ takeMVar var+ _ <- sideStep var chunk iter+ liftI $ go var++ -- final step - no more data, so we need to inform our consumer about it+ go var e = do+ iter <- liftIO $ takeMVar var+ join . lift $ enumChunk e iter++ -- forks away from the main computation, return results via MVar+ sideStep var chunk iter = liftIO . forkIO $ runIter iter onDone onCont+ where+ onDone a s = putMVar var $ idone a s+ onCont k _ = runIter (k chunk) onDone onFina+ onFina k e = putMVar var $ icont k e++-- | Transform an Enumeratee into a parallel composable one, introducing+-- one step extra delay, see 'parI'.+parE ::+ (Nullable s1, Nullable s2, Monoid s1)+ => Enumeratee s1 s2 IO r+ -> Enumeratee s1 s2 IO r+parE outer inner = parI (outer inner)++-- | Enumerate a list of iteratees over a single stream simultaneously+-- and discard the results. Each iteratee runs in a separate forkIO thread,+-- passes all errors from iteratees up.+psequence_ ::+ (LL.ListLike s el, Nullable s)+ => [Iteratee s IO a]+ -> Iteratee s IO ()+psequence_ = I.sequence_ . map parI+++{-+-- | Enumerate a list of iteratees over a single stream simultaneously+-- and keeps the results. Each iteratee runs in a separete forkIO thread, passes all+-- errors from iteratees up.+psequence = I.sequence . map parI+-}++-- | A variant of 'parI' with the parallelized iteratee lifted into an+-- arbitrary MonadIO.+liftParI ::+ (Nullable s, Monoid s, MonadIO m)+ => Iteratee s IO a+ -> Iteratee s m a+liftParI = ilift liftIO . parI++-- | Perform a parallel map/reduce. The `bufsize` parameter controls+-- the maximum number of chunks to read at one time. A larger bufsize+-- allows for greater parallelism, but will require more memory.+--+-- Implementation of `sum`+--+-- > sum :: (Monad m, LL.ListLike s, Nullable s) => Iteratee s m Int64+-- > sum = getSum <$> mapReduce 4 (Sum . LL.sum)+mapReduce ::+ (Monad m, Nullable s, Monoid b)+ => Int -- ^ maximum number of chunks to read+ -> (s -> b) -- ^ map function+ -> Iteratee s m b+mapReduce bufsize f = liftI (step (0, []))+ where+ step a@(!buf,acc) (Chunk xs)+ | nullC xs = liftI (step a)+ | buf >= bufsize =+ let acc' = mconcat acc+ b' = f xs+ in b' `par` acc' `pseq` liftI (step (0,[b' `mappend` acc']))+ | otherwise =+ let b' = f xs+ in b' `par` liftI (step (succ buf,b':acc))+ step (_,acc) s@(EOF Nothing) =+ idone (mconcat acc) s+ step acc (EOF (Just err)) =+ throwRecoverableErr err (step acc)+
src/Data/NullPoint.hs view
@@ -9,6 +9,7 @@ where import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L -- ---------------------------------------------- -- |NullPoint class. Containers that have a null representation, corresponding@@ -22,3 +23,5 @@ instance NullPoint B.ByteString where empty = B.empty +instance NullPoint L.ByteString where+ empty = L.empty
src/Data/Nullable.hs view
@@ -9,16 +9,20 @@ import Data.NullPoint import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L -- ---------------------------------------------- -- |Nullable container class class NullPoint c => Nullable c where- null :: c -> Bool+ nullC :: c -> Bool instance Nullable [a] where- null [] = True- null _ = False+ nullC [] = True+ nullC _ = False instance Nullable B.ByteString where- null = B.null+ nullC = B.null++instance Nullable L.ByteString where+ nullC = L.null
tests/QCUtils.hs view
@@ -43,7 +43,11 @@ ns <- arbitrary elements [ I.drop n >> stream2list+ ,I.drop n >> return ns ,I.break (< 5) ,I.heads ns >> stream2list ,I.peek >> stream2list+ ,I.peek >> return ns+ ,I.identity >> return []+ ,I.identity >> return ns ]
− tests/benchmarkHandle.hs
@@ -1,50 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Main where--import Prelude hiding (null, length)-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import Criterion.Main-import Data.Word-import Data.Iteratee-import Data.Iteratee.Base.ReadableChunk-import Data.Iteratee.IO.Fd (fileDriverFd)-import Data.Iteratee.IO.Handle (fileDriverHandle)--bufSize = 65536-file = "/usr/share/dict/words"--length' :: Monad m => Iteratee ByteString m Int-length' = length--testFdString :: IO ()-testFdString = fileDriverFd bufSize len file >> return ()- where- len :: Monad m => Iteratee String m Int- len = length--testFdByte :: IO ()-testFdByte = fileDriverFd bufSize len file >> return ()- where- len :: Monad m => Iteratee ByteString m Int- len = length--testHdString :: IO ()-testHdString = fileDriverHandle bufSize len file >> return ()- where- len :: Monad m => Iteratee String m Int- len = length--testHdByte :: IO ()-testHdByte = fileDriverHandle bufSize len file >> return ()- where- len :: Monad m => Iteratee ByteString m Int- len = length--main = defaultMain- [ bench "Fd with String" testFdString- , bench "Hd with String" testHdString- , bench "Fd with ByteString" testFdByte- , bench "Hd with ByteString" testHdByte- ]
− tests/benchmarks.hs
@@ -1,188 +0,0 @@-{-# LANGUAGE RankNTypes, KindSignatures, NoMonomorphismRestriction #-}---- some basic benchmarking of iteratee--module Main where--import Data.Iteratee-import qualified Data.Iteratee.ListLike as I-import Data.Iteratee.ListLike (enumPureNChunk, stream2list, stream2stream)-import Data.Word-import Data.Monoid-import qualified Data.ByteString as BS-import Control.Monad.Identity-import Control.Monad-import qualified Data.ListLike as LL-import Control.DeepSeq--import Criterion.Main--main = defaultMain [allListBenches, allByteStringBenches]---- ---------------------------------------------------------------- helper functions and data---- |Hold information about a benchmark. This allows each--- benchmark (and baseline) to be created independently of the stream types,--- for easy comparison of different streams.--- BDList is for creating baseline comparison functions. Although the name--- is BDList, it will work for any stream type (e.g. bytestrings).-data BD a b s (m :: * -> *) = BDIter1 String (a -> b) (Iteratee s m a) - | BDIterN String Int (a -> b) (Iteratee s m a)- | BDList String (s -> b) s--id1 name i = BDIter1 name id i-idN name i = BDIterN name 5 id i--makeList name f = BDList name f [1..10000]--makeBench :: BD n eval [Int] Identity -> Benchmark-makeBench (BDIter1 n eval i) = bench n $- proc eval runIdentity (enumPure1Chunk [1..10000]) i-makeBench (BDIterN n csize eval i) = bench n $- proc eval runIdentity (enumPureNChunk [1..10000] csize) i-makeBench (BDList n f l) = bench n $ whnf f l--packedBS :: BS.ByteString-packedBS = (BS.pack [1..10000])--makeBenchBS (BDIter1 n eval i) = bench n $- proc eval runIdentity (enumPure1Chunk packedBS) i-makeBenchBS (BDIterN n csize eval i) = bench n $- proc eval runIdentity (enumPureNChunk packedBS csize) i-makeBenchBS (BDList n f l) = error "makeBenchBS can't be called on BDList"--proc :: (Functor m, Monad m)- => (a -> b) --function to force evaluation of result- -> (m a -> a)- -> I.Enumerator s m a- -> I.Iteratee s m a- -> Pure-proc eval runner enum iter = whnf (eval . runner . (I.run <=< enum)) iter--defaultProc = proc id runIdentity (enumPure1Chunk [1..10000])-defaultNProc = proc id runIdentity (enumPureNChunk [1..10000] 5)---- ---------------------------------------------------------------- benchmark groups-makeGroup n = bgroup n . map makeBench--makeGroupBS :: String -> [BD t t1 BS.ByteString Identity] -> Benchmark-makeGroupBS n = bgroup n . map makeBenchBS--listbench = makeGroup "stream2List" (slistBenches :: [BD [Int] () [Int] Identity])-streambench = makeGroup "stream" (streamBenches :: [BD [Int] () [Int] Identity])-breakbench = makeGroup "break" $ break0 : break0' : breakBenches-headsbench = makeGroup "heads" headsBenches-dropbench = makeGroup "drop" $ drop0 : dropBenches-lengthbench = makeGroup "length" listBenches-takebench = makeGroup "take" $ take0 : takeBenches---takeRbench = makeGroup "takeR" $ takeR0 : takeRBenches-takeRbench = makeGroup "takeR" []-mapbench = makeGroup "map" $ mapBenches-convbench = makeGroup "convStream" convBenches-miscbench = makeGroup "other" miscBenches--listbenchbs = makeGroupBS "stream2List" slistBenches-streambenchbs = makeGroupBS "stream" streamBenches-breakbenchbs = makeGroupBS "break" breakBenches-headsbenchbs = makeGroupBS "heads" headsBenches-dropbenchbs = makeGroupBS "drop" dropBenches-lengthbenchbs = makeGroupBS "length" listBenches-takebenchbs = makeGroupBS "take" takeBenches-takeRbenchbs = makeGroupBS "takeR" takeRBenches-mapbenchbs = makeGroupBS "map" mapBenches-convbenchbs = makeGroupBS "convStream" convBenches-miscbenchbs = makeGroupBS "other" miscBenches---allListBenches = bgroup "list" [listbench, streambench, breakbench, headsbench, dropbench, lengthbench, takebench, takeRbench, mapbench, convbench, miscbench]--allByteStringBenches = bgroup "bytestring" [listbenchbs, streambenchbs, breakbenchbs, headsbenchbs, dropbenchbs, lengthbenchbs, takebenchbs, takeRbenchbs, mapbenchbs, convbenchbs, miscbenchbs]--list0 = makeList "list one go" deepseq-list1 = BDIter1 "stream2list one go" (flip deepseq ()) stream2list-list2 = BDIterN "stream2list chunk by 4" 4 (flip deepseq ()) stream2list-list3 = BDIterN "stream2list chunk by 1024" 1024 (flip deepseq ()) stream2list-slistBenches = [list1, list2, list3]--stream1 = BDIter1 "stream2stream one go" (flip deepseq ()) stream2stream-stream2 = BDIterN "stream2stream chunk by 4" 4 (flip deepseq ()) stream2stream-stream3 = BDIterN "stream2stream chunk by 1024" 1024 (flip deepseq ()) stream2stream-streamBenches = [stream1, stream2, stream3]--break0 = makeList "break early list" (fst . Prelude.break (>5))-break0' = makeList "break never list" (fst . Prelude.break (<0))-break1 = id1 "break early one go" (I.break (>5))-break2 = id1 "break never" (I.break (<0)) -- not ever true.-break3 = idN "break early chunked" (I.break (>500))-break4 = idN "break never chunked" (I.break (<0)) -- not ever true-break5 = idN "break late chunked" (I.break (>8000))-breakBenches = [break1, break2, break3, break4, break5]--heads1 = id1 "heads null" (I.heads $ LL.fromList [])-heads2 = id1 "heads 1" (I.heads $ LL.fromList [1])-heads3 = id1 "heads 100" (I.heads $ LL.fromList [1..100])-heads4 = idN "heads 100 over chunks" (I.heads $ LL.fromList [1..100])-headsBenches = [heads1, heads2, heads3, heads4]--benchpeek = id1 "peek" I.peek-benchskip = id1 "skipToEof" (I.skipToEof >> return Nothing)-miscBenches = [benchpeek, benchskip]--drop0 = makeList "drop plain (list only)"- ( flip seq () . Prelude.drop 100)-drop1 = id1 "drop null" (I.drop 0)-drop2 = id1 "drop plain" (I.drop 100)-drop3 = idN "drop over chunks" (I.drop 100)--dropw0 = makeList "dropWhile all (list only)" (Prelude.dropWhile (const True))-dropw1 = id1 "dropWhile all" (I.dropWhile (const True))-dropw2 = idN "dropWhile all chunked" (I.dropWhile (const True))-dropw3 = id1 "dropWhile small" (I.dropWhile ( < 100))-dropw4 = id1 "dropWhile large" (I.dropWhile ( < 6000))-dropBenches = [drop1, drop2, drop3, dropw1, dropw2, dropw3, dropw4]---l1 = makeList "length of list" Prelude.length-l2 = id1 "length single iteratee" I.length-l3 = idN "length chunked" I.length-listBenches = [l2, l3]--take0 = makeList "take length of list long" (Prelude.length . Prelude.take 1000)-take1 = id1 "take head short one go" (I.joinI $ I.take 20 I.head)-take2 = id1 "take head long one go" (I.joinI $ I.take 1000 I.head)-take3 = idN "take head short chunked" (I.joinI $ I.take 20 I.head)-take4 = idN "take head long chunked" (I.joinI $ I.take 1000 I.head)-take5 = id1 "take length long one go" (I.joinI $ I.take 1000 I.length)-take6 = idN "take length long chunked" (I.joinI $ I.take 1000 I.length)-takeBenches = [take1, take2, take3, take4, take5, take6]--{--takeR0 = makeList "take length of list long" (Prelude.length . Prelude.take 1000)-takeR1 = id1 "takeR head short one go" (I.joinI $ I.take 20 I.head)-takeR2 = id1 "takeR head long one go" (I.joinI $ I.takeR 1000 I.head)-takeR3 = idN "takeR head short chunked" (I.joinI $ I.takeR 20 I.head)-takeR4 = idN "takeR head long chunked" (I.joinI $ I.takeR 1000 I.head)-takeR5 = id1 "takeR length long one go" (I.joinI $ I.takeR 1000 I.length)-takeR6 = idN "takeR length long chunked" (I.joinI $ I.takeR 1000 I.length)-takeRBenches = [takeR1, takeR2, takeR3, takeR4, takeR5, takeR6]--}-takeRBenches = []--map1 = id1 "map length one go" (I.joinI $ I.rigidMapStream id I.length)-map2 = idN "map length chunked" (I.joinI $ I.rigidMapStream id I.length)-map3 = id1 "map head one go" (I.joinI $ I.rigidMapStream id I.head)-map4 = idN "map head chunked" (I.joinI $ I.rigidMapStream id I.head)-mapBenches = [map1, map2, map3, map4]--conv1 = idN "convStream id head chunked" (I.joinI . I.convStream idChunk $ I.head)-conv2 = idN "convStream id length chunked" (I.joinI . I.convStream idChunk $ I.length)-idChunk = I.liftI step- where- step (I.Chunk xs)- | LL.null xs = idChunk- | True = idone xs (I.Chunk mempty)-convBenches = [conv1, conv2]--instance NFData BS.ByteString where
tests/testIteratee.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -O #-}-{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoMonomorphismRestriction, ViewPatterns, TupleSections #-} import Prelude as P @@ -7,18 +7,22 @@ import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit import Test.QuickCheck -import Data.Iteratee hiding (head, break)+import Data.Iteratee hiding (head, break) import qualified Data.Iteratee.Char as IC import qualified Data.Iteratee as Iter-import Data.Functor.Identity-import Data.Monoid+import Data.Functor.Identity+import qualified Data.List as List (groupBy, unfoldr)+import Data.Monoid import qualified Data.ListLike as LL -import Text.Printf (printf)-import System.Environment (getArgs)+import Control.Monad as CM+import Control.Monad.Writer+import Control.Exception (SomeException) instance Show (a -> b) where show _ = "<<function>>"@@ -52,8 +56,8 @@ -- --------------------------------------------- -- Iteratee instances -runner0 = runIdentity . Iter.run runner1 = runIdentity . Iter.run . runIdentity+enumSpecial xs n = enumPure1Chunk LL.empty >=> enumPureNChunk xs n prop_iterFmap xs f a = runner1 (enumPure1Chunk xs (fmap f $ return a)) == runner1 (enumPure1Chunk xs (return $ f a))@@ -63,15 +67,15 @@ == f (runner1 (enumPure1Chunk xs i)) where types = (xs :: [Int], i :: I, f :: [Int] -> [Int]) -prop_iterMonad1 xs a f = runner1 (enumPureNChunk xs 1 (return a >>= f))+prop_iterMonad1 xs a f = runner1 (enumSpecial xs 1 (return a >>= f)) == runner1 (enumPure1Chunk xs (f a)) where types = (xs :: [Int], a :: Int, f :: Int -> I) -prop_iterMonad2 m xs = runner1 (enumPureNChunk xs 1 (m >>= return))+prop_iterMonad2 m xs = runner1 (enumSpecial xs 1 (m >>= return)) == runner1 (enumPure1Chunk xs m) where types = (xs :: [Int], m :: I) -prop_iterMonad3 m f g xs = runner1 (enumPureNChunk xs 1 ((m >>= f) >>= g))+prop_iterMonad3 m f g xs = runner1 (enumSpecial xs 1 ((m >>= f) >>= g)) == runner1 (enumPure1Chunk xs (m >>= (\x -> f x >>= g))) where types = (xs :: [Int], m :: I, f :: [Int] -> I, g :: [Int] -> I) @@ -81,7 +85,7 @@ prop_list xs = runner1 (enumPure1Chunk xs stream2list) == xs where types = xs :: [Int] -prop_clist xs n = n > 0 ==> runner1 (enumPureNChunk xs n stream2list) == xs+prop_clist xs n = n > 0 ==> runner1 (enumSpecial xs n stream2list) == xs where types = xs :: [Int] prop_break f xs = runner1 (enumPure1Chunk xs (Iter.break f)) == fst (break f xs)@@ -90,15 +94,28 @@ prop_break2 f xs = runner1 (enumPure1Chunk xs (Iter.break f >> stream2list)) == snd (break f xs) where types = xs :: [Int] +prop_breakE f xs = runner1 (enumPure1Chunk xs (joinI $ Iter.breakE f stream2stream)) == fst (break f xs)+ where types = xs :: [Int]++prop_breakE2 f xs = runner1 (enumPure1Chunk xs (joinI (Iter.breakE f stream2stream) >> stream2list)) == snd (break f xs)+ where types = xs :: [Int]++ prop_head xs = P.length xs > 0 ==> runner1 (enumPure1Chunk xs Iter.head) == head xs where types = xs :: [Int] prop_head2 xs = P.length xs > 0 ==> runner1 (enumPure1Chunk xs (Iter.head >> stream2list)) == tail xs where types = xs :: [Int] -prop_heads xs = runner1 (enumPure1Chunk xs $ heads xs) == P.length xs+prop_tryhead xs = case xs of+ [] -> runner1 (enumPure1Chunk xs tryHead) == Nothing+ _ -> runner1 (enumPure1Chunk xs tryHead) == Just (P.head xs) where types = xs :: [Int] +prop_heads xs n = n > 0 ==>+ runner1 (enumSpecial xs n $ heads xs) == P.length xs+ where types = xs :: [Int]+ prop_heads2 xs = runner1 (enumPure1Chunk xs $ heads [] >>= \c -> stream2list >>= \s -> return (c,s)) == (0, xs)@@ -116,13 +133,56 @@ prop_skip xs = runner1 (enumPure1Chunk xs (skipToEof >> stream2list)) == [] where types = xs :: [Int] +prop_last1 xs = P.length xs > 0 ==>+ runner1 (enumPure1Chunk xs (Iter.last)) == P.last xs+ where types = xs :: [Int]++prop_last2 xs = P.length xs > 0 ==>+ runner1 (enumPure1Chunk xs (Iter.last >> Iter.peek)) == Nothing+ where types = xs :: [Int]++prop_drop xs n k = (n > 0 && k >= 0) ==>+ runner1 (enumSpecial xs n (Iter.drop k >> stream2list)) == P.drop k xs+ where types = xs :: [Int]++prop_dropWhile f xs =+ runner1 (enumPure1Chunk xs (Iter.dropWhile f >> stream2list))+ == P.dropWhile f xs+ where types = (xs :: [Int], f :: Int -> Bool)++prop_length xs = runner1 (enumPure1Chunk xs Iter.length) == P.length xs+ where types = xs :: [Int]++-- length 0 is an odd case. enumPureNChunk skips null inputs, returning+-- the original iteratee, which is then given to `enumEof` by `run`.+-- This is different from enumPure1Chunk, which will provide a null chunk+-- to the iteratee.+-- +-- not certain ATM which should be correct...+prop_chunkLength xs n = n > 0 ==>+ runner1 (enumPureNChunk xs n (liftM2 (,) chunkLength stream2list))+ == case P.length xs of+ 0 -> (Nothing, xs)+ xl | xl >= n -> (Just n, xs)+ | otherwise -> (Just (P.length xs), xs)+ where types = xs :: [Int]++prop_chunkLength2 xs =+ runner1 ((enumEof >=> enumPure1Chunk xs) chunkLength) == Nothing+ where types = xs :: [Int]++prop_takeFromChunk xs n k = n > 0 ==>+ runner1 (enumPureNChunk xs n (liftM2 (,) (takeFromChunk k) stream2list))+ == if k > n then splitAt n xs else splitAt k xs+ where types = xs :: [Int]+ -- --------------------------------------------- -- Simple enumerator tests type I = Iteratee [Int] Identity [Int] prop_enumChunks n xs i = n > 0 ==>- runner1 (enumPure1Chunk xs i) == runner1 (enumPureNChunk xs n i)+ runner1 (enumPure1Chunk xs i) == runner1 (enumSpecial xs n i) where types = (n :: Int, xs :: [Int], i :: I) prop_app1 xs ys i = runner1 (enumPure1Chunk ys (joinIM $ enumPure1Chunk xs i))@@ -154,7 +214,41 @@ runner1 (enumPure1Chunk xs =<< enumPure1Chunk [] Iter.head) == runner1 (enumPure1Chunk xs Iter.head) where types = xs :: [Int]++prop_enumList xs i =+ not (P.null xs) ==>+ runner1 (enumList (replicate 100 xs) i)+ == runner1 (enumPure1Chunk (concat $ replicate 100 xs) i)+ where types = (xs :: [Int], i :: I)++prop_enumCheckIfDone xs i =+ runner1 (enumPure1Chunk xs (lift (enumCheckIfDone i) >>= snd))+ == runner1 (enumPure1Chunk xs i)+ where types = (xs :: [Int], i :: I)+ -- ---------------------------------------------+-- Enumerator Combinators++prop_enumWith xs f n = n > 0 ==> runner1 (enumSpecial xs n $ fmap fst $ enumWith (Iter.dropWhile f) (stream2list))+ == runner1 (enumSpecial xs n $ Iter.dropWhile f)+ where types = (xs :: [Int])++prop_enumWith2 xs f n = n > 0 ==> runner1 (enumSpecial xs n $ enumWith (Iter.dropWhile f) (stream2list) >> stream2list)+ == runner1 (enumSpecial xs n $ Iter.dropWhile f >> stream2list)+ where types = (xs :: [Int])++prop_enumWith3 xs i n =+ n > 0+ ==> runner1 (enumSpecial xs n $ enumWith i stream2list >> stream2list)+ == runner1 (enumSpecial xs n (i >> stream2list))+ where types = (xs :: [Int], i :: I)++prop_countConsumed (Positive (min (2^10) -> n)) (Positive (min (2^20) -> a)) (Positive k) =+ runner1 (enumPureNChunk [1..] n iter) == (a, a)+ where+ iter = countConsumed . joinI $ (takeUpTo (a + k) ><> Iter.take a) Iter.last++-- --------------------------------------------- -- Nested Iteratees -- take, mapStream, convStream, and takeR@@ -166,7 +260,7 @@ where types = (i :: I, xs :: [Int]) prop_mapStream2 xs n i = n > 0 ==>- runner2 (enumPureNChunk xs n $ mapStream id i)+ runner2 (enumSpecial xs n $ mapStream id i) == runner1 (enumPure1Chunk xs i) where types = (i :: I, xs :: [Int]) @@ -175,7 +269,33 @@ == runner1 (enumPure1Chunk xs i) where types = (i :: I, xs :: [Int]) +prop_rigidMapStream xs n f = n > 0 ==>+ runner2 (enumSpecial xs n $ rigidMapStream f stream2list) == map f xs+ where types = (xs :: [Int]) +prop_foldl xs n f x0 = n > 0 ==>+ runner1 (enumSpecial xs n (Iter.foldl f x0)) == P.foldl f x0 xs+ where types = (xs :: [Int], x0 :: Int)++prop_foldl' xs n f x0 = n > 0 ==>+ runner1 (enumSpecial xs n (Iter.foldl' f x0)) == LL.foldl' f x0 xs+ where types = (xs :: [Int], x0 :: Int)++prop_foldl1 xs n f = (n > 0 && not (null xs)) ==>+ runner1 (enumSpecial xs n (Iter.foldl1 f)) == P.foldl1 f xs+ where types = (xs :: [Int])++prop_foldl1' xs n f = (n > 0 && not (null xs)) ==>+ runner1 (enumSpecial xs n (Iter.foldl1' f)) == P.foldl1 f xs+ where types = (xs :: [Int])++prop_sum xs n = n > 0 ==> runner1 (enumSpecial xs n Iter.sum) == P.sum xs+ where types = (xs :: [Int])++prop_product xs n = n > 0 ==>+ runner1 (enumSpecial xs n Iter.product) == P.product xs+ where types = (xs :: [Int])+ convId :: (LL.ListLike s el, Monad m) => Iteratee s m s convId = liftI (\str -> case str of s@(Chunk xs) | LL.null xs -> convId@@ -216,7 +336,144 @@ == runner2 (enumPure1Chunk xs $ takeUpTo n stream2list) where types = xs :: [Int] +prop_takeUpTo2 xs n = n >= 0 ==>+ runner2 (enumPure1Chunk xs (takeUpTo n identity)) == ()+ where types = xs :: [Int]++-- check for final stream state+prop_takeUpTo3 xs n d t = n > 0 ==>+ runner1 (enumPureNChunk xs n (joinI (takeUpTo t (Iter.drop d)) >> stream2list))+ == P.drop (min t d) xs+ where types = xs :: [Int]++prop_takeWhile xs n f = n > 0 ==>+ runner1 (enumSpecial xs n (liftM2 (,) (Iter.takeWhile f) stream2list))+ == (P.takeWhile f xs, P.dropWhile f xs)+ where types = xs :: [Int]++prop_filter xs n f = n > 0 ==>+ runner2 (enumSpecial xs n (Iter.filter f stream2list)) == P.filter f xs+ where types = xs :: [Int]++prop_group xs n = n > 0 ==>+ runner2 (enumPure1Chunk xs $ Iter.group n stream2list)+ == runner1 (enumPure1Chunk groups stream2list)+ where types = xs :: [Int]+ groups :: [[Int]]+ groups = List.unfoldr groupOne xs+ where groupOne [] = Nothing+ groupOne elts@(_:_) = Just . splitAt n $ elts+ +prop_groupBy xs = forAll (choose (2,5)) $ \m ->+ let pred z1 z2 = (z1 `mod` m == z2 `mod` m)+ in runner2 (enumPure1Chunk xs $ Iter.groupBy pred stream2list)+ == runner1 (enumPure1Chunk (List.groupBy pred xs) stream2list)+ where types = xs :: [Int]++prop_mapChunksM xs n = n > 0 ==>+ runWriter ((enumSpecial xs n (joinI $ Iter.mapChunksM f stream2list)) >>= run)+ == (xs, Sum (P.length xs))+ where f ck = tell (Sum $ P.length ck) >> return ck+ types = xs :: [Int]+{-+prop_mapjoin xs i =+ runIdentity (run (joinI . runIdentity $ enumPure1Chunk xs $ mapStream id i))+ == runner1 (enumPure1Chunk xs i)+ where types = (i :: I, xs :: [Int])+-}++prop_mapChunksM_ xs n = n > 0 ==>+ snd (runWriter ((enumSpecial xs n (Iter.mapChunksM_ f)) >>= run))+ == Sum (P.length xs)+ where f ck = tell (Sum $ P.length ck)+ types = xs :: [Int]++prop_mapM_ xs n = n > 0 ==>+ runWriter ((enumSpecial xs n (Iter.mapM_ f)) >>= run)+ == runWriter (CM.mapM_ f xs)+ where f = const $ tell (Sum 1)+ types = xs :: [Int]++prop_foldChunksM xs x0 n = n > 0 ==>+ runWriter ((enumSpecial xs n (Iter.foldChunksM f x0)) >>= run)+ == runWriter (f x0 xs)+ where f acc ck = CM.foldM f' acc ck+ f' acc el = tell (Sum 1) >> return (acc+el)+ types = xs :: [Int]++prop_foldM xs x0 n = n > 0 ==>+ runWriter ((enumSpecial xs n (Iter.foldM f x0)) >>= run)+ == runWriter (CM.foldM f x0 xs)+ where f acc el = tell (Sum 1) >> return (acc - el)+ types = xs :: [Int] -- ---------------------------------------------+-- Zips++prop_zip xs i1 i2 n = n > 0 ==>+ runner1 (enumPureNChunk xs n $ liftM2 (,) (Iter.zip i1 i2) stream2list)+ == let (r1, t1) = runner1 $ enumPure1Chunk xs $ liftM2 (,) i1 stream2list+ (r2, t2) = runner1 $ enumPure1Chunk xs $ liftM2 (,) i2 stream2list+ shorter = if P.length t1 > P.length t2 then t2 else t1+ in ((r1,r2), shorter)+ where types = (i1 :: I, i2 :: I, xs :: [Int])++-- ---------------------------------------------+-- Sequences++test_sequence_ =+ assertEqual "sequence_: no duplicate runs" ((),[4,5])+ (runWriter (Iter.enumList [[4],[5::Int]] (Iter.sequence_ [iter])+ >>= run))+ where+ iter = do+ x <- Iter.head+ lift $ tell [x]+ y <- Iter.head+ lift $ tell [y]++-- ---------------------------------------------+-- Data.Iteratee.PTerm++mk_prop_pt_id etee p_etee i xs n = n > 0 ==>+ runner1 (enumSpecial xs n $ joinI (p_etee i))+ == runner1 (enumSpecial xs n $ joinI (etee i))+ where types = (etee, p_etee, i, xs) :: (Etee, Etee, Itee, [Int])++instance Eq SomeException where+ l == r = show l == show r++type Etee = Enumeratee [Int] [Int] Identity [Int]+type Itee = Iteratee [Int] Identity [Int]++prop_mapChunksPT f i = mk_prop_pt_id (mapChunks f) (mapChunksPT f)+ where types = (i :: Itee)++prop_mapChunksMPT f i =+ mk_prop_pt_id (mapChunksM (return . f)) (mapChunksMPT (return . f))+ where types = (i :: Itee)++-- would like to test with arbitrary iteratees, but we need to guarantee+-- that they will return a value from the stream, which isn't always true+-- for the arbitrary instance.+-- could use a newtype to make it work...+prop_convStreamPT = mk_prop_pt_id (convStream getChunk) (convStreamPT getChunk)++prop_unfoldConvStreamPT f =+ mk_prop_pt_id (unfoldConvStream f' (0 :: Int)) (unfoldConvStreamPT f' 0)+ where f' x = fmap (f x,) getChunk++prop_breakEPT i = mk_prop_pt_id (breakE i) (breakEPT i)+prop_takePT i = mk_prop_pt_id (Iter.take i) (takePT i)+prop_takeUpToPT i = mk_prop_pt_id (Iter.takeUpTo i) (takeUpToPT i)+prop_takeWhileEPT i = mk_prop_pt_id (Iter.takeWhileE i) (takeWhileEPT i)++prop_mapStreamPT i = mk_prop_pt_id (Iter.mapStream i) (mapStreamPT i)+prop_rigidMapStreamPT i =+ mk_prop_pt_id (Iter.rigidMapStream i) (rigidMapStreamPT i)+prop_filterPT i = mk_prop_pt_id (Iter.filter i) (filterPT i)+++-- --------------------------------------------- -- Data.Iteratee.Char {-@@ -244,13 +501,22 @@ ] ,testGroup "Simple Iteratees" [ testProperty "break" prop_break- ,testProperty "break remaineder" prop_break2+ ,testProperty "break remainder" prop_break2 ,testProperty "head" prop_head ,testProperty "head remainder" prop_head2+ ,testProperty "tryhead" prop_tryhead ,testProperty "heads" prop_heads ,testProperty "null heads" prop_heads2 ,testProperty "peek" prop_peek ,testProperty "peek2" prop_peek2+ ,testProperty "last" prop_last1+ ,testProperty "last ends properly" prop_last2+ ,testProperty "length" prop_length+ ,testProperty "chunkLength" prop_chunkLength+ ,testProperty "chunkLength of EoF" prop_chunkLength2+ ,testProperty "takeFromChunk" prop_takeFromChunk+ ,testProperty "drop" prop_drop+ ,testProperty "dropWhile" prop_dropWhile ,testProperty "skipToEof" prop_skip ,testProperty "iteratee Functor 1" prop_iterFmap ,testProperty "iteratee Functor 2" prop_iterFmap2@@ -268,21 +534,70 @@ ,testProperty "isFinished error" prop_isFinished2 ,testProperty "null data idempotence" prop_null ,testProperty "null data head idempotence" prop_nullH+ ,testProperty "enumList" prop_enumList+ ,testProperty "enumCheckIfDone" prop_enumCheckIfDone ] ,testGroup "Nested iteratees" [ testProperty "mapStream identity" prop_mapStream ,testProperty "mapStream identity 2" prop_mapStream2 ,testProperty "mapStream identity joinI" prop_mapjoin+ ,testProperty "rigidMapStream" prop_rigidMapStream+ ,testProperty "breakE" prop_breakE+ ,testProperty "breakE remainder" prop_breakE2 ,testProperty "take" prop_take ,testProperty "take (finished iteratee)" prop_take2 ,testProperty "takeUpTo" prop_takeUpTo+ ,testProperty "takeUpTo (finished iteratee)" prop_takeUpTo2+ ,testProperty "takeUpTo (remaining stream)" prop_takeUpTo3+ ,testProperty "takeWhile" prop_takeWhile+ ,testProperty "filter" prop_filter+ ,testProperty "group" prop_group+ ,testProperty "groupBy" prop_groupBy ,testProperty "convStream EOF" prop_convstream2 ,testProperty "convStream identity" prop_convstream ,testProperty "convStream identity 2" prop_convstream3 ]+ ,testGroup "Enumerator Combinators" [+ testProperty "enumWith" prop_enumWith+ ,testProperty "enumWith remaining" prop_enumWith2+ ,testProperty "enumWith remaining 2" prop_enumWith3+ ,testProperty "countConsumed" prop_countConsumed+ ]+ ,testGroup "Folds" [+ testProperty "foldl" prop_foldl+ ,testProperty "foldl'" prop_foldl'+ ,testProperty "foldl1" prop_foldl1+ ,testProperty "foldl1'" prop_foldl1'+ ,testProperty "sum" prop_sum+ ,testProperty "product" prop_product+ ]+ ,testGroup "Zips" [+ testProperty "zip" prop_zip+ ,testCase "sequence_" test_sequence_+ ] ,testGroup "Data.Iteratee.Char" [ --testProperty "line" prop_line ]+ ,testGroup "PT variants" [+ testProperty "mapChunksPT" prop_mapChunksPT+ ,testProperty "mapChunksMPT" prop_mapChunksMPT+ ,testProperty "convStreamPT" prop_convStreamPT+ ,testProperty "unfoldConvStreamPT" prop_unfoldConvStreamPT+ ,testProperty "breakEPT" prop_breakEPT+ ,testProperty "takePT" prop_takePT+ ,testProperty "takeUpToPT" prop_takeUpToPT+ ,testProperty "takeWhileEPT" prop_takeWhileEPT+ ,testProperty "mapStreamPT" prop_mapStreamPT+ ,testProperty "rigidMapStreamPT" prop_rigidMapStreamPT+ ,testProperty "filterPT" prop_filterPT+ ]+ ,testGroup "Monadic functions" [+ testProperty "mapM_" prop_mapM_+ ,testProperty "foldM" prop_foldM+ ,testProperty "mapChunksM" prop_mapChunksM+ ,testProperty "mapChunksM_" prop_mapChunksM_+ ,testProperty "foldChunksM" prop_foldChunksM+ ] ] ------------------------------------------------------------------------