iteratee 0.8.8.2 → 0.8.9.0

raw patch · 16 files changed

+1207/−916 lines, 16 filesdep +lifted-basedep +monad-controldep +transformers-basedep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: lifted-base, monad-control, transformers-base, unix-bytestring

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• iteratee.cabal +10/−6
• src/Data/Iteratee.hs +5/−9
• src/Data/Iteratee/Base.hs +181/−91
• src/Data/Iteratee/Binary.hs +20/−51
• src/Data/Iteratee/Char.hs +27/−27
• src/Data/Iteratee/IO.hs +15/−14
• src/Data/Iteratee/IO/Base.hs +2/−2
• src/Data/Iteratee/IO/Fd.hs +42/−29
• src/Data/Iteratee/IO/Handle.hs +44/−39
• src/Data/Iteratee/IO/Posix.hs +0/−104
• src/Data/Iteratee/Iteratee.hs +194/−166
• src/Data/Iteratee/ListLike.hs +291/−352
• src/Data/Iteratee/PTerm.hs +289/−0
• src/Data/Iteratee/Parallel.hs +24/−18
• tests/benchmarks.hs +3/−3
• tests/testIteratee.hs +60/−5

@@ -1,5 +1,5 @@ name:          iteratee-version:       0.8.8.2+version:       0.8.9.0 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.0.4, GHC == 7.2.1+tested-with:   GHC == 7.2.1, GHC == 7.4.2 stability:     experimental  cabal-version: >= 1.6@@ -41,19 +41,22 @@   else     cpp-options: -DUSE_POSIX     exposed-modules:-      Data.Iteratee.IO.Posix       Data.Iteratee.IO.Fd     build-depends:-      unix >= 2 && < 3+      unix                    >= 2 && < 3,+      unix-bytestring         >= 0.3.5 && < 0.4    build-depends:     base                      >= 3       && < 6,     ListLike                  >= 1.0     && < 4,     MonadCatchIO-transformers >  0.2     && < 0.4,     bytestring                >= 0.9     && < 0.10,-    containers                >= 0.2     && < 0.5,+    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              >= 0.2     && < 0.4,+    transformers-base         >= 0.4     && < 0.5    exposed-modules:     Data.Nullable@@ -71,6 +74,7 @@     Data.Iteratee.Iteratee     Data.Iteratee.ListLike     Data.Iteratee.Parallel+    Data.Iteratee.PTerm    other-modules:     Data.Iteratee.IO.Base

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

@@ -1,5 +1,12 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, Rank2Types,-    DeriveDataTypeable, ExistentialQuantification #-}+{-# LANGUAGE TypeFamilies+            ,MultiParamTypeClasses+            ,FlexibleContexts+            ,FlexibleInstances+            ,UndecidableInstances+            ,RankNTypes+            ,DeriveDataTypeable+            ,ScopedTypeVariables+            ,ExistentialQuantification #-}  -- |Monadic Iteratees: -- incremental input parsers, processors and transformers@@ -7,7 +14,6 @@ module Data.Iteratee.Base (   -- * Types   Stream (..)-  ,StreamStatus (..)   -- ** Exception types   ,module Data.Iteratee.Exception   -- ** Iteratees@@ -16,15 +22,17 @@   -- ** Control functions   ,run   ,tryRun-  ,mapIteratee   ,ilift   ,ifold   -- ** Creating Iteratees   ,idone   ,icont+  ,icontP+  ,ierr+  ,ireq   ,liftI   ,idoneM-  ,icontM+  ,ierrM   -- ** Stream Functions   ,setEOF   -- * Classes@@ -37,12 +45,18 @@ import Data.Iteratee.Base.LooseMap as X import Data.Nullable               as X import Data.NullPoint              as X++import Data.Maybe import Data.Monoid +import Control.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 (..), Exception (..),-  catch, block, toException, fromException)+import Control.Monad.CatchIO (MonadCatchIO (..),+  catch, block)+import Control.Monad.Trans.Control import Control.Applicative hiding (empty) import Control.Exception (SomeException) import qualified Control.Exception as E@@ -80,13 +94,6 @@   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 @@ -99,87 +106,166 @@ -- ---------------------------------------------- -- | Monadic iteratee newtype Iteratee s m a = Iteratee{ runIter :: forall r.-          (a -> Stream s -> m r) ->-          ((Stream s -> Iteratee s m a) -> Maybe SomeException -> m r) ->-          m r}+          (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}  -- ---------------------------------------------- -idone :: Monad m => a -> Stream s -> Iteratee s m a-idone a s = Iteratee $ \onDone _ -> onDone a s+idone :: a -> Iteratee s m a+idone a = Iteratee $ \onDone _ _ _ -> onDone a+{-# INLINE idone #-} -icont :: (Stream s -> Iteratee s m a) -> Maybe SomeException -> Iteratee s m a-icont k e = Iteratee $ \_ onCont -> onCont k e+icont :: (Stream s -> m (Iteratee s m a, Stream s)) -> Iteratee s m a+icont k = Iteratee $ \_ onCont _ _ -> onCont k+{-# INLINE icont #-} -liftI :: Monad m => (Stream s -> Iteratee s m a) -> Iteratee s m a-liftI k = Iteratee $ \_ onCont -> onCont k Nothing+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 #-}++ierr :: Iteratee s m a -> SomeException -> Iteratee s m a+ierr i e = Iteratee $ \_ _ onErr _ -> onErr i e+{-# INLINE ierr #-}++ireq :: m b -> (b -> Iteratee s m a) -> Iteratee s m a+ireq mb bf = Iteratee $ \_ _ _ onReq -> onReq mb bf+{-# INLINE ireq #-}+ -- Monadic versions, frequently used by enumerators-idoneM :: Monad m => a -> Stream s -> m (Iteratee s m a)-idoneM x str = return $ Iteratee $ \onDone _ -> onDone x str+idoneM :: Monad m => a -> m (Iteratee s m a)+idoneM x = return $ idone x -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+ierrM :: Monad m => Iteratee s m a -> SomeException -> m (Iteratee s m a)+ierrM i e = return $ ierr i e -instance (Functor m, Monad m) => Functor (Iteratee s m) where-  fmap f m = Iteratee $ \onDone onCont ->-    let od = onDone . f-        oc = onCont . (fmap f .)-    in runIter m od oc+instance 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, Monad m, Nullable s) => Applicative (Iteratee s m) where-    pure x  = idone x (Chunk empty)+instance (Functor m, Monad m) => Applicative (Iteratee s m) where+    pure x  = idone x+    {-# INLINE (<*>) #-}     m <*> a = m >>= flip fmap a -instance (Monad m, Nullable s) => Monad (Iteratee s m) where+instance (Monad m) => Monad (Iteratee s m) where   {-# INLINE return #-}-  return x = Iteratee $ \onDone _ -> onDone x (Chunk empty)+  return = idone   {-# INLINE (>>=) #-}-  (>>=) = bindIteratee+  (>>=) = bindIter -{-# INLINE bindIteratee #-}-bindIteratee :: (Monad m, Nullable s)+{-# INLINE bindIter #-}+bindIter :: forall s m a b. (Monad m)     => Iteratee s m a     -> (a -> Iteratee s m b)     -> Iteratee s m b-bindIteratee = self-    where-        self m f = Iteratee $ \onDone onCont ->-             let m_done a (Chunk s)-                   | nullC s     = runIter (f a) onDone onCont-                 m_done a stream = runIter (f a) (const . flip onDone stream) f_cont-                   where f_cont k Nothing = runIter (k stream) onDone onCont-                         f_cont k e       = onCont k e-             in runIter m m_done (onCont . (flip self f .))+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) -instance NullPoint s => MonadTrans (Iteratee s) where-  lift m = Iteratee $ \onDone _ -> m >>= flip onDone (Chunk empty)+instance MonadTrans (Iteratee s) where+  lift = flip ireq idone -instance (MonadIO m, Nullable s, NullPoint s) => MonadIO (Iteratee s m) where+instance (MonadBase b m) => MonadBase b (Iteratee s m) where+  liftBase = lift . liftBase++instance (MonadIO m) => MonadIO (Iteratee s m) where   liftIO = lift . liftIO -instance (MonadCatchIO m, Nullable s, NullPoint s) =>+instance forall s m. (MonadCatchIO m) =>   MonadCatchIO (Iteratee s m) where-    m `catch` f = Iteratee $ \od oc -> runIter m od oc `catch` (\e -> runIter (f e) od oc)+    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)     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))+  restoreT = join . lift . liftM+               (either 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+ -- |Send 'EOF' to the @Iteratee@ and disregard the unconsumed part of the -- stream.  If the iteratee is in an exception state, that exception is -- thrown with 'Control.Exception.throw'.  Iteratees that do not terminate -- on @EOF@ will throw 'EofException'.-run :: Monad m => Iteratee s m a -> m a-run iter = runIter iter onDone onCont+run :: forall s m a. Monad m => Iteratee s m a -> m a+run iter = runIter iter onDone onCont onErr onReq  where-   onDone  x _        = return x-   onCont  k Nothing  = runIter (k (EOF Nothing)) onDone onCont'-   onCont  _ (Just e) = E.throw e-   onCont' _ Nothing  = E.throw EofException-   onCont' _ (Just e) = E.throw e+   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 #-}  -- |Run an iteratee, returning either the result or the iteratee exception. -- Note that only internal iteratee exceptions will be returned; exceptions@@ -187,24 +273,19 @@ -- not be returned. --  -- See 'Data.Iteratee.Exception.IFException' for details.-tryRun :: (Exception e, Monad m) => Iteratee s m a -> m (Either e a)-tryRun iter = runIter iter onDone onCont+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   where-    onDone  x _ = return $ Right x-    onCont  k Nothing  = runIter (k (EOF Nothing)) onDone onCont'-    onCont  _ (Just e) = return $ maybeExc e-    onCont' _ Nothing  = return $ maybeExc (toException EofException)-    onCont' _ (Just e) = return $ maybeExc e+    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     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.@@ -217,22 +298,31 @@ --  -- A more complex example would involve lifting an iteratee to work with -- interleaved streams.  See the example at 'Data.Iteratee.ListLike.merge'.-ilift ::+ilift :: forall m n s a.   (Monad m, Monad n)   => (forall r. m r -> n r)   -> Iteratee s m a   -> Iteratee s n a-ilift f i = Iteratee $  \od oc ->-  let onDone a str  = return $ Left (a,str)-      onCont k mErr = return $ Right (ilift f . k, mErr)-  in f (runIter i onDone onCont) >>= either (uncurry od) (uncurry oc)+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  -- | Lift a computation in the inner monad of an iteratee, while threading -- through an accumulator.-ifold :: (Monad m, Monad n) => (forall r. m r -> acc -> n (r, acc))-      -> acc -> Iteratee s m a -> Iteratee s n (a, acc)-ifold f acc i = Iteratee $ \ od oc -> do-  (r, acc') <- flip f acc $-    runIter i (curry $ return . Left) (curry $ return . Right)-  either (uncurry (od . flip (,) acc'))-         (uncurry (oc . (ifold f acc .))) r+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'))

