module Control.Joint.Schemes.TU 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 (Primary, run))

newtype TU t u a = TU (t :. u := a)

type (<:.>) = TU

instance Interpreted (t <:.> u) where
	type Primary (TU t u) a = t :. u := a
	run :: (<:.>) t u a -> Primary (t <:.> u) a
run (TU (t :. u) := a
x) = (t :. u) := a
Primary (t <:.> u) a
x

instance Monad t => MonadTrans (TU t) where
	lift :: m a -> TU t m a
lift = ((t :. m) := a) -> TU t m a
forall k k (t :: k -> *) (u :: k -> k) (a :: k).
((t :. u) := a) -> TU t u a
TU (((t :. m) := a) -> TU t m a)
-> (m a -> (t :. m) := a) -> m a -> TU t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> (t :. m) := a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance Comonad t => ComonadTrans (TU t) where
	lower :: TU t w a -> w a
lower (TU (t :. w) := a
x) = ((t :. w) := a) -> w a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (t :. w) := a
x