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