UTU.hs

module Pandora.Paradigm.Junction.Schemes.UTU (UTU (..)) where

import Pandora.Core.Functor (Variant (Co), type (:.:), type (><))
import Pandora.Core.Morphism ((.), ($))
import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), comap))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>)))
import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
import Pandora.Pattern.Functor.Liftable (Liftable (lift))
import Pandora.Pattern.Functor.Lowerable (Lowerable (lower))
import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Pattern.Object.Monoid (Monoid (zero))

newtype UTU ct cu t u a = UTU (u :.: t u >< a)

instance Composition (UTU ct cu t u) where
	type Outline (UTU ct cu t u) a = u :.: t u >< a
	composition (UTU x) = x

instance (Covariant (t u), Covariant u) => Covariant (UTU 'Co 'Co t u) where
	f <$> UTU x = UTU $ f <$$> x

instance (Pointable (t u), Pointable u) => Pointable (UTU 'Co 'Co t u) where
	point = UTU . point . point

instance (Extractable (t u), Extractable u) => Extractable (UTU 'Co 'Co t u) where
	extract = extract . extract . composition

instance (Covariant (t u), Avoidable u) => Avoidable (UTU 'Co 'Co t u) where
	idle = UTU idle

instance (Covariant (t u), Alternative u) => Alternative (UTU 'Co 'Co t u) where
	UTU x <+> UTU y = UTU $ x <+> y

instance (Applicative (t u), Applicative u) => Applicative (UTU 'Co 'Co t u) where
	UTU f <*> UTU x = UTU $ apply <$> f <*> x

instance (Traversable (t u), Traversable u) => Traversable (UTU 'Co 'Co t u) where
	UTU x ->> f = UTU <$> x ->>> f

instance (Distributive (t u), Distributive u) => Distributive (UTU 'Co 'Co t u) where
	x >>- f = UTU . comap distribute . distribute $ composition . f <$> x

instance (forall u' . Pointable u', Liftable t) => Liftable (UTU 'Co 'Co t) where
	lift = UTU . point . lift

instance (forall u' . Extractable u', Lowerable t) => Lowerable (UTU 'Co 'Co t) where
	lower = lower . extract . composition

instance (forall u' . Setoid (u' :.: t u' >< a)) => Setoid (UTU 'Co 'Co t u a) where
	UTU x == UTU y = x == y

instance (forall u' . Chain (u' :.: t u' >< a)) => Chain (UTU 'Co 'Co t u a) where
	UTU x <=> UTU y = x <=> y

instance (forall u' . Semigroup (u' :.: t u' >< a)) => Semigroup (UTU 'Co 'Co t u a) where
	UTU x + UTU y = UTU $ x + y

instance (forall u' . Monoid (u' :.: t u' >< a)) => Monoid (UTU 'Co 'Co t u a) where
	zero = UTU zero