module Data.Drinkery.Distiller
( Distiller
, (+&)
, ($&)
, (++$)
, (++&)
, Still
, scanningMaybe
, filteringMaybe
, mapping
, traversing
, filtering
, scanning
) where
import Control.Monad.Trans
import Data.Drinkery.Tap
import Data.Drinkery.Class
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, Monad m) => tap m -> Drinker tap m a -> m a
t +& b = do
(a, t') <- runDrinker b t
close t'
return a
($&) :: (Monad m) => tap m -> Drinker tap m a -> m a
t $& b = fmap fst $ runDrinker b t
type Still p q r s m = Distiller (Tap p q) r s m
scanningMaybe :: (Monoid r, Monad m) => (b -> a -> b) -> b -> Still r (Maybe a) r (Maybe b) m
scanningMaybe f b0 = consTap (Just b0) $ go b0 where
go b = Tap $ \r -> Drinker $ \tap -> do
(m, t') <- unTap tap r
case m of
Just a -> let !b' = f b a in return ((Just b', go b'), t')
Nothing -> return ((Nothing, go b), t')
filteringMaybe :: (Monoid r, Monad m) => (a -> Bool) -> Still r (Maybe a) r (Maybe a) m
filteringMaybe = filtering . maybe True
propagating :: (Monoid r, Monad m) => Drinker (Tap r a) m (b, Still r a r b m) -> Still r a r b m
propagating m = Tap $ \r -> request r >> m
mapping :: (Monoid r, Monad m) => (a -> b) -> Still r a r b m
mapping f = go where
go = propagating $ drink >>= \a -> return (f a, go)
traversing :: (Monoid r, Monad m) => (a -> m b) -> Still r a r b m
traversing f = go where
go = propagating $ drink >>= \a -> lift (f a) >>= \b -> return (b, go)
filtering :: (Monoid r, Monad m) => (a -> Bool) -> Still r a r a m
filtering f = go where
go = propagating $ drink >>= \a -> if f a
then return (a, go)
else unTap go mempty
scanning :: (Monoid r, Monad m) => (b -> a -> b) -> b -> Still r a r b m
scanning f b0 = consTap b0 $ go b0 where
go b = propagating $ fmap (\a -> let !b' = f b a in (b', go $ b')) drink