module Pandora.Paradigm.Schemes.T_U where

import Pandora.Core.Functor (type (~>))
import Pandora.Pattern.Category (($))
import Pandora.Pattern.Functor.Covariant (Covariant)
import Pandora.Pattern.Functor.Contravariant (Contravariant)
import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
import Pandora.Pattern.Transformer.Liftable (Liftable (lift))
import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))
import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))
import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))

newtype T_U ct cu t u a = T_U (t a :*: u a)

type (<:*:>) = T_U Covariant Covariant
type (>:*:>) = T_U Contravariant Covariant
type (<:*:<) = T_U Covariant Contravariant
type (>:*:<) = T_U Contravariant Contravariant

instance Interpreted (T_U ct cu t u) where
	type Primary (T_U ct cu t u) a = t a :*: u a
	run ~(T_U x) = x
	unite = T_U

instance Avoidable t => Liftable (T_U Covariant Covariant t) where
	lift :: Covariant u => u ~> t <:*:> u
	lift x = T_U $ empty :*: x

instance Lowerable (T_U Covariant Covariant t) where
	lower :: t <:*:> u ~> u
	lower ~(T_U (_ :*: y)) = y

instance Covariant t => Hoistable (T_U Covariant Covariant t) where
	hoist :: u ~> v -> (t <:*:> u ~> t <:*:> v)
	hoist f (T_U (x :*: y)) = T_U $ x :*: f y