iteratee-mtl (empty) → 0.4.0

raw patch · 34 files changed

+4074/−0 lines, 34 filesdep +ListLikedep +MonadCatchIO-mtldep +QuickChecksetup-changed

Dependencies added: ListLike, MonadCatchIO-mtl, QuickCheck, base, bytestring, containers, mtl, test-framework, test-framework-quickcheck2, unix

Files

• CONTRIBUTORS +15/−0
• Examples/Tiff.hs +632/−0
• Examples/Wave.hs +330/−0
• Examples/headers.hs +171/−0
• Examples/test_full1.txt +15/−0
• Examples/test_full2.txt +16/−0
• Examples/test_full3.txt +17/−0
• Examples/test_wc.hs +16/−0
• Examples/word.hs +52/−0
• LICENSE +32/−0
• README +30/−0
• Setup.hs +8/−0
• iteratee-mtl.cabal +113/−0
• src/Data/Iteratee.hs +20/−0
• src/Data/Iteratee/Base.hs +194/−0
• src/Data/Iteratee/Base/LooseMap.hs +19/−0
• src/Data/Iteratee/Base/ReadableChunk.hs +47/−0
• src/Data/Iteratee/Binary.hs +105/−0
• src/Data/Iteratee/Char.hs +122/−0
• src/Data/Iteratee/Exception.hs +208/−0
• src/Data/Iteratee/IO.hs +119/−0
• src/Data/Iteratee/IO/Base.hs +25/−0
• src/Data/Iteratee/IO/Fd.hs +131/−0
• src/Data/Iteratee/IO/Handle.hs +133/−0
• src/Data/Iteratee/IO/Posix.hs +104/−0
• src/Data/Iteratee/IO/Windows.hs +13/−0
• src/Data/Iteratee/Iteratee.hs +290/−0
• src/Data/Iteratee/ListLike.hs +471/−0
• src/Data/NullPoint.hs +24/−0
• src/Data/Nullable.hs +24/−0
• tests/QCUtils.hs +49/−0
• tests/benchmarkHandle.hs +50/−0
• tests/benchmarks.hs +188/−0
• tests/testIteratee.hs +291/−0

@@ -0,0 +1,15 @@+Thanks to the following individuals for contributing to this project.++Oleg Kiselyov+Gregory Collins+Brian Lewis+John Lato+Antoine Latter+Echo Nolan+Conrad Parker+Paulo Tanimoto+Magnus Therning+Johan Tibell+Bas van Dijk+Valery Vorotyntsev+Edward Yang

