module Data.Functor.Composition.T (T (..)) where

import "morphisms" Control.Morphism ((.), ($))

import Control.Functor.Covariant (Covariant ((<$>), comap))
import Control.Functor.Covariant.Extractable (Extractable (extract))
import Control.Functor.Covariant.Exclusive (Exclusive (exclusive))
import Control.Functor.Covariant.Pointable (Pointable (point))
import Control.Functor.Covariant.Alternative (Alternative ((<+>)))
import Control.Functor.Covariant.Applicative (Applicative ((<*>), apply))
import Control.Functor.Covariant.Composition.Adjoint (Adjoint (phi, psi))
import Control.Functor.Contravariant (Contravariant ((>$<), contramap))
import Control.Variance (Variant (Co, Contra))

newtype T ct cu t u a = T { t :: t (u a) }

instance (Covariant t, Covariant u) => Covariant (T Co Co t u) where
	f <$> T x = T $ (comap . comap) f x

instance (Covariant t, Contravariant u) => Contravariant (T Co Contra t u) where
	f >$< T x = T $ contramap f <$> x

instance (Contravariant t, Covariant u) => Contravariant (T Contra Co t u) where
	f >$< T x = T $ contramap (comap f) x

instance (Contravariant t, Contravariant u) => Covariant (T Contra Contra t u) where
	f <$> T x = T $ contramap (contramap f) x

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

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

instance (Exclusive t, Covariant u) => Exclusive (T Co Co t u) where
	exclusive = T exclusive

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

instance (Extractable t, Extractable u) => Extractable (T Co Co t u) where
	extract = extract . extract . t

type Adjunctive t u = (Extractable t, Pointable t, Extractable u, Pointable u, Adjoint t u)

instance (Adjunctive t u, Adjunctive v w) => Adjoint (T Co Co t v) (T Co Co u w) where
	phi f = point . f . point
	psi f = extract . extract . comap f