Furrow.hs

module Bio.Streaming.Furrow
    ( Furrow(..)
    , evertStream
    , afford
    , drain
    ) where

import Bio.Prelude
import Bio.Streaming

{- | A tiny stream that can be afforded to incrementally.

The streaming abstraction works fine if multiple sources feed into a
small constant number of functions, but fails if there is an
unpredictable number of such consumers.  In that case, 'evertStream'
should be used to turn each consumer into a 'Furrow'.  It's then
possible to incrementally 'afford' stuff to each 'Furrow' in a
collection in a simple loop.  To get the final value, 'drain' each
'Furrow'.
-}
newtype Furrow a m r = Furrow (Stream ((->) (Maybe a)) m r) deriving
  (Functor, Applicative, Monad, MonadTrans, MonadIO, MFunctor, MMonad)

instance MonadThrow m => MonadThrow (Furrow a m) where
    throwM = Furrow . lift . throwM

afford :: Monad m => Furrow a m b -> a -> m (Furrow a m b)
afford (Furrow s) a = inspect s >>= \case
    Left  b -> return (Furrow (pure b))
    Right f -> return (Furrow (f (Just a)))

drain :: Monad m => Furrow a m b -> m b
drain (Furrow s) = inspect s >>= \case
    Left  b -> return b
    Right f -> inspect (f Nothing) >>= \case
        Left  b -> return b
        Right _ -> error "continuedAfterEOF"

-- | Turns a function that consumes a stream into a furrow.  Idea and
-- some code stolen from \"streaming-eversion\".
evertStream :: Monad m => (Stream (Of a) (Furrow a m) () -> Furrow a m b) -> Furrow a m b
evertStream consumer = consumer cat
  where
    cat = lift (Furrow (yields id)) >>= maybe (pure ()) (\a -> wrap (a :> cat))