iteratee 0.8.9.0 → 0.8.9.1

raw patch · 16 files changed

+1034/−946 lines, 16 filesdep −lifted-basedep −unix-bytestringdep ~transformers-basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: lifted-base, unix-bytestring

Dependency ranges changed: transformers-base

API changes (from Hackage documentation)

Files

• iteratee.cabal +6/−7
• src/Data/Iteratee.hs +11/−5
• src/Data/Iteratee/Base.hs +98/−151
• src/Data/Iteratee/Binary.hs +49/−17
• src/Data/Iteratee/Char.hs +27/−27
• src/Data/Iteratee/IO.hs +14/−15
• src/Data/Iteratee/IO/Base.hs +2/−2
• src/Data/Iteratee/IO/Fd.hs +29/−42
• src/Data/Iteratee/IO/Handle.hs +39/−44
• src/Data/Iteratee/IO/Posix.hs +104/−0
• src/Data/Iteratee/Iteratee.hs +163/−191
• src/Data/Iteratee/ListLike.hs +374/−314
• src/Data/Iteratee/PTerm.hs +93/−100
• src/Data/Iteratee/Parallel.hs +18/−24
• tests/benchmarks.hs +3/−3
• tests/testIteratee.hs +4/−4

@@ -1,5 +1,5 @@ name:          iteratee-version:       0.8.9.0+version:       0.8.9.1 synopsis:      Iteratee-based I/O description:   The Iteratee monad provides strict, safe, and functional I/O. In addition@@ -12,7 +12,7 @@ license:       BSD3 license-file:  LICENSE homepage:      http://www.tiresiaspress.us/haskell/iteratee-tested-with:   GHC == 7.2.1, GHC == 7.4.2+tested-with:   GHC == 7.0.4, GHC == 7.2.1 stability:     experimental  cabal-version: >= 1.6@@ -41,22 +41,21 @@   else     cpp-options: -DUSE_POSIX     exposed-modules:+      Data.Iteratee.IO.Posix       Data.Iteratee.IO.Fd     build-depends:-      unix                    >= 2 && < 3,-      unix-bytestring         >= 0.3.5 && < 0.4+      unix >= 2 && < 3    build-depends:     base                      >= 3       && < 6,     ListLike                  >= 1.0     && < 4,     MonadCatchIO-transformers >  0.2     && < 0.4,+    monad-control             == 0.3.* ,     bytestring                >= 0.9     && < 0.10,     containers                >= 0.2     && < 0.6,-    lifted-base               >= 0.1.1   && < 0.2,-    monad-control             >= 0.3     && < 0.4,     parallel                  >= 2       && < 4,     transformers              >= 0.2     && < 0.4,-    transformers-base         >= 0.4     && < 0.5+    transformers-base         >= 0.3     && < 0.5    exposed-modules:     Data.Nullable

@@ -44,12 +44,18 @@ -}  module Data.Iteratee (-  module I+  module Data.Iteratee.Binary,+  module Data.Iteratee.ListLike,+  module Data.Iteratee.PTerm,+  fileDriver,+  fileDriverVBuf,+  fileDriverRandom,+  fileDriverRandomVBuf )  where -import Data.Iteratee.Binary   as I-import Data.Iteratee.IO       as I-import Data.Iteratee.ListLike as I-import Data.Iteratee.PTerm    as I+import Data.Iteratee.Binary+import Data.Iteratee.IO+import Data.Iteratee.ListLike+import Data.Iteratee.PTerm

@@ -3,9 +3,8 @@             ,FlexibleContexts             ,FlexibleInstances             ,UndecidableInstances-            ,RankNTypes+            ,Rank2Types             ,DeriveDataTypeable-            ,ScopedTypeVariables             ,ExistentialQuantification #-}  -- |Monadic Iteratees:@@ -14,6 +13,7 @@ module Data.Iteratee.Base (   -- * Types   Stream (..)+  ,StreamStatus (..)   -- ** Exception types   ,module Data.Iteratee.Exception   -- ** Iteratees@@ -22,17 +22,15 @@   -- ** Control functions   ,run   ,tryRun+  ,mapIteratee   ,ilift   ,ifold   -- ** Creating Iteratees   ,idone   ,icont-  ,icontP-  ,ierr-  ,ireq   ,liftI   ,idoneM-  ,ierrM+  ,icontM   -- ** Stream Functions   ,setEOF   -- * Classes@@ -49,13 +47,11 @@ import Data.Maybe import Data.Monoid -import Control.Arrow (first) import Control.Monad (liftM, join) import Control.Monad.Base import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Control.Monad.CatchIO (MonadCatchIO (..),-  catch, block)+import Control.Monad.CatchIO (MonadCatchIO (..), catch, block) import Control.Monad.Trans.Control import Control.Applicative hiding (empty) import Control.Exception (SomeException)@@ -94,6 +90,13 @@   fmap f (Chunk xs) = Chunk $ f xs   fmap _ (EOF mErr) = EOF mErr +-- |Describe the status of a stream of data.+data StreamStatus =+  DataRemaining+  | EofNoError+  | EofError SomeException+  deriving (Show, Typeable)+ -- ---------------------------------------------- -- create exception type hierarchy @@ -106,166 +109,114 @@ -- ---------------------------------------------- -- | Monadic iteratee newtype Iteratee s m a = Iteratee{ runIter :: forall r.-          (a -> r) ->-          ((Stream s -> m (Iteratee s m a, Stream s)) -> r) ->-          (Iteratee s m a -> SomeException -> r) ->-          (forall b. m b -> (b -> (Iteratee s m a)) -> r) ->-          r}+          (a -> Stream s -> m r) ->+          ((Stream s -> Iteratee s m a) -> Maybe SomeException -> m r) ->+          m r}  -- ---------------------------------------------- -idone :: a -> Iteratee s m a-idone a = Iteratee $ \onDone _ _ _ -> onDone a-{-# INLINE idone #-}--icont :: (Stream s -> m (Iteratee s m a, Stream s)) -> Iteratee s m a-icont k = Iteratee $ \_ onCont _ _ -> onCont k-{-# INLINE icont #-}--icontP :: Monad m => (Stream s -> (Iteratee s m a, Stream s)) -> Iteratee s m a-icontP k = Iteratee $ \_ onCont _ _ -> onCont (return . k)-{-# INLINE icontP #-}---- | identical to icont, left in for compatibility-ish reasons-liftI :: Monad m => (Stream s -> (Iteratee s m a, Stream s)) -> Iteratee s m a-liftI = icontP-{-# INLINE liftI #-}+idone :: a -> Stream s -> Iteratee s m a+idone a s = Iteratee $ \onDone _ -> onDone a s -ierr :: Iteratee s m a -> SomeException -> Iteratee s m a-ierr i e = Iteratee $ \_ _ onErr _ -> onErr i e-{-# INLINE ierr #-}+icont :: (Stream s -> Iteratee s m a) -> Maybe SomeException -> Iteratee s m a+icont k e = Iteratee $ \_ onCont -> onCont k e -ireq :: m b -> (b -> Iteratee s m a) -> Iteratee s m a-ireq mb bf = Iteratee $ \_ _ _ onReq -> onReq mb bf-{-# INLINE ireq #-}+liftI :: (Stream s -> Iteratee s m a) -> Iteratee s m a+liftI k = Iteratee $ \_ onCont -> onCont k Nothing  -- Monadic versions, frequently used by enumerators-idoneM :: Monad m => a -> m (Iteratee s m a)-idoneM x = return $ idone x+idoneM :: Monad m => a -> Stream s -> m (Iteratee s m a)+idoneM x str = return $ Iteratee $ \onDone _ -> onDone x str -ierrM :: Monad m => Iteratee s m a -> SomeException -> m (Iteratee s m a)-ierrM i e = return $ ierr i e+icontM+  :: Monad m =>+     (Stream s -> Iteratee s m a)+     -> Maybe SomeException+     -> m (Iteratee s m a)+icontM k e = return $ Iteratee $ \_ onCont -> onCont k e -instance forall s m. (Functor m) => Functor (Iteratee s m) where-  {-# INLINE fmap #-}-  fmap f m = runIter m (idone . f) onCont onErr (onReq f)-    where-      onCont k      = icont $ fmap (first (fmap f)) . k-      onErr i e     = ierr (fmap f i) e-      onReq :: (a -> b) -> m x -> (x -> Iteratee s m a) -> Iteratee s m b-      onReq ff mb doB = ireq mb (fmap ff . doB)+instance (Functor m) => Functor (Iteratee s m) where+  fmap f m = Iteratee $ \onDone onCont ->+    let od = onDone . f+        oc = onCont . (fmap f .)+    in runIter m od oc -instance (Functor m, Monad m) => Applicative (Iteratee s m) where-    pure x  = idone x+instance (Functor m, Monad m, Nullable s) => Applicative (Iteratee s m) where+    pure x  = idone x (Chunk empty)     {-# INLINE (<*>) #-}     m <*> a = m >>= flip fmap a -instance (Monad m) => Monad (Iteratee s m) where+instance (Monad m, Nullable s) => Monad (Iteratee s m) where   {-# INLINE return #-}-  return = idone+  return x = Iteratee $ \onDone _ -> onDone x (Chunk empty)   {-# INLINE (>>=) #-}-  (>>=) = bindIter+  (>>=) = bindIteratee -{-# INLINE bindIter #-}-bindIter :: forall s m a b. (Monad m)+{-# INLINE bindIteratee #-}+bindIteratee :: (Monad m, Nullable s)     => Iteratee s m a     -> (a -> Iteratee s m b)     -> Iteratee s m b-bindIter m f = runIter m f onCont onErr onReq-  where-    push i str = runIter i-                         (\a         -> return (idone a, str))-                         (\k         -> k str)-                         (\iResume e -> return (ierr iResume e, EOF (Just e)))-                         (\mb doB    -> mb >>= \b -> push (doB b) str)-    onCont k  = icont $ \str -> do-                  (i', strRem) <- k str-                  let oD a  = push (f a) strRem-                      oC _k = return (i' `bindIter` f, strRem)-                      oE iResume e = return (ierr (bindIter iResume f) e-                                             ,EOF (Just e))-                      oR :: m x -> (x -> Iteratee s m a) -> m (Iteratee s m b, Stream s)-                      oR mb doB    = mb >>= \b ->-                                      push (doB b `bindIter` f) strRem-                  runIter i' oD oC oE oR-    onErr i e = ierr (i >>= f) e-    onReq :: m x -> (x -> Iteratee s m a) -> Iteratee s m b-    onReq mb doB = ireq mb (( `bindIter` f) . doB)+bindIteratee = self+    where+        self m f = Iteratee $ \onDone onCont ->+             let m_done a (Chunk s)+                   | nullC s     = runIter (f a) onDone onCont+                 m_done a stream = runIter (f a) (const . flip onDone stream) f_cont+                   where f_cont k Nothing = runIter (k stream) onDone onCont+                         f_cont k e       = onCont k e+             in runIter m m_done (onCont . (flip self f .)) -instance MonadTrans (Iteratee s) where-  lift = flip ireq idone+instance NullPoint s => MonadTrans (Iteratee s) where+  lift m = Iteratee $ \onDone _ -> m >>= flip onDone (Chunk empty) -instance (MonadBase b m) => MonadBase b (Iteratee s m) where+instance (MonadBase b m, Nullable s, NullPoint s) => MonadBase b (Iteratee s m) where   liftBase = lift . liftBase -instance (MonadIO m) => MonadIO (Iteratee s m) where+instance (MonadIO m, Nullable s, NullPoint s) => MonadIO (Iteratee s m) where   liftIO = lift . liftIO -instance forall s m. (MonadCatchIO m) =>+instance (MonadCatchIO m, Nullable s, NullPoint s) =>   MonadCatchIO (Iteratee s m) where-    m `catch` f = let oC k    = icont $ \s -> k s `catch`-                                  (\e -> return (f e-                                          , EOF . Just $ toException e))-                      oE i' e = ierr (i' `catch` f) e-                  in runIter m idone oC oE (catchOR m f)+    m `catch` f = Iteratee $ \od oc -> runIter m od oc `catch` (\e -> runIter (f e) od oc)     block       = ilift block     unblock     = ilift unblock --- This definition is pulled out from the MonadCatchIO.catch instance because--- it's the simplest way to make the type signatures work out...-catchOR :: (Exception e, MonadCatchIO m) => Iteratee s m a -> (e -> Iteratee s m a) -> m b -> (b -> Iteratee s m a) -> Iteratee s m a-catchOR _ f mb doB = ireq ((doB `liftM` mb) `catch` (\e -> return (f e) )) id- instance forall s. (NullPoint s, Nullable s) => MonadTransControl (Iteratee s) where   newtype StT (Iteratee s) x =-    StIter { unStIter :: Either x (Maybe SomeException) }-  liftWith f = lift $ f $ \t -> liftM StIter (runIter t-                                 (return . Left)-                                 (const . return $ Right Nothing)-                                 (\_ e -> return $ Right (Just e))-                                 (\mb doB -> pushoR mb doB))+    StIter { unStIter :: Either (x, Stream s) (Maybe SomeException) }+  liftWith f = lift $ f $ \t -> liftM StIter+      (runIter t (\x s -> return $ Left (x,s))+                 (\_ e -> return $ Right e) )   restoreT = join . lift . liftM-               (either idone+               (either (uncurry idone)                        (te . fromMaybe (iterStrExc                           "iteratee: error in MonadTransControl instance"))                       . unStIter )   {-# INLINE liftWith #-}   {-# INLINE restoreT #-} -pushoR :: Monad m =>-          m x-       -> (x -> Iteratee s m a)-       -> m (Either a (Maybe SomeException))-pushoR mb doB = mb >>= \b -> runIter (doB b)-   (return . Left)-   (const . return $ Right Nothing)-   (\_ e -> return $ Right (Just e))-   pushoR--te :: SomeException -> Iteratee s m a-te e = ierr (te e) e- instance (MonadBaseControl b m, Nullable s) => MonadBaseControl b (Iteratee s m) where   newtype StM (Iteratee s m) a =     StMIter { unStMIter :: ComposeSt (Iteratee s) m a}   liftBaseWith = defaultLiftBaseWith StMIter   restoreM     = defaultRestoreM unStMIter +te :: SomeException -> Iteratee s m a+te e = icont (const (te e)) (Just e)+ -- |Send 'EOF' to the @Iteratee@ and disregard the unconsumed part of the -- stream.  If the iteratee is in an exception state, that exception is -- thrown with 'Control.Exception.throw'.  Iteratees that do not terminate -- on @EOF@ will throw 'EofException'.-run :: forall s m a. Monad m => Iteratee s m a -> m a-run iter = runIter iter onDone onCont onErr onReq+run :: Monad m => Iteratee s m a -> m a+run iter = runIter iter onDone onCont  where-   onDone  x     = return x-   onCont  k     = k (EOF Nothing) >>= \(i,_) ->-                     runIter i onDone onCont' onErr onReq-   onCont' _     = E.throw EofException-   onErr _ e     = E.throw e-   onReq :: m x -> (x -> Iteratee s m a) -> m a-   onReq mb doB  = mb >>= run . doB-{-# INLINE run #-}+   onDone  x _        = return x+   onCont  k Nothing  = runIter (k (EOF Nothing)) onDone onCont'+   onCont  _ (Just e) = E.throw e+   onCont' _ Nothing  = E.throw EofException+   onCont' _ (Just e) = E.throw e  -- |Run an iteratee, returning either the result or the iteratee exception. -- Note that only internal iteratee exceptions will be returned; exceptions@@ -273,19 +224,24 @@ -- not be returned. --  -- See 'Data.Iteratee.Exception.IFException' for details.-tryRun :: forall s m a e. (Exception e, Monad m)-  => Iteratee s m a-  -> m (Either e a)-tryRun iter = runIter iter onD onC onE onR+tryRun :: (Exception e, Monad m) => Iteratee s m a -> m (Either e a)+tryRun iter = runIter iter onDone onCont   where-    onD  x     = return $ Right x-    onC  k     = k (EOF Nothing) >>= \(i,_) -> runIter i onD onC' onE onR-    onC' _     = return $ maybeExc (toException EofException)-    onE   _ e  = return $ maybeExc e-    onR :: m x -> (x -> Iteratee s m a) -> m (Either e a)-    onR mb doB = mb >>= tryRun . doB+    onDone  x _ = return $ Right x+    onCont  k Nothing  = runIter (k (EOF Nothing)) onDone onCont'+    onCont  _ (Just e) = return $ maybeExc e+    onCont' _ Nothing  = return $ maybeExc (toException EofException)+    onCont' _ (Just e) = return $ maybeExc e     maybeExc e = maybe (Left (E.throw e)) Left (fromException e) +-- |Transform a computation inside an @Iteratee@.+mapIteratee :: (NullPoint s, Monad n, Monad m) =>+  (m a -> n b)+  -> Iteratee s m a+  -> Iteratee s n b+mapIteratee f = lift . f . run+{-# DEPRECATED mapIteratee "This function will be removed, compare to 'ilift'" #-}+ -- | Lift a computation in the inner monad of an iteratee. --  -- A simple use would be to lift a logger iteratee to a monad stack.@@ -298,31 +254,22 @@ --  -- A more complex example would involve lifting an iteratee to work with -- interleaved streams.  See the example at 'Data.Iteratee.ListLike.merge'.-ilift :: forall m n s a.+ilift ::   (Monad m, Monad n)   => (forall r. m r -> n r)   -> Iteratee s m a   -> Iteratee s n a-ilift f i = runIter i idone onCont onErr  onReq- where-  onCont k = icont $ \str -> first (ilift f) `liftM` f (k str)-  onErr = ierr . ilift f-  onReq :: m x -> (x -> Iteratee s m a) -> Iteratee s n a-  onReq mb doB = ireq (liftM (ilift f . doB) (f mb)) id+ilift f i = Iteratee $  \od oc ->+  let onDone a str  = return $ Left (a,str)+      onCont k mErr = return $ Right (ilift f . k, mErr)+  in f (runIter i onDone onCont) >>= either (uncurry od) (uncurry oc)  -- | Lift a computation in the inner monad of an iteratee, while threading -- through an accumulator.-ifold :: forall m n acc s a. (Monad m, Monad n)-  => (forall r. m r -> acc -> n (r, acc))-  -> acc-  -> Iteratee s m a-  -> Iteratee s n (a, acc)-ifold f acc i = runIter i onDone onCont onErr onReq- where-  onDone x = ireq (f (return x) acc) idone-  onCont k = icont $ \str -> do-               ((i', strRes), acc') <- f (k str) acc-               return (ifold f acc' i', strRes)-  onErr i' e = ierr (ifold f acc i') e-  onReq :: m x -> (x -> Iteratee s m a) -> Iteratee s n (a, acc)-  onReq mb doB = ireq (f mb acc) (\(b', acc') -> ifold f acc' (doB b'))+ifold :: (Monad m, Monad n) => (forall r. m r -> acc -> n (r, acc))+      -> acc -> Iteratee s m a -> Iteratee s n (a, acc)+ifold f acc i = Iteratee $ \ od oc -> do+  (r, acc') <- flip f acc $+    runIter i (curry $ return . Left) (curry $ return . Right)+  either (uncurry (od . flip (,) acc'))+         (uncurry (oc . (ifold f acc .))) r

