Ideas for conduit-extras.

gistfile1.hs

-- | Just like 'awaitForever', but adds state that is passed between
-- invocations of conduits.
awaitFold :: (Monad m) => (r -> i -> ConduitM i o m r) -> r -> Conduit i m o
awaitFold f = loop
  where
    loop r = await >>= maybe (return ()) (f r >=> mseq loop)
{-# INLINE awaitFold #-}

-- | Just like 'awaitFold', but allows premature termination of a
-- conduit by returning @mzero@.
awaitFold' :: (Monad m) => (r -> i -> MaybeT (ConduitM i o m) r) -> r -> Conduit i m o
awaitFold' f r = runMaybeT (loop r) >> return ()
  where
    loop x = MaybeT await >>= f x >>= mseq loop
{-# INLINE awaitFold' #-}

-- | Passes data through while it satisfies a given predicate.
-- Pushes the first non-satisfying input back as a left-over, so only
-- satisfying inputs are percieved to be consumed.
while :: (Monad m) => (a -> Bool) -> Conduit a m a
while p = runMaybeT loop >> return ()
  where
    loop = do
        i <- MaybeT await
        -- If @i@ fails the predicate, @leftover@ it and terminate using @mzero@:
        guard (p i) `mplus` (lift (leftover i) >> mzero)
        lift (yield i)
        loop


-- | Somewhat esoteric function, probably only useful with `MaybeT`.
awaitM :: (MonadTrans t, Monad m, MonadPlus (t (ConduitM i o m)))
       => t (ConduitM i o m) i
awaitM = lift await >>= maybe mzero return
{-# INLINE awaitM #-}



-- | Forces evaluation of a value evaluating a monadic function. This is
-- somewhat stronger than `seq`, because it ensures that the argument is always
-- evaluated, even if the monadic function doesn't use it.
mseq :: (a -> m b) -> a -> m b
mseq f x = x `seq` f x
{-# INLINE mseq #-}