module Data.Drinkery.Distiller
( Distiller
, (+&)
, ($&)
, (++$)
, (++&)
, reservingTap
, echo
, mapping
, traversing
, filtering
, scanning
, repeating
) where
import Control.Monad.Catch (onException, MonadCatch)
import Control.Monad.Trans
import Data.Drinkery.Tap
import Data.Drinkery.Class
import Data.Semigroup
type Distiller tap r s m = Tap r s (Sink tap m)
infix 6 +&
infixr 7 $&
infixr 7 ++&
infixl 8 ++$
(++&) :: (Applicative m) => tap m -> Sink tap m a -> m (tap m, a)
d ++& b = unSink b d $ \a t -> pure (t, a)
(++$) :: (Applicative m) => tap m -> Distiller tap r s m -> Tap r s m
(++$) = go where
go t d = Tap $ \r -> unSink (unTap d r) t
$ \(s, d') t' -> pure (s, go t' d')
(+&) :: (Closable tap, MonadCatch m) => tap m -> Sink tap m a -> m a
t +& b = do
(a, t') <- runSink b t `onException` close t
close t'
return a
($&) :: (Monad m) => tap m -> Sink tap m a -> m a
t $& b = fmap fst $ runSink b t
echo :: Monad m => Distiller (Tap r s) r s m
echo = mapping id
mapping :: (Monad m) => (a -> b) -> Distiller (Tap r a) r b m
mapping f = go where
go = reservingTap $ \a -> pure (f a, go)
reservingTap :: Monad m => (a -> Sink (Tap r a) m (b, Distiller (Tap r a) r b m)) -> Distiller (Tap r a) r b m
reservingTap k = Tap $ \r -> Sink $ \t cont -> do
(a, t') <- unTap t r
unSink (k a) t' cont
traversing :: (Monad m) => (a -> m b) -> Distiller (Tap r a) r b m
traversing f = go where
go = reservingTap $ \a -> do
b <- lift $ f a
return (b, go)
filtering :: (Monoid r, Monad m) => (a -> Bool) -> Distiller (Tap r a) r a m
filtering f = go where
go = reservingTap $ \a -> if f a
then return (a, go)
else unTap go mempty
scanning :: Monad m => (b -> a -> b) -> b -> Distiller (Tap r a) r b m
scanning f b0 = go b0 where
go b = reservingTap $ \a -> do
let !b' = f b a
return (b', go $ b')
repeating :: (MonadSink (Tap r a) m, Semigroup r) => m b -> Tap r b m
repeating m = go where
go = Tap $ \r -> do
request r
a <- m
return (a, go)