iteratee-0.8.9.4/0000755000000000000000000000000012021512063011652 5ustar0000000000000000iteratee-0.8.9.4/README0000644000000000000000000000176112021512063012537 0ustar0000000000000000This library implements enumerator/iteratee style I/O, as described at http://okmij.org/ftp/Haskell/Iteratee/ INSTALLATION INSTRUCTIONS: This library uses the Hackage/Cabal build system. You will need a working Haskell compiler and appropriate build system. This is most easily met by installing the Haskell Platform. The following command will install the library: cabal install iteratee This library is pure Haskell, and should install on any system with a suitable Haskell compiler with no extra steps required. In particular, POSIX-compatible, Mac OSX, and Windows should all be supported. INSTALLATION OPTIONS: This library supports the following cabal flags: splitBase (default enabled): use the split-up base package. buildTests (default disabled): build a test executable. NOTES: -The Data.Iteratee.IO.Posix module is only available on Posix systems. -The Data.Iteratee.IO.Windows module is currently a stub. Currently only the standard Handle interface is available on Windows. iteratee-0.8.9.4/iteratee.cabal0000644000000000000000000000421212021512063014437 0ustar0000000000000000name: iteratee version: 0.8.9.4 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 license: BSD3 license-file: LICENSE homepage: http://www.tiresiaspress.us/haskell/iteratee tested-with: GHC == 7.6.0, GHC == 7.4.2 stability: experimental cabal-version: >= 1.10 build-type: Simple extra-source-files: CONTRIBUTORS README Examples/*.hs Examples/*.lhs Examples/*.txt tests/*.hs bench/*.hs library default-language: Haskell2010 hs-source-dirs: src if os(windows) cpp-options: -DUSE_WINDOWS exposed-modules: Data.Iteratee.IO.Windows else cpp-options: -DUSE_POSIX exposed-modules: Data.Iteratee.IO.Posix Data.Iteratee.IO.Fd build-depends: unix >= 2 && < 3 build-depends: base >= 3 && < 6, ListLike >= 3.0 && < 4, MonadCatchIO-transformers > 0.2 && < 0.4, monad-control == 0.3.* , bytestring >= 0.9 && < 0.11, containers >= 0.2 && < 0.6, parallel >= 2 && < 4, transformers >= 0.2 && < 0.4, transformers-base >= 0.4 && < 0.5 exposed-modules: Data.Nullable Data.NullPoint Data.Iteratee Data.Iteratee.Base Data.Iteratee.Base.ReadableChunk Data.Iteratee.Base.LooseMap Data.Iteratee.Binary Data.Iteratee.Char 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 -O2 if impl(ghc >= 6.8) ghc-options: -fwarn-tabs source-repository head type: darcs location: http://www.tiresiaspress.us/haskell/iteratee iteratee-0.8.9.4/CONTRIBUTORS0000644000000000000000000000047612021512063013541 0ustar0000000000000000Thanks 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 iteratee-0.8.9.4/LICENSE0000644000000000000000000000277412021512063012671 0ustar0000000000000000Copyright (c) Oleg Kiselyov, John Lato, Paulo Tanimoto Portions by Oleg Kiselyov are in Public Domain. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. iteratee-0.8.9.4/Setup.hs0000644000000000000000000000017512021512063013311 0ustar0000000000000000#! /usr/bin/runhaskell module Main (main) where import Distribution.Simple (defaultMain) main :: IO () main = defaultMain iteratee-0.8.9.4/tests/0000755000000000000000000000000012021512063013014 5ustar0000000000000000iteratee-0.8.9.4/tests/QCUtils.hs0000644000000000000000000000270512021512063014700 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-} module QCUtils where import Test.QuickCheck import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen import Data.Iteratee import Data.Iteratee.Iteratee import qualified Data.Iteratee as I import qualified Data.ListLike as LL import Data.Functor.Identity import Control.Applicative import Control.Exception -- Show instance instance (Show a, LL.ListLike s el) => Show (Iteratee s Identity a) where show = (++) "<> " . show . runIdentity . run -- Arbitrary instances instance Arbitrary c => Arbitrary (Stream c) where arbitrary = do err <- arbitrary xs <- arbitrary elements [EOF err, Chunk xs] tE :: Exception e => e -> SomeException tE = toException instance Arbitrary SomeException where arbitrary = do str <- arbitrary off <- fromInteger <$> (arbitrary :: Gen Integer) elements [tE DivergentException, tE (SeekException off), tE EofException, iterStrExc str] instance (Num a, Ord a, Arbitrary a, Monad m) => Arbitrary (Iteratee [a] m [a]) where arbitrary = do n <- suchThat arbitrary (>0) 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 ] iteratee-0.8.9.4/tests/testIteratee.hs0000644000000000000000000005261612021512063016024 0ustar0000000000000000{-# OPTIONS_GHC -O #-} {-# LANGUAGE NoMonomorphismRestriction, ViewPatterns, TupleSections #-} import Prelude as P import QCUtils 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 qualified Data.Iteratee.Char as IC import qualified Data.Iteratee as Iter import Data.Functor.Identity import qualified Data.List as List (groupBy, unfoldr) import Data.Monoid import qualified Data.ListLike as LL import Control.Monad as CM import Control.Monad.Writer import Control.Exception (SomeException) instance Show (a -> b) where show _ = "<>" -- --------------------------------------------- -- Stream instances type ST = Stream [Int] prop_eq str = str == str where types = str :: ST prop_mempty = mempty == (Chunk [] :: Stream [Int]) prop_mappend str1 str2 | isChunk str1 && isChunk str2 = str1 `mappend` str2 == Chunk (chunkData str1 ++ chunkData str2) prop_mappend str1 str2 = isEOF $ str1 `mappend` str2 where types = (str1 :: ST, str2 :: ST) prop_mappend2 str = str `mappend` mempty == mempty `mappend` str where types = str :: ST isChunk (Chunk _) = True isChunk (EOF _) = False chunkData (Chunk xs) = xs isEOF (EOF _) = True isEOF (Chunk _) = False -- --------------------------------------------- -- Iteratee instances 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)) where types = (xs :: [Int], f :: Int -> Int, a :: Int) prop_iterFmap2 xs f i = runner1 (enumPure1Chunk xs (fmap f i)) == f (runner1 (enumPure1Chunk xs i)) where types = (xs :: [Int], i :: I, f :: [Int] -> [Int]) 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 (enumSpecial xs 1 (m >>= return)) == runner1 (enumPure1Chunk xs m) where types = (xs :: [Int], m :: I) 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) -- --------------------------------------------- -- List <-> Stream prop_list xs = runner1 (enumPure1Chunk xs stream2list) == xs where types = xs :: [Int] 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) where types = xs :: [Int] 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_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) where types = xs :: [Int] prop_peek xs = runner1 (enumPure1Chunk xs peek) == sHead xs where types = xs :: [Int] sHead [] = Nothing sHead (x:_) = Just x prop_peek2 xs = runner1 (enumPure1Chunk xs (peek >> stream2list)) == xs where types = xs :: [Int] 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 (enumSpecial xs n i) where types = (n :: Int, xs :: [Int], i :: I) prop_app1 xs ys i = runner1 (enumPure1Chunk ys (joinIM $ enumPure1Chunk xs i)) == runner1 (enumPure1Chunk (xs ++ ys) i) where types = (xs :: [Int], ys :: [Int], i :: I) prop_app2 xs ys = runner1 ((enumPure1Chunk xs >>> enumPure1Chunk ys) stream2list) == runner1 (enumPure1Chunk (xs ++ ys) stream2list) where types = (xs :: [Int], ys :: [Int]) prop_app3 xs ys i = runner1 ((enumPure1Chunk xs >>> enumPure1Chunk ys) i) == runner1 (enumPure1Chunk (xs ++ ys) i) where types = (xs :: [Int], ys :: [Int], i :: I) prop_eof xs ys i = runner1 (enumPure1Chunk ys $ runIdentity $ (enumPure1Chunk xs >>> enumEof) i) == runner1 (enumPure1Chunk xs i) where types = (xs :: [Int], ys :: [Int], i :: I) prop_isFinished = runner1 (enumEof (isFinished :: Iteratee [Int] Identity Bool)) == True prop_isFinished2 = runner1 (enumErr (iterStrExc "Error") (isFinished :: Iteratee [Int] Identity Bool)) == True prop_null xs i = runner1 (enumPure1Chunk xs =<< enumPure1Chunk [] i) == runner1 (enumPure1Chunk xs i) where types = (xs :: [Int], i :: I) prop_nullH xs = P.length xs > 0 ==> 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 runner2 = runIdentity . run . runner1 prop_mapStream xs i = runner2 (enumPure1Chunk xs $ mapStream id i) == runner1 (enumPure1Chunk xs i) where types = (i :: I, xs :: [Int]) prop_mapStream2 xs n i = n > 0 ==> runner2 (enumSpecial xs n $ mapStream id i) == runner1 (enumPure1Chunk xs i) where types = (i :: I, 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_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 s@(Chunk xs) -> idone xs (Chunk mempty) s@(EOF e) -> idone mempty (EOF e) ) prop_convId xs = runner1 (enumPure1Chunk xs convId) == xs where types = xs :: [Int] prop_convstream xs i = P.length xs > 0 ==> runner2 (enumPure1Chunk xs $ convStream convId i) == runner1 (enumPure1Chunk xs i) where types = (xs :: [Int], i :: I) prop_convstream2 xs = P.length xs > 0 ==> runner2 (enumPure1Chunk xs $ convStream convId Iter.head) == runner1 (enumPure1Chunk xs Iter.head) where types = xs :: [Int] prop_convstream3 xs = P.length xs > 0 ==> runner2 (enumPure1Chunk xs $ convStream convId stream2list) == runner1 (enumPure1Chunk xs stream2list) where types = xs :: [Int] prop_take xs n = n >= 0 ==> runner2 (enumPure1Chunk xs $ Iter.take n stream2list) == runner1 (enumPure1Chunk (P.take n xs) stream2list) where types = xs :: [Int] prop_take2 xs n = n > 0 ==> runner2 (enumPure1Chunk xs $ Iter.take n peek) == runner1 (enumPure1Chunk (P.take n xs) peek) where types = xs :: [Int] prop_takeUpTo xs n = n >= 0 ==> runner2 (enumPure1Chunk xs $ Iter.take n stream2list) == 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 {- -- this isn't true, since lines "\r" returns ["\r"], and IC.line should -- return Right "". Not sure what a real test would be... prop_line xs = P.length xs > 0 ==> fromEither (runner1 (enumPure1Chunk xs $ IC.line)) == head (lines xs) where types = xs :: [Char] fromEither (Left l) = l fromEither (Right l) = l -} -- --------------------------------------------- tests = [ testGroup "Elementary" [ testProperty "list" prop_list ,testProperty "chunkList" prop_clist] ,testGroup "Stream tests" [ testProperty "mempty" prop_mempty ,testProperty "mappend" prop_mappend ,testProperty "mappend associates" prop_mappend2 ,testProperty "eq" prop_eq ] ,testGroup "Simple Iteratees" [ testProperty "break" prop_break ,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 ,testProperty "iteratee Monad LI" prop_iterMonad1 ,testProperty "iteratee Monad RI" prop_iterMonad2 ,testProperty "iteratee Monad Assc" prop_iterMonad3 ] ,testGroup "Simple Enumerators/Combinators" [ testProperty "enumPureNChunk" prop_enumChunks ,testProperty "enum append 1" prop_app1 ,testProperty "enum sequencing" prop_app2 ,testProperty "enum sequencing 2" prop_app3 ,testProperty "enumEof" prop_eof ,testProperty "isFinished" prop_isFinished ,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 ] ] ------------------------------------------------------------------------ -- The entry point main = defaultMain tests iteratee-0.8.9.4/tests/fusion2.hs0000644000000000000000000001516212021512063014742 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-} module Main where import Data.Iteratee as I import Criterion.Main import Control.Monad.Identity import Control.Monad.Trans runner :: Enumeratee [Int] xs Identity a -> [Int] -> Iteratee xs Identity a -> a runner etee xs iter = runIdentity $ enumPureNChunk xs 5 (joinI $ etee iter) >>= I.run -- test fusion of enumeratee/iteratee composition runner2 :: Enumeratee [Int] xs Identity a -> [Int] -> Iteratee xs Identity a -> a runner2 etee xs iter = runIdentity $ enumPureNChunk xs 5 (etee =$ iter) >>= I.run -- test fusion of enumerator/enumeratee composition runner3 :: Enumeratee [Int] xs Identity a -> [Int] -> Iteratee xs Identity a -> a runner3 etee xs iter = runIdentity $ (enumPureNChunk xs 5 $= etee) iter >>= I.run m2 :: Enumeratee [Int] [Int] Identity a m2 = mapChunks id ><> mapChunks (map (+1)) m3 :: Enumeratee [Int] [Int] Identity a m3 = mapChunks id ><> mapChunks (map (+1)) ><> I.filter (even) m4 :: Enumeratee [Int] [Int] Identity a m4 = m2 ><> m2 m10 :: Enumeratee [Int] [Int] Identity a m10 = m3 ><> m2 ><> m3 ><> m2 fusedMap :: Iteratee [Int] Identity a -> a fusedMap = runner m2 [1..100] fusedMap3 :: Iteratee [Int] Identity a -> a fusedMap3 = runner m3 [1..100] fusedMap4 :: Iteratee [Int] Identity a -> a fusedMap4 = runner m4 [1..100] fusedMap10 :: Iteratee [Int] Identity a -> a fusedMap10 = runner m10 [1..100] -- experiment with using stream-fusion like constructs for -- enumeratees data StreamF m b a = forall s. StreamF (s -> m (Step s b a)) !s data Step s b a = Done | Yield [a] !s | Next (b -> P2 [a] s) data P2 a b = P2 !a !b map_t :: Monad m => (a -> b) -> StreamF m a b map_t fn = StreamF loop () where loop () = return (Next (\a -> P2 [fn a] () )) {-# INLINE map_t #-} filter_t :: Monad m => (a -> Bool) -> StreamF m a a filter_t pred = StreamF loop () where loop () = return (Next (\a -> P2 (if pred a then [a] else []) ()) ) {-# INLINE filter_t #-} cmp_t :: Monad m => StreamF m a b -> StreamF m b c -> StreamF m a c cmp_t (StreamF fn1 s1_0) (StreamF fn2 s2_0) = StreamF loop (s1_0,s2_0,[]) where loop (s1,s2,supply) = fn2 s2 >>= \r2 -> case r2 of Done -> return Done Yield cS s2' -> return $ Yield cS (s1,s2',supply) Next fn -> case supply of (b:bS) -> let P2 cS s2' = fn b in return $ Yield cS (s1,s2',bS) [] -> fn1 s1 >>= \r1 -> case r1 of Done -> return Done Yield aS s1' -> loop (s1', s2, aS) Next f -> return $ Next $ \a -> let P2 bS s1' = f a in P2 [] (s1',s2,bS) {-# INLINE cmp_t #-} {- id_t :: Monad m => StreamF m a -> StreamF m a id_t (StreamF istep s0) = StreamF loop s0 where loop s = istep s >>= \r -> case r of Done -> return Done Yield a s' -> return $ Yield a s' Skip s' -> return $ Skip s' {-# INLINE id_t #-} map_t :: Monad m => (a -> b) -> StreamF m a -> StreamF m b map_t fn (StreamF istep s0) = StreamF loop s0 where loop s = istep s >>= \r -> case r of Done -> return Done Yield a s' -> return $ Yield (fn a) s' Skip s' -> return $ Skip s' {-# INLINE map_t #-} filter_t :: Monad m => (a -> Bool) -> StreamF m a -> StreamF m a filter_t pred (StreamF istep s0) = StreamF loop s0 where loop s = istep s >>= \r -> case r of Done -> return Done Yield a s' -> return $ if pred a then Yield a s' else Skip s' Skip s' -> return $ Skip s' {-# INLINE filter_t #-} iStream :: Monad m => StreamF (Iteratee [a] m) a iStream = StreamF loop [] where loop (x:xs) = return $ Yield x xs loop [] = do r <- isStreamFinished case r of Nothing -> getChunk >>= loop Just _ -> return Done {-# INLINE iStream #-} -- this isn't really the correct type signature, but I don't know how to write -- what it actually is. Maybe it won't be a problem, with the correct type -- class constraints. etee_t :: Monad m => (forall m. Monad m => StreamF m a -> StreamF m b) -> Enumeratee [a] [b] m x etee_t stream_fn = case stream_fn iStream of StreamF b_fn s0 -> unfoldConvStream fn s0 where fn s = do stepRes <- b_fn s case stepRes of Done -> return (s,[]) Yield a s' -> return (s',[a]) Skip s' -> return (s',[]) {-# INLINE etee_t #-} type Trans m a b = Monad m => StreamF m a -> StreamF m b -} etee_t :: Monad m => StreamF m a b -> Enumeratee [a] [b] m x etee_t stream = case stream of StreamF b_fn s0 -> unfoldConvStream fn (s0,[]) where fn (s,[]) = do ck <- getChunk return ((s,ck),[]) fn (s,supply@(x:xs)) = do stepRes <- lift $ b_fn s case stepRes of Done -> return ((s,supply),[]) Yield aS s' -> return ((s',supply),aS) Next f -> let P2 bS s' = f x in return ((s',xs),bS) type Trans m a b = Monad m => StreamF m a b m2_t :: Trans m Int Int m2_t = map_t id `cmp_t` map_t (+1) m3_t :: Trans m Int Int m3_t = map_t id `cmp_t` map_t (+1) `cmp_t` filter_t even m4_t :: Trans m Int Int m4_t = m2_t `cmp_t` m2_t fusedMap_t :: Iteratee [Int] Identity a -> a fusedMap_t = runner_t m2_t [1..100] fusedMap3_t :: Iteratee [Int] Identity a -> a fusedMap3_t = runner_t m3_t [1..100] fusedMap4_t :: Iteratee [Int] Identity a -> a fusedMap4_t = runner_t m4_t [1..100] runner_t :: (forall m. Trans m Int x) -> [Int] -> Iteratee [x] Identity a -> a runner_t trans xs iter = runIdentity $ enumPureNChunk xs 5 (joinI $ (etee_t trans) iter) >>= I.run fusionBenches :: [Benchmark] fusionBenches = [ bench "mapChunks/mapChunks fusion" $ whnf fusedMap I.sum , bench "mapChunks/filter fusion" $ whnf fusedMap3 I.sum , bench "nested mapChunks/mapChunks fusion" $ whnf fusedMap4 I.sum , bench "highly nested fusion" $ whnf fusedMap10 I.sum , bench "stream mapChunks/mapChunks" $ whnf fusedMap_t I.sum , bench "stream mapChunks/filter" $ whnf fusedMap3_t I.sum , bench "stream nested mapChunks/mapChunks" $ whnf fusedMap4_t I.sum ] main :: IO () main = do putStrLn "\n\n Original" print $ "fusedMap" print $ fusedMap I.sum print "fusedMap/filter" print $ fusedMap3 I.sum print "fusedMap4" print $ fusedMap4 I.sum print "fusedMap10" print $ fusedMap10 I.sum putStrLn "\n\n Stream-based" print $ "fusedMap" print $ fusedMap I.sum print "fusedMap/filter" print $ fusedMap3 I.sum print "fusedMap4" print $ fusedMap4 I.sum defaultMain fusionBenches iteratee-0.8.9.4/tests/fusion.hs0000644000000000000000000000464212021512063014661 0ustar0000000000000000module Main where import Data.Iteratee as I import Criterion.Main import Control.Monad.Identity runner :: Enumeratee [Int] xs Identity a -> [Int] -> Iteratee xs Identity a -> a runner etee xs iter = runIdentity $ enumPureNChunk xs 5 (joinI $ etee iter) >>= I.run -- test fusion of enumeratee/iteratee composition runner2 :: Enumeratee [Int] xs Identity a -> [Int] -> Iteratee xs Identity a -> a runner2 etee xs iter = runIdentity $ enumPureNChunk xs 5 (etee =$ iter) >>= I.run -- test fusion of enumerator/enumeratee composition runner3 :: Enumeratee [Int] xs Identity a -> [Int] -> Iteratee xs Identity a -> a runner3 etee xs iter = runIdentity $ (enumPureNChunk xs 5 $= etee) iter >>= I.run m2 :: Enumeratee [Int] [Int] Identity a m2 = mapChunks id ><> mapChunks (map (+1)) {-# INLINE m2 #-} m3 :: Enumeratee [Int] [Int] Identity a m3 = mapChunks id ><> mapChunks (map (+1)) ><> I.filter (even) {-# INLINE m3 #-} m4 :: Enumeratee [Int] [Int] Identity a m4 = m2 ><> m2 m10 :: Enumeratee [Int] [Int] Identity a m10 = m3 ><> m2 ><> m3 ><> m2 m' :: Enumeratee [a] [a] Identity x m' = convStream (getChunk) {-# INLINE m' #-} m'2 :: Num a => Enumeratee [a] [a] Identity x m'2 = convStream (liftM (map (+1)) getChunk) {-# INLINE m'2 #-} fusedMap :: Iteratee [Int] Identity a -> a fusedMap = runner m2 [1..100] fusedMap' :: Iteratee [Int] Identity a -> a fusedMap' = runner (m2 ><> m') [1..100] fusedMap'2 :: Iteratee [Int] Identity a -> a fusedMap'2 = runner (m2 ><> m' ><> m') [1..100] fusedMap3 :: Iteratee [Int] Identity a -> a fusedMap3 = runner m3 [1..100] fusedMap4 :: Iteratee [Int] Identity a -> a fusedMap4 = runner m4 [1..100] fusedMap10 :: Iteratee [Int] Identity a -> a fusedMap10 = runner m10 [1..100] fusionBenches :: [Benchmark] fusionBenches = [ bench "mapChunks/mapChunks fusion" $ whnf fusedMap I.sum , bench "mapChunks/filter fusion" $ whnf fusedMap3 I.sum , bench "nested mapChunks/mapChunks fusion" $ whnf fusedMap4 I.sum , bench "highly nested fusion" $ whnf fusedMap10 I.sum , bench "mapChunks/mapChunks/convStream" $ whnf fusedMap' I.sum , bench "mapChunks/mapChunks/convStream2" $ whnf fusedMap'2 I.sum ] main :: IO () main = do print $ "fusedMap" print $ fusedMap I.sum print "fusedMap/filter" print $ fusedMap3 I.sum print "fusedMap4" print $ fusedMap4 I.sum print "fusedMap10" print $ fusedMap10 I.sum defaultMain fusionBenches iteratee-0.8.9.4/bench/0000755000000000000000000000000012021512063012731 5ustar0000000000000000iteratee-0.8.9.4/bench/BenchAll.hs0000644000000000000000000000024412021512063014735 0ustar0000000000000000module Main where import Criterion.Main import BenchBase (allByteStringBenches) import BenchIO (ioBenches) main = defaultMain (allByteStringBenches: ioBenches) iteratee-0.8.9.4/bench/BenchIO.hs0000644000000000000000000000356712021512063014547 0ustar0000000000000000{-# 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-0.8.9.4/bench/BenchBase.hs0000644000000000000000000002505412021512063015105 0ustar0000000000000000{-# 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] instance NFData BS.ByteString where 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] iteratee-0.8.9.4/src/0000755000000000000000000000000012021512063012441 5ustar0000000000000000iteratee-0.8.9.4/src/Data/0000755000000000000000000000000012021512063013312 5ustar0000000000000000iteratee-0.8.9.4/src/Data/NullPoint.hs0000644000000000000000000000114112021512063015567 0ustar0000000000000000-- |NullPoint: -- Pointed types (usually containers) that can be empty. -- Corresponds to Data.Monoid.mempty module Data.NullPoint ( -- * Classes NullPoint (..) ) where import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L -- ---------------------------------------------- -- |NullPoint class. Containers that have a null representation, corresponding -- to Data.Monoid.mempty. class NullPoint c where empty :: c instance NullPoint [a] where empty = [] instance NullPoint B.ByteString where empty = B.empty instance NullPoint L.ByteString where empty = L.empty iteratee-0.8.9.4/src/Data/Iteratee.hs0000644000000000000000000000465112021512063015416 0ustar0000000000000000{- | 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 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, fileDriverRandomVBuf ) where import Data.Iteratee.Binary import Data.Iteratee.IO import Data.Iteratee.ListLike import Data.Iteratee.PTerm iteratee-0.8.9.4/src/Data/Nullable.hs0000644000000000000000000000103012021512063015376 0ustar0000000000000000-- |Nullable: -- test if a type (container) is null. module Data.Nullable ( -- * Classes Nullable (..) ) where 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 nullC :: c -> Bool instance Nullable [a] where nullC [] = True nullC _ = False instance Nullable B.ByteString where nullC = B.null instance Nullable L.ByteString where nullC = L.null iteratee-0.8.9.4/src/Data/Iteratee/0000755000000000000000000000000012021512063015054 5ustar0000000000000000iteratee-0.8.9.4/src/Data/Iteratee/Binary.hs0000644000000000000000000001403612021512063016640 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, BangPatterns #-} -- |Monadic Iteratees: -- incremental input parsers, processors, and transformers -- -- Iteratees for parsing binary data. module Data.Iteratee.Binary ( -- * Types Endian (..) -- * Endian multi-byte iteratees ,endianRead2 ,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. 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 = endianReadN e 2 word16' {-# INLINE endianRead2 #-} endianRead3 :: (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 endianRead3i 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 -> let m :: Int32 m = shiftR (shiftL (fromIntegral c3) 24) 8 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 = 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 #-} iteratee-0.8.9.4/src/Data/Iteratee/Iteratee.hs0000644000000000000000000004477112021512063017167 0ustar0000000000000000{-# 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 ,throwRecoverableErr ,checkErr -- ** Basic Iteratees ,identity ,skipToEof ,isStreamFinished -- ** Chunkwise Iteratees ,mapChunksM_ ,foldChunksM ,getChunk ,getChunks -- ** Nested iteratee combinators ,mapChunks ,mapChunksM ,convStream ,unfoldConvStream ,unfoldConvStreamCheck ,joinI ,joinIM -- * Enumerators ,Enumerator ,Enumeratee -- ** Basic enumerators ,enumChunk ,enumEof ,enumErr ,enumPure1Chunk ,enumList ,enumCheckIfDone ,enumFromCallback ,enumFromCallbackCatch -- ** Enumerator Combinators ,(>>>) ,eneeCheckIfDone ,eneeCheckIfDoneHandle ,eneeCheckIfDoneIgnore ,eneeCheckIfDonePass ,mergeEnums -- ** Enumeratee Combinators ,($=) ,(=$) ,(><>) ,(<><) -- * Misc. ,seek ,FileOffset -- * Classes ,module Data.Iteratee.Base ) where import Prelude hiding (head, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product) import Data.Iteratee.IO.Base import Data.Iteratee.Base import Control.Exception import Control.Monad.Trans.Class import Data.Maybe import Data.Typeable -- exception helpers excDivergent :: SomeException excDivergent = toException DivergentException -- ------------------------------------------------------------------------ -- Primitive iteratees -- |Report and propagate an unrecoverable error. -- Disregard the input first and then propagate the error. This error -- cannot be handled by 'enumFromCallbackCatch', although it can be cleared -- by 'checkErr'. 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 :: SomeException -> (Stream s -> Iteratee s m a) -> Iteratee s m a throwRecoverableErr e i = icont i (Just e) -- |Check if an iteratee produces an error. -- Returns @Right a@ if it completes without errors, otherwise -- @Left SomeException@. 'checkErr' is useful for iteratees that may not -- terminate, such as @Data.Iteratee.head@ with an empty stream. checkErr :: (NullPoint s) => Iteratee s m a -> Iteratee s m (Either SomeException a) checkErr iter = Iteratee $ \onDone onCont -> let od = onDone . Right oc k Nothing = onCont (checkErr . k) Nothing oc _ (Just e) = onDone (Left e) (Chunk empty) in runIter iter od oc -- ------------------------------------------------------------------------ -- Parser combinators -- |The identity iteratee. Doesn't do any processing of input. identity :: (NullPoint s) => Iteratee s m () identity = idone () (Chunk empty) -- |Get the stream status of an iteratee. 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 {-# INLINE isStreamFinished #-} -- |Skip the rest of the stream skipToEof :: Iteratee s m () skipToEof = icont check Nothing where check (Chunk _) = skipToEof check s = idone () s -- |Seek to a position in the stream 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' type Enumeratee sFrom sTo (m :: * -> *) a = Iteratee sTo m a -> Iteratee sFrom m (Iteratee sTo m a) -- 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 = 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 m s'. convStream :: (Monad m, Nullable s) => Iteratee s m s' -> Enumeratee s s' m a convStream fi = eneeCheckIfDonePass check where 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 -- generated by the function while continually updating the internal state. unfoldConvStream :: (Monad m, Nullable s) => (acc -> Iteratee s m (acc, s')) -> acc -> Enumeratee s s' m a unfoldConvStream f acc0 = eneeCheckIfDonePass (check acc0) where 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 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 -- -- 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. -- When to stop is of course up to the enumerator... type Enumerator s m a = Iteratee s m a -> m (Iteratee s m a) -- |Applies the iteratee to the given stream. This wraps 'enumEof', -- 'enumErr', and 'enumPure1Chunk', calling the appropriate enumerator -- based upon 'Stream'. enumChunk :: (Monad m) => Stream s -> Enumerator s m a enumChunk (Chunk xs) = enumPure1Chunk xs enumChunk (EOF Nothing) = enumEof enumChunk (EOF (Just e)) = enumErr e -- |The most primitive enumerator: applies the iteratee to the terminated -- stream. The result is the iteratee in the Done state. It is an error -- if the iteratee does not terminate on EOF. enumEof :: (Monad m) => Enumerator s m a enumEof iter = runIter iter onDone onCont where onDone x _str = return $ idone x (EOF Nothing) onCont k Nothing = runIter (k (EOF Nothing)) onDone onCont' onCont k e = return $ icont k e onCont' _ Nothing = return $ throwErr excDivergent onCont' k e = return $ icont k e -- |Another primitive enumerator: tell the Iteratee the stream terminated -- with an error. enumErr :: (Exception e, Monad m) => e -> Enumerator s m a enumErr e iter = runIter iter onDone onCont where onDone x _ = return $ idone x (EOF . Just $ toException e) onCont k Nothing = runIter (k (EOF (Just (toException e)))) onDone onCont' onCont k e' = return $ icont k e' onCont' _ Nothing = return $ throwErr excDivergent onCont' k e' = return $ icont k e' -- |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 (>=>)... 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 enumPure1Chunk str iter = runIter iter idoneM onCont where onCont k Nothing = return $ k $ Chunk str onCont k e = return $ icont k e -- | 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) enumCheckIfDone iter = runIter iter onDone onCont where onDone x str = return (True, idone x str) onCont k e = return (False, icont k e) {-# INLINE enumCheckIfDone #-} -- |Create an enumerator from a callback function enumFromCallback :: (Monad m, NullPoint s) => (st -> m (Either SomeException ((Bool, st), s))) -> st -> Enumerator s m a enumFromCallback c st = enumFromCallbackCatch c (\NotAnException -> return Nothing) st -- Dummy exception to catch in enumFromCallback -- This never gets thrown, but it lets us -- share plumbing data NotAnException = NotAnException deriving (Show, Typeable) instance Exception NotAnException where instance IException NotAnException where -- |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))) -> (e -> m (Maybe EnumException)) -> st -> Enumerator s m a enumFromCallbackCatch c handler = loop where 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 #-} iteratee-0.8.9.4/src/Data/Iteratee/Exception.hs0000644000000000000000000001615112021512063017352 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification #-} -- |Monadic and General Iteratees: -- Messaging and exception handling. -- -- Iteratees use an internal exception handling mechanism that is parallel to -- that provided by 'Control.Exception'. This allows the iteratee framework -- to handle its own exceptions outside @IO@. -- -- Iteratee exceptions are divided into two categories, 'IterException' and -- 'EnumException'. @IterExceptions@ are exceptions within an iteratee, and -- @EnumExceptions@ are exceptions within an enumerator. -- -- Enumerators can be constructed to handle an 'IterException' with -- @Data.Iteratee.Iteratee.enumFromCallbackCatch@. If the enumerator detects -- an @iteratee exception@, the enumerator calls the provided exception handler. -- The enumerator is then able to continue feeding data to the iteratee, -- provided the exception was successfully handled. If the handler could -- not handle the exception, the 'IterException' is converted to an -- 'EnumException' and processing aborts. -- -- Exceptions can also be cleared by @Data.Iteratee.Iteratee.checkErr@, -- although in this case the iteratee continuation cannot be recovered. -- -- When viewed as Resumable Exceptions, iteratee exceptions provide a means -- for iteratees to send control messages to enumerators. The @seek@ -- implementation provides an example. @Data.Iteratee.Iteratee.seek@ stores -- the current iteratee continuation and throws a 'SeekException', which -- inherits from 'IterException'. @Data.Iteratee.IO.enumHandleRandom@ is -- constructed with @enumFromCallbackCatch@ and a handler that performs -- an @hSeek@. Upon receiving the 'SeekException', @enumHandleRandom@ calls -- the handler, checks that it executed properly, and then continues with -- the stored continuation. -- -- As the exception hierarchy is open, users can extend it with custom -- exceptions and exception handlers to implement sophisticated messaging -- systems based upon resumable exceptions. module Data.Iteratee.Exception ( -- * Exception types IFException (..) ,Exception (..) -- from Control.Exception -- ** Enumerator exceptions ,EnumException (..) ,DivergentException (..) ,EnumStringException (..) ,EnumUnhandledIterException (..) -- ** Iteratee exceptions ,IException (..) ,IterException (..) ,SeekException (..) ,EofException (..) ,IterStringException (..) -- * Functions ,enStrExc ,iterStrExc ,wrapIterExc ,iterExceptionToException ,iterExceptionFromException ) where import Data.Iteratee.IO.Base import Control.Exception import Data.Data -- ---------------------------------------------- -- create exception type hierarchy -- |Root of the Iteratee exception hierarchy. @IFException@ derives from -- @Control.Exception.SomeException@. 'EnumException', 'IterException', -- and all inheritants are descendents of 'IFException'. data IFException = forall e . Exception e => IFException e deriving Typeable instance Show IFException where show (IFException e) = show e instance Exception IFException ifExceptionToException :: Exception e => e -> SomeException ifExceptionToException = toException . IFException ifExceptionFromException :: Exception e => SomeException -> Maybe e ifExceptionFromException x = do IFException a <- fromException x cast a -- Root of enumerator exceptions. data EnumException = forall e . Exception e => EnumException e deriving Typeable instance Show EnumException where show (EnumException e) = show e instance Exception EnumException where toException = ifExceptionToException fromException = ifExceptionFromException enumExceptionToException :: Exception e => e -> SomeException enumExceptionToException = toException . IterException enumExceptionFromException :: Exception e => SomeException -> Maybe e enumExceptionFromException x = do IterException a <- fromException x cast a -- |The @iteratee@ diverged upon receiving 'EOF'. data DivergentException = DivergentException deriving (Show, Typeable) instance Exception DivergentException where toException = enumExceptionToException fromException = enumExceptionFromException -- |Create an enumerator exception from a @String@. data EnumStringException = EnumStringException String deriving (Show, Typeable) instance Exception EnumStringException where toException = enumExceptionToException fromException = enumExceptionFromException -- |Create an 'EnumException' from a string. enStrExc :: String -> EnumException enStrExc = EnumException . EnumStringException -- |The enumerator received an 'IterException' it could not handle. data EnumUnhandledIterException = EnumUnhandledIterException IterException deriving (Show, Typeable) instance Exception EnumUnhandledIterException where toException = enumExceptionToException fromException = enumExceptionFromException -- |Convert an 'IterException' to an 'EnumException'. Meant to be used -- within an @Enumerator@ to signify that it could not handle the -- @IterException@. wrapIterExc :: IterException -> EnumException wrapIterExc = EnumException . EnumUnhandledIterException -- iteratee exceptions -- |A class for @iteratee exceptions@. Only inheritants of @IterException@ -- should be instances of this class. class Exception e => IException e where toIterException :: e -> IterException toIterException = IterException fromIterException :: IterException -> Maybe e fromIterException = fromException . toException -- |Root of iteratee exceptions. data IterException = forall e . Exception e => IterException e deriving Typeable instance Show IterException where show (IterException e) = show e instance Exception IterException where toException = ifExceptionToException fromException = ifExceptionFromException iterExceptionToException :: Exception e => e -> SomeException iterExceptionToException = toException . IterException iterExceptionFromException :: Exception e => SomeException -> Maybe e iterExceptionFromException x = do IterException a <- fromException x cast a instance IException IterException where toIterException = id fromIterException = Just -- |A seek request within an @Iteratee@. data SeekException = SeekException FileOffset deriving (Typeable, Show) instance Exception SeekException where toException = iterExceptionToException fromException = iterExceptionFromException instance IException SeekException where -- |The @Iteratee@ needs more data but received @EOF@. data EofException = EofException deriving (Typeable, Show) instance Exception EofException where toException = iterExceptionToException fromException = iterExceptionFromException instance IException EofException where -- |An @Iteratee exception@ specified by a @String@. data IterStringException = IterStringException String deriving (Typeable, Show) instance Exception IterStringException where toException = iterExceptionToException fromException = iterExceptionFromException instance IException IterStringException where -- |Create an @iteratee exception@ from a string. -- This convenience function wraps 'IterStringException' and 'toException'. iterStrExc :: String -> SomeException iterStrExc= toException . IterStringException iteratee-0.8.9.4/src/Data/Iteratee/ListLike.hs0000644000000000000000000011235012021512063017132 0ustar0000000000000000{-# 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. module Data.Iteratee.ListLike ( -- * Iteratees -- ** Iteratee Utilities isFinished ,stream2list ,stream2stream -- ** Basic Iteratees ,break ,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' ,foldl1 ,foldl1' -- ** Special Folds ,sum ,product -- * Enumerators -- ** Basic enumerators ,enumPureNChunk -- ** Enumerator Combinators ,enumPair ,enumWith ,zip ,zip3 ,zip4 ,zip5 ,sequence_ ,countConsumed ,greedy -- ** Monadic functions ,mapM_ ,foldM -- * Re-exported modules ,module Data.Iteratee.Iteratee ) where 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.Monad (liftM, liftM2, mplus, (<=<)) import Control.Monad.Trans.Class import Data.Word (Word8) import qualified Data.ByteString as B -- Useful combinators for implementing iteratees and enumerators -- | Check if a stream has received 'EOF'. isFinished :: (Nullable s) => Iteratee s m Bool isFinished = liftI check where check c@(Chunk xs) | nullC xs = liftI check | otherwise = idone False c check s@(EOF _) = idone True s {-# INLINE isFinished #-} -- ------------------------------------------------------------------------ -- Primitive iteratees -- |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 = 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 = liftM mconcat getChunks {-# INLINE stream2stream #-} -- ------------------------------------------------------------------------ -- Parser combinators -- |Takes an element predicate and returns the (possibly empty) prefix of -- the stream. None of the characters in the string satisfy the character -- 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 :: (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 | otherwise = case LL.break cpred str of (str', tail') | LL.null tail' -> icont (step (bfr `mappend` str)) Nothing | 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. -- -- The analogue of @List.head@ -- -- 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 | 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. heads :: (Monad m, Nullable s, LL.ListLike s el, Eq el) => s -> Iteratee s m Int heads st | nullC st = return 0 heads st = loop 0 st where loop cnt xs | 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) else idone cnt s step cnt _ stream = idone cnt stream {-# INLINE heads #-} -- |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 :: (LL.ListLike s el) => Iteratee s m (Maybe el) peek = liftI step where step s@(Chunk vec) | LL.null vec = liftI step | 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 -- ^ 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 >= t = idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec) | LL.null vec = liftI step | 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 roll t d = LL.singleton <$> joinI (take t stream2stream) <* drop (d-t) -- d is >= t, so this version works {-# INLINE roll #-} -- |Drop n elements of the stream, if there are that many. -- -- The analogue of @List.drop@ 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)) | 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 :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m () dropWhile p = liftI step where step (Chunk str) | LL.null left = liftI step | 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. -- -- This forces evaluation of the entire stream. -- -- The analogue of @List.length@ length :: (Num a, LL.ListLike s el) => Iteratee s m a length = liftI (step 0) where 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 -- ^ number of elements to consume -> Enumeratee s s m a take 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 = take (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 (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 -- of processing of the outer stream once the processing of the inner stream -- finished early. -- -- 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 = 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 = 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')@, -- build a nested stream of elements of the type @el'@ and apply the -- given iteratee to it. -- -- The analog of @List.map@ 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 :: (LL.ListLike s el, NullPoint s) => (el -> el) -> Enumeratee s s 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, Functor m, Nullable s, LL.ListLike s el) => (el -> Bool) -> Enumeratee s s m a 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 :: (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) | 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' :: (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) | 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 :: (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 | otherwise = foldl f $ FLL.foldl1 f xs step stream = icont step (Just (setEOF stream)) {-# INLINE foldl1 #-} -- | Strict variant of 'foldl1'. 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 | otherwise = foldl' f $ FLL.foldl1 f xs step stream = icont step (Just (setEOF stream)) {-# INLINE foldl1' #-} -- | Sum of a stream. 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) | otherwise = liftI (step $! acc + LL.sum xs) step acc str = idone acc str {-# INLINE sum #-} -- | Product of a stream. 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) | otherwise = liftI (step $! acc * LL.product xs) step acc str = idone acc str {-# INLINE product #-} -- ------------------------------------------------------------------------ -- Zips -- |Enumerate two iteratees over a single stream simultaneously. -- Deprecated, use `Data.Iteratee.ListLike.zip` instead. -- -- Compare to @zip@. {-# 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 = 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 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 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 str n iter | LL.null str = return iter | n > 0 = enum' str iter | otherwise = error $ "enumPureNChunk called with n==" ++ show n where enum' str' iter' | LL.null str' = return iter' | 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 #-} iteratee-0.8.9.4/src/Data/Iteratee/Char.hs0000644000000000000000000001250012021512063016263 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} -- | Utilities for Char-based iteratee processing. module Data.Iteratee.Char ( -- * Word and Line processors printLines ,printLinesUnterminated ,enumLines ,enumLinesBS ,enumWords ,enumWordsBS ) where import Data.Iteratee.Iteratee import qualified Data.Iteratee.ListLike as I import Data.Iteratee.ListLike (heads) import Data.Char import Data.Monoid import qualified Data.ListLike as LL import Control.Monad (liftM) import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as BC -- |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 lines' = I.break (`elem` "\r\n") >>= \l -> terminators >>= check l check _ 0 = return () check "" _ = return () check l _ = liftIO (putStrLn l) >> lines' -- |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. -- When the stream of characters is terminated, the stream of lines -- is also terminated. -- This is the first proper iteratee-enumerator: it is the iteratee of the -- character stream and the enumerator of the line stream. enumLines :: (LL.ListLike s el, LL.StringLike s, Nullable s, Monad m) => Enumeratee s [s] m a enumLines = convStream getter where getter = icont step Nothing lChar = (== '\n') . last . LL.toString step (Chunk xs) | LL.null xs = getter | lChar xs = idone (LL.lines xs) mempty | 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 | otherwise = let w' = LL.lines $ mappend xs ys ws = init w' ck = last w' in idone ws (Chunk ck) step' xs str = idone (LL.lines xs) str -- |Convert the stream of characters to the stream of words, and -- apply the given iteratee to enumerate the latter. -- Words are delimited by white space. -- This is the analogue of List.words enumWords :: (LL.ListLike s Char, Nullable s, Monad m) => Enumeratee s [s] m a enumWords = convStream $ I.dropWhile isSpace >> liftM (:[]) (I.break isSpace) {-# INLINE enumWords #-} -- Like enumWords, but operates on ByteStrings. -- This is provided as a higher-performance alternative to enumWords, and -- is equivalent to treating the stream as a Data.ByteString.Char8.ByteString. enumWordsBS :: (Monad m) => Enumeratee BC.ByteString [BC.ByteString] m a enumWordsBS iter = convStream getter iter where getter = liftI step lChar = isSpace . BC.last step (Chunk xs) | BC.null xs = getter | lChar xs = idone (BC.words xs) (Chunk BC.empty) | 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 | otherwise = let w' = BC.words . BC.append xs $ ys ws = init w' ck = last w' in idone ws (Chunk ck) step' xs str = idone (BC.words xs) str {-# INLINE enumWordsBS #-} -- Like enumLines, but operates on ByteStrings. -- This is provided as a higher-performance alternative to enumLines, and -- is equivalent to treating the stream as a Data.ByteString.Char8.ByteString. enumLinesBS :: (Monad m) => Enumeratee BC.ByteString [BC.ByteString] m a enumLinesBS = convStream getter where getter = icont step Nothing lChar = (== '\n') . BC.last step (Chunk xs) | BC.null xs = getter | lChar xs = idone (BC.lines xs) (Chunk BC.empty) | 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 | otherwise = let w' = BC.lines $ BC.append xs ys ws = init w' ck = last w' in idone ws (Chunk ck) step' xs str = idone (BC.lines xs) str iteratee-0.8.9.4/src/Data/Iteratee/PTerm.hs0000644000000000000000000002447612021512063016454 0ustar0000000000000000{-# 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 #-} iteratee-0.8.9.4/src/Data/Iteratee/Parallel.hs0000644000000000000000000001002012021512063017135 0ustar0000000000000000{-# 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) iteratee-0.8.9.4/src/Data/Iteratee/Base.hs0000644000000000000000000002221512021512063016264 0ustar0000000000000000{-# LANGUAGE TypeFamilies ,MultiParamTypeClasses ,FlexibleContexts ,FlexibleInstances ,UndecidableInstances ,Rank2Types ,DeriveDataTypeable ,ExistentialQuantification #-} -- |Monadic Iteratees: -- incremental input parsers, processors and transformers module Data.Iteratee.Base ( -- * Types Stream (..) ,StreamStatus (..) -- ** Exception types ,module Data.Iteratee.Exception -- ** Iteratees ,Iteratee (..) -- * Functions -- ** Control functions ,run ,tryRun ,mapIteratee ,ilift ,ifold -- ** Creating Iteratees ,idone ,icont ,liftI ,idoneM ,icontM -- ** Stream Functions ,setEOF -- * Classes ,module X ) where import Prelude hiding (null) import Data.Iteratee.Exception 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 (..), block) import qualified Control.Monad.CatchIO as EIO import Control.Monad.Trans.Control import Control.Applicative hiding (empty) import Control.Exception (SomeException) import qualified Control.Exception as E import Data.Data -- |A stream is a (continuing) sequence of elements bundled in Chunks. -- The first variant indicates termination of the stream. -- Chunk a gives the currently available part of the stream. -- The stream is not terminated yet. -- The case (null Chunk) signifies a stream with no currently available -- data but which is still continuing. A stream processor should, -- informally speaking, ``suspend itself'' and wait for more data -- to arrive. data Stream c = EOF (Maybe SomeException) | Chunk c deriving (Show, Typeable) instance (Eq c) => Eq (Stream c) where (Chunk c1) == (Chunk c2) = c1 == c2 (EOF Nothing) == (EOF Nothing) = True (EOF (Just e1)) == (EOF (Just e2)) = typeOf e1 == typeOf e2 _ == _ = False instance Monoid c => Monoid (Stream c) where mempty = Chunk mempty mappend (EOF mErr) _ = EOF mErr mappend _ (EOF mErr) = EOF mErr mappend (Chunk s1) (Chunk s2) = Chunk (s1 `mappend` s2) -- |Map a function over a stream. instance Functor Stream where fmap f (Chunk xs) = Chunk $ f xs fmap _ (EOF mErr) = EOF mErr -- |Describe the status of a stream of data. data StreamStatus = DataRemaining | EofNoError | EofError SomeException deriving (Show, Typeable) -- ---------------------------------------------- -- create exception type hierarchy -- |Produce the 'EOF' error message. If the stream was terminated because -- of an error, keep the error message. setEOF :: Stream c -> SomeException setEOF (EOF (Just e)) = e setEOF _ = toException EofException -- ---------------------------------------------- -- | Monadic iteratee newtype Iteratee s m a = Iteratee{ runIter :: forall r. (a -> Stream s -> m r) -> ((Stream s -> Iteratee s m a) -> Maybe SomeException -> m r) -> m r} -- ---------------------------------------------- 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 :: (Stream s -> Iteratee s m a) -> Iteratee s m a liftI k = Iteratee $ \_ onCont -> onCont k Nothing -- Monadic versions, frequently used by enumerators idoneM :: Monad m => a -> Stream s -> m (Iteratee s m a) idoneM x str = return $ Iteratee $ \onDone _ -> onDone x str icontM :: Monad m => (Stream s -> Iteratee s m a) -> Maybe SomeException -> m (Iteratee s m a) icontM k e = return $ Iteratee $ \_ onCont -> onCont k e instance (Functor m) => Functor (Iteratee s m) where fmap f m = Iteratee $ \onDone onCont -> let od = onDone . f oc = onCont . (fmap f .) in runIter m od oc 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 (>>=) #-} (>>=) = 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 `EIO.catch` (\e -> runIter (f e) od oc) block = ilift block unblock = ilift unblock 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 -- on @EOF@ will throw 'EofException'. run :: Monad m => Iteratee s m a -> m a run iter = runIter iter onDone onCont where onDone x _ = return x onCont k Nothing = runIter (k (EOF Nothing)) onDone onCont' onCont _ (Just e) = E.throw e onCont' _ Nothing = E.throw EofException onCont' _ (Just e) = E.throw e -- |Run an iteratee, returning either the result or the iteratee exception. -- 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 where onDone x _ = return $ Right x onCont k Nothing = runIter (k (EOF Nothing)) onDone onCont' onCont _ (Just e) = return $ maybeExc e onCont' _ Nothing = return $ maybeExc (toException EofException) onCont' _ (Just e) = return $ maybeExc e maybeExc e = maybe (Left (E.throw e)) Left (fromException e) -- |Transform a computation inside an @Iteratee@. mapIteratee :: (NullPoint s, Monad n, Monad m) => (m a -> n b) -> 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 iteratee-0.8.9.4/src/Data/Iteratee/IO.hs0000644000000000000000000000727212021512063015727 0ustar0000000000000000{-# LANGUAGE CPP #-} -- |Random and Binary IO with generic Iteratees. module Data.Iteratee.IO( -- * Data defaultBufSize, -- * File enumerators -- ** Handle-based enumerators H.enumHandle, H.enumHandleRandom, enumFile, enumFileRandom, #if defined(USE_POSIX) -- ** FileDescriptor based enumerators FD.enumFd, FD.enumFdRandom, #endif -- * Iteratee drivers -- These are FileDescriptor-based on POSIX systems, otherwise they are -- Handle-based. The Handle-based drivers are accessible on POSIX systems -- at Data.Iteratee.IO.Handle fileDriver, fileDriverVBuf, fileDriverRandom, fileDriverRandomVBuf, ) where import Data.Iteratee.Base.ReadableChunk import Data.Iteratee.Iteratee import Data.Iteratee.Binary() import qualified Data.Iteratee.IO.Handle as H #if defined(USE_POSIX) import qualified Data.Iteratee.IO.Fd as FD #endif import Control.Monad.CatchIO -- | 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 :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Int -> FilePath -> Enumerator s m a enumFile = FD.enumFile enumFileRandom :: (MonadCatchIO 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) => Iteratee s m a -> FilePath -> m a fileDriver = FD.fileDriverFd defaultBufSize -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a 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) => Iteratee s m a -> FilePath -> m a fileDriverRandom = FD.fileDriverRandomFd defaultBufSize fileDriverRandomVBuf :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a fileDriverRandomVBuf = FD.fileDriverRandomFd #else -- ----------------------------------------------- -- Handle-based operations for compatibility. -- |Process a file using the given Iteratee. This function wraps -- @enumHandle@ as a convenience. fileDriver :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Iteratee s m a -> FilePath -> m a fileDriver = H.fileDriverHandle defaultBufSize -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a 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) => Iteratee s m a -> FilePath -> m a fileDriverRandom = H.fileDriverRandomHandle defaultBufSize fileDriverRandomVBuf :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a fileDriverRandomVBuf = H.fileDriverRandomHandle enumFile :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Int -> FilePath -> Enumerator s m a enumFile = H.enumFile enumFileRandom :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Int -> FilePath -> Enumerator s m a enumFileRandom = H.enumFileRandom #endif iteratee-0.8.9.4/src/Data/Iteratee/Base/0000755000000000000000000000000012021512063015726 5ustar0000000000000000iteratee-0.8.9.4/src/Data/Iteratee/Base/ReadableChunk.hs0000644000000000000000000000322412021512063020753 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-} -- |Monadic Iteratees: -- incremental input parsers, processors and transformers -- -- Support for IO enumerators module Data.Iteratee.Base.ReadableChunk ( ReadableChunk (..) ) where 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 import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Array -- |Class of streams which can be filled from a 'Ptr'. Typically these -- are streams which can be read from a file, @Handle@, or similar resource. -- -- class (Storable el) => ReadableChunk s el | s -> el where readFromPtr :: MonadIO m => Ptr el -> Int -- ^ The pointer must not be used after @readFromPtr@ completes. -> m s -- ^ The Int parameter is the length of the data in *bytes*. instance ReadableChunk [Char] Char where readFromPtr buf l = liftIO $ peekCAStringLen (castPtr buf, l) instance ReadableChunk [Word8] Word8 where readFromPtr buf l = liftIO $ peekArray l buf instance ReadableChunk [Word16] Word16 where readFromPtr buf l = liftIO $ peekArray l buf instance ReadableChunk [Word32] Word32 where readFromPtr buf l = liftIO $ peekArray l buf instance ReadableChunk [Word] Word where readFromPtr buf l = liftIO $ peekArray l buf 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 iteratee-0.8.9.4/src/Data/Iteratee/Base/LooseMap.hs0000644000000000000000000000077012021512063020005 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} -- |Monadic Iteratees: incremental input parsers, processors, and transformers -- -- Maps over restricted-element containers module Data.Iteratee.Base.LooseMap ( LooseMap (..) ) where -- |Enable map functions for containers that require class contexts on the -- element types. For lists, this is identical to plain `map`. class LooseMap c el el' where lMap :: (el -> el') -> c el -> c el' instance LooseMap [] el el' where lMap = map iteratee-0.8.9.4/src/Data/Iteratee/IO/0000755000000000000000000000000012021512063015363 5ustar0000000000000000iteratee-0.8.9.4/src/Data/Iteratee/IO/Handle.hs0000644000000000000000000001134612021512063017117 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} -- |Random and Binary IO with generic Iteratees. These functions use Handles -- for IO operations, and are provided for compatibility. When available, -- the File Descriptor based functions are preferred as these wastefully -- allocate memory rather than running in constant space. module Data.Iteratee.IO.Handle( -- * File enumerators enumHandle ,enumHandleCatch ,enumHandleRandom ,enumFile ,enumFileRandom -- * Iteratee drivers ,fileDriverHandle ,fileDriverRandomHandle ) where import Data.Iteratee.Base.ReadableChunk import Data.Iteratee.Iteratee import Data.Iteratee.Binary() import Control.Exception import Control.Monad import Control.Monad.CatchIO as CIO import Control.Monad.IO.Class import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc import System.IO -- ------------------------------------------------------------------------ -- Binary Random IO enumerators makeHandleCallback :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) => Ptr el -> Int -> Handle -> st -> m (Either SomeException ((Bool, st), s)) makeHandleCallback p bsize h st = do n' <- liftIO (CIO.try $ hGetBuf h p bsize :: IO (Either SomeException Int)) case n' of Left e -> return $ Left e Right 0 -> return $ Right ((False, st), empty) Right n -> liftM (\s -> Right ((True, st), s)) $ readFromPtr p (fromIntegral n) -- |The (monadic) enumerator of a file Handle. This version enumerates -- over the entire contents of a file, in order, unless stopped by -- 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) => Int -- ^Buffer size (number of elements per read) -> Handle -> Enumerator s m a enumHandle bs h i = let bufsize = bs * sizeOf (undefined :: el) 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. enumHandleCatch :: forall e s el m a.(IException e, NullPoint s, ReadableChunk s el, MonadCatchIO m) => Int -- ^Buffer size (number of elements per read) -> Handle -> (e -> m (Maybe EnumException)) -> Enumerator s m a enumHandleCatch bs h handler i = let bufsize = bs * sizeOf (undefined :: el) 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) => Int -- ^ Buffer size (number of elements per read) -> Handle -> Enumerator s m a enumHandleRandom bs h i = enumHandleCatch bs h handler i where handler (SeekException off) = liftM (either (Just . EnumException :: IOException -> Maybe EnumException) (const Nothing)) . liftIO . CIO.try $ hSeek h AbsoluteSeek $ fromIntegral off -- ---------------------------------------------- -- File Driver wrapper functions. enumFile' :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) => (Int -> Handle -> Enumerator s m a) -> Int -- ^Buffer size -> FilePath -> Enumerator s m a enumFile' enumf bufsize filepath iter = CIO.bracket (liftIO $ openBinaryFile filepath ReadMode) (liftIO . hClose) (flip (enumf bufsize) iter) enumFile :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) => Int -- ^Buffer size -> FilePath -> Enumerator s m a enumFile = enumFile' enumHandle enumFileRandom :: (NullPoint s, MonadCatchIO 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) -> Iteratee s m a -> FilePath -> m a 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 -- ^ Buffer size (number of elements) -> Iteratee s m a -> FilePath -> m a fileDriverRandomHandle bufsize iter filepath = enumFileRandom bufsize filepath iter >>= run iteratee-0.8.9.4/src/Data/Iteratee/IO/Fd.hs0000644000000000000000000001121112021512063016244 0ustar0000000000000000{-# LANGUAGE CPP, ScopedTypeVariables #-} -- |Random and Binary IO with generic Iteratees, using File Descriptors for IO. -- when available, these are the preferred functions for performing IO as they -- run in constant space and function properly with sockets, pipes, etc. module Data.Iteratee.IO.Fd( #if defined(USE_POSIX) -- * File enumerators -- ** FileDescriptor based enumerators for monadic iteratees enumFd ,enumFdCatch ,enumFdRandom ,enumFile ,enumFileRandom -- * Iteratee drivers ,fileDriverFd ,fileDriverRandomFd #endif ) where #if defined(USE_POSIX) import Data.Iteratee.Base.ReadableChunk import Data.Iteratee.Iteratee 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.IO.Class import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc import System.IO (SeekMode(..)) import System.Posix hiding (FileOffset) -- ------------------------------------------------------------------------ -- Binary Random IO enumerators makefdCallback :: (MonadIO m, NullPoint s, ReadableChunk s el) => Ptr el -> ByteCount -> Fd -> st -> m (Either SomeException ((Bool, st), s)) makefdCallback p bufsize fd st = do n <- liftIO $ myfdRead fd (castPtr p) bufsize case n of 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') -- |The enumerator of a POSIX File Descriptor. This version enumerates -- 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, MonadCatchIO m) => Int -> Fd -> Enumerator s m a enumFd bs fd iter = let bufsize = bs * (sizeOf (undefined :: el)) 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, MonadCatchIO m) => Int -> Fd -> (e -> m (Maybe EnumException)) -> Enumerator s m a enumFdCatch bs fd handler iter = let bufsize = bs * (sizeOf (undefined :: el)) 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, MonadCatchIO m) => Int -> Fd -> Enumerator s m a enumFdRandom bs fd iter = enumFdCatch bs fd handler iter where handler (SeekException off) = liftM (either (const . Just $ enStrExc "Error seeking within file descriptor") (const Nothing)) . liftIO . myfdSeek fd AbsoluteSeek $ fromIntegral off fileDriver :: (MonadCatchIO m, ReadableChunk s el) => (Int -> Fd -> Enumerator s m a) -> Int -> Iteratee s m a -> FilePath -> m a fileDriver enumf bufsize iter filepath = CIO.bracket (liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags) (liftIO . closeFd) (run <=< flip (enumf bufsize) iter) -- |Process a file using the given @Iteratee@. fileDriverFd :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) => Int -- ^Buffer size (number of elements) -> Iteratee s m a -> FilePath -> m a fileDriverFd = fileDriver enumFd -- |A version of fileDriverFd that supports seeking. fileDriverRandomFd :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) => Int -> Iteratee s m a -> FilePath -> m a fileDriverRandomFd = fileDriver enumFdRandom enumFile' :: (NullPoint s, MonadCatchIO 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, MonadCatchIO m, ReadableChunk s el) => Int -- ^Buffer size -> FilePath -> Enumerator s m a enumFile = enumFile' enumFd enumFileRandom :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) => Int -- ^Buffer size -> FilePath -> Enumerator s m a enumFileRandom = enumFile' enumFdRandom #endif iteratee-0.8.9.4/src/Data/Iteratee/IO/Posix.hs0000644000000000000000000000653212021512063017027 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface #-} -- Low-level IO operations -- These operations are either missing from the GHC run-time library, -- or implemented suboptimally or heavy-handedly module Data.Iteratee.IO.Posix ( #if defined(USE_POSIX) FileOffset, myfdRead, myfdSeek, Errno(..), select'read'pending #endif ) where #if defined(USE_POSIX) import Foreign.C import Foreign.Ptr import System.Posix import System.IO (SeekMode(..)) import Control.Monad import Data.Bits -- for select import Foreign.Marshal.Array -- for select -- |Alas, GHC provides no function to read from Fd to an allocated buffer. -- The library function fdRead is not appropriate as it returns a string -- already. I'd rather get data from a buffer. -- Furthermore, fdRead (at least in GHC) allocates a new buffer each -- time it is called. This is a waste. Yet another problem with fdRead -- is in raising an exception on any IOError or even EOF. I'd rather -- avoid exceptions altogether. myfdRead :: Fd -> Ptr CChar -> ByteCount -> IO (Either Errno ByteCount) myfdRead (Fd fd) ptr n = do n' <- cRead fd ptr n if n' == -1 then liftM Left getErrno else return . Right . fromIntegral $ n' foreign import ccall unsafe "unistd.h read" cRead :: CInt -> Ptr CChar -> CSize -> IO CInt -- |The following fseek procedure throws no exceptions. myfdSeek:: Fd -> SeekMode -> FileOffset -> IO (Either Errno FileOffset) myfdSeek (Fd fd) mode off = do n' <- cLSeek fd off (mode2Int mode) if n' == -1 then liftM Left getErrno else return . Right $ n' where mode2Int :: SeekMode -> CInt -- From GHC source mode2Int AbsoluteSeek = 0 mode2Int RelativeSeek = 1 mode2Int SeekFromEnd = 2 foreign import ccall unsafe "unistd.h lseek" cLSeek :: CInt -> FileOffset -> CInt -> IO FileOffset -- Darn! GHC doesn't provide the real select over several descriptors! -- We have to implement it ourselves type FDSET = CUInt type TIMEVAL = CLong -- Two longs foreign import ccall "unistd.h select" c_select :: CInt -> Ptr FDSET -> Ptr FDSET -> Ptr FDSET -> Ptr TIMEVAL -> IO CInt -- Convert a file descriptor to an FDSet (for use with select) -- essentially encode a file descriptor in a big-endian notation fd2fds :: CInt -> [FDSET] fd2fds fd = replicate nb 0 ++ [setBit 0 off] where (nb,off) = quotRem (fromIntegral fd) (bitSize (undefined::FDSET)) fds2mfd :: [FDSET] -> [CInt] fds2mfd fds = [fromIntegral (j+i*bitsize) | (afds,i) <- zip fds [0..], j <- [0..bitsize], testBit afds j] where bitsize = bitSize (undefined::FDSET) unFd :: Fd -> CInt unFd (Fd x) = x -- |poll if file descriptors have something to read -- Return the list of read-pending descriptors select'read'pending :: [Fd] -> IO (Either Errno [Fd]) select'read'pending mfd = withArray ([0,1]::[TIMEVAL]) $ \_timeout -> withArray fds $ \readfs -> do rc <- c_select (fdmax+1) readfs nullPtr nullPtr nullPtr if rc == -1 then liftM Left getErrno -- because the wait was indefinite, rc must be positive! else liftM (Right . map Fd . fds2mfd) (peekArray (length fds) readfs) where fds :: [FDSET] fds = foldr ormax [] (map (fd2fds . unFd) mfd) fdmax = maximum $ map fromIntegral mfd ormax [] x = x ormax x [] = x ormax (a:ar) (b:br) = (a .|. b) : ormax ar br #endif iteratee-0.8.9.4/src/Data/Iteratee/IO/Windows.hs0000644000000000000000000000020412021512063017345 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Iteratee.IO.Windows ( #if defined(USE_WINDOWS) #endif ) where #if defined(USE_WINDOWS) #endif iteratee-0.8.9.4/src/Data/Iteratee/IO/Base.hs0000644000000000000000000000071112021512063016570 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Iteratee.IO.Base ( #if defined(USE_WINDOWS) module Data.Iteratee.IO.Windows, #endif #if defined(USE_POSIX) module Data.Iteratee.IO.Posix, #else FileOffset #endif ) where #if defined(USE_WINDOWS) import Data.Iteratee.IO.Windows #endif -- Provide the FileOffset type, which is available in Posix modules -- and maybe Windows #if defined(USE_POSIX) import Data.Iteratee.IO.Posix #else type FileOffset = Integer #endif iteratee-0.8.9.4/src/Data/Iteratee/IO/Interact.hs0000644000000000000000000000206212021512063017470 0ustar0000000000000000module 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 #-} iteratee-0.8.9.4/Examples/0000755000000000000000000000000012021512063013430 5ustar0000000000000000iteratee-0.8.9.4/Examples/test_full2.txt0000644000000000000000000000024612021512063016256 0ustar0000000000000000header1: v1 header2: v2 header3: v3 header4: v4 1C body line 1 body line 2 2 body li 37 ne 3 body line 4 body line 5 0 iteratee-0.8.9.4/Examples/test_wc.hs0000644000000000000000000000066512021512063015443 0ustar0000000000000000import qualified Data.ByteString.Char8 as C import qualified Data.Iteratee as I import System cnt :: I.Iteratee C.ByteString IO Int cnt = I.liftI (step 0) where step acc (I.Chunk s) | C.null s = I.icont (step acc) Nothing | True = let acc' = acc + C.count '\n' s in acc' `seq` I.icont (step acc') Nothing step acc str = I.idone acc str main = do [f] <- getArgs I.fileDriverVBuf (2^16) cnt f >>= print iteratee-0.8.9.4/Examples/Tiff.hs0000644000000000000000000006110512021512063014657 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} -- Random and Binary IO with IterateeM -- A general-purpose TIFF library -- The library gives the user the TIFF dictionary, which the user -- can search for specific tags and obtain the values associated with -- the tags, including the pixel matrix. -- -- The overarching theme is incremental processing: initially, -- only the TIFF dictionary is read. The value associated with a tag -- is read only when that tag is looked up (unless the value was short -- and was packed in the TIFF dictionary entry). The pixel matrix -- (let alone the whole TIFF file) is not loaded in memory -- -- the pixel matrix is not even located before it is needed. -- The matrix is processed incrementally, by a user-supplied -- iteratee. -- -- The incremental processing is accomplished by iteratees and enumerators. -- The enumerators are indeed first-class, they are stored -- in the interned TIFF dictionary data structure. These enumerators -- represent the values associated with tags; the values will be read -- on demand, when the enumerator is applied to a user-given iteratee. -- -- The library extensively uses nested streams, tacitly converting the -- stream of raw bytes from the file into streams of integers, -- rationals and other user-friendly items. The pixel matrix is -- presented as a contiguous stream, regardless of its segmentation -- into strips and physical arrangement. -- The library exhibits random IO and binary parsing, reading -- of multi-byte numeric data in big- or little-endian formats. -- The library can be easily adopted for AIFF, RIFF and other -- IFF formats. -- -- We show a representative application of the library: reading a sample -- TIFF file, printing selected values from the TIFF dictionary, -- verifying the values of selected pixels and computing the histogram -- of pixel values. The pixel verification procedure stops reading the -- pixel matrix as soon as all specified pixel values are verified. -- The histogram accumulation does read the entire matrix, but -- incrementally. Neither pixel matrix processing procedure loads -- the whole matrix in memory. In fact, we never read and retain -- more than the IO-buffer-full of raw data. -- This TIFF library is to be contrasted with the corresponding Scheme -- code: -- http://okmij.org/ftp/Scheme/binary-io.html#tiff -- The main distinction is using iteratees for on-demand processing. module Data.Iteratee.Codecs.Tiff where import Data.Iteratee import qualified Data.Iteratee as Iter import qualified Data.ListLike as LL import Data.Iteratee.Binary import Control.Monad import Control.Monad.Trans import Data.Char (chr) import Data.Int import Data.Word import Data.Ratio import Data.Maybe import qualified Data.IntMap as IM -- ======================================================================== -- Sample TIFF user code -- The following is sample code using the TIFF library (whose implementation -- is in the second part of this file). -- Our sample code prints interesting information from the TIFF -- dictionary (such as the dimensions, the resolution and the name -- of the image) -- The main user function. tiff_reader is the library function, -- which builds the TIFF dictionary. -- process_tiff is the user function, to extract useful data -- from the dictionary test_tiff :: FilePath -> IO () test_tiff = fileDriverRandom (tiff_reader >>= process_tiff) -- Sample TIFF processing function process_tiff :: MonadIO m => Maybe (IM.IntMap TIFFDE) -> Iteratee [Word8] m () process_tiff Nothing = return () process_tiff (Just dict) = do note ["dict size: ", show $ IM.size dict] -- Check tag values against the known values for the sample image check_tag TG_IMAGEWIDTH (flip dict_read_int dict) 129 check_tag TG_IMAGELENGTH (flip dict_read_int dict) 122 check_tag TG_BITSPERSAMPLE (flip dict_read_int dict) 8 check_tag TG_IMAGEDESCRIPTION (flip dict_read_string dict) "JPEG:gnu-head-sm.jpg 129x122" check_tag TG_COMPRESSION (flip dict_read_int dict) 1 check_tag TG_SAMPLESPERPIXEL (flip dict_read_int dict) 1 check_tag TG_STRIPBYTECOUNTS (flip dict_read_int dict) 15738 -- nrows*ncols check_tag TG_XRESOLUTION (flip dict_read_rat dict) (72%1) check_tag TG_YRESOLUTION (flip dict_read_rat dict) (72%1) (n,hist) <- compute_hist dict note ["computed histogram over ", show n, " values\n", show hist] --iterReportError >>= maybe (return ()) error note ["Verifying values of sample pixels"] verify_pixel_vals dict [(0,255), (17,248)] --err <- iterReportError --maybe (return ()) error err --return err where check_tag tag action v = do vc <- action tag case vc of Just v' | v' == v -> note ["Tag ",show tag, " value ", show v] _ -> error $ unwords ["Tag", show tag, "unexpected:", show vc] -- process_tiff Nothing = return Nothing -- sample processing of the pixel matrix: computing the histogram compute_hist :: MonadIO m => TIFFDict -> Iteratee [Word8] m (Int,IM.IntMap Int) compute_hist dict = Iter.joinI $ pixel_matrix_enum dict $ compute_hist' 0 IM.empty where --compute_hist' count = liftI . Cont . step count compute_hist' count hist = icont (step count hist) Nothing step count hist (Chunk ch) | LL.null ch = icont (step count hist) Nothing | otherwise = icont (step (count + LL.length ch) (foldr accum hist ch)) Nothing step count hist s = idone (count,hist) s accum e = IM.insertWith (+) (fromIntegral e) 1 -- Another sample processor of the pixel matrix: verifying values of -- some pixels -- This processor does not read the whole matrix; it stops as soon -- as everything is verified or the error is detected verify_pixel_vals :: MonadIO m => TIFFDict -> [(IM.Key, Word8)] -> Iteratee [Word8] m () verify_pixel_vals dict pixels = Iter.joinI $ pixel_matrix_enum dict $ verify 0 (IM.fromList pixels) where verify _ m | IM.null m = return () verify n m = icont (step n m) Nothing step n m (Chunk xs) | LL.null xs = icont (step n m) Nothing | otherwise = let (h, t) = (LL.head xs, LL.tail xs) in case IM.updateLookupWithKey (\_k _e -> Nothing) n m of (Just v,m') -> if v == h then step (succ n) m' (Chunk t) else let er = (unwords ["Pixel #",show n, "expected:",show v, "found", show h]) in icont (const . throwErr . iterStrExc $ er) (Just $ iterStrExc er) (Nothing,m')-> step (succ n) m' (Chunk t) step _n _m s = idone () s -- ======================================================================== -- TIFF library code -- A TIFF directory is a finite map associating a TIFF tag with -- a record TIFFDE type TIFFDict = IM.IntMap TIFFDE data TIFFDE = TIFFDE{tiffde_count :: Int, -- number of items tiffde_enum :: TIFFDE_ENUM -- enumerator to get values } type EnumeratorM sFrom sTo m a = Iteratee sTo m a -> m (Iteratee sFrom m a) joinL :: (Monad m, Nullable s) => m (Iteratee s m a) -> Iteratee s m a joinL = join . lift data TIFFDE_ENUM = TEN_CHAR (forall a m. Monad m => EnumeratorM [Word8] [Char] m a) | TEN_BYTE (forall a m. Monad m => EnumeratorM [Word8] [Word8] m a) | TEN_INT (forall a m. Monad m => EnumeratorM [Word8] [Int] m a) | TEN_RAT (forall a m. Monad m => EnumeratorM [Word8] [Ratio Int] m a) -- Standard TIFF data types data TIFF_TYPE = TT_NONE -- 0 | TT_byte -- 1 8-bit unsigned integer | TT_ascii -- 2 8-bit bytes with last byte null | TT_short -- 3 16-bit unsigned integer | TT_long -- 4 32-bit unsigned integer | TT_rational -- 5 64-bit fractional (numer+denominator) -- The following was added in TIFF 6.0 | TT_sbyte -- 6 8-bit signed (2s-complement) integer | TT_undefined -- 7 An 8-bit byte, "8-bit chunk" | TT_sshort -- 8 16-bit signed (2s-complement) integer | TT_slong -- 9 32-bit signed (2s-complement) integer | TT_srational -- 10 "signed rational", two SLONGs (num+denominator) | TT_float -- 11 "IEEE 32-bit float", single precision (4-byte) | TT_double -- 12 "IEEE 64-bit double", double precision (8-byte) deriving (Eq, Enum, Ord, Bounded, Show) -- Standard TIFF tags data TIFF_TAG = TG_other Int -- other than below | TG_SUBFILETYPE -- subfile data descriptor | TG_OSUBFILETYPE -- +kind of data in subfile | TG_IMAGEWIDTH -- image width in pixels | TG_IMAGELENGTH -- image height in pixels | TG_BITSPERSAMPLE -- bits per channel (sample) | TG_COMPRESSION -- data compression technique | TG_PHOTOMETRIC -- photometric interpretation | TG_THRESHOLDING -- +thresholding used on data | TG_CELLWIDTH -- +dithering matrix width | TG_CELLLENGTH -- +dithering matrix height | TG_FILLORDER -- +data order within a byte | TG_DOCUMENTNAME -- name of doc. image is from | TG_IMAGEDESCRIPTION -- info about image | TG_MAKE -- scanner manufacturer name | TG_MODEL -- scanner model name/number | TG_STRIPOFFSETS -- offsets to data strips | TG_ORIENTATION -- +image orientation | TG_SAMPLESPERPIXEL -- samples per pixel | TG_ROWSPERSTRIP -- rows per strip of data | TG_STRIPBYTECOUNTS -- bytes counts for strips | TG_MINSAMPLEVALUE -- +minimum sample value | TG_MAXSAMPLEVALUE -- maximum sample value | TG_XRESOLUTION -- pixels/resolution in x | TG_YRESOLUTION -- pixels/resolution in y | TG_PLANARCONFIG -- storage organization | TG_PAGENAME -- page name image is from | TG_XPOSITION -- x page offset of image lhs | TG_YPOSITION -- y page offset of image lhs | TG_FREEOFFSETS -- +byte offset to free block | TG_FREEBYTECOUNTS -- +sizes of free blocks | TG_GRAYRESPONSEUNIT -- gray scale curve accuracy | TG_GRAYRESPONSECURVE -- gray scale response curve | TG_GROUP3OPTIONS -- 32 flag bits | TG_GROUP4OPTIONS -- 32 flag bits | TG_RESOLUTIONUNIT -- units of resolutions | TG_PAGENUMBER -- page numbers of multi-page | TG_COLORRESPONSEUNIT -- color scale curve accuracy | TG_COLORRESPONSECURVE -- RGB response curve | TG_SOFTWARE -- name & release | TG_DATETIME -- creation date and time | TG_ARTIST -- creator of image | TG_HOSTCOMPUTER -- machine where created | TG_PREDICTOR -- prediction scheme w/ LZW | TG_WHITEPOINT -- image white point | TG_PRIMARYCHROMATICITIES -- primary chromaticities | TG_COLORMAP -- RGB map for pallette image | TG_BADFAXLINES -- lines w/ wrong pixel count | TG_CLEANFAXDATA -- regenerated line info | TG_CONSECUTIVEBADFAXLINES -- max consecutive bad lines | TG_MATTEING -- alpha channel is present deriving (Eq, Show) tag_map :: Num t => [(TIFF_TAG, t)] tag_map = [ (TG_SUBFILETYPE,254), (TG_OSUBFILETYPE,255), (TG_IMAGEWIDTH,256), (TG_IMAGELENGTH,257), (TG_BITSPERSAMPLE,258), (TG_COMPRESSION,259), (TG_PHOTOMETRIC,262), (TG_THRESHOLDING,263), (TG_CELLWIDTH,264), (TG_CELLLENGTH,265), (TG_FILLORDER,266), (TG_DOCUMENTNAME,269), (TG_IMAGEDESCRIPTION,270), (TG_MAKE,271), (TG_MODEL,272), (TG_STRIPOFFSETS,273), (TG_ORIENTATION,274), (TG_SAMPLESPERPIXEL,277), (TG_ROWSPERSTRIP,278), (TG_STRIPBYTECOUNTS,279), (TG_MINSAMPLEVALUE,280), (TG_MAXSAMPLEVALUE,281), (TG_XRESOLUTION,282), (TG_YRESOLUTION,283), (TG_PLANARCONFIG,284), (TG_PAGENAME,285), (TG_XPOSITION,286), (TG_YPOSITION,287), (TG_FREEOFFSETS,288), (TG_FREEBYTECOUNTS,289), (TG_GRAYRESPONSEUNIT,290), (TG_GRAYRESPONSECURVE,291), (TG_GROUP3OPTIONS,292), (TG_GROUP4OPTIONS,293), (TG_RESOLUTIONUNIT,296), (TG_PAGENUMBER,297), (TG_COLORRESPONSEUNIT,300), (TG_COLORRESPONSECURVE,301), (TG_SOFTWARE,305), (TG_DATETIME,306), (TG_ARTIST,315), (TG_HOSTCOMPUTER,316), (TG_PREDICTOR,317), (TG_WHITEPOINT,318), (TG_PRIMARYCHROMATICITIES,319), (TG_COLORMAP,320), (TG_BADFAXLINES,326), (TG_CLEANFAXDATA,327), (TG_CONSECUTIVEBADFAXLINES,328), (TG_MATTEING,32995) ] tag_map' :: IM.IntMap TIFF_TAG tag_map' = IM.fromList $ map (\(tag,v) -> (v,tag)) tag_map tag_to_int :: TIFF_TAG -> Int tag_to_int (TG_other x) = x tag_to_int x = fromMaybe (error $ "not found tag: " ++ show x) $ lookup x tag_map int_to_tag :: Int -> TIFF_TAG int_to_tag x = fromMaybe (TG_other x) $ IM.lookup x tag_map' -- The library function to read the TIFF dictionary tiff_reader :: Iteratee [Word8] IO (Maybe TIFFDict) tiff_reader = do endian <- read_magic check_version case endian of Just e -> do endianRead4 e >>= Iter.seek . fromIntegral load_dict e Nothing -> return Nothing where -- Read the magic and set the endianness read_magic = do c1 <- Iter.head c2 <- Iter.head case (c1,c2) of (0x4d, 0x4d) -> return $ Just MSB (0x49, 0x49) -> return $ Just LSB _ -> (throwErr . iterStrExc $ "Bad TIFF magic word: " ++ show [c1,c2]) >> return Nothing -- Check the version in the header. It is always ... tiff_version = 42 check_version = do v <- endianRead2 MSB if v == tiff_version then return () else throwErr (iterStrExc $ "Bad TIFF version: " ++ show v) -- A few conversion procedures u32_to_float :: Word32 -> Double u32_to_float _x = -- unsigned 32-bit int -> IEEE float error "u32->float is not yet implemented" u32_to_s32 :: Word32 -> Int32 -- unsigned 32-bit int -> signed 32 bit u32_to_s32 = fromIntegral -- u32_to_s32 0x7fffffff == 0x7fffffff -- u32_to_s32 0xffffffff == -1 u16_to_s16 :: Word16 -> Int16 -- unsigned 16-bit int -> signed 16 bit u16_to_s16 = fromIntegral -- u16_to_s16 32767 == 32767 -- u16_to_s16 32768 == -32768 -- u16_to_s16 65535 == -1 u8_to_s8 :: Word8 -> Int8 -- unsigned 8-bit int -> signed 8 bit u8_to_s8 = fromIntegral -- u8_to_s8 127 == 127 -- u8_to_s8 128 == -128 -- u8_to_s8 255 == -1 note :: (MonadIO m, Nullable s) => [String] -> Iteratee s m () note = liftIO . putStrLn . concat -- An internal function to load the dictionary. It assumes that the stream -- is positioned to read the dictionary load_dict :: MonadIO m => Endian -> Iteratee [Word8] m (Maybe TIFFDict) load_dict e = do nentries <- endianRead2 e dict <- foldr (const read_entry) (return (Just IM.empty)) [1..nentries] next_dict <- endianRead4 e when (next_dict > 0) $ note ["The TIFF file contains several images, ", "only the first one will be considered"] return dict where read_entry dictM = dictM >>= maybe (return Nothing) (\dict -> do tag <- endianRead2 e typ' <- endianRead2 e typ <- convert_type (fromIntegral typ') count <- endianRead4 e -- we read the val-offset later. We need to check the size and the type -- of the datum, because val-offset may contain the value itself, -- in its lower-numbered bytes, regardless of the big/little endian -- order! note ["TIFFEntry: tag ",show . int_to_tag . fromIntegral $ tag, " type ", show typ, " count ", show count] enum_m <- maybe (return Nothing) (\t -> read_value t e (fromIntegral count)) typ case enum_m of Just enum -> return . Just $ IM.insert (fromIntegral tag) (TIFFDE (fromIntegral count) enum) dict _ -> return (Just dict) ) convert_type :: (Monad m, Nullable s) => Int -> Iteratee s m (Maybe TIFF_TYPE) convert_type typ | typ > 0 && typ <= fromEnum (maxBound::TIFF_TYPE) = return . Just . toEnum $ typ convert_type typ = do throwErr . iterStrExc $ "Bad type of entry: " ++ show typ return Nothing read_value :: MonadIO m => TIFF_TYPE -> Endian -> Int -> Iteratee [Word8] m (Maybe TIFFDE_ENUM) read_value typ e' 0 = do endianRead4 e' throwErr . iterStrExc $ "Zero count in the entry of type: " ++ show typ return Nothing -- Read an ascii string from the offset in the -- dictionary. The last byte of -- an ascii string is always zero, which is -- included in 'count' but we don't need to read it read_value TT_ascii e' count | count > 4 = do -- val-offset is offset offset <- endianRead4 e' return . Just . TEN_CHAR $ \iter_char -> return $ do Iter.seek (fromIntegral offset) let iter = convStream (liftM ((:[]) . chr . fromIntegral) Iter.head) iter_char Iter.joinI $ Iter.joinI $ Iter.take (pred count) iter -- Read the string of 0 to 3 characters long -- The zero terminator is included in count, but -- we don't need to read it read_value TT_ascii _e count = do -- count is within 1..4 let len = pred count -- string length let loop acc 0 = return . Just . reverse $ acc loop acc n = Iter.head >>= (\v -> loop ((chr . fromIntegral $ v):acc) (pred n)) str <- loop [] len Iter.drop (4-len) case str of Just str' -> return . Just . TEN_CHAR $ immed_value str' Nothing -> return Nothing -- Read the array of signed or unsigned bytes read_value typ e' count | count > 4 && typ == TT_byte || typ == TT_sbyte = do offset <- endianRead4 e' return . Just . TEN_INT $ \iter_int -> return $ do Iter.seek (fromIntegral offset) let iter = convStream (liftM ((:[]) . conv_byte typ) Iter.head) iter_int Iter.joinI $ Iter.joinI $ Iter.take count iter -- Read the array of 1 to 4 bytes read_value typ _e count | typ == TT_byte || typ == TT_sbyte = do let loop acc 0 = return . Just . reverse $ acc loop acc n = Iter.head >>= (\v -> loop (conv_byte typ v:acc) (pred n)) str <- (loop [] count) Iter.drop (4-count) case str of Just str' -> return . Just . TEN_INT $ immed_value str' Nothing -> return Nothing -- Read the array of Word8 read_value TT_undefined e' count | count > 4 = do offset <- endianRead4 e' return . Just . TEN_BYTE $ \iter -> return $ do Iter.seek (fromIntegral offset) Iter.joinI $ Iter.take count iter -- Read the array of Word8 of 1..4 elements, -- packed in the offset field read_value TT_undefined _e count = do let loop acc 0 = return . Just . reverse $ acc loop acc n = Iter.head >>= (\v -> loop (v:acc) (pred n)) str <- loop [] count Iter.drop (4-count) case str of Just str' -> return . Just . TEN_BYTE $ immed_value str' Nothing -> return Nothing --return . Just . TEN_BYTE $ immed_value str -- Read the array of short integers -- of 1 element: the offset field contains the value read_value typ e' 1 | typ == TT_short || typ == TT_sshort = do item <- endianRead2 e' Iter.drop 2 -- skip the padding return . Just . TEN_INT $ immed_value [conv_short typ item] -- of 2 elements: the offset field contains the value read_value typ e' 2 | typ == TT_short || typ == TT_sshort = do i1 <- endianRead2 e' i2 <- endianRead2 e' return . Just . TEN_INT $ immed_value [conv_short typ i1, conv_short typ i2] -- of n elements read_value typ e' count | typ == TT_short || typ == TT_sshort = do offset <- endianRead4 e' return . Just . TEN_INT $ \iter_int -> return $ do Iter.seek (fromIntegral offset) let iter = convStream (liftM ((:[]) . conv_short typ) (endianRead2 e')) iter_int Iter.joinI $ Iter.joinI $ Iter.take (2*count) iter -- Read the array of long integers -- of 1 element: the offset field contains the value read_value typ e' 1 | typ == TT_long || typ == TT_slong = do item <- endianRead4 e' return . Just . TEN_INT $ immed_value [conv_long typ item] -- of n elements read_value typ e' count | typ == TT_long || typ == TT_slong = do offset <- endianRead4 e' return . Just . TEN_INT $ \iter_int -> return $ do Iter.seek (fromIntegral offset) let iter = convStream (liftM ((:[]) . conv_long typ) (endianRead4 e')) iter_int Iter.joinI $ Iter.joinI $ Iter.take (4*count) iter read_value typ e' count = do -- stub _offset <- endianRead4 e' note ["unhandled type: ", show typ, " with count ", show count] return Nothing immed_value :: (Monad m) => [el] -> EnumeratorM [Word8] [el] m a immed_value item iter = --(Iter.enumPure1Chunk item >. enumEof) iter >>== Iter.joinI . return return . joinI . return . joinIM $ (enumPure1Chunk item >>> enumEof) iter conv_byte :: TIFF_TYPE -> Word8 -> Int conv_byte TT_byte = fromIntegral conv_byte TT_sbyte = fromIntegral . u8_to_s8 conv_byte _ = error "conv_byte called with non-byte type" conv_short :: TIFF_TYPE -> Word16 -> Int conv_short TT_short = fromIntegral conv_short TT_sshort = fromIntegral . u16_to_s16 conv_short _ = error "conv_short called with non-short type" conv_long :: TIFF_TYPE -> Word32 -> Int conv_long TT_long = fromIntegral conv_long TT_slong = fromIntegral . u32_to_s32 conv_long _ = error "conv_long called with non-long type" -- Reading the pixel matrix -- For simplicity, we assume no compression and 8-bit pixels pixel_matrix_enum :: MonadIO m => TIFFDict -> Enumeratee [Word8] [Word8] m a pixel_matrix_enum dict iter = validate_dict >>= proceed where -- Make sure we can handle this particular TIFF image validate_dict = do dict_assert TG_COMPRESSION 1 dict_assert TG_SAMPLESPERPIXEL 1 dict_assert TG_BITSPERSAMPLE 8 ncols <- liftM (fromMaybe 0) $ dict_read_int TG_IMAGEWIDTH dict nrows <- liftM (fromMaybe 0) $ dict_read_int TG_IMAGELENGTH dict strip_offsets <- liftM (fromMaybe [0]) $ dict_read_ints TG_STRIPOFFSETS dict rps <- liftM (fromMaybe nrows) (dict_read_int TG_ROWSPERSTRIP dict) if ncols > 0 && nrows > 0 && rps > 0 then return $ Just (ncols,nrows,rps,strip_offsets) else return Nothing dict_assert tag v = do vfound <- dict_read_int tag dict case vfound of Just v' | v' == v -> return $ Just () _ -> throwErr (iterStrExc (unwords ["dict_assert: tag:", show tag, "expected:", show v, "found:", show vfound])) >> return Nothing proceed Nothing = throwErr $ iterStrExc "Can't handle this TIFF" proceed (Just (ncols,nrows,rows_per_strip,strip_offsets)) = do let strip_size = rows_per_strip * ncols image_size = nrows * ncols note ["Processing the pixel matrix, ", show image_size, " bytes"] let loop _pos [] iter' = return iter' loop pos (strip:strips) iter' = do Iter.seek (fromIntegral strip) let len = min strip_size (image_size - pos) iter'' <- Iter.take (fromIntegral len) iter' loop (pos+len) strips iter'' loop 0 strip_offsets iter -- A few helpers for getting data from TIFF dictionary dict_read_int :: Monad m => TIFF_TAG -> TIFFDict -> Iteratee [Word8] m (Maybe Int) dict_read_int tag dict = do els <- dict_read_ints tag dict case els of Just (e:_) -> return $ Just e _ -> return Nothing dict_read_ints :: Monad m => TIFF_TAG -> TIFFDict -> Iteratee [Word8] m (Maybe [Int]) dict_read_ints tag dict = case IM.lookup (tag_to_int tag) dict of Just (TIFFDE _ (TEN_INT enum)) -> do e <- joinL $ enum stream2list return (Just e) _ -> return Nothing dict_read_rat :: Monad m => TIFF_TAG -> TIFFDict -> Iteratee [Word8] m (Maybe (Ratio Int)) dict_read_rat tag dict = case IM.lookup (tag_to_int tag) dict of Just (TIFFDE 1 (TEN_RAT enum)) -> do [e] <- joinL $ enum stream2list return (Just e) _ -> return Nothing dict_read_string :: Monad m => TIFF_TAG -> TIFFDict -> Iteratee [Word8] m (Maybe String) dict_read_string tag dict = case IM.lookup (tag_to_int tag) dict of Just (TIFFDE _ (TEN_CHAR enum)) -> do e <- joinL $ enum stream2list return (Just e) _ -> return Nothing iteratee-0.8.9.4/Examples/test_full3.txt0000644000000000000000000000024712021512063016260 0ustar0000000000000000header1: v1 header2: v2 header3: v3 header4: v4 1C body line 1 body line 2 7 body li 38 ne 3 body line 4 body line 5 0 iteratee-0.8.9.4/Examples/itertut.lhs0000644000000000000000000003414712021512063015651 0ustar0000000000000000> {-# LANGUAGE RankNTypes #-} > > module IterTut where > > import Prelude hiding (drop, take) > import Data.Iteratee > import qualified Data.ListLike as LL > import Control.Monad.Identity Reference material on Iteratees : http://okmij.org/ftp/Streams.html http://ianen.org/articles/understanding-iteratees/ This tutorial is based on http://okmij.org/ftp/Haskell/Iteratee/IterateeIO-talk-notes.pdf amongst other sources. Hopefully you will find my additions positive. [This tutorial is still incomplete, however I am including it in this release as I hope the section on the CPS transform will be useful to users switching to the new library. JL] Exercises : given a text file of Ints separated by newlines, write a function which returns the first Int greater than a given k, or Nothing. Do this once using explicit handle operations (hGetLine) and again using lazy IO (hGetContents.) Problems : Handle IO is inconvenient : imperative, not composeable. LazyIO (e.g. hGetContents) has unreliable semantics : when do the handles get closed? What is the resouce usage? This example is a toy -- imagine parsing HTTP requests in a high-performance server. Imperative parsers are ugly, but we cannot sacrifice performance and use lazy IO. Oleg's solution : realize IO as left folds over streams. Recall the left fold foldl :: (a -> b -> a) -> a -> [b] -> a This is broken up into three parts : the input list [b], the worker function (a -> b -> a) and initial state a, and the folding function itself ("fold"). The input list is generalized into the Stream type : > type ErrMsg = String > > data BasicStream a = B_Chunk [a] | B_EOF (Maybe ErrMsg) We support chunked reads and non-blocking IO. B_Chunk [] means the handle is open but there isn't data available yet. The worker function (plus state) is generalized into the Iteratee type : > data BasicIteratee a b = Done b (BasicStream a) > | Cont (BasicStream a -> BasicIteratee a b) (Maybe ErrMsg) An iteratee is either done, returning a value and the remaining input, or ready for more input. The first argument to B_Cont is a function that accepts more input, and advances the iteratee's state -- a "continuation." An iteratee can possibly be in an error state (e.g. if parsing invalid data), as indicated by the second argument. Simple examples : > peekB :: BasicIteratee a (Maybe a) > peekB = Cont step Nothing > where step (B_Chunk []) = peekB > step c@(B_Chunk (x:xs)) = Done (Just x) c > step stream = Done Nothing stream > > headBI :: BasicIteratee a a > headBI = Cont step Nothing > where step (B_Chunk []) = headBI > step c@(B_Chunk (x:xs)) = Done x $ B_Chunk xs > step iter = Cont step $ Just "EOF" > > throwErrB :: ErrMsg -> BasicIteratee a b > throwErrB e = Cont (\_ -> throwErrB e) (Just e) > > dropB :: Int -> BasicIteratee a () > dropB n = Cont (step n) Nothing > where step 0 st = Done () st peek returns the next element, or Nothing if the stream is EOF. headBI is like head. The folding function is generalized to the Enumerator type. It's job is to feed an iteratee the contents of some resource, until it is exhausted or the iteratee is done. > type BasicEnumerator a b = BasicIteratee a b -> BasicIteratee a b The simplest enumerator just feeds EOF : > sendEOF :: BasicEnumerator a b > sendEOF (Cont k Nothing) = > case k $ B_EOF Nothing of > iter@(Cont _ Nothing) -> throwErrB "Divergent iteratee" > iter -> iter > sendEOF (Done x _) = Done x $ B_EOF Nothing > sendEOF i = i We can feed the contents of a list to an iteratee : > enumListB :: [a] -> BasicEnumerator a b > enumListB lst (Cont k Nothing) = k $ B_Chunk lst > enumListB _ i = i > > enumListNChunkB :: [a] -> Int -> BasicEnumerator a b > enumListNChunkB ls n it > | n <= 0 = error "Invalid n" > | Prelude.null ls = it > | otherwise = > case it of > Cont k Nothing -> enumListNChunkB t n $ k (B_Chunk h) > where (h,t) = splitAt n ls > _ -> it The first sends the list in one big chunk; the second in chunks of size no larger than n. Advantages : One perspective : lazy IO does not couple the resource (the handle) with the demand tightly enough -- the list interface is too abstract. The iteratee / enumerator protocol makes the demand explicit, and the continuation passing style makes resource lifetime understandable. ------------------------ Composition : Horizontal ------------------------ Iteratees, unlike Handle IO, are compositional in many ways. First is "horizontal" : > instance Monad (BasicIteratee a) where Monadic composition is chaining iteratees : "horizontal." In the simplest case, if the first iteratee is done without any remaining input, we pass the value it returns to the function f. > Done x (B_Chunk []) >>= f = f x If it is done but has more input or an EOF, we pass that to the next iteratee. > Done x st >>= f = case f x of If the next iteratee is also done, it is safe to ignore the "rest" of its "stream", since it was not actually fed any input. Otherwise we pass the stream (or error state) along. > Done y _ -> Done y st > Cont k Nothing -> k st > i -> i If the first iteratee wants to continue, the composition continues. If f has type b -> BasicIteratee a c, then (>>= f) has type BasicIteratee a b -> BasicIteratee a c. > Cont k e >>= f = Cont ((>>= f) . k) e Meanwhile a monadic value is a done iteratee returning the value. > return x = Done x (B_Chunk []) functors, applicative enumerator composition ---------------------- Composition : Vertical ---------------------- joinI, enumeratees > type BasicEnumeratee outer inner out = > BasicIteratee inner out -> BasicIteratee outer (BasicIteratee inner out) 'takeB' sends only the first n elements of the stream to the inner iteratee; even if more are available. > takeB :: Int -> BasicEnumeratee a a b > takeB 0 iter = return iter > takeB n it@(Done x _) = dropB n >> return (return x) > takeB n it@(Cont _ (Just e)) = dropB n >> throwErrB e > takeB n it@(Cont k Nothing) = Cont (step n k) Nothing > where step n k (B_Chunk []) = Cont (step n k) Nothing > step n k c@(B_Chunk l) > | Prelude.length l < n = takeB (n - Prelude.length l) $ k c > | otherwise = Done (k (B_Chunk h)) (B_Chunk t) > where (h,t) = splitAt n l > step n k st = Done (k st) st --------------- Generalizations --------------- StreamG, ListLike, Nullable / NullPoint : turn pattern-matching on lists into guards --------------- Monadic actions --------------- > type BasicEnumeratorM m a b = BasicIteratee a b -> m (BasicIteratee a b) BasicIterateeM, BasicEnumeratorM, BasicEnumerateeM --------- CPS-style --------- The actual iteratee library is "CPS transformed." (See Oleg's IterateeMCPS.hs.) It uses CPS on two levels : the first is in the continuation for the Cont state, and the second is to eliminate constructors. newtype Iteratee s m a = Iteratee { runIter :: forall r. (a -> StreamG s -> m r) -> ((StreamG s -> Iteratee s m a) -> Maybe SomeException -> m r) -> m r } The two arguments are continuations which return a value of type m r (for some Monad m); the iteratee will call one of these two continuations and return the value. The first argument is the continuation to call if the iteratee is in the "Done" state, the second if in the "Cont" state. Basic rule : replace separate constructors with calls to the appropriate arguments, and pattern matching with continuations passed into the appropriate argument. Streams stay the same. Iteratees : an iteratee in state X ==> a function that calls continuation X B_Done x s ==> Iteratee $ \onDone _ -> onDone x s B_Cont k e ==> Iteratee $ \_ onCont -> onCont k' e where k' s is the transformation of the BasicIteratee k s. Some synonyms : idone x s = Iteratee $ \od _ -> od x s return x = idone x (Chunk empty) icont k e = Iteratee $ \_ oc -> oc k e liftI k = icont k Nothing so B_Cont k Nothing = liftI k'. Example : headBI :: BasicIteratee a a headBI = Cont step Nothing -- turns into liftI step' where step (B_Chunk []) = headBI -- ListLike guard step c@(B_Chunk (x:xs)) = Done x $ B_Chunk xs -- Done ==> idone step iter = Cont step $ Just $ ErrMsg "EOF" -- Cont ==> icont ==> > headI :: (Monad m, LL.ListLike s a) => Iteratee s m a > headI = liftI step' > where step' (Chunk c) > | LL.null c = headI > | otherwise = idone (LL.head c) (Chunk $ LL.tail c) > step' st = icont step' (Just (setEOF st)) If the state of the iteratee depends some other parameter, the result of the continuation will be an argument of both state arguments (and the parameter.) myit x = Iteratee step where step od oc = ... Enumerators : pattern-match on an iteratee in state X => pass continuation into iteratee argument X case iter of B_Done x s -> f x s B_cont k e -> g k e ==> runIter iter onDone onCont where onDone x s = f' x s onCont k e = g' k e where f' x s is the transformation of the (monadic) iteratee f x s, and likewise for g' k e. Example : the identity (monadic) enumerator > idIB :: (Monad m) => BasicEnumeratorM m a b > idIB (Done x s) = return $ Done x s > idIB (Cont k e) = return $ Cont k e is transformed into > idI iter = runIter iter onDone onCont > where onDone x s = return $ idone x s > onCont k e = return $ icont k e With the synonyms idoneM = return . idone icontM = return . icont this simplifies to > idI' iter = runIter iter idoneM icontM Example : enumListNChunkB :: [a] -> Int -> BasicEnumerator a b enumListNChunkB ls n it | n <= 0 = error "Invalid n" | Prelude.null ls = it | otherwise = case it of Cont k Nothing -> enumListNChunkB t n $ k (B_Chunk h) where (h,t) = splitAt n ls _ -> it ==> > enumListNChunks :: (Monad m, LL.ListLike s el) => > s -> Int -> Enumerator s m b > enumListNChunks ls n it > | n <= 0 = error "Invalid n" > | LL.null ls = return it > | otherwise = runIter it idoneM onCont -- idoneM is the identity in the Done state > where onCont k Nothing = enumListNChunks t n $ k (Chunk h) > where (h, t) = LL.splitAt n ls > onCont k e = icontM k e -- icontM is the identity in the Cont state Enumeratees : ("iteratees and enumerators at the same time.") An example to keep in mind. mapB :: (el -> el') -> BasicEnumeratee el el' a mapB f it@(Done _ _) = Done it (B_Chunk []) mapB _ it@(Cont k (Just e)) = throwErrB e mapB f it@(Cont k Nothing) = Cont step Nothing where step (B_Chunk s) = mapB f $ k (B_Chunk $ map f s) step (B_EOF e) = mapB f $ k (B_EOF e) Let's try our hand at a translation : mapI f inner = ... An idiom : the return value is a nested iteratee, with an outer ("from") part and an inner part ("to"). According to our iteratee translation this is mapI f inner = Iteratee $ \onDoneF onContF -> ... The result of this outer iteratee typically depends on the state of the inner iteratee. Hence like with Enumerators we do a "pattern match" mapI f inner = Iteratee $ \onDoneF onContF -> let onDoneT x s = ... onContT k e = ... in runIter inner onDoneT onContT I've prefered using let instead of a where because it keeps the outer continuations onDoneF and onContF in scope. One of onDoneT or onContT will get called, depending on what state the "To" iteratee is in. Remember though we want to eventually call either onDoneF or onContF to signal what state the outer "From" iteratee is in. In the simplest cases we will simply directly call them, e.g. mapB f it@(Done _ _) = Done it (B_Chunk []) ===> let onDoneT x s = onDoneF it (Chunk empty) If we however build up our desired iteratee value via combinators, we need to remember to pass them the outer continuation messages : mapB _ it@(Cont k (Just e)) = throwErrB e -- this is a Cont iteratee ===> let onContT k (Just e) = runIter (throwErr e) onDoneF onContF Note only onContF will get called, since throwErr delivers a continuing iteratee. The complete translation (we've truncated onDoneF to odf, etc.) : > mapI :: (Monad m, LL.ListLike (s el) el, LL.ListLike (s el') el', > NullPoint (s el), NullPoint (s el') ) => > (el -> el') -> Enumeratee (s el) (s el') m a > mapI f it = Iteratee $ \odf ocf -> > let odt x s = odf it (Chunk empty) > oct _ (Just e) = runIter (throwErr e) odf ocf > oct k Nothing = ocf step Nothing > where > step (Chunk xs) > | LL.null xs = icont step Nothing > | otherwise = mapI f $ k (Chunk $ LL.map f xs) > step (EOF e) = mapI f $ k (EOF e) > in runIter it odt oct Another example : takeB :: Int -> BasicEnumeratee a a b takeB 0 iter = return iter takeB n it@(Done x _) = dropB n >> return (return x) takeB n it@(Cont _ (Just e)) = dropB n >> throwErrB e takeB n it@(Cont k Nothing) = Cont (step n k) Nothing where step n k (B_Chunk []) = Cont (step n k) Nothing step n k c@(B_Chunk l) | Prelude.length l < n = takeB (n - Prelude.length l) $ k c | otherwise = Done (k (B_Chunk h)) (B_Chunk t) where (h,t) = splitAt n l step n k st = Done (k st) st ==> > takeI :: (Monad m, Nullable a, LL.ListLike a el) => Int -> Enumeratee a a m b > takeI 0 iter = return iter > takeI n it = > Iteratee $ \odf ocf -> > let odt x _ = runIter (drop n >> return (return x)) odf ocf > oct _ (Just e) = runIter (drop n >> throwErr e) odf ocf > oct k Nothing = ocf (step n k) Nothing > where step n k c@(Chunk xs) > | LL.length xs < n = takeI (n - LL.length xs) $ k c > | otherwise = idone (k (Chunk h)) (Chunk t) > where (h,t) = LL.splitAt n xs > step n k st = idone (k st) st > in runIter it odt oct Exercise : why the calls to idone instead of odf? iteratee-0.8.9.4/Examples/test_full1.txt0000644000000000000000000000024412021512063016253 0ustar0000000000000000header1: v1 header2: v2 header3: v3 header4: v4 1C body line 1 body line 2 7 body li 37 ne 3 body line 4 body line 5 0 iteratee-0.8.9.4/Examples/Wave.hs0000644000000000000000000002610212021512063014667 0ustar0000000000000000{-# LANGUAGE RankNTypes, FlexibleContexts #-} {- This module is not meant primarily for instructive and pedagogical purposes. As such, it is not fully featured, and sacrifices performance and generality for clarity of code. -} module Data.Iteratee.Codecs.Wave {-# DEPRECATED "This will be moved to a separate package in the future" #-} ( WAVEDE (..), WAVEDE_ENUM (..), WAVE_CHUNK (..), AudioFormat (..), waveReader, readRiff, waveChunk, chunkToString, dictReadFormat, dictReadFirstFormat, dictReadLastFormat, dictReadFirstData, dictReadLastData, dictReadData, dictProcessData ) where import Prelude as P import Control.Monad (join) import Control.Monad.Trans (lift) import Data.Iteratee import qualified Data.Iteratee as Iter import Data.Iteratee.Binary import Data.Char (chr, ord) import Data.Int import Data.Word import Data.Bits (shiftL) import Data.Maybe import qualified Data.IntMap as IM -- ===================================================== -- WAVE libary code -- useful type synonyms -- |A WAVE directory is a list associating WAVE chunks with -- a record WAVEDE type WAVEDict = IM.IntMap [WAVEDE] data WAVEDE = WAVEDE{ wavede_count :: Int, -- ^length of chunk wavede_type :: WAVE_CHUNK, -- ^type of chunk wavede_enum :: WAVEDE_ENUM -- ^enumerator to get values of chunk } type EnumeratorM sFrom sTo m a = Iteratee sTo m a -> m (Iteratee sFrom m a) joinL :: (Monad m, Nullable s) => m (Iteratee s m a) -> Iteratee s m a joinL = join . lift data WAVEDE_ENUM = WEN_BYTE (forall a. EnumeratorM [Word8] [Word8] IO a) | WEN_DUB (forall a. EnumeratorM [Word8] [Double] IO a) -- |Standard WAVE Chunks data WAVE_CHUNK = WAVE_FMT -- ^Format | WAVE_DATA -- ^Data | WAVE_OTHER String -- ^Other deriving (Eq, Ord, Show) instance Enum WAVE_CHUNK where fromEnum WAVE_FMT = 1 fromEnum WAVE_DATA = 2 fromEnum (WAVE_OTHER _) = 3 toEnum 1 = WAVE_FMT toEnum 2 = WAVE_DATA toEnum 3 = WAVE_OTHER "" toEnum _ = error "Invalid enumeration value" -- ----------------- -- wave chunk reading/writing functions -- |Convert a string to WAVE_CHUNK type waveChunk :: String -> Maybe WAVE_CHUNK waveChunk str | str == "fmt " = Just WAVE_FMT | str == "data" = Just WAVE_DATA | P.length str == 4 = Just $ WAVE_OTHER str | otherwise = Nothing -- |Convert a WAVE_CHUNK to the representative string chunkToString :: WAVE_CHUNK -> String chunkToString WAVE_FMT = "fmt " chunkToString WAVE_DATA = "data" chunkToString (WAVE_OTHER str) = str -- ----------------- data AudioFormat = AudioFormat { numberOfChannels :: NumChannels, -- ^Number of channels in the audio data sampleRate :: SampleRate, -- ^Sample rate of the audio bitDepth :: BitDepth -- ^Bit depth of the audio data } deriving (Show, Eq) type NumChannels = Integer type SampleRate = Integer type BitDepth = Integer -- convenience function to read a 4-byte ASCII string stringRead4 :: Monad m => Iteratee [Word8] m String stringRead4 = do s1 <- Iter.head s2 <- Iter.head s3 <- Iter.head s4 <- Iter.head return $ map (chr . fromIntegral) [s1, s2, s3, s4] -- ----------------- -- |The library function to read the WAVE dictionary waveReader :: Iteratee [Word8] IO (Maybe WAVEDict) waveReader = do readRiff tot_size <- endianRead4 LSB readRiffWave chunks_m <- findChunks $ fromIntegral tot_size loadDict $ joinM chunks_m -- |Read the RIFF header of a file. readRiff :: Iteratee [Word8] IO () readRiff = do cnt <- heads $ fmap (fromIntegral . ord) "RIFF" if cnt == 4 then return () else throwErr $ iterStrExc "Bad RIFF header" -- | Read the WAVE part of the RIFF header. readRiffWave :: Iteratee [Word8] IO () readRiffWave = do cnt <- heads $ fmap (fromIntegral . ord) "WAVE" if cnt == 4 then return () else throwErr $ iterStrExc "Bad RIFF/WAVE header" -- | An internal function to find all the chunks. It assumes that the -- stream is positioned to read the first chunk. findChunks :: Int -> Iteratee [Word8] IO (Maybe [(Int, WAVE_CHUNK, Int)]) findChunks n = findChunks' 12 [] where findChunks' offset acc = do typ <- stringRead4 count <- endianRead4 LSB case waveChunk typ of Nothing -> (throwErr . iterStrExc $ "Bad subchunk descriptor: " ++ show typ) >> return Nothing Just chk -> let newpos = offset + 8 + count in case newpos >= fromIntegral n of True -> return . Just $ reverse $ (fromIntegral offset, chk, fromIntegral count) : acc False -> do Iter.seek $ fromIntegral newpos findChunks' newpos $ (fromIntegral offset, chk, fromIntegral count) : acc loadDict :: [(Int, WAVE_CHUNK, Int)] -> Iteratee [Word8] IO (Maybe WAVEDict) loadDict = P.foldl read_entry (return (Just IM.empty)) where read_entry dictM (offset, typ, count) = dictM >>= maybe (return Nothing) (\dict -> do enum_m <- readValue dict offset typ count case (enum_m, IM.lookup (fromEnum typ) dict) of (Just enum, Nothing) -> --insert new entry return . Just $ IM.insert (fromEnum typ) [WAVEDE (fromIntegral count) typ enum] dict (Just enum, Just _vals) -> --existing entry return . Just $ IM.update (\ls -> Just $ ls ++ [WAVEDE (fromIntegral count) typ enum]) (fromEnum typ) dict (Nothing, _) -> return (Just dict) ) readValue :: WAVEDict -> Int -> -- Offset WAVE_CHUNK -> -- Chunk type Int -> -- Count Iteratee [Word8] IO (Maybe WAVEDE_ENUM) readValue _dict offset _ 0 = do throwErr . iterStrExc $ "Zero count in the entry of chunk at: " ++ show offset return Nothing readValue dict offset WAVE_DATA count = do fmt_m <- dictReadLastFormat dict case fmt_m of Just fmt -> return . Just . WEN_DUB $ \iter_dub -> return $ do Iter.seek (8 + fromIntegral offset) let iter = Iter.convStream (convFunc fmt) iter_dub joinI . joinI . Iter.take count $ iter Nothing -> do throwErr . iterStrExc $ "No valid format for data chunk at: " ++ show offset return Nothing -- return the WaveFormat iteratee readValue _dict offset WAVE_FMT count = return . Just . WEN_BYTE $ \iter -> return $ do Iter.seek (8 + fromIntegral offset) Iter.joinI $ Iter.take count iter -- for WAVE_OTHER, return Word8s and maybe the user can parse them readValue _dict offset (WAVE_OTHER _str) count = return . Just . WEN_BYTE $ \iter -> return $ do Iter.seek (8 + fromIntegral offset) Iter.joinI $ Iter.take count iter -- |Convert Word8s to Doubles convFunc :: AudioFormat -> Iteratee [Word8] IO [Double] convFunc (AudioFormat _nc _sr 8) = fmap ((:[]) . normalize 8 . (fromIntegral :: Word8 -> Int8)) Iter.head convFunc (AudioFormat _nc _sr 16) = fmap ((:[]) . normalize 16 . (fromIntegral :: Word16 -> Int16)) (endianRead2 LSB) convFunc (AudioFormat _nc _sr 24) = fmap ((:[]) . normalize 24 . (fromIntegral :: Word32 -> Int32)) (endianRead3 LSB) convFunc (AudioFormat _nc _sr 32) = fmap ((:[]) . normalize 32 . (fromIntegral :: Word32 -> Int32)) (endianRead4 LSB) convFunc _ = error "unrecognized audio format in convFunc" eitherToMaybe :: Either a b -> Maybe b eitherToMaybe = either (const Nothing) Just -- |An Iteratee to read a wave format chunk sWaveFormat :: Iteratee [Word8] IO (Maybe AudioFormat) sWaveFormat = do f' <- endianRead2 LSB --data format, 1==PCM nc <- endianRead2 LSB sr <- endianRead4 LSB Iter.drop 6 bd <- endianRead2 LSB case f' == 1 of True -> return . Just $ AudioFormat (fromIntegral nc) (fromIntegral sr) (fromIntegral bd) False -> return Nothing -- --------------------- -- functions to assist with reading from the dictionary -- |Read the first format chunk in the WAVE dictionary. dictReadFirstFormat :: WAVEDict -> Iteratee [Word8] IO (Maybe AudioFormat) dictReadFirstFormat dict = case IM.lookup (fromEnum WAVE_FMT) dict of Just [] -> return Nothing Just ((WAVEDE _ WAVE_FMT (WEN_BYTE enum)) : _xs) -> joinIM $ enum sWaveFormat _ -> return Nothing -- |Read the last fromat chunk from the WAVE dictionary. This is useful -- when parsing all chunks in the dictionary. dictReadLastFormat :: WAVEDict -> Iteratee [Word8] IO (Maybe AudioFormat) dictReadLastFormat dict = case IM.lookup (fromEnum WAVE_FMT) dict of Just [] -> return Nothing Just xs -> let (WAVEDE _ WAVE_FMT (WEN_BYTE enum)) = last xs in joinIM $ enum sWaveFormat _ -> return Nothing -- |Read the specified format chunk from the WAVE dictionary dictReadFormat :: Int -> --Index in the format chunk list to read WAVEDict -> --Dictionary Iteratee [Word8] IO (Maybe AudioFormat) dictReadFormat ix dict = case IM.lookup (fromEnum WAVE_FMT) dict of Just xs -> let (WAVEDE _ WAVE_FMT (WEN_BYTE enum)) = (!!) xs ix in joinIM $ enum sWaveFormat _ -> return Nothing -- |Read the first data chunk in the WAVE dictionary. dictReadFirstData :: WAVEDict -> Iteratee [Word8] IO (Maybe [Double]) dictReadFirstData dict = case IM.lookup (fromEnum WAVE_DATA) dict of Just [] -> return Nothing Just ((WAVEDE _ WAVE_DATA (WEN_DUB enum)) : _xs) -> do e <- joinIM $ enum Iter.stream2list return $ Just e _ -> return Nothing -- |Read the last data chunk in the WAVE dictionary. dictReadLastData :: WAVEDict -> Iteratee [Word8] IO (Maybe [Double]) dictReadLastData dict = case IM.lookup (fromEnum WAVE_DATA) dict of Just [] -> return Nothing Just xs -> let (WAVEDE _ WAVE_DATA (WEN_DUB enum)) = last xs in do e <- joinIM $ enum Iter.stream2list return $ Just e _ -> return Nothing -- |Read the specified data chunk from the WAVE dictionary. dictReadData :: Int -> --Index in the data chunk list to read WAVEDict -> --Dictionary Iteratee [Word8] IO (Maybe [Double]) dictReadData ix dict = case IM.lookup (fromEnum WAVE_DATA) dict of Just xs -> let (WAVEDE _ WAVE_DATA (WEN_DUB enum)) = (!!) xs ix in do e <- joinIM $ enum Iter.stream2list return $ Just e _ -> return Nothing -- |Read the specified data chunk from the dictionary, applying the -- data to the specified Iteratee. dictProcessData :: Int -> -- Index in the data chunk list to read WAVEDict -> -- Dictionary Iteratee [Double] IO a -> Iteratee [Word8] IO (Maybe a) dictProcessData ix dict iter = case IM.lookup (fromEnum WAVE_DATA) dict of Just xs -> let (WAVEDE _ WAVE_DATA (WEN_DUB enum)) = (!!) xs ix in do e <- joinIM $ enum iter return $ Just e _ -> return Nothing -- --------------------- -- convenience functions -- |Convert (Maybe []) to []. Nothing maps to an empty list. joinM :: Maybe [a] -> [a] joinM Nothing = [] joinM (Just a) = a -- |Normalize a given value for the provided bit depth. normalize :: Integral a => BitDepth -> a -> Double normalize 8 a = (fromIntegral a - 128) / 128 normalize bd a = case (a > 0) of True -> fromIntegral a / divPos False -> fromIntegral a / divNeg where divPos = fromIntegral (1 `shiftL` fromIntegral (bd - 1) :: Int) - 1 divNeg = fromIntegral (1 `shiftL` fromIntegral (bd - 1) :: Int) iteratee-0.8.9.4/Examples/word.hs0000644000000000000000000000350612021512063014743 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- A simple wc-like program using Data.Iteratee. -- Demonstrates a few different ways of composing iteratees. module Main where import Prelude as P import Data.Iteratee import Data.Iteratee.Char as C import qualified Data.Iteratee as I import qualified Data.ByteString.Char8 as BC import Data.Word import Data.Char import Data.ListLike as LL import System.Environment -- | An iteratee to calculate the number of characters in a stream. -- Very basic, assumes ASCII, not particularly efficient. numChars :: (Monad m, ListLike s el) => I.Iteratee s m Int numChars = I.length -- | An iteratee to calculate the number of words in a stream of Word8's. -- this operates on a Word8 stream in order to use ByteStrings. -- -- This function converts the stream of Word8s into a stream of words, -- then counts the words with Data.Iteratee.length -- This is the equivalent of "length . BC.words". numWords :: Monad m => I.Iteratee BC.ByteString m Int numWords = I.joinI $ enumWordsBS I.length -- | Count the number of lines, in the same manner as numWords. numLines :: Monad m => I.Iteratee BC.ByteString m Int numLines = I.joinI $ enumLinesBS I.length -- | A much more efficient numLines using the foldl' iteratee. -- Rather than converting a stream, this simply counts newline characters. numLines2 :: Monad m => I.Iteratee BC.ByteString m Int numLines2 = I.foldl' step 0 where step !acc el = if el == (fromIntegral $ ord '\n') then acc + 1 else acc -- | Combine multiple iteratees into a single unit using "enumPair". -- 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.zip` numChars main = do f:_ <- getArgs words <- fileDriverVBuf 65536 twoIter f print words iteratee-0.8.9.4/Examples/headers.hs0000644000000000000000000001403612021512063015403 0ustar0000000000000000import Data.Iteratee import qualified Data.Iteratee as Iter import Data.Iteratee.Char import qualified Data.Iteratee.IO as IIO import Control.Monad.Trans import Control.Monad.Identity import Data.Char import Data.Word -- HTTP chunk decoding -- Each chunk has the following format: -- -- CRLF CRLF -- -- where is the hexadecimal number; is a -- sequence of bytes. -- The last chunk (so-called EOF chunk) has the format -- 0 CRLF CRLF (where 0 is an ASCII zero, a character with the decimal code 48). -- For more detail, see "Chunked Transfer Coding", Sec 3.6.1 of -- the HTTP/1.1 standard: -- http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.6.1 -- The following enum_chunk_decoded has the signature of the enumerator -- of the nested (encapsulated and chunk-encoded) stream. It receives -- an iteratee for the embedded stream and returns the iteratee for -- the base, embedding stream. Thus what is an enumerator and what -- is an iteratee may be a matter of perspective. -- We have a decision to make: Suppose an iteratee has finished (either because -- it obtained all needed data or encountered an error that makes further -- processing meaningless). While skipping the rest of the stream/the trailer, -- we encountered a framing error (e.g., missing CRLF after chunk data). -- What do we do? We chose to disregard the latter problem. -- Rationale: when the iteratee has finished, we are in the process -- of skipping up to the EOF (draining the source). -- Disregarding the errors seems OK then. -- Also, the iteratee may have found an error and decided to abort further -- processing. Flushing the remainder of the input is reasonable then. -- One can make a different choice... -- Upon further consideration, I reversed the earlier decision: -- if we detected a framing error, we can't trust the rest of the stream -- We can't skip till the EOF chunk as we aren't even sure we can -- recognize the EOF chunk any more. -- So, we just report the _recoverable_ error upstream: -- the recovery will be to report the accumlated nested iteratee. enum_chunk_decoded :: Monad m => Iteratee m a -> m (Iteratee m a) enum_chunk_decoded iter = return read_size where read_size = Iter.break (== '\r') >>= checkCRLF iter . check_size checkCRLF iter' m = do n <- heads "\r\n" if n == 2 then m else frame_err "Bad Chunk: no CRLF" iter' check_size "0" = checkCRLF iter (joinIM $ enumEof iter) check_size str@(_:_) = maybe (frame_err ("Bad chunk size: " ++ str) iter) read_chunk $ read_hex 0 str check_size _ = frame_err "Error reading chunk size" iter read_chunk size = Iter.take size iter >>= \r -> checkCRLF r (joinIM $ enum_chunk_decoded r) read_hex acc "" = Just acc read_hex acc (d:rest) | isHexDigit d = read_hex (16*acc + digitToInt d) rest read_hex acc _ = Nothing frame_err e iter = IterateeT (\_ -> return $ Cont (joinIM $ enumErr e iter) (Just $ Err "Frame error")) -- ------------------------------------------------------------------------ -- Tests -- Pure tests, requiring no IO read_lines_rest :: Iteratee Identity (Either [Line] [Line], String) read_lines_rest = do ls <- readLines ErrOnEof rest <- Iter.break (const False) return (ls, rest) test_str1 :: String test_str1 = "header1: v1\rheader2: v2\r\nheader3: v3\nheader4: v4\n" ++ "header5: v5\r\nheader6: v6\r\nheader7: v7\r\n\nrest\n" testp1 :: Bool testp1 = let (Right lines, rest) = runIdentity . run . joinIM $ enumPure1Chunk test_str1 read_lines_rest in lines == ["header1: v1","header2: v2","header3: v3","header4: v4", "header5: v5","header6: v6","header7: v7"] && rest == "rest\n" testp2 :: Bool testp2 = let (Right lines, rest) = runIdentity . run . joinIM $ enumPureNChunk test_str1 5 read_lines_rest in lines == ["header1: v1","header2: v2","header3: v3","header4: v4", "header5: v5","header6: v6","header7: v7"] && rest == "rest\n" -- Run the complete test, reading the headers and the body test_driver_full filepath = do putStrLn "About to read headers" result <- fileDriver read_headers_body filepath putStrLn "Finished reading" case result of (Right headers, Right body, _) -> do putStrLn "Complete headers" print headers putStrLn "\nComplete body" print body (Left headers, _, status) -> do putStrLn $ "Problem " ++ show status putStrLn "Incomplete headers" print headers (Right headers, Left body, status) -> do putStrLn "Complete headers" print headers putStrLn $ "Problem " ++ show status putStrLn "Incomplete body" print body where read_headers_body = do headers <- readLines ErrOnEof body <- joinIM . enum_chunk_decoded $ readLines ErrOnEof status <- getStatus return (headers, body, status) test31 = do putStrLn "Expected result is:" putStrLn "About to read headers" putStrLn "Finished reading" putStrLn "Complete headers" putStrLn "[\"header1: v1\",\"header2: v2\",\"header3: v3\",\"header4: v4\"]" putStrLn "Problem EofNoError" putStrLn "Incomplete body" putStrLn "[\"body line 1\",\"body line 2\",\"body line 3\",\"body line 4\"]" putStrLn "" putStrLn "Actual result is:" test_driver_full "test_full1.txt" test32 = do putStrLn "Expected result is:" putStrLn "About to read headers" putStrLn "*** Exception: control message: Just (Err \"Frame error\")" putStrLn "" putStrLn "Actual result is:" test_driver_full "test_full2.txt" test33 = do putStrLn "Expected result is:" putStrLn "About to read headers" putStrLn "Finished reading" putStrLn "Complete headers" putStrLn "[\"header1: v1\",\"header2: v2\",\"header3: v3\",\"header4: v4\"]" putStrLn "Problem EofNoError" putStrLn "Incomplete body" putStrLn "[\"body line 1\",\"body line 2\",\"body line 3\",\"body line 4\",\"body line 5\"]" putStrLn "" putStrLn "Actual result is:" test_driver_full "test_full3.txt"