@@ -0,0 +1,632 @@+{-# 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

@@ -0,0 +1,330 @@+{-# 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)

@@ -0,0 +1,171 @@+import 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:+--+--        <chunk-size> CRLF <chunk-data> CRLF+--+-- where <chunk-size> is the hexadecimal number; <chunk-data> is a+-- sequence of <chunk-size> 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"

@@ -0,0 +1,15 @@+header1: 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
+

@@ -0,0 +1,16 @@+header1: 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
+

@@ -0,0 +1,17 @@+header1: 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
+

@@ -0,0 +1,16 @@+import 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

@@ -0,0 +1,52 @@+{-# 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+++-- | 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.enumPair` numChars++main = do+  f:_ <- getArgs+  words <- fileDriverVBuf 65536 twoIter f+  print words

@@ -0,0 +1,32 @@+Copyright (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.

@@ -0,0 +1,30 @@+This 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.+

@@ -0,0 +1,8 @@+#! /usr/bin/runhaskell++module Main (main) where++import Distribution.Simple (defaultMain)++main :: IO ()+main = defaultMain

@@ -0,0 +1,113 @@+name:          iteratee-mtl+version:       0.4.0+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.+category:      System, Data+author:        Oleg Kiselyov, John W. Lato+maintainer:    John W. Lato <jwlato@gmail.com>+license:       BSD3+license-file:  LICENSE+homepage:      http://inmachina.net/~jwlato/haskell/iteratee+tested-with:   GHC == 6.12.1+stability:     experimental++cabal-version: >= 1.6+build-type:    Simple++extra-source-files:+  CONTRIBUTORS+  README+  Examples/*.hs+  Examples/*.txt+  tests/*.hs++flag splitBase+  description: Use the split-up base package.++flag buildTests+  description: Build test executables.+  default:     False++library+  hs-source-dirs:+    src++  if flag(splitBase)+    build-depends:+      base >= 3 && < 5+  else+    build-depends:+      base < 3++  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:+    ListLike         >= 1.0     && < 2,+    MonadCatchIO-mtl >  0.3     && < 0.4,+    bytestring       >= 0.9     && < 0.10,+    containers       >= 0.2     && < 0.4,+    mtl              >= 1.1     && < 1.2++  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.Iteratee+    Data.Iteratee.ListLike++  other-modules:+    Data.Iteratee.IO.Base++  ghc-options:   -Wall+  if impl(ghc >= 6.8)+    ghc-options: -fwarn-tabs++executable testIteratee+  hs-source-dirs:+    src+    tests++  main-is: testIteratee.hs++  other-modules:+    QCUtils++  if flag(buildTests)+    build-depends:+      QuickCheck                 >= 2   && < 3,+      test-framework             >= 0.3 && < 0.4,+      test-framework-quickcheck2 >= 0.2 && < 0.3+  else+    executable: False+    buildable:  False++  if flag(splitBase)+    build-depends:+      base >= 3 && < 5+  else+    build-depends:+      base < 3++source-repository head+  type:     darcs+  location: http://inmachina.net/~jwlato/haskell/iteratee-mtl

@@ -0,0 +1,20 @@+{- | Provide iteratee-based IO as described in Oleg Kiselyov's paper http://okmij.org/ftp/Haskell/Iteratee/.++Oleg's original code uses lists to store buffers of data for reading in the iteratee.  This package allows the use of arbitrary types through use of the StreamChunk type class.  See Data.Iteratee.WrappedByteString for implementation details.++-}++module Data.Iteratee (+  module Data.Iteratee.Binary,+  module Data.Iteratee.ListLike,+  fileDriver,+  fileDriverVBuf,+  fileDriverRandom,+  fileDriverRandomVBuf+)++where++import Data.Iteratee.Binary+import Data.Iteratee.IO+import Data.Iteratee.ListLike

@@ -0,0 +1,194 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, 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+  -- ** Creating Iteratees+  ,idone+  ,icont+  ,liftI+  ,idoneM+  ,icontM+  -- ** Stream Functions+  ,setEOF+  -- * Classes+  ,module Data.NullPoint+  ,module Data.Nullable+  ,module Data.Iteratee.Base.LooseMap+)+where++import Prelude hiding (null, catch)+import Data.Iteratee.Base.LooseMap+import Data.Iteratee.Exception+import Data.Nullable+import Data.NullPoint+import Data.Monoid++import Control.Monad.Trans+import Control.Monad.CatchIO (MonadCatchIO (..), Exception (..),+  catch, block, toException, fromException)+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 :: Monad m => a -> Stream s -> Iteratee s m a+idone a s = Iteratee $ \onDone _ -> onDone a s++icont :: (Stream s -> Iteratee s m a) -> Maybe SomeException -> Iteratee s m a+icont k e = Iteratee $ \_ onCont -> onCont k e++liftI :: Monad m => (Stream s -> Iteratee s m a) -> Iteratee s m a+liftI 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, Monad 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)+    m <*> a = m >>= flip fmap a++instance (Monad m, Nullable s) => Monad (Iteratee s m) where+  {-# INLINE return #-}+  return x = Iteratee $ \onDone _ -> onDone x (Chunk empty)+  {-# INLINE (>>=) #-}+  m >>= f = Iteratee $ \onDone onCont ->+     let m_done a (Chunk s)+           | null s      = runIter (f a) onDone onCont+         m_done a stream = runIter (f a) (const . flip onDone stream) f_cont+           where f_cont k Nothing = runIter (k stream) onDone onCont+                 f_cont k e       = onCont k e+     in runIter m m_done (onCont . ((>>= f) .))++instance NullPoint s => MonadTrans (Iteratee s) where+  lift m = Iteratee $ \onDone _ -> m >>= flip onDone (Chunk empty)++instance (MonadIO m, Nullable s, NullPoint s) => MonadIO (Iteratee s m) where+  liftIO = lift . liftIO++instance (MonadCatchIO m, Nullable s, NullPoint s) =>+  MonadCatchIO (Iteratee s m) where+    m `catch` f = Iteratee $ \od oc -> runIter m od oc `catch` (\e -> runIter (f e) od oc)+    block       = mapIteratee block+    unblock     = mapIteratee unblock++-- |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

@@ -0,0 +1,19 @@+{-# 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

@@ -0,0 +1,47 @@+{-# 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 Data.Word+import Control.Monad.Trans+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)

@@ -0,0 +1,105 @@+{-# LANGUAGE FlexibleContexts #-}++-- |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+)+where++import Data.Iteratee.Base+import qualified Data.Iteratee.ListLike as I+import qualified Data.ListLike as LL+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 = do+  c1 <- I.head+  c2 <- I.head+  case e of+    MSB -> return $ (fromIntegral c1 `shiftL` 8) .|. fromIntegral c2+    LSB -> return $ (fromIntegral c2 `shiftL` 8) .|. fromIntegral c1++endianRead3+  :: (Nullable s, LL.ListLike s Word8, Monad m) =>+     Endian+     -> Iteratee s m Word32+endianRead3 e = do+  c1 <- I.head+  c2 <- I.head+  c3 <- I.head+  case e of+    MSB -> return $ (((fromIntegral c1+                        `shiftL` 8) .|. fromIntegral c2)+                        `shiftL` 8) .|. fromIntegral c3+    LSB -> return $ (((fromIntegral c3+                        `shiftL` 8) .|. fromIntegral c2)+                        `shiftL` 8) .|. fromIntegral c1++-- |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++endianRead4+  :: (Nullable s, LL.ListLike s Word8, Monad m) =>+     Endian+     -> Iteratee s m Word32+endianRead4 e = do+  c1 <- I.head+  c2 <- I.head+  c3 <- I.head+  c4 <- I.head+  case e of+    MSB -> return $+               (((((fromIntegral c1+                `shiftL` 8) .|. fromIntegral c2)+                `shiftL` 8) .|. fromIntegral c3)+                `shiftL` 8) .|. fromIntegral c4+    LSB -> return $+               (((((fromIntegral c4+                `shiftL` 8) .|. fromIntegral c3)+                `shiftL` 8) .|. fromIntegral c2)+                `shiftL` 8) .|. fromIntegral c1

@@ -0,0 +1,122 @@+{-# LANGUAGE FlexibleContexts #-}++-- | Utilities for Char-based iteratee processing.++module Data.Iteratee.Char (+  -- * Word and Line processors+  printLines+  ,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+import           Control.Monad.Trans+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+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'+  terminators = heads "\r\n" >>= \l -> if l == 0 then heads "\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+      | True       = icont (step' xs) Nothing+    step _str      = getter+    step' xs (Chunk ys)+      | LL.null ys = icont (step' xs) Nothing+      | lChar ys   = idone (LL.lines . mappend xs $ ys) mempty+      | True       = let w' = LL.lines $ mappend xs ys+                         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)+      | True       = icont (step' xs) Nothing+    step str       = idone mempty str+    step' xs (Chunk ys)+      | BC.null ys = icont (step' xs) Nothing+      | lChar ys   = idone (BC.words . BC.append xs $ ys) mempty+      | True       = let w' = BC.words . BC.append xs $ ys+                         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)+      | True       = icont (step' xs) Nothing+    step str       = idone mempty str+    step' xs (Chunk ys)+      | BC.null ys = icont (step' xs) Nothing+      | lChar ys   = idone (BC.lines . BC.append xs $ ys) mempty+      | True       = let w' = BC.lines $ BC.append xs ys+                         ws = init w'+                         ck = last w'+                     in idone ws (Chunk ck)+    step' xs str   = idone (BC.lines xs) str+

@@ -0,0 +1,208 @@+{-# 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 (..)+  -- ** Enumerator exceptions+  ,EnumException (..)+  ,DivergentException (..)+  ,EnumStringException (..)+  ,EnumUnhandledIterException (..)+  -- ** Iteratee exceptions+  ,IException (..)+  ,IterException (..)+  ,SeekException (..)+  ,EofException (..)+  ,IterStringException (..)+  -- * Functions+  ,enStrExc+  ,iterStrExc+  ,wrapIterExc+)+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+

@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}++-- |Random and Binary IO with generic Iteratees.++module Data.Iteratee.IO(+  -- * File enumerators+  -- ** Handle-based enumerators+  enumHandle,+  enumHandleRandom,+#if defined(USE_POSIX)+  -- ** FileDescriptor based enumerators+  enumFd,+  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 Data.Iteratee.IO.Handle++#if defined(USE_POSIX)+import Data.Iteratee.IO.Fd+#endif++import Control.Monad.CatchIO++defaultBufSize :: Int+defaultBufSize = 1024++-- If Posix is available, use the fileDriverRandomFd as fileDriverRandom.  Otherwise, use a handle-based variant.+#if defined(USE_POSIX)++-- |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 = 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 = 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 = fileDriverRandomFd defaultBufSize++fileDriverRandomVBuf+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+     Int+     -> Iteratee s m a+     -> FilePath+     -> m a+fileDriverRandomVBuf = 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 = 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 = 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 = fileDriverRandomHandle defaultBufSize++fileDriverRandomVBuf+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+     Int+     -> Iteratee s m a+     -> FilePath+     -> m a+fileDriverRandomVBuf = fileDriverRandomHandle++#endif

@@ -0,0 +1,25 @@+{-# 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

@@ -0,0 +1,131 @@+{-# 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+  -- * 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.Exception+import Control.Monad+import Control.Monad.CatchIO as CIO+import Control.Monad.Trans++import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Alloc++import System.IO (SeekMode(..))++import System.Posix hiding (FileOffset)+import GHC.Conc++-- ------------------------------------------------------------------------+-- Binary Random IO enumerators++makefdCallback ::+  (MonadIO m, NullPoint s, ReadableChunk s el) =>+  Ptr el+  -> ByteCount+  -> Fd+  -> m (Either SomeException (Bool, s))+makefdCallback p bufsize fd = do+  liftIO $ GHC.Conc.threadWaitRead fd+  n <- liftIO $ myfdRead fd (castPtr p) bufsize+  case n of+    Left _   -> return $ Left undefined+    Right 0  -> return $ Right (False, empty)+    Right n' -> liftM (\s -> Right (True, 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, MonadIO m) =>+     Int+     -> Fd+     -> Enumerator s m a+enumFd bs fd iter = do+  let bufsize = bs * (sizeOf (undefined :: el))+  p <- liftIO $ mallocBytes bufsize+  enumFromCallback (makefdCallback p (fromIntegral bufsize) fd) iter++-- |A variant of enumFd that catches exceptions raised by the @Iteratee@.+enumFdCatch+ :: forall e s el m a.(IException e, NullPoint s, ReadableChunk s el, MonadIO m)+    => Int+    -> Fd+    -> (e -> m (Maybe EnumException))+    -> Enumerator s m a+enumFdCatch bs fd handler iter = do+  let bufsize = bs * (sizeOf (undefined :: el))+  p <- liftIO $ mallocBytes bufsize+  enumFromCallbackCatch (makefdCallback p (fromIntegral bufsize) fd)+    handler iter+++-- |The enumerator of a POSIX File Descriptor: a variation of @enumFd@ that+-- supports RandomIO (seek requests).+enumFdRandom+ :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m) =>+    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++#endif

@@ -0,0 +1,133 @@+{-# 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+  -- * 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.Trans++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+  -> m (Either SomeException (Bool, s))+makeHandleCallback p bsize h = 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, empty)+    Right n -> liftM (\s -> Right (True, 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 = do+  let bufsize = bs * sizeOf (undefined :: el)+  p <- liftIO $ mallocBytes bufsize+  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 = do+  let bufsize = bs * sizeOf (undefined :: el)+  p <- liftIO $ mallocBytes bufsize+  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.++fileDriver :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>+  (Int -> Handle -> Enumerator s m a)+  -> Int -- ^Buffer size+  -> Iteratee s m a+  -> FilePath+  -> m a+fileDriver enumf bufsize iter filepath = CIO.bracket+  (liftIO $ openBinaryFile filepath ReadMode)+  (liftIO . hClose)+  (run <=< flip (enumf bufsize) iter)++-- |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 = fileDriver enumHandle++-- |A version of @fileDriverHandle@ that supports seeking.+fileDriverRandomHandle+  :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>+     Int+     -> Iteratee s m a+     -> FilePath+     -> m a+fileDriverRandomHandle = fileDriver enumHandleRandom+

@@ -0,0 +1,104 @@+{-# 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

@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}++module Data.Iteratee.IO.Windows (+#if defined(USE_WINDOWS)+#endif+)++where++#if defined(USE_WINDOWS)+++#endif

@@ -0,0 +1,290 @@+{-# LANGUAGE KindSignatures, FlexibleContexts, ScopedTypeVariables, DeriveDataTypeable #-}++-- |Monadic and General Iteratees:+-- incremental input parsers, processors and transformers++module Data.Iteratee.Iteratee (+  -- * Types+  -- ** Error handling+  throwErr+  ,throwRecoverableErr+  ,checkErr+  -- ** Basic Iteratees+  ,identity+  ,skipToEof+  ,isStreamFinished+  -- ** Nested iteratee combinators+  ,convStream+  ,unfoldConvStream+  ,joinI+  ,joinIM+  -- * Enumerators+  ,Enumerator+  ,Enumeratee+  -- ** Basic enumerators+  ,enumChunk+  ,enumEof+  ,enumErr+  ,enumPure1Chunk+  ,enumCheckIfDone+  ,enumFromCallback+  ,enumFromCallbackCatch+  -- ** Enumerator Combinators+  ,(>>>)+  ,eneeCheckIfDone+  -- * 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 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 :: (Monad m) => SomeException -> Iteratee s m a+throwErr e = icont (const (throwErr e)) (Just e)++-- |Report and propagate a recoverable error.  This error can be handled by+-- both 'enumFromCallbackCatch' and 'checkErr'.+throwRecoverableErr ::+ (Monad m) =>+  SomeException+  -> (Stream s -> Iteratee s m a)+  -> Iteratee s m a+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 ::+ (Monad m, 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 :: (Monad m, NullPoint s) => Iteratee s m ()+identity = idone () (Chunk empty)++-- |Get the stream status of an iteratee.+isStreamFinished :: Monad m => Iteratee s m (Maybe SomeException)+isStreamFinished = liftI check+  where+    check s@(EOF e) = idone (Just $ fromMaybe (toException EofException) e) s+    check s         = idone Nothing s+{-# INLINE isStreamFinished #-}+++-- |Skip the rest of the stream+skipToEof :: (Monad m) => Iteratee s m ()+skipToEof = icont check Nothing+  where+    check (Chunk _) = skipToEof+    check s         = idone () s+++-- |Seek to a position in the stream+seek :: (Monad m, NullPoint s) => FileOffset -> Iteratee s m ()+seek o = throwRecoverableErr (toException $ SeekException o) (const identity)+++-- ---------------------------------------------------+-- 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 #-}++eneeCheckIfDone ::+ (Monad m, NullPoint elo) =>+  ((Stream eli -> Iteratee eli m a) -> Iteratee elo m (Iteratee eli m a))+  -> Enumeratee elo eli m a+eneeCheckIfDone f inner = Iteratee $ \od oc -> +  let on_done x s = od (idone x s) (Chunk empty)+      on_cont k Nothing  = runIter (f k) od oc+      on_cont _ (Just e) = runIter (throwErr e) od oc+  in runIter inner on_done on_cont+++-- |Convert one stream into another, not necessarily in lockstep.+-- The transformer mapStream maps one element of the outer stream+-- to one element of the nested stream.  The transformer below is more+-- general: it may take several elements of the outer stream to produce+-- one element of the inner stream, or the other way around.+-- The transformation from one stream to the other is specified as+-- Iteratee s el s'.+convStream ::+ (Monad m, Nullable s) =>+  Iteratee s m s'+  -> Enumeratee s s' m a+convStream fi = eneeCheckIfDone check+  where+    check k = isStreamFinished >>= maybe (step k) (idone (liftI k) . EOF . Just)+    step k = fi >>= convStream fi . k . Chunk++-- |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 acc = eneeCheckIfDone check+  where+    check k = isStreamFinished >>= maybe (step k) (idone (liftI k) . EOF . Just)+    step k = f acc >>= \(acc', s') -> unfoldConvStream f acc' . k . Chunk $ s'+++joinI ::+ (Monad m, Nullable s) =>+  Iteratee s m (Iteratee s' m a)+  -> Iteratee s m a+joinI = (>>=+  \inner -> Iteratee $ \od oc ->+  let on_done  x _        = od x (Chunk empty)+      on_cont  k Nothing  = runIter (k (EOF Nothing)) on_done on_cont'+      on_cont  _ (Just e) = runIter (throwErr e) od oc+      on_cont' _ e        = runIter (throwErr (fromMaybe excDivergent e)) od oc+  in runIter inner on_done on_cont)++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++-- |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++-- |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) =>+  m (Either SomeException (Bool, s))+  -> Enumerator s m a+enumFromCallback = flip enumFromCallbackCatch+  (\NotAnException -> return Nothing)++-- 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) =>+  m (Either SomeException (Bool, s))+  -> (e -> m (Maybe EnumException))+  -> Enumerator s m a+enumFromCallbackCatch c handler = loop+  where+    loop iter = runIter iter idoneM on_cont+    on_cont k Nothing = c >>= either (return . k . EOF . Just) (uncurry check)+      where+        check b = if b then loop . k . Chunk else return . k . Chunk+    on_cont k j@(Just e) = case fromException e of+      Just e' -> handler e' >>= maybe (loop . k $ Chunk empty)+                                 (return . icont k . Just) . fmap toException+      Nothing -> return (icont k j)+

@@ -0,0 +1,471 @@+{-# LANGUAGE FlexibleContexts, BangPatterns #-}++-- |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+  ,heads+  ,peek+  ,length+  -- ** Nested iteratee combinators+  ,take+  ,takeUpTo+  ,mapStream+  ,rigidMapStream+  ,filter+  -- ** Folds+  ,foldl+  ,foldl'+  ,foldl1+  ,foldl1'+  -- ** Special Folds+  ,sum+  ,product+  -- * Enumerators+  -- ** Basic enumerators+  ,enumPureNChunk+  -- ** Enumerator Combinators+  ,enumPair+  -- * Classes+  ,module Data.Iteratee.Iteratee+)+where++import Prelude hiding (null, head, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product)++import qualified Data.ListLike as LL+import qualified Data.ListLike.FoldableLL as FLL+import Data.Iteratee.Iteratee+import Control.Monad.Trans+import Data.Monoid+import Data.Word (Word8)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+++-- Useful combinators for implementing iteratees and enumerators++-- | Check if a stream has received 'EOF'.+isFinished :: (Monad m, Nullable s) => Iteratee s m Bool+isFinished = liftI check+  where+  check c@(Chunk xs)+    | null xs     = liftI check+    | True        = 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 = liftI (step [])+  where+    step acc (Chunk ls)+      | null ls  = liftI (step acc)+      | True     = liftI (step (acc ++ LL.toList ls))+    step acc str = idone acc str+{-# INLINE stream2list #-}++-- |Read a stream to the end and return all of its elements as a stream.+-- This iteratee returns all data from the stream *strictly*.+stream2stream :: (Monad m, Nullable s, Monoid s) => Iteratee s m s+stream2stream = icont (step mempty) Nothing+  where+    step acc (Chunk ls)+      | null ls   = icont (step acc) Nothing+      | True      = icont (step (acc `mappend` ls)) Nothing+    step acc str  = idone acc str+{-# 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.+--+-- The analogue of @List.break@++break :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m s+break cpred = icont (step mempty) Nothing+  where+    step bfr (Chunk str)+      | LL.null str       =  icont (step bfr) Nothing+      | True              =  case LL.break cpred str of+        (str', tail')+          | LL.null tail' -> icont (step (bfr `mappend` str)) Nothing+          | True          -> 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@+head :: (Monad m, LL.ListLike s el) => Iteratee s m el+head = liftI step+  where+  step (Chunk vec)+    | LL.null vec  = icont step Nothing+    | True         = idone (LL.head vec) (Chunk $ LL.tail vec)+  step stream      = icont step (Just (setEOF stream))+{-# INLINE head #-}+++-- |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 | null st = return 0+heads st = loop 0 st+  where+  loop cnt xs+    | null xs = return cnt+    | True    = liftI (step cnt xs)+  step cnt str (Chunk xs) | null xs  = liftI (step cnt str)+  step cnt str stream     | null str = idone cnt stream+  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 :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe el)+peek = liftI step+  where+    step s@(Chunk vec)+      | LL.null vec = liftI step+      | True        = idone (Just $ LL.head vec) s+    step stream     = idone Nothing stream+{-# INLINE peek #-}+++-- |Drop n elements of the stream, if there are that many.+--+-- The analogue of @List.drop@+drop :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()+drop 0  = return ()+drop n' = liftI (step n')+  where+    step n (Chunk str)+      | LL.length str <= n = liftI (step (n - LL.length str))+      | True               = idone () (Chunk (LL.drop n str))+    step _ stream          = idone () stream+{-# INLINE drop #-}++-- |Skip all elements while the predicate is true.+--+-- The analogue of @List.dropWhile@+dropWhile :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m ()+dropWhile p = liftI step+  where+    step (Chunk str)+      | LL.null left = liftI step+      | True         = 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 :: (Monad m, Num a, LL.ListLike s el) => Iteratee s m a+length = liftI (step 0)+  where+    step !i (Chunk xs) = liftI (step $ i + LL.length xs)+    step !i stream     = idone (fromIntegral i) stream+{-# INLINE length #-}+++-- ---------------------------------------------------+-- The converters show a different way of composing two iteratees:+-- `vertical' rather than `horizontal'++-- |Read n elements from a stream and apply the given iteratee to the+-- stream of the read elements. Unless the stream is terminated early, we+-- read exactly n elements, even if the iteratee has accepted fewer.+--+-- The analogue of @List.take@+take :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a+take n' iter+ | n' <= 0 = return iter+ | True    = 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)+      | True               = idone (k (Chunk s1)) (Chunk s2)+      where (s1, s2) = LL.splitAt n str+    step _n k stream       = idone (k stream) stream+{-# SPECIALIZE take :: Monad m => Int -> Enumeratee [el] [el] m a #-}+{-# SPECIALIZE take :: Monad m => Int -> Enumeratee B.ByteString B.ByteString m a #-}+{-# SPECIALIZE take :: Monad m => Int -> Enumeratee BC.ByteString BC.ByteString m a #-}++-- |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.+--+-- N.B. If the inner iteratee finishes early, remaining data within the current+-- chunk will be dropped.+takeUpTo :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a+takeUpTo i iter+ | i <= 0    = return iter+ | otherwise = Iteratee $ \od oc ->+    runIter iter (onDone od oc) (onCont od oc)+  where+    onDone od oc x _        = runIter (return (return x)) od oc+    onCont od oc k Nothing  = if i == 0 then od (liftI k) (Chunk mempty)+                                 else runIter (liftI (step i k)) od oc+    onCont od oc _ (Just e) = runIter (throwErr e) od oc+    step n k (Chunk str)+      | LL.null str         = liftI (step n k)+      | LL.length str <= n  = takeUpTo (n - LL.length str) $ k (Chunk str)+      | True                = idone (k (Chunk s1)) (Chunk s2)+      where (s1, s2) = LL.splitAt n str+    step _ k stream         = idone (k stream) stream+{-# SPECIALIZE takeUpTo :: Monad m => Int -> Enumeratee [el] [el] m a #-}+{-# SPECIALIZE takeUpTo :: Monad m => Int -> Enumeratee B.ByteString B.ByteString m a #-}+++-- |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 ::+ (Monad m,+  LL.ListLike (s el) el,+  LL.ListLike (s el') el',+  NullPoint (s el),+  LooseMap s el el') =>+ (el -> el')+ -> Enumeratee (s el) (s el') m a+mapStream f = eneeCheckIfDone (liftI . step)+  where+    step k (Chunk xs)+      | LL.null xs = liftI (step k)+      | True       = mapStream f $ k (Chunk $ lMap f xs)+    step k s       = idone (liftI k) s+{-# SPECIALIZE mapStream :: Monad m => (el -> el') -> Enumeratee [el] [el'] m a #-}++-- |Map the stream rigidly.+--+-- Like 'mapStream', but the element type cannot change.+-- This function is necessary for @ByteString@ and similar types+-- that cannot have 'LooseMap' instances, and may be more efficient.+rigidMapStream ::+ (Monad m, LL.ListLike s el, NullPoint s) =>+  (el -> el)+  -> Enumeratee s s m a+rigidMapStream f = eneeCheckIfDone (liftI . step)+  where+    step k (Chunk xs)+      | LL.null xs = liftI (step k)+      | True       = rigidMapStream f $ k (Chunk $ LL.rigidMap f xs)+    step k s       = idone (liftI k) s+{-# SPECIALIZE rigidMapStream :: Monad m => (el -> el) -> Enumeratee [el] [el] m a #-}+{-# SPECIALIZE rigidMapStream :: Monad m => (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-}+++-- |Creates an 'enumeratee' with only elements from the stream that+-- satisfy the predicate function.  The outer stream is completely consumed.+--+-- The analogue of @List.filter@+filter ::+ (Monad m, Nullable s, LL.ListLike s el) =>+  (el -> Bool)+  -> Enumeratee s s m a+filter p = convStream f'+  where+    f' = icont step Nothing+    step (Chunk xs)+      | LL.null xs = f'+      | True       = idone (LL.filter p xs) mempty+    step _ = f'+{-# INLINE filter #-}++-- ------------------------------------------------------------------------+-- Folds++-- | Left-associative fold.+--+-- The analogue of @List.foldl@+foldl ::+ (Monad m, LL.ListLike s el, FLL.FoldableLL s el) =>+  (a -> el -> a)+  -> a+  -> Iteratee s m a+foldl f i = liftI (step i)+  where+    step acc (Chunk xs)+      | LL.null xs  = liftI (step acc)+      | True   = liftI (step $ FLL.foldl f acc xs)+    step acc stream = idone acc stream+{-# INLINE foldl #-}+++-- | Left-associative fold that is strict in the accumulator.+-- This function should be used in preference to 'foldl' whenever possible.+--+-- The analogue of @List.foldl'@.+foldl' ::+ (Monad m, LL.ListLike s el, FLL.FoldableLL s el) =>+  (a -> el -> a)+  -> a+  -> Iteratee s m a+foldl' f i = liftI (step i)+  where+    step acc (Chunk xs)+      | LL.null xs = liftI (step acc)+      | True       = liftI (step $! FLL.foldl' f acc xs)+    step acc stream = idone acc stream+{-# INLINE foldl' #-}++-- | Variant of foldl with no base case.  Requires at least one element+--   in the stream.+--+-- The analogue of @List.foldl1@.+foldl1 ::+ (Monad m, LL.ListLike s el, FLL.FoldableLL s el) =>+  (el -> el -> el)+  -> Iteratee s m el+foldl1 f = liftI step+  where+    step (Chunk xs)+    -- After the first chunk, just use regular foldl.+      | LL.null xs = liftI step+      | True       = foldl f $ FLL.foldl1 f xs+    step stream    = icont step (Just (setEOF stream))+{-# INLINE foldl1 #-}+++-- | Strict variant of 'foldl1'.+foldl1' ::+ (Monad m, LL.ListLike s el, FLL.FoldableLL s el) =>+  (el -> el -> el)+  -> Iteratee s m el+foldl1' f = liftI step+  where+    step (Chunk xs)+    -- After the first chunk, just use regular foldl'.+      | LL.null xs = liftI step+      | True       = foldl' f $ FLL.foldl1 f xs+    step stream    = icont step (Just (setEOF stream))+{-# INLINE foldl1' #-}+++-- | Sum of a stream.+sum :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el+sum = liftI (step 0)+  where+    step acc (Chunk xs)+      | LL.null xs = liftI (step acc)+      | True       = liftI (step $! acc + LL.sum xs)+    step acc str   = idone acc str+{-# INLINE sum #-}+++-- | Product of a stream.+product :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el+product = liftI (step 1)+  where+    step acc (Chunk xs)+      | LL.null xs = liftI (step acc)+      | True       = liftI (step $! acc * LL.product xs)+    step acc str   = idone acc str+{-# INLINE product #-}+++-- ------------------------------------------------------------------------+-- Zips++-- |Enumerate two iteratees over a single stream simultaneously.+--+-- Compare to @zip@.+enumPair ::+ (Monad m, Nullable s, LL.ListLike s el) =>+  Iteratee s m a+  -> Iteratee s m b+  -> Iteratee s m (a,b)+enumPair i1 i2 = Iteratee $ \od oc -> runIter i1 (onDone od oc) (onCont od oc)+  where+    onDone od oc x s        = runIter i2 (oD12 od oc x s) (onCont' od oc x)+    oD12 od oc x1 s1 x2 s2  = runIter (idone (x1,x2) (longest s1 s2)) od oc+    onCont od oc k mErr     = runIter (icont (step k) mErr) od oc+      where+    onCont' od oc x1 k mErr = runIter (icont (step2 x1 k) mErr) od oc+    step k c@(Chunk str)+      | null str            = liftI (step k)+      | True                = lift (enumPure1Chunk str i2) >>= enumPair (k c)+    step k s@(EOF Nothing)  = lift (enumEof i2) >>= enumPair (k s)+    step k s@(EOF (Just e)) = lift (enumErr e i2) >>= enumPair (k s)+    step2 x1 k (Chunk str)+      | null str            = liftI (step2 x1 k)+    step2 x1 k str          = enumPair (return x1) (k str)+    longest c1@(Chunk xs) c2@(Chunk ys) = if LL.length xs > LL.length ys+                                          then c1 else c2+    longest e@(EOF _)  _         = e+    longest _          e@(EOF _) = e+{-# INLINE enumPair #-}+++-- ------------------------------------------------------------------------+-- 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+  | True        = error $ "enumPureNChunk called with n==" ++ show n+  where+    enum' str' iter'+      | LL.null str' = return iter'+      | True         = 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 #-}

@@ -0,0 +1,24 @@+-- |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++-- ----------------------------------------------+-- |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+

@@ -0,0 +1,24 @@+-- |Nullable:+-- test if a type (container) is null.++module Data.Nullable (+  -- * Classes+  Nullable (..)+)+where++import Data.NullPoint+import qualified Data.ByteString as B+++-- ----------------------------------------------+-- |Nullable container class+class NullPoint c => Nullable c where+  null :: c -> Bool++instance Nullable [a] where+  null [] = True+  null _  = False++instance Nullable B.ByteString where+  null = B.null

@@ -0,0 +1,49 @@+{-# 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 Control.Monad.Identity++import Control.Applicative+import Control.Exception++-- Show instance+instance (Show a, LL.ListLike s el) => Show (Iteratee s Identity a) where+  show = (++) "<<Iteratee>> " . 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.break (< 5)+              ,I.heads ns >> stream2list+              ,I.peek >> stream2list+              ]

@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}++module Main where++import Prelude hiding (null, length)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Criterion.Main+import Data.Word+import Data.Iteratee+import Data.Iteratee.Base.ReadableChunk+import Data.Iteratee.IO.Fd (fileDriverFd)+import Data.Iteratee.IO.Handle (fileDriverHandle)++bufSize = 65536+file = "/usr/share/dict/words"++length' :: Monad m => Iteratee ByteString m Int+length' = length++testFdString :: IO ()+testFdString = fileDriverFd bufSize len file >> return ()+  where+  len :: Monad m => Iteratee String m Int+  len = length++testFdByte :: IO ()+testFdByte = fileDriverFd bufSize len file >> return ()+  where+  len :: Monad m => Iteratee ByteString m Int+  len = length++testHdString :: IO ()+testHdString = fileDriverHandle bufSize len file >> return ()+  where+  len :: Monad m => Iteratee String m Int+  len = length++testHdByte :: IO ()+testHdByte = fileDriverHandle bufSize len file >> return ()+  where+  len :: Monad m => Iteratee ByteString m Int+  len = length++main = defaultMain+  [ bench "Fd with String" testFdString+  , bench "Hd with String" testHdString+  , bench "Fd with ByteString" testFdByte+  , bench "Hd with ByteString" testHdByte+  ]

@@ -0,0 +1,188 @@+{-# LANGUAGE RankNTypes, KindSignatures, NoMonomorphismRestriction #-}++-- some basic benchmarking of iteratee++module Main where++import Data.Iteratee+import qualified Data.Iteratee.ListLike as I+import Data.Iteratee.ListLike (enumPureNChunk, stream2list, stream2stream)+import Data.Word+import Data.Monoid+import qualified Data.ByteString as BS+import Control.Monad.Identity+import Control.Monad+import qualified Data.ListLike as LL+import Control.DeepSeq++import Criterion.Main++main = defaultMain [allListBenches, allByteStringBenches]++-- -------------------------------------------------------------+-- helper functions and data++-- |Hold information about a benchmark.  This allows each+-- benchmark (and baseline) to be created independently of the stream types,+-- for easy comparison of different streams.+-- BDList is for creating baseline comparison functions.  Although the name+-- is BDList, it will work for any stream type (e.g. bytestrings).+data BD a b s (m :: * -> *) = BDIter1 String (a -> b) (Iteratee s m a) +  | BDIterN String Int (a -> b) (Iteratee s m a)+  | BDList String (s -> b) s++id1 name i = BDIter1 name id i+idN name i = BDIterN name 5 id i++makeList name f = BDList name f [1..10000]++makeBench :: BD n eval [Int] Identity -> Benchmark+makeBench (BDIter1 n eval i) = bench n $+  proc eval runIdentity (enumPure1Chunk [1..10000]) i+makeBench (BDIterN n csize eval i) = bench n $+  proc eval runIdentity (enumPureNChunk [1..10000] csize) i+makeBench (BDList n f l) = bench n $ whnf f l++packedBS :: BS.ByteString+packedBS  = (BS.pack [1..10000])++makeBenchBS (BDIter1 n eval i) = bench n $+  proc eval runIdentity (enumPure1Chunk packedBS) i+makeBenchBS (BDIterN n csize eval i) = bench n $+  proc eval runIdentity (enumPureNChunk packedBS csize) i+makeBenchBS (BDList n f l) = error "makeBenchBS can't be called on BDList"++proc :: (Functor m, Monad m)+  => (a -> b) --function to force evaluation of result+  -> (m a -> a)+  -> I.Enumerator s m a+  -> I.Iteratee s m a+  -> Pure+proc eval runner enum iter = whnf (eval . runner . (I.run <=< enum)) iter++defaultProc = proc id runIdentity (enumPure1Chunk [1..10000])+defaultNProc = proc id runIdentity (enumPureNChunk [1..10000] 5)++-- -------------------------------------------------------------+-- benchmark groups+makeGroup n = bgroup n . map makeBench++makeGroupBS :: String -> [BD t t1 BS.ByteString Identity] -> Benchmark+makeGroupBS n = bgroup n . map makeBenchBS++listbench = makeGroup "stream2List" (slistBenches :: [BD [Int] () [Int] Identity])+streambench = makeGroup "stream" (streamBenches :: [BD [Int] () [Int] Identity])+breakbench = makeGroup "break" $ break0 : break0' : breakBenches+headsbench = makeGroup "heads" headsBenches+dropbench = makeGroup "drop" $ drop0 : dropBenches+lengthbench = makeGroup "length" listBenches+takebench = makeGroup "take" $ take0 : takeBenches+--takeRbench = makeGroup "takeR" $ takeR0 : takeRBenches+takeRbench = makeGroup "takeR" []+mapbench = makeGroup "map" $ mapBenches+convbench = makeGroup "convStream" convBenches+miscbench = makeGroup "other" miscBenches++listbenchbs = makeGroupBS "stream2List" slistBenches+streambenchbs = makeGroupBS "stream" streamBenches+breakbenchbs = makeGroupBS "break" breakBenches+headsbenchbs = makeGroupBS "heads" headsBenches+dropbenchbs = makeGroupBS "drop" dropBenches+lengthbenchbs = makeGroupBS "length" listBenches+takebenchbs = makeGroupBS "take" takeBenches+takeRbenchbs = makeGroupBS "takeR" takeRBenches+mapbenchbs = makeGroupBS "map" mapBenches+convbenchbs = makeGroupBS "convStream" convBenches+miscbenchbs = makeGroupBS "other" miscBenches+++allListBenches = bgroup "list" [listbench, streambench, breakbench, headsbench, dropbench, lengthbench, takebench, takeRbench, mapbench, convbench, miscbench]++allByteStringBenches = bgroup "bytestring" [listbenchbs, streambenchbs, breakbenchbs, headsbenchbs, dropbenchbs, lengthbenchbs, takebenchbs, takeRbenchbs, mapbenchbs, convbenchbs, miscbenchbs]++list0 = makeList "list one go" deepseq+list1 = BDIter1 "stream2list one go" (flip deepseq ()) stream2list+list2 = BDIterN "stream2list chunk by 4" 4 (flip deepseq ()) stream2list+list3 = BDIterN "stream2list chunk by 1024" 1024 (flip deepseq ()) stream2list+slistBenches = [list1, list2, list3]++stream1 = BDIter1 "stream2stream one go" (flip deepseq ()) stream2stream+stream2 = BDIterN "stream2stream chunk by 4" 4 (flip deepseq ()) stream2stream+stream3 = BDIterN "stream2stream chunk by 1024" 1024 (flip deepseq ()) stream2stream+streamBenches = [stream1, stream2, stream3]++break0 = makeList "break early list" (fst . Prelude.break (>5))+break0' = makeList "break never list" (fst . Prelude.break (<0))+break1 = id1 "break early one go" (I.break (>5))+break2 = id1 "break never" (I.break (<0)) -- not ever true.+break3 = idN "break early chunked" (I.break (>500))+break4 = idN "break never chunked" (I.break (<0)) -- not ever true+break5 = idN "break late chunked" (I.break (>8000))+breakBenches = [break1, break2, break3, break4, break5]++heads1 = id1 "heads null" (I.heads $ LL.fromList [])+heads2 = id1 "heads 1" (I.heads $ LL.fromList [1])+heads3 = id1 "heads 100" (I.heads $ LL.fromList [1..100])+heads4 = idN "heads 100 over chunks" (I.heads $ LL.fromList [1..100])+headsBenches = [heads1, heads2, heads3, heads4]++benchpeek = id1 "peek" I.peek+benchskip = id1 "skipToEof" (I.skipToEof >> return Nothing)+miscBenches = [benchpeek, benchskip]++drop0 = makeList "drop plain (list only)"+  ( flip seq () . Prelude.drop 100)+drop1 = id1 "drop null" (I.drop 0)+drop2 = id1 "drop plain" (I.drop 100)+drop3 = idN "drop over chunks" (I.drop 100)++dropw0 = makeList "dropWhile all (list only)" (Prelude.dropWhile (const True))+dropw1 = id1 "dropWhile all" (I.dropWhile (const True))+dropw2 = idN "dropWhile all chunked" (I.dropWhile (const True))+dropw3 = id1 "dropWhile small" (I.dropWhile ( < 100))+dropw4 = id1 "dropWhile large" (I.dropWhile ( < 6000))+dropBenches = [drop1, drop2, drop3, dropw1, dropw2, dropw3, dropw4]+++l1 = makeList "length of list" Prelude.length+l2 = id1 "length single iteratee" I.length+l3 = idN "length chunked" I.length+listBenches = [l2, l3]++take0 = makeList "take length of list long" (Prelude.length . Prelude.take 1000)+take1 = id1 "take head short one go" (I.joinI $ I.take 20 I.head)+take2 = id1 "take head long one go" (I.joinI $ I.take 1000 I.head)+take3 = idN "take head short chunked" (I.joinI $ I.take 20 I.head)+take4 = idN "take head long chunked" (I.joinI $ I.take 1000 I.head)+take5 = id1 "take length long one go" (I.joinI $ I.take 1000 I.length)+take6 = idN "take length long chunked" (I.joinI $ I.take 1000 I.length)+takeBenches = [take1, take2, take3, take4, take5, take6]++{-+takeR0 = makeList "take length of list long" (Prelude.length . Prelude.take 1000)+takeR1 = id1 "takeR head short one go" (I.joinI $ I.take 20 I.head)+takeR2 = id1 "takeR head long one go" (I.joinI $ I.takeR 1000 I.head)+takeR3 = idN "takeR head short chunked" (I.joinI $ I.takeR 20 I.head)+takeR4 = idN "takeR head long chunked" (I.joinI $ I.takeR 1000 I.head)+takeR5 = id1 "takeR length long one go" (I.joinI $ I.takeR 1000 I.length)+takeR6 = idN "takeR length long chunked" (I.joinI $ I.takeR 1000 I.length)+takeRBenches = [takeR1, takeR2, takeR3, takeR4, takeR5, takeR6]+-}+takeRBenches = []++map1 = id1 "map length one go" (I.joinI $ I.rigidMapStream id I.length)+map2 = idN "map length chunked" (I.joinI $ I.rigidMapStream id I.length)+map3 = id1 "map head one go" (I.joinI $ I.rigidMapStream id I.head)+map4 = idN "map head chunked" (I.joinI $ I.rigidMapStream id I.head)+mapBenches = [map1, map2, map3, map4]++conv1 = idN "convStream id head chunked" (I.joinI . I.convStream idChunk $ I.head)+conv2 = idN "convStream id length chunked" (I.joinI . I.convStream idChunk $ I.length)+idChunk = I.liftI step+  where+    step (I.Chunk xs)+      | LL.null xs      = idChunk+      | True            = idone xs (I.Chunk mempty)+convBenches = [conv1, conv2]++instance NFData BS.ByteString where

@@ -0,0 +1,291 @@+{-# OPTIONS_GHC -O #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++import Prelude as P++import QCUtils++import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Test.QuickCheck++import Data.Iteratee hiding (head, break)+import qualified Data.Iteratee.Char as IC+import qualified Data.Iteratee as Iter+import Control.Monad.Identity+import Data.Monoid+import qualified Data.ListLike as LL++import Text.Printf (printf)+import System.Environment (getArgs)++instance Show (a -> b) where+  show _ = "<<function>>"++-- ---------------------------------------------+-- 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++runner0 = runIdentity . Iter.run+runner1 = runIdentity . Iter.run . runIdentity++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 (enumPureNChunk xs 1 (return a >>= f))+                       == runner1 (enumPure1Chunk xs (f a))+  where types = (xs :: [Int], a :: Int, f :: Int -> I)++prop_iterMonad2 m xs = runner1 (enumPureNChunk xs 1 (m >>= return))+                     == runner1 (enumPure1Chunk xs m)+  where types = (xs :: [Int], m :: I)++prop_iterMonad3 m f g xs = runner1 (enumPureNChunk 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 (enumPureNChunk 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_head xs = P.length xs > 0 ==> runner1 (enumPure1Chunk xs Iter.head) == head xs+  where types = xs :: [Int]++prop_head2 xs = P.length xs > 0 ==> runner1 (enumPure1Chunk xs (Iter.head >> stream2list)) == tail xs+  where types = xs :: [Int]++prop_heads xs = runner1 (enumPure1Chunk xs $ heads xs) == P.length xs+  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]++-- ---------------------------------------------+-- Simple enumerator tests++type I = Iteratee [Int] Identity [Int]++prop_enumChunks n xs i = n > 0  ==>+  runner1 (enumPure1Chunk xs i) == runner1 (enumPureNChunk xs n i)+  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]+-- ---------------------------------------------+-- 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 (enumPureNChunk 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])+++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]++-- ---------------------------------------------+-- 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 remaineder" prop_break2+    ,testProperty "head" prop_head+    ,testProperty "head remainder" prop_head2+    ,testProperty "heads" prop_heads+    ,testProperty "null heads" prop_heads2+    ,testProperty "peek" prop_peek+    ,testProperty "peek2" prop_peek2+    ,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+    ]+  ,testGroup "Nested iteratees" [+    testProperty "mapStream identity" prop_mapStream+    ,testProperty "mapStream identity 2" prop_mapStream2+    ,testProperty "mapStream identity joinI" prop_mapjoin+    ,testProperty "take" prop_take+    ,testProperty "take (finished iteratee)" prop_take2+    ,testProperty "takeUpTo" prop_takeUpTo+    ,testProperty "convStream EOF" prop_convstream2+    ,testProperty "convStream identity" prop_convstream+    ,testProperty "convStream identity 2" prop_convstream3+    ]+  ,testGroup "Data.Iteratee.Char" [+    --testProperty "line" prop_line+    ]+  ]++------------------------------------------------------------------------+-- The entry point++main = defaultMain tests