iteratee 0.2.4 → 0.3.1

raw patch · 24 files changed

+791/−499 lines, 24 filesdep ~basedep ~containersdep ~haskell98setup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, haskell98, unix

API changes (from Hackage documentation)

Files

• CONTRIBUTORS +4/−5
• Examples/headers.hs +38/−8
• Examples/wave_reader.hs +1/−2
• Examples/word.hs +25/−0
• Setup.hs +6/−0
• Setup.lhs +0/−4
• iteratee.cabal +103/−59
• src/Data/Iteratee.hs +0/−1
• src/Data/Iteratee/Base.hs +201/−66
• src/Data/Iteratee/Base/LooseMap.hs +12/−0
• src/Data/Iteratee/Base/StreamChunk.hs +16/−8
• src/Data/Iteratee/Binary.hs +13/−15
• src/Data/Iteratee/Char.hs +47/−18
• src/Data/Iteratee/Codecs/Tiff.hs +118/−119
• src/Data/Iteratee/Codecs/Wave.hs +1/−2
• src/Data/Iteratee/IO.hs +20/−12
• src/Data/Iteratee/IO/Base.hs +2/−1
• src/Data/Iteratee/IO/Fd.hs +75/−59
• src/Data/Iteratee/IO/Handle.hs +73/−65
• src/Data/Iteratee/IO/Posix.hs +15/−18
• src/Data/Iteratee/IO/Windows.hs +0/−1
• src/Data/Iteratee/WrappedByteString.hs +13/−26
• tests/QCUtils.hs +0/−1
• tests/testIteratee.hs +8/−9

@@ -1,10 +1,9 @@-Thanks to the following individuals for contributing code to this project.+Thanks to the following individuals for contributing to this project.  Oleg Kiselyov+Brian Lewis John Lato+Echo Nolan Paulo Tanimoto-Bas van Dijk--In addition to the above, many thanks for comments and advice provided by: Johan Tibell-Echo Nolan+Bas van Dijk

