{-# LANGUAGE Rank2Types, BangPatterns #-} module Data.SouSiT.Sink ( Sink(..), SinkStatus(..), closeSink, -- * monadic functions inputOr, input, skip, -- * utility functions appendSink, (=||=), feedList, liftSink, -- * sink construction -> Sink i m r) (m r) | Done (m r) instance Monad m => Functor (Sink i m) where fmap f (Sink st) = Sink (liftM mp st) where mp (Done r) = Done (liftM f r) mp (Cont nf cf) = Cont (fmap f . nf) (liftM f cf) instance Monad m => Monad (Sink i m) where return a = doneSink $ return a (Sink st) >>= f = Sink (st >>= mp) where mp (Done r) = liftM f r >>= sinkStatus mp (Cont nf cf) = return $ Cont ((>>= -> Sink i m r feedList [] !s = s feedList (x:xs) !s = Sink (sinkStatus s >>= step) where step (Done r) = return $ Done r step (Cont f _) = sinkStatus $ feedList xs $ f x contSink :: Monad m => (i -> Sink i m r) -> m r -> Sink i m r contSink next = Sink . return . Cont f (return ()) where f i = Sink $ process i >> sinkStatus  = Sink $ open >>= flip step i step rs i = process rs i >> return (Cont (Sink . f = contSink step (return Nothing) where step i = Sink $ liftM cont (f i) cont Nothing = Cont step (return Nothing) cont result = Done $ return (liftSink t . nf) (t cf)