module Data.Functor.Composition.TTT (TTT (..)) 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 TTT ct cu cv cw t u v w a = TTT { ttt :: (t :.: u :.: v :.: w) a }

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

instance (Covariant t, Covariant u, Covariant v, Contravariant w) => Contravariant (TTT Co Co Co Contra t u v w) where
	f >$< TTT x = TTT $ (comap . comap . comap) (contramap f) x

instance (Covariant t, Covariant u, Contravariant v, Covariant w) => Contravariant (TTT Co Co Contra Co t u v w) where
	f >$< TTT x = TTT $ (comap . comap) (contramap (comap f)) x

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

instance (Contravariant t, Covariant u, Covariant v, Covariant w) => Contravariant (TTT Contra Co Co Co t u v w) where
	f >$< TTT x = TTT $ comap (comap (comap f)) >$< x

instance (Contravariant t, Contravariant u, Covariant v, Covariant w) => Covariant (TTT Contra Contra Co Co t u v w) where
	f <$> TTT x = TTT $ (contramap . contramap . comap . comap $ f) x

instance (Covariant t, Contravariant u, Contravariant v, Covariant w) => Covariant (TTT Co Contra Contra Co t u v w) where
	f <$> TTT x = TTT $ (comap . contramap . contramap . comap $ f) x

instance (Covariant t, Covariant u, Contravariant v, Contravariant w) => Covariant (TTT Co Co Contra Contra t u v w) where
	f <$> TTT x = TTT $ (comap . comap) (contramap . contramap $ f) x

instance (Covariant t, Contravariant u, Covariant v, Contravariant w) => Covariant (TTT Co Contra Co Contra t u v w) where
	f <$> TTT x = TTT $ (comap . contramap . comap . contramap $ f) x

instance (Contravariant t, Covariant u, Contravariant v, Covariant w) => Covariant (TTT Contra Co Contra Co t u v w) where
	f <$> TTT x = TTT $ (contramap . comap . contramap . comap $ f) x

instance (Contravariant t, Covariant u, Covariant v, Contravariant w) => Covariant (TTT Contra Co Co Contra t u v w) where
	f <$> TTT x = TTT $ (contramap . comap . comap . contramap $ f) x

instance (Contravariant t, Contravariant u, Contravariant v, Covariant w) => Contravariant (TTT Contra Contra Contra Co t u v w) where
	f >$< TTT x = TTT $ (contramap . contramap . contramap . comap) f x

instance (Covariant t, Contravariant u, Contravariant v, Contravariant w) => Contravariant (TTT Co Contra Contra Contra t u v w) where
	f >$< TTT x = TTT $ (comap . contramap . contramap . contramap) f x

instance (Contravariant t, Covariant u, Contravariant v, Contravariant w) => Contravariant (TTT Contra Co Contra Contra t u v w) where
	f >$< TTT x = TTT $ (contramap . comap . contramap . contramap) f x

instance (Contravariant t, Contravariant u, Covariant v, Contravariant w) => Contravariant (TTT Contra Contra Co Contra t u v w) where
	f >$< TTT x = TTT $ (contramap . contramap . comap . contramap) f x

instance (Contravariant t, Contravariant u, Contravariant v, Contravariant w) => Covariant (TTT Contra Contra Contra Contra t u v w) where
	f <$> TTT x = TTT $ (contramap . contramap . contramap . contramap) f x

instance (Applicative t, Applicative u, Applicative v, Applicative w) => Applicative (TTT Co Co Co Co t u v w) where
	TTT f <*> TTT x = TTT $ (comap apply . (comap . comap) apply . (comap . comap . comap) apply $ f) <*> x

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

instance (Exclusive t, Covariant u, Covariant v, Covariant w) => Exclusive (TTT Co Co Co Co t u v w) where
	exclusive = TTT exclusive

instance (Pointable t, Pointable u, Pointable v, Pointable w) => Pointable (TTT Co Co Co Co t u v w) where
	point = TTT . point . point . point . point

instance (Extractable t, Extractable u, Extractable v, Extractable w) => Extractable (TTT Co Co Co Co t u v w) where
	extract = extract . extract . extract . extract . ttt

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

instance (Adjunctive t u, Adjunctive t' u', Adjunctive t'' u'', Adjunctive t''' u''')
	=> Adjoint (TTT Co Co Co Co t t' t'' t''') (TTT Co Co Co Co u u' u'' u''') where
	phi f = point . f . point
	psi f = extract . extract . comap f