@@ -14,24 +14,12 @@   ,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 qualified Data.ByteString.Unsafe as B import Data.Word import Data.Bits import Data.Int@@ -104,27 +92,31 @@   -> Int   -> ([Word8] -> b)   -> Iteratee s m b-endianReadN MSB n0 cnct = liftI (step n0 [])+endianReadN MSB n0 cnct = icontP (step n0 [])  where   step !n acc (Chunk c)-    | LL.null c        = liftI (step n acc)+    | LL.null c        = (icontP (step n acc), Chunk c)     | LL.length c >= n = let (this,next) = LL.splitAt n c-                         in idone (cnct $ acc ++ LL.toList this) (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 [])+                             !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 [])  where   step !n acc (Chunk c)-    | LL.null c        = liftI (step n acc)+    | LL.null c        = (icontP (step n acc), Chunk c)     | LL.length c >= n = let (this,next) = LL.splitAt n c-                         in idone (cnct $ reverse (LL.toList this) ++ acc)-                                  (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)+                             !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) {-# INLINE endianReadN #-}  -- As of now, the polymorphic code is as fast as the best specializations@@ -132,30 +124,6 @@ -- future, or possibly deprecated. -- JWL, 2012-01-16 -readWord16be_bs :: Monad m => Iteratee B.ByteString m Word16-readWord16be_bs = endianRead2 MSB-{-# INLINE readWord16be_bs  #-}--readWord16le_bs :: Monad m => Iteratee B.ByteString m Word16-readWord16le_bs = endianRead2 LSB-{-# INLINE readWord16le_bs  #-}--readWord32be_bs :: Monad m => Iteratee B.ByteString m Word32-readWord32be_bs = endianRead4 MSB-{-# INLINE readWord32be_bs  #-}--readWord32le_bs :: Monad m => Iteratee B.ByteString m Word32-readWord32le_bs = endianRead4 LSB-{-# INLINE readWord32le_bs  #-}--readWord64be_bs :: Monad m => Iteratee B.ByteString m Word64-readWord64be_bs = endianRead8 MSB-{-# INLINE readWord64be_bs  #-}--readWord64le_bs :: Monad m => Iteratee B.ByteString m Word64-readWord64le_bs = endianRead8 LSB-{-# INLINE readWord64le_bs  #-}- word16' :: [Word8] -> Word16 word16' [c1,c2] = word16 c1 c2 word16' _ = error "iteratee: internal error in word16'"@@ -179,6 +147,7 @@ word64' :: [Word8] -> Word64 word64' [c1,c2,c3,c4,c5,c6,c7,c8] = word64 c1 c2 c3 c4 c5 c6 c7 c8 word64' _ = error "iteratee: internal error in word64'"+{-# INLINE word64' #-}  word64   :: Word8 -> Word8 -> Word8 -> Word8 

@@ -78,21 +78,21 @@      Enumeratee s [s] m a enumLines = convStream getter   where-    getter = icont step Nothing+    getter = icontP step     lChar = (== '\n') . last . LL.toString     step (Chunk xs)-      | LL.null xs = getter-      | lChar xs   = idone (LL.lines xs) mempty-      | otherwise  = icont (step' xs) Nothing-    step _str      = getter+      | LL.null xs = (getter, Chunk xs)+      | lChar xs   = (idone (LL.lines xs), mempty)+      | otherwise  = (icontP (step' xs), mempty)+    step str       = (getter, str)     step' xs (Chunk ys)-      | LL.null ys = icont (step' xs) Nothing-      | lChar ys   = idone (LL.lines . mappend xs $ ys) mempty+      | LL.null ys = (icontP (step' xs), Chunk ys)+      | 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 = liftI step+    getter = icontP step     lChar = isSpace . BC.last     step (Chunk xs)-      | BC.null xs = getter-      | lChar xs   = idone (BC.words xs) (Chunk BC.empty)-      | otherwise  = icont (step' xs) Nothing-    step str       = idone mempty str+      | BC.null xs = (getter, mempty)+      | lChar xs   = (idone (BC.words xs), Chunk BC.empty)+      | otherwise  = (icontP (step' xs), mempty)+    step str       = (idone mempty, str)     step' xs (Chunk ys)-      | BC.null ys = icont (step' xs) Nothing-      | lChar ys   = idone (BC.words . BC.append xs $ ys) mempty+      | BC.null ys = (icontP (step' xs), mempty)+      | 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 = icont step Nothing+    getter = icontP step     lChar = (== '\n') . BC.last     step (Chunk xs)-      | BC.null xs = getter-      | lChar xs   = idone (BC.lines xs) (Chunk BC.empty)-      | otherwise  = icont (step' xs) Nothing-    step str       = idone mempty str+      | 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)     step' xs (Chunk ys)-      | BC.null ys = icont (step' xs) Nothing-      | lChar ys   = idone (BC.lines . BC.append xs $ ys) mempty+      | BC.null ys = (icontP (step' xs), mempty)+      | 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 #-}+{-# LANGUAGE CPP, FlexibleContexts #-}  -- |Random and Binary IO with generic Iteratees. @@ -37,7 +37,8 @@ import qualified Data.Iteratee.IO.Fd as FD #endif -import Control.Monad.CatchIO+import Control.Monad.Trans.Control+import Control.Monad.IO.Class  -- | The default buffer size. defaultBufSize :: Int@@ -47,14 +48,14 @@ #if defined(USE_POSIX)  enumFile-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Int      -> FilePath      -> Enumerator s m a enumFile = FD.enumFile  enumFileRandom-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Int      -> FilePath      -> Enumerator s m a@@ -63,7 +64,7 @@ -- |Process a file using the given Iteratee.  This function wraps -- enumFd as a convenience. fileDriver-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Iteratee s m a      -> FilePath      -> m a@@ -71,7 +72,7 @@  -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Int      -> Iteratee s m a      -> FilePath@@ -81,14 +82,14 @@ -- |Process a file using the given Iteratee.  This function wraps -- enumFdRandom as a convenience. fileDriverRandom-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Iteratee s m a      -> FilePath      -> m a fileDriverRandom = FD.fileDriverRandomFd defaultBufSize  fileDriverRandomVBuf-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Int      -> Iteratee s m a      -> FilePath@@ -103,7 +104,7 @@ -- |Process a file using the given Iteratee.  This function wraps -- @enumHandle@ as a convenience. fileDriver ::- (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>   Iteratee s m a   -> FilePath   -> m a@@ -111,7 +112,7 @@  -- |A version of fileDriver with a user-specified buffer size (in elements). fileDriverVBuf ::- (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+ (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>   Int   -> Iteratee s m a   -> FilePath@@ -121,14 +122,14 @@ -- |Process a file using the given Iteratee.  This function wraps -- @enumRandomHandle@ as a convenience. fileDriverRandom-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Iteratee s m a      -> FilePath      -> m a fileDriverRandom = H.fileDriverRandomHandle defaultBufSize  fileDriverRandomVBuf-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Int      -> Iteratee s m a      -> FilePath@@ -136,14 +137,14 @@ fileDriverRandomVBuf = H.fileDriverRandomHandle  enumFile-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  m, NullPoint s, ReadableChunk s el) =>      Int      -> FilePath      -> Enumerator s m a enumFile = H.enumFile  enumFileRandom-  :: (MonadCatchIO m, NullPoint s, ReadableChunk s el) =>+  :: (MonadIO m, MonadBaseControl IO  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 Data.Iteratee.IO.Posix,+  module System.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 Data.Iteratee.IO.Posix+import System.Posix #else type FileOffset = Integer #endif

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

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

@@ -1,104 +0,0 @@-{-# 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,7 +2,6 @@             ,RankNTypes             ,FlexibleContexts             ,ScopedTypeVariables-            ,BangPatterns             ,DeriveDataTypeable #-}  -- |Monadic and General Iteratees:@@ -10,10 +9,12 @@  module Data.Iteratee.Iteratee (   -- * Types-  EnumerateeHandler+  Cont+  ,EnumerateeHandler   -- ** Error handling   ,throwErr   ,throwRecoverableErr+  ,throwRec   ,checkErr   -- ** Basic Iteratees   ,identity@@ -29,7 +30,6 @@   ,mapChunksM   ,convStream   ,unfoldConvStream-  ,unfoldConvStreamCheck   ,joinI   ,joinIM   -- * Enumerators@@ -48,14 +48,17 @@   ,(>>>)   ,eneeCheckIfDone   ,eneeCheckIfDoneHandle-  ,eneeCheckIfDoneIgnore   ,eneeCheckIfDonePass+  ,eneeCheckIfDoneIgnore   ,mergeEnums   -- ** Enumeratee Combinators   ,($=)   ,(=$)   ,(><>)   ,(<><)+  -- ** Enumerator creation callbacks+  ,CBState (..)+  ,Callback   -- * Misc.   ,seek   ,FileOffset@@ -69,7 +72,9 @@ 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@@ -85,62 +90,59 @@ --  Disregard the input first and then propagate the error.  This error -- cannot be handled by 'enumFromCallbackCatch', although it can be cleared -- by 'checkErr'.-throwErr :: (Monad m) => SomeException -> Iteratee s m a-throwErr e = icont (const (throwErr e)) (Just e)+throwErr :: SomeException -> Iteratee s m a+throwErr e = ierr (throwErr e) e  -- |Report and propagate a recoverable error.  This error can be handled by -- both 'enumFromCallbackCatch' and 'checkErr'.-throwRecoverableErr ::- (Monad m) =>-  SomeException-  -> (Stream s -> Iteratee s m a)-  -> Iteratee s m a-throwRecoverableErr e i = icont i (Just e)+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 + -- |Check if an iteratee produces an error. -- Returns @Right a@ if it completes without errors, otherwise -- @Left SomeException@. 'checkErr' is useful for iteratees that may not -- terminate, such as @Data.Iteratee.head@ with an empty stream.-checkErr ::- (Monad m, NullPoint s) =>-  Iteratee s m a-  -> Iteratee s m (Either SomeException a)-checkErr iter = Iteratee $ \onDone onCont ->-  let od            = onDone . Right-      oc k Nothing  = onCont (checkErr . k) Nothing-      oc _ (Just e) = onDone (Left e) (Chunk empty)-  in runIter iter od oc+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)  -- ------------------------------------------------------------------------ -- Parser combinators  -- |The identity iteratee.  Doesn't do any processing of input.-identity :: (Monad m, NullPoint s) => Iteratee s m ()-identity = idone () (Chunk empty)+identity :: Iteratee s m ()+identity = idone ()  -- |Get the stream status of an iteratee.-isStreamFinished :: (Monad m, Nullable s) => Iteratee s m (Maybe SomeException)-isStreamFinished = liftI check+isStreamFinished :: (Nullable s, Monad m) => Iteratee s m (Maybe SomeException)+isStreamFinished = icontP check   where     check s@(Chunk xs)-      | nullC xs  = isStreamFinished-      | otherwise = idone Nothing s-    check s@(EOF e) = idone (Just $ fromMaybe (toException EofException) e) s+      | nullC xs  = (isStreamFinished, s)+      | otherwise = (idone Nothing, s)+    check s@(EOF e) = (idone (Just $ fromMaybe (toException EofException) e), s) {-# INLINE isStreamFinished #-}   -- |Skip the rest of the stream-skipToEof :: (Monad m) => Iteratee s m ()-skipToEof = icont check Nothing+skipToEof :: (NullPoint s, Monad m) => Iteratee s m ()+skipToEof = icontP check   where-    check (Chunk _) = skipToEof-    check s         = idone () s+    check (Chunk _) = (skipToEof, Chunk empty)+    check s         = (idone (), s)   -- |Seek to a position in the stream-seek :: (Monad m, NullPoint s) => FileOffset -> Iteratee s m ()-seek o = throwRecoverableErr (toException $ SeekException o) (const identity)+seek :: (NullPoint s) => FileOffset -> Iteratee s m ()+seek o = throwRec (SeekException o) identity  -- | Map a monadic function over the chunks of the stream and ignore the -- result.  Useful for creating efficient monadic iteratee consumers, e.g.@@ -149,42 +151,47 @@ --  -- these can be efficiently run in parallel with other iteratees via -- @Data.Iteratee.ListLike.zip@.-mapChunksM_ :: (Monad m, Nullable s) => (s -> m b) -> Iteratee s m ()-mapChunksM_ f = liftI step+mapChunksM_ :: (Monad m, Nullable s, NullPoint s)+  => (s -> m b)+  -> Iteratee s m ()+mapChunksM_ f = icont step   where-    step (Chunk xs)-      | nullC xs   = liftI step-      | otherwise  = lift (f xs) >> liftI step-    step s@(EOF _) = idone () s+    step s@(Chunk xs)+      | nullC xs   = return (icont step, s)+      | otherwise  = f xs >> return (icont step, Chunk empty)+    step s@(EOF _) = return (idone (), s) {-# INLINE mapChunksM_ #-}  -- | A fold over chunks-foldChunksM :: (Monad m, Nullable s) => (a -> s -> m a) -> a -> Iteratee s m a-foldChunksM f = liftI . go+foldChunksM :: (Monad m, Nullable s, NullPoint s)+  => (a -> s -> m a)+  -> a+  -> Iteratee s m a+foldChunksM f = icont . go   where-    go a (Chunk c) = lift (f a c) >>= liftI . go-    go a e = idone a e+    go a (Chunk c) = f a c >>= \a' -> return (icont (go a'), Chunk empty)+    go a e = return (idone a, e) {-# INLINE foldChunksM #-}  -- | Get the current chunk from the stream. getChunk :: (Monad m, Nullable s, NullPoint s) => Iteratee s m s-getChunk = liftI step+getChunk = icontP step  where-  step (Chunk xs)-    | nullC xs  = liftI step-    | otherwise = idone xs $ Chunk empty-  step (EOF Nothing)  = throwErr $ toException EofException-  step (EOF (Just e)) = throwErr e+  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) {-# INLINE getChunk #-}  -- | Get a list of all chunks from the stream.-getChunks :: (Monad m, Nullable s) => Iteratee s m [s]-getChunks = liftI (step id)+getChunks :: (Monad m, Nullable s, NullPoint s) => Iteratee s m [s]+getChunks = icontP (step id)  where-  step acc (Chunk xs)-    | nullC xs    = liftI (step acc)-    | otherwise   = liftI (step $ acc . (xs:))-  step acc stream = idone (acc []) stream+  step acc s@(Chunk xs)+    | nullC xs    = (icontP (step acc), s)+    | otherwise   = (icontP (step $ acc . (xs:)), s)+  step acc stream = (idone (acc []), stream) {-# INLINE getChunks #-}  -- ---------------------------------------------------@@ -205,27 +212,27 @@ -- >   :: (Monad m, LL.ListLike s el, NullPoint s) -- >   => (el -> Bool) -- >   -> Enumeratee s s m a--- > breakE cpred = eneeCheckIfDone (liftI . step)+-- > breakE cpred = eneeCheckIfDone (icont . step) -- >  where -- >   step k (Chunk s)--- >       | LL.null s  = liftI (step k)+-- >       | LL.null s  = icont (step k) -- >       | otherwise  = case LL.break cpred s of -- >         (str', tail')--- >           | LL.null tail' -> eneeCheckIfDone (liftI . step) . k $ Chunk str'+-- >           | LL.null tail' -> eneeCheckIfDone (icont . step) . k $ Chunk str' -- >           | otherwise     -> idone (k $ Chunk str') (Chunk tail') -- >   step k stream           =  idone (k stream) stream --  eneeCheckIfDone ::  (Monad m, NullPoint elo) =>-  ((Stream eli -> Iteratee eli m a) -> Iteratee elo m (Iteratee eli m a))+  (Cont eli m a -> Iteratee elo m (Iteratee eli m a))   -> Enumeratee elo eli m a-eneeCheckIfDone f = eneeCheckIfDonePass f'- where-  f' k Nothing  = f k-  f' k (Just e) = throwRecoverableErr e (\s -> joinIM $ enumChunk s $ eneeCheckIfDone f (liftI k))+eneeCheckIfDone = eneeCheckIfDonePass +-- | The continuation type of an incomplete iteratee+type Cont s m a = Stream s -> m (Iteratee s m a, Stream s)+ type EnumerateeHandler eli elo m a =-  (Stream eli -> Iteratee eli m a)+  Iteratee eli m a   -> SomeException   -> Iteratee elo m (Iteratee eli m a) @@ -233,51 +240,61 @@ -- a handler which is used -- to process any exceptions in a separate method. eneeCheckIfDoneHandle-  :: (Monad m, NullPoint elo)+  :: forall m eli elo a. (NullPoint elo)   => EnumerateeHandler eli elo m a-  -> ((Stream eli -> Iteratee eli m a)-      -> Maybe SomeException-      -> Iteratee elo m (Iteratee eli m a)-     )+  -> (Cont eli m a -> Iteratee elo m (Iteratee eli m a))   -> Enumeratee elo eli m a-eneeCheckIfDoneHandle h f inner = Iteratee $ \od oc ->-  let onDone x s = od (idone x s) (Chunk empty)-      onCont k Nothing  = runIter (f k Nothing) od oc-      onCont k (Just e) = runIter (h k e)       od oc-  in runIter inner onDone onCont+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) {-# INLINABLE eneeCheckIfDoneHandle #-} +-- | Create enumeratees that pass all errors through the outer iteratee. eneeCheckIfDonePass-  :: (Monad m, NullPoint elo)-  => ((Stream eli -> Iteratee eli m a)-      -> Maybe SomeException-      -> Iteratee elo m (Iteratee eli m a)-     )+  :: (NullPoint elo)+  => (Cont eli m a -> Iteratee elo m (Iteratee eli m a))   -> Enumeratee elo eli m a-eneeCheckIfDonePass f = eneeCheckIfDoneHandle (\k e -> f k (Just e)) f+eneeCheckIfDonePass f = worker+ where+  worker = eneeCheckIfDoneHandle handler f+  handler i = ierr (worker i) {-# INLINABLE eneeCheckIfDonePass #-} +-- | Create an enumeratee that ignores all errors from the inner iteratee eneeCheckIfDoneIgnore-  :: (Monad m, NullPoint elo)-  => ((Stream eli -> Iteratee eli m a)-      -> Maybe SomeException-      -> Iteratee elo m (Iteratee eli m a)-     )+  :: (NullPoint elo)+  => (Cont eli m a -> Iteratee elo m (Iteratee eli m a))   -> Enumeratee elo eli m a-eneeCheckIfDoneIgnore f = eneeCheckIfDoneHandle (\k _ -> f k Nothing) f+eneeCheckIfDoneIgnore f = worker+ where+  worker = eneeCheckIfDoneHandle handler f+  handler i _e = worker i+{-# INLINABLE eneeCheckIfDoneIgnore #-} + -- | 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 = eneeCheckIfDonePass (icont . step)+mapChunks f = go  where-  step k (Chunk xs)     = eneeCheckIfDonePass (icont . step) . k . Chunk $ f xs-  step k str@(EOF mErr) = idone (k $ EOF mErr) str+  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) {-# INLINE mapChunks #-}  -- | Convert a stream of @s@ to a stream of @s'@ using the supplied function.@@ -285,11 +302,12 @@   :: (Monad m, NullPoint s, Nullable s)   => (s -> m s')   -> Enumeratee s s' m a-mapChunksM f = eneeCheckIfDonePass (icont . step)+mapChunksM f = go  where-  step k (Chunk xs)     = lift (f xs) >>=-                          eneeCheckIfDonePass (icont . step) . k . Chunk-  step k str@(EOF mErr) = idone (k $ EOF mErr) str+  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) {-# INLINE mapChunksM #-}  -- |Convert one stream into another, not necessarily in lockstep.@@ -300,17 +318,21 @@ -- 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 ::+convStream :: forall s s' m a.  (Monad m, Nullable s) =>   Iteratee s m s'   -> Enumeratee s s' m a-convStream fi = eneeCheckIfDonePass check+convStream fi = go   where-    check k (Just e) = throwRecoverableErr e (const identity) >> check k Nothing-    check k _ = isStreamFinished >>= maybe (step k) (idone (liftI k) . EOF . Just)-    step k = fi >>= eneeCheckIfDonePass check . k . Chunk+    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 {-# 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.@@ -319,35 +341,28 @@   (acc -> Iteratee s m (acc, s'))   -> acc   -> Enumeratee s s' m a-unfoldConvStream f acc0 = eneeCheckIfDonePass (check acc0)-  where-    check acc k (Just e) = throwRecoverableErr e (const identity) >> check acc k Nothing-    check acc k _ = isStreamFinished >>=-                    maybe (step acc k) (idone (liftI k) . EOF . Just)-    step acc k = f acc >>= \(acc', s') ->-                    eneeCheckIfDonePass (check acc') . k . Chunk $ s'+unfoldConvStream fi acc0 = unfoldConvStreamCheck eneeCheckIfDonePass fi acc0+{-# INLINABLE unfoldConvStream #-}  unfoldConvStreamCheck   :: (Monad m, Nullable elo)-  => (((Stream eli -> Iteratee eli m a)-        -> Maybe SomeException-        -> Iteratee elo m (Iteratee eli m a)-      )+  => ((Cont eli m a -> Iteratee elo m (Iteratee eli m a))       -> Enumeratee elo eli m a      )   -> (acc -> Iteratee elo m (acc, eli))   -> acc   -> Enumeratee elo eli m a-unfoldConvStreamCheck checkDone f acc0 = checkDone (check acc0)+unfoldConvStreamCheck checkDone f acc0 = go acc0   where-    check acc k mX = isStreamFinished >>=-                   maybe (step acc k mX) (idone (icont k mX) . EOF . Just)-    step acc k Nothing = f acc >>= \(acc', s') ->-                  (checkDone (check acc') . k $ Chunk s')-    step acc k (Just ex) = throwRecoverableErr ex $ \str' ->-      let i = f acc >>= \(acc', s') ->-                           (checkDone (check acc') . k $ Chunk s')-      in joinIM $ enumChunk str' i+    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' {-# INLINABLE unfoldConvStreamCheck #-}  -- | Collapse a nested iteratee.  The inner iteratee is terminated by @EOF@.@@ -355,24 +370,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 = (>>=-  \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)+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 {-# INLINE joinI #-}  -- | Lift an iteratee inside a monad to an iteratee. joinIM :: (Monad m) => m (Iteratee s m a) -> Iteratee s m a-joinIM mIter = Iteratee $ \od oc -> mIter >>= \iter -> runIter iter od oc+joinIM mIter = ireq mIter id   -- ------------------------------------------------------------------------@@ -398,24 +413,25 @@ -- stream. The result is the iteratee in the Done state.  It is an error -- if the iteratee does not terminate on EOF. enumEof :: (Monad m) => Enumerator s m a-enumEof iter = runIter iter onDone onCont+enumEof iter = runIter iter idoneM onC ierrM onR   where-    onDone  x _str    = return $ idone x (EOF Nothing)-    onCont  k Nothing = runIter (k (EOF Nothing)) onDone onCont'-    onCont  k e       = return $ icont k e-    onCont' _ Nothing = return $ throwErr excDivergent-    onCont' k e       = return $ icont k e+    onC  k     = k (EOF Nothing) >>= \(i,_) -> runIter i idoneM onC' ierrM onR+    onC' _k    = return $ throwErr excDivergent+    onR mb doB = mb >>= enumEof . doB  -- |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 onDone onCont+enumErr e iter = runIter iter idoneM onCont ierrM onR   where-    onDone  x _       = return $ idone x (EOF . Just $ toException e)-    onCont  k Nothing = runIter (k (EOF (Just (toException e)))) onDone onCont'-    onCont  k e'      = return $ icont k e'-    onCont' _ Nothing = return $ throwErr excDivergent-    onCont' k e'      = return $ icont k e'+    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   -- |The composition of two enumerators: essentially the functional composition@@ -491,22 +507,23 @@ -- It passes a given list of elements to the iteratee in one chunk -- This enumerator does no IO and is useful for testing of base parsing enumPure1Chunk :: (Monad m) => s -> Enumerator s m a-enumPure1Chunk str iter = runIter iter idoneM onCont+enumPure1Chunk str iter = runIter iter idoneM onC ierrM onR   where-    onCont k Nothing = return $ k $ Chunk str-    onCont k e       = return $ icont k e+    onC k      = fst `liftM` k (Chunk str)+    onR mb doB = mb >>= enumPure1Chunk str . doB  -- | 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')+  go [] i  = return i+  go xs' i = runIter i idoneM (onCont xs') onErr (onReq xs')    where-    onCont (x:xs) k Nothing = go xs . k $ Chunk x-    onCont _ _ (Just e) = return $ throwErr e-    onCont _ k Nothing  = return $ icont k Nothing+    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 {-# INLINABLE enumList #-}  -- | Checks if an iteratee has finished.@@ -514,21 +531,23 @@ -- 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+enumCheckIfDone iter = runIter iter onDone onCont onErr onReq   where-    onDone x str = return (True, idone x str)-    onCont k e   = return (False, icont k e)+    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 {-# INLINE enumCheckIfDone #-}   -- |Create an enumerator from a callback function enumFromCallback ::  (Monad m, NullPoint s) =>-  (st -> m (Either SomeException ((Bool, st), s)))+  Callback st m s   -> st   -> Enumerator s m a-enumFromCallback c st =-  enumFromCallbackCatch c (\NotAnException -> return Nothing) st+enumFromCallback c =+  enumFromCallbackCatch c (\NotAnException -> return Nothing)  -- Dummy exception to catch in enumFromCallback -- This never gets thrown, but it lets us@@ -539,26 +558,35 @@ 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-  :: (IException e, Monad m, NullPoint s)-  => (st -> m (Either SomeException ((Bool, st), s)))+  :: forall e m s st a. (IException e, Monad m, NullPoint s)+  => Callback st m s   -> (e -> m (Maybe EnumException))   -> st   -> Enumerator s m a enumFromCallbackCatch c handler = loop   where-    loop st iter = runIter iter idoneM (onCont st)-    check k (True,  st') = loop st' . k . Chunk-    check k (False,_st') = return . k . Chunk-    onCont st k Nothing  = c st >>=-        either (return . k . EOF . Just) (uncurry (check k))-    onCont st k j@(Just e) = case fromException e of+    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       Just e' -> handler e' >>=-                   maybe (loop st . k $ Chunk empty)-                         (return . icont k . Just) . fmap toException-      Nothing -> return (icont k j)+                   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) {-# INLINE enumFromCallbackCatch #-}--

@@ -51,7 +51,6 @@   -- ** Basic enumerators   ,enumPureNChunk   -- ** Enumerator Combinators-  ,enumPair   ,enumWith   ,zip   ,zip3@@ -59,7 +58,6 @@   ,zip5   ,sequence_   ,countConsumed-  ,greedy   -- ** Monadic functions   ,mapM_   ,foldM@@ -72,13 +70,14 @@  import qualified Prelude as Prelude -import Data.List (partition) import qualified Data.ListLike as LL import qualified Data.ListLike.FoldableLL as FLL import Data.Iteratee.Iteratee import Data.Monoid import Control.Applicative ((<$>), (<*>), (<*))-import Control.Monad (liftM, liftM2, mplus, (<=<))+import Control.Arrow (first, (***))+import Control.Monad (liftM, mplus)+import qualified Control.Monad as CM import Control.Monad.Trans.Class import Data.Word (Word8) import qualified Data.ByteString as B@@ -87,12 +86,12 @@  -- | Check if a stream has received 'EOF'. isFinished :: (Monad m, Nullable s) => Iteratee s m Bool-isFinished = liftI check+isFinished = icontP check   where   check c@(Chunk xs)-    | nullC xs    = liftI check-    | otherwise   = idone False c-  check s@(EOF _) = idone True s+    | nullC xs    = (icontP check, c)+    | otherwise   = (idone False, c)+  check s@(EOF _) = (idone True, s) {-# INLINE isFinished #-}  -- ------------------------------------------------------------------------@@ -127,15 +126,15 @@ -- The analogue of @List.break@  break :: (Monad m, LL.ListLike s el) => (el -> Bool) -> Iteratee s m s-break cpred = icont (step mempty) Nothing+break cpred = icontP (step mempty)   where-    step bfr (Chunk str)-      | LL.null str       =  icont (step bfr) Nothing+    step bfr c@(Chunk str)+      | LL.null str       =  (icontP (step bfr), c)       | otherwise         =  case LL.break cpred str of         (str', tail')-          | LL.null tail' -> icont (step (bfr `mappend` str)) Nothing-          | otherwise     -> idone (bfr `mappend` str') (Chunk tail')-    step bfr stream       =  idone bfr stream+          | LL.null tail' -> (icontP (step (bfr `mappend` str)), Chunk tail')+          | otherwise     -> (idone (bfr `mappend` str'), Chunk tail')+    step bfr stream       =  (idone bfr, stream) {-# INLINE break #-}  @@ -143,27 +142,24 @@ -- Raise a (recoverable) error if the stream is terminated. --  -- The analogue of @List.head@--- --- Because @head@ can raise an error, it shouldn't be used when constructing--- iteratees for @convStream@.  Use @tryHead@ instead. head :: (Monad m, LL.ListLike s el) => Iteratee s m el-head = liftI step+head = icontP step   where-  step (Chunk vec)-    | LL.null vec  = icont step Nothing-    | otherwise    = idone (LL.head vec) (Chunk $ LL.tail vec)-  step stream      = icont step (Just (setEOF stream))+  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) {-# 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 = liftI step+tryHead = icontP step   where-  step (Chunk vec)-    | LL.null vec  = liftI step-    | otherwise    = idone (Just $ LL.head vec) (Chunk $ LL.tail vec)-  step stream      = idone Nothing stream+  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) {-# INLINE tryHead #-}  -- |Attempt to read the last element of the stream and return it@@ -171,14 +167,14 @@ --  -- The analogue of @List.last@ last :: (Monad m, LL.ListLike s el, Nullable s) => Iteratee s m el-last = liftI (step Nothing)+last = icontP (step Nothing)   where-  step l (Chunk xs)-    | nullC xs     = liftI (step l)-    | otherwise    = liftI $ step (Just $ LL.last xs)+  step l c@(Chunk xs)+    | nullC xs     = (icontP (step l), c)+    | otherwise    = (icontP $ step (Just $ LL.last xs), Chunk LL.empty)   step l s@(EOF _) = case l of-    Nothing -> icont (step l) . Just . setEOF $ s-    Just x  -> idone x s+    Nothing -> (ierr (icontP (step l)) (setEOF s), s)+    Just x  -> (idone x, s) {-# INLINE last #-}  @@ -188,20 +184,22 @@ -- 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 = liftI (step cnt xs)-  step cnt str (Chunk xs) | nullC xs  = liftI (step cnt str)-  step cnt str stream     | nullC str = idone cnt stream+    | 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)   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 #-}  @@ -210,12 +208,12 @@ -- Return @Just c@ if successful, return @Nothing@ if the stream is -- terminated by 'EOF'. peek :: (Monad m, LL.ListLike s el) => Iteratee s m (Maybe el)-peek = liftI step+peek = icontP step   where     step s@(Chunk vec)-      | LL.null vec = liftI step-      | otherwise   = idone (Just $ LL.head vec) s-    step stream     = idone Nothing stream+      | LL.null vec = (icontP step, s)+      | 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@@ -226,18 +224,19 @@   => Int  -- ^ length of chunk (t)   -> Int  -- ^ amount to consume (d)   -> Iteratee s m s'-roll t d | t > d  = liftI step+roll t d | t > d  = icontP 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) mempty <* drop (d-LL.length vec)-      | LL.null vec        = liftI step-      | otherwise          = liftI (step' vec)-    step stream            = idone LL.empty stream+          (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)     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 #-}@@ -247,27 +246,27 @@ --  -- The analogue of @List.drop@ drop :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Iteratee s m ()-drop 0  = return ()-drop n' = liftI (step n')+drop 0  = idone ()+drop n' = icontP (step n')   where     step n (Chunk str)-      | LL.length str < n = liftI (step (n - LL.length str))-      | otherwise         = idone () (Chunk (LL.drop n str))-    step _ stream         = idone () stream+      | LL.length str < n = (icontP (step (n - LL.length str)), mempty)+      | 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 = liftI step+dropWhile p = icontP step   where     step (Chunk str)-      | LL.null left = liftI step-      | otherwise    = idone () (Chunk left)+      | LL.null left = (icontP step, mempty)+      | otherwise    = (idone (), Chunk left)       where         left = LL.dropWhile p str-    step stream      = idone () stream+    step stream      = (idone (), stream) {-# INLINE dropWhile #-}  @@ -277,20 +276,21 @@ --  -- The analogue of @List.length@ length :: (Monad m, Num a, LL.ListLike s el) => Iteratee s m a-length = liftI (step 0)+length = icontP (step 0)   where-    step !i (Chunk xs) = liftI (step $ i + fromIntegral (LL.length xs))-    step !i stream     = idone i stream+    step !i (Chunk xs) = let newL = i + fromIntegral (LL.length xs)+                         in newL `seq` (icontP (step newL), mempty)+    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 = liftI step+chunkLength = icontP 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@@ -299,11 +299,11 @@   (Monad m, Nullable s, LL.ListLike s el)   => Int   -> Iteratee s m s-takeFromChunk n | n <= 0 = return empty-takeFromChunk n = liftI step+takeFromChunk n | n <= 0 = idone empty+takeFromChunk n = icontP 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,18 +318,24 @@ --  -- @breakE@ should be used in preference to @break@ whenever possible. breakE-  :: (Monad m, LL.ListLike s el, NullPoint s)+  :: (LL.ListLike s el, NullPoint s, Monad m, Functor m)   => (el -> Bool)   -> Enumeratee s s m a-breakE cpred = eneeCheckIfDonePass (icont . step)+breakE cpred = go  where+  go = eneeCheckIfDonePass (icont . step)   step k (Chunk s)-      | LL.null s  = liftI (step k)+      | LL.null s  = return (icont (step k), mempty)       | otherwise  = case LL.break cpred s of         (str', tail')-          | LL.null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'-          | otherwise     -> idone (k $ Chunk str') (Chunk tail')-  step k stream           =  idone (k stream) stream+          | 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) {-# INLINE breakE #-}  -- |Read n elements from a stream and apply the given iteratee to the@@ -342,19 +348,22 @@   => Int   -- ^ number of elements to consume   -> Enumeratee s s m a take n' iter- | n' <= 0   = return iter- | otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)-  where-    on_done od oc x _ = runIter (drop n' >> return (return x)) od oc-    on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)-                                 else runIter (liftI (step n' k)) od oc-    on_cont od oc _ (Just e) = runIter (drop n' >> throwErr e) od oc-    step n k (Chunk str)-      | LL.null str        = liftI (step n k)-      | LL.length str <= n = take (n - LL.length str) $ k (Chunk str)-      | otherwise          = idone (k (Chunk s1)) (Chunk s2)+  | 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)       where (s1, s2) = LL.splitAt n str-    step _n k stream       = idone (k stream) stream+  step _n k stream       = return (idone (icont k), stream) {-# INLINE take #-}  -- |Read n elements from a stream and apply the given iteratee to the@@ -383,32 +392,35 @@ -- 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    = return iter- | otherwise = Iteratee $ \od oc ->-    runIter iter (onDone od oc) (onCont od oc)+ | i <= 0    = idone iter+ | otherwise = runIter iter onDone onCont onErr onReq   where-    onDone od oc x str      = runIter (idone (return x) str) od oc-    onCont od oc k Nothing  = if i == 0 then od (liftI k) (Chunk mempty)-                                 else runIter (liftI (step i k)) od oc-    onCont od oc _ (Just e) = runIter (throwErr e) od oc-    step n k (Chunk str)-      | LL.null str       = liftI (step n k)-      | LL.length str < n = takeUpTo (n - LL.length str) $ k (Chunk str)-      | otherwise         =+    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          -- check to see if the inner iteratee has completed, and if so,          -- grab any remaining stream to put it in the outer iteratee.          -- the outer iteratee is always complete at this stage, although          -- the inner may not be.          let (s1, s2) = LL.splitAt n str-         in Iteratee $ \od' _ -> do-              res <- runIter (k (Chunk s1)) (\a s  -> return $ Left  (a, s))-                                            (\k' e -> return $ Right (k',e))-              case res of-                Left (a,Chunk s1') -> od' (return a)-                                          (Chunk $ s1' `LL.append` s2)-                Left  (a,s')       -> od' (idone a s') (Chunk s2)-                Right (k',e)       -> od' (icont k' e) (Chunk s2)-    step _ k stream       = idone (k stream) stream+         (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) {-# INLINE takeUpTo #-}  -- | Takes an element predicate and returns the (possibly empty)@@ -418,7 +430,7 @@ -- remaining stream will not satisfy the predicate. --  -- The analogue of @List.takeWhile@, see also @break@ and @takeWhileE@-takeWhile :: (LL.ListLike s el, Monad m) => (el -> Bool) -> Iteratee s m s+takeWhile :: (Monad m, LL.ListLike s el ) => (el -> Bool) -> Iteratee s m s takeWhile = break . (not .) {-# INLINEABLE takeWhile #-} @@ -427,7 +439,7 @@ --  -- This is preferred to @takeWhile@. takeWhileE- :: (Monad m, LL.ListLike s el, NullPoint s)+ :: (LL.ListLike s el, NullPoint s, Monad m, Functor m)  => (el -> Bool)  -> Enumeratee s s m a takeWhileE = breakE . (not .)@@ -482,7 +494,7 @@   :: (LL.ListLike s el, Monad m, Nullable s)   => Int  -- ^ size of group   -> Enumeratee s [s] m a-group cksz iinit = liftI (step 0 id iinit)+group cksz iinit = icont (step 0 id iinit)  where   -- there are two cases to consider for performance purposes:   --  1 - grouping lots of small chunks into bigger chunks@@ -491,32 +503,34 @@   -- and pass them to the inner iteratee as one list.  @gsplit@ does this.   --   -- case 1 is a bit harder, need to hold onto each chunk and coalesce them-  -- after enough have been received.  Currently using a difference list+  -- after enough have been received.  Currently using a Hughes list   -- for this, i.e ([s] -> [s])   --   -- not using eneeCheckIfDone because that loses final chunks at EOF   step sz pfxd icur (Chunk s)-    | LL.null s               = liftI (step sz pfxd icur)-    | LL.length s + sz < cksz = liftI (step (sz+LL.length s) (pfxd . (s:)) icur)+    | 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)     | otherwise               =         let (full, rest) = gsplit . mconcat $ pfxd [s]             pfxd'        = if LL.null rest then id else (rest:)-            onDone x str = return $ Left (x,str)-            onCont k Nothing = return . Right . Left . k $ Chunk full-            onCont k e       = return . Right $ Right (liftI k, e)-        in  do-              res <- lift $ runIter icur onDone onCont-              case res of-                Left (x,str) -> idone (idone x str) (Chunk rest)-                Right (Left inext)  -> liftI $ step (LL.length rest) pfxd' inext-                Right (Right (inext, e)) -> icont (step (LL.length rest)-                                                        pfxd' inext)-                                                  e+            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   step _ pfxd icur mErr = case pfxd [] of-                         []   -> idone icur mErr-                         rest -> do-                           inext <- lift $ enumPure1Chunk [mconcat rest] icur-                           idone inext mErr+                         []   -> return (idone icur, mErr)+                         rest -> ((, mErr) . idone) `liftM`+                                 enumPure1Chunk [mconcat rest] icur+   gsplit ls = case LL.splitAt cksz ls of     (g, rest) | LL.null rest -> if LL.length g == cksz                                    then ([g], LL.empty)@@ -531,10 +545,10 @@ --  -- The analogue of 'List.groupBy' groupBy-  :: (LL.ListLike s el, Monad m, Nullable s)+  :: forall s el m a. (LL.ListLike s el, Monad m, Nullable s)   => (el -> el -> Bool)   -> Enumeratee s [s] m a-groupBy same iinit = liftI $ go iinit (const True, id)+groupBy same iinit = icont $ go iinit (const True, id)   where      -- As in group, need to handle grouping efficiently when we're fed     -- many small chunks.@@ -548,24 +562,29 @@     -- unless the stream was entirely empty and there is no     -- accumulator.     go icurr pfx (Chunk s) = case gsplit pfx s of-      ([], partial)   -> liftI $ go icurr partial-      (full, partial) -> do+      ([], partial)   -> return (icont $ go icurr partial, mempty)+      (full, partial) ->         -- if the inner iteratee is done, the outer iteratee needs to be         -- notified to terminate.         -- if the inner iteratee is in an error state, that error should         -- be lifted to the outer iteratee-        let onCont k Nothing = return $ Right $ Left $ k $ Chunk full-            onCont k e       = return $ Right $ Right (liftI k, e)-            onDone x str     = return $ Left (x,str)-        res <- lift $ runIter icurr onDone onCont-        case res of-          Left (x,str) -> idone (idone x str) (Chunk (mconcat $ snd partial []))-          Right (Left inext)      -> liftI $ go inext partial-          Right (Right (inext,e)) -> icont (go inext partial) e+        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     go icurr (_inpfx, pfxd) (EOF mex) = case pfxd [] of-      [] -> lift . enumChunk (EOF mex) $ icurr-      rest -> do inext <- lift . enumPure1Chunk [mconcat rest] $ icurr-                 lift . enumChunk (EOF mex) $ inext+      [] -> ((,EOF mex) . idone) `liftM` enumChunk (EOF mex) icurr+      rest -> ((,EOF mex) . idone) `liftM`+               (enumPure1Chunk [mconcat rest] icurr >>= enumChunk (EOF mex))+     -- 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@@ -605,7 +624,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@@ -693,12 +712,12 @@   => (a -> el -> a)   -> a   -> Iteratee s m a-foldl f i = liftI (step i)+foldl f i = icontP (step i)   where-    step acc (Chunk xs)-      | LL.null xs  = liftI (step acc)-      | otherwise   = liftI (step $ FLL.foldl f acc xs)-    step acc stream = idone acc stream+    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) {-# INLINE foldl #-}  @@ -711,12 +730,12 @@   => (a -> el -> a)   -> a   -> Iteratee s m a-foldl' f i = liftI (step i)+foldl' f i = icontP (step i)   where-    step acc (Chunk xs)-      | LL.null xs = liftI (step acc)-      | otherwise  = liftI (step $! FLL.foldl' f acc xs)-    step acc stream = idone acc stream+    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) {-# INLINE foldl' #-}  -- | Variant of foldl with no base case.  Requires at least one element@@ -727,13 +746,14 @@   :: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)   => (el -> el -> el)   -> Iteratee s m el-foldl1 f = liftI step+foldl1 f = icontP step   where-    step (Chunk xs)+    step c@(Chunk xs)     -- After the first chunk, just use regular foldl.-      | LL.null xs = liftI step-      | otherwise  = foldl f $ FLL.foldl1 f xs-    step stream    = icont step (Just (setEOF stream))+      | LL.null xs = (icontP step, c)+      | otherwise  = (foldl f $ FLL.foldl1 f xs, mempty)+    step stream    = (ierr (icontP step) $ toException EofException+                      , stream) {-# INLINE foldl1 #-}  @@ -742,35 +762,36 @@   :: (Monad m, LL.ListLike s el, FLL.FoldableLL s el)   => (el -> el -> el)   -> Iteratee s m el-foldl1' f = liftI step+foldl1' f = icontP step   where-    step (Chunk xs)+    step c@(Chunk xs)     -- After the first chunk, just use regular foldl'.-      | LL.null xs = liftI step-      | otherwise  = foldl' f $ FLL.foldl1 f xs-    step stream    = icont step (Just (setEOF stream))+      | LL.null xs = (icontP step, c)+      | otherwise  = (foldl' f $ FLL.foldl1 f xs, mempty)+    step stream    = (ierr (icontP step) $ toException EofException+                      , stream) {-# INLINE foldl1' #-}   -- | Sum of a stream. sum :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el-sum = liftI (step 0)+sum = icontP (step 0)   where-    step acc (Chunk xs)-      | LL.null xs = liftI (step acc)-      | otherwise  = liftI (step $! acc + LL.sum xs)-    step acc str   = idone acc str+    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) {-# INLINE sum #-}   -- | Product of a stream. product :: (Monad m, LL.ListLike s el, Num el) => Iteratee s m el-product = liftI (step 1)+product = icontP (step 1)   where-    step acc (Chunk xs)-      | LL.null xs = liftI (step acc)-      | otherwise  = liftI (step $! acc * LL.product xs)-    step acc str   = idone acc str+    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) {-# INLINE product #-}  @@ -778,63 +799,37 @@ -- Zips  -- |Enumerate two iteratees over a single stream simultaneously.---  Deprecated, use `Data.Iteratee.ListLike.zip` instead. -- --- Compare to @zip@.-{-# DEPRECATED enumPair "use Data.Iteratee.ListLike.zip" #-}-enumPair-  :: (Monad m, Nullable s, LL.ListLike s el)-  => Iteratee s m a-  -> Iteratee s m b-  -> Iteratee s m (a, b)-enumPair = zip---- |Enumerate two iteratees over a single stream simultaneously.---  -- Compare to @List.zip@. zip   :: (Monad m, Nullable s, LL.ListLike s el)   => Iteratee s m a   -> Iteratee s m b   -> Iteratee s m (a, b)-zip x0 y0 = do-    -- need to check if both iteratees are initially finished.  If so,-    -- we don't want to push a chunk which will be dropped-    (a', x') <- lift $ runIter x0 od oc-    (b', y') <- lift $ runIter y0 od oc-    case checkDone a' b' of-      Just (Right (a,b,s))  -> idone (a,b) s  -- 's' may be EOF, needs to stay-      Just (Left (Left a))  -> liftM (a,) y'-      Just (Left (Right b)) -> liftM (,b) x'-      Nothing               -> liftI (step x' y')-  where-    step x y (Chunk xs) | nullC xs = liftI (step x y)-    step x y (Chunk xs) = do-      (a', x') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs x-      (b', y') <- lift $ (\i -> runIter i od oc) =<< enumPure1Chunk xs y-      case checkDone a' b' of-        Just (Right (a,b,s))  -> idone (a,b) s-        Just (Left (Left a))  -> liftM (a,) y'-        Just (Left (Right b)) -> liftM (,b) x'-        Nothing               -> liftI (step x' y')-    step x y (EOF err) = joinIM $ case err of-      Nothing -> (liftM2.liftM2) (,) (enumEof   x) (enumEof   y)-      Just e  -> (liftM2.liftM2) (,) (enumErr e x) (enumErr e y)+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 -    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 (zip (icont xK) i')+  ory xK mb doB    = ireq mb (zip (icont xK) . doB) -    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+  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) -    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@@ -876,37 +871,23 @@   => Iteratee s m a   -> Iteratee s m b   -> Iteratee s m (a, b)-enumWith i1 i2 = do-    -- as with zip, first check to see if the initial iteratee is complete,-    -- otherwise data would be dropped.-    -- running the second iteratee as well to prevent a monadic effect mismatch-    -- although I think that would be highly unlikely to happen in common-    -- code-    (a', x') <- lift $ runIter i1 od oc-    (_,  y') <- lift $ runIter i2 od oc-    case a' of-      Just (a, s) -> flip idone s =<< lift (liftM (a,) $ run i2)-      Nothing     -> go x' y'-  where-    od a s = return (Just (a, s), idone a s)-    oc k e = return (Nothing    , icont k e)+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 -    getUsed xs (Chunk ys) = LL.take (LL.length xs - LL.length ys) xs-    getUsed xs (EOF _)    = xs+  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) -    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)+  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) {-# INLINE enumWith #-}  -- |Enumerate a list of iteratees over a single stream simultaneously@@ -915,42 +896,38 @@ --  -- Compare to @Prelude.sequence_@. sequence_-  :: (Monad m, LL.ListLike s el, Nullable s)+  :: forall el s m a. (Monad m, LL.ListLike s el, Nullable s)   => [Iteratee s m a]   -> Iteratee s m ()-sequence_ = self+sequence_ = check []   where-    self is = liftI step-      where-        step (Chunk xs) | LL.null xs = liftI step-        step s@(Chunk _) = do-          -- give a chunk to each iteratee-          is'  <- lift $ mapM (enumChunk s) is-          -- filter done iteratees-          (done, notDone) <- lift $ partition fst `liftM` mapM enumCheckIfDone is'-          if Prelude.null notDone-            then idone () <=< remainingStream $ map snd done-            else self $ map snd notDone-        step s@(EOF _) = do-          s' <- remainingStream <=< lift $ mapM (enumChunk s) is-          case s' of-            EOF (Just e) -> throwErr e-            _            -> idone () s'+    -- 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. -    -- 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+    -- 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)) +    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)@@ -966,20 +943,26 @@                  (Monad m, LL.ListLike s el, Nullable s, Integral n) =>                  Iteratee s m a               -> Iteratee s m (a, n)-countConsumed i = go 0 (const i) (Chunk empty)+countConsumed = check 0   where-    go :: n -> (Stream s -> Iteratee s m a) -> Stream s-       -> Iteratee s m (a, n)-    go !n f str@(EOF _) = (, n) `liftM` f str-    go !n f str@(Chunk c) = Iteratee rI-      where-        newLen = n + fromIntegral (LL.length c)-        rI od oc = runIter (f str) onDone onCont-          where-            onDone a str'@(Chunk c') =-                od (a, newLen - fromIntegral (LL.length c')) str'-            onDone a str'@(EOF _) = od (a, n) str'-            onCont f' mExc = oc (go newLen f') mExc+    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) {-# INLINE countConsumed #-}  -- ------------------------------------------------------------------------@@ -995,56 +978,13 @@   where     enum' str' iter'       | LL.null str' = return iter'-      | otherwise    = let (s1, s2) = LL.splitAt n str'-                           on_cont k Nothing = enum' s2 . k $ Chunk s1-                           on_cont k e = return $ icont k e-                       in runIter iter' idoneM on_cont+      | 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 {-# 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 @@ -1054,11 +994,11 @@   :: (Monad m, LL.ListLike s el, Nullable s)   => (el -> m b)   -> Iteratee s m ()-mapM_ f = liftI step+mapM_ f = icont step   where-    step (Chunk xs) | LL.null xs = liftI step-    step (Chunk xs) = lift (LL.mapM_ f xs) >> liftI step-    step s@(EOF _)  = idone () s+    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) {-# INLINE mapM_ #-}  -- |The analogue of @Control.Monad.foldM@@@ -1067,11 +1007,10 @@   => (a -> b -> m a)   -> a   -> Iteratee s m a-foldM f e = liftI step+foldM f e = icont (step e)   where-    step (Chunk xs) | LL.null xs = liftI step-    step (Chunk xs) = do-        x <- lift $ f e (LL.head xs)-        joinIM $ enumPure1Chunk (LL.tail xs) (foldM f x)-    step (EOF _) = return e+    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) {-# INLINE foldM #-}

@@ -0,0 +1,289 @@+{-# LANGUAGE RankNTypes+            ,FlexibleContexts+            ,ScopedTypeVariables #-}++-- | Enumeratees - pass terminals variant.+-- +-- Provides enumeratees that pass terminal markers ('EOF') to the inner+-- 'iteratee'.+-- +-- Most enumeratees, upon receipt of @EOF@, will enter a done state and return+-- the inner iteratee without sending @EOF@ to it.  This allows for composing+-- enumerators as in:+-- +-- > myEnum extraData i = do+-- > nested <- enumFile "file" (mapChunks unpacker i)+-- > inner <- run nested+-- > enumList extraData inner+-- +-- if @mapChunks unpacker@ sent 'EOF' to the inner iteratee @i@, there would+-- be no way to submit extra data to it after 'run'ing the result from+-- @enumFile@.+-- +-- In certain cases, this is not the desired behavior.  Consider:+-- +-- > consumer :: Iteratee String IO ()+-- > consumer = icont (go 0)+-- >   where+-- >     go c (Chunk xs) = liftIO (putStr s) >> icont (go c)+-- >     go 10 e         = liftIO (putStr "10 loops complete")+-- >                         >> idone () (Chunk "")+-- >     go n  e         = I.seek 0 >> icont (go (n+1))+--+-- The @consumer@ iteratee does not complete until after it has received +-- 10 @EOF@s.  If you attempt to use it in a standard enumeratee, it will+-- never terminate.  When the outer enumeratee is terminated, the inner+-- iteratee will remain in a @cont@ state, but in general there is no longer+-- any valid data for the continuation.  The enumeratee itself must pass the+-- EOF marker to the inner iteratee and remain in a cont state until the inner+-- iteratee signals its completion.+-- +-- All enumeratees in this module will pass 'EOF' terminators to the inner+-- iteratees.++module Data.Iteratee.PTerm (+  -- * Nested iteratee combinators+   mapChunksPT+  ,mapChunksMPT+  ,convStreamPT+  ,unfoldConvStreamPT+  ,unfoldConvStreamCheckPT+  -- * ListLike analog functions+  ,breakEPT+  ,takePT+  ,takeUpToPT+  ,takeWhileEPT+  ,mapStreamPT+  ,rigidMapStreamPT+  ,filterPT+)+where++import Prelude hiding (head, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product)++import           Data.Iteratee.Iteratee+import           Data.Iteratee.ListLike (drop)++import qualified Data.ListLike as LL++import           Control.Arrow ((***), first)+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'++-- | Convert one stream into another with the supplied mapping function.+-- +-- A version of 'mapChunks' that sends 'EOF's to the inner iteratee.+-- +mapChunksPT :: (NullPoint s, Monad m) => (s -> s') -> Enumeratee s s' m a+mapChunksPT f = go+ 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))+{-# INLINE mapChunksPT #-}++-- | Convert a stream of @s@ to a stream of @s'@ using the supplied function.+-- +-- A version of 'mapChunksM' that sends 'EOF's to the inner iteratee.+mapChunksMPT+  :: (Monad m, NullPoint s, Nullable s)+  => (s -> m s')+  -> Enumeratee s s' m a+mapChunksMPT f = go+ 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)+{-# INLINE mapChunksMPT #-}++-- |Convert one stream into another, not necessarily in lockstep.+-- +-- A version of 'convStream' that sends 'EOF's to the inner iteratee.+convStreamPT+  :: (Monad m, Nullable s, NullPoint s')+  =>  Iteratee s m s'+  -> Enumeratee s s' m a+convStreamPT fi = go+  where+    go = eneeCheckIfDonePass check+    check k = 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+{-# INLINABLE convStreamPT #-}++-- |The most general stream converter.+-- +-- A version of 'unfoldConvStream' that sends 'EOF's to the inner iteratee.+unfoldConvStreamPT ::+ (Monad m, Nullable s, NullPoint s') =>+  (acc -> Iteratee s m (acc, s'))+  -> acc+  -> Enumeratee s s' m a+unfoldConvStreamPT f acc0 = go acc0+  where+    go acc = eneeCheckIfDonePass (check acc)+    check acc k = 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 #-}++-- | 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))+      -> Enumeratee elo eli m a+     )+  -> (acc -> Iteratee elo m (acc, eli))+  -> acc+  -> Enumeratee elo eli m a+unfoldConvStreamCheckPT checkDone f acc0 = go 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+{-# INLINABLE unfoldConvStreamCheckPT #-}++-- -------------------------------------+-- ListLike variants++-- | A variant of 'Data.Iteratee.ListLike.breakE' that passes 'EOF's.+breakEPT+  :: (LL.ListLike s el, NullPoint s, Monad m)+  => (el -> Bool)+  -> Enumeratee s s m a+breakEPT cpred = go+ where+  go = eneeCheckIfDonePass (icont . step)+  step k s'@(Chunk s)+      | LL.null s  = return (icont (step k), s')+      | 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+{-# INLINE breakEPT #-}++-- | A variant of 'Data.Iteratee.ListLike.take' that passes 'EOF's.+takePT ::+  (Monad m, Nullable s, LL.ListLike s el)+  => Int   -- ^ number of elements to consume+  -> Enumeratee s s m a+takePT n' iter+  | n' <= 0   = return iter+  | otherwise = 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)+      where (s1, s2) = LL.splitAt n str+  step _n k stream       = (idone *** const stream) <$> k 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+  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+         -- 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+{-# INLINE takeUpToPT #-}++-- | A variant of 'Data.Iteratee.ListLike.takeWhileE' that passes 'EOF's.+takeWhileEPT+ :: (LL.ListLike s el, NullPoint s, Monad m)+ => (el -> Bool)+ -> Enumeratee s s m a+takeWhileEPT = breakEPT . (not .)+{-# INLINEABLE takeWhileEPT #-}++-- | A variant of 'Data.Iteratee.ListLike.mapStream' that passes 'EOF's.+mapStreamPT+  :: (LL.ListLike (s el) el+     ,LL.ListLike (s el') el'+     ,NullPoint (s el)+     ,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 #-}++-- | A variant of 'Data.Iteratee.ListLike.rigidMapStream' that passes 'EOF's.+rigidMapStreamPT+  :: (LL.ListLike s el, Monad m, 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 #-}++-- | A variant of 'Data.Iteratee.ListLike.filter' that passes 'EOF's.+filterPT+  :: (Monad m, Nullable s, LL.ListLike s el)+  => (el -> Bool)+  -> Enumeratee s s m a+filterPT p = convStreamPT (LL.filter p <$> getChunk)+{-# INLINE filterPT #-}

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

@@ -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.liftI step+idChunk = I.icontP step   where     step (I.Chunk xs)-      | LL.null xs      = idChunk-      | True            = idone xs (I.Chunk mempty)+      | LL.null xs      = (idChunk, mempty)+      | True            = (idone xs, mempty) convBenches = [conv1, conv2]  instance NFData BS.ByteString where

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -O #-}-{-# LANGUAGE NoMonomorphismRestriction, ViewPatterns #-}+{-# LANGUAGE NoMonomorphismRestriction, ViewPatterns, TupleSections #-}  import Prelude as P @@ -22,6 +22,7 @@  import           Control.Monad as CM import           Control.Monad.Writer+import           Control.Exception (SomeException)  instance Show (a -> b) where   show _ = "<<function>>"@@ -296,10 +297,10 @@   where types = (xs :: [Int])  convId :: (LL.ListLike s el, Monad m) => Iteratee s m s-convId = liftI (\str -> case str of-  s@(Chunk xs) | LL.null xs -> convId-  s@(Chunk xs) -> idone xs (Chunk mempty)-  s@(EOF e)    -> idone mempty (EOF e)+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)   )  prop_convId xs = runner1 (enumPure1Chunk xs convId) == xs@@ -430,7 +431,48 @@     y <- Iter.head     lift $ tell [y] +-- ---------------------------------------------+-- Data.Iteratee.PTerm +mk_prop_pt_id etee p_etee i xs n = n > 0 ==>+  runner1 (enumSpecial xs n $ joinI (p_etee i))+  == runner1 (enumSpecial xs n $ joinI (etee i))+ where types = (etee, p_etee, i, xs) :: (Etee, Etee, Itee, [Int])++instance Eq SomeException where+  l == r = show l == show r++type Etee = Enumeratee [Int] [Int] Identity [Int]+type Itee = Iteratee [Int] Identity [Int]++prop_mapChunksPT f i = mk_prop_pt_id (mapChunks f) (mapChunksPT f)+ where types = (i :: Itee)++prop_mapChunksMPT f i =+  mk_prop_pt_id (mapChunksM (return . f)) (mapChunksMPT (return . f))+ where types = (i :: Itee)++-- would like to test with arbitrary iteratees, but we need to guarantee+-- that they will return a value from the stream, which isn't always true+-- for the arbitrary instance.+-- could use a newtype to make it work...+prop_convStreamPT = mk_prop_pt_id (convStream getChunk) (convStreamPT getChunk)++prop_unfoldConvStreamPT f =+  mk_prop_pt_id (unfoldConvStream f' (0 :: Int)) (unfoldConvStreamPT f' 0)+ where f' x = fmap (f x,) getChunk++prop_breakEPT i = mk_prop_pt_id (breakE i) (breakEPT i)+prop_takePT i = mk_prop_pt_id (Iter.take i) (takePT i)+prop_takeUpToPT i = mk_prop_pt_id (Iter.takeUpTo i) (takeUpToPT i)+prop_takeWhileEPT i = mk_prop_pt_id (Iter.takeWhileE i) (takeWhileEPT i)++prop_mapStreamPT i = mk_prop_pt_id (Iter.mapStream i) (mapStreamPT i)+prop_rigidMapStreamPT i =+  mk_prop_pt_id (Iter.rigidMapStream i) (rigidMapStreamPT i)+prop_filterPT i = mk_prop_pt_id (Iter.filter i) (filterPT i)++ -- --------------------------------------------- -- Data.Iteratee.Char @@ -535,6 +577,19 @@    ]   ,testGroup "Data.Iteratee.Char" [     --testProperty "line" prop_line+    ]+  ,testGroup "PT variants" [+     testProperty "mapChunksPT" prop_mapChunksPT+    ,testProperty "mapChunksMPT" prop_mapChunksMPT+    ,testProperty "convStreamPT" prop_convStreamPT+    ,testProperty "unfoldConvStreamPT" prop_unfoldConvStreamPT+    ,testProperty "breakEPT" prop_breakEPT+    ,testProperty "takePT" prop_takePT+    ,testProperty "takeUpToPT" prop_takeUpToPT+    ,testProperty "takeWhileEPT" prop_takeWhileEPT+    ,testProperty "mapStreamPT" prop_mapStreamPT+    ,testProperty "rigidMapStreamPT" prop_rigidMapStreamPT+    ,testProperty "filterPT" prop_filterPT     ]   ,testGroup "Monadic functions" [     testProperty "mapM_" prop_mapM_