module Control.Object.Stream where
import Data.Functor.Rep
import Data.Functor.Adjunction
import Control.Object.Object
import Data.Foldable as F
import Control.Applicative
import Data.Functor.Request
import Control.Monad
import Control.Monad.Trans.Either
import Control.Object.Mortal
($$) :: (Monad m, Adjunction f g) => Object g m -> Object f m -> m x
a $$ b = do
(x, a') <- runObject a askRep
((), b') <- runObject b (unit () `index` x)
a' $$ b'
infix 1 $$
($?$) :: (Monad m, Adjunction f g) => Object g (EitherT a m) -> Object f (EitherT a m) -> m a
a $?$ b = liftM (either id id) $ runEitherT (a $$ b)
(!$$!) :: (Monad m, Adjunction f g) => Mortal g m a -> Mortal f m a -> m a
Mortal a !$$! Mortal b = a $?$ b
fromFoldable :: (Foldable t, Alternative m, Representable f) => t (Rep f) -> Object f m
fromFoldable = F.foldr go $ Object $ const empty where
go x m = Object $ \cont -> pure (index cont x, m)
mapL :: (Adjunction f g, Adjunction f' g', Functor m) => (Rep g' -> Rep g) -> Object f m -> Object f' m
mapL t = (^>>@) $ rightAdjunct $ \x -> tabulate (index (unit x) . t)
mapR :: (Representable f, Representable g, Functor m) => (Rep f -> Rep g) -> Object f m -> Object g m
mapR t = (^>>@) $ \f -> tabulate (index f . t)
filterL :: (Adjunction f g, Applicative m) => (Rep g -> Bool) -> Object f m -> Object f m
filterL p obj = Object $ \f -> if counit (tabulate p <$ f)
then fmap (filterL p) `fmap` runObject obj f
else pure (extractL f, filterL p obj)
filterR :: (Representable f, Monad m) => (Rep f -> Bool) -> Object f m -> Object f m
filterR p obj = Object $ \f -> go f obj where
go f o = do
(x, o') <- runObject o askRep
if p x
then return (index f x, filterR p o')
else go f o'
($$@) :: (Representable f, Representable g, Monad m) => Object f m -> Object (Request (Rep f) (Rep g)) m -> Object g m
obj $$@ pro = Object $ \g -> do
(x, obj') <- runObject obj askRep
(a, pro') <- runObject pro $ Request x (index g)
return (a, obj' $$@ pro')
(@$$) :: (Adjunction f g, Adjunction f' g', Monad m) => Object (Request (Rep g') (Rep g)) m -> Object f m -> Object f' m
pro @$$ obj = Object $ \f' -> do
let (a, f_) = splitL f'
(x, pro') <- runObject pro $ Request (counit (askRep <$ f_)) id
((), obj') <- runObject obj $ unit () `index` x
return (a, pro' @$$ obj')