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
import Data.Tuple
type Distiller tap r s m = Tap r s (Drinker tap m)
infix 6 +&
infixr 7 $&
infixr 7 ++&
infixl 8 ++$
(++&) :: (Functor m) => tap m -> Drinker tap m a -> m (tap m, a)
d ++& b = swap <$> runDrinker b d
(++$) :: (Functor m) => tap m -> Distiller tap r s m -> Tap r s m
(++$) = go where
go t d = Tap $ \r -> (\((s, d'), t') -> (s, go t' d'))
<$> runDrinker (unTap d r) t
(+&) :: (Closable tap, MonadCatch m) => tap m -> Drinker tap m a -> m a
t +& b = do
(a, t') <- runDrinker b t `onException` close t
close t'
return a
($&) :: (Monad m) => tap m -> Drinker tap m a -> m a
t $& b = fmap fst $ runDrinker 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 = Tap $ \r -> drinking $ \t -> fmap (\(s, t') -> ((f s, go), t')) $ unTap t r
reservingTap :: MonadDrunk (Tap r a) m => (a -> m (s, Tap r s m)) -> Tap r s m
reservingTap k = Tap $ \r -> do
a <- drinking $ \t -> unTap t r
k a
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 :: (MonadDrunk (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)