module Control.Joint.Schemes.UT where import "comonad" Control.Comonad (Comonad (extract)) import "comonad" Control.Comonad.Trans.Class (ComonadTrans (lower)) import "transformers" Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Joint.Core (type (:.), type (:=)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) newtype UT t u a = UT (u :. t := a) type (<.:>) = UT instance Interpreted (UT t u) where type Primary (UT t u) a = u :. t := a run :: UT t u a -> Primary (UT t u) a run (UT (u :. t) := a x) = (u :. t) := a Primary (UT t u) a x instance Monad t => MonadTrans (UT t) where lift :: m a -> UT t m a lift m a x = ((m :. t) := a) -> UT t m a forall k k (t :: k -> k) (u :: k -> *) (a :: k). ((u :. t) := a) -> UT t u a UT (((m :. t) := a) -> UT t m a) -> ((m :. t) := a) -> UT t m a forall a b. (a -> b) -> a -> b $ a -> t a forall (m :: * -> *) a. Monad m => a -> m a return (a -> t a) -> m a -> (m :. t) := a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> m a x instance Comonad t => ComonadTrans (UT t) where lower :: UT t w a -> w a lower (UT (w :. t) := a x) = t a -> a forall (w :: * -> *) a. Comonad w => w a -> a extract (t a -> a) -> ((w :. t) := a) -> w a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (w :. t) := a x