@@ -14,12 +14,23 @@   ,endianRead3i   ,endianRead4   ,endianRead8+  -- ** bytestring specializations+  -- | In current versions of @iteratee@ there is no difference between the+  -- bytestring specializations and polymorphic functions.  They exist+  -- for compatibility.+  ,readWord16be_bs+  ,readWord16le_bs+  ,readWord32be_bs+  ,readWord32le_bs+  ,readWord64be_bs+  ,readWord64le_bs ) where  import Data.Iteratee.Base import qualified Data.Iteratee.ListLike as I import qualified Data.ListLike as LL+import qualified Data.ByteString as B import Data.Word import Data.Bits import Data.Int@@ -92,37 +103,58 @@   -> Int   -> ([Word8] -> b)   -> Iteratee s m b-endianReadN MSB n0 cnct = icontP (step n0 [])+endianReadN MSB n0 cnct = liftI (step n0 [])  where   step !n acc (Chunk c)-    | LL.null c        = (icontP (step n acc), Chunk c)+    | LL.null c        = liftI (step n acc)     | LL.length c >= n = let (this,next) = LL.splitAt n c                              !result     = cnct $ acc ++ LL.toList this-                         in (idone result, Chunk next)-    | otherwise        = (icontP (step (n - LL.length c) (acc ++ LL.toList c))-                          , Chunk empty)-  step !n acc (EOF Nothing  )  = (icontP (step n acc)-                                 , EOF . Just $ toException EofException)-  step !n acc s@(EOF (Just _)) = (icontP (step n acc), s)-endianReadN LSB n0 cnct = icontP (step n0 [])+                         in idone result (Chunk next)+    | otherwise        = liftI (step (n - LL.length c) (acc ++ LL.toList c))+  step !n acc (EOF Nothing)  = icont (step n acc) (Just $ toException EofException)+  step !n acc (EOF (Just e)) = icont (step n acc) (Just e)+endianReadN LSB n0 cnct = liftI (step n0 [])  where   step !n acc (Chunk c)-    | LL.null c        = (icontP (step n acc), Chunk c)+    | LL.null c        = liftI (step n acc)     | LL.length c >= n = let (this,next) = LL.splitAt n c                              !result = cnct $ reverse (LL.toList this) ++ acc-                         in (idone result, Chunk next)-    | otherwise        = (icontP (step (n - LL.length c)-                                       (reverse (LL.toList c) ++ acc))-                          , Chunk empty)-  step !n acc (EOF Nothing) = (icontP (step n acc)-                               , EOF . Just $ toException EofException)-  step !n acc str           = (icontP (step n acc), str)+                         in idone result (Chunk next)+    | otherwise        = liftI (step (n - LL.length c)+                                     (reverse (LL.toList c) ++ acc))+  step !n acc (EOF Nothing)  = icont (step n acc)+                                    (Just $ toException EofException)+  step !n acc (EOF (Just e)) = icont (step n acc) (Just e) {-# INLINE endianReadN #-}  -- As of now, the polymorphic code is as fast as the best specializations -- I have found, so these just call out.  They may be improved in the -- future, or possibly deprecated. -- JWL, 2012-01-16++readWord16be_bs :: Monad m => Iteratee B.ByteString m Word16+readWord16be_bs = endianRead2 MSB+{-# INLINE readWord16be_bs  #-}++readWord16le_bs :: Monad m => Iteratee B.ByteString m Word16+readWord16le_bs = endianRead2 LSB+{-# INLINE readWord16le_bs  #-}++readWord32be_bs :: Monad m => Iteratee B.ByteString m Word32+readWord32be_bs = endianRead4 MSB+{-# INLINE readWord32be_bs  #-}++readWord32le_bs :: Monad m => Iteratee B.ByteString m Word32+readWord32le_bs = endianRead4 LSB+{-# INLINE readWord32le_bs  #-}++readWord64be_bs :: Monad m => Iteratee B.ByteString m Word64+readWord64be_bs = endianRead8 MSB+{-# INLINE readWord64be_bs  #-}++readWord64le_bs :: Monad m => Iteratee B.ByteString m Word64+readWord64le_bs = endianRead8 LSB+{-# INLINE readWord64le_bs  #-}  word16' :: [Word8] -> Word16 word16' [c1,c2] = word16 c1 c2

@@ -78,21 +78,21 @@      Enumeratee s [s] m a enumLines = convStream getter   where-    getter = icontP step+    getter = icont step Nothing     lChar = (== '\n') . last . LL.toString     step (Chunk xs)-      | LL.null xs = (getter, Chunk xs)-      | lChar xs   = (idone (LL.lines xs), mempty)-      | otherwise  = (icontP (step' xs), mempty)-    step str       = (getter, str)+      | LL.null xs = getter+      | lChar xs   = idone (LL.lines xs) mempty+      | otherwise  = icont (step' xs) Nothing+    step _str      = getter     step' xs (Chunk ys)-      | LL.null ys = (icontP (step' xs), Chunk ys)-      | lChar ys   = (idone (LL.lines . mappend xs $ ys), mempty)+      | LL.null ys = icont (step' xs) Nothing+      | lChar ys   = idone (LL.lines . mappend xs $ ys) mempty       | otherwise  = let w' = LL.lines $ mappend xs ys                          ws = init w'                          ck = last w'-                     in (idone ws, Chunk ck)-    step' xs str   = (idone (LL.lines xs), str)+                     in idone ws (Chunk ck)+    step' xs str   = idone (LL.lines xs) str  -- |Convert the stream of characters to the stream of words, and -- apply the given iteratee to enumerate the latter.@@ -109,21 +109,21 @@   :: (Monad m) => Enumeratee BC.ByteString [BC.ByteString] m a  enumWordsBS iter = convStream getter iter   where-    getter = icontP step+    getter = liftI step     lChar = isSpace . BC.last     step (Chunk xs)-      | BC.null xs = (getter, mempty)-      | lChar xs   = (idone (BC.words xs), Chunk BC.empty)-      | otherwise  = (icontP (step' xs), mempty)-    step str       = (idone mempty, str)+      | BC.null xs = getter+      | lChar xs   = idone (BC.words xs) (Chunk BC.empty)+      | otherwise  = icont (step' xs) Nothing+    step str       = idone mempty str     step' xs (Chunk ys)-      | BC.null ys = (icontP (step' xs), mempty)-      | lChar ys   = (idone (BC.words . BC.append xs $ ys), mempty)+      | BC.null ys = icont (step' xs) Nothing+      | lChar ys   = idone (BC.words . BC.append xs $ ys) mempty       | otherwise  = let w' = BC.words . BC.append xs $ ys                          ws = init w'                          ck = last w'-                     in (idone ws, Chunk ck)-    step' xs str   = (idone (BC.words xs), str)+                     in idone ws (Chunk ck)+    step' xs str   = idone (BC.words xs) str  {-# INLINE enumWordsBS #-} @@ -133,19 +133,19 @@ enumLinesBS :: (Monad m) => Enumeratee BC.ByteString [BC.ByteString] m a enumLinesBS = convStream getter   where-    getter = icontP step+    getter = icont step Nothing     lChar = (== '\n') . BC.last     step (Chunk xs)-      | BC.null xs = (getter, Chunk xs)-      | lChar xs   = (idone (BC.lines xs), Chunk BC.empty)-      | otherwise  = (icontP (step' xs), mempty)-    step str       = (idone mempty, str)+      | BC.null xs = getter+      | lChar xs   = idone (BC.lines xs) (Chunk BC.empty)+      | otherwise  = icont (step' xs) Nothing+    step str       = idone mempty str     step' xs (Chunk ys)-      | BC.null ys = (icontP (step' xs), mempty)-      | lChar ys   = (idone (BC.lines . BC.append xs $ ys), mempty)+      | BC.null ys = icont (step' xs) Nothing+      | lChar ys   = idone (BC.lines . BC.append xs $ ys) mempty       | otherwise  = let w' = BC.lines $ BC.append xs ys                          ws = init w'                          ck = last w'-                     in (idone ws, Chunk ck)-    step' xs str   = (idone (BC.lines xs), str)+                     in idone ws (Chunk ck)+    step' xs str   = idone (BC.lines xs) str 

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts #-}+{-# LANGUAGE CPP #-}  -- |Random and Binary IO with generic Iteratees. @@ -37,8 +37,7 @@ import qualified Data.Iteratee.IO.Fd as FD #endif -import Control.Monad.Trans.Control-import Control.Monad.IO.Class+import Control.Monad.CatchIO  -- | The default buffer size. defaultBufSize :: Int@@ -48,14 +47,14 @@ #if defined(USE_POSIX)  enumFile-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Int      -> FilePath      -> Enumerator s m a enumFile = FD.enumFile  enumFileRandom-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Int      -> FilePath      -> Enumerator s m a@@ -64,7 +63,7 @@ -- |Process a file using the given Iteratee.  This function wraps -- enumFd as a convenience. fileDriver-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Iteratee s m a      -> FilePath      -> m a@@ -72,7 +71,7 @@  -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Int      -> Iteratee s m a      -> FilePath@@ -82,14 +81,14 @@ -- |Process a file using the given Iteratee.  This function wraps -- enumFdRandom as a convenience. fileDriverRandom-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Iteratee s m a      -> FilePath      -> m a fileDriverRandom = FD.fileDriverRandomFd defaultBufSize  fileDriverRandomVBuf-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Int      -> Iteratee s m a      -> FilePath@@ -104,7 +103,7 @@ -- |Process a file using the given Iteratee.  This function wraps -- @enumHandle@ as a convenience. fileDriver ::- (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+ (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>   Iteratee s m a   -> FilePath   -> m a@@ -112,7 +111,7 @@  -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf ::- (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+ (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>   Int   -> Iteratee s m a   -> FilePath@@ -122,14 +121,14 @@ -- |Process a file using the given Iteratee.  This function wraps -- @enumRandomHandle@ as a convenience. fileDriverRandom-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Iteratee s m a      -> FilePath      -> m a fileDriverRandom = H.fileDriverRandomHandle defaultBufSize  fileDriverRandomVBuf-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Int      -> Iteratee s m a      -> FilePath@@ -137,14 +136,14 @@ fileDriverRandomVBuf = H.fileDriverRandomHandle  enumFile-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Int      -> FilePath      -> Enumerator s m a enumFile = H.enumFile  enumFileRandom-  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>+  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>      Int      -> FilePath      -> Enumerator s m a

@@ -5,7 +5,7 @@   module Data.Iteratee.IO.Windows, #endif #if defined(USE_POSIX)-  module System.Posix,+  module Data.Iteratee.IO.Posix, #else   FileOffset #endif@@ -19,7 +19,7 @@ -- Provide the FileOffset type, which is available in Posix modules -- and maybe Windows #if defined(USE_POSIX)-import System.Posix+import Data.Iteratee.IO.Posix #else type FileOffset = Integer #endif

@@ -1,7 +1,4 @@-{-# LANGUAGE  CPP-            , PackageImports-            , ScopedTypeVariables-            , FlexibleContexts #-}+{-# LANGUAGE CPP, ScopedTypeVariables #-}  -- |Random and Binary IO with generic Iteratees, using File Descriptors for IO. -- when available, these are the preferred functions for performing IO as they@@ -31,19 +28,18 @@ import Data.Iteratee.IO.Base  import Control.Concurrent (yield)+import Control.Exception import Control.Monad-import Control.Monad.Trans.Control-import Control.Exception.Lifted+import Control.Monad.CatchIO as CIO import Control.Monad.IO.Class -import Foreign.C.Error import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc  import System.IO (SeekMode(..)) -import "unix-bytestring" System.Posix.IO.ByteString+import System.Posix hiding (FileOffset)  -- ------------------------------------------------------------------------ -- Binary Random IO enumerators@@ -53,50 +49,48 @@   Ptr el   -> ByteCount   -> Fd-  -> Callback st m s+  -> st+  -> m (Either SomeException ((Bool, st), s)) makefdCallback p bufsize fd st = do-  n <- liftIO $ tryFdReadBuf fd (castPtr p) bufsize+  n <- liftIO $ myfdRead fd (castPtr p) bufsize   case n of-    Left  (Errno err) -> return $ Left (error $ "read failed: " ++ show err)-    Right 0   -> liftIO yield >> return (Right ((Finished, st), empty))-    Right n'  -> liftM (\s -> Right ((HasMore, st), s)) $-                   readFromPtr p (fromIntegral n')-{-# INLINABLE makefdCallback #-}+    Left  _  -> return $ Left (error "myfdRead failed")+    Right 0  -> liftIO yield >> return (Right ((False, st), empty))+    Right n' -> liftM (\s -> Right ((True, st), s)) $+                  readFromPtr p (fromIntegral n')  -- |The enumerator of a POSIX File Descriptor.  This version enumerates -- over the entire contents of a file, in order, unless stopped by -- the iteratee.  In particular, seeking is not supported. enumFd-  :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadBaseControl IO m) =>+  :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadCatchIO m) =>      Int      -> Fd      -> Enumerator s m a enumFd bs fd iter =   let bufsize = bs * (sizeOf (undefined :: el))-  in bracket (liftIO $ mallocBytes bufsize)-             (liftIO . free)-             (\p -> enumFromCallback (makefdCallback p (fromIntegral bufsize) fd) () iter)-{-# INLINABLE enumFd #-}+  in CIO.bracket (liftIO $ mallocBytes bufsize)+                 (liftIO . free)+                 (\p -> enumFromCallback (makefdCallback p (fromIntegral bufsize) fd) () iter)  -- |A variant of enumFd that catches exceptions raised by the @Iteratee@. enumFdCatch- :: forall e s el m a.(IException e, NullPoint s, ReadableChunk s el, MonadIO m, MonadBaseControl IO m)+ :: forall e s el m a.(IException e, NullPoint s, ReadableChunk s el, MonadCatchIO m)     => Int     -> Fd     -> (e -> m (Maybe EnumException))     -> Enumerator s m a enumFdCatch bs fd handler iter =   let bufsize = bs * (sizeOf (undefined :: el))-  in bracket (liftIO $ mallocBytes bufsize)-             (liftIO . free)-             (\p -> enumFromCallbackCatch (makefdCallback p (fromIntegral bufsize) fd) handler () iter)-{-# INLINABLE enumFdCatch #-}+  in CIO.bracket (liftIO $ mallocBytes bufsize)+                 (liftIO . free)+                 (\p -> enumFromCallbackCatch (makefdCallback p (fromIntegral bufsize) fd) handler () iter)   -- |The enumerator of a POSIX File Descriptor: a variation of @enumFd@ that -- supports RandomIO (seek requests). enumFdRandom- :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadIO m, MonadBaseControl IO m) =>+ :: forall s el m a.(NullPoint s, ReadableChunk s el, MonadCatchIO m) =>     Int     -> Fd     -> Enumerator s m a@@ -106,68 +100,61 @@       liftM (either              (const . Just $ enStrExc "Error seeking within file descriptor")              (const Nothing))-            . liftIO . tryFdSeek fd AbsoluteSeek $ fromIntegral off-{-# INLINABLE enumFdRandom #-}+            . liftIO . myfdSeek fd AbsoluteSeek $ fromIntegral off  fileDriver-  :: (MonadIO m, MonadBaseControl IO m, ReadableChunk s el) =>+  :: (MonadCatchIO m, ReadableChunk s el) =>      (Int -> Fd -> Enumerator s m a)      -> Int      -> Iteratee s m a      -> FilePath      -> m a-fileDriver enumf bufsize iter filepath = bracket+fileDriver enumf bufsize iter filepath = CIO.bracket   (liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags)   (liftIO . closeFd)   (run <=< flip (enumf bufsize) iter)-{-# INLINABLE fileDriver #-}  -- |Process a file using the given @Iteratee@. fileDriverFd-  :: (NullPoint s, MonadIO m, MonadBaseControl IO m, ReadableChunk s el) =>+  :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>      Int -- ^Buffer size (number of elements)      -> Iteratee s m a      -> FilePath      -> m a fileDriverFd = fileDriver enumFd-{-# INLINABLE fileDriverFd #-}  -- |A version of fileDriverFd that supports seeking. fileDriverRandomFd-  :: (NullPoint s, MonadIO m, MonadBaseControl IO m, ReadableChunk s el) =>+  :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>      Int      -> Iteratee s m a      -> FilePath      -> m a fileDriverRandomFd = fileDriver enumFdRandom-{-# INLINABLE fileDriverRandomFd #-} -enumFile' :: (NullPoint s, MonadIO m, MonadBaseControl IO m, ReadableChunk s el) =>+enumFile' :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>   (Int -> Fd -> Enumerator s m a)   -> Int -- ^Buffer size   -> FilePath   -> Enumerator s m a-enumFile' enumf bufsize filepath iter = bracket+enumFile' enumf bufsize filepath iter = CIO.bracket   (liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags)   (liftIO . closeFd)   (flip (enumf bufsize) iter)-{-# INLINABLE enumFile' #-}  enumFile ::-  (NullPoint s, MonadIO m, MonadBaseControl IO m, ReadableChunk s el)+  (NullPoint s, MonadCatchIO m, ReadableChunk s el)   => Int                 -- ^Buffer size   -> FilePath   -> Enumerator s m a enumFile = enumFile' enumFd-{-# INLINABLE enumFile #-}  enumFileRandom ::-  (NullPoint s, MonadIO m, MonadBaseControl IO m, ReadableChunk s el)+  (NullPoint s, MonadCatchIO m, ReadableChunk s el)   => Int                 -- ^Buffer size   -> FilePath   -> Enumerator s m a enumFileRandom = enumFile' enumFdRandom-{-# INLINABLE enumFileRandom #-}   #endif

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- |Random and Binary IO with generic Iteratees.  These functions use Handles -- for IO operations, and are provided for compatibility.  When available,@@ -23,10 +23,9 @@ import Data.Iteratee.Iteratee import Data.Iteratee.Binary() -import Control.Applicative ((<$>))+import Control.Exception import Control.Monad-import Control.Monad.Trans.Control-import Control.Exception.Lifted+import Control.Monad.CatchIO as CIO import Control.Monad.IO.Class  import Foreign.Ptr@@ -39,18 +38,19 @@ -- ------------------------------------------------------------------------ -- Binary Random IO enumerators -makeHandleCallback :: forall st m s el.-  (MonadBaseControl IO m, MonadIO m, NullPoint s, ReadableChunk s el) =>+makeHandleCallback ::+  (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>   Ptr el   -> Int   -> Handle-  -> Callback st m s+  -> st+  -> m (Either SomeException ((Bool, st), s)) makeHandleCallback p bsize h st = do-  n' <- (try $ liftIO $ hGetBuf h p bsize) :: m (Either SomeException Int)+  n' <- liftIO (CIO.try $ hGetBuf h p bsize :: IO (Either SomeException Int))   case n' of     Left e -> return $ Left e-    Right 0 -> return $ Right ((Finished, st), empty)-    Right n -> liftIO $ (\s -> Right ((HasMore, st), s)) <$>+    Right 0 -> return $ Right ((False, st), empty)+    Right n -> liftM (\s -> Right ((True, st), s)) $                  readFromPtr p (fromIntegral n)  @@ -58,33 +58,32 @@ -- over the entire contents of a file, in order, unless stopped by -- the iteratee.  In particular, seeking is not supported. -- Data is read into a buffer of the specified size.-enumHandle- :: forall s el m a.-    (NullPoint s, ReadableChunk s el, MonadBaseControl IO m, MonadIO m)-  => Int -- ^Buffer size (number of elements per read)+enumHandle ::+ forall s el m a.(NullPoint s, ReadableChunk s el, MonadCatchIO m) =>+  Int -- ^Buffer size (number of elements per read)   -> Handle   -> Enumerator s m a enumHandle bs h i =   let bufsize = bs * sizeOf (undefined :: el)-  in bracket (liftIO $ mallocBytes bufsize)+  in CIO.bracket (liftIO $ mallocBytes bufsize)                  (liftIO . free)                  (\p -> enumFromCallback (makeHandleCallback p bufsize h) () i)  -- |An enumerator of a file handle that catches exceptions raised by -- the Iteratee. enumHandleCatch- :: forall e s el m a.(IException e,+ ::+ forall e s el m a.(IException e,                     NullPoint s,                     ReadableChunk s el,-                    MonadBaseControl IO m,-                    MonadIO m)+                    MonadCatchIO m)   => Int -- ^Buffer size (number of elements per read)   -> Handle   -> (e -> m (Maybe EnumException))   -> Enumerator s m a enumHandleCatch bs h handler i =   let bufsize = bs * sizeOf (undefined :: el)-  in bracket (liftIO $ mallocBytes bufsize)+  in CIO.bracket (liftIO $ mallocBytes bufsize)                  (liftIO . free)                  (\p -> enumFromCallbackCatch (makeHandleCallback p bufsize h) handler () i) @@ -92,12 +91,9 @@ -- |The enumerator of a Handle: a variation of enumHandle that -- supports RandomIO (seek requests). -- Data is read into a buffer of the specified size.-enumHandleRandom- :: forall s el m a. (NullPoint s-                     ,ReadableChunk s el-                     ,MonadBaseControl IO m-                     ,MonadIO m)-  => Int -- ^ Buffer size (number of elements per read)+enumHandleRandom ::+ forall s el m a.(NullPoint s, ReadableChunk s el, MonadCatchIO m) =>+  Int -- ^ Buffer size (number of elements per read)   -> Handle   -> Enumerator s m a enumHandleRandom bs h i = enumHandleCatch bs h handler i@@ -106,31 +102,30 @@        liftM (either               (Just . EnumException :: IOException -> Maybe EnumException)               (const Nothing))-             . liftIO . try $ hSeek h AbsoluteSeek $ fromIntegral off+             . liftIO . CIO.try $ hSeek h AbsoluteSeek $ fromIntegral off  -- ---------------------------------------------- -- File Driver wrapper functions. -enumFile'-  :: (NullPoint s, MonadBaseControl IO m, ReadableChunk s el, MonadIO m)-  => (Int -> Handle -> Enumerator s m a)+enumFile' :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>+  (Int -> Handle -> Enumerator s m a)   -> Int -- ^Buffer size   -> FilePath   -> Enumerator s m a-enumFile' enumf bufsize filepath iter = bracket+enumFile' enumf bufsize filepath iter = CIO.bracket   (liftIO $ openBinaryFile filepath ReadMode)   (liftIO . hClose)   (flip (enumf bufsize) iter) -enumFile-  :: (NullPoint s, MonadBaseControl IO m, ReadableChunk s el, MonadIO m)+enumFile ::+  (NullPoint s, MonadCatchIO m, ReadableChunk s el)   => Int                 -- ^Buffer size   -> FilePath   -> Enumerator s m a enumFile = enumFile' enumHandle -enumFileRandom-  :: (NullPoint s, MonadBaseControl IO m, ReadableChunk s el, MonadIO m)+enumFileRandom ::+  (NullPoint s, MonadCatchIO m, ReadableChunk s el)   => Int                 -- ^Buffer size   -> FilePath   -> Enumerator s m a@@ -139,21 +134,21 @@ -- |Process a file using the given @Iteratee@.  This function wraps -- @enumHandle@ as a convenience. fileDriverHandle-  :: (NullPoint s, MonadBaseControl IO m, ReadableChunk s el, MonadIO m)-  => Int                      -- ^Buffer size (number of elements)-  -> Iteratee s m a-  -> FilePath-  -> m a+  :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>+     Int                      -- ^Buffer size (number of elements)+     -> Iteratee s m a+     -> FilePath+     -> m a fileDriverHandle bufsize iter filepath =   enumFile bufsize filepath iter >>= run  -- |A version of @fileDriverHandle@ that supports seeking. fileDriverRandomHandle-  :: (NullPoint s, MonadBaseControl IO m, ReadableChunk s el, MonadIO m)-  => Int                      -- ^ Buffer size (number of elements)-  -> Iteratee s m a-  -> FilePath-  -> m a+  :: (NullPoint s, MonadCatchIO m, ReadableChunk s el) =>+     Int                      -- ^ Buffer size (number of elements)+     -> Iteratee s m a+     -> FilePath+     -> m a fileDriverRandomHandle bufsize iter filepath =   enumFileRandom bufsize filepath iter >>= run 

@@ -0,0 +1,104 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++-- Low-level IO operations+-- These operations are either missing from the GHC run-time library,+-- or implemented suboptimally or heavy-handedly++module Data.Iteratee.IO.Posix (+#if defined(USE_POSIX)+  FileOffset,+  myfdRead,+  myfdSeek,+  Errno(..),+  select'read'pending+#endif+)++where++#if defined(USE_POSIX)++import Foreign.C+import Foreign.Ptr+import System.Posix+import System.IO (SeekMode(..))+import Control.Monad+import Data.Bits                        -- for select+import Foreign.Marshal.Array            -- for select++-- |Alas, GHC provides no function to read from Fd to an allocated buffer.+-- The library function fdRead is not appropriate as it returns a string+-- already. I'd rather get data from a buffer.+-- Furthermore, fdRead (at least in GHC) allocates a new buffer each+-- time it is called. This is a waste. Yet another problem with fdRead+-- is in raising an exception on any IOError or even EOF. I'd rather+-- avoid exceptions altogether.++myfdRead :: Fd -> Ptr CChar -> ByteCount -> IO (Either Errno ByteCount)+myfdRead (Fd fd) ptr n = do+  n' <- cRead fd ptr n+  if n' == -1 then liftM Left getErrno+     else return . Right . fromIntegral $ n'++foreign import ccall unsafe "unistd.h read" cRead+  :: CInt -> Ptr CChar -> CSize -> IO CInt++-- |The following fseek procedure throws no exceptions.+myfdSeek:: Fd -> SeekMode -> FileOffset -> IO (Either Errno FileOffset)+myfdSeek (Fd fd) mode off = do+  n' <- cLSeek fd off (mode2Int mode)+  if n' == -1 then liftM Left getErrno+     else return . Right  $ n'+ where mode2Int :: SeekMode -> CInt     -- From GHC source+       mode2Int AbsoluteSeek = 0+       mode2Int RelativeSeek = 1+       mode2Int SeekFromEnd  = 2++foreign import ccall unsafe "unistd.h lseek" cLSeek+  :: CInt -> FileOffset -> CInt -> IO FileOffset+++-- Darn! GHC doesn't provide the real select over several descriptors!+-- We have to implement it ourselves++type FDSET = CUInt+type TIMEVAL = CLong -- Two longs+foreign import ccall "unistd.h select" c_select+  :: CInt -> Ptr FDSET -> Ptr FDSET -> Ptr FDSET -> Ptr TIMEVAL -> IO CInt++-- Convert a file descriptor to an FDSet (for use with select)+-- essentially encode a file descriptor in a big-endian notation+fd2fds :: CInt -> [FDSET]+fd2fds fd = replicate nb 0 ++ [setBit 0 off]+  where+    (nb,off) = quotRem (fromIntegral fd) (bitSize (undefined::FDSET))++fds2mfd :: [FDSET] -> [CInt]+fds2mfd fds = [fromIntegral (j+i*bitsize) |+               (afds,i) <- zip fds [0..], j <- [0..bitsize],+               testBit afds j]+  where bitsize = bitSize (undefined::FDSET)++unFd :: Fd -> CInt+unFd (Fd x) = x++-- |poll if file descriptors have something to read+-- Return the list of read-pending descriptors+select'read'pending :: [Fd] -> IO (Either Errno [Fd])+select'read'pending mfd =+    withArray ([0,1]::[TIMEVAL]) $ \_timeout ->+      withArray fds $ \readfs -> do+          rc <- c_select (fdmax+1) readfs nullPtr nullPtr nullPtr+          if rc == -1+            then liftM Left getErrno+            -- because the wait was indefinite, rc must be positive!+            else liftM (Right . map Fd . fds2mfd) (peekArray (length fds) readfs)+  where+    fds :: [FDSET]+    fds  = foldr ormax [] (map (fd2fds . unFd) mfd)+    fdmax = maximum $ map fromIntegral mfd+    ormax [] x = x+    ormax x [] = x+    ormax (a:ar) (b:br) = (a .|. b) : ormax ar br++#endif

@@ -2,6 +2,7 @@             ,RankNTypes             ,FlexibleContexts             ,ScopedTypeVariables+            ,BangPatterns             ,DeriveDataTypeable #-}  -- |Monadic and General Iteratees:@@ -9,12 +10,10 @@  module Data.Iteratee.Iteratee (   -- * Types-  Cont-  ,EnumerateeHandler+  EnumerateeHandler   -- ** Error handling   ,throwErr   ,throwRecoverableErr-  ,throwRec   ,checkErr   -- ** Basic Iteratees   ,identity@@ -30,6 +29,7 @@   ,mapChunksM   ,convStream   ,unfoldConvStream+  ,unfoldConvStreamCheck   ,joinI   ,joinIM   -- * Enumerators@@ -48,17 +48,14 @@   ,(>>>)   ,eneeCheckIfDone   ,eneeCheckIfDoneHandle-  ,eneeCheckIfDonePass   ,eneeCheckIfDoneIgnore+  ,eneeCheckIfDonePass   ,mergeEnums   -- ** Enumeratee Combinators   ,($=)   ,(=$)   ,(><>)   ,(<><)-  -- ** Enumerator creation callbacks-  ,CBState (..)-  ,Callback   -- * Misc.   ,seek   ,FileOffset@@ -72,9 +69,7 @@ import Data.Iteratee.IO.Base import Data.Iteratee.Base -import Control.Arrow (first, (***)) import Control.Exception-import Control.Monad import Control.Monad.Trans.Class import Data.Maybe import Data.Typeable@@ -91,58 +86,60 @@ -- cannot be handled by 'enumFromCallbackCatch', although it can be cleared -- by 'checkErr'. throwErr :: SomeException -> Iteratee s m a-throwErr e = ierr (throwErr e) e+throwErr e = icont (const (throwErr e)) (Just e)  -- |Report and propagate a recoverable error.  This error can be handled by -- both 'enumFromCallbackCatch' and 'checkErr'.-throwRecoverableErr :: (Exception e) => e -> Iteratee s m a -> Iteratee s m a-throwRecoverableErr e i = ierr i (toException e)---- | A shorter name for 'throwRecoverableErr'-throwRec :: (Exception e) => e -> Iteratee s m a -> Iteratee s m a-throwRec = throwRecoverableErr+throwRecoverableErr ::+  SomeException+  -> (Stream s -> Iteratee s m a)+  -> Iteratee s m a+throwRecoverableErr e i = icont i (Just e)   -- |Check if an iteratee produces an error. -- Returns @Right a@ if it completes without errors, otherwise -- @Left SomeException@. 'checkErr' is useful for iteratees that may not -- terminate, such as @Data.Iteratee.head@ with an empty stream.-checkErr :: Monad m => Iteratee s m a -> Iteratee s m (Either SomeException a)-checkErr iter = runIter iter (idone . Right) oc oe oR- where-  oc k   = icont (liftM (first checkErr) . k)-  oe _ e = idone (Left e)-  oR mb doB = ireq mb (checkErr . doB)+checkErr ::+ (NullPoint s) =>+  Iteratee s m a+  -> Iteratee s m (Either SomeException a)+checkErr iter = Iteratee $ \onDone onCont ->+  let od            = onDone . Right+      oc k Nothing  = onCont (checkErr . k) Nothing+      oc _ (Just e) = onDone (Left e) (Chunk empty)+  in runIter iter od oc  -- ------------------------------------------------------------------------ -- Parser combinators  -- |The identity iteratee.  Doesn't do any processing of input.-identity :: Iteratee s m ()-identity = idone ()+identity :: (NullPoint s) => Iteratee s m ()+identity = idone () (Chunk empty)  -- |Get the stream status of an iteratee.-isStreamFinished :: (Nullable s, Monad m) => Iteratee s m (Maybe SomeException)-isStreamFinished = icontP check+isStreamFinished :: (Nullable s) => Iteratee s m (Maybe SomeException)+isStreamFinished = liftI check   where     check s@(Chunk xs)-      | nullC xs  = (isStreamFinished, s)-      | otherwise = (idone Nothing, s)-    check s@(EOF e) = (idone (Just $ fromMaybe (toException EofException) e), s)+      | nullC xs  = isStreamFinished+      | otherwise = idone Nothing s+    check s@(EOF e) = idone (Just $ fromMaybe (toException EofException) e) s {-# INLINE isStreamFinished #-}   -- |Skip the rest of the stream-skipToEof :: (NullPoint s, Monad m) => Iteratee s m ()-skipToEof = icontP check+skipToEof :: Iteratee s m ()+skipToEof = icont check Nothing   where-    check (Chunk _) = (skipToEof, Chunk empty)-    check s         = (idone (), s)+    check (Chunk _) = skipToEof+    check s         = idone () s   -- |Seek to a position in the stream seek :: (NullPoint s) => FileOffset -> Iteratee s m ()-seek o = throwRec (SeekException o) identity+seek o = throwRecoverableErr (toException $ SeekException o) (const identity)  -- | Map a monadic function over the chunks of the stream and ignore the -- result.  Useful for creating efficient monadic iteratee consumers, e.g.@@ -151,47 +148,42 @@ --  -- these can be efficiently run in parallel with other iteratees via -- @Data.Iteratee.ListLike.zip@.-mapChunksM_ :: (Monad m, Nullable s, NullPoint s)-  => (s -> m b)-  -> Iteratee s m ()-mapChunksM_ f = icont step+mapChunksM_ :: (Monad m, Nullable s) => (s -> m b) -> Iteratee s m ()+mapChunksM_ f = liftI step   where-    step s@(Chunk xs)-      | nullC xs   = return (icont step, s)-      | otherwise  = f xs >> return (icont step, Chunk empty)-    step s@(EOF _) = return (idone (), s)+    step (Chunk xs)+      | nullC xs   = liftI step+      | otherwise  = lift (f xs) >> liftI step+    step s@(EOF _) = idone () s {-# INLINE mapChunksM_ #-}  -- | A fold over chunks-foldChunksM :: (Monad m, Nullable s, NullPoint s)-  => (a -> s -> m a)-  -> a-  -> Iteratee s m a-foldChunksM f = icont . go+foldChunksM :: (Monad m, Nullable s) => (a -> s -> m a) -> a -> Iteratee s m a+foldChunksM f = liftI . go   where-    go a (Chunk c) = f a c >>= \a' -> return (icont (go a'), Chunk empty)-    go a e = return (idone a, e)+    go a (Chunk c) = lift (f a c) >>= liftI . go+    go a e = idone a e {-# INLINE foldChunksM #-}  -- | Get the current chunk from the stream.-getChunk :: (Monad m, Nullable s, NullPoint s) => Iteratee s m s-getChunk = icontP step+getChunk :: (Nullable s, NullPoint s) => Iteratee s m s+getChunk = liftI step  where-  step s@(Chunk xs)-    | nullC xs  = (icontP step, s)-    | otherwise = (idone xs, Chunk empty)-  step s@(EOF Nothing)  = (throwRec EofException getChunk, s)-  step s@(EOF (Just e)) = (throwRec e getChunk, s)+  step (Chunk xs)+    | nullC xs  = liftI step+    | otherwise = idone xs $ Chunk empty+  step (EOF Nothing)  = throwErr $ toException EofException+  step (EOF (Just e)) = throwErr e {-# INLINE getChunk #-}  -- | Get a list of all chunks from the stream.-getChunks :: (Monad m, Nullable s, NullPoint s) => Iteratee s m [s]-getChunks = icontP (step id)+getChunks :: (Nullable s) => Iteratee s m [s]+getChunks = liftI (step id)  where-  step acc s@(Chunk xs)-    | nullC xs    = (icontP (step acc), s)-    | otherwise   = (icontP (step $ acc . (xs:)), s)-  step acc stream = (idone (acc []), stream)+  step acc (Chunk xs)+    | nullC xs    = liftI (step acc)+    | otherwise   = liftI (step $ acc . (xs:))+  step acc stream = idone (acc []) stream {-# INLINE getChunks #-}  -- ---------------------------------------------------@@ -212,27 +204,27 @@ -- >   :: (Monad m, LL.ListLike s el, NullPoint s) -- >   => (el -> Bool) -- >   -> Enumeratee s s m a--- > breakE cpred = eneeCheckIfDone (icont . step)+-- > breakE cpred = eneeCheckIfDone (liftI . step) -- >  where -- >   step k (Chunk s)--- >       | LL.null s  = icont (step k)+-- >       | LL.null s  = liftI (step k) -- >       | otherwise  = case LL.break cpred s of -- >         (str', tail')--- >           | LL.null tail' -> eneeCheckIfDone (icont . step) . k $ Chunk str'+-- >           | LL.null tail' -> eneeCheckIfDone (liftI . step) . k $ Chunk str' -- >           | otherwise     -> idone (k $ Chunk str') (Chunk tail') -- >   step k stream           =  idone (k stream) stream --  eneeCheckIfDone ::  (Monad m, NullPoint elo) =>-  (Cont eli m a -> Iteratee elo m (Iteratee eli m a))+  ((Stream eli -> Iteratee eli m a) -> Iteratee elo m (Iteratee eli m a))   -> Enumeratee elo eli m a-eneeCheckIfDone = eneeCheckIfDonePass---- | The continuation type of an incomplete iteratee-type Cont s m a = Stream s -> m (Iteratee s m a, Stream s)+eneeCheckIfDone f = eneeCheckIfDonePass f'+ where+  f' k Nothing  = f k+  f' k (Just e) = throwRecoverableErr e (\s -> joinIM $ enumChunk s $ eneeCheckIfDone f (liftI k))  type EnumerateeHandler eli elo m a =-  Iteratee eli m a+  (Stream eli -> Iteratee eli m a)   -> SomeException   -> Iteratee elo m (Iteratee eli m a) @@ -240,61 +232,51 @@ -- a handler which is used -- to process any exceptions in a separate method. eneeCheckIfDoneHandle-  :: forall m eli elo a. (NullPoint elo)+  :: (NullPoint elo)   => EnumerateeHandler eli elo m a-  -> (Cont eli m a -> Iteratee elo m (Iteratee eli m a))+  -> ((Stream eli -> Iteratee eli m a)+      -> Maybe SomeException+      -> Iteratee elo m (Iteratee eli m a)+     )   -> Enumeratee elo eli m a-eneeCheckIfDoneHandle h fc inner = worker inner- where-  worker i     = runIter i onDone fc h onReq-  onDone x     = idone (idone x)-  onReq :: forall b. m b-                     -> (b -> Iteratee eli m a)-                     -> Iteratee elo m (Iteratee eli m a)-  onReq mb doB = ireq mb (worker . doB)+eneeCheckIfDoneHandle h f inner = Iteratee $ \od oc ->+  let onDone x s = od (idone x s) (Chunk empty)+      onCont k Nothing  = runIter (f k Nothing) od oc+      onCont k (Just e) = runIter (h k e)       od oc+  in runIter inner onDone onCont {-# INLINABLE eneeCheckIfDoneHandle #-} --- | Create enumeratees that pass all errors through the outer iteratee. eneeCheckIfDonePass   :: (NullPoint elo)-  => (Cont eli m a -> Iteratee elo m (Iteratee eli m a))+  => ((Stream eli -> Iteratee eli m a)+      -> Maybe SomeException+      -> Iteratee elo m (Iteratee eli m a)+     )   -> Enumeratee elo eli m a-eneeCheckIfDonePass f = worker- where-  worker = eneeCheckIfDoneHandle handler f-  handler i = ierr (worker i)+eneeCheckIfDonePass f = eneeCheckIfDoneHandle (\k e -> f k (Just e)) f {-# INLINABLE eneeCheckIfDonePass #-} --- | Create an enumeratee that ignores all errors from the inner iteratee eneeCheckIfDoneIgnore   :: (NullPoint elo)-  => (Cont eli m a -> Iteratee elo m (Iteratee eli m a))+  => ((Stream eli -> Iteratee eli m a)+      -> Maybe SomeException+      -> Iteratee elo m (Iteratee eli m a)+     )   -> Enumeratee elo eli m a-eneeCheckIfDoneIgnore f = worker- where-  worker = eneeCheckIfDoneHandle handler f-  handler i _e = worker i-{-# INLINABLE eneeCheckIfDoneIgnore #-}-+eneeCheckIfDoneIgnore f = eneeCheckIfDoneHandle (\k _ -> f k Nothing) f  -- | Convert one stream into another with the supplied mapping function. -- This function operates on whole chunks at a time, contrasting to -- @mapStream@ which operates on single elements. -- --- 'mapChunks' is useful for creating high-performance iteratees, however--- the entire input chunk will be consumed even if the inner iteratee doesn't--- make use of all of it.---  -- > unpacker :: Enumeratee B.ByteString [Word8] m a -- > unpacker = mapChunks B.unpack -- -mapChunks :: (Monad m, NullPoint s) => (s -> s') -> Enumeratee s s' m a-mapChunks f = go+mapChunks :: (NullPoint s) => (s -> s') -> Enumeratee s s' m a+mapChunks f = eneeCheckIfDonePass (icont . step)  where-  go = eneeCheckIfDonePass (icont . step)-  step k (Chunk xs) = k (Chunk (f xs)) >>= \(i',_) ->-                        return (go i', Chunk empty)-  step k (EOF mErr) = (idone *** const (EOF mErr)) `liftM` k (EOF mErr)+  step k (Chunk xs)     = eneeCheckIfDonePass (icont . step) . k . Chunk $ f xs+  step k str@(EOF mErr) = idone (k $ EOF mErr) str {-# INLINE mapChunks #-}  -- | Convert a stream of @s@ to a stream of @s'@ using the supplied function.@@ -302,12 +284,11 @@   :: (Monad m, NullPoint s, Nullable s)   => (s -> m s')   -> Enumeratee s s' m a-mapChunksM f = go+mapChunksM f = eneeCheckIfDonePass (icont . step)  where-  go = eneeCheckIfDonePass (icont . step)-  step k (Chunk xs) = f xs >>= k . Chunk >>= \(i', _str) ->-                            return (go i', Chunk empty)-  step k (EOF mErr) = (idone *** const (EOF mErr)) `liftM` k (EOF mErr)+  step k (Chunk xs)     = lift (f xs) >>=+                          eneeCheckIfDonePass (icont . step) . k . Chunk+  step k str@(EOF mErr) = idone (k $ EOF mErr) str {-# INLINE mapChunksM #-}  -- |Convert one stream into another, not necessarily in lockstep.@@ -318,21 +299,17 @@ -- one element of the inner stream, or the other way around. -- The transformation from one stream to the other is specified as -- Iteratee s m s'.-convStream :: forall s s' m a.+convStream ::  (Monad m, Nullable s) =>   Iteratee s m s'   -> Enumeratee s s' m a-convStream fi = go+convStream fi = eneeCheckIfDonePass check   where-    go = eneeCheckIfDonePass check-    check k = isStreamFinished >>= maybe (step k) (hndl k)-    hndl k e = case fromException e of-      Just EofException -> idone (icont k)-      _                 -> ierr (step k) e-    step k = fi >>= lift . k . Chunk >>= go . fst+    check k (Just e) = throwRecoverableErr e (const identity) >> check k Nothing+    check k _ = isStreamFinished >>= maybe (step k) (idone (liftI k) . EOF . Just)+    step k = fi >>= eneeCheckIfDonePass check . k . Chunk {-# INLINABLE convStream #-} - -- |The most general stream converter.  Given a function to produce iteratee -- transformers and an initial state, convert the stream using iteratees -- generated by the function while continually updating the internal state.@@ -341,28 +318,36 @@   (acc -> Iteratee s m (acc, s'))   -> acc   -> Enumeratee s s' m a-unfoldConvStream fi acc0 = unfoldConvStreamCheck eneeCheckIfDonePass fi acc0+unfoldConvStream f acc0 = eneeCheckIfDonePass (check acc0)+  where+    check acc k (Just e) = throwRecoverableErr e (const identity) >> check acc k Nothing+    check acc k _ = isStreamFinished >>=+                    maybe (step acc k) (idone (liftI k) . EOF . Just)+    step acc k = f acc >>= \(acc', s') ->+                    eneeCheckIfDonePass (check acc') . k . Chunk $ s' {-# INLINABLE unfoldConvStream #-}  unfoldConvStreamCheck   :: (Monad m, Nullable elo)-  => ((Cont eli m a -> Iteratee elo m (Iteratee eli m a))+  => (((Stream eli -> Iteratee eli m a)+        -> Maybe SomeException+        -> Iteratee elo m (Iteratee eli m a)+      )       -> Enumeratee elo eli m a      )   -> (acc -> Iteratee elo m (acc, eli))   -> acc   -> Enumeratee elo eli m a-unfoldConvStreamCheck checkDone f acc0 = go acc0+unfoldConvStreamCheck checkDone f acc0 = checkDone (check acc0)   where-    go acc = checkDone (check acc)-    check acc k  = isStreamFinished >>= maybe (step acc k) (hndl acc k)-    hndl acc k e = case fromException e of-      Just EofException -> idone (icont k)-      _                 -> ierr (step acc k) e-    step acc k = do-      (acc', s') <- f acc-      (i', _)    <- lift . k $ Chunk s'-      go acc' i'+    check acc k mX = isStreamFinished >>=+                   maybe (step acc k mX) (idone (icont k mX) . EOF . Just)+    step acc k Nothing = f acc >>= \(acc', s') ->+                  (checkDone (check acc') . k $ Chunk s')+    step acc k (Just ex) = throwRecoverableErr ex $ \str' ->+      let i = f acc >>= \(acc', s') ->+                           (checkDone (check acc') . k $ Chunk s')+      in joinIM $ enumChunk str' i {-# INLINABLE unfoldConvStreamCheck #-}  -- | Collapse a nested iteratee.  The inner iteratee is terminated by @EOF@.@@ -370,24 +355,24 @@ --  --  The stream resumes from the point of the outer iteratee; any remaining --  input in the inner iteratee will be lost.---  --  Differs from 'Control.Monad.join' in that the inner iteratee is terminated, --  and may have a different stream type than the result. joinI ::  (Monad m, Nullable s) =>   Iteratee s m (Iteratee s' m a)   -> Iteratee s m a-joinI i = runIter i onDone onCont onErr onR- where-  onDone i'   = ireq (tryRun i') (either throwErr return)-  onCont k    = icont $ \str -> first joinI `liftM` k str-  onErr i' e  = throwRec e (joinI i')-  onR mb doB  = lift mb >>= joinI . doB+joinI = (>>=+  \inner -> Iteratee $ \od oc ->+  let onDone  x _        = od x (Chunk empty)+      onCont  k Nothing  = runIter (k (EOF Nothing)) onDone onCont'+      onCont  _ (Just e) = runIter (throwErr e) od oc+      onCont' _ e        = runIter (throwErr (fromMaybe excDivergent e)) od oc+  in runIter inner onDone onCont) {-# INLINE joinI #-}  -- | Lift an iteratee inside a monad to an iteratee. joinIM :: (Monad m) => m (Iteratee s m a) -> Iteratee s m a-joinIM mIter = ireq mIter id+joinIM mIter = Iteratee $ \od oc -> mIter >>= \iter -> runIter iter od oc   -- ------------------------------------------------------------------------@@ -413,25 +398,24 @@ -- stream. The result is the iteratee in the Done state.  It is an error -- if the iteratee does not terminate on EOF. enumEof :: (Monad m) => Enumerator s m a-enumEof iter = runIter iter idoneM onC ierrM onR+enumEof iter = runIter iter onDone onCont   where-    onC  k     = k (EOF Nothing) >>= \(i,_) -> runIter i idoneM onC' ierrM onR-    onC' _k    = return $ throwErr excDivergent-    onR mb doB = mb >>= enumEof . doB+    onDone  x _str    = return $ idone x (EOF Nothing)+    onCont  k Nothing = runIter (k (EOF Nothing)) onDone onCont'+    onCont  k e       = return $ icont k e+    onCont' _ Nothing = return $ throwErr excDivergent+    onCont' k e       = return $ icont k e  -- |Another primitive enumerator: tell the Iteratee the stream terminated -- with an error.--- --- If the iteratee is already in an error state, the previous error is--- preserved. enumErr :: (Exception e, Monad m) => e -> Enumerator s m a-enumErr e iter = runIter iter idoneM onCont ierrM onR+enumErr e iter = runIter iter onDone onCont   where-    onCont  k  = do-      (i',_) <- k . EOF . Just $ toException e -      runIter i' idoneM onCont' ierrM onR-    onCont' _  = return $ throwErr excDivergent-    onR mb doB = mb >>= enumErr e . doB+    onDone  x _       = return $ idone x (EOF . Just $ toException e)+    onCont  k Nothing = runIter (k (EOF (Just (toException e)))) onDone onCont'+    onCont  k e'      = return $ icont k e'+    onCont' _ Nothing = return $ throwErr excDivergent+    onCont' k e'      = return $ icont k e'   -- |The composition of two enumerators: essentially the functional composition@@ -507,23 +491,22 @@ -- It passes a given list of elements to the iteratee in one chunk -- This enumerator does no IO and is useful for testing of base parsing enumPure1Chunk :: (Monad m) => s -> Enumerator s m a-enumPure1Chunk str iter = runIter iter idoneM onC ierrM onR+enumPure1Chunk str iter = runIter iter idoneM onCont   where-    onC k      = fst `liftM` k (Chunk str)-    onR mb doB = mb >>= enumPure1Chunk str . doB+    onCont k Nothing = return $ k $ Chunk str+    onCont k e       = return $ icont k e  -- | Enumerate chunks from a list --  enumList :: (Monad m) => [s] -> Enumerator s m a enumList chunks = go chunks  where-  go [] i  = return i-  go xs' i = runIter i idoneM (onCont xs') onErr (onReq xs')+  go [] i = return i+  go xs' i = runIter i idoneM (onCont xs')    where-    onCont (x:xs) k = k (Chunk x) >>= go xs . fst-    onCont []     k = return $ icont k-    onErr iRes e    = return $ throwRec e iRes-    onReq xs mb doB = mb >>= go xs . doB+    onCont (x:xs) k Nothing = go xs . k $ Chunk x+    onCont _ _ (Just e) = return $ throwErr e+    onCont _ k Nothing  = return $ icont k Nothing {-# INLINABLE enumList #-}  -- | Checks if an iteratee has finished.@@ -531,23 +514,21 @@ -- This enumerator runs the iteratee, performing any monadic actions. -- If the result is True, the returned iteratee is done. enumCheckIfDone :: (Monad m) => Iteratee s m a -> m (Bool, Iteratee s m a)-enumCheckIfDone iter = runIter iter onDone onCont onErr onReq+enumCheckIfDone iter = runIter iter onDone onCont   where-    onDone x  = return (True, idone x)-    onCont k  = return (False, icont k)-    onErr i e = return (False, ierr i e)-    onReq mb doB = mb >>= enumCheckIfDone . doB+    onDone x str = return (True, idone x str)+    onCont k e   = return (False, icont k e) {-# INLINE enumCheckIfDone #-}   -- |Create an enumerator from a callback function enumFromCallback ::  (Monad m, NullPoint s) =>-  Callback st m s+  (st -> m (Either SomeException ((Bool, st), s)))   -> st   -> Enumerator s m a-enumFromCallback c =-  enumFromCallbackCatch c (\NotAnException -> return Nothing)+enumFromCallback c st =+  enumFromCallbackCatch c (\NotAnException -> return Nothing) st  -- Dummy exception to catch in enumFromCallback -- This never gets thrown, but it lets us@@ -558,35 +539,26 @@ instance Exception NotAnException where instance IException NotAnException where --- | Indicate if a callback should be called again to produce more data.-data CBState = HasMore | Finished deriving (Eq, Show, Ord, Enum)---- | The type of callback functions to create enumerators.-type Callback st m s = st -> m (Either SomeException ((CBState, st), s))- -- |Create an enumerator from a callback function with an exception handler. -- The exception handler is called if an iteratee reports an exception. enumFromCallbackCatch-  :: forall e m s st a. (IException e, Monad m, NullPoint s)-  => Callback st m s+  :: (IException e, Monad m, NullPoint s)+  => (st -> m (Either SomeException ((Bool, st), s)))   -> (e -> m (Maybe EnumException))   -> st   -> Enumerator s m a enumFromCallbackCatch c handler = loop   where-    loop st iter = runIter iter idoneM (onCont st) (onErr st) (onReq st)-    onCont st k  = c st >>= either (liftM fst . k . EOF . Just) (check k)-    onErr st i e = case fromException e of+    loop st iter = runIter iter idoneM (onCont st)+    check k (True,  st') = loop st' . k . Chunk+    check k (False,_st') = return . k . Chunk+    onCont st k Nothing  = c st >>=+        either (return . k . EOF . Just) (uncurry (check k))+    onCont st k j@(Just e) = case fromException e of       Just e' -> handler e' >>=-                   maybe (loop st i)-                         (return . ierr i) . fmap toException-      Nothing -> return (ierr i e)-    onReq :: st -> m x -> (x -> Iteratee s m a) -> m (Iteratee s m a)-    onReq st mb doB = mb >>= loop st . doB-      -    check :: (Stream s -> m (Iteratee s m a, Stream s))-             -> ((CBState, st), s)-             -> m (Iteratee s m a)-    check k ((HasMore,  st'), s) = k (Chunk s) >>= loop st' . fst-    check k ((Finished,_st'), s) = fst `liftM` k (Chunk s)+                   maybe (loop st . k $ Chunk empty)+                         (return . icont k . Just) . fmap toException+      Nothing -> return (icont k j) {-# INLINE enumFromCallbackCatch #-}++

@@ -51,6 +51,7 @@   -- ** Basic enumerators   ,enumPureNChunk   -- ** Enumerator Combinators+  ,enumPair   ,enumWith   ,zip   ,zip3@@ -58,6 +59,7 @@   ,zip5   ,sequence_   ,countConsumed+  ,greedy   -- ** Monadic functions   ,mapM_   ,foldM@@ -70,14 +72,13 @@  import qualified Prelude as Prelude +import Data.List (partition) import qualified Data.ListLike as LL import qualified Data.ListLike.FoldableLL as FLL import Data.Iteratee.Iteratee import Data.Monoid import Control.Applicative ((<$>), (<*>), (<*))-import Control.Arrow (first, (***))-import Control.Monad (liftM, mplus)-import qualified Control.Monad as CM+import Control.Monad (liftM, liftM2, mplus, (<=<)) import Control.Monad.Trans.Class import Data.Word (Word8) import qualified Data.ByteString as B@@ -85,13 +86,13 @@ -- Useful combinators for implementing iteratees and enumerators  -- | Check if a stream has received 'EOF'.-isFinished :: (Monad m, Nullable s) => Iteratee s m Bool-isFinished = icontP check+isFinished :: (Nullable s) => Iteratee s m Bool+isFinished = liftI check   where   check c@(Chunk xs)-    | nullC xs    = (icontP check, c)-    | otherwise   = (idone False, c)-  check s@(EOF _) = (idone True, s)+    | nullC xs    = liftI check+    | otherwise   = idone False c+  check s@(EOF _) = idone True s {-# INLINE isFinished #-}  -- ------------------------------------------------------------------------@@ -125,16 +126,16 @@ --  -- The analogue of @List.break@ -break :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m s-break cpred = icontP (step mempty)+break :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m s+break cpred = icont (step mempty) Nothing   where-    step bfr c@(Chunk str)-      | LL.null str       =  (icontP (step bfr), c)+    step bfr (Chunk str)+      | LL.null str       =  icont (step bfr) Nothing       | otherwise         =  case LL.break cpred str of         (str', tail')-          | LL.null tail' -> (icontP (step (bfr `mappend` str)), Chunk tail')-          | otherwise     -> (idone (bfr `mappend` str'), Chunk tail')-    step bfr stream       =  (idone bfr, stream)+          | LL.null tail' -> icont (step (bfr `mappend` str)) Nothing+          | otherwise     -> idone (bfr `mappend` str') (Chunk tail')+    step bfr stream       =  idone bfr stream {-# INLINE break #-}  @@ -142,39 +143,42 @@ -- Raise a (recoverable) error if the stream is terminated. --  -- The analogue of @List.head@-head :: (Monad m, LL.ListLike s el) => Iteratee s m el-head = icontP step+-- +-- Because @head@ can raise an error, it shouldn't be used when constructing+-- iteratees for @convStream@.  Use @tryHead@ instead.+head :: (LL.ListLike s el) => Iteratee s m el+head = liftI step   where-  step c@(Chunk vec)-    | LL.null vec  = (icontP step, c)-    | otherwise    = (idone (LL.head vec), Chunk $ LL.tail vec)-  step stream      = (ierr (icontP step) (setEOF stream), stream)+  step (Chunk vec)+    | LL.null vec  = icont step Nothing+    | otherwise    = idone (LL.head vec) (Chunk $ LL.tail vec)+  step stream      = icont step (Just (setEOF stream)) {-# INLINE head #-}  -- | Similar to @head@, except it returns @Nothing@ if the stream -- is terminated.-tryHead :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe el)-tryHead = icontP step+tryHead :: (LL.ListLike s el) => Iteratee s m (Maybe el)+tryHead = liftI step   where-  step c@(Chunk vec)-    | LL.null vec  = (icontP step, c)-    | otherwise    = (idone (Just $ LL.head vec), Chunk $ LL.tail vec)-  step stream      = (idone Nothing, stream)+  step (Chunk vec)+    | LL.null vec  = liftI step+    | otherwise    = idone (Just $ LL.head vec) (Chunk $ LL.tail vec)+  step stream      = idone Nothing stream {-# INLINE tryHead #-}  -- |Attempt to read the last element of the stream and return it -- Raise a (recoverable) error if the stream is terminated --  -- The analogue of @List.last@-last :: (Monad m, LL.ListLike s el, Nullable s) => Iteratee s m el-last = icontP (step Nothing)+last :: (LL.ListLike s el, Nullable s) => Iteratee s m el+last = liftI (step Nothing)   where-  step l c@(Chunk xs)-    | nullC xs     = (icontP (step l), c)-    | otherwise    = (icontP $ step (Just $ LL.last xs), Chunk LL.empty)+  step l (Chunk xs)+    | nullC xs     = liftI (step l)+    | otherwise    = liftI $ step (Just $ LL.last xs)   step l s@(EOF _) = case l of-    Nothing -> (ierr (icontP (step l)) (setEOF s), s)-    Just x  -> (idone x, s)+    Nothing -> icont (step l) . Just . setEOF $ s+    Just x  -> idone x s {-# INLINE last #-}  @@ -184,22 +188,20 @@ -- stream. -- For example, if the stream contains 'abd', then (heads 'abc') -- will remove the characters 'ab' and return 2.-heads :: (Monad m, Nullable s, LL.ListLike s el, Eq el)-  => s-  -> Iteratee s m Int+heads :: (Monad m, Nullable s, LL.ListLike s el, Eq el) => s -> Iteratee s m Int heads st | nullC st = return 0 heads st = loop 0 st   where   loop cnt xs     | nullC xs  = return cnt-    | otherwise = icontP (step cnt xs)-  step cnt str (Chunk xs) | nullC xs  = (icontP (step cnt str), Chunk xs)-  step cnt str stream     | nullC str = (idone cnt, stream)+    | otherwise = liftI (step cnt xs)+  step cnt str (Chunk xs) | nullC xs  = liftI (step cnt str)+  step cnt str stream     | nullC str = idone cnt stream   step cnt str s@(Chunk xs) =     if LL.head str == LL.head xs        then step (succ cnt) (LL.tail str) (Chunk $ LL.tail xs)-       else (idone cnt, s)-  step cnt _ stream         = (idone cnt, stream)+       else idone cnt s+  step cnt _ stream         = idone cnt stream {-# INLINE heads #-}  @@ -207,13 +209,13 @@ -- it from the stream. -- Return @Just c@ if successful, return @Nothing@ if the stream is -- terminated by 'EOF'.-peek :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe el)-peek = icontP step+peek :: (LL.ListLike s el) => Iteratee s m (Maybe el)+peek = liftI step   where     step s@(Chunk vec)-      | LL.null vec = (icontP step, s)-      | otherwise   = (idone (Just $ LL.head vec), s)-    step stream     = (idone Nothing, stream)+      | LL.null vec = liftI step+      | otherwise   = idone (Just $ LL.head vec) s+    step stream     = idone Nothing stream {-# INLINE peek #-}  -- | Return a chunk of @t@ elements length while consuming @d@ elements@@ -224,19 +226,18 @@   => Int  -- ^ length of chunk (t)   -> Int  -- ^ amount to consume (d)   -> Iteratee s m s'-roll t d | t > d  = icontP step+roll t d | t > d  = liftI step   where     step (Chunk vec)       | LL.length vec >= d =-          (idone (LL.singleton $ LL.take t vec), Chunk $ LL.drop d vec)+          idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec)       | LL.length vec >= t =-          (idone (LL.singleton $ LL.take t vec) <* drop (d-LL.length vec)-           ,mempty)-      | LL.null vec        = (icontP step, mempty)-      | otherwise          = (icontP (step' vec), mempty)-    step stream            = (idone LL.empty, stream)+          idone (LL.singleton $ LL.take t vec) mempty <* drop (d-LL.length vec)+      | LL.null vec        = liftI step+      | otherwise          = liftI (step' vec)+    step stream            = idone LL.empty stream     step' v1 (Chunk vec)   = step . Chunk $ v1 `mappend` vec-    step' v1 stream        = (idone (LL.singleton v1), stream)+    step' v1 stream        = idone (LL.singleton v1) stream roll t d = LL.singleton <$> joinI (take t stream2stream) <* drop (d-t)   -- d is >= t, so this version works {-# INLINE roll #-}@@ -245,28 +246,28 @@ -- |Drop n elements of the stream, if there are that many. --  -- The analogue of @List.drop@-drop :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()-drop 0  = idone ()-drop n' = icontP (step n')+drop :: (Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()+drop 0  = idone () (Chunk empty)+drop n' = liftI (step n')   where     step n (Chunk str)-      | LL.length str < n = (icontP (step (n - LL.length str)), mempty)-      | otherwise         = (idone (), Chunk (LL.drop n str))-    step _ stream         = (idone (), stream)+      | LL.length str < n = liftI (step (n - LL.length str))+      | otherwise         = idone () (Chunk (LL.drop n str))+    step _ stream         = idone () stream {-# INLINE drop #-}  -- |Skip all elements while the predicate is true. --  -- The analogue of @List.dropWhile@-dropWhile :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m ()-dropWhile p = icontP step+dropWhile :: (LL.ListLike s el) => (el -> Bool) -> Iteratee s m ()+dropWhile p = liftI step   where     step (Chunk str)-      | LL.null left = (icontP step, mempty)-      | otherwise    = (idone (), Chunk left)+      | LL.null left = liftI step+      | otherwise    = idone () (Chunk left)       where         left = LL.dropWhile p str-    step stream      = (idone (), stream)+    step stream      = idone () stream {-# INLINE dropWhile #-}  @@ -275,35 +276,34 @@ -- This forces evaluation of the entire stream. --  -- The analogue of @List.length@-length :: (Monad m, Num a, LL.ListLike s el) => Iteratee s m a-length = icontP (step 0)+length :: (Num a, LL.ListLike s el) => Iteratee s m a+length = liftI (step 0)   where-    step !i (Chunk xs) = let newL = i + fromIntegral (LL.length xs)-                         in newL `seq` (icontP (step newL), mempty)-    step !i stream     = (idone i, stream)+    step !i (Chunk xs) = liftI (step $ i + fromIntegral (LL.length xs))+    step !i stream     = idone i stream {-# INLINE length #-}  -- | Get the length of the current chunk, or @Nothing@ if 'EOF'. --  -- This function consumes no input.-chunkLength :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe Int)-chunkLength = icontP step+chunkLength :: (LL.ListLike s el) => Iteratee s m (Maybe Int)+chunkLength = liftI step  where-  step s@(Chunk xs) = (idone (Just $ LL.length xs), s)-  step stream       = (idone Nothing, stream)+  step s@(Chunk xs) = idone (Just $ LL.length xs) s+  step stream       = idone Nothing stream {-# INLINE chunkLength #-}  -- | Take @n@ elements from the current chunk, or the whole chunk if -- @n@ is greater. takeFromChunk ::-  (Monad m, Nullable s, LL.ListLike s el)+  (Nullable s, LL.ListLike s el)   => Int   -> Iteratee s m s-takeFromChunk n | n <= 0 = idone empty-takeFromChunk n = icontP step+takeFromChunk n | n <= 0 = idone empty (Chunk empty)+takeFromChunk n = liftI step  where-  step (Chunk xs) = let (h,t) = LL.splitAt n xs in (idone h, Chunk t)-  step stream     = (idone empty, stream)+  step (Chunk xs) = let (h,t) = LL.splitAt n xs in idone h $ Chunk t+  step stream     = idone empty stream {-# INLINE takeFromChunk #-}  -- ---------------------------------------------------@@ -318,24 +318,18 @@ --  -- @breakE@ should be used in preference to @break@ whenever possible. breakE-  :: (LL.ListLike s el, NullPoint s, Monad m, Functor m)+  :: (LL.ListLike s el, NullPoint s)   => (el -> Bool)   -> Enumeratee s s m a-breakE cpred = go+breakE cpred = eneeCheckIfDonePass (icont . step)  where-  go = eneeCheckIfDonePass (icont . step)   step k (Chunk s)-      | LL.null s  = return (icont (step k), mempty)+      | LL.null s  = liftI (step k)       | otherwise  = case LL.break cpred s of         (str', tail')-          | LL.null tail' -> do-              (i', _) <- k (Chunk str')-              return (go i' <* dropWhile (not . cpred), Chunk tail')-                               -- if the inner iteratee completes before-                               -- the predicate is met, elements still-                               -- need to be dropped.-          | otherwise -> (idone *** const (Chunk tail')) `liftM` k (Chunk str')-  step k stream       =  return (idone (icont k), stream)+          | LL.null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'+          | otherwise     -> idone (k $ Chunk str') (Chunk tail')+  step k stream           =  idone (liftI k) stream {-# INLINE breakE #-}  -- |Read n elements from a stream and apply the given iteratee to the@@ -348,22 +342,19 @@   => Int   -- ^ number of elements to consume   -> Enumeratee s s m a take n' iter-  | n' <= 0   = return iter-  | otherwise = runIter iter onDone onCont onErr onReq- where-  onDone x = drop n' >> idone (idone x)-  onCont k = if n' == 0 then idone (icont k)-                else icont (step n' k)-  onErr i  = ierr (take n' i)-  onReq mb doB = ireq mb (take n' . doB)--  step n k c@(Chunk str)-      | LL.null str        = return (icont (step n k), c)-      | LL.length str <= n = (take (n - LL.length str) *** const mempty)-                             `liftM` k (Chunk str)-      | otherwise          = (idone *** const (Chunk s2)) `liftM` k (Chunk s1)+ | n' <= 0   = return iter+ | otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)+  where+    on_done od oc x _ = runIter (drop n' >> return (return x)) od oc+    on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)+                                 else runIter (liftI (step n' k)) od oc+    on_cont od oc _ (Just e) = runIter (drop n' >> throwErr e) od oc+    step n k (Chunk str)+      | LL.null str        = liftI (step n k)+      | LL.length str <= n = take (n - LL.length str) $ k (Chunk str)+      | otherwise          = idone (k (Chunk s1)) (Chunk s2)       where (s1, s2) = LL.splitAt n str-  step _n k stream       = return (idone (icont k), stream)+    step _n k stream       = idone (liftI k) stream {-# INLINE take #-}  -- |Read n elements from a stream and apply the given iteratee to the@@ -392,35 +383,32 @@ -- 4 elements to the outer stream takeUpTo :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a takeUpTo i iter- | i <= 0    = idone iter- | otherwise = runIter iter onDone onCont onErr onReq+ | i <= 0    = idone iter (Chunk empty)+ | otherwise = Iteratee $ \od oc ->+    runIter iter (onDone od oc) (onCont od oc)   where-    onDone x = idone (idone x)-    onCont k = if i == 0 then idone (icont k)-                         else icont (step i k)-    onErr i' = ierr (takeUpTo i i')-    onReq mb doB = ireq mb (takeUpTo i . doB)--    step n k c@(Chunk str)-      | LL.null str       = return (icont (step n k), c)-      | LL.length str < n = first (takeUpTo (n - LL.length str))-                            `liftM` k (Chunk str)-      | otherwise         = do+    onDone od oc x str      = runIter (idone (return x) str) od oc+    onCont od oc k Nothing  = if i == 0 then od (liftI k) (Chunk mempty)+                                 else runIter (liftI (step i k)) od oc+    onCont od oc _ (Just e) = runIter (throwErr e) od oc+    step n k (Chunk str)+      | LL.null str       = liftI (step n k)+      | LL.length str < n = takeUpTo (n - LL.length str) $ k (Chunk str)+      | otherwise         =          -- check to see if the inner iteratee has completed, and if so,          -- grab any remaining stream to put it in the outer iteratee.          -- the outer iteratee is always complete at this stage, although          -- the inner may not be.          let (s1, s2) = LL.splitAt n str-         (iter', preStr) <- k (Chunk s1)-         case preStr of-              (Chunk preC)-                | LL.null preC -> return (idone iter', Chunk s2)-                | otherwise    -> return (idone iter'-                                     , Chunk $ preC `LL.append` s2)-              -- this case shouldn't ever happen, except possibly-              -- with broken iteratees-              _                -> return (idone iter', preStr)-    step _ k stream       = return (idone (icont k), stream)+         in Iteratee $ \od' _ -> do+              res <- runIter (k (Chunk s1)) (\a s  -> return $ Left  (a, s))+                                            (\k' e -> return $ Right (k',e))+              case res of+                Left (a,Chunk s1') -> od' (return a)+                                          (Chunk $ s1' `LL.append` s2)+                Left  (a,s')       -> od' (idone a s') (Chunk s2)+                Right (k',e)       -> od' (icont k' e) (Chunk s2)+    step _ k stream       = idone (liftI k) stream {-# INLINE takeUpTo #-}  -- | Takes an element predicate and returns the (possibly empty)@@ -430,7 +418,7 @@ -- remaining stream will not satisfy the predicate. --  -- The analogue of @List.takeWhile@, see also @break@ and @takeWhileE@-takeWhile :: (Monad m, LL.ListLike s el ) => (el -> Bool) -> Iteratee s m s+takeWhile :: (LL.ListLike s el ) => (el -> Bool) -> Iteratee s m s takeWhile = break . (not .) {-# INLINEABLE takeWhile #-} @@ -439,7 +427,7 @@ --  -- This is preferred to @takeWhile@. takeWhileE- :: (LL.ListLike s el, NullPoint s, Monad m, Functor m)+ :: (LL.ListLike s el, NullPoint s)  => (el -> Bool)  -> Enumeratee s s m a takeWhileE = breakE . (not .)@@ -452,15 +440,14 @@ --  -- The analog of @List.map@ mapStream-  :: (Monad m-     ,LL.ListLike (s el) el+  :: (LL.ListLike (s el) el      ,LL.ListLike (s el') el'      ,NullPoint (s el)      ,LooseMap s el el')   => (el -> el')   -> Enumeratee (s el) (s el') m a mapStream f = mapChunks (lMap f)-{-# SPECIALIZE mapStream :: Monad m => (el -> el') -> Enumeratee [el] [el'] m a #-}+{-# SPECIALIZE mapStream :: (el -> el') -> Enumeratee [el] [el'] m a #-}  -- |Map the stream rigidly. -- @@ -468,12 +455,12 @@ -- This function is necessary for @ByteString@ and similar types -- that cannot have 'LooseMap' instances, and may be more efficient. rigidMapStream-  :: (Monad m, LL.ListLike s el, NullPoint s)+  :: (LL.ListLike s el, NullPoint s)   => (el -> el)   -> Enumeratee s s m a rigidMapStream f = mapChunks (LL.rigidMap f)-{-# SPECIALIZE rigidMapStream :: Monad m => (el -> el) -> Enumeratee [el] [el] m a #-}-{-# SPECIALIZE rigidMapStream :: Monad m => (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-}+{-# SPECIALIZE rigidMapStream :: (el -> el) -> Enumeratee [el] [el] m a #-}+{-# SPECIALIZE rigidMapStream :: (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-}   -- |Creates an 'enumeratee' with only elements from the stream that@@ -494,7 +481,7 @@   :: (LL.ListLike s el, Monad m, Nullable s)   => Int  -- ^ size of group   -> Enumeratee s [s] m a-group cksz iinit = icont (step 0 id iinit)+group cksz iinit = liftI (step 0 id iinit)  where   -- there are two cases to consider for performance purposes:   --  1 - grouping lots of small chunks into bigger chunks@@ -503,34 +490,32 @@   -- and pass them to the inner iteratee as one list.  @gsplit@ does this.   --   -- case 1 is a bit harder, need to hold onto each chunk and coalesce them-  -- after enough have been received.  Currently using a Hughes list+  -- after enough have been received.  Currently using a difference list   -- for this, i.e ([s] -> [s])   --   -- not using eneeCheckIfDone because that loses final chunks at EOF   step sz pfxd icur (Chunk s)-    | LL.null s               = return (icont (step sz pfxd icur), Chunk s)-    | LL.length s + sz < cksz = return (icont (step (sz+LL.length s)-                                             (pfxd . (s:)) icur)-                                        , mempty)+    | LL.null s               = liftI (step sz pfxd icur)+    | LL.length s + sz < cksz = liftI (step (sz+LL.length s) (pfxd . (s:)) icur)     | otherwise               =         let (full, rest) = gsplit . mconcat $ pfxd [s]             pfxd'        = if LL.null rest then id else (rest:)-            onDone x  = return (idone (idone x), Chunk rest)-            onErr i e = return (ierr (icont (step (LL.length rest) pfxd' i)) e-                                , Chunk rest)-            onCont k  = (icont . step (LL.length rest) pfxd'-                         *** const (Chunk rest))-                         `liftM` k (Chunk full)-            -- since step is a monadic function, the monadic request can be-            -- inlined, saving an indirection-            onReq mb doB = mb >>= \b ->-                           step (LL.length rest) pfxd' (doB b) (Chunk rest)-        in  runIter icur onDone onCont onErr onReq+            onDone x str = return $ Left (x,str)+            onCont k Nothing = return . Right . Left . k $ Chunk full+            onCont k e       = return . Right $ Right (liftI k, e)+        in  do+              res <- lift $ runIter icur onDone onCont+              case res of+                Left (x,str) -> idone (idone x str) (Chunk rest)+                Right (Left inext)  -> liftI $ step (LL.length rest) pfxd' inext+                Right (Right (inext, e)) -> icont (step (LL.length rest)+                                                        pfxd' inext)+                                                  e   step _ pfxd icur mErr = case pfxd [] of-                         []   -> return (idone icur, mErr)-                         rest -> ((, mErr) . idone) `liftM`-                                 enumPure1Chunk [mconcat rest] icur-+                         []   -> idone icur mErr+                         rest -> do+                           inext <- lift $ enumPure1Chunk [mconcat rest] icur+                           idone inext mErr   gsplit ls = case LL.splitAt cksz ls of     (g, rest) | LL.null rest -> if LL.length g == cksz                                    then ([g], LL.empty)@@ -545,10 +530,10 @@ --  -- The analogue of 'List.groupBy' groupBy-  :: forall s el m a. (LL.ListLike s el, Monad m, Nullable s)+  :: (LL.ListLike s el, Monad m, Nullable s)   => (el -> el -> Bool)   -> Enumeratee s [s] m a-groupBy same iinit = icont $ go iinit (const True, id)+groupBy same iinit = liftI $ go iinit (const True, id)   where      -- As in group, need to handle grouping efficiently when we're fed     -- many small chunks.@@ -562,29 +547,24 @@     -- unless the stream was entirely empty and there is no     -- accumulator.     go icurr pfx (Chunk s) = case gsplit pfx s of-      ([], partial)   -> return (icont $ go icurr partial, mempty)-      (full, partial) ->+      ([], partial)   -> liftI $ go icurr partial+      (full, partial) -> do         -- if the inner iteratee is done, the outer iteratee needs to be         -- notified to terminate.         -- if the inner iteratee is in an error state, that error should         -- be lifted to the outer iteratee-        let onCont k = k (Chunk full) >>= \(inext, str') ->-                         case str' of-                           Chunk rest -> return (icont $ go inext partial-                                           , Chunk $ mconcat rest)-                           EOF mex -> return (icont $ go inext partial, EOF mex)-            onErr inext e = return (ierr (icont (go inext partial)) e-                                    , EOF (Just e))-            onDone :: a -> m (Iteratee s m (Iteratee [s] m a), Stream s)-            onDone a      = return (idone (idone a)-                                    , Chunk . mconcat $ snd partial [])-            onReq mb doB  = mb >>= \b -> go (doB b) pfx (Chunk s)-        in runIter icurr onDone onCont onErr onReq+        let onCont k Nothing = return $ Right $ Left $ k $ Chunk full+            onCont k e       = return $ Right $ Right (liftI k, e)+            onDone x str     = return $ Left (x,str)+        res <- lift $ runIter icurr onDone onCont+        case res of+          Left (x,str) -> idone (idone x str) (Chunk (mconcat $ snd partial []))+          Right (Left inext)      -> liftI $ go inext partial+          Right (Right (inext,e)) -> icont (go inext partial) e     go icurr (_inpfx, pfxd) (EOF mex) = case pfxd [] of-      [] -> ((,EOF mex) . idone) `liftM` enumChunk (EOF mex) icurr-      rest -> ((,EOF mex) . idone) `liftM`-               (enumPure1Chunk [mconcat rest] icurr >>= enumChunk (EOF mex))-+      [] -> lift . enumChunk (EOF mex) $ icurr+      rest -> do inext <- lift . enumPure1Chunk [mconcat rest] $ icurr+                 lift . enumChunk (EOF mex) $ inext     -- Here, gsplit carries an accumulator consisting of a predicate     -- "inpfx" that indicates whether a new element belongs in the     -- growing group, and a difference list to ultimately generate the@@ -624,7 +604,7 @@                                       in ( gdone, (same (LL.head glast), (glast :)) )     llGroupBy eq l -- Copied from Data.ListLike, avoid spurious (Eq el) constraint       | LL.null l = []-      | otherwise = LL.cons x ys : llGroupBy eq zs+      | otherwise = (LL.cons x ys):(llGroupBy eq zs)         where (ys, zs) = LL.span (eq x) xs               x = LL.head l               xs = LL.tail l@@ -708,16 +688,16 @@ --  -- The analogue of @List.foldl@ foldl-  :: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)+  :: (LL.ListLike s el, FLL.FoldableLL s el)   => (a -> el -> a)   -> a   -> Iteratee s m a-foldl f i = icontP (step i)+foldl f i = liftI (step i)   where-    step acc c@(Chunk xs)-      | LL.null xs  = (icontP (step acc), c)-      | otherwise   = (icontP (step $ FLL.foldl f acc xs), mempty)-    step acc stream = (idone acc, stream)+    step acc (Chunk xs)+      | LL.null xs  = liftI (step acc)+      | otherwise   = liftI (step $ FLL.foldl f acc xs)+    step acc stream = idone acc stream {-# INLINE foldl #-}  @@ -726,16 +706,16 @@ --  -- The analogue of @List.foldl'@. foldl'-  :: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)+  :: (LL.ListLike s el, FLL.FoldableLL s el)   => (a -> el -> a)   -> a   -> Iteratee s m a-foldl' f i = icontP (step i)+foldl' f i = liftI (step i)   where-    step acc c@(Chunk xs)-      | LL.null xs  = (icontP (step acc), c)-      | otherwise   = (icontP (step $! FLL.foldl' f acc xs), mempty)-    step acc stream = (idone acc, stream)+    step acc (Chunk xs)+      | LL.null xs = liftI (step acc)+      | otherwise  = liftI (step $! FLL.foldl' f acc xs)+    step acc stream = idone acc stream {-# INLINE foldl' #-}  -- | Variant of foldl with no base case.  Requires at least one element@@ -743,55 +723,53 @@ --  -- The analogue of @List.foldl1@. foldl1-  :: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)+  :: (LL.ListLike s el, FLL.FoldableLL s el)   => (el -> el -> el)   -> Iteratee s m el-foldl1 f = icontP step+foldl1 f = liftI step   where-    step c@(Chunk xs)+    step (Chunk xs)     -- After the first chunk, just use regular foldl.-      | LL.null xs = (icontP step, c)-      | otherwise  = (foldl f $ FLL.foldl1 f xs, mempty)-    step stream    = (ierr (icontP step) $ toException EofException-                      , stream)+      | LL.null xs = liftI step+      | otherwise  = foldl f $ FLL.foldl1 f xs+    step stream    = icont step (Just (setEOF stream)) {-# INLINE foldl1 #-}   -- | Strict variant of 'foldl1'. foldl1'-  :: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)+  :: (LL.ListLike s el, FLL.FoldableLL s el)   => (el -> el -> el)   -> Iteratee s m el-foldl1' f = icontP step+foldl1' f = liftI step   where-    step c@(Chunk xs)+    step (Chunk xs)     -- After the first chunk, just use regular foldl'.-      | LL.null xs = (icontP step, c)-      | otherwise  = (foldl' f $ FLL.foldl1 f xs, mempty)-    step stream    = (ierr (icontP step) $ toException EofException-                      , stream)+      | LL.null xs = liftI step+      | otherwise  = foldl' f $ FLL.foldl1 f xs+    step stream    = icont step (Just (setEOF stream)) {-# INLINE foldl1' #-}   -- | Sum of a stream.-sum :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el-sum = icontP (step 0)+sum :: (LL.ListLike s el, Num el) => Iteratee s m el+sum = liftI (step 0)   where-    step acc c@(Chunk xs)-      | LL.null xs = (icontP (step acc), c)-      | otherwise  = (icontP (step $! acc + LL.sum xs), mempty)-    step acc str   = (idone acc, str)+    step acc (Chunk xs)+      | LL.null xs = liftI (step acc)+      | otherwise  = liftI (step $! acc + LL.sum xs)+    step acc str   = idone acc str {-# INLINE sum #-}   -- | Product of a stream.-product :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el-product = icontP (step 1)+product :: (LL.ListLike s el, Num el) => Iteratee s m el+product = liftI (step 1)   where-    step acc c@(Chunk xs)-      | LL.null xs = (icontP (step acc), c)-      | otherwise  = (icontP (step $! acc * LL.product xs), mempty)-    step acc str   = (idone acc, str)+    step acc (Chunk xs)+      | LL.null xs = liftI (step acc)+      | otherwise  = liftI (step $! acc * LL.product xs)+    step acc str   = idone acc str {-# INLINE product #-}  @@ -799,37 +777,63 @@ -- Zips  -- |Enumerate two iteratees over a single stream simultaneously.+--  Deprecated, use `Data.Iteratee.ListLike.zip` instead. -- +-- Compare to @zip@.+{-# DEPRECATED enumPair "use Data.Iteratee.ListLike.zip" #-}+enumPair+  :: (Monad m, Nullable s, LL.ListLike s el)+  => Iteratee s m a+  -> Iteratee s m b+  -> Iteratee s m (a, b)+enumPair = zip++-- |Enumerate two iteratees over a single stream simultaneously.+--  -- Compare to @List.zip@. zip   :: (Monad m, Nullable s, LL.ListLike s el)   => Iteratee s m a   -> Iteratee s m b   -> Iteratee s m (a, b)-zip x0 y0 = runIter x0 (odx y0) (ocx y0) (oex y0) (orx y0)- where-  odx yIter a      = (a, ) `liftM` yIter-  ocx yIter k      = runIter yIter (ody k) (ocy k) (oey k) (ory k)-  oex yIter i' e   = throwRec e (zip i' yIter)-  orx yIter ma doA = ireq ma $ (`zip` yIter) . doA+zip x0 y0 = do+    -- need to check if both iteratees are initially finished.  If so,+    -- we don't want to push a chunk which will be dropped+    (a', x') <- lift $ runIter x0 od oc+    (b', y') <- lift $ runIter y0 od oc+    case checkDone a' b' of+      Just (Right (a,b,s))  -> idone (a,b) s  -- 's' may be EOF, needs to stay+      Just (Left (Left a))  -> liftM (a,) y'+      Just (Left (Right b)) -> liftM (,b) x'+      Nothing               -> liftI (step x' y')+  where+    step x y (Chunk xs) | nullC xs = liftI (step x y)+    step x y (Chunk xs) = do+      (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x+      (b', y') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs y+      case checkDone a' b' of+        Just (Right (a,b,s))  -> idone (a,b) s+        Just (Left (Left a))  -> liftM (a,) y'+        Just (Left (Right b)) -> liftM (,b) x'+        Nothing               -> liftI (step x' y')+    step x y (EOF err) = joinIM $ case err of+      Nothing -> (liftM2.liftM2) (,) (enumEof   x) (enumEof   y)+      Just e  -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y) -  ody x_k b        = (,b) `liftM` icont x_k-  ocy xK yK        = icont (step xK yK)-  oey xK i' e      = throwRec e (zip (icont xK) i')-  ory xK mb doB    = ireq mb (zip (icont xK) . doB)+    od a s = return (Just (a, s), idone a s)+    oc k e = return (Nothing    , icont k e) -  step xK yK (Chunk xs) | nullC xs = return (icont (step xK yK), Chunk xs)-  step xK yK str   = do-    (x,xLeft) <- xK str-    (y,yLeft) <- yK str-    return (zip x y, shorter xLeft yLeft)+    checkDone r1 r2 = case (r1, r2) of+      (Just (a, s1), Just (b,s2)) -> Just $ Right (a, b, shorter s1 s2)+      (Just (a, _), Nothing)      -> Just . Left $ Left a+      (Nothing, Just (b, _))      -> Just . Left $ Right b+      (Nothing, Nothing)          -> Nothing -  shorter c1@(Chunk xs) c2@(Chunk ys)-    | LL.length xs < LL.length ys = c1-    | otherwise                   = c2-  shorter e@(EOF _)  _         = e-  shorter _          e@(EOF _) = e-  +    shorter c1@(Chunk xs) c2@(Chunk ys)+      | LL.length xs < LL.length ys = c1+      | otherwise                   = c2+    shorter e@(EOF _)  _         = e+    shorter _          e@(EOF _) = e {-# INLINE zip #-}  zip3@@ -871,23 +875,37 @@   => Iteratee s m a   -> Iteratee s m b   -> Iteratee s m (a, b)-enumWith x0 y0 = runIter x0 (odx y0) (ocx y0) (oex y0) (orx y0)- where-  odx yIter a      = (a,) `liftM` joinIM (enumEof yIter)-  ocx yIter k      = runIter yIter (ody k) (ocy k) (oey k) (ory k)-  oex yIter i' e   = throwRec e (enumWith i' yIter)-  orx yIter ma doA = ireq ma $ (`enumWith` yIter) . doA+enumWith i1 i2 = do+    -- as with zip, first check to see if the initial iteratee is complete,+    -- otherwise data would be dropped.+    -- running the second iteratee as well to prevent a monadic effect mismatch+    -- although I think that would be highly unlikely to happen in common+    -- code+    (a', x') <- lift $ runIter i1 od oc+    (_,  y') <- lift $ runIter i2 od oc+    case a' of+      Just (a, s) -> flip idone s =<< lift (liftM (a,) $ run i2)+      Nothing     -> go x' y'+  where+    od a s = return (Just (a, s), idone a s)+    oc k e = return (Nothing    , icont k e) -  ody x_k b        = (,b) `liftM` icont x_k-  ocy xK yK        = icont (step xK yK)-  oey xK i' e      = throwRec e (enumWith (icont xK) i')-  ory xK mb doB    = ireq mb (enumWith (icont xK) . doB)+    getUsed xs (Chunk ys) = LL.take (LL.length xs - LL.length ys) xs+    getUsed xs (EOF _)    = xs -  step xK yK (Chunk xs) | nullC xs = return (icont (step xK yK), Chunk xs)-  step xK yK str = do-    (x, xLeft) <- xK str-    (y,_yLeft) <- yK str-    return (enumWith x y, xLeft)+    go x y = liftI step+      where+        step (Chunk xs) | nullC xs = liftI step+        step (Chunk xs) = do+          (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x+          case a' of+            Just (a, s) -> do+              b <- lift $ run =<< enumPure1Chunk (getUsed xs s) y+              idone (a, b) s+            Nothing        -> lift (enumPure1Chunk xs y) >>= go x'+        step (EOF err) = joinIM $ case err of+          Nothing -> (liftM2.liftM2) (,) (enumEof   x) (enumEof   y)+          Just e  -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y) {-# INLINE enumWith #-}  -- |Enumerate a list of iteratees over a single stream simultaneously@@ -896,38 +914,42 @@ --  -- Compare to @Prelude.sequence_@. sequence_-  :: forall el s m a. (Monad m, LL.ListLike s el, Nullable s)+  :: (Monad m, LL.ListLike s el, Nullable s)   => [Iteratee s m a]   -> Iteratee s m ()-sequence_ = check []+sequence_ = self   where-    -- recursively checks each input iteratee to see if it's finished.-    -- all of the unfinished iteratees are run with a single chunk,-    -- then checked again.+    self is = liftI step+      where+        step (Chunk xs) | LL.null xs = liftI step+        step s@(Chunk _) = do+          -- give a chunk to each iteratee+          is'  <- lift $ mapM (enumChunk s) is+          -- filter done iteratees+          (done, notDone) <- lift $ partition fst `liftM` mapM enumCheckIfDone is'+          if Prelude.null notDone+            then idone () <=< remainingStream $ map snd done+            else self $ map snd notDone+        step s@(EOF _) = do+          s' <- remainingStream <=< lift $ mapM (enumChunk s) is+          case s' of+            EOF (Just e) -> throwErr e+            _            -> idone () s' -    -- a possible inefficiency is if multiple iteratees are in the-    -- Request state (monadic action), as each request is fed to the-    -- enumerator separately.  An alternative implementation would aggregate-    -- all monadic effects (as this version aggregates all continuations)-    -- to perform them at once.-    check [] [] = idone ()-    check ks [] = icont (step ks)-    check ks (i:iters) = runIter i (\_ -> check ks iters)-                                   (onCont ks iters)-                                   (onErr ks iters)-                                   (onReq ks iters)-    onCont ks iters k  = check (k:ks) iters-    onErr ks iters i e = throwRec e (check ks (i:iters))-    onReq :: [Stream s -> m (Iteratee s m a, Stream s)]-          -> [Iteratee s m a]-          -> m b-          -> (b -> Iteratee s m a)-          -> Iteratee s m ()-    onReq ks iters mb doB = ireq mb (\b -> check ks (doB b:iters))+    -- returns the unconsumed part of the stream; "sequence_ is" consumes as+    -- much of the stream as the iteratee in is that consumes the most; e.g.+    -- sequence_ [I.head, I.last] consumes whole stream+    remainingStream+      :: (Monad m, Nullable s, LL.ListLike s el)+      => [Iteratee s m a] -> Iteratee s m (Stream s)+    remainingStream is = lift $+      return . Prelude.foldl1 shorter <=< mapM (\i -> runIter i od oc) $ is+      where+        od _ s = return s+        oc _ e = return $ case e of+          Nothing -> mempty+          _       -> EOF e -    step ks str = first (check []) `liftM` CM.foldM (accf str) ([], str) ks-    accf str (iS, !strs) k = ((:iS) *** flip shorter strs) `liftM` k str-           -- return the shorter one of two streams; errors are propagated with the     -- priority given to the "left"     shorter c1@(Chunk xs) c2@(Chunk ys)@@ -943,26 +965,20 @@                  (Monad m, LL.ListLike s el, Nullable s, Integral n) =>                  Iteratee s m a               -> Iteratee s m (a, n)-countConsumed = check 0+countConsumed i = go 0 (const i) (Chunk empty)   where-    newLen :: n -> s -> s -> n-    newLen n c c' = n + fromIntegral (LL.length c - LL.length c')-    check :: n -> Iteratee s m a -> Iteratee s m (a,n)-    check !n iter = runIter iter (onDone n)-                                 (onCont n)-                                 (onErr n)-                                 (onReq n)-    step !n k str@(Chunk c) = k str >>= \res -> return $ case res of-      (i, Chunk c')            -> (check (newLen n c c') i, Chunk c')-      (i, str'@(EOF (Just e))) -> (throwRec e (check (newLen n c mempty) i)-                                   , str')-      (i, str')                -> (throwRec EofException-                                            (check (newLen n c mempty) i), str')-    step n k str = first (liftM (,n)) `liftM` k str-    onDone n a  = idone (a,n)-    onCont n k  = icont (step n k)-    onErr n i e = throwRec e (check n i)-    onReq n mb doB = ireq mb (check n . doB)+    go :: n -> (Stream s -> Iteratee s m a) -> Stream s+       -> Iteratee s m (a, n)+    go !n f str@(EOF _) = (, n) `liftM` f str+    go !n f str@(Chunk c) = Iteratee rI+      where+        newLen = n + fromIntegral (LL.length c)+        rI od oc = runIter (f str) onDone onCont+          where+            onDone a str'@(Chunk c') =+                od (a, newLen - fromIntegral (LL.length c')) str'+            onDone a str'@(EOF _) = od (a, n) str'+            onCont f' mExc = oc (go newLen f') mExc {-# INLINE countConsumed #-}  -- ------------------------------------------------------------------------@@ -978,13 +994,56 @@   where     enum' str' iter'       | LL.null str' = return iter'-      | otherwise    = let (s1, s2)     = LL.splitAt n str'-                           onCont k     = k (Chunk s1) >>= enum' s2 . fst-                           onErr i' e   = return $ ierr i' e-                           onReq mb doB = mb >>= enum' str' . doB-                       in runIter iter' idoneM onCont onErr onReq+      | otherwise    = let (s1, s2) = LL.splitAt n str'+                           on_cont k Nothing = enum' s2 . k $ Chunk s1+                           on_cont k e = return $ icont k e+                       in runIter iter' idoneM on_cont {-# INLINE enumPureNChunk #-} +-- | Convert an iteratee to a \"greedy\" version.+--+-- When a chunk is received, repeatedly run the input iteratee+-- until the entire chunk is consumed, then the outputs+-- are combined (via 'mconcat').+--+-- > > let l = [1..5::Int]+-- > > run =<< enumPure1Chunk l (joinI (take 2 stream2list))+-- > [1,2]+-- > > run =<< enumPure1Chunk l (greedy $ joinI (I.take 2 stream2list))+-- > [1,2,3,4,5]+--+-- Note that a greedy iteratee will consume the entire input chunk and force+-- the next chunk before returning a value.  A portion of the second chunk may+-- be consumed.+-- +-- 'greedy' may be useful on the first parameter of 'convStream', e.g.+-- +-- > convStream (greedy someIter)+--+-- to create more efficient converters.+greedy ::+ (Monad m, Functor m, LL.ListLike s el', Monoid a) =>+  Iteratee s m a+  -> Iteratee s m a+greedy iter' = liftI (step [] iter')+ where+  step acc iter (Chunk str)+    | LL.null str = liftI (step acc iter)+    | otherwise   = joinIM $ do+      i2 <- enumPure1Chunk str iter+      result <- runIter i2 (\a s -> return $ Left (a,s))+                           (\k e -> return $ Right (icont k e))+      case result of+        Left (a, Chunk resS)+          | LL.null resS+              || LL.length resS == LL.length str -> return $+                         idone (mconcat $ reverse (a:acc)) (Chunk resS)+        Left (a, stream) -> return $ step (a:acc) iter stream+        Right i -> return $ fmap (mconcat . reverse . (:acc)) i+  step acc iter stream = joinIM $+    enumChunk stream (fmap (mconcat . reverse . (:acc)) iter)+{-# INLINE greedy #-}+ -- ------------------------------------------------------------------------ -- Monadic functions @@ -994,11 +1053,11 @@   :: (Monad m, LL.ListLike s el, Nullable s)   => (el -> m b)   -> Iteratee s m ()-mapM_ f = icont step+mapM_ f = liftI step   where-    step c@(Chunk xs) | LL.null xs = return (icont step, c)-    step (Chunk xs) = LL.mapM_ f xs >> return (icont step, mempty)-    step s@(EOF _)  = return (idone (), s)+    step (Chunk xs) | LL.null xs = liftI step+    step (Chunk xs) = lift (LL.mapM_ f xs) >> liftI step+    step s@(EOF _)  = idone () s {-# INLINE mapM_ #-}  -- |The analogue of @Control.Monad.foldM@@@ -1007,10 +1066,11 @@   => (a -> b -> m a)   -> a   -> Iteratee s m a-foldM f e = icont (step e)+foldM f e = liftI step   where-    step acc c@(Chunk xs) | LL.null xs = return (icont (step acc), c)-    step acc (Chunk xs) = CM.foldM f acc (LL.toList xs) >>= \acc' ->-                            return (icont (step acc'), mempty)-    step acc stream     = return (idone acc, stream)+    step (Chunk xs) | LL.null xs = liftI step+    step (Chunk xs) = do+        x <- lift $ f e (LL.head xs)+        joinIM $ enumPure1Chunk (LL.tail xs) (foldM f x)+    step (EOF _) = return e {-# INLINE foldM #-}

@@ -1,6 +1,9 @@-{-# LANGUAGE RankNTypes+{-# LANGUAGE KindSignatures+            ,RankNTypes             ,FlexibleContexts-            ,ScopedTypeVariables #-}+            ,ScopedTypeVariables+            ,BangPatterns+            ,DeriveDataTypeable #-}  -- | Enumeratees - pass terminals variant. -- @@ -23,12 +26,12 @@ -- In certain cases, this is not the desired behavior.  Consider: --  -- > consumer :: Iteratee String IO ()--- > consumer = icont (go 0)+-- > consumer = liftI (go 0) -- >   where--- >     go c (Chunk xs) = liftIO (putStr s) >> icont (go c)+-- >     go c (Chunk xs) = liftIO (putStr s) >> liftI (go c) -- >     go 10 e         = liftIO (putStr "10 loops complete") -- >                         >> idone () (Chunk "")--- >     go n  e         = I.seek 0 >> icont (go (n+1))+-- >     go n  e         = I.seek 0 >> liftI (go (n+1)) -- -- The @consumer@ iteratee does not complete until after it has received  -- 10 @EOF@s.  If you attempt to use it in a standard enumeratee, it will@@ -66,17 +69,14 @@  import qualified Data.ListLike as LL -import           Control.Arrow ((***), first)+import           Control.Applicative ((<$>))+import           Control.Exception import           Control.Monad.Trans.Class-import           Control.Monad  import qualified Data.ByteString as B import           Data.Monoid import           Data.Word (Word8) -(<$>) :: Monad m => (a1 -> r) -> m a1 -> m r-(<$>) = liftM- -- --------------------------------------------------- -- The converters show a different way of composing two iteratees: -- `vertical' rather than `horizontal'@@ -85,14 +85,11 @@ --  -- A version of 'mapChunks' that sends 'EOF's to the inner iteratee. -- -mapChunksPT :: (NullPoint s, Monad m) => (s -> s') -> Enumeratee s s' m a-mapChunksPT f = go+mapChunksPT :: (NullPoint s) => (s -> s') -> Enumeratee s s' m a+mapChunksPT f = eneeCheckIfDonePass (icont . step)  where-  go = eneeCheckIfDonePass (icont . step)-  step k (Chunk xs) = k (Chunk (f xs)) >>= \(i',_) ->-                          return (go i', Chunk empty)-  step k (EOF mErr) = k (EOF mErr) >>= (\(i',_) ->-                          return (go i' , EOF mErr))+  step k (Chunk xs) = eneeCheckIfDonePass (icont . step) . k . Chunk $ f xs+  step k (EOF mErr) = eneeCheckIfDonePass (icont . step) . k $ EOF mErr {-# INLINE mapChunksPT #-}  -- | Convert a stream of @s@ to a stream of @s'@ using the supplied function.@@ -102,13 +99,11 @@   :: (Monad m, NullPoint s, Nullable s)   => (s -> m s')   -> Enumeratee s s' m a-mapChunksMPT f = go+mapChunksMPT f = eneeCheckIfDonePass (icont . step)  where-  go = eneeCheckIfDonePass (icont . step)-  step k (Chunk xs) = f xs >>= k . Chunk >>= \(i', _str) ->-                          return (go i', Chunk empty)-  step k (EOF mErr) = k (EOF mErr) >>= \(i',_) ->-                          return (go i', EOF mErr)+  step k (Chunk xs) = lift (f xs) >>=+                        eneeCheckIfDonePass (icont . step) . k . Chunk+  step k (EOF mErr) = eneeCheckIfDonePass (icont . step) . k $ EOF mErr {-# INLINE mapChunksMPT #-}  -- |Convert one stream into another, not necessarily in lockstep.@@ -121,11 +116,13 @@ convStreamPT fi = go   where     go = eneeCheckIfDonePass check-    check k = isStreamFinished >>= maybe (step k)+    check k (Just e) = throwRecoverableErr e (const identity)+                       >> go (k $ Chunk empty)+    check k _ = isStreamFinished >>= maybe (step k)                   (\e -> case fromException e of-                    Just EofException -> lift (k (EOF Nothing))  >>= go . fst-                    Nothing           -> lift (k (EOF (Just e))) >>= go . fst)-    step k = fi >>= lift . k . Chunk >>= go . fst+                    Just EofException -> go . k $ EOF Nothing+                    Nothing -> go . k . EOF $ Just e)+    step k = fi >>= go . k . Chunk {-# INLINABLE convStreamPT #-}  -- |The most general stream converter.@@ -139,38 +136,42 @@ unfoldConvStreamPT f acc0 = go acc0   where     go acc = eneeCheckIfDonePass (check acc)-    check acc k = isStreamFinished >>= maybe (step acc k)+    check acc k (Just e) = throwRecoverableErr e (const identity)+                           >> go acc (k $ Chunk empty)+    check acc k _ = isStreamFinished >>= maybe (step acc k)                       (\e -> case fromException e of-                        Just EofException -> lift (k (EOF Nothing))-                                              >>= go acc . fst-                        Nothing -> lift (k (EOF (Just e)))-                                     >>= go acc . fst )-    step acc k = f acc-                   >>= \(acc',s') -> lift (k (Chunk s'))-                     >>= go acc' . fst-{-# INLINABLE unfoldConvStreamPT #-}+                        Just EofException -> go acc . k $ EOF Nothing+                        Nothing -> go acc . k . EOF $ Just e)+    step acc k = f acc >>= \(acc', s') -> go acc' . k $ Chunk s'+{-+    check acc k _ = isStreamFinished >>=+                    maybe (step acc k) (idone (liftI k) . EOF . Just)+    step acc k = f acc >>= \(acc', s') ->+                    go acc' . k . Chunk $ s'+-}  -- | A version of 'unfoldConvStreamCheck' that sends 'EOF's -- to the inner iteratee. unfoldConvStreamCheckPT   :: (Monad m, Nullable elo)-  => ((Cont eli m a -> Iteratee elo m (Iteratee eli m a))+  => (((Stream eli -> Iteratee eli m a)+        -> Maybe SomeException+        -> Iteratee elo m (Iteratee eli m a)+      )       -> Enumeratee elo eli m a      )   -> (acc -> Iteratee elo m (acc, eli))   -> acc   -> Enumeratee elo eli m a-unfoldConvStreamCheckPT checkDone f acc0 = go acc0+unfoldConvStreamCheckPT checkDone f acc0 = checkDone (check acc0)   where-    go acc = checkDone (check acc)-    check acc k = isStreamFinished >>= maybe (step acc k)-                      (\e -> case fromException e of-                        Just EofException -> lift (k (EOF Nothing))-                                              >>= go acc . fst-                        Nothing -> lift (k (EOF (Just e))) >>= go acc . fst )-    step acc k = do-      (acc',s') <- f acc-      lift (k (Chunk s')) >>= go acc' . fst+    check acc k mX = step acc k mX+    step acc k Nothing = f acc >>= \(acc', s') ->+                  (checkDone (check acc') . k $ Chunk s')+    step acc k (Just ex) = throwRecoverableErr ex $ \str' ->+      let i = f acc >>= \(acc', s') ->+                           (checkDone (check acc') . k $ Chunk s')+      in joinIM $ enumChunk str' i {-# INLINABLE unfoldConvStreamCheckPT #-}  -- -------------------------------------@@ -178,19 +179,18 @@  -- | A variant of 'Data.Iteratee.ListLike.breakE' that passes 'EOF's. breakEPT-  :: (LL.ListLike s el, NullPoint s, Monad m)+  :: (LL.ListLike s el, NullPoint s)   => (el -> Bool)   -> Enumeratee s s m a-breakEPT cpred = go+breakEPT cpred = eneeCheckIfDonePass (icont . step)  where-  go = eneeCheckIfDonePass (icont . step)-  step k s'@(Chunk s)-      | LL.null s  = return (icont (step k), s')+  step k (Chunk s)+      | LL.null s  = liftI (step k)       | otherwise  = case LL.break cpred s of         (str', tail')-          | LL.null tail' -> (go *** const mempty) <$> k (Chunk str')-          | otherwise     -> (idone *** const (Chunk tail')) <$> k (Chunk str')-  step k stream           =  (idone *** const stream) <$> k stream+          | LL.null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'+          | otherwise     -> idone (k $ Chunk str') (Chunk tail')+  step k stream           =  idone (k stream) stream {-# INLINE breakEPT #-}  -- | A variant of 'Data.Iteratee.ListLike.take' that passes 'EOF's.@@ -199,61 +199,55 @@   => Int   -- ^ number of elements to consume   -> Enumeratee s s m a takePT n' iter-  | n' <= 0   = return iter-  | otherwise = runIter iter onDone onCont onErr onReq- where-  onDone x = drop n' >> idone (idone x)-  onCont k = if n' == 0 then idone (icont k)-                else icont (step n' k)-  onErr i  = ierr (takePT n' i)-  onReq mb doB = ireq mb (takePT n' . doB)--  step n k c@(Chunk str)-      | LL.null str        = return (icont (step n k), c)-      | LL.length str <= n = (takePT (n - LL.length str) *** const mempty)-                             <$> k (Chunk str)-      | otherwise          = (idone *** const (Chunk s2)) <$> k (Chunk s1)+ | n' <= 0   = return iter+ | otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)+  where+    on_done od oc x _ = runIter (drop n' >> return (return x)) od oc+    on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)+                                 else runIter (liftI (step n' k)) od oc+    on_cont od oc _ (Just e) = runIter (drop n' >> throwErr e) od oc+    step n k (Chunk str)+      | LL.null str        = liftI (step n k)+      | LL.length str <= n = takePT (n - LL.length str) $ k (Chunk str)+      | otherwise          = idone (k (Chunk s1)) (Chunk s2)       where (s1, s2) = LL.splitAt n str-  step _n k stream       = (idone *** const stream) <$> k stream+    step _n k stream       = idone (k stream) stream {-# INLINE takePT #-}  -- | A variant of 'Data.Iteratee.ListLike.takeUpTo' that passes 'EOF's. takeUpToPT :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a takeUpToPT i iter- | i <= 0    = idone iter- | otherwise = runIter iter onDone onCont onErr onReq+ | i <= 0    = idone iter (Chunk empty)+ | otherwise = Iteratee $ \od oc ->+    runIter iter (onDone od oc) (onCont od oc)   where-    onDone x = idone (idone x)-    onCont k = if i == 0 then idone (icont k)-                         else icont (step i k)-    onErr i' = ierr (takeUpToPT i i')-    onReq mb doB = ireq mb (takeUpToPT i . doB)--    step n k c@(Chunk str)-      | LL.null str       = return (icont (step n k), c)-      | LL.length str < n = first (takeUpToPT (n - LL.length str))-                            <$> k (Chunk str)-      | otherwise         = do+    onDone od oc x str      = runIter (idone (return x) str) od oc+    onCont od oc k Nothing  = if i == 0 then od (liftI k) (Chunk mempty)+                                 else runIter (liftI (step i k)) od oc+    onCont od oc _ (Just e) = runIter (throwErr e) od oc+    step n k (Chunk str)+      | LL.null str       = liftI (step n k)+      | LL.length str < n = takeUpToPT (n - LL.length str) $ k (Chunk str)+      | otherwise         =          -- check to see if the inner iteratee has completed, and if so,          -- grab any remaining stream to put it in the outer iteratee.          -- the outer iteratee is always complete at this stage, although          -- the inner may not be.          let (s1, s2) = LL.splitAt n str-         (iter', preStr) <- k (Chunk s1)-         case preStr of-              (Chunk preC)-                | LL.null preC -> return (idone iter', Chunk s2)-                | otherwise    -> return (idone iter'-                                     , Chunk $ preC `LL.append` s2)-              -- this case shouldn't ever happen, except possibly-              -- with broken iteratees-              _                -> return (idone iter', preStr)-    step _ k stream       = (idone *** const stream) <$> k stream+         in Iteratee $ \od' _ -> do+              res <- runIter (k (Chunk s1)) (\a s  -> return $ Left  (a, s))+                                            (\k' e -> return $ Right (k',e))+              case res of+                Left (a,Chunk s1') -> od' (return a)+                                          (Chunk $ s1' `LL.append` s2)+                Left  (a,s')       -> od' (idone a s') (Chunk s2)+                Right (k',e)       -> od' (icont k' e) (Chunk s2)+    step _ k stream       = idone (k stream) stream {-# INLINE takeUpToPT #-}  -- | A variant of 'Data.Iteratee.ListLike.takeWhileE' that passes 'EOF's. takeWhileEPT- :: (LL.ListLike s el, NullPoint s, Monad m)+ :: (LL.ListLike s el, NullPoint s)  => (el -> Bool)  -> Enumeratee s s m a takeWhileEPT = breakEPT . (not .)@@ -264,25 +258,24 @@   :: (LL.ListLike (s el) el      ,LL.ListLike (s el') el'      ,NullPoint (s el)-     ,Monad m      ,LooseMap s el el')   => (el -> el')   -> Enumeratee (s el) (s el') m a mapStreamPT f = mapChunksPT (lMap f)-{-# SPECIALIZE mapStreamPT :: Monad m => (el -> el') -> Enumeratee [el] [el'] m a #-}+{-# SPECIALIZE mapStreamPT :: (el -> el') -> Enumeratee [el] [el'] m a #-}  -- | A variant of 'Data.Iteratee.ListLike.rigidMapStream' that passes 'EOF's. rigidMapStreamPT-  :: (LL.ListLike s el, Monad m, NullPoint s)+  :: (LL.ListLike s el, NullPoint s)   => (el -> el)   -> Enumeratee s s m a rigidMapStreamPT f = mapChunksPT (LL.rigidMap f)-{-# SPECIALIZE rigidMapStreamPT :: Monad m => (el -> el) -> Enumeratee [el] [el] m a #-}-{-# SPECIALIZE rigidMapStreamPT :: Monad m => (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-}+{-# SPECIALIZE rigidMapStreamPT :: (el -> el) -> Enumeratee [el] [el] m a #-}+{-# SPECIALIZE rigidMapStreamPT :: (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m a #-}  -- | A variant of 'Data.Iteratee.ListLike.filter' that passes 'EOF's. filterPT-  :: (Monad m, Nullable s, LL.ListLike s el)+  :: (Monad m, Functor m, Nullable s, LL.ListLike s el)   => (el -> Bool)   -> Enumeratee s s m a filterPT p = convStreamPT (LL.filter p <$> getChunk)

@@ -1,4 +1,4 @@-{-# LANGUAGE NoMonomorphismRestriction, BangPatterns, ScopedTypeVariables #-}+{-# LANGUAGE NoMonomorphismRestriction, BangPatterns #-}  module Data.Iteratee.Parallel (   psequence_@@ -33,15 +33,15 @@ -- parallel Iteratee: E0,   E1,  E2,       .. Ez --                 \_ I0\_ I1\_ .. Iy\__ Iz -- -parI :: forall s a. (Nullable s, Monoid s) => Iteratee s IO a -> Iteratee s IO a-parI = icont . firstStep+parI :: (Nullable s, Monoid s) => Iteratee s IO a -> Iteratee s IO a+parI = liftI . firstStep   where-    -- first step, here we fork separate thread for the next chain and at the+    -- first step, here we fork separete thread for the next chain and at the     -- same time ask for more date from the previous chain     firstStep iter chunk = do         var <- liftIO newEmptyMVar         _   <- sideStep var chunk iter-        return (icont $ go var, mempty)+        liftI $ go var      -- somewhere in the middle, we are getting iteratee from previous step,     -- feeding it with some new data, asking for more data and starting@@ -49,25 +49,19 @@     go var chunk@(Chunk _) = do         iter <- liftIO $ takeMVar var         _    <- sideStep var chunk iter-        return (icont $ go var, mempty)+        liftI $ go var      -- final step - no more data, so  we need to inform our consumer about it     go var e = do         iter <- liftIO $ takeMVar var-        return (join . lift $ enumChunk e iter, e)+        join . lift $ enumChunk e iter      -- forks away from the main computation, return results via MVar-    sideStep var chunk iter = liftIO . forkIO-            $ runIter iter onDone onCont onErr onReq+    sideStep var chunk iter = liftIO . forkIO $ runIter iter onDone onCont         where-            onDone a  = putMVar var $ idone a-            onCont k  = k chunk >>= \(i',_) ->-                          runIter i' onDone onFina onErr onReq-            onErr i e = putMVar var $ ierr i e-            onReq :: IO x -> (x -> Iteratee s IO a) -> IO ()-            onReq mb doB = mb >>= \b ->-                             runIter (doB b) onDone onCont onErr onReq-            onFina k = putMVar var $ icont k+            onDone a s = putMVar var $ idone a s+            onCont k _ = runIter (k chunk) onDone onFina+            onFina k e = putMVar var $ icont k e  -- | Transform an Enumeratee into a parallel composable one, introducing --  one step extra delay, see 'parI'.@@ -115,19 +109,19 @@   => Int               -- ^ maximum number of chunks to read   -> (s -> b)          -- ^ map function   -> Iteratee s m b-mapReduce bufsize f = icontP (step (0, []))+mapReduce bufsize f = liftI (step (0, []))  where   step a@(!buf,acc) (Chunk xs)-    | nullC xs = (icontP (step a), Chunk xs)+    | nullC xs = liftI (step a)     | buf >= bufsize =         let acc'  = mconcat acc             b'    = f xs-        in b' `par` acc' `pseq` (icontP (step (0,[b' `mappend` acc'])), Chunk empty)+        in b' `par` acc' `pseq` liftI (step (0,[b' `mappend` acc']))     | otherwise     =         let b' = f xs-        in b' `par` (icontP (step (succ buf,b':acc)), Chunk empty)+        in b' `par` liftI (step (succ buf,b':acc))   step (_,acc) s@(EOF Nothing) =-    (idone (mconcat acc), s)-  step acc     s@(EOF (Just err))  =-    (throwRecoverableErr err (icontP $ step acc), s)+    idone (mconcat acc) s+  step acc       (EOF (Just err))  =+    throwRecoverableErr err (step acc) 

@@ -212,11 +212,11 @@  conv1 = idN "convStream id head chunked" (I.joinI . I.convStream idChunk $ I.head) conv2 = idN "convStream id length chunked" (I.joinI . I.convStream idChunk $ I.length)-idChunk = I.icontP step+idChunk = I.liftI step   where     step (I.Chunk xs)-      | LL.null xs      = (idChunk, mempty)-      | True            = (idone xs, mempty)+      | LL.null xs      = idChunk+      | True            = idone xs (I.Chunk mempty) convBenches = [conv1, conv2]  instance NFData BS.ByteString where

@@ -297,10 +297,10 @@   where types = (xs :: [Int])  convId :: (LL.ListLike s el, Monad m) => Iteratee s m s-convId = icontP (\str -> case str of-  s@(Chunk xs) | LL.null xs -> (convId, s)-  s@(Chunk xs) -> (idone xs, Chunk mempty)-  s@(EOF e)    -> (idone mempty, EOF e)+convId = liftI (\str -> case str of+  s@(Chunk xs) | LL.null xs -> convId+  s@(Chunk xs) -> idone xs (Chunk mempty)+  s@(EOF e)    -> idone mempty (EOF e)   )  prop_convId xs = runner1 (enumPure1Chunk xs convId) == xs