@@ -11,7 +11,7 @@ -- HTTP chunk decoding -- Each chunk has the following format: ----- 	  <chunk-size> CRLF <chunk-data> CRLF+--        <chunk-size> CRLF <chunk-data> CRLF -- -- where <chunk-size> is the hexadecimal number; <chunk-data> is a -- sequence of <chunk-size> bytes.@@ -64,7 +64,7 @@   read_hex acc _ = Nothing    frame_err e iter = IterateeG (\_ ->-                     return $ Cont (joinIM $ enumErr e $ iter)+                     return $ Cont (joinIM $ enumErr e iter)                      (Just $ Err "Frame error"))  -- ------------------------------------------------------------------------@@ -89,7 +89,7 @@          enumPure1Chunk test_str1 read_lines_rest     in     lines == ["header1: v1","header2: v2","header3: v3","header4: v4",-	     "header5: v5","header6: v6","header7: v7"]+             "header5: v5","header6: v6","header7: v7"]     && rest == "rest\n"  testp2 :: Bool@@ -98,7 +98,7 @@                               enumPureNChunk test_str1 5 read_lines_rest     in     lines == ["header1: v1","header2: v2","header3: v3","header4: v4",-	     "header5: v5","header6: v6","header7: v7"]+             "header5: v5","header6: v6","header7: v7"]     && rest == "rest\n"  @@ -136,9 +136,39 @@     status <- isFinished     return (headers, body, status) -test31 = test_driver_full "test_full1.txt"-test32 = test_driver_full "test_full2.txt"-test33 = test_driver_full "test_full3.txt"+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 Just (Err \"EOF\")"+  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" -test34 = test_driver_full "test_full3.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 Just (Err \"EOF\")"+  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" 

@@ -23,7 +23,7 @@  -- Use the collection of [WAVEDE] returned from wave_reader to -- do further processing.  The IntMap has an entry for each type of chunk--- in the wave file.  Read the first format chunk and disply the +-- in the wave file.  Read the first format chunk and disply the -- format information, then use the dict_process_data function -- to enumerate over the maxIter iteratee to find the maximum value -- (peak amplitude) in the file.@@ -41,4 +41,3 @@ -- efficient to use foldl' maxIter :: IterateeG [] Double IO Double maxIter = Iter.foldl' (flip (max . abs)) 0-

@@ -0,0 +1,25 @@+-- A simple wc-like program using Data.Iteratee+module Main where++import Prelude as P+import Data.Iteratee+import Data.Iteratee.Char as C+import System+++-- An iteratee to calculate the number of characters in a stream.  Very basic.+numChars :: Monad m => IterateeG [] el m Int+numChars = C.length++-- An iteratee to calculate the number of words in a stream.+numWords :: (Monad m, Functor m) => IterateeG [] Char m Int+numWords = joinI $ enumWords C.length++-- Count the number of lines, similar to numWords+numLines :: (Monad m, Functor m) => IterateeG [] Char m Int+numLines = joinI $ enumLines C.length++main = do+  f:_ <- getArgs+  words <- fileDriver (numLines `enumPair` numWords `enumPair` numChars) f+  print words

@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple (defaultMain)++main :: IO ()+main = defaultMain

@@ -1,4 +0,0 @@-#! /usr/bin/env runhaskell--> import Distribution.Simple-> main = defaultMain

@@ -1,68 +1,112 @@-Name:		iteratee-Version:        0.2.4-Cabal-Version:  >= 1.2-Description:	The IterateeGM monad provides strict, safe, and functional-                I/O.  In addition to pure Iteratee processors, file IO and -                combinator functions are provided.-License:	BSD3-License-file:	LICENSE-Author:		Oleg Kiselyov-Maintainer:	John W. Lato, jwlato@gmail.com-homepage:       http://inmachina.net/~jwlato/haskell/iteratee-Stability:	experimental-synopsis:       Iteratee-based I/O-category:       System, Data-build-type:     Simple-cabal-version:  >= 1.2-tested-with:    GHC == 6.10.3-extra-source-files: README LICENSE CONTRIBUTORS Examples/headers.hs Examples/test_full1.txt Examples/test_full2.txt Examples/test_full3.txt Examples/wave_reader.hs Examples/short.wav+name:          iteratee+version:       0.3.1+synopsis:      Iteratee-based I/O+description:+  The IterateeGM 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+maintainer:    John W. Lato <jwlato@gmail.com>+license:       BSD3+license-file:  LICENSE+homepage:      http://inmachina.net/~jwlato/haskell/iteratee+tested-with:   GHC == 6.10.4+stability:     experimental +cabal-version: >= 1.6+build-type:    Simple++extra-source-files:+  CONTRIBUTORS+  README+  Examples/*.hs+  Examples/*.txt+  Examples/*.wav+ flag splitBase-  description: Choose the new split-up base package.+  description: Use the new split-up base package.  flag buildTests-  description: build test executables+  description: Build test executables.   default:     False -Library- Hs-Source-Dirs:        src- ghc-options:           -Wall- if flag(splitBase)-   build-depends:       base >= 3, base < 5- else-   build-depends:       base < 3- if os(windows)-   cpp-options:         -DUSE_WINDOWS-   other-modules:       Data.Iteratee.IO.Windows- else-   cpp-options:         -DUSE_POSIX-   other-modules:       Data.Iteratee.IO.Posix-   build-depends:       unix- build-depends:         haskell98, containers >= 0.2 && < 0.3, bytestring >= 0.9 && < 0.10, extensible-exceptions >= 0.1 && < 0.2, transformers >= 0.1.4 && < 0.2, ListLike >= 1.0 && < 2- exposed-modules:       Data.Iteratee-                        Data.Iteratee.Base-                        Data.Iteratee.Base.StreamChunk-                        Data.Iteratee.Binary-                        Data.Iteratee.Char-                        Data.Iteratee.Codecs.Wave-                        Data.Iteratee.Codecs.Tiff-                        Data.Iteratee.IO-                        Data.Iteratee.IO.Base-                        Data.Iteratee.WrappedByteString- other-modules:         Data.Iteratee.IO.Fd-                        Data.Iteratee.IO.Handle+library+  hs-source-dirs:+    src -Executable testIteratee-  Hs-Source-Dirs:  src, tests-  Main-Is:         testIteratee.hs-  Other-Modules:   QCUtils+  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,+    bytestring            >= 0.9   && < 0.10,+    containers            >= 0.2   && < 0.4,+    extensible-exceptions >= 0.1   && < 0.2,+    haskell98             >= 1     && < 2,+    transformers          >= 0.1.4 && < 0.2++  exposed-modules:+    Data.Iteratee+    Data.Iteratee.Base+    Data.Iteratee.Base.StreamChunk+    Data.Iteratee.Base.LooseMap+    Data.Iteratee.Binary+    Data.Iteratee.Char+    Data.Iteratee.Codecs.Tiff+    Data.Iteratee.Codecs.Wave+    Data.Iteratee.IO+    Data.Iteratee.IO.Handle+    Data.Iteratee.WrappedByteString++  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.2 && < 0.3, test-framework-quickcheck2 >= 0.2 && < 0.3-  Else-    Executable:    False-    Buildable:     False-  If flag(splitBase)-    Build-Depends: base >= 3 && < 5-  Else-    Build-Depends: base >= 1 && < 2+    build-depends:+      QuickCheck                 >= 2   && < 3,+      test-framework             >= 0.2 && < 0.3,+      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

@@ -16,4 +16,3 @@ import Data.Iteratee.Base import Data.Iteratee.Binary import Data.Iteratee.IO-

@@ -13,21 +13,23 @@   EnumeratorGM,   EnumeratorGMM,   -- * Iteratees-  -- ** Iteratee Combinators+  -- ** Iteratee Utilities   joinI,   liftI,   isFinished,   run,   joinIM,   stream2list,+  stream2stream,   checkIfDone,+  liftInner,   -- ** Error handling   setEOF,   throwErr,   checkErr,   -- ** Basic Iteratees   break,-  --dropWhile,+  dropWhile,   drop,   identity,   head,@@ -39,30 +41,41 @@   take,   takeR,   mapStream,+  rigidMapStream,+  looseMapStream,   convStream,   filter,   -- ** Folds   foldl,   foldl',   foldl1,+  -- ** Special Folds+  sum,+  product,   -- * Enumerators+  -- ** Basic enumerators   enumEof,   enumErr,-  (>.),   enumPure1Chunk,   enumPureNChunk,+  -- ** Enumerator Combinators+  (>.),+  enumPair,   -- * Misc.   seek,-  FileOffset+  FileOffset,+  -- * Classes+  module Data.Iteratee.Base.LooseMap ) where -import Prelude hiding (head, drop, dropWhile, take, break, foldl, foldl1, length, filter)+import Prelude hiding (head, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product) import qualified Prelude as P  import qualified Data.Iteratee.Base.StreamChunk as SC import qualified Data.ListLike as LL import qualified Data.ListLike.FoldableLL as FLL+import Data.Iteratee.Base.LooseMap import Data.Iteratee.IO.Base import Control.Monad import Control.Applicative@@ -112,6 +125,13 @@               | Seek FileOffset               deriving (Show, Eq) +instance Monoid ErrMsg where+  mempty = Err ""+  mappend (Err s1) (Err s2)  = Err (s1 ++ s2)+  mappend e@(Err _) _        = e+  mappend _        e@(Err _) = e+  mappend (Seek _) (Seek b)  = Seek b+ -- |Iteratee -- a generic stream processor, what is being folded over -- a stream -- When Iteratee is in the 'done' state, it contains the computed@@ -144,8 +164,7 @@ -- Useful combinators for implementing iteratees and enumerators  -- | Lift an IterGV result into an 'IterateeG'-liftI :: (Monad m, SC.StreamChunk s el) =>-         IterGV s el m a -> IterateeG s el m a+liftI :: (Monad m, SC.StreamChunk s el) => IterGV s el m a -> IterateeG s el m a liftI (Cont k Nothing)     = k liftI (Cont _k (Just err)) = throwErr err liftI i@(Done _ (EOF _  )) = IterateeG (const (return i))@@ -164,7 +183,7 @@  -- | Check if a stream has finished ('EOF'). isFinished :: (SC.StreamChunk s el, Monad m) =>-              IterateeG s el m (Maybe ErrMsg)+  IterateeG s el m (Maybe ErrMsg) isFinished = IterateeG check   where   check s@(EOF e) = return $ Done (Just $ fromMaybe (Err "EOF") e) s@@ -174,9 +193,9 @@ -- finished then apply it to the given 'EnumeratorGM'. -- If in error, throw the error. checkIfDone :: (SC.StreamChunk s el, Monad m) =>-               (IterateeG s el m a -> m (IterateeG s el m a)) ->-               IterGV s el m a ->-               m (IterateeG s el m a)+  (IterateeG s el m a -> m (IterateeG s el m a)) ->+  IterGV s el m a ->+  m (IterateeG s el m a) checkIfDone _ (Done x _)        = return . return $ x checkIfDone k (Cont x Nothing)  = k x checkIfDone _ (Cont _ (Just e)) = return . throwErr $ e@@ -192,13 +211,25 @@ -- for embedded/nested streams.  In particular, joinI is useful to -- process the result of take, mapStream, or convStream below. joinI :: (SC.StreamChunk s el, SC.StreamChunk s' el', Monad m) =>-         IterateeG s el m (IterateeG s' el' m a) ->-         IterateeG s el m a+  IterateeG s el m (IterateeG s' el' m a) ->+  IterateeG s el m a joinI m = IterateeG (docase <=< runIter m)   where   docase (Done ma str) = liftM (flip Done str) (run ma)   docase (Cont k mErr) = return $ Cont (joinI k) mErr +-- |Layer a monad transformer over the inner monad.+liftInner :: (Monad m, MonadTrans t, Monad (t m)) =>+  IterateeG s el m a ->+  IterateeG s el (t m) a+liftInner iter = IterateeG step+  where+  step str = do+    igv <- lift $ runIter iter str+    case igv of+      Done a res  -> return $ Done a res+      Cont k mErr -> return $ Cont (liftInner k) mErr+ -- It turns out, IterateeG form a monad. We can use the familiar do -- notation for composing Iteratees @@ -207,9 +238,9 @@   (>>=)    = iterBind  iterBind :: (Monad m ) =>-             IterateeG s el m a ->-             (a -> IterateeG s el m b) ->-             IterateeG s el m b+  IterateeG s el m a ->+  (a -> IterateeG s el m b) ->+  IterateeG s el m b iterBind m f = IterateeG (docase <=< runIter m)   where   docase (Done a str)  = runIter (f a) str@@ -250,6 +281,18 @@                                  Nothing   step acc str        = return $ Done (SC.toList acc) str +-- |Read a stream to the end and return all of its elements as a stream+stream2stream :: (SC.StreamChunk s el, Monad m) => IterateeG s el m (s el)+stream2stream = IterateeG (step mempty)+  where+  step acc (Chunk ls)+    | SC.null ls      = return $ Cont (IterateeG (step acc)) Nothing+  step acc (Chunk ls) = return $ Cont+                                 (IterateeG (step (acc `mappend` ls)))+                                 Nothing+  step acc str        = return $ Done acc str++ -- |Report and propagate an error.  Disregard the input first and then -- propagate the error. throwErr :: (Monad m) => ErrMsg -> IterateeG s el m a@@ -267,8 +310,8 @@ -- with an empty stream.  In particular, it enables them to be used with -- 'convStream'. checkErr :: (Monad m, SC.StreamChunk s el) =>-              IterateeG s el m a ->-              IterateeG s el m (Either ErrMsg a)+  IterateeG s el m a ->+  IterateeG s el m (Either ErrMsg a) checkErr iter = IterateeG (check <=< runIter iter)   where   check (Done a str) = return $ Done (Right a) str@@ -288,8 +331,8 @@ -- satisfies the predicate.  break :: (SC.StreamChunk s el, Monad m) =>-          (el -> Bool) ->-          IterateeG s el m (s el)+  (el -> Bool) ->+  IterateeG s el m (s el) break cpred = IterateeG (step mempty)   where   step before (Chunk str) | SC.null str = return $@@ -325,8 +368,8 @@ -- For example, if the stream contains "abd", then (heads "abc") -- will remove the characters "ab" and return 2. heads :: (SC.StreamChunk s el, Monad m, Eq el) =>-         s el ->-         IterateeG s el m Int+  s el ->+  IterateeG s el m Int heads st | SC.null st = return 0 heads st = loop 0 st   where@@ -382,7 +425,20 @@   step (Chunk str)       = return $ Done () (Chunk (LL.drop n str))   step stream            = return $ Done () stream +-- |Skip all elements while the predicate is true.+-- This is the analogue of List.dropWhile+dropWhile :: (SC.StreamChunk s el, Monad m) =>+  (el -> Bool) ->+  IterateeG s el m ()+dropWhile p = IterateeG step+  where+  step (Chunk str) = let dropped = LL.dropWhile p str+                     in if LL.null dropped+                       then return $ Cont (dropWhile p) Nothing+                       else return $ Done () (Chunk dropped)+  step stream      = return $ Done () stream + -- |Return the total length of the stream length :: (Num a, LL.ListLike (s el) el, Monad m) => IterateeG s el m a length = length' 0@@ -410,19 +466,19 @@ -- stream of the read elements. Unless the stream is terminated early, we -- read exactly n elements (even if the iteratee has accepted fewer). take :: (SC.StreamChunk s el, Monad m) =>-        Int ->-        EnumeratorN s el s el m a+  Int ->+  EnumeratorN s el s el m a take 0 iter = return iter take n' iter = IterateeG (step n')   where   step n chk@(Chunk str)     | SC.null str = return $ Cont (take n iter) Nothing-    | SC.length str <= n = return $ Cont (joinIM inner) Nothing+    | SC.length str < n = liftM (flip Cont Nothing) inner       where inner = liftM (check (n - SC.length str)) (runIter iter chk)   step n (Chunk str) = done (Chunk s1) (Chunk s2)     where (s1, s2) = SC.splitAt n str   step _n stream            = done stream stream-  check n (Done x _)        = drop n >> (return $ return x)+  check n (Done x _)        = drop n >> return (return x)   check n (Cont x Nothing)  = take n x   check n (Cont _ (Just e)) = drop n >> throwErr e   done s1 s2 = liftM (flip Done s2) (runIter iter s1 >>= checkIfDone return)@@ -435,9 +491,9 @@ -- of processing of the outer stream once the processing of the inner stream -- finished early. takeR :: (SC.StreamChunk s el, Monad m) =>-         Int ->-         IterateeG s el m a ->-         IterateeG s el m (IterateeG s el m a)+  Int ->+  IterateeG s el m a ->+  IterateeG s el m (IterateeG s el m a) takeR 0 iter = return iter takeR n iter = IterateeG (step n)   where@@ -459,14 +515,43 @@ -- Note the contravariance  mapStream :: (SC.StreamChunk s el, SC.StreamChunk s el', Monad m) =>-              (el -> el') ->-              EnumeratorN s el s el' m a-mapStream f iter = IterateeG ((check <=< runIter iter) . strMap (SC.cMap f))+ (el -> el')+  -> EnumeratorN s el s el' m a+mapStream f i = IterateeG ((check <=< runIter i) . strMap (SC.cMap f))   where-  check (Done a _) = return $ Done (return a) (Chunk LL.empty)-  check (Cont k mErr) = return $ Cont (mapStream f k) mErr+    go iter = IterateeG ((check <=< runIter iter) . strMap (SC.cMap f))+    check (Done a _)    = return $ Done (return a) (Chunk LL.empty)+    check (Cont k mErr) = return $ Cont (go k) mErr +-- |Map a stream without changing the element type.  For StreamChunks+-- with limited element types (e.g. bytestrings)+-- this can be much more efficient than regular mapStream+rigidMapStream :: (SC.StreamChunk s el, Monad m) =>+  (el -> el)+  -> EnumeratorN s el s el m a+rigidMapStream f i =  go i+  where+    go iter = IterateeG ((check <=< runIter iter) . strMap (LL.rigidMap f))+    check (Done a _)    = return $ Done (return a) (Chunk LL.empty)+    check (Cont k mErr) = return $ Cont (go k) mErr +-- |Yet another stream mapping function.  For container instances with+-- class contexts, such as uvector or storablevector, this allows+-- the native map function to be used  and is likely to be much+-- more efficient than the standard mapStream.+looseMapStream :: (SC.StreamChunk s el,+    SC.StreamChunk s el',+    LooseMap s el el',+    Monad m) =>+  (el -> el')+  -> EnumeratorN s el s el' m a+looseMapStream f i =  go i+  where+    go iter = IterateeG ((check <=< runIter iter) . strMap (looseMap f))+    check (Done a _)    = return $ Done (return a) (Chunk LL.empty)+    check (Cont k mErr) = return $ Cont (go k) mErr++ -- |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@@ -491,8 +576,8 @@ -- |Creates an enumerator with only elements from the stream that -- satisfy the predicate function. filter :: (LL.ListLike (s el) el, Monad m) =>-          (el -> Bool) ->-          EnumeratorN s el s el m a+  (el -> Bool) ->+  EnumeratorN s el s el m a filter p = convStream f'   where   f' = IterateeG step@@ -505,33 +590,37 @@  -- | Left-associative fold. foldl :: (LL.ListLike (s el) el, FLL.FoldableLL (s el) el, Monad m) =>-         (a -> el -> a) ->-         a ->-         IterateeG s el m a-foldl f i = iter+  (a -> el -> a) ->+  a ->+  IterateeG s el m a+foldl f i = iter i   where-  iter = IterateeG step-  step (Chunk xs) | LL.null xs = return $ Cont (iter) Nothing-  step (Chunk xs) = return $ Cont (foldl f (FLL.foldl f i xs)) Nothing-  step stream     = return $ Done i stream+  iter ac = IterateeG step+    where+      step (Chunk xs) | LL.null xs = return $ Cont (iter ac) Nothing+      step (Chunk xs) = return $ Cont (iter (FLL.foldl f ac xs)) Nothing+      step stream     = return $ Done ac stream  -- | Left-associative fold that is strict in the accumulator. foldl' :: (LL.ListLike (s el) el, FLL.FoldableLL (s el) el, Monad m) =>-          (a -> el -> a) ->-          a ->-          IterateeG s el m a-foldl' f i = iter+  (a -> el -> a) ->+  a ->+  IterateeG s el m a+foldl' f i = IterateeG (step i)   where-  iter = IterateeG step-  step (Chunk xs) | LL.null xs = return $ Cont (iter) Nothing-  step (Chunk xs) = return $ Cont (foldl' f $! FLL.foldl' f i xs) Nothing-  step stream     = return $ Done i stream+    step ac (Chunk xs) | LL.null xs = return $ Cont (IterateeG (step ac))+                                               Nothing+    step ac (Chunk xs) = return $ Cont (IterateeG (step $! FLL.foldl' f ac xs))+                                       Nothing+    step ac stream     = return $ Done ac stream +{-# INLINE foldl' #-}+ -- | Variant of foldl with no base case.  Requires at least one element --   in the stream. foldl1 :: (LL.ListLike (s el) el, FLL.FoldableLL (s el) el, Monad m) =>-          (el -> el -> el) ->-          IterateeG s el m el+  (el -> el -> el) ->+  IterateeG s el m el foldl1 f = IterateeG step   where   step (Chunk xs) | LL.null xs = return $ Cont (foldl1 f) Nothing@@ -540,7 +629,55 @@   step (Chunk xs) = return $ Cont (foldl f (FLL.foldl1 f xs)) Nothing   step stream     = return $ Cont (foldl1 f) (Just (setEOF stream)) +-- | Sum of a stream.+sum :: (LL.ListLike (s el) el, Num el, Monad m) =>+  IterateeG s el m el+sum = IterateeG (step 0)+  where+    step acc (Chunk xs)+      | LL.null xs = return $ Cont (IterateeG (step acc)) Nothing+    step acc (Chunk xs) = return $ Cont (IterateeG . step $! acc + (LL.sum xs))+                                        Nothing+    step acc str = return $ Done acc str++-- | Product of a stream+product :: (LL.ListLike (s el) el, Num el, Monad m) =>+  IterateeG s el m el+product = IterateeG (step 1)+  where+    step acc (Chunk xs)+      | LL.null xs = return $ Cont (IterateeG (step acc)) Nothing+    step acc (Chunk xs) = return $ Cont (IterateeG . step $! acc *+                                          (LL.product xs))+                                        Nothing+    step acc str = return $ Done acc str+ -- ------------------------------------------------------------------------+-- Zips++-- |Enumerate two iteratees over a single stream simultaneously.+enumPair :: (LL.ListLike (s el) el, Monad m) =>+  IterateeG s el m a ->+  IterateeG s el m b ->+  IterateeG s el m (a,b)+enumPair i1 i2 = IterateeG step+  where+  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+  step (Chunk xs) | LL.null xs = return $ Cont (IterateeG step) Nothing+  step str = do+    ia <- runIter i1 str+    ib <- runIter i2 str+    case (ia, ib) of+      (Done a astr, Done b bstr)  -> return $ Done (a,b) $ longest astr bstr+      (Done a _astr, Cont k mErr) -> return $ Cont (enumPair (return a) k) mErr+      (Cont k mErr, Done b _bstr) -> return $ Cont (enumPair k (return b)) mErr+      (Cont a aEr,  Cont b bEr)   -> return $ Cont (enumPair a b)+                                                   (aEr `mappend` bEr)++-- ------------------------------------------------------------------------ -- Enumerators -- |Each enumerator takes an iteratee and returns an iteratee -- an Enumerator is an iteratee transformer.@@ -563,7 +700,7 @@ -- |The most primitive enumerator: applies the iteratee to the terminated -- stream. The result is the iteratee usually in the done state. enumEof :: Monad m =>-           EnumeratorGM s el m a+  EnumeratorGM s el m a enumEof iter = runIter iter (EOF Nothing) >>= check   where   check (Done x _) = return $ IterateeG $ return . Done x@@ -571,8 +708,8 @@  -- |Another primitive enumerator: report an error enumErr :: (SC.StreamChunk s el, Monad m) =>-           String ->-           EnumeratorGM s el m a+  String ->+  EnumeratorGM s el m a enumErr e iter = runIter iter (EOF (Just (Err e))) >>= check   where   check (Done x _)  = return $ IterateeG (return . Done x)@@ -584,15 +721,15 @@ -- though: in e1 >. e2, e1 is executed first  (>.):: (SC.StreamChunk s el, Monad m) =>-       EnumeratorGM s el m a -> EnumeratorGM s el m a -> EnumeratorGM s el m a+  EnumeratorGM s el m a -> EnumeratorGM s el m a -> EnumeratorGM s el m a (>.) e1 e2 = e2 <=< e1  -- |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 :: (SC.StreamChunk s el, Monad m) =>-                    s el ->-                    EnumeratorGM s el m a+  s el ->+  EnumeratorGM s el m a enumPure1Chunk str iter = runIter iter (Chunk str) >>= checkIfDone return  @@ -601,9 +738,9 @@ -- This enumerator does no IO and is useful for testing of base parsing -- and handling of chunk boundaries enumPureNChunk :: (SC.StreamChunk s el, Monad m) =>-                    s el ->-                    Int ->-                    EnumeratorGM s el m a+  s el ->+  Int ->+  EnumeratorGM s el m a enumPureNChunk str _ iter | SC.null str = return iter enumPureNChunk str n iter | n > 0 = runIter iter (Chunk s1) >>=                                     checkIfDone (enumPureNChunk s2 n)@@ -612,7 +749,5 @@ enumPureNChunk _ n _ = error $ "enumPureNChunk called with n==" ++ show n  -- |A variant of join for Iteratees in a monad.-joinIM :: (Monad m) =>-          m (IterateeG s el m a) -> IterateeG s el m a+joinIM :: (Monad m) => m (IterateeG s el m a) -> IterateeG s el m a joinIM m = IterateeG (\str -> m >>= flip runIter str)-

@@ -0,0 +1,12 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module Data.Iteratee.Base.LooseMap (+  LooseMap (..)+)++where++-- |Enable map functions for containers that require class contexts on the+-- element types.  There's really no reason to ever use this with+-- types that are fully polymorphic, such as Lists.+class LooseMap c el el' where+  looseMap :: (el -> el') -> c el -> c el'

@@ -15,6 +15,8 @@  import qualified Data.List as L import qualified Data.ListLike as LL+import Data.Word+import Foreign.C import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Array@@ -64,16 +66,11 @@   toList = LL.toList    -- |Map a computation over the stream.-  cMap :: (StreamChunk c' el') => (el -> el') -> c el -> c' el'+  cMap :: (StreamChunk c el') => (el -> el') -> c el -> c el'   cMap f = LL.foldr (LL.cons . f) LL.empty  instance StreamChunk [] el where-  cMap       = listmap--listmap :: (StreamChunk s' el') => (el -> el') -> [el] -> s' el'-listmap f = foldr (LL.cons . f) LL.empty--{-# RULES "listmap/map" listmap = map #-}+  cMap       = map  -- |Class of streams which can be filled from a 'Ptr'.  Typically these -- are streams which can be read from a file.@@ -82,6 +79,17 @@ class (StreamChunk s el, Storable el) => ReadableChunk s el where   readFromPtr :: Ptr (el) -> Int -> IO (s el) -instance (Storable el) => ReadableChunk [] el where+instance ReadableChunk [] Char where+  readFromPtr buf l = peekCAStringLen (castPtr buf, l)++instance ReadableChunk [] Word8 where   readFromPtr = flip peekArray +instance ReadableChunk [] Word16 where+  readFromPtr = flip peekArray++instance ReadableChunk [] Word32 where+  readFromPtr = flip peekArray++instance ReadableChunk [] Word where+  readFromPtr = flip peekArray

@@ -29,7 +29,7 @@   deriving (Eq, Ord, Show, Enum)  endianRead2 :: (StreamChunk s Word8, Monad m) => Endian ->-                It.IterateeG s Word8 m Word16+  It.IterateeG s Word8 m Word16 endianRead2 e = do   c1 <- It.head   c2 <- It.head@@ -41,7 +41,7 @@ -- set the entire first byte so the Word32 can be properly set negative as -- well. endianRead3 :: (StreamChunk s Word8, Monad m) => Endian ->-                It.IterateeG s Word8 m Word32+  It.IterateeG s Word8 m Word32 endianRead3 e = do   c1 <- It.head   c2 <- It.head@@ -58,22 +58,20 @@                         `shiftL` 8) .|. fromIntegral m  endianRead4 :: (StreamChunk s Word8, Monad m) => Endian ->-                It.IterateeG s Word8 m Word32+  It.IterateeG s Word8 m Word32 endianRead4 e = do   c1 <- It.head   c2 <- It.head   c3 <- It.head   c4 <- It.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--+    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

@@ -34,6 +34,8 @@ import Data.Iteratee.Base hiding (break) import Data.Char import Control.Monad.Trans+import qualified Data.ListLike as LL+import Data.Monoid  -- |A particular instance of StreamG: the stream of characters. -- This stream is used by many input parsers.@@ -43,7 +45,7 @@  -- Useful combinators for implementing iteratees and enumerators -type Line = String	-- The line of text, terminators are not included+type Line = String      -- The line of text, terminators are not included  -- |Read the line of text from the stream -- The line can be terminated by CR, LF or CRLF.@@ -105,15 +107,27 @@ -- This is the first proper iteratee-enumerator: it is the iteratee of the -- character stream and the enumerator of the line stream. -enumLines :: (Functor m, Monad m) =>-             IterateeG [] Line m a ->-             IterateeG [] Char m (IterateeG [] Line m a)-enumLines iter = line >>= check iter+enumLines :: (LL.ListLike (s el) el, LL.StringLike (s el), Functor m, Monad m) =>+  IterateeG [] (s el) m a ->+  IterateeG s el m (IterateeG [] (s el) m a)+enumLines = convStream getter   where-  --check :: Either Line Line -> IterateeG [] Char m (IterateeG [] Line m a)-  check iter' (Left l)  = runLine iter' l-  check iter' (Right l) = runLine iter' l-  runLine i' l = return . joinIM . fmap Iter.liftI $ (runIter i' $ Chunk [l])+    getter = IterateeG step+    lChar = (== '\n') . last . LL.toString+    step (Chunk xs)+      | LL.null xs = return $ Cont getter Nothing+      | lChar xs   = return $ Done (Just $ LL.lines xs) (Chunk mempty)+      | True       = return $ Cont (IterateeG (step' xs)) Nothing+    step str       = return $ Done Nothing str+    step' xs (Chunk ys)+      | LL.null ys = return $ Cont (IterateeG (step' xs)) Nothing+      | lChar ys   = return $ Done (Just . LL.lines . mappend xs $ ys)+                                   (Chunk mempty)+      | True       = let w' = LL.lines $ mappend xs ys+                         ws = init w'+                         ck = last w'+                     in return $ Done (Just ws) (Chunk ck)+    step' xs str   = return $ Done (Just $ LL.lines xs) str   -- |Convert the stream of characters to the stream of words, and@@ -123,19 +137,34 @@ -- One should keep in mind that enumWords is a more general, monadic -- function. -enumWords :: (Functor m, Monad m) =>-	     IterateeG [] String m a ->-             IterateeG [] Char m (IterateeG [] String m a)-enumWords iter = Iter.break isSpace >>= check iter+enumWords :: (LL.ListLike (s el) el+    , LL.StringLike (s el)+    , Functor m, Monad m)+  => IterateeG [] (s el) m a+  -> IterateeG s el m (IterateeG [] (s el) m a)+enumWords = convStream getter   where-  --check :: String -> IterateeG [] Char m (IterateeG [] String m a)-  check iter' "" = return iter'-  check iter' w  = return . joinIM . fmap Iter.liftI $-                   (runIter iter' $ Chunk [w])+    getter = IterateeG step+    lChar = isSpace . last . LL.toString+    step (Chunk xs) | LL.null xs = return $ Cont getter Nothing+    step (Chunk xs)+      | LL.null xs = return $ Cont getter Nothing+      | lChar xs   = return $ Done (Just $ LL.words xs) (Chunk mempty)+      | True       = return $ Cont (IterateeG (step' xs)) Nothing+    step str       = return $ Done Nothing str+    step' xs (Chunk ys)+      | LL.null ys = return $ Cont (IterateeG (step' xs)) Nothing+      | lChar ys   = return $ Done (Just . LL.words . mappend xs $ ys)+                                   (Chunk mempty)+      | True       = let w' = LL.words $ mappend xs ys+                         ws = init w'+                         ck = last w'+                     in return $ Done (Just ws) (Chunk ck)+    step' xs str   = return $ Done (Just $ LL.words xs) str +{-# INLINE enumWords #-}  -- ------------------------------------------------------------------------ -- Enumerators  type EnumeratorM m a = EnumeratorGM [] Char m a-

@@ -5,16 +5,16 @@ -- 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 +-- 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 -- +-- (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 +-- The matrix is processed incrementally, by a user-supplied -- iteratee. -- -- The incremental processing is accomplished by iteratees and enumerators.@@ -23,8 +23,8 @@ -- 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, +-- 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.@@ -48,7 +48,7 @@ --     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+module Data.Iteratee.Codecs.Tiff {-# DEPRECATED "This will be moved to a separate package in the future" #-} where  import Data.Iteratee import qualified Data.Iteratee as Iter@@ -90,7 +90,7 @@   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"+                "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@@ -106,10 +106,10 @@   --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]+           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 @@ -135,8 +135,8 @@ -- as everything is verified or the error is detected verify_pixel_vals :: MonadIO m =>                      TIFFDict -> [(IM.Key, Word8)] -> IterateeG [] Word8 m ()-verify_pixel_vals dict pixels = Iter.joinI $ pixel_matrix_enum dict $ -				verify 0 (IM.fromList pixels)+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 = IterateeG (step n m)@@ -144,10 +144,11 @@    | SC.null xs = return $ Cont (verify n m) Nothing    | otherwise = let (h, t) = (SC.head xs, SC.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])+    (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 return $ Cont (throwErr . Err $ er) (Just $ Err er)     (Nothing,m')->    step (succ n) m' (Chunk t)  step _n _m s = return $ Done () s@@ -161,8 +162,8 @@ type TIFFDict = IM.IntMap TIFFDE  data TIFFDE = TIFFDE{tiffde_count :: Int,        -- number of items-		     tiffde_enum  :: TIFFDE_ENUM -- enumerator to get values-		    }+                     tiffde_enum  :: TIFFDE_ENUM -- enumerator to get values+                    }  data TIFFDE_ENUM =   TEN_CHAR (forall a m. Monad m => EnumeratorGMM [] Word8 [] Char m a)@@ -177,7 +178,7 @@   | 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+                                -- 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@@ -189,55 +190,55 @@   -- Standard TIFF tags-data TIFF_TAG = TG_other Int		-- other than below-  | TG_SUBFILETYPE 	        -- subfile data descriptor+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_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_ROWSPERSTRIP             -- rows per strip of data   | TG_STRIPBYTECOUNTS          -- bytes counts for strips-  | TG_MINSAMPLEVALUE	        -- +minimum sample value+  | 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_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_GRAYRESPONSECURVE        -- gray scale response curve   | TG_GROUP3OPTIONS            -- 32 flag bits-  | TG_GROUP4OPTIONS 	        -- 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_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_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_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)@@ -338,7 +339,7 @@  -- A few conversion procedures u32_to_float :: Word32 -> Double-u32_to_float _x = 		-- unsigned 32-bit int -> IEEE float+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@@ -370,7 +371,7 @@   next_dict <- endianRead4 e   when (next_dict > 0) $       note ["The TIFF file contains several images, ",-	         "only the first one will be considered"]+            "only the first one will be considered"]   return dict  where   read_entry dictM = dictM >>=@@ -384,14 +385,14 @@       -- 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]+     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 $ IM.insert (fromIntegral tag)+                                 (TIFFDE (fromIntegral count) enum) dict       _ -> return (Just dict)      ) @@ -402,7 +403,7 @@       throwErr . Err $ "Bad type of entry: " ++ show typ       return Nothing -  read_value :: MonadIO m => TIFF_TYPE -> Endian -> Int -> +  read_value :: MonadIO m => TIFF_TYPE -> Endian -> Int ->                 IterateeG [] Word8 m (Maybe TIFFDE_ENUM)    read_value typ e' 0 = do@@ -410,24 +411,24 @@     throwErr . Err $ "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 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 -                         (checkErr Iter.head >>= return . either (const Nothing) (Just . (:[]) . chr . fromIntegral))+            let iter = convStream+                         (liftM (either (const Nothing) (Just . (:[]) . chr . fromIntegral)) (checkErr Iter.head))                          iter_char             Iter.joinI $ Iter.joinI $ Iter.takeR (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+  -- 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))@@ -437,17 +438,17 @@       Just str' -> return . Just . TEN_CHAR $ immed_value str'       Nothing   -> return Nothing -			-- Read the array of signed or unsigned bytes+  -- 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 -                         (checkErr Iter.head >>= return . either (const Nothing) (Just . (:[]) . conv_byte typ))+            let iter = convStream+                         (liftM (either (const Nothing) (Just . (:[]) . conv_byte typ)) (checkErr Iter.head))                          iter_int             Iter.joinI $ Iter.joinI $ Iter.takeR count iter -			-- Read the array of 1 to 4 bytes+  -- 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)@@ -458,16 +459,16 @@       Just str' -> return . Just . TEN_INT $ immed_value str'       Nothing   -> return Nothing -			-- Read the array of Word8+  -- 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.takeR count iter -			-- Read the array of Word8 of 1..4 elements,-			-- packed in the offset field-  read_value TT_undefined _e count = do +  -- 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@@ -477,47 +478,45 @@       Nothing   -> return Nothing     --return . Just . TEN_BYTE $ immed_value str -			-- Read the array of short integers+  -- Read the array of short integers -			-- of 1 element: the offset field contains the value+  -- 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+    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+  -- 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]+    return . Just . TEN_INT $+             immed_value [conv_short typ i1, conv_short typ i2] -			-- of n elements+  -- 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 -                         (checkErr (endianRead2 e') >>=-                           return . either (const Nothing) (Just . (:[]) . conv_short typ))+          let iter = convStream+                         (liftM (either (const Nothing) (Just . (:[]) . conv_short typ)) (checkErr (endianRead2 e')))                          iter_int           Iter.joinI $ Iter.joinI $ Iter.takeR (2*count) iter  -			-- Read the array of long integers-			-- of 1 element: the offset field contains the value+  -- 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+  -- 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 -                         (checkErr (endianRead4 e') >>=-                           return . either (const Nothing) (Just . (:[]) . conv_long typ))+            let iter = convStream+                         (liftM (either (const Nothing) (Just . (:[]) . conv_long typ)) (checkErr (endianRead4 e')))                          iter_int             Iter.joinI $ Iter.joinI $ Iter.takeR (4*count) iter @@ -562,30 +561,30 @@       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 +      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 (Err (unwords ["dict_assert: tag:", show tag,-				"expected:", show v, "found:", show vfound])) >>+        _ -> throwErr (Err (unwords ["dict_assert: tag:", show tag,+                                     "expected:", show v, "found:", show vfound])) >>              return Nothing     proceed Nothing = throwErr $ Err "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+         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.takeR (fromIntegral len) iter'-	   loop (pos+len) strips iter''+             Iter.seek (fromIntegral strip)+             let len = min strip_size (image_size - pos)+             iter'' <- Iter.takeR (fromIntegral len) iter'+             loop (pos+len) strips iter''      loop 0 strip_offsets iter  @@ -599,29 +598,29 @@    Just (e:_) -> return $ Just e    _          -> return Nothing -dict_read_ints :: Monad m => TIFF_TAG -> TIFFDict -> -		  IterateeG [] Word8 m (Maybe [Int])-dict_read_ints tag dict = +dict_read_ints :: Monad m => TIFF_TAG -> TIFFDict ->+                  IterateeG [] 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 <- joinIM $ enum stream2list-	     return (Just e)+          e <- joinIM $ enum stream2list+          return (Just e)       _ -> return Nothing  dict_read_rat :: Monad m => TIFF_TAG -> TIFFDict ->                  IterateeG [] Word8 m (Maybe (Ratio Int))-dict_read_rat tag dict = +dict_read_rat tag dict =   case IM.lookup (tag_to_int tag) dict of       Just (TIFFDE 1 (TEN_RAT enum)) -> do-	     [e] <- joinIM $ enum stream2list-	     return (Just e)+          [e] <- joinIM $ enum stream2list+          return (Just e)       _ -> return Nothing  dict_read_string :: Monad m => TIFF_TAG -> TIFFDict ->                     IterateeG [] Word8 m (Maybe String)-dict_read_string tag dict = +dict_read_string tag dict =   case IM.lookup (tag_to_int tag) dict of       Just (TIFFDE _ (TEN_CHAR enum)) -> do-	     e <- joinIM $ enum stream2list-	     return (Just e)+          e <- joinIM $ enum stream2list+          return (Just e)       _ -> return Nothing

@@ -8,7 +8,7 @@  -} -module Data.Iteratee.Codecs.Wave (+module Data.Iteratee.Codecs.Wave {-# DEPRECATED "This will be moved to a separate package in the future" #-} (   WAVEDE (..),   WAVEDE_ENUM (..),   WAVE_CHUNK (..),@@ -323,4 +323,3 @@   where     divPos = fromIntegral (1 `shiftL` fromIntegral (bd - 1) :: Int) - 1     divNeg = fromIntegral (1 `shiftL` fromIntegral (bd - 1) :: Int)-

@@ -13,6 +13,8 @@   enumFdRandom, #endif   -- * Iteratee drivers+  --   These are FileDescriptor-based on POSIX systems, otherwise they are+  --   Handle-based.   fileDriver,   fileDriverRandom, )@@ -28,21 +30,25 @@ import Data.Iteratee.IO.Fd #endif +import Control.Monad.Trans+ -- 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 IterateeG.  This function wraps -- enumFd as a convenience.-fileDriver :: ReadableChunk s el => IterateeG s el IO a ->-              FilePath ->-              IO a+fileDriver :: (MonadIO m, ReadableChunk s el) =>+  IterateeG s el m a ->+  FilePath ->+  m a fileDriver = fileDriverFd  -- |Process a file using the given IterateeG.  This function wraps -- enumFdRandom as a convenience.-fileDriverRandom :: ReadableChunk s el => IterateeG s el IO a ->-                    FilePath ->-                    IO a+fileDriverRandom :: (MonadIO m, ReadableChunk s el) =>+  IterateeG s el m a ->+  FilePath ->+  m a fileDriverRandom = fileDriverRandomFd  #else@@ -52,16 +58,18 @@  -- |Process a file using the given IterateeG.  This function wraps -- enumHandle as a convenience.-fileDriver :: ReadableChunk s el => IterateeG s el IO a ->-              FilePath ->-              IO a+fileDriver :: (MonadIO m, ReadableChunk s el) =>+  IterateeG s el m a ->+  FilePath ->+  m a fileDriver = fileDriverHandle  -- |Process a file using the given IterateeG.  This function wraps -- enumFdHandle as a convenience.-fileDriverRandom :: ReadableChunk s el => IterateeG s el IO a ->-                    FilePath ->-                    IO a+fileDriverRandom :: (MonadIO m, ReadableChunk s el) =>+  IterateeG s el m a ->+  FilePath ->+  m a fileDriverRandom = fileDriverRandomHandle  #endif

@@ -16,9 +16,10 @@ 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-

@@ -24,13 +24,17 @@ import Data.Iteratee.Binary() import Data.Iteratee.IO.Base +import Control.Monad+import Control.Monad.Trans+ import Foreign.Ptr-import Foreign.Marshal.Alloc+import Foreign.ForeignPtr import Foreign.Storable  import System.IO (SeekMode(..))  import System.Posix hiding (FileOffset)+import GHC.Conc  -- ------------------------------------------------------------------------ -- Binary Random IO enumerators@@ -38,92 +42,104 @@ -- |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 a s el.(ReadableChunk s el) => Fd -> EnumeratorGM s el IO a-enumFd fd iter' = allocaBytes (fromIntegral buffer_size) $ loop iter'+enumFd :: forall s el m a.(ReadableChunk s el, MonadIO m) =>+  Fd ->+  EnumeratorGM s el m a+enumFd fd iter' =+  liftIO (mallocForeignPtrBytes (fromIntegral buffer_size)) >>= loop iter'   where-    buffer_size = fromIntegral $ 2048 - (mod 2048 $ sizeOf (undefined :: el))-    loop iter p = do-      n <- myfdRead fd (castPtr p) buffer_size-      case n of-        Left _errno -> enumErr "IO error" iter-        Right 0 -> return iter-        Right n' -> do-          s <- readFromPtr p (fromIntegral n')-          igv <- runIter iter (Chunk s)-          check p igv+    buffer_size = fromIntegral $ 4096 - mod 4096 (sizeOf (undefined :: el))+    loop iter fp = do+      s <- liftIO . withForeignPtr fp $ \p -> do+        liftIO $ GHC.Conc.threadWaitRead fd+        n <- myfdRead fd (castPtr p) buffer_size+        case n of+          Left _errno -> return $ Left "IO error"+          Right 0 -> return $ Right Nothing+          Right n' -> liftM (Right . Just) $ readFromPtr p (fromIntegral n')+      checkres fp iter s+    checkres fp iter = either (flip enumErr iter)+                              (maybe (return iter)+                                     (check fp <=< runIter iter . Chunk))     check _p (Done x _) = return . return $ x     check p  (Cont i Nothing) = loop i p     check _p (Cont _ (Just e)) = return $ throwErr e  -- |The enumerator of a POSIX File Descriptor: a variation of enumFd that -- supports RandomIO (seek requests)-enumFdRandom :: forall a s el.(ReadableChunk s el) => Fd -> EnumeratorGM s el IO a-enumFdRandom fd iter =- allocaBytes (fromIntegral buffer_size) (loop (0,0) iter)+enumFdRandom :: forall s el m a.(ReadableChunk s el, MonadIO m) =>+  Fd ->+  EnumeratorGM s el m a+enumFdRandom fd iter' =+ liftIO (mallocForeignPtrBytes (fromIntegral buffer_size)) >>= loop (0,0) iter'  where   -- this can be usefully varied.  Values between 512 and 4096 seem   -- to provide the best performance for most cases.-  buffer_size = fromIntegral $ 4096 - (mod 4096 $ sizeOf (undefined :: el))+  buffer_size = fromIntegral $ 4096 - mod 4096 (sizeOf (undefined :: el))   -- the first argument of loop is (off,len), describing which part-  -- of the file is currently in the buffer 'p'-{--  loop :: (ReadableChunk s el) =>-          (FileOffset,Int) ->-          IterateeG s el IO a -> -	  Ptr el ->-          IO (IterateeG s el IO a)--}+  -- of the file is currently in the buffer 'fp'+  loop :: (FileOffset,Int) ->+          IterateeG s el m a ->+          ForeignPtr el ->+          m (IterateeG s el m a)     -- Thanks to John Lato for the strictness annotation     -- Otherwise, the `off + fromIntegral len' below accumulates thunks-  loop (off,len) _iter' _p | off `seq` len `seq` False = undefined-  loop (off,len) iter' p = do-   n <- myfdRead fd (castPtr p) buffer_size-   case n of-    Left _errno -> enumErr "IO error" iter'-    Right 0 -> return iter'-    Right n' -> do-         s <- readFromPtr p (fromIntegral n')-         igv <- runIter iter' (Chunk s)-         check (off + fromIntegral len, fromIntegral n') p igv-  seekTo pos@(off, len) off' iter' p+  loop (off,len) _iter _fp | off `seq` len `seq` False = undefined+  loop (off,len) iter fp = do+    s <- liftIO . withForeignPtr fp $ \p -> do+      liftIO $ GHC.Conc.threadWaitRead fd+      n <- myfdRead fd (castPtr p) buffer_size+      case n of+        Left _errno -> return $ Left "IO error"+        Right 0 -> return $ Right Nothing+        Right n' -> liftM+          (Right . Just . (,) (off + fromIntegral len, fromIntegral n'))+          (readFromPtr p (fromIntegral n'))+    checkres fp iter s+  seekTo pos@(off, len) off' iter fp     | off <= off' && off' < off + fromIntegral len =   -- Seek within buffer     do     let local_off = fromIntegral $ off' - off-    s <- readFromPtr (p `plusPtr` local_off) (len - local_off)-    igv <- runIter iter' (Chunk s)-    check pos p igv-  seekTo _pos off iter' p = do                           -- Seek outside buffer-    off' <- myfdSeek fd AbsoluteSeek (fromIntegral off)+    s <- liftIO $ withForeignPtr fp $ \p ->+                    readFromPtr (p `plusPtr` local_off) (len - local_off)+    igv <- runIter iter (Chunk s)+    check pos fp igv+  seekTo _pos off iter fp = do                         -- Seek outside buffer+    off' <- liftIO $ myfdSeek fd AbsoluteSeek (fromIntegral off)     case off' of-      Left _errno -> enumErr "IO error" iter'-      Right off'' -> loop (off'',0) iter' p-  check _ _p (Done x _)                 = return . return $ x-  check o p  (Cont i Nothing)           = loop o i p-  check o p  (Cont i (Just (Seek off))) = seekTo o off i p-  check _ _p (Cont _ (Just e))          = return $ throwErr e+      Left _errno -> enumErr "IO error" iter+      Right off'' -> loop (off'',0) iter fp+  checkres fp iter = either+                       (flip enumErr iter)+                       (maybe (return iter) (uncurry $ runS fp iter))+  runS fp iter o s = runIter iter (Chunk s) >>= check o fp+  check _ _fp (Done x _)                 = return . return $ x+  check o fp  (Cont i Nothing)           = loop o i fp+  check o fp  (Cont i (Just (Seek off))) = seekTo o off i fp+  check _ _fp (Cont _ (Just e))          = return $ throwErr e  -- |Process a file using the given IterateeGM.  This function wraps -- enumFd as a convenience.-fileDriverFd :: ReadableChunk s el => IterateeG s el IO a ->-                FilePath ->-                IO a+fileDriverFd :: (MonadIO m, ReadableChunk s el) =>+  IterateeG s el m a ->+  FilePath ->+  m a fileDriverFd iter filepath = do-  fd <- openFd filepath ReadOnly Nothing defaultFileFlags+  fd <- liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags   result <- enumFd fd iter >>= run-  closeFd fd+  liftIO $ closeFd fd   return result  -- |Process a file using the given IterateeGM.  This function wraps -- enumFdRandom as a convenience.-fileDriverRandomFd :: ReadableChunk s el =>-                      IterateeG s el IO a ->-                      FilePath ->-                      IO a+fileDriverRandomFd :: (MonadIO m, ReadableChunk s el) =>+  IterateeG s el m a ->+  FilePath ->+  m a fileDriverRandomFd iter filepath = do-  fd <- openFd filepath ReadOnly Nothing defaultFileFlags+  fd <- liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags   result <- enumFdRandom fd iter >>= run-  closeFd fd+  liftIO $ closeFd fd   return result  #endif-

@@ -22,9 +22,11 @@  import Data.Int import Control.Exception.Extensible+import Control.Monad+import Control.Monad.Trans  import Foreign.Ptr-import Foreign.Marshal.Alloc+import Foreign.ForeignPtr import Foreign.Storable  import System.IO@@ -36,95 +38,101 @@ -- |The 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.-enumHandle :: forall a s el.(ReadableChunk s el) => Handle -> EnumeratorGM s el IO a-enumHandle h i = allocaBytes (fromIntegral buffer_size) $ loop i+enumHandle :: forall s el m a.(ReadableChunk s el, MonadIO m) =>+  Handle ->+  EnumeratorGM s el m a+enumHandle h i =+  liftIO (mallocForeignPtrBytes (fromIntegral buffer_size)) >>= loop i   where-    buffer_size = 4096 - (mod 4096 $ sizeOf (undefined :: el))-    loop iter p = do-      n <- (try $ hGetBuf h p buffer_size) :: IO (Either SomeException Int)-      case n of-        Left _   -> enumErr "IO error" iter-        Right 0  -> return iter-        Right n' -> do-          s <- readFromPtr p (fromIntegral n')-          igv <- runIter iter (Chunk s)-          check p igv+    buffer_size = 4096 - mod 4096 (sizeOf (undefined :: el))+    loop iter fp = do+      s <- liftIO . withForeignPtr fp $ \p -> do+        n <- try $ hGetBuf h p buffer_size :: IO (Either SomeException Int)+        case n of+          Left _  -> return $ Left "IO error"+          Right 0 -> return $ Right Nothing+          Right n' -> liftM (Right . Just) $ readFromPtr p (fromIntegral n')+      checkres fp iter s+    checkres fp iter = either (flip enumErr iter)+                              (maybe (return iter)+                                     (check fp <=< runIter iter . Chunk))     check _p (Done x _) = return . return $ x     check p  (Cont i' Nothing) = loop i' p     check _p (Cont _ (Just e)) = return $ throwErr e - -- |The enumerator of a Handle: a variation of enumHandle that -- supports RandomIO (seek requests)-enumHandleRandom :: forall a s el.(ReadableChunk s el) => Handle -> EnumeratorGM s el IO a-enumHandleRandom h iter =- allocaBytes (fromIntegral buffer_size) (loop (0,0) iter)+enumHandleRandom :: forall s el m a.(ReadableChunk s el, MonadIO m) =>+  Handle ->+  EnumeratorGM s el m a+enumHandleRandom h i =+ liftIO (mallocForeignPtrBytes (fromIntegral buffer_size)) >>= loop (0,0) i  where-  -- this can be usefully varied.  Values between 512 and 4096 seem-  -- to provide the best performance for most cases.-  buffer_size = 4096 - (mod 4096 $ sizeOf (undefined :: el))+  buffer_size = 4096 - mod 4096 (sizeOf (undefined :: el))   -- the first argument of loop is (off,len), describing which part-  -- of the file is currently in the buffer 'p'-{--  loop :: (ReadableChunk s el) =>-          (FileOffset,Int) ->-          IterateeG s el IO a -> -	  Ptr el ->-          IO (IterateeG s el IO a)--}-  -- Otherwise, the `off + fromIntegral len' below accumulates thunks-  loop (off,len) _iter' _p | off `seq` len `seq` False = undefined-  loop (off,len) iter' p = do-   n <- (try $ hGetBuf h p buffer_size) :: IO (Either SomeException Int)-   case n of-    Left _errno -> enumErr "IO error" iter-    Right 0 -> return iter'-    Right n' -> do-         s <- readFromPtr p (fromIntegral n')-         igv <- runIter iter' (Chunk s)-	 check (off + fromIntegral len,fromIntegral n') p igv-  seekTo pos@(off, len) off' iter' p-    | off <= off' && off' < off + fromIntegral len =	-- Seek within buffer+  -- of the file is currently in the buffer 'fp'+  loop :: (FileOffset,Int) ->+          IterateeG s el m a ->+          ForeignPtr el ->+          m (IterateeG s el m a)+  -- strictify `off', else the `off + fromIntegral len' accumulates thunks+  loop (off,len) _iter _p | off `seq` len `seq` False = undefined+  loop (off,len) iter fp = do+    s <- liftIO . withForeignPtr fp $ \p -> do+      n <- try $ hGetBuf h p buffer_size :: IO (Either SomeException Int)+      case n of+        Left _errno -> return $ Left "IO error"+        Right 0 -> return $ Right Nothing+        Right n' -> liftM+          (Right . Just . (,) (off + fromIntegral len, fromIntegral n'))+          (readFromPtr p (fromIntegral n'))+    checkres fp iter s+  seekTo pos@(off, len) off' iter fp+    | off <= off' && off' < off + fromIntegral len =    -- Seek within buffer     do     let local_off = fromIntegral $ off' - off-    s <- readFromPtr (p `plusPtr` local_off) (len - local_off)-    igv <- runIter iter' (Chunk s)-    check pos p igv-  seekTo _pos off iter' p = do                          -- Seek outside buffer-   off' <- (try $ hSeek h AbsoluteSeek-            (fromIntegral off)) :: IO (Either SomeException ())+    s <- liftIO $ withForeignPtr fp $ \p ->+                    readFromPtr (p `plusPtr` local_off) (len - local_off)+    igv <- runIter iter (Chunk s)+    check pos fp igv+  seekTo _pos off iter fp = do                          -- Seek outside buffer+   off' <- liftIO (try $ hSeek h AbsoluteSeek+            (fromIntegral off) :: IO (Either SomeException ()))    case off' of-    Left _errno -> enumErr "IO error" iter'-    Right _     -> loop (off,0) iter' p-  check _ _ (Done x _)                 = return . return $ x-  check o p (Cont i Nothing)           = loop o i p-  check o p (Cont i (Just (Seek off))) = seekTo o off i p-  check _ _ (Cont _ (Just e))          = return $ throwErr e+    Left _errno -> enumErr "IO error" iter+    Right _     -> loop (off,0) iter fp+  checkres fp iter = either+                       (flip enumErr iter)+                       (maybe (return iter) (uncurry $ runS fp iter))+  runS fp iter o s = runIter iter (Chunk s) >>= check o fp+  check _ _ (Done x _)                   = return . return $ x+  check o fp (Cont i' Nothing)           = loop o i' fp+  check o fp (Cont i' (Just (Seek off))) = seekTo o off i' fp+  check _ _ (Cont _ (Just e))            = return $ throwErr e  -- ---------------------------------------------- -- File Driver wrapper functions.  -- |Process a file using the given IterateeGM.  This function wraps -- enumHandle as a convenience.-fileDriverHandle :: ReadableChunk s el =>-                    IterateeG s el IO a ->-                    FilePath ->-                    IO a+fileDriverHandle :: (MonadIO m, ReadableChunk s el) =>+  IterateeG s el m a ->+  FilePath ->+  m a fileDriverHandle iter filepath = do-  h <- openBinaryFile filepath ReadMode+  h <- liftIO $ openBinaryFile filepath ReadMode   result <- enumHandle h iter >>= run-  hClose h+  liftIO $ hClose h   return result  -- |Process a file using the given IterateeGM.  This function wraps -- enumHandleRandom as a convenience.-fileDriverRandomHandle :: ReadableChunk s el =>-                          IterateeG s el IO a ->+fileDriverRandomHandle :: (MonadIO m, ReadableChunk s el) =>+                          IterateeG s el m a ->                           FilePath ->-                          IO a+                          m a fileDriverRandomHandle iter filepath = do-  h <- openBinaryFile filepath ReadMode+  h <- liftIO $ openBinaryFile filepath ReadMode   result <- enumHandleRandom h iter >>= run-  hClose h+  liftIO $ hClose h   return result-

@@ -1,6 +1,6 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} --- Low-level IO operations +-- Low-level IO operations -- These operations are either missing from the GHC run-time library, -- or implemented suboptimally or heavy-handedly @@ -23,8 +23,8 @@ import System.Posix import System.IO (SeekMode(..)) import Control.Monad-import Data.Bits			-- for select-import Foreign.Marshal.Array		-- for select+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@@ -49,7 +49,7 @@   n' <- cLSeek fd off (mode2Int mode)   if n' == -1 then liftM Left getErrno      else return . Right  $ n'- where mode2Int :: SeekMode -> CInt	-- From GHC source+ where mode2Int :: SeekMode -> CInt     -- From GHC source        mode2Int AbsoluteSeek = 0        mode2Int RelativeSeek = 1        mode2Int SeekFromEnd  = 2@@ -58,7 +58,7 @@   :: CInt -> FileOffset -> CInt -> IO FileOffset  --- Darn! GHC doesn't provide the real select over several descriptors! +-- Darn! GHC doesn't provide the real select over several descriptors! -- We have to implement it ourselves  type FDSET = CUInt@@ -74,9 +74,9 @@     (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]+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@@ -86,16 +86,13 @@ -- Return the list of read-pending descriptors select'read'pending :: [Fd] -> IO (Either Errno [Fd]) select'read'pending mfd =-    withArray ([0,1]::[TIMEVAL]) ( -- holdover...-    \_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 peekArray (length fds) readfs >>=-                 return . Right . map Fd . fds2mfd))+    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)

@@ -11,4 +11,3 @@   #endif-

@@ -14,7 +14,6 @@ import Data.Word import Data.Monoid import Foreign.Ptr-import Foreign.Marshal.Array import Control.Monad  -- |Wrap a Data.ByteString ByteString@@ -31,12 +30,12 @@ -- Thanks to Echo Nolan for indicating that the bytestring must copy -- data to a new ptr to preserve referential transparency. instance SC.ReadableChunk WrappedByteString Word8 where-  readFromPtr buf l = liftM WrapBS $! BBase.create l $ \newp ->-                    copyArray newp buf l -- must copy from the buffer+  readFromPtr buf l = let csl = (castPtr buf, l) in+                      liftM WrapBS $ BW.packCStringLen csl  instance SC.ReadableChunk WrappedByteString Char where-  readFromPtr buf l = liftM WrapBS $! BBase.create l $ \newp ->-                    copyArray newp (castPtr buf) l --must copy data from buffer+  readFromPtr buf l = let csl = (castPtr buf, l) in+                      liftM WrapBS $ BC.packCStringLen csl  instance LL.ListLike (WrappedByteString Word8) Word8 where   length        = BW.length . unWrap@@ -51,27 +50,22 @@   dropWhile p   = WrapBS . BW.dropWhile p . unWrap   fromList      = WrapBS . BW.pack   toList        = BW.unpack . unWrap+  rigidMap f    = WrapBS . BW.map f . unWrap  instance SC.StreamChunk WrappedByteString Word8 where   cMap          = bwmap  bwmap :: (SC.StreamChunk s' el') =>-         (Word8 -> el') ->-         WrappedByteString Word8 ->-         s' el'+  (Word8 -> el')+  -> WrappedByteString Word8+  -> s' el' bwmap f xs = step xs   where   step bs     | LL.null bs = mempty     | True     = f (LL.head bs) `LL.cons` step (LL.tail bs) --- a specialized version to use in the RULE-bwmap' :: (Word8 -> Word8) ->-          WrappedByteString Word8 ->-          WrappedByteString Word8-bwmap' f = WrapBS . BW.map f . unWrap--{-# RULES "bwmap/map" forall s (f :: Word8 -> Word8). bwmap f s = bwmap' f s #-}+-- Now the Char instance  instance Monoid (WrappedByteString Char) where     mempty = WrapBS BW.empty@@ -94,24 +88,17 @@   dropWhile p   = WrapBS . BC.dropWhile p . unWrap   fromList      = WrapBS . BC.pack   toList        = BC.unpack . unWrap+  rigidMap f    = WrapBS . BC.map f . unWrap  instance SC.StreamChunk WrappedByteString Char where   cMap          = bcmap  bcmap :: (SC.StreamChunk s' el') =>-         (Char -> el') ->-         WrappedByteString Char ->-         s' el'+  (Char -> el')+   -> WrappedByteString Char+   -> s' el' bcmap f xs = step xs   where   step bs     | LL.null bs = mempty     | True     = f (LL.head bs) `LL.cons` step (LL.tail bs)---- a specialized version to use in the RULE-bcmap' :: (Char -> Char) ->-          WrappedByteString Char ->-          WrappedByteString Char-bcmap' f = WrapBS . BC.map f . unWrap--{-# RULES "bcmap/map" forall s (f :: Char -> Char). bcmap f s = bcmap' f s #-}

@@ -39,4 +39,3 @@               ,I.heads ns >> stream2list               ,I.peek >> stream2list               ]-

@@ -30,7 +30,7 @@ type ST = StreamG [] Int  prop_eq str = str == str-  where types = (str :: ST)+  where types = str :: ST  prop_mempty = mempty == (Chunk [] :: StreamG [] Int) @@ -44,7 +44,7 @@   where types = (str :: ST, f :: Int -> Integer)  prop_mappend2 str = str `mappend` mempty == mempty `mappend` str-  where types = (str :: ST)+  where types = str :: ST   isChunk (Chunk _) = True@@ -159,7 +159,7 @@ prop_nullH xs = P.length xs > 0 ==>                 runner1 (enumPure1Chunk xs =<< enumPure1Chunk [] Iter.head)                 == runner1 (enumPure1Chunk xs Iter.head)-  where types = (xs :: [Int])+  where types = xs :: [Int] -- --------------------------------------------- -- Nested Iteratees @@ -200,27 +200,27 @@ prop_convstream2 xs = P.length xs > 0 ==>                       runner2 (enumPure1Chunk xs $ convStream convId Iter.head)                       == runner1 (enumPure1Chunk xs Iter.head)-  where types = (xs :: [Int])+  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])+  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])+  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])+  where types = xs :: [Int]  prop_takeR xs n = n >= 0 ==>                   runner2 (enumPure1Chunk xs $ Iter.take n stream2list)                   == runner2 (enumPure1Chunk xs $ takeR n stream2list)-  where types = (xs :: [Int])+  where types = xs :: [Int]  -- --------------------------------------------- -- Data.Iteratee.Char@@ -296,4 +296,3 @@ -- The entry point  main = defaultMain tests-