iteratee 0.1.0 → 0.2

raw patch · 19 files changed

+1324/−904 lines, 19 filesdep +ListLikedep +QuickCheckdep +test-frameworkdep −mtldep ~basedep ~bytestringdep ~containersnew-component:exe:testbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: ListLike, QuickCheck, test-framework, test-framework-quickcheck2, transformers

Dependencies removed: mtl

Dependency ranges changed: base, bytestring, containers, extensible-exceptions

API changes (from Hackage documentation)

Files

• CONTRIBUTORS +1/−0
• Examples/headers.hs +69/−104
• Examples/short.wav binary
• Examples/wave_reader.hs +13/−12
• README +30/−0
• iteratee.cabal +21/−5
• src/Data/Iteratee.hs +1/−0
• src/Data/Iteratee/Base.hs +305/−245
• src/Data/Iteratee/Base/StreamChunk.hs +24/−19
• src/Data/Iteratee/Binary.hs +27/−25
• src/Data/Iteratee/Char.hs +59/−49
• src/Data/Iteratee/Codecs/Tiff.hs +151/−159
• src/Data/Iteratee/Codecs/Wave.hs +147/−161
• src/Data/Iteratee/IO.hs +12/−12
• src/Data/Iteratee/IO/Fd.hs +46/−49
• src/Data/Iteratee/IO/Handle.hs +49/−54
• src/Data/Iteratee/WrappedByteString.hs +30/−10
• tests/QCUtils.hs +42/−0
• tests/tests.hs +297/−0

@@ -3,6 +3,7 @@ Oleg Kiselyov John Lato Paulo Tanimoto+Bas van Dijk  In addition to the above, many thanks for comments and advice provided by: Johan Tibell

@@ -38,40 +38,46 @@ -- 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 -> IterateeM m a-enum_chunk_decoded = docase- where- docase iter@Done{} =-    liftI iter >>= (\r -> (enum_chunk_decoded ==<< skipToEof) >> return r)- docase iter@(Cont k) = line >>= check_size+enum_chunk_decoded :: Monad m => Iteratee m a -> m (Iteratee m a)+enum_chunk_decoded iter = return read_size   where-  check_size (Right "0") = line >> k EOF-  check_size (Right str) =-     maybe (k . Error $ "Bad chunk size: " ++ str) (read_chunk iter)-         $ read_hex 0 str-  check_size _ = k (Error "Error reading chunk size")-- read_chunk iter size =-     do-     r  <- Iter.take size iter-     c1 <- Iter.head-     c2 <- Iter.head-     case (c1,c2) of-       (Just '\r',Just '\n') -> docase r-       _ -> (enum_chunk_decoded ==<< skipToEof) >>-	    enumErr "Bad chunk trailer" r+  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_hex acc "" = Just acc- read_hex acc (d:rest) | isHexDigit d = read_hex (16*acc + digitToInt d) rest- read_hex _acc _ = Nothing+  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 = IterateeG (\_ ->+                     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+  rest <- Iter.break (const False)+  return (ls, rest)+ test_str1 :: String test_str1 =     "header1: v1\rheader2: v2\r\nheader3: v3\nheader4: v4\n" ++@@ -79,101 +85,60 @@  testp1 :: Bool testp1 =-    let Done (Done lines' EOF) (Chunk rest)-	    = runIdentity . unIM $ enumPure1Chunk test_str1 ==<<-	                             (enum_lines ==<< stream2list)+    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"]+    lines == ["header1: v1","header2: v2","header3: v3","header4: v4",+	     "header5: v5","header6: v6","header7: v7"]     && rest == "rest\n"  testp2 :: Bool testp2 =-    let Done (Done lines' EOF) (Chunk rest)-	    = runIdentity . unIM $ enumPureNChunk test_str1 5 ==<<-	                             (enum_lines ==<< stream2list)+    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 == "r"+    lines == ["header1: v1","header2: v2","header3: v3","header4: v4",+	     "header5: v5","header6: v6","header7: v7"]+    && rest == "rest\n"  -testw1 :: Bool-testw1 =-    let test_str = "header1: v1\rheader2: v2\r\nheader3:\t v3"-	expected = ["header1:","v1","header2:","v2","header3:","v3"] in-    let run_test test_str' =-         let Done (Done words' EOF) EOF-	       = runIdentity . unIM $ (enumPureNChunk test_str' 5 >. enumEof)-	                                ==<< (enum_words ==<< stream2list)-         in words'-    in-    and [run_test test_str == expected,-	 run_test (test_str ++ " ") == expected]- -- Run the complete test, reading the headers and the body --- This simple iteratee is used to process a variety of streams:--- embedded, interleaved, etc.-line_printer :: IterateeGM [] Char IO (IterateeG [] Line IO ())-line_printer = enum_lines ==<< print_lines---- Two sample processors---- Read the headers, print the headers, read the lines of the chunk-encoded--- body and print each line as it has been read-read_headers_print_body :: IterateeGM [] Char IO (IterateeG [] Line IO ())-read_headers_print_body = do-     headers' <- enum_lines ==<< stream2list-     case headers' of-	Done headers EOF -> lift $ do-	   putStrLn "Complete headers"-	   print headers-	Done headers (Error err) -> lift $ do-	   putStrLn $ "Incomplete headers due to " ++ err-	   print headers-        _ -> lift $ putStrLn "Pattern not matched"--     lift $ putStrLn "\nLines of the body follow"-     enum_chunk_decoded ==<< line_printer---- Read the headers and print the header right after it has been read--- Read the lines of the chunk-encoded body and print each line as--- it has been read-print_headers_print_body :: IterateeGM [] Char IO (IterateeG [] Line IO ())-print_headers_print_body = do-     lift $ putStrLn "\nLines of the headers follow"-     line_printer-     lift $ putStrLn "\nLines of the body follow"-     enum_chunk_decoded ==<< line_printer---- This iteratee uses a mapStream to convert the stream from--- Word8 elements to Char elements.--- This is necessary because we want only ASCII chars, not unicode chars.--- this version only works on Posix systems-{--test_driver_full iter filepath = do-  fd <- openFd filepath ReadOnly Nothing defaultFileFlags-  putStrLn "About to read headers"-  unIM $ (IIO.enumFd fd >. enumEof) ==<< (mapStream mapfn ==<< iter)-  closeFd fd-  putStrLn "Finished reading"- where-  mapfn :: Word8 -> Char-  mapfn = chr . fromIntegral--}--test_driver_full iter filepath = do+test_driver_full filepath = do   putStrLn "About to read headers"-  fileDriverRandom (mapStream mapfn ==<< iter) filepath+  result <- fileDriver (mapStream mapfn read_headers_body) filepath >>= run   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   mapfn :: Word8 -> Char   mapfn = chr . fromIntegral+  read_headers_body = do+    headers <- readLines+    body <- joinIM $ enum_chunk_decoded readLines+    status <- isFinished+    return (headers, body, status) -test31 = test_driver_full read_headers_print_body "test_full1.txt"-test32 = test_driver_full read_headers_print_body "test_full2.txt"-test33 = test_driver_full read_headers_print_body "test_full3.txt"+test31 = test_driver_full "test_full1.txt"+test32 = test_driver_full "test_full2.txt"+test33 = test_driver_full "test_full3.txt" -test34 = test_driver_full print_headers_print_body "test_full3.txt"+test34 = test_driver_full "test_full3.txt" 

binary file changed (absent → 54 bytes)

@@ -18,31 +18,32 @@     [] -> putStrLn "Usage: wave_reader FileName"     fname:xs -> do       putStrLn $ "Reading file: " ++ fname-      fileDriverRandom (wave_reader >>= test) fname+      fileDriverRandom (waveReader >>= test) fname       return ()  -- 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  -- format information, then use the dict_process_data function--- to enumerate over the max_iter iteratee to find the maximum value+-- to enumerate over the maxIter iteratee to find the maximum value -- (peak amplitude) in the file.-test :: Maybe (IM.IntMap [WAVEDE]) -> IterateeGM [] Word8 IO ()+test :: Maybe (IM.IntMap [WAVEDE]) -> IterateeG [] Word8 IO () test Nothing = lift $ putStrLn "No dictionary" test (Just dict) = do-  fmtm <- dict_read_first_format dict+  fmtm <- dictReadFirstFormat dict   lift . putStrLn $ show fmtm-  maxm <- dict_process_data 0 dict max_iter+  maxm <- dictProcessData 0 dict maxIter   lift . putStrLn $ show maxm   return ()  -- an iteratee that calculates the maximum value found so far.--- this could be written with snext as well, however it is more+-- this could be written with head as well, however it is more -- efficient to operate on an entire chunk at once.-max_iter :: IterateeGM [] Double IO Double-max_iter = m' 0+maxIter :: IterateeG [] Double IO Double+maxIter = m 0   where-  m' acc = liftI $ Cont (step acc)-  step acc (Chunk []) = m' acc-  step acc (Chunk xs) = m' $! foldl' (max . abs) acc xs-  step acc str = liftI $ Done acc str+  m n = IterateeG (step n)+  step acc (Chunk []) = return $ Cont (m acc) Nothing+  step acc (Chunk xs) = return $ Cont (m $! foldl' (max . abs) acc xs) Nothing+  step acc str = return $ Done acc str+

@@ -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.+

@@ -1,5 +1,5 @@ Name:		iteratee-Version:        0.1.0+Version:        0.2 Cabal-Version:  >= 1.2 Description:	The IterateeGM monad provides strict, safe, and functional                 I/O.  In addition to pure Iteratee processors, file IO and @@ -14,15 +14,19 @@ category:       System, Data build-type:     Simple cabal-version:  >= 1.2-tested-with:    GHC == 6.10.1, GHC == 6.8.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+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  flag splitBase   description: Choose the new split-up base package. +flag buildTests+  description: build test executables+  default:     False+ Library  Hs-Source-Dirs:        src- ghc-options:           -O2 -Wall+ ghc-options:           -Wall -fexcess-precision -fno-method-sharing  if flag(splitBase)    build-depends:       base >= 3, base < 5  else@@ -36,7 +40,7 @@    cpp-options:         -DUSE_POSIX    other-modules:       Data.Iteratee.IO.Posix    build-depends:       unix- build-depends:         haskell98, mtl, containers, bytestring, extensible-exceptions+ 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@@ -50,3 +54,15 @@  other-modules:         Data.Iteratee.IO.Fd                         Data.Iteratee.IO.Handle +Executable test+  GHC-Options:     -Wall+  Hs-Source-Dirs:  src, tests+  Main-Is:         tests.hs+  Other-Modules:   QCUtils+  Build-Depends:   QuickCheck >= 2 && < 3, test-framework >= 0.2 && < 0.3, test-framework-quickcheck2 >= 0.2 && < 0.3+  If flag(splitBase)+    Build-Depends: base >= 3 && < 5+  Else+    Build-Depends: base >= 1 && < 2+  if !flag(buildTests)+    buildable:     False

@@ -7,6 +7,7 @@ module Data.Iteratee (   module Data.Iteratee.Base,   module Data.Iteratee.Binary,+  fileDriver,   fileDriverRandom ) 

@@ -1,29 +1,37 @@+{-# LANGUAGE FlexibleContexts #-}+ -- |Monadic and General Iteratees: -- incremental input parsers, processors and transformers  module Data.Iteratee.Base (   -- * Types+  ErrMsg (..),   StreamG (..),+  IterGV (..),   IterateeG (..),-  IterateeGM (..),   EnumeratorN,   EnumeratorGM,   EnumeratorGMM,   -- * Iteratees   -- ** Iteratee Combinators-  liftI,-  (>>==),-  (==<<),   joinI,+  liftI,+  isFinished,+  run,+  joinIM,   stream2list,+  checkIfDone,   -- ** Error handling-  iterErr,-  iterReportError,+  setEOF,+  throwErr,+  checkErr,   -- ** Basic Iteratees   break,-  dropWhile,+  --dropWhile,   drop,+  identity,   head,+  heads,   peek,   skipToEof,   seek,@@ -39,8 +47,7 @@   enumPure1Chunk,   enumPureNChunk,   -- * Misc.-  FileOffset,-  bindm+  FileOffset ) where @@ -48,14 +55,14 @@ import qualified Prelude as P  import qualified Data.Iteratee.Base.StreamChunk as SC+import qualified Data.ListLike as LL import Data.Iteratee.IO.Base+import Control.Monad+import Control.Applicative import Control.Monad.Trans-import Control.Monad.Identity-import System.IO+import Data.Monoid+import Data.Maybe (fromMaybe) --- |A useful combinator.-bindm :: Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b)-bindm m f = m >>= maybe (return Nothing) f  -- |A stream is a (continuing) sequence of elements bundled in Chunks. -- The first two variants indicate termination of the stream.@@ -65,8 +72,39 @@ -- data but which is still continuing. A stream processor should, -- informally speaking, ``suspend itself'' and wait for more data -- to arrive.-data (SC.StreamChunk c el) => StreamG c el = EOF | Error String | Chunk (c el) +data StreamG c el =+  EOF (Maybe ErrMsg)+  | Chunk (c el)++instance Eq (c el) => Eq (StreamG c el) where+  EOF mErr1 == EOF mErr2 = mErr1 == mErr2+  Chunk xs == Chunk ys   = xs == ys+  _ == _ = False++instance Show (c el) => Show (StreamG c el) where+  show (EOF mErr) = "StreamG: EOF " ++ show mErr+  show (Chunk xs) = "StreamG: Chunk " ++ show xs++instance Functor c => Functor (StreamG c) where+  fmap _ (EOF mErr) = EOF mErr+  fmap f (Chunk xs) = Chunk $ fmap f xs++instance Monoid (c el) => Monoid (StreamG c el) 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.+strMap :: (c el -> c' el') -> StreamG c el -> StreamG c' el'+strMap f (Chunk xs) = Chunk $ f xs+strMap _ (EOF mErr) = EOF mErr++data ErrMsg = Err String+              | Seek FileOffset+              deriving (Show, Eq)+ -- |Iteratee -- a generic stream processor, what is being folded over -- a stream -- When Iteratee is in the 'done' state, it contains the computed@@ -83,45 +121,54 @@ -- We also assume that given a terminated stream, an iteratee -- moves to the done state, so the results computed so far could be returned. -data IterateeG s el m a-  = Done a (StreamG s el)-  | Cont (StreamG s el -> IterateeGM s el m a)-  | Seek FileOffset (StreamG s el -> IterateeGM s el m a)+data IterGV c el m a =+  Done a (StreamG c el)+  | Cont (IterateeG c el m a) (Maybe ErrMsg) -instance (Show a) => Show (IterateeG s el m a) where-  show (Done a _)  = "Iteratee done: " ++ P.show a-  show (Cont   _k) = "Iteratee: incomplete"-  show (Seek f _k) = "Iteratee: seek to " ++ P.show f ++ "requested"+instance (Show (c el), Show a) => Show (IterGV c el m a) where+  show (Done a str) = "IterGV Done <<" ++ show a ++ ">> : <<" ++ show str ++ ">>"+  show (Cont _ mErr) = "IterGV Cont :: " ++ show mErr -newtype IterateeGM s el m a = IM {unIM :: m (IterateeG s el m a)}+newtype IterateeG c el m a = IterateeG{+  runIter :: StreamG c el -> m (IterGV c el m a)+  }   -- Useful combinators for implementing iteratees and enumerators --- |Lift an 'IterateeG' into an 'IterateeGM'.-liftI :: Monad m => IterateeG s el m a -> IterateeGM s el m a-liftI = IM . return--{-# INLINE liftI #-}---- |Just like bind (at run-time, this is indeed exactly bind)-infixl 1 >>==-(>>==) :: Monad m =>-          IterateeGM s el m a ->-          (IterateeG s el m a -> IterateeGM s' el' m b) ->-          IterateeGM s' el' m b-m >>== f = IM (unIM m >>= unIM . f)+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))+liftI (Done a (Chunk st )) = IterateeG (check st)+  where+  check str (Chunk str') = return $ Done a (Chunk $ str `mappend` str')+  check _str e@(EOF _)   = return $ Done a e -{-# INLINE (>>==) #-}+run :: (Monad m, SC.StreamChunk s el) => IterateeG s el m a -> m a+run iter = runIter iter (EOF Nothing) >>= \res ->+  case res of+    Done x _ -> return x+    Cont _ e -> error $ "control message: " ++ show e --- |Just like an application -- a call-by-value-like application-infixr 1 ==<<-(==<<) :: Monad m =>-          (IterateeG s el m a -> IterateeGM s' el' m b)-          -> IterateeGM s el m a-          -> IterateeGM s' el' m b-(==<<) = flip (>>==)+isFinished :: (SC.StreamChunk s el, Monad m) =>+              IterateeG s el m (Maybe ErrMsg)+isFinished = IterateeG check+  where+  check s@(EOF e) = return $ Done (Just $ fromMaybe (Err "EOF") e) s+  check s         = return $ Done Nothing s +-- |If the iteratee (IterGV) has finished, return its value.  If it has not+-- 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)+checkIfDone _ (Done x _)        = return . return $ x+checkIfDone k (Cont x Nothing)  = k x+checkIfDone _ (Cont _ (Just e)) = return . throwErr $ e  -- |The following is a `variant' of join in the IterateeGM s el m monad -- When el' is the same as el, the type of joinI is indeed that of@@ -134,179 +181,192 @@ -- 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) =>-         IterateeGM s el m (IterateeG s' el' m a) ->-         IterateeGM s el m a-joinI m = m >>= (\iter -> enumEof iter >>== check)+         IterateeG s el m (IterateeG s' el' m a) ->+         IterateeG s el m a+joinI m = IterateeG (\str -> runIter m str >>= docase)   where-  check (Done x (Error str)) = liftI $ Done x (Error str)-  check (Done x _) = liftI $ Done x EOF-  check (Cont _)   = error "joinI: can't happen: EOF didn't terminate"-  check (Seek _ _) = error "joinI: can't happen: EOF didn't terminate"+  docase (Done ma str) = run ma >>= \a -> return (Done a str)+  docase (Cont k mErr) = return $ Cont (joinI k) mErr --- It turns out, IterateeGM form a monad. We can use the familiar do+-- It turns out, IterateeG form a monad. We can use the familiar do -- notation for composing Iteratees -instance (SC.StreamChunk s el, Monad m) => Monad (IterateeGM s el m) where-  return x = liftI  $ Done  x (Chunk SC.empty)-  m >>= f = iter_bind m f+instance (Monad m) => Monad (IterateeG s el m) where+  return x = IterateeG (return . Done x)+  (>>=)    = iterBind -iter_bind :: (SC.StreamChunk s el, Monad m ) =>-             IterateeGM s el m a ->-             (a -> IterateeGM s el m b) ->-             IterateeGM s el m b-iter_bind m f = m >>== docase+iterBind :: (Monad m ) =>+             IterateeG s el m a ->+             (a -> IterateeG s el m b) ->+             IterateeG s el m b+iterBind m f = IterateeG $ \str -> (runIter m str >>= docase)   where-  docase (Done a (Chunk vec))-    | SC.null vec        = f a-  docase (Done a stream) = f a >>== (\r -> case r of-    Done x _             -> liftI $ Done x stream-    Cont k               -> k stream-    iter                 -> liftI iter)-  docase (Cont k)        = liftI $ Cont ((>>= f) . k)-  docase (Seek off k)    = liftI $ Seek off ((>>= f) . k)+  docase (Done a str)  = runIter (f a) str+  docase (Cont k mErr) = return $ Cont (k `iterBind` f) mErr -{-# SPECIALIZE iter_bind :: SC.StreamChunk s el => IterateeGM s el IO a -> (a -> IterateeGM s el IO b) -> IterateeGM s el IO b #-}+{-# INLINE iterBind #-} -instance (Monad m, Functor m) => Functor (IterateeGM s el m) where-  fmap f m = m >>== docase+instance (Monad m, Functor m) =>+  Functor (IterateeG s el m) where+  fmap f m = IterateeG $ \str -> runIter m str >>= docase     where-    docase (Done a stream) = liftI $ Done (f a) stream-    docase (Cont k)        = liftI $ Cont (fmap f . k)-    docase (Seek off k)    = liftI $ Seek off (fmap f . k)+    -- docase :: IterGV s el m a -> m (IterGV s el m a)+    docase (Done a stream) = return $ Done (f a) stream+    docase (Cont k mErr)   = return $ Cont (fmap f k) mErr -instance (SC.StreamChunk s el) => MonadTrans (IterateeGM s el) where-  lift m = IM (m >>= unIM . return)+instance (Monad m, Functor m) => Applicative (IterateeG s el m) where+  pure    = return+  m <*> a = m >>= \f -> fmap f a -instance (SC.StreamChunk s el, MonadIO m) => MonadIO (IterateeGM s el m) where+instance MonadTrans (IterateeG s el) where+  lift m = IterateeG $ \str -> m >>= \a -> return $ Done a str++instance (MonadIO m) => MonadIO (IterateeG s el m) where   liftIO = lift . liftIO  -- ------------------------------------------------------------------------ -- Primitive iteratees  -- |Read a stream to the end and return all of its elements as a list-stream2list :: (SC.StreamChunk s el, Monad m) => IterateeGM s el m [el]-stream2list = liftI $ Cont (step SC.empty)- where- step acc (Chunk ls) | SC.null ls   = liftI $ Cont (step acc)-                     | otherwise    = liftI $ Cont (step $ acc `SC.append` ls)- step acc stream                    = liftI $ Done (SC.toList acc) stream+stream2list :: (SC.StreamChunk s el, Monad m) => IterateeG s el m [el]+stream2list = IterateeG (step mempty)+  where+  -- step :: s el -> StreamG s el -> m (IterGV s el m [el])+  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 (SC.toList acc) str  -- |Report and propagate an error.  Disregard the input first and then -- propagate the error.-iterErr :: (SC.StreamChunk s el, Monad m) => String -> IterateeGM s el m ()-iterErr err = liftI $ Cont step-  where-  step _ = liftI $ Done () (Error err)+throwErr :: (Monad m) => ErrMsg -> IterateeG s el m a+throwErr e = IterateeG (\_ -> return $ Cont (throwErr e) (Just e)) --- |Check to see if the stream is in error-iterReportError :: (SC.StreamChunk s el, Monad m) =>-                   IterateeGM s el m (Maybe String)-iterReportError = liftI $ Cont step+-- |Produce the EOF error message.  If the stream was terminated because+-- of an error, keep the original error message.+setEOF :: StreamG c el -> ErrMsg+setEOF (EOF (Just e)) = e+setEOF _              = Err "EOF"++-- |Check if an iteratee produces an error.+-- Returns 'Right a' if it completes without errors, otherwise 'Left ErrMsg'+checkErr :: (Monad m, SC.StreamChunk s el) =>+              IterateeG s el m a ->+              IterateeG s el m (Either ErrMsg a)+checkErr iter = IterateeG (\str -> runIter iter str >>= check)   where-  step s@(Error str) = liftI $ Done (Just str) s-  step s             = liftI $ Done Nothing s+  check (Done a str) = return $ Done (Right a) str+  check (Cont _ (Just err)) = return $ Done (Left err) mempty+  check (Cont k Nothing) = return $ Cont (checkErr k) Nothing ++ -- ------------------------------------------------------------------------ -- Parser combinators  -- |The analogue of List.break--- It takes an element predicate and returns a pair:---  (str, Just c) -- the element 'c' is the first element of the stream---                   satisfying the break predicate;---                   The chunk str is the prefix of the stream up---                   to but including 'c'---  (str,Nothing) -- The stream is terminated with EOF or error before---                   any element satisfying the break predicate was found.---                   str is the scanned part of the stream.--- None of the element in str satisfy the break predicate.+-- It 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 on the stream+-- satisfies the predicate.  break :: (SC.StreamChunk s el, Monad m) =>           (el -> Bool) ->-          IterateeGM s el m (s el, Maybe el)-break cpred = liftI $ Cont (liftI . step SC.empty)+          IterateeG s el m (s el)+break cpred = IterateeG (step mempty)   where-  step before (Chunk str)-    | SC.null str = Cont (liftI . step before)-    | otherwise = case SC.findIndex cpred str of-        Nothing -> Cont (liftI . step (before `SC.append` str))-        Just ix -> let (str', tail') = SC.splitAt ix str-                   in-                   done (before `SC.append` str') (Just $ SC.head tail') (Chunk $ SC.tail tail')-  step before stream = done before Nothing stream-  done line' char = Done (line', char)+  step before (Chunk str) | SC.null str = return $+    Cont (IterateeG (step before)) Nothing+  step before (Chunk str) =+    case LL.break cpred str of+      (_, tail') | SC.null tail' -> return $ Cont+                              (IterateeG (step (before `mappend` str)))+                              Nothing+      (str', tail') -> return $ Done (before `mappend` str') (Chunk tail')+  step before stream = return $ Done before stream +-- |The identity iterator.  Doesn't do anything.+identity :: (Monad m) => IterateeG s el m ()+identity = IterateeG (return . Done ()) --- |A particular optimized case of 'drop': skip all elements of the stream--- satisfying the given predicate - until the first element--- that does not satisfy the predicate, or the end of the stream.--- This is the analogue of List.dropWhile-dropWhile :: (SC.StreamChunk s el, Monad m) =>-              (el -> Bool) ->-              IterateeGM s el m ()-dropWhile cpred = liftI $ Cont step++-- |Attempt to read the next element of the stream and return it+-- Raise a (recoverable) error if the stream is terminated+head :: (SC.StreamChunk s el, Monad m) => IterateeG s el m el+head = IterateeG step   where-  step (Chunk str)-    | SC.null str = dropWhile cpred-    | otherwise = let remm = SC.dropWhile cpred str-                  in-                  case SC.null remm of-                    True  -> dropWhile cpred-                    False -> liftI $ Done () (Chunk remm)-  step stream   = liftI $ Done () stream+  step (Chunk vec)+    | SC.null vec  = return $ Cont head Nothing+    | otherwise    = return $ Done (SC.head vec) (Chunk $ SC.tail vec)+  step stream      = return $ Cont head (Just (setEOF stream))  --- |Attempt to read the next element of the stream--- Return (Just c) if successful, return Nothing if the stream is--- terminated (by EOF or an error)-head :: (SC.StreamChunk s el, Monad m) =>-         IterateeGM s el m (Maybe el)-head = liftI $ Cont step+-- |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 :: (SC.StreamChunk s el, Monad m, Eq el) =>+         s el ->+         IterateeG s el m Int+heads st | SC.null st = return 0+heads st = loop 0 st   where-  step (Chunk vec)-    | SC.null vec  = head-    | otherwise      = liftI $ Done (Just $ SC.head vec) (Chunk $ SC.tail vec)-  step stream        = liftI $ Done Nothing stream+  loop cnt xs | SC.null xs = return cnt+  loop cnt xs              = IterateeG (step cnt xs)+  step cnt str (Chunk xs) | SC.null xs  = return $ Cont (loop cnt str) Nothing+  step cnt str stream     | SC.null str = return $ Done cnt stream+  step cnt str s@(Chunk xs) =+    if SC.head str == SC.head xs+       then step (succ cnt) (SC.tail str) (Chunk $ SC.tail xs)+       else return $ Done cnt s+  step cnt _ stream         = return $ Done cnt stream   -- |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 or an error)-peek :: (SC.StreamChunk s el, Monad m) =>-         IterateeGM s el m (Maybe el)-peek = liftI $ Cont step+peek :: (SC.StreamChunk s el, Monad m) => IterateeG s el m (Maybe el)+peek = IterateeG step   where   step s@(Chunk vec)-    | SC.null vec = peek-    | otherwise = liftI $ Done (Just $ SC.head vec) s-  step stream   = liftI $ Done Nothing stream+    | SC.null vec = return $ Cont peek Nothing+    | otherwise = return $ Done (Just $ SC.head vec) s+  step stream   = return $ Done Nothing stream   -- |Skip the rest of the stream-skipToEof :: (SC.StreamChunk s el, Monad m) => IterateeGM s el m ()-skipToEof = liftI $ Cont step+skipToEof :: (Monad m) => IterateeG s el m ()+skipToEof = IterateeG step   where-  step (Chunk _) = skipToEof-  step _         = return ()+  step (Chunk _) = return $ Cont skipToEof Nothing+  step s         = return $ Done () s ++-- |Seek to a position in the stream+seek :: (Monad m) => FileOffset -> IterateeG s el m ()+seek n = IterateeG step+  where+  step (Chunk _) = return $ Cont identity (Just (Seek n))+  step s         = return $ Done () s+++ -- |Skip n elements of the stream, if there are that many -- This is the analogue of List.drop-drop :: (SC.StreamChunk s el, Monad m) => Int -> IterateeGM s el m ()+drop :: (SC.StreamChunk s el, Monad m) => Int -> IterateeG s el m () drop 0 = return ()-drop n = liftI $ Cont step-  where-  step (Chunk str) | SC.length str <= n = drop (n - SC.length str)-  step (Chunk str) = liftI $ Done () (Chunk s2)-   where-   (_s1,s2) = SC.splitAt n str-  step stream      = liftI $ Done () stream---- |Create a request to seek within an input stream.  This will result in--- an error if the enumerator is not capable of responding to a seek request.-seek :: (SC.StreamChunk s el, Monad m) => FileOffset -> IterateeGM s el m ()-seek off = liftI (Seek off step)+drop n = IterateeG step   where-  step = liftI . Done ()+  step (Chunk str)+    | SC.length str <= n = return $ Cont (drop (n - SC.length str)) Nothing+  step (Chunk str)       = return $ Done () (Chunk (LL.drop n str))+  step stream            = return $ Done () stream  -- --------------------------------------------------- -- The converters show a different way of composing two iteratees:@@ -318,33 +378,29 @@ -- to process the embedded, inner stream as it reads the outer stream. type EnumeratorN s_outer el_outer s_inner el_inner m a =   IterateeG s_inner el_inner m a ->-  IterateeGM s_outer el_outer m (IterateeG s_inner el_inner m a)+  IterateeG s_outer el_outer m (IterateeG s_inner el_inner m a)  -- |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). 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@Done{} = drop n >> return iter-take n (Seek _off k) = liftI $ Cont step-  where-  step chunk@(Chunk str)-    | SC.null str        = liftI $ Cont step-    | SC.length str <= n = take (n - SC.length str) ==<< k chunk-  step (Chunk str)       = done (Chunk s1) (Chunk s2)-    where (s1,s2) = SC.splitAt n str-  step stream            = done stream stream-  done s1 s2             = k s1 >>== \r -> liftI $ Done r s2-take n (Cont k) = liftI $ Cont step+take n' iter = IterateeG (step n')   where-  step chunk@(Chunk str)-    | SC.null str        = liftI $ Cont step-    | SC.length str <= n = take (n - SC.length str) ==<< k chunk-  step (Chunk str)       = done (Chunk s1) (Chunk s2)-    where (s1,s2) = SC.splitAt n str-  step stream            = done stream stream-  done s1 s2             = k s1 >>== \r -> liftI $ Done r s2+  step n chk@(Chunk str)+    | SC.null str = return $ Cont (take n iter) Nothing+    | SC.length str <= n = return $ Cont (joinIM inner) Nothing+      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 (Cont x Nothing)  = take n x+  check n (Cont _ (Just e)) = drop n >> throwErr e+  done s1 s2 = runIter iter s1 >>= checkIfDone return >>= \i' ->+               return (Done i' s2)   -- |Read n elements from a stream and apply the given iteratee to the@@ -352,24 +408,26 @@ -- 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. This variation is particularly useful for randomIO,--- where we do not have to care to `drain the input stream'.+-- finished early. takeR :: (SC.StreamChunk s el, Monad m) =>-          Int ->-          EnumeratorN s el 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@Done{} = return iter-takeR _n iter@Seek{} = return iter-takeR n (Cont k)     = liftI $ Cont step+takeR n iter = IterateeG (step n)   where-  step chunk@(Chunk str)-    | SC.null str        = liftI $ Cont step-    | SC.length str <= n = takeR (n - SC.length str) ==<< k chunk-  step (Chunk str)       = done (Chunk s1) (Chunk s2)-    where (s1,s2) = SC.splitAt n str-  step stream            = done stream stream-  done s1 s2             = k s1 >>== \r -> liftI $ Done r s2+  step n' s@(Chunk str)+    | LL.null str        = return $ Cont (takeR n iter) Nothing+    | LL.length str <= n = runIter iter s >>= check (n - LL.length str)+    | otherwise          = done (Chunk str1) (Chunk str2)+      where (str1, str2) = LL.splitAt n' str+  step _n str            = done str str+  check _n' (Done a str)   = return $ Done (return a) str+  check n'  (Cont k mErr)  = return $ Cont (takeR n' k) mErr+  done s1 s2 = runIter iter s1 >>= checkIfDone return >>= \i' ->+               return (Done i' s2) + -- |Map the stream: yet 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@@ -379,42 +437,33 @@ mapStream :: (SC.StreamChunk s el, SC.StreamChunk s el', Monad m) =>               (el -> el') ->               EnumeratorN s el s el' m a-mapStream _f iter@Done{} = return iter-mapStream f (Cont k) = liftI $ Cont step-  where-  step (Chunk str)-    | SC.null str  = liftI $ Cont step-  step (Chunk str) = k (Chunk (SC.cMap f str)) >>== mapStream f-  step EOF         = k EOF                     >>== \r -> liftI $ Done r EOF-  step (Error err) = k (Error err)             >>== \r ->-                       liftI $ Done r (Error err)-mapStream f (Seek off k) = liftI $ Seek off step+mapStream f iter = IterateeG (\str -> runIter iter (strMap (SC.cMap f) str) >>=+                   check)   where-  step (Chunk str)-    | SC.null str  = liftI $ Cont step-  step (Chunk str) = k (Chunk (SC.cMap f str)) >>== mapStream f-  step EOF         = k EOF                     >>== \r -> liftI $ Done r EOF-  step (Error err) = k (Error err)             >>== \r ->-                       liftI $ Done r (Error err)+  check (Done a _) = return $ Done (return a) (Chunk LL.empty)+  check (Cont k mErr) = return $ Cont (mapStream f 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 -- 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--- IterateeGM s el m (Maybe [el']).  The `Maybe' type reflects the--- possibility of the conversion error.-convStream :: (SC.StreamChunk s el, SC.StreamChunk s' el', Monad m) =>-  IterateeGM s el m (Maybe (s' el')) -> EnumeratorN s el s' el' m a-convStream _fi iter@Done{} = return iter-convStream fi (Cont k) = fi >>=-  (convStream fi ==<<) . k . maybe (Error "conv: stream error") Chunk-convStream fi (Seek _off k) = fi >>=-  (convStream fi ==<<) . k . maybe (Error "conv: stream error") Chunk--{-# SPECIALIZE convStream :: (SC.StreamChunk s el, SC.StreamChunk s' el') => IterateeGM s el IO (Maybe (s' el')) -> EnumeratorN s el s' el' IO a #-}+-- IterateeGM s el m (Maybe (s' el')).  The Maybe type is in case of+-- errors (or end of stream).+convStream :: Monad m =>+  IterateeG s el m (Maybe (s' el')) ->+  EnumeratorN s el s' el' m a+convStream fi iter = fi >>= check+  where+  check (Just xs) = lift (runIter iter (Chunk xs)) >>= docase+  check (Nothing) = return iter+  docase (Done a _)        = return . return $ a+  docase (Cont k Nothing)  = convStream fi k+  docase (Cont _ (Just e)) = return $ throwErr e +{-# SPECIALIZE convStream :: IterateeG s el IO (Maybe (s' el')) -> EnumeratorN s el s' el' IO a #-}  -- ------------------------------------------------------------------------ -- Enumerators@@ -428,26 +477,32 @@ -- enumerators. The latter is useful when one iteratee -- reads from the concatenation of two data sources. -type EnumeratorGM s el m a = IterateeG s el m a -> IterateeGM s el m a+type EnumeratorGM s el m a = IterateeG s el m a -> m (IterateeG s el m a)  -- |More general enumerator type: enumerator that maps -- streams (not necessarily in lock-step).  This is -- a flattened (`joinI-ed') EnumeratorN sfrom elfrom sto elto m a type EnumeratorGMM sfrom elfrom sto elto m a =-  IterateeG sto elto m a -> IterateeGM sfrom elfrom m a+  IterateeG sto elto m a -> m (IterateeG sfrom elfrom m a)  -- |The most primitive enumerator: applies the iteratee to the terminated -- stream. The result is the iteratee usually in the done state.-enumEof :: (SC.StreamChunk s el, Monad m) => EnumeratorGM s el m a-enumEof (Done x _)    = liftI $ Done x EOF-enumEof (Cont k)      = k EOF-enumEof (Seek _off k) = k EOF+enumEof :: Monad m =>+           EnumeratorGM s el m a+enumEof iter = runIter iter (EOF Nothing) >>= check+  where+  check (Done x _) = return $ IterateeG $ return . Done x+  check (Cont _ e) = return $ throwErr (fromMaybe (Err "Divergent Iteratee") e)  -- |Another primitive enumerator: report an error-enumErr :: (SC.StreamChunk s el, Monad m) => String -> EnumeratorGM s el m a-enumErr str (Done x _)    = liftI $ Done x (Error str)-enumErr str (Cont k)      = k (Error str)-enumErr str (Seek _off k) = k (Error str)+enumErr :: (SC.StreamChunk s el, Monad m) =>+           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)+  check (Cont _ e') = return $ throwErr+                      (fromMaybe (Err "Divergent Iteratee") e')  -- |The composition of two enumerators: essentially the functional composition -- It is convenient to flip the order of the arguments of the composition@@ -455,7 +510,7 @@  (>.):: (SC.StreamChunk s el, Monad m) =>        EnumeratorGM s el m a -> EnumeratorGM s el m a -> EnumeratorGM s el m a-e1 >. e2 = (e2 ==<<) . e1+(>.) e1 e2 i1 = e1 i1 >>= e2  -- |The pure 1-chunk enumerator -- It passes a given list of elements to the iteratee in one chunk@@ -463,21 +518,26 @@ enumPure1Chunk :: (SC.StreamChunk s el, Monad m) =>                     s el ->                     EnumeratorGM s el m a-enumPure1Chunk _str iter@Done{} = liftI iter-enumPure1Chunk str (Cont k) = k (Chunk str)-enumPure1Chunk _str (Seek _off _k) = fail "enumPure1Chunk cannot handle random IO"+enumPure1Chunk str iter = runIter iter (Chunk str) >>= checkIfDone return + -- |The pure n-chunk enumerator--- It passes a given lift of elements to the iteratee in n chunks+-- It passes a given chunk of elements to the iteratee in n chunks -- 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-enumPureNChunk _str _n iter@Done{}   = liftI iter-enumPureNChunk str  _n iter | SC.null str = liftI iter-enumPureNChunk str n (Cont k)        = enumPureNChunk s2 n ==<< k (Chunk s1)-  where (s1,s2) = SC.splitAt n str-enumPureNChunk _str _n (Seek _off _k) = fail "enumPureNChunk cannot handle ranom IO"+enumPureNChunk str _ iter | SC.null str = return iter+enumPureNChunk str n iter | n > 0 = runIter iter (Chunk s1) >>=+                                    checkIfDone (enumPureNChunk s2 n)+  where+  (s1, s2) = SC.splitAt n str+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 m = IterateeG (\str -> m >>= flip runIter str) 

@@ -14,6 +14,7 @@ import qualified Prelude as P  import qualified Data.List as L+import qualified Data.ListLike as LL import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Array@@ -21,52 +22,56 @@  -- |Class of types that can be used to hold chunks of data within Iteratee -- streams.-class StreamChunk c el where+class LL.ListLike (c el) el => StreamChunk c el where   -- |Length of currently available data.   length :: c el -> Int-  -- |Create an empty chunk of data.-  empty :: c el+  length = LL.length+   -- |Test if the current stream is null.   null :: c el -> Bool+  null = LL.null+   -- |Prepend an element to the front of the data.   cons :: el -> c el -> c el+  cons = LL.cons+   -- |Return the first element of the stream.   head :: c el -> el+  head = LL.head+   -- |Return the tail of the stream.   tail :: c el -> c el+  tail = LL.tail+   -- |First index matching the predicate.   findIndex :: (el -> Bool) -> c el -> Maybe Int+  findIndex = LL.findIndex+   -- |Split the data at the specified index.   splitAt :: Int -> c el -> (c el, c el)+  splitAt = LL.splitAt+   -- |Drop data matching the predicate.   dropWhile :: (el -> Bool) -> c el -> c el-  -- |Append to chunks of data into one.-  append :: c el -> c el -> c el+  dropWhile = LL.dropWhile+   -- |Create a stream from a list.   fromList :: [el] -> c el+  fromList = LL.fromList+   -- |Create a list from the stream.   toList :: c el -> [el]+  toList = LL.toList+   -- |Map a computation over the stream.   cMap :: (StreamChunk c' el') => (el -> el') -> c el -> c' el'+  cMap f = LL.foldr (LL.cons . f) LL.empty  instance StreamChunk [] el where-  length    = P.length-  empty     = []-  null []   = True-  null _    = False-  cons      = (:)-  head      = P.head-  tail      = P.tail-  findIndex = L.findIndex-  splitAt   = P.splitAt-  dropWhile = P.dropWhile-  append    = (++)-  fromList   = id-  toList     = id   cMap       = listmap  listmap :: (StreamChunk s' el') => (el -> el') -> [el] -> s' el'-listmap f = foldr (cons . f) empty+listmap f = foldr (LL.cons . f) LL.empty  {-# RULES "listmap/map" listmap = map #-} 

@@ -5,14 +5,13 @@   -- * Types   Endian (..),   -- * Endian multi-byte iteratees-  endian_read2,-  endian_read3,-  endian_read4+  endianRead2,+  endianRead3,+  endianRead4 ) where  import Data.Iteratee.Base.StreamChunk (StreamChunk)-import Data.Iteratee.Base (IterateeGM) import qualified Data.Iteratee.Base as It import Data.Word import Data.Bits@@ -29,46 +28,49 @@   | LSB           -- ^ Least Significan Byte is first (little-endian)   deriving (Eq, Ord, Show, Enum) -endian_read2 :: (StreamChunk s Word8, Monad m) => Endian -> IterateeGM s Word8 m (Maybe Word16)-endian_read2 e =-  It.bindm It.head $ \c1 ->-  It.bindm It.head $ \c2 ->+endianRead2 :: (StreamChunk s Word8, Monad m) => Endian ->+                It.IterateeG s Word8 m Word16+endianRead2 e = do+  c1 <- It.head+  c2 <- It.head   case e of-    MSB -> return $ return $ (fromIntegral c1 `shiftL` 8) .|. fromIntegral c2-    LSB -> return $ return $ (fromIntegral c2 `shiftL` 8) .|. fromIntegral c1+    MSB -> return $ (fromIntegral c1 `shiftL` 8) .|. fromIntegral c2+    LSB -> return $ (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 Word32 can be properly set negative as -- well.-endian_read3 :: (StreamChunk s Word8, Monad m) => Endian -> IterateeGM s Word8 m (Maybe Word32)-endian_read3 e = -  It.bindm It.head $ \c1 ->-  It.bindm It.head $ \c2 ->-  It.bindm It.head $ \c3 ->+endianRead3 :: (StreamChunk s Word8, Monad m) => Endian ->+                It.IterateeG s Word8 m Word32+endianRead3 e = do+  c1 <- It.head+  c2 <- It.head+  c3 <- It.head   case e of-    MSB -> return $ return $ (((fromIntegral c1+    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 $ return $ (((fromIntegral c3+     return $ (((fromIntegral c3                         `shiftL` 8) .|. fromIntegral c2)                         `shiftL` 8) .|. fromIntegral m -endian_read4 :: (StreamChunk s Word8, Monad m) => Endian -> IterateeGM s Word8 m (Maybe Word32)-endian_read4 e =-  It.bindm It.head $ \c1 ->-  It.bindm It.head $ \c2 ->-  It.bindm It.head $ \c3 ->-  It.bindm It.head $ \c4 ->+endianRead4 :: (StreamChunk s Word8, Monad m) => Endian ->+                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 $ return $ +    MSB -> return $  	       (((((fromIntegral c1 		`shiftL` 8) .|. fromIntegral c2) 	        `shiftL` 8) .|. fromIntegral c3) 	        `shiftL` 8) .|. fromIntegral c4-    LSB -> return $ return $ +    LSB -> return $  	       (((((fromIntegral c4 		`shiftL` 8) .|. fromIntegral c3) 	        `shiftL` 8) .|. fromIntegral c2)

@@ -16,22 +16,22 @@   -- * Type synonyms   Stream,   Iteratee,-  IterateeM,   EnumeratorM,   Line,   -- * Word and Line processors   line,-  print_lines,-  enum_lines,-  enum_words,+  printLines,+  readLines,+  enumLines,+  enumWords,    module Data.Iteratee.Base )  where -import Data.Iteratee.Base (StreamG (..), IterateeG, IterateeGM, EnumeratorGM, (==<<), liftI) import qualified Data.Iteratee.Base as Iter+import Data.Iteratee.Base hiding (break) import Data.Char import Control.Monad.Trans @@ -39,8 +39,7 @@ -- This stream is used by many input parsers. type Stream = StreamG [] Char -type Iteratee  m a = IterateeG  [] Char m a-type IterateeM m a = IterateeGM [] Char m a+type Iteratee = IterateeG [] Char  -- Useful combinators for implementing iteratees and enumerators @@ -55,17 +54,13 @@ -- The code is the same as that of pure Iteratee, only the signature -- has changed. -- Compare the code below with GHCBufferIO.line_lazy-line :: Monad m => IterateeM m (Either Line Line)-line = Iter.break (\c -> c == '\r' || c == '\n') >>= check_next- where- check_next (line',Just '\r') = Iter.peek >>= \c ->-	case c of-	  Just '\n' -> Iter.head >> return (Right line')-	  Just _    -> return (Right line')-	  Nothing   -> return (Left line')- check_next (line',Just _)  = return (Right line')- check_next (line',Nothing) = return (Left line')-+line :: Monad m => IterateeG [] Char m (Either Line Line)+line = Iter.break (\c -> c == '\r' || c == '\n') >>= \l ->+       terminators >>= check l+  where+  check l 0 = return . Left $ l+  check l _ = return . Right $ l+  terminators = heads "\r\n" >>= \l -> if l == 0 then heads "\n" else return l  -- Line iteratees: processors of a stream whose elements are made of Lines @@ -74,17 +69,34 @@  -- |Print lines as they are received. This is the first `impure' iteratee -- with non-trivial actions during chunk processing-print_lines :: IterateeGM [] Line IO ()-print_lines = liftI $ Iter.Cont step- where- step (Chunk []) = print_lines- step (Chunk ls) = lift (mapM_ pr_line ls) >> print_lines- step EOF        = lift (putStrLn ">> natural end") >> liftI (Iter.Done () EOF)- step stream     = lift (putStrLn ">> unnatural end") >>-		   liftI (Iter.Done () stream)- pr_line line'   = putStrLn $ ">> read line: " ++ line'+printLines :: IterateeG [] Char IO ()+printLines = lines'+  where+  lines' = Iter.break (\c -> c == '\r' || c == '\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  +-- |Read a sequence of lines from the stream up to the empty lin+-- The line can be terminated by CR, LF, or CRLF -- or by EOF or stream error.+-- Return the read lines, in order, not including the terminating empty line+-- Upon EOF or stream error, return the complete, terminated lines accumulated+-- so far.++readLines :: (Monad m) => IterateeG [] Char m (Either [Line] [Line])+readLines = lines' []+  where+  lines' acc = Iter.break (\c -> c == '\r' || c == '\n') >>= \l ->+               terminators >>= check acc l+  check acc _  0 = return . Left . reverse $ acc -- no terminator found+  check acc "" _ = return . Right . reverse $ acc+  check acc l  _ = lines' (l:acc)+  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.@@ -93,35 +105,33 @@ -- This is the first proper iteratee-enumerator: it is the iteratee of the -- character stream and the enumerator of the line stream. -enum_lines :: Monad m =>-	      IterateeG [] Line m a ->-              IterateeGM [] Char m (IterateeG [] Line m a)-enum_lines iter@Iter.Done{} = return iter-enum_lines Iter.Seek{}      = error "Seeking is not supported by enum_lines"-enum_lines (Iter.Cont k)    = line >>= check_line k- where- check_line k' (Right "") =-   enum_lines ==<< k' EOF      -- empty line, normal term- check_line k' (Right l)  = enum_lines ==<< k' (Chunk [l])- check_line k' _          = enum_lines ==<< k' (Error "EOF") -- abnormal termin+enumLines :: (Functor m, Monad m) =>+             IterateeG [] Line m a ->+             IterateeG [] Char m (IterateeG [] Line m a)+enumLines iter = line >>= check iter+  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]) + -- |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--- One should keep in mind that enum_words is a more general, monadic+-- One should keep in mind that enumWords is a more general, monadic -- function. -enum_words :: Monad m =>-	      IterateeG [] String m a ->-              IterateeGM [] Char m (IterateeG [] String m a)-enum_words iter@Iter.Done{} = return iter-enum_words Iter.Seek{}      = error "Seeking not supported by enum_words"-enum_words (Iter.Cont k)    = Iter.dropWhile isSpace >>-                              Iter.break isSpace >>= check_word k- where- check_word k' ("",_)  = enum_words ==<< k' EOF- check_word k' (str,_) = enum_words ==<< k' (Chunk [str])+enumWords :: (Functor m, Monad m) =>+	     IterateeG [] String m a ->+             IterateeG [] Char m (IterateeG [] String m a)+enumWords iter = Iter.break isSpace >>= check iter+  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])   -- ------------------------------------------------------------------------

@@ -50,11 +50,12 @@  module Data.Iteratee.Codecs.Tiff where -import Data.Iteratee.Base (StreamG (..), IterateeG (..), IterateeGM, EnumeratorGMM, EnumeratorN, bindm, liftI, (==<<), (>.), (>>==), iterErr, enumErr, convStream, iterReportError, enumEof)-import qualified Data.Iteratee.Base as Iter+import Data.Iteratee+import qualified Data.Iteratee as Iter import qualified Data.Iteratee.Base.StreamChunk as SC import Data.Iteratee.Binary-import Control.Monad.State+import Control.Monad+import Control.Monad.Trans import Data.Char (chr) import Data.Int import Data.Word@@ -80,8 +81,8 @@  -- Sample TIFF processing function process_tiff :: MonadIO m => Maybe (IM.IntMap TIFFDE) ->-  IterateeGM [] Word8 m (Maybe String)-process_tiff Nothing = return $ Just "No dictionary"+  IterateeG [] 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@@ -98,12 +99,12 @@    (n,hist) <- compute_hist dict   note ["computed histogram over ", show n, " values\n", show hist]-  iterReportError >>= maybe (return ()) error+  --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+  --err <- iterReportError+  --maybe (return ()) error err+  --return err  where check_tag tag action v = do 	   vc <- action tag 	   case vc of@@ -115,14 +116,17 @@ -- sample processing of the pixel matrix: computing the histogram compute_hist :: MonadIO m =>                 TIFFDict ->-                IterateeGM [] Word8 m (Int,IM.IntMap Int)-compute_hist dict = Iter.joinI $ pixel_matrix_enum dict ==<< compute_hist' 0 IM.empty+                IterateeG [] 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 = liftI . Cont . step count+ compute_hist' count hist = IterateeG (step count hist)  step count hist (Chunk ch)-   | SC.null ch  = compute_hist' count hist-   | otherwise = compute_hist' (count + SC.length ch) (foldr accum hist ch)- step count hist s        = liftI $ Done (count,hist) s+   | SC.null ch  = return $ Cont (compute_hist' count hist) Nothing+   | otherwise = return $ Cont+                 (compute_hist' (count + SC.length ch) (foldr accum hist ch))+                 Nothing+ step count hist s        = return $ Done (count,hist) s  accum e = IM.insertWith (+) (fromIntegral e) 1  -- Another sample processor of the pixel matrix: verifying values of@@ -130,22 +134,23 @@ -- 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)] -> IterateeGM [] Word8 m ()-verify_pixel_vals dict pixels = Iter.joinI $ pixel_matrix_enum dict ==<< +                     TIFFDict -> [(IM.Key, Word8)] -> IterateeG [] 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 = liftI $ Cont (step n m)+ verify n m = IterateeG (step n m)  step n m (Chunk xs)-   | SC.null xs = verify n m+   | 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 iterErr $ unwords ["Pixel #",show n,+		     else let er = (unwords ["Pixel #",show n, 					      "expected:",show v,-					      "found", show h]+					      "found", show h])+                          in return $ Cont (throwErr . Err $ er) (Just $ Err er)     (Nothing,m')->    step (succ n) m' (Chunk t)- step _n _m s = liftI $ Done () s+ step _n _m s = return $ Done () s   -- ========================================================================@@ -303,13 +308,13 @@   -- The library function to read the TIFF dictionary-tiff_reader :: IterateeGM [] Word8 IO (Maybe TIFFDict)+tiff_reader :: IterateeG [] Word8 IO (Maybe TIFFDict) tiff_reader = do   endian <- read_magic   check_version   case endian of-    Just e -> bindm (endian_read4 e) $ \dict_offset -> do-              Iter.seek (fromIntegral dict_offset)+    Just e -> do+              endianRead4 e >>= Iter.seek . fromIntegral               load_dict e     Nothing -> return Nothing  where@@ -318,18 +323,18 @@      c1 <- Iter.head      c2 <- Iter.head      case (c1,c2) of-      (Just 0x4d, Just 0x4d) -> return $ Just MSB-      (Just 0x49, Just 0x49) -> return $ Just LSB-      _ -> (iterErr $ "Bad TIFF magic word: " ++ show [c1,c2])+      (0x4d, 0x4d) -> return $ Just MSB+      (0x49, 0x49) -> return $ Just LSB+      _ -> (throwErr .Err $ "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 <- endian_read2 MSB-     case v of-      Just v' | v' == tiff_version -> return ()-      _ -> iterErr $ "Bad TIFF version: " ++ show v+     v <- endianRead2 MSB+     if v == tiff_version+       then return ()+       else throwErr (Err $ "Bad TIFF version: " ++ show v)  -- A few conversion procedures u32_to_float :: Word32 -> Double@@ -353,27 +358,27 @@ -- u8_to_s8 128 == -128 -- u8_to_s8 255 == -1 -note :: (MonadIO m) => [String] -> IterateeGM [] el m ()-note = lift . liftIO . putStrLn . concat+note :: (MonadIO m) => [String] -> IterateeG [] el 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 -> IterateeGM [] Word8 m (Maybe TIFFDict)-load_dict e =-  bindm (endian_read2 e) $ \nentries -> do-   dict <- foldr (const read_entry) (return (Just IM.empty)) [1..nentries]-   bindm (endian_read4 e) $ \next_dict -> do-   when (next_dict > 0) $+load_dict :: MonadIO m => Endian -> IterateeG [] 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+  return dict  where-  read_entry dictM =-    bindm dictM $ \dict ->-     bindm (endian_read2 e) $ \tag ->    -     bindm (endian_read2 e) $ \typ' ->    -     bindm (convert_type (fromIntegral typ')) $ \typ ->    -     bindm (endian_read4 e) $ \count -> do+  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@@ -381,40 +386,42 @@       note ["TIFFEntry: tag ",show . int_to_tag . fromIntegral $ tag,  	   " type ", show typ, " count ", show count]-     enum_m <- read_value typ e (fromIntegral 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) => Int -> IterateeGM [] el m (Maybe TIFF_TYPE)+  convert_type :: (Monad m) => Int -> IterateeG [] el m (Maybe TIFF_TYPE)   convert_type typ | typ > 0 && typ <= fromEnum (maxBound::TIFF_TYPE)       = return . Just . toEnum $ typ   convert_type typ = do-      iterErr $ "Bad type of entry: " ++ show typ+      throwErr . Err $ "Bad type of entry: " ++ show typ       return Nothing    read_value :: MonadIO m => TIFF_TYPE -> Endian -> Int -> -                IterateeGM [] Word8 m (Maybe TIFFDE_ENUM)+                IterateeG [] Word8 m (Maybe TIFFDE_ENUM) -  read_value typ e' 0 =-    bindm (endian_read4 e') $ \_offset -> do-      iterErr $ "Zero count in the entry of type: " ++ show typ-      return Nothing+  read_value typ e' 0 = do+    endianRead4 e'+    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_value TT_ascii e' count | count > 4 = -- for sure, val-offset is offset-    bindm (endian_read4 e') $ \offset ->-      return . Just . TEN_CHAR $ \iter_char -> do+  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 -                         (bindm Iter.head (return. Just .(:[]). chr . fromIntegral))+                         (checkErr Iter.head >>= return . either (const Nothing) (Just . (:[]) . chr . fromIntegral))                          iter_char-            Iter.joinI $ Iter.joinI $ Iter.takeR (pred count) ==<< iter+            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@@ -422,138 +429,123 @@   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 = bindm Iter.head (\v -> loop ((chr . fromIntegral $ v):acc)+        loop acc n = Iter.head >>= (\v -> loop ((chr . fromIntegral $ v):acc)                                              (pred n))-    bindm (loop [] len) $ \str -> do-      Iter.drop (4-len)-      return . Just . TEN_CHAR $ immed_value str+    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 =-    bindm (endian_read4 e') $ \offset ->-      return . Just . TEN_INT $ \iter_int -> do+  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 -                         (bindm Iter.head (return . Just . (:[]) . conv_byte typ))+                         (checkErr Iter.head >>= return . either (const Nothing) (Just . (:[]) . conv_byte typ))                          iter_int-            Iter.joinI $ Iter.joinI $ Iter.takeR count ==<< iter+            Iter.joinI $ Iter.joinI $ Iter.takeR 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 = bindm Iter.head (\v -> loop (conv_byte typ v:acc)+        loop acc n = Iter.head >>= (\v -> loop (conv_byte typ v:acc)                                              (pred n))-    bindm (loop [] count) $ \str -> do-      Iter.drop (4-count)-      return . Just . TEN_INT $ immed_value str+    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 =-    bindm (endian_read4 e') $ \offset ->-      return . Just . TEN_BYTE $ \iter -> do-            Iter.seek (fromIntegral offset)-            Iter.joinI $ Iter.takeR count iter+  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      let loop acc 0 = return . Just . reverse $ acc-        loop acc n = bindm Iter.head (\v -> loop (v:acc) (pred n))-    bindm (loop [] count) $ \str -> do-      Iter.drop (4-count)-      return . Just . TEN_BYTE $ immed_value str+        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 =-    bindm (endian_read2 e') $ \item -> do-      Iter.drop 2				-- skip the padding-      return . Just . TEN_INT $ immed_value [conv_short typ item]+  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 =-    bindm (endian_read2 e') $ \i1 -> -     bindm (endian_read2 e') $ \i2 ->-      return . Just . TEN_INT $ +  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 =-    bindm (endian_read4 e') $ \offset ->-      return . Just . TEN_INT $ \iter_int -> do-            Iter.seek (fromIntegral offset)-            let iter = convStream -                         (bindm (endian_read2 e') -			  (return . Just . (:[]) . conv_short typ))+  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))                          iter_int-            Iter.joinI $ Iter.joinI $ Iter.takeR (2*count) ==<< iter+          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_value typ e' 1 | typ == TT_long || typ == TT_slong =-    bindm (endian_read4 e') $ \item ->-      return . Just . TEN_INT $ immed_value [conv_long typ item]+  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 =-    bindm (endian_read4 e') $ \offset ->-      return . Just . TEN_INT $ \iter_int -> do+  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 -                         (bindm (endian_read4 e')  -			  (return . Just . (:[]) . conv_long typ))+                         (checkErr (endianRead4 e') >>=+                           return . either (const Nothing) (Just . (:[]) . conv_long typ))                          iter_int-            Iter.joinI $ Iter.joinI $ Iter.takeR (4*count) ==<< iter--			-- Read the array of rationals. A rational can't-			-- be packed into the offset field-{--  read_value typ e count | typ == TT_rational || typ == TT_srational = do -    bindm (endian_read4 e) $ \offset ->-      return . Just . TEN_RAT $ \iter_rat -> do-            Iter.seek (fromIntegral offset)-            let iter = convStream -                         (bindm (endian_read4 e) $ \i1 ->-			   bindm (endian_read4 e) $ \i2 ->-			    (return . Just . (:[]) $ conv_rat typ i1 i2))-                         iter_rat-            Iter.joinI $ Iter.joinI $ Iter.takeR (8*count) ==<< iter--}+            Iter.joinI $ Iter.joinI $ Iter.takeR (4*count) iter  -  read_value typ e' count = -- stub-    bindm (endian_read4 e') $ \_offset -> do+  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] -> EnumeratorGMM [] Word8 [] el m a   immed_value item iter =-     (Iter.enumPure1Chunk item >. enumEof) iter >>== Iter.joinI . return+     --(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 "This should never happen"+  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 "This should never happen"+  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 "This should never happen"--{- this code is never used...-  conv_rat :: TIFF_TYPE -> Word32 -> Word32 -> Rational-  conv_rat TT_rational v1 v2 = (fromIntegral v1) % (fromIntegral v2)-  conv_rat TT_srational v1 v2 = (fromIntegral (u32_to_s32 v1)) % -				(fromIntegral (u32_to_s32 v2))-  conv_rat _tt _ _ = error "This should never happen"--}+  conv_long _ = error "conv_long called with non-long type"  -- Reading the pixel matrix -- For simplicity, we assume no compression and 8-bit pixels@@ -561,34 +553,34 @@ pixel_matrix_enum dict iter = validate_dict >>= proceed  where    -- Make sure we can handle this particular TIFF image-   validate_dict =-      dict_assert TG_COMPRESSION 1         `bindm`  \() ->-      dict_assert TG_SAMPLESPERPIXEL 1    `bindm`  \() ->-      dict_assert TG_BITSPERSAMPLE 8      `bindm`  \() ->-      dict_read_int TG_IMAGEWIDTH dict    `bindm`  \ncols ->-      dict_read_int TG_IMAGELENGTH dict   `bindm`  \nrows ->-      dict_read_ints TG_STRIPOFFSETS dict `bindm`  \strip_offsets -> do-        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+   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 ()-	_ -> iterErr (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 = enumErr "Can't handle this TIFF" iter >>== return+   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      note ["Processing the pixel matrix, ", show image_size, " bytes"]-     let loop _pos _ iter'@Done{} = return iter'-         loop _pos [] iter'          = return iter'+     let loop _pos [] iter'          = return iter'          loop pos (strip:strips) iter' = do 	   Iter.seek (fromIntegral strip) 	   let len = min strip_size (image_size - pos)@@ -600,7 +592,7 @@ -- A few helpers for getting data from TIFF dictionary  dict_read_int :: Monad m => TIFF_TAG -> TIFFDict ->-                 IterateeGM [] Word8 m (Maybe Int)+                 IterateeG [] Word8 m (Maybe Int) dict_read_int tag dict = do   els <- dict_read_ints tag dict   case els of@@ -608,28 +600,28 @@    _          -> return Nothing  dict_read_ints :: Monad m => TIFF_TAG -> TIFFDict -> -		  IterateeGM [] Word8 m (Maybe [Int])+		  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 <- enum  ==<< Iter.stream2list+	     e <- joinIM $ enum stream2list 	     return (Just e)       _ -> return Nothing  dict_read_rat :: Monad m => TIFF_TAG -> TIFFDict ->-                 IterateeGM [] Word8 m (Maybe (Ratio Int))+                 IterateeG [] 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] <- enum  ==<< Iter.stream2list+	     [e] <- joinIM $ enum stream2list 	     return (Just e)       _ -> return Nothing  dict_read_string :: Monad m => TIFF_TAG -> TIFFDict ->-                    IterateeGM [] Word8 m (Maybe String)+                    IterateeG [] 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 <- enum  ==<< Iter.stream2list+	     e <- joinIM $ enum stream2list 	     return (Just e)       _ -> return Nothing

@@ -2,7 +2,9 @@  {- -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 and commonly installed packages.+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.  -} @@ -11,24 +13,24 @@   WAVEDE_ENUM (..),   WAVE_CHUNK (..),   AudioFormat (..),-  wave_reader,-  read_riff,-  wave_chunk,-  chunk_to_string,-  dict_read_format,-  dict_read_first_format,-  dict_read_last_format,-  dict_read_first_data,-  dict_read_last_data,-  dict_read_data,-  dict_process_data+  waveReader,+  readRiff,+  waveChunk,+  chunkToString,+  dictReadFormat,+  dictReadFirstFormat,+  dictReadLastFormat,+  dictReadFirstData,+  dictReadLastData,+  dictReadData,+  dictProcessData ) where  import Data.Iteratee.Base import qualified Data.Iteratee.Base as Iter import Data.Iteratee.Binary-import Data.Char (chr)+import Data.Char (chr, ord) import Data.Int import Data.Word import Data.Bits (shiftL)@@ -74,21 +76,20 @@ -- wave chunk reading/writing functions  -- |Convert a string to WAVE_CHUNK type-wave_chunk :: String -> Maybe WAVE_CHUNK-wave_chunk str+waveChunk :: String -> Maybe WAVE_CHUNK+waveChunk str   | str == "fmt " = Just WAVE_FMT   | str == "data" = Just WAVE_DATA   | length str == 4 = Just $ WAVE_OTHER str   | otherwise = Nothing  -- |Convert a WAVE_CHUNK to the representative string-chunk_to_string :: WAVE_CHUNK -> String-chunk_to_string WAVE_FMT = "fmt "-chunk_to_string WAVE_DATA = "data"-chunk_to_string (WAVE_OTHER str) = str+chunkToString :: WAVE_CHUNK -> String+chunkToString WAVE_FMT = "fmt "+chunkToString WAVE_DATA = "data"+chunkToString (WAVE_OTHER str) = str  -- -------------------- throw this in here for now... data AudioFormat = AudioFormat {   numberOfChannels :: NumChannels, -- ^Number of channels in the audio data   sampleRate :: SampleRate, -- ^Sample rate of the audio@@ -100,222 +101,207 @@ type BitDepth = Integer  -- convenience function to read a 4-byte ASCII string-string_read4 :: Monad m => IterateeGM L Word8 m (Maybe String)-string_read4 =-  bindm Iter.head $ \s1 ->-   bindm Iter.head $ \s2 ->-   bindm Iter.head $ \s3 ->-   bindm Iter.head $ \s4 ->-   return . Just $ map (chr . fromIntegral) [s1, s2, s3, s4]+stringRead4 :: Monad m => IterateeG L 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-wave_reader :: IterateeGM L Word8 IO (Maybe WAVEDict)-wave_reader = do-  read_riff-  bindm (endian_read4 LSB) $ \tot_size -> do-    read_riff_wave-    chunks_m <- find_chunks $ fromIntegral tot_size-    load_dict $ join_m chunks_m+waveReader :: IterateeG L 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.-read_riff :: IterateeGM L Word8 IO ()-read_riff = do-  s <- string_read4-  case s == Just "RIFF" of-    True -> return ()-    False -> iterErr $ "Bad RIFF header: " ++ show s+readRiff :: IterateeG L Word8 IO ()+readRiff = do+  cnt <- heads $ fmap (fromIntegral . ord) "RIFF"+  if cnt == 4 then return () else throwErr $ Err "Bad RIFF header"  -- | Read the WAVE part of the RIFF header.-read_riff_wave :: IterateeGM L Word8 IO ()-read_riff_wave = do-  s <- string_read4-  case s == Just "WAVE" of-    True -> return ()-    False -> iterErr $ "Bad RIFF/WAVE header: " ++ show s+readRiffWave :: IterateeG L Word8 IO ()+readRiffWave = do+  cnt <- heads $ fmap (fromIntegral . ord) "WAVE"+  if cnt == 4 then return () else throwErr $ Err "Bad RIFF/WAVE header"  -- | An internal function to find all the chunks.  It assumes that the -- stream is positioned to read the first chunk.-find_chunks :: Int -> IterateeGM L Word8 IO (Maybe [(Int, WAVE_CHUNK, Int)])-find_chunks n = find_chunks' 12 []+findChunks :: Int -> IterateeG L Word8 IO (Maybe [(Int, WAVE_CHUNK, Int)])+findChunks n = findChunks' 12 []   where-  find_chunks' offset acc =-    bindm string_read4 $ \typ -> do-      count <- endian_read4 LSB-      case (wave_chunk typ, count) of-        (Nothing, _) -> (iterErr $ "Bad subchunk descriptor: " ++ show typ)-          >> return Nothing-        (_, Nothing) -> iterErr "Bad subchunk length" >> return Nothing-        (Just chk, Just count') -> 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-              find_chunks' newpos $-               (fromIntegral offset, chk, fromIntegral count') : acc+  findChunks' offset acc = do+    typ <- stringRead4+    count <- endianRead4 LSB+    case waveChunk typ of+      Nothing -> (throwErr . Err $ "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 -load_dict :: [(Int, WAVE_CHUNK, Int)] ->-               IterateeGM L Word8 IO (Maybe WAVEDict)-load_dict = foldl read_entry (return (Just IM.empty))+loadDict :: [(Int, WAVE_CHUNK, Int)] ->+               IterateeG L Word8 IO (Maybe WAVEDict)+loadDict = foldl read_entry (return (Just IM.empty))   where-  read_entry dictM (offset, typ, count) =-    bindm dictM $ \dict -> do-      enum_m <- read_value 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)+  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)+    ) -read_value :: WAVEDict ->+readValue :: WAVEDict ->               Int -> -- Offset               WAVE_CHUNK -> -- Chunk type               Int -> -- Count-              IterateeGM L Word8 IO (Maybe WAVEDE_ENUM)-read_value _dict offset _ 0 = do-  iterErr $ "Zero count in the entry of chunk at: " ++ show offset+              IterateeG L Word8 IO (Maybe WAVEDE_ENUM)+readValue _dict offset _ 0 = do+  throwErr . Err $ "Zero count in the entry of chunk at: " ++ show offset   return Nothing -read_value dict offset WAVE_DATA count = do-  fmt_m <- dict_read_last_format dict+readValue dict offset WAVE_DATA count = do+  fmt_m <- dictReadLastFormat dict   case fmt_m of     Just fmt ->-      return . Just . WEN_DUB $ \iter_dub -> do+      return . Just . WEN_DUB $ \iter_dub -> return $ do         Iter.seek (8 + fromIntegral offset)-        let iter = Iter.convStream (conv_func fmt) iter_dub-        Iter.joinI $ Iter.joinI $ Iter.takeR count ==<< iter+        let iter = Iter.convStream (convFunc fmt) iter_dub+        joinI . joinI . takeR count $ iter     Nothing -> do-      iterErr $ "No valid format for data chunk at: " ++ show offset+      throwErr . Err $ "No valid format for data chunk at: " ++ show offset       return Nothing  -- return the WaveFormat iteratee-read_value _dict offset WAVE_FMT count =-  return . Just . WEN_BYTE $ \iter -> do+readValue _dict offset WAVE_FMT count =+  return . Just . WEN_BYTE $ \iter -> return $ do     Iter.seek (8 + fromIntegral offset)     Iter.joinI $ Iter.takeR count iter  -- for WAVE_OTHER, return Word8s and maybe the user can parse them-read_value _dict offset (WAVE_OTHER _str) count =-  return . Just . WEN_BYTE $ \iter -> do+readValue _dict offset (WAVE_OTHER _str) count =+  return . Just . WEN_BYTE $ \iter -> return $ do     Iter.seek (8 + fromIntegral offset)     Iter.joinI $ Iter.takeR count iter -unroller :: (Integral a, Monad m) =>-            IterateeGM L Word8 m (Maybe a) ->-            IterateeGM L Word8 m (Maybe (L a))-unroller iter = do-  w1 <- iter-  w2 <- iter-  w3 <- iter-  w4 <- iter-  w5 <- iter-  w6 <- iter-  w7 <- iter-  w8 <- iter-  case catMaybes [w1, w2, w3, w4, w5, w6, w7, w8] of-    [] -> return Nothing-    xs -> return $ Just xs  -- |Convert Word8s to Doubles-conv_func :: AudioFormat -> IterateeGM L Word8 IO (Maybe (L Double))-conv_func (AudioFormat _nc _sr 8) = (fmap . fmap . fmap)-  (normalize 8 . (fromIntegral :: Word8 -> Int8)) (unroller Iter.head)-conv_func (AudioFormat _nc _sr 16) = (fmap . fmap . fmap)-  (normalize 16 . (fromIntegral :: Word16 -> Int16))-    (unroller (endian_read2 LSB))-conv_func (AudioFormat _nc _sr 24) = (fmap . fmap . fmap)-  (normalize 24 . (fromIntegral :: Word32 -> Int32))-    (unroller (endian_read3 LSB))-conv_func (AudioFormat _nc _sr 32) = (fmap . fmap . fmap)-  (normalize 32 . (fromIntegral :: Word32 -> Int32))-    (unroller (endian_read4 LSB))-conv_func _ = iterErr "Invalid wave bit depth" >> return Nothing+convFunc :: AudioFormat -> IterateeG L Word8 IO (Maybe (L Double))+convFunc (AudioFormat _nc _sr 8) = (fmap . fmap)+  ((:[]) . normalize 8 . (fromIntegral :: Word8 -> Int8))+    (fmap eitherToMaybe (checkErr Iter.head))+convFunc (AudioFormat _nc _sr 16) = (fmap . fmap)+  ((:[]) . normalize 16 . (fromIntegral :: Word16 -> Int16))+    (fmap eitherToMaybe (checkErr $ endianRead2 LSB))+convFunc (AudioFormat _nc _sr 24) = (fmap . fmap)+  ((:[]) . normalize 24 . (fromIntegral :: Word32 -> Int32))+    (fmap eitherToMaybe (checkErr $ endianRead3 LSB))+convFunc (AudioFormat _nc _sr 32) = (fmap . fmap)+  ((:[]) . normalize 32 . (fromIntegral :: Word32 -> Int32))+    (fmap eitherToMaybe (checkErr $ endianRead4 LSB))+convFunc _ = return Nothing +eitherToMaybe :: Either a b -> Maybe b+eitherToMaybe = either (const Nothing) Just+ -- |An Iteratee to read a wave format chunk-sWaveFormat :: IterateeGM L Word8 IO (Maybe AudioFormat)-sWaveFormat =-  bindm (endian_read2 LSB) $ \f' -> --data format, 1==PCM-   bindm (endian_read2 LSB) $ \nc ->-   bindm (endian_read4 LSB) $ \sr -> do-     Iter.drop 6-     bindm (endian_read2 LSB) $ \bd ->-       case f' == 1 of-         True -> return . Just $ AudioFormat (fromIntegral nc)-                                             (fromIntegral sr)-                                             (fromIntegral bd)-         False -> return Nothing+sWaveFormat :: IterateeG L 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.-dict_read_first_format :: WAVEDict -> IterateeGM L Word8 IO (Maybe AudioFormat)-dict_read_first_format dict = case IM.lookup (fromEnum WAVE_FMT) dict of+dictReadFirstFormat :: WAVEDict -> IterateeG L 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) -> enum ==<< sWaveFormat+  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.-dict_read_last_format :: WAVEDict -> IterateeGM L Word8 IO (Maybe AudioFormat)-dict_read_last_format dict = case IM.lookup (fromEnum WAVE_FMT) dict of+dictReadLastFormat :: WAVEDict -> IterateeG L 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-    enum ==<< sWaveFormat+    joinIM $ enum sWaveFormat   _ -> return Nothing  -- |Read the specified format chunk from the WAVE dictionary-dict_read_format :: Int -> --Index in the format chunk list to read+dictReadFormat :: Int -> --Index in the format chunk list to read                     WAVEDict -> --Dictionary-                    IterateeGM L Word8 IO (Maybe AudioFormat)-dict_read_format ix dict = case IM.lookup (fromEnum WAVE_FMT) dict of+                    IterateeG L 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-    enum ==<< sWaveFormat+    joinIM $ enum sWaveFormat   _ -> return Nothing  -- |Read the first data chunk in the WAVE dictionary.-dict_read_first_data :: WAVEDict -> IterateeGM L Word8 IO (Maybe [Double])-dict_read_first_data dict = case IM.lookup (fromEnum WAVE_DATA) dict of+dictReadFirstData :: WAVEDict -> IterateeG L 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 <- enum ==<< Iter.stream2list+       e <- joinIM $ enum Iter.stream2list        return $ Just e   _ -> return Nothing  -- |Read the last data chunk in the WAVE dictionary.-dict_read_last_data :: WAVEDict -> IterateeGM L Word8 IO (Maybe [Double])-dict_read_last_data dict = case IM.lookup (fromEnum WAVE_DATA) dict of+dictReadLastData :: WAVEDict -> IterateeG L 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 <- enum ==<< Iter.stream2list+    e <- joinIM $ enum Iter.stream2list     return $ Just e   _ -> return Nothing  -- |Read the specified data chunk from the WAVE dictionary.-dict_read_data :: Int -> --Index in the data chunk list to read+dictReadData :: Int -> --Index in the data chunk list to read                   WAVEDict -> --Dictionary-                  IterateeGM L Word8 IO (Maybe [Double])-dict_read_data ix dict = case IM.lookup (fromEnum WAVE_DATA) dict of+                  IterateeG L 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 <- enum ==<< Iter.stream2list+    e <- joinIM $ enum Iter.stream2list     return $ Just e   _ -> return Nothing  -- |Read the specified data chunk from the dictionary, applying the--- data to the specified IterateeGM.-dict_process_data :: Int -> -- Index in the data chunk list to read+-- data to the specified IterateeG.+dictProcessData :: Int -> -- Index in the data chunk list to read                      WAVEDict -> -- Dictionary-                     IterateeGM L Double IO a ->-                     IterateeGM L Word8 IO (Maybe a)-dict_process_data ix dict iter = case IM.lookup (fromEnum WAVE_DATA) dict of+                     IterateeG L Double IO a ->+                     IterateeG L 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 <- enum ==<< iter+    e <- joinIM $ enum iter     return $ Just e   _ -> return Nothing @@ -323,9 +309,9 @@ -- convenience functions  -- |Convert (Maybe []) to [].  Nothing maps to an empty list.-join_m :: Maybe [a] -> [a]-join_m Nothing = []-join_m (Just a) = a+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

@@ -31,18 +31,18 @@ -- 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 IterateeGM.  This function wraps+-- |Process a file using the given IterateeG.  This function wraps -- enumFd as a convenience.-fileDriver :: ReadableChunk s el => IterateeGM s el IO a ->+fileDriver :: ReadableChunk s el => IterateeG s el IO a ->               FilePath ->-              IO (Either (String, a) a)+              IO a fileDriver = fileDriverFd --- |Process a file using the given IterateeGM.  This function wraps+-- |Process a file using the given IterateeG.  This function wraps -- enumFdRandom as a convenience.-fileDriverRandom :: ReadableChunk s el => IterateeGM s el IO a ->+fileDriverRandom :: ReadableChunk s el => IterateeG s el IO a ->                     FilePath ->-                    IO (Either (String, a) a)+                    IO a fileDriverRandom = fileDriverRandomFd  #else@@ -50,18 +50,18 @@ -- ----------------------------------------------- -- Handle-based operations for compatibility. --- |Process a file using the given IterateeGM.  This function wraps+-- |Process a file using the given IterateeG.  This function wraps -- enumHandle as a convenience.-fileDriver :: ReadableChunk s el => IterateeGM s el IO a ->+fileDriver :: ReadableChunk s el => IterateeG s el IO a ->               FilePath ->-              IO (Either (String, a) a)+              IO a fileDriver = fileDriverHandle --- |Process a file using the given IterateeGM.  This function wraps+-- |Process a file using the given IterateeG.  This function wraps -- enumFdHandle as a convenience.-fileDriverRandom :: ReadableChunk s el => IterateeGM s el IO a ->+fileDriverRandom :: ReadableChunk s el => IterateeG s el IO a ->                     FilePath ->-                    IO (Either (String, a) a)+                    IO a fileDriverRandom = fileDriverRandomHandle  #endif

@@ -8,11 +8,11 @@ #if defined(USE_POSIX)   -- * File enumerators   -- ** FileDescriptor based enumerators-  enumFd,-  enumFdRandom,+  enumFd+  ,enumFdRandom   -- * Iteratee drivers-  fileDriverFd,-  fileDriverRandomFd,+  ,fileDriverFd+  ,fileDriverRandomFd #endif ) @@ -23,7 +23,6 @@ import Data.Iteratee.Base import Data.Iteratee.Binary() import Data.Iteratee.IO.Base-import Data.Int  import Foreign.Ptr import Foreign.Marshal.Alloc@@ -39,93 +38,91 @@ -- over the entire contents of a file, in order, unless stopped by -- the iteratee.  In particular, seeking is not supported. enumFd :: ReadableChunk s el => Fd -> EnumeratorGM s el IO a-enumFd fd iter' = IM $ allocaBytes (fromIntegral buffer_size) $ loop iter'+enumFd fd iter' = allocaBytes (fromIntegral buffer_size) $ loop iter'   where     buffer_size = 4096-    loop iter@Done{} _p = return iter-    loop _iter@Seek{} _p = error "enumFd is not compatabile with seek IO"-    loop (Cont step) p = do+    loop iter p = do       n <- myfdRead fd (castPtr p) buffer_size       case n of-        Left _errno -> unIM $ step (Error "IO error")-        Right 0 -> return iter'+        Left _errno -> enumErr "IO error" iter+        Right 0 -> return iter         Right n' -> do           s <- readFromPtr p (fromIntegral n')-          im <- unIM $ step (Chunk s)-	  loop im p+          igv <- runIter iter (Chunk s)+          check p igv+    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 :: ReadableChunk s el => Fd -> EnumeratorGM s el IO a enumFdRandom fd iter =- IM $ allocaBytes (fromIntegral buffer_size) (loop (0,0) iter)+ allocaBytes (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 = 4096   -- 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)-  loop _pos iter'@Done{} _p = return iter'-  loop pos@(off,len) (Seek off' c) p | -    off <= off' && off' < off + fromIntegral len =	-- Seek within buffer p-    do-    let local_off = fromIntegral $ off' - off-    s <- readFromPtr (p `plusPtr` local_off) (len - local_off)-    im <- unIM $ c (Chunk s)-    loop pos im p-  loop _pos iter'@(Seek off c) p = do -- Seek outside the buffer-   off' <- myfdSeek fd AbsoluteSeek (fromIntegral off)-   case off' of-    Left _errno -> unIM $ enumErr "IO error" iter'-    Right off''  -> loop (off'',0) (Cont c) p+-}     -- 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'@(Cont step) p = do+  loop (off,len) iter' p = do    n <- myfdRead fd (castPtr p) buffer_size    case n of-    Left _errno -> unIM $ step (Error "IO error")+    Left _errno -> enumErr "IO error" iter'     Right 0 -> return iter'     Right n' -> do          s <- readFromPtr p (fromIntegral n')-         im <- unIM $ step (Chunk s)-	 loop (off + fromIntegral len,fromIntegral n') im p+         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+    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)+    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  -- |Process a file using the given IterateeGM.  This function wraps -- enumFd as a convenience.-fileDriverFd :: ReadableChunk s el => IterateeGM s el IO a ->+fileDriverFd :: ReadableChunk s el => IterateeG s el IO a ->                 FilePath ->-                IO (Either (String, a) a)+                IO a fileDriverFd iter filepath = do   fd <- openFd filepath ReadOnly Nothing defaultFileFlags-  result <- unIM $ (enumFd fd >. enumEof) ==<< iter+  result <- enumFd fd iter >>= run   closeFd fd-  print_res result- where-  print_res (Done a (Error err)) = return $ Left (err, a)-  print_res (Done a _) = return $ Right a-  print_res (Cont _)   = return $ Left ("Iteratee unfinished", undefined)-  print_res (Seek _ _) = return $ Left ("Iteratee unfinished", undefined)+  return result  -- |Process a file using the given IterateeGM.  This function wraps -- enumFdRandom as a convenience.-fileDriverRandomFd :: ReadableChunk s el => IterateeGM s el IO a ->+fileDriverRandomFd :: ReadableChunk s el =>+                      IterateeG s el IO a ->                       FilePath ->-                      IO (Either (String, a) a)+                      IO a fileDriverRandomFd iter filepath = do   fd <- openFd filepath ReadOnly Nothing defaultFileFlags-  result <- unIM $ (enumFdRandom fd >. enumEof) ==<< iter+  result <- enumFdRandom fd iter >>= run   closeFd fd-  print_res result- where-  print_res (Done a (Error err)) = return $ Left (err, a)-  print_res (Done a _) = return $ Right a-  print_res (Cont _)   = return $ Left ("Iteratee unfinished", undefined)-  print_res (Seek _ _) = return $ Left ("Iteratee unfinished", undefined)+  return result  #endif+

@@ -5,11 +5,11 @@  module Data.Iteratee.IO.Handle(   -- * File enumerators-  enumHandle,-  enumHandleRandom,+  enumHandle+  ,enumHandleRandom   -- * Iteratee drivers-  fileDriverHandle,-  fileDriverRandomHandle,+  ,fileDriverHandle+  ,fileDriverRandomHandle )  where@@ -17,7 +17,6 @@ import Data.Iteratee.Base.StreamChunk (ReadableChunk (..)) import Data.Iteratee.Base import Data.Iteratee.Binary()-import Data.Iteratee.IO.Base  import Data.Int import Control.Exception.Extensible@@ -35,63 +34,69 @@ -- over the entire contents of a file, in order, unless stopped by -- the iteratee.  In particular, seeking is not supported. enumHandle :: ReadableChunk s el => Handle -> EnumeratorGM s el IO a-enumHandle h iter' = IM $ allocaBytes (fromIntegral buffer_size) $ loop iter'+enumHandle h i = allocaBytes (fromIntegral buffer_size) $ loop i   where     buffer_size = 4096-    loop iter@Done{} _p     = return iter-    loop _iter@Seek{} _p    = error "enumH is not compatabile with seek IO"-    loop iter@(Cont step) p = do-      n <- try $ hGetBuf h p buffer_size+    loop iter p = do+      n <- (try $ hGetBuf h p buffer_size) :: IO (Either SomeException Int)       case n of-        Left ex -> unIM $ step (Error $ show (ex :: SomeException))-        Right 0 -> return iter+        Left _   -> enumErr "IO error" iter+        Right 0  -> return iter         Right n' -> do           s <- readFromPtr p (fromIntegral n')-          im <- unIM $ step (Chunk s)-	  loop im p+          igv <- runIter iter (Chunk s)+          check p igv+    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++-- |The enumerator of a Handle: a variation of enumHandle that -- supports RandomIO (seek requests) enumHandleRandom :: ReadableChunk s el => Handle -> EnumeratorGM s el IO a enumHandleRandom h iter =- IM $ allocaBytes (fromIntegral buffer_size) (loop (0,0) iter)+ allocaBytes (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 = 4096   -- 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)-  loop _pos iter'@Done{} _p = return iter'-  loop pos@(off,len) (Seek off' c) p | -    off <= off' && off' < off + fromIntegral len =	-- Seek within buffer p-    do-    let local_off = fromIntegral $ off' - off-    s <- readFromPtr (p `plusPtr` local_off) (len - local_off)-    im <- unIM $ c (Chunk s)-    loop pos im p-  loop _pos iter'@(Seek off c) p = do -- Seek outside the buffer-   off' <- (try $ hSeek h AbsoluteSeek-            (fromIntegral off)) :: IO (Either SomeException ())-   case off' of-    Left _errno -> unIM $ enumErr "IO error" iter'-    Right _     -> loop (off,0) (Cont c) p-    -- Thanks to John Lato for the strictness annotation-    -- Otherwise, the `off + fromIntegral len' below accumulates thunks+-}+  -- Otherwise, the `off + fromIntegral len' below accumulates thunks   loop (off,len) _iter' _p | off `seq` len `seq` False = undefined-  loop (off,len) iter'@(Cont step) p = do+  loop (off,len) iter' p = do    n <- (try $ hGetBuf h p buffer_size) :: IO (Either SomeException Int)    case n of-    Left _errno -> unIM $ step (Error "IO error")+    Left _errno -> enumErr "IO error" iter     Right 0 -> return iter'     Right n' -> do          s <- readFromPtr p (fromIntegral n')-         im <- unIM $ step (Chunk s)-	 loop (off + fromIntegral len,fromIntegral n') im p+         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+    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 ())+   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  -- ---------------------------------------------- -- File Driver wrapper functions.@@ -99,34 +104,24 @@ -- |Process a file using the given IterateeGM.  This function wraps -- enumHandle as a convenience. fileDriverHandle :: ReadableChunk s el =>-                    IterateeGM s el IO a ->+                    IterateeG s el IO a ->                     FilePath ->-                    IO (Either (String, a) a)+                    IO a fileDriverHandle iter filepath = do   h <- openBinaryFile filepath ReadMode-  result <- unIM $ (enumHandle h >. enumEof) ==<< iter+  result <- enumHandle h iter >>= run   hClose h-  print_res result- where-  print_res (Done a (Error err)) = return $ Left (err, a)-  print_res (Done a _) = return $ Right a-  print_res (Cont _)   = return $ Left ("Iteratee unfinished", undefined)-  print_res (Seek _ _) = return $ Left ("Iteratee unfinished", undefined)+  return result  -- |Process a file using the given IterateeGM.  This function wraps -- enumHandleRandom as a convenience. fileDriverRandomHandle :: ReadableChunk s el =>-                          IterateeGM s el IO a ->+                          IterateeG s el IO a ->                           FilePath ->-                          IO (Either (String, a) a)+                          IO a fileDriverRandomHandle iter filepath = do   h <- openBinaryFile filepath ReadMode-  result <- unIM $ (enumHandleRandom h >. enumEof) ==<< iter+  result <- enumHandleRandom h iter >>= run   hClose h-  print_res result- where-  print_res (Done a (Error err)) = return $ Left (err, a)-  print_res (Done a _) = return $ Right a-  print_res (Cont _)   = return $ Left ("Iteratee unfinished", undefined)-  print_res (Seek _ _) = return $ Left ("Iteratee unfinished", undefined)+  return result 

@@ -1,4 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}  module Data.Iteratee.WrappedByteString (   WrappedByteString (..)@@ -10,12 +11,22 @@ import qualified Data.ByteString as BW import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Internal as BBase+import qualified Data.ListLike as LL import Data.Word+import Data.Monoid import Foreign.ForeignPtr  -- |Wrap a Data.ByteString ByteString newtype WrappedByteString a = WrapBS { unWrap :: BBase.ByteString } +instance Monoid (WrappedByteString Word8) where+  mempty = WrapBS BW.empty+  mappend a1 a2 = WrapBS (BW.append (unWrap a1) (unWrap a2))++instance LL.FoldableLL (WrappedByteString Word8) Word8 where+  foldl f z = BW.foldl f z . unWrap+  foldr f z = BW.foldr f z . unWrap+ instance SC.ReadableChunk WrappedByteString Word8 where   readFromPtr p l = do     fptr <- newForeignPtr_ p@@ -26,10 +37,10 @@     fptr <- newForeignPtr_ p     return . WrapBS $ BBase.fromForeignPtr (castForeignPtr fptr) 0 l -instance SC.StreamChunk WrappedByteString Word8 where+instance LL.ListLike (WrappedByteString Word8) Word8 where   length        = BW.length . unWrap-  empty         = WrapBS BW.empty   null          = BW.null . unWrap+  singleton     = WrapBS . BW.singleton   cons a        = WrapBS . BW.cons a . unWrap   head          = BW.head . unWrap   tail          = WrapBS . BW.tail . unWrap@@ -37,9 +48,10 @@   splitAt i s   = let (a1, a2) = BW.splitAt i $ unWrap s                   in (WrapBS a1, WrapBS a2)   dropWhile p   = WrapBS . BW.dropWhile p . unWrap-  append a1 a2  = WrapBS (BW.append (unWrap a1) (unWrap a2))   fromList      = WrapBS . BW.pack   toList        = BW.unpack . unWrap++instance SC.StreamChunk WrappedByteString Word8 where   cMap          = bwmap  bwmap :: (SC.StreamChunk s' el') =>@@ -49,8 +61,8 @@ bwmap f xs = step xs   where   step bs-    | SC.null bs = SC.empty-    | True     = f (SC.head bs) `SC.cons` step (SC.tail 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) ->@@ -60,11 +72,18 @@  {-# RULES "bwmap/map" forall s (f :: Word8 -> Word8). bwmap f s = bwmap' f s #-} +instance Monoid (WrappedByteString Char) where+    mempty = WrapBS BW.empty+    mappend a1 a2 = WrapBS (BW.append (unWrap a1) (unWrap a2)) -instance SC.StreamChunk WrappedByteString Char where+instance LL.FoldableLL (WrappedByteString Char) Char where+  foldl f z = BC.foldl f z . unWrap+  foldr f z = BC.foldr f z . unWrap++instance LL.ListLike (WrappedByteString Char) Char where   length        = BC.length . unWrap-  empty         = WrapBS BC.empty   null          = BC.null . unWrap+  singleton     = WrapBS . BC.singleton   cons a        = WrapBS . BC.cons a . unWrap   head          = BC.head . unWrap   tail          = WrapBS . BC.tail . unWrap@@ -72,9 +91,10 @@   splitAt i s   = let (a1, a2) = BC.splitAt i $ unWrap s                   in (WrapBS a1, WrapBS a2)   dropWhile p   = WrapBS . BC.dropWhile p . unWrap-  append a1 a2  = WrapBS (BC.append (unWrap a1) (unWrap a2))   fromList      = WrapBS . BC.pack   toList        = BC.unpack . unWrap++instance SC.StreamChunk WrappedByteString Char where   cMap          = bcmap  bcmap :: (SC.StreamChunk s' el') =>@@ -84,8 +104,8 @@ bcmap f xs = step xs   where   step bs-    | SC.null bs = SC.empty-    | True     = f (SC.head bs) `SC.cons` step (SC.tail 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) ->

@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}++module QCUtils where++import Test.QuickCheck+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen++import Data.Iteratee+import qualified Data.Iteratee as I+import Data.Iteratee.Base.StreamChunk (StreamChunk)+import Control.Monad.Identity++-- Show instance+instance (Show a, StreamChunk s el) => Show (IterateeG s el Identity a) where+  show = (++) "<<Iteratee>> " . show . runIdentity . run++-- Arbitrary instances++instance Arbitrary ErrMsg where+  arbitrary = do+    err <- arbitrary+    n <- arbitrary :: Gen Int+    elements [Err err, Seek (fromIntegral n)]++instance Arbitrary (c el) => Arbitrary (StreamG c el) where+  arbitrary = do+    err <- arbitrary+    xs <- arbitrary+    elements [EOF err, Chunk xs]++instance (Num a, Ord a, Arbitrary a, Monad m) => Arbitrary (IterateeG [] 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,297 @@+{-# OPTIONS_GHC -O #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++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 qualified Data.Iteratee.Base.StreamChunk as SC+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>>"++-- ---------------------------------------------+-- StreamG instances++type ST = StreamG [] Int++prop_eq str = str == str+  where types = (str :: ST)++prop_mempty = mempty == (Chunk [] :: StreamG [] 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_functor str@(EOF _) f = isEOF $ fmap f str+prop_functor str@(Chunk xs) f = fmap f str == Chunk (fmap f xs)+  where types = (str :: ST, f :: Int -> Integer)++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 = length xs > 0 ==> runner1 (enumPure1Chunk xs Iter.head) == head xs+  where types = xs :: [Int]++prop_head2 xs = length xs > 0 ==> runner1 (enumPure1Chunk xs (Iter.head >> stream2list)) == tail xs+  where types = xs :: [Int]++prop_heads xs = runner1 (enumPure1Chunk xs $ heads xs) == 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 = IterateeG [] 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 :: IterateeG [] Int Identity (Maybe ErrMsg))) == Just (Err "EOF")++prop_isFinished2 = runner1 (enumErr "Error" (isFinished :: IterateeG [] Int Identity (Maybe ErrMsg))) == Just (Err "Error")++prop_null xs i = runner1 (enumPure1Chunk xs =<< enumPure1Chunk [] i)+                 == runner1 (enumPure1Chunk xs i)+  where types = (xs :: [Int], i :: I)++prop_nullH xs = 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 :: (SC.StreamChunk s el, Monad m) => IterateeG s el m (Maybe (s el))+convId = IterateeG (\str -> case str of+  s@(Chunk xs) | LL.null xs -> return $ Cont convId Nothing+  s@(Chunk xs) -> return $ Done (Just xs) (Chunk mempty)+  s@(EOF e)   -> return $ Done Nothing (EOF e)+  )++prop_convId xs = runner1 (enumPure1Chunk xs convId) == Just xs+  where types = xs :: [Int]++prop_convstream xs i = length xs > 0 ==>+                       runner2 (enumPure1Chunk xs $ convStream convId i)+                       == runner1 (enumPure1Chunk xs i)+  where types = (xs :: [Int], i :: I)++prop_convstream2 xs = length xs > 0 ==>+                      runner2 (enumPure1Chunk xs $ convStream convId Iter.head)+                      == runner1 (enumPure1Chunk xs Iter.head)+  where types = (xs :: [Int])++prop_convstream3 xs = 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 (Prelude.take n xs) stream2list)+  where types = (xs :: [Int])++prop_take2 xs n = n > 0 ==>+                  runner2 (enumPure1Chunk xs $ Iter.take n peek)+                  == runner1 (enumPure1Chunk (Prelude.take n xs) peek)+  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])++-- ---------------------------------------------+-- 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 = 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 "StreamG tests" [+    testProperty "mempty" prop_mempty+    ,testProperty "mappend" prop_mappend+    ,testProperty "mappend associates" prop_mappend2+    ,testProperty "functor" prop_functor+    ,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 "takeR" prop_takeR+    ,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+