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
  (a -> Furrow a m b -> Furrow a m a
(a -> b) -> Furrow a m a -> Furrow a m b
(forall a b. (a -> b) -> Furrow a m a -> Furrow a m b)
-> (forall a b. a -> Furrow a m b -> Furrow a m a)
-> Functor (Furrow a m)
forall a b. a -> Furrow a m b -> Furrow a m a
forall a b. (a -> b) -> Furrow a m a -> Furrow a m b
forall a (m :: * -> *) a b.
Monad m =>
a -> Furrow a m b -> Furrow a m a
forall a (m :: * -> *) a b.
Monad m =>
(a -> b) -> Furrow a m a -> Furrow a m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Furrow a m b -> Furrow a m a
$c<$ :: forall a (m :: * -> *) a b.
Monad m =>
a -> Furrow a m b -> Furrow a m a
fmap :: (a -> b) -> Furrow a m a -> Furrow a m b
$cfmap :: forall a (m :: * -> *) a b.
Monad m =>
(a -> b) -> Furrow a m a -> Furrow a m b
Functor, Functor (Furrow a m)
a -> Furrow a m a
Functor (Furrow a m) =>
(forall a. a -> Furrow a m a)
-> (forall a b.
    Furrow a m (a -> b) -> Furrow a m a -> Furrow a m b)
-> (forall a b c.
    (a -> b -> c) -> Furrow a m a -> Furrow a m b -> Furrow a m c)
-> (forall a b. Furrow a m a -> Furrow a m b -> Furrow a m b)
-> (forall a b. Furrow a m a -> Furrow a m b -> Furrow a m a)
-> Applicative (Furrow a m)
Furrow a m a -> Furrow a m b -> Furrow a m b
Furrow a m a -> Furrow a m b -> Furrow a m a
Furrow a m (a -> b) -> Furrow a m a -> Furrow a m b
(a -> b -> c) -> Furrow a m a -> Furrow a m b -> Furrow a m c
forall a. a -> Furrow a m a
forall a b. Furrow a m a -> Furrow a m b -> Furrow a m a
forall a b. Furrow a m a -> Furrow a m b -> Furrow a m b
forall a b. Furrow a m (a -> b) -> Furrow a m a -> Furrow a m b
forall a b c.
(a -> b -> c) -> Furrow a m a -> Furrow a m b -> Furrow a m c
forall a (m :: * -> *). Monad m => Functor (Furrow a m)
forall a (m :: * -> *) a. Monad m => a -> Furrow a m a
forall a (m :: * -> *) a b.
Monad m =>
Furrow a m a -> Furrow a m b -> Furrow a m a
forall a (m :: * -> *) a b.
Monad m =>
Furrow a m a -> Furrow a m b -> Furrow a m b
forall a (m :: * -> *) a b.
Monad m =>
Furrow a m (a -> b) -> Furrow a m a -> Furrow a m b
forall a (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Furrow a m a -> Furrow a m b -> Furrow a m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Furrow a m a -> Furrow a m b -> Furrow a m a
$c<* :: forall a (m :: * -> *) a b.
Monad m =>
Furrow a m a -> Furrow a m b -> Furrow a m a
*> :: Furrow a m a -> Furrow a m b -> Furrow a m b
$c*> :: forall a (m :: * -> *) a b.
Monad m =>
Furrow a m a -> Furrow a m b -> Furrow a m b
liftA2 :: (a -> b -> c) -> Furrow a m a -> Furrow a m b -> Furrow a m c
$cliftA2 :: forall a (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Furrow a m a -> Furrow a m b -> Furrow a m c
<*> :: Furrow a m (a -> b) -> Furrow a m a -> Furrow a m b
$c<*> :: forall a (m :: * -> *) a b.
Monad m =>
Furrow a m (a -> b) -> Furrow a m a -> Furrow a m b
pure :: a -> Furrow a m a
$cpure :: forall a (m :: * -> *) a. Monad m => a -> Furrow a m a
$cp1Applicative :: forall a (m :: * -> *). Monad m => Functor (Furrow a m)
Applicative, Applicative (Furrow a m)
a -> Furrow a m a
Applicative (Furrow a m) =>
(forall a b. Furrow a m a -> (a -> Furrow a m b) -> Furrow a m b)
-> (forall a b. Furrow a m a -> Furrow a m b -> Furrow a m b)
-> (forall a. a -> Furrow a m a)
-> Monad (Furrow a m)
Furrow a m a -> (a -> Furrow a m b) -> Furrow a m b
Furrow a m a -> Furrow a m b -> Furrow a m b
forall a. a -> Furrow a m a
forall a b. Furrow a m a -> Furrow a m b -> Furrow a m b
forall a b. Furrow a m a -> (a -> Furrow a m b) -> Furrow a m b
forall a (m :: * -> *). Monad m => Applicative (Furrow a m)
forall a (m :: * -> *) a. Monad m => a -> Furrow a m a
forall a (m :: * -> *) a b.
Monad m =>
Furrow a m a -> Furrow a m b -> Furrow a m b
forall a (m :: * -> *) a b.
Monad m =>
Furrow a m a -> (a -> Furrow a m b) -> Furrow a m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Furrow a m a
$creturn :: forall a (m :: * -> *) a. Monad m => a -> Furrow a m a
>> :: Furrow a m a -> Furrow a m b -> Furrow a m b
$c>> :: forall a (m :: * -> *) a b.
Monad m =>
Furrow a m a -> Furrow a m b -> Furrow a m b
>>= :: Furrow a m a -> (a -> Furrow a m b) -> Furrow a m b
$c>>= :: forall a (m :: * -> *) a b.
Monad m =>
Furrow a m a -> (a -> Furrow a m b) -> Furrow a m b
$cp1Monad :: forall a (m :: * -> *). Monad m => Applicative (Furrow a m)
Monad, m a -> Furrow a m a
(forall (m :: * -> *) a. Monad m => m a -> Furrow a m a)
-> MonadTrans (Furrow a)
forall a (m :: * -> *) a. Monad m => m a -> Furrow a m a
forall (m :: * -> *) a. Monad m => m a -> Furrow a m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Furrow a m a
$clift :: forall a (m :: * -> *) a. Monad m => m a -> Furrow a m a
MonadTrans, Monad (Furrow a m)
Monad (Furrow a m) =>
(forall a. IO a -> Furrow a m a) -> MonadIO (Furrow a m)
IO a -> Furrow a m a
forall a. IO a -> Furrow a m a
forall a (m :: * -> *). MonadIO m => Monad (Furrow a m)
forall a (m :: * -> *) a. MonadIO m => IO a -> Furrow a m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Furrow a m a
$cliftIO :: forall a (m :: * -> *) a. MonadIO m => IO a -> Furrow a m a
$cp1MonadIO :: forall a (m :: * -> *). MonadIO m => Monad (Furrow a m)
MonadIO, (forall a. m a -> n a) -> Furrow a m b -> Furrow a n b
(forall (m :: * -> *) (n :: * -> *) b.
 Monad m =>
 (forall a. m a -> n a) -> Furrow a m b -> Furrow a n b)
-> MFunctor (Furrow a)
forall a (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Furrow a m b -> Furrow a n b
forall k (t :: (* -> *) -> k -> *).
(forall (m :: * -> *) (n :: * -> *) (b :: k).
 Monad m =>
 (forall a. m a -> n a) -> t m b -> t n b)
-> MFunctor t
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Furrow a m b -> Furrow a n b
hoist :: (forall a. m a -> n a) -> Furrow a m b -> Furrow a n b
$choist :: forall a (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Furrow a m b -> Furrow a n b
MFunctor, MFunctor (Furrow a)
MonadTrans (Furrow a)
(MFunctor (Furrow a), MonadTrans (Furrow a)) =>
(forall (n :: * -> *) (m :: * -> *) b.
 Monad n =>
 (forall a. m a -> Furrow a n a) -> Furrow a m b -> Furrow a n b)
-> MMonad (Furrow a)
(forall a. m a -> Furrow a n a) -> Furrow a m b -> Furrow a n b
forall a. MFunctor (Furrow a)
forall a. MonadTrans (Furrow a)
forall a (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> Furrow a n a) -> Furrow a m b -> Furrow a n b
forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> Furrow a n a) -> Furrow a m b -> Furrow a n b
forall (t :: (* -> *) -> * -> *).
(MFunctor t, MonadTrans t) =>
(forall (n :: * -> *) (m :: * -> *) b.
 Monad n =>
 (forall a. m a -> t n a) -> t m b -> t n b)
-> MMonad t
embed :: (forall a. m a -> Furrow a n a) -> Furrow a m b -> Furrow a n b
$cembed :: forall a (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> Furrow a n a) -> Furrow a m b -> Furrow a n b
$cp2MMonad :: forall a. MonadTrans (Furrow a)
$cp1MMonad :: forall a. MFunctor (Furrow a)
MMonad)

instance MonadThrow m => MonadThrow (Furrow a m) where
    throwM :: e -> Furrow a m a
throwM = Stream ((->) (Maybe a)) m a -> Furrow a m a
forall a (m :: * -> *) r.
Stream ((->) (Maybe a)) m r -> Furrow a m r
Furrow (Stream ((->) (Maybe a)) m a -> Furrow a m a)
-> (e -> Stream ((->) (Maybe a)) m a) -> e -> Furrow a m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m a -> Stream ((->) (Maybe a)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Stream ((->) (Maybe a)) m a)
-> (e -> m a) -> e -> Stream ((->) (Maybe a)) m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

afford :: Monad m => Furrow a m b -> a -> m (Furrow a m b)
afford :: Furrow a m b -> a -> m (Furrow a m b)
afford (Furrow s :: Stream ((->) (Maybe a)) m b
s) a :: a
a = Stream ((->) (Maybe a)) m b
-> m (Either b (Maybe a -> Stream ((->) (Maybe a)) m b))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream ((->) (Maybe a)) m b
s m (Either b (Maybe a -> Stream ((->) (Maybe a)) m b))
-> (Either b (Maybe a -> Stream ((->) (Maybe a)) m b)
    -> m (Furrow a m b))
-> m (Furrow a m b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left  b :: b
b -> Furrow a m b -> m (Furrow a m b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream ((->) (Maybe a)) m b -> Furrow a m b
forall a (m :: * -> *) r.
Stream ((->) (Maybe a)) m r -> Furrow a m r
Furrow (b -> Stream ((->) (Maybe a)) m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b))
    Right f :: Maybe a -> Stream ((->) (Maybe a)) m b
f -> Furrow a m b -> m (Furrow a m b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream ((->) (Maybe a)) m b -> Furrow a m b
forall a (m :: * -> *) r.
Stream ((->) (Maybe a)) m r -> Furrow a m r
Furrow (Maybe a -> Stream ((->) (Maybe a)) m b
f (a -> Maybe a
forall a. a -> Maybe a
Just a
a)))

drain :: Monad m => Furrow a m b -> m b
drain :: Furrow a m b -> m b
drain (Furrow s :: Stream ((->) (Maybe a)) m b
s) = Stream ((->) (Maybe a)) m b
-> m (Either b (Maybe a -> Stream ((->) (Maybe a)) m b))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream ((->) (Maybe a)) m b
s m (Either b (Maybe a -> Stream ((->) (Maybe a)) m b))
-> (Either b (Maybe a -> Stream ((->) (Maybe a)) m b) -> m b)
-> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left  b :: b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
    Right f :: Maybe a -> Stream ((->) (Maybe a)) m b
f -> Stream ((->) (Maybe a)) m b
-> m (Either b (Maybe a -> Stream ((->) (Maybe a)) m b))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect (Maybe a -> Stream ((->) (Maybe a)) m b
f Maybe a
forall a. Maybe a
Nothing) m (Either b (Maybe a -> Stream ((->) (Maybe a)) m b))
-> (Either b (Maybe a -> Stream ((->) (Maybe a)) m b) -> m b)
-> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left  b :: b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
        Right _ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
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 :: (Stream (Of a) (Furrow a m) () -> Furrow a m b) -> Furrow a m b
evertStream consumer :: Stream (Of a) (Furrow a m) () -> Furrow a m b
consumer = Stream (Of a) (Furrow a m) () -> Furrow a m b
consumer Stream (Of a) (Furrow a m) ()
forall a. Stream (Of a) (Furrow a m) ()
cat
  where
    cat :: Stream (Of a) (Furrow a m) ()
cat = Furrow a m (Maybe a) -> Stream (Of a) (Furrow a m) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream ((->) (Maybe a)) m (Maybe a) -> Furrow a m (Maybe a)
forall a (m :: * -> *) r.
Stream ((->) (Maybe a)) m r -> Furrow a m r
Furrow ((Maybe a -> Maybe a) -> Stream ((->) (Maybe a)) m (Maybe a)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f r -> Stream f m r
yields Maybe a -> Maybe a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)) Stream (Of a) (Furrow a m) (Maybe a)
-> (Maybe a -> Stream (Of a) (Furrow a m) ())
-> Stream (Of a) (Furrow a m) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) (Furrow a m) ()
-> (a -> Stream (Of a) (Furrow a m) ())
-> Maybe a
-> Stream (Of a) (Furrow a m) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Stream (Of a) (Furrow a m) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\a :: a
a -> Of a (Stream (Of a) (Furrow a m) ())
-> Stream (Of a) (Furrow a m) ()
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (a
a a
-> Stream (Of a) (Furrow a m) ()
-> Of a (Stream (Of a) (Furrow a m) ())
forall a b. a -> b -> Of a b
:> Stream (Of a) (Furrow a m) ()
cat))