{-# LANGUAGE UndecidableInstances #-}

module Pandora.Paradigm.Controlflow.Joint.Adaptable (Adaptable (..)) where

import Pandora.Core.Functor (type (~>))
import Pandora.Pattern.Category (identity, (.))
import Pandora.Pattern.Functor.Covariant (Covariant)
import Pandora.Pattern.Functor.Pointable (Pointable)
import Pandora.Pattern.Functor.Extractable (Extractable)
import Pandora.Pattern.Functor.Comonad (Comonad)
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Paradigm.Controlflow.Joint.Schematic (Schematic)
import Pandora.Paradigm.Controlflow.Joint.Transformer.Monadic (Monadic (lay, wrap), (:>))
import Pandora.Paradigm.Controlflow.Joint.Transformer.Comonadic (Comonadic (flick, bring), (:<))

class Adaptable t u where
	{-# MINIMAL adapt #-}
	adapt :: t ~> u

type Layable t u = (Monadic t, Covariant u)
type Wrappable t u = (Monadic t, Pointable u)
type Flickable t u = (Comonadic t, Covariant u)
type Bringable t u = (Comonadic t, Extractable u)

instance Covariant t => Adaptable t t where
	adapt = identity

instance (Covariant (t :> u), Layable t u) => Adaptable u (t :> u) where
	adapt = lay

instance (Covariant (t :> u), Wrappable t u) => Adaptable t (t :> u) where
	adapt = wrap

instance (Covariant (t :> u), Flickable t u) => Adaptable (t :< u) u where
	adapt = flick

instance (Covariant (t :< u), Bringable t u) => Adaptable (t :< u) t where
	adapt = bring

instance
	( Covariant (t :> u :> v)
	, Layable t (Schematic Monad u v)
	, Wrappable u v
	) => Adaptable u (t :> u :> v) where
	adapt = lay . wrap

instance
	( Covariant (t :> u :> v)
	, Layable t (Schematic Monad u v)
	, Layable u v
	) => Adaptable v (t :> u :> v) where
	adapt = lay . lay

instance
	( Covariant (t :< u :< v)
	, Flickable t (Schematic Comonad u v)
	, Bringable u v
	) => Adaptable (t :< u :< v) u where
	adapt = bring . flick

instance
	( Covariant (t :< u :< v)
	, Flickable t (Schematic Comonad u v)
	, Flickable u v
	) => Adaptable (t :< u :< v) v where
	adapt = flick . flick

instance
	( Covariant (t :> u :> v :> w)
	, Layable t (Schematic Monad u (v :> w))
	, Layable u (Schematic Monad v w)
	, Wrappable v w
	) => Adaptable v (t :> u :> v :> w) where
	adapt = lay . lay . wrap

instance
	( Covariant (t :> u :> v :> w)
	, Layable t (Schematic Monad u v)
	, Layable t (Schematic Monad u (v :> w))
	, Layable u (Schematic Monad v w)
	, Layable v w
	) => Adaptable w (t :> u :> v :> w) where
	adapt = lay . lay . lay

instance
	( Covariant (t :< u :< v :< w)
	, Flickable t (Schematic Comonad u (v :< w))
	, Flickable u (Schematic Comonad v w)
	, Bringable v w
	) => Adaptable (t :< u :< v :< w) v where
	adapt = bring . flick . flick

instance
	( Covariant (t :< u :< v :< w)
	, Flickable t (Schematic Comonad u v)
	, Flickable t (Schematic Comonad u (v :< w))
	, Flickable u (Schematic Comonad v w)
	, Flickable v w
	) => Adaptable (t :< u :< v :< w) w where
	adapt = flick . flick . flick

instance
	( Covariant (t :> u :> v :> w :> x)
	, Layable t (Schematic Monad u (v :> w :> x))
	, Layable u (Schematic Monad v (w :> x))
	, Layable v (Schematic Monad w x)
	, Layable w x
	) => Adaptable x (t :> u :> v :> w :> x) where
	adapt = lay . lay . lay . lay

instance
	( Covariant (t :> u :> v :> w :> x)
	, Layable t (Schematic Monad u (v :> w :> x))
	, Layable u (Schematic Monad v (w :> x))
	, Layable v (Schematic Monad w x)
	, Wrappable w x
	) => Adaptable w (t :> u :> v :> w :> x) where
	adapt = lay . lay . lay . wrap

instance
	( Covariant (t :< u :< v :< w :< x)
	, Flickable t (Schematic Comonad u (v :< w :< x))
	, Flickable u (Schematic Comonad v (w :< x))
	, Flickable v (Schematic Comonad w x)
	, Flickable w x
	) => Adaptable (t :< u :< v :< w :< x) x where
	adapt = flick . flick . flick . flick

instance
	( Covariant (t :< u :< v :< w :< x)
	, Flickable t (Schematic Comonad u (v :< w :< x))
	, Flickable u (Schematic Comonad v (w :< x))
	, Flickable v (Schematic Comonad w x)
	, Bringable w x
	) => Adaptable (t :< u :< v :< w :< x) w where
	adapt = bring . flick . flick . flick

instance
	( Covariant (t :> u :> v :> w :> x :> y)
	, Layable t (Schematic Monad u (v :> w :> x :> y))
	, Layable u (Schematic Monad v (w :> x :> y))
	, Layable v (Schematic Monad w (x :> y))
	, Layable w (Schematic Monad x y)
	, Layable x y
	) => Adaptable y (t :> u :> v :> w :> x :> y) where
	adapt = lay . lay . lay . lay . lay

instance
	( Covariant (t :> u :> v :> w :> x :> y)
	, Layable t (Schematic Monad u (v :> w :> x :> y))
	, Layable u (Schematic Monad v (w :> x :> y))
	, Layable v (Schematic Monad w (x :> y))
	, Layable w (Schematic Monad x y)
	, Wrappable x y
	) => Adaptable x (t :> u :> v :> w :> x :> y) where
	adapt = lay . lay . lay . lay . wrap

instance
	( Covariant (t :< u :< v :< w :< x :< y)
	, Flickable t (Schematic Comonad u (v :< w :< x :< y))
	, Flickable u (Schematic Comonad v (w :< x :< y))
	, Flickable v (Schematic Comonad w (x :< y))
	, Flickable w (Schematic Comonad x y)
	, Flickable x y
	) => Adaptable (t :< u :< v :< w :< x :< y) y where
	adapt = flick . flick . flick . flick . flick

instance
	( Covariant (t :< u :< v :< w :< x :< y)
	, Flickable t (Schematic Comonad u (v :< w :< x :< y))
	, Flickable u (Schematic Comonad v (w :< x :< y))
	, Flickable v (Schematic Comonad w (x :< y))
	, Flickable w (Schematic Comonad x y)
	, Bringable x y
	) => Adaptable (t :< u :< v :< w :< x :< y) x where
	adapt = bring . flick . flick . flick . flick

instance
	( Covariant (t :> u :> v :> w :> x :> y :> z)
	, Layable t (Schematic Monad u (v :> w :> x :> y :> z))
	, Layable u (Schematic Monad v (w :> x :> y :> z))
	, Layable v (Schematic Monad w (x :> y :> z))
	, Layable w (Schematic Monad x (y :> z))
	, Layable x (Schematic Monad y z)
	, Layable y z
	) => Adaptable z (t :> u :> v :> w :> x :> y :> z) where
	adapt = lay . lay . lay . lay . lay . lay

instance
	( Covariant (t :> u :> v :> w :> x :> y :> z)
	, Layable t (Schematic Monad u (v :> w :> x :> y :> z))
	, Layable u (Schematic Monad v (w :> x :> y :> z))
	, Layable v (Schematic Monad w (x :> y :> z))
	, Layable w (Schematic Monad x (y :> z))
	, Layable x (Schematic Monad y z)
	, Wrappable y z
	) => Adaptable y (t :> u :> v :> w :> x :> y :> z) where
	adapt = lay . lay . lay . lay . lay . wrap

instance
	( Covariant (t :< u :< v :< w :< x :< y :< z)
	, Flickable t (Schematic Comonad u (v :< w :< x :< y :< z))
	, Flickable u (Schematic Comonad v (w :< x :< y :< z))
	, Flickable v (Schematic Comonad w (x :< y :< z))
	, Flickable w (Schematic Comonad x (y :< z))
	, Flickable x (Schematic Comonad y z)
	, Flickable y z
	) => Adaptable (t :< u :< v :< w :< x :< y :< z) z where
	adapt = flick . flick . flick . flick . flick . flick

instance
	( Covariant (t :< u :< v :< w :< x :< y :< z)
	, Flickable t (Schematic Comonad u (v :< w :< x :< y :< z))
	, Flickable u (Schematic Comonad v (w :< x :< y :< z))
	, Flickable v (Schematic Comonad w (x :< y :< z))
	, Flickable w (Schematic Comonad x (y :< z))
	, Flickable x (Schematic Comonad y z)
	, Bringable y z
	) => Adaptable (t :< u :< v :< w :< x :< y :< z) y where
	adapt = bring . flick . flick . flick . flick . flick

instance
	( Covariant (t :> u :> v :> w :> x :> y :> z :> f)
	, Layable t (Schematic Monad u (v :> w :> x :> y :> z :> f))
	, Layable u (Schematic Monad v (w :> x :> y :> z :> f))
	, Layable v (Schematic Monad w (x :> y :> z :> f))
	, Layable w (Schematic Monad x (y :> z :> f))
	, Layable x (Schematic Monad y (z :> f))
	, Layable y (Schematic Monad z f)
	, Layable z f
	) => Adaptable f (t :> u :> v :> w :> x :> y :> z :> f) where
	adapt = lay . lay . lay . lay . lay . lay . lay

instance
	( Covariant (t :> u :> v :> w :> x :> y :> z :> f)
	, Layable t (Schematic Monad u (v :> w :> x :> y :> z :> f))
	, Layable u (Schematic Monad v (w :> x :> y :> z :> f))
	, Layable v (Schematic Monad w (x :> y :> z :> f))
	, Layable w (Schematic Monad x (y :> z :> f))
	, Layable x (Schematic Monad y (z :> f))
	, Layable y (Schematic Monad z f)
	, Wrappable z f
	) => Adaptable z (t :> u :> v :> w :> x :> y :> z :> f) where
	adapt = lay . lay . lay . lay . lay . lay . wrap

instance
	( Covariant (t :< u :< v :< w :< x :< y :< z :< f)
	, Flickable t (Schematic Comonad u (v :< w :< x :< y :< z :< f))
	, Flickable u (Schematic Comonad v (w :< x :< y :< z :< f))
	, Flickable v (Schematic Comonad w (x :< y :< z :< f))
	, Flickable w (Schematic Comonad x (y :< z :< f))
	, Flickable x (Schematic Comonad y (z :< f))
	, Flickable y (Schematic Comonad z f)
	, Flickable z f
	) => Adaptable (t :< u :< v :< w :< x :< y :< z :< f) f where
	adapt = flick . flick . flick . flick . flick . flick . flick

instance
	( Covariant (t :< u :< v :< w :< x :< y :< z :< f)
	, Flickable t (Schematic Comonad u (v :< w :< x :< y :< z :< f))
	, Flickable u (Schematic Comonad v (w :< x :< y :< z :< f))
	, Flickable v (Schematic Comonad w (x :< y :< z :< f))
	, Flickable w (Schematic Comonad x (y :< z :< f))
	, Flickable x (Schematic Comonad y (z :< f))
	, Flickable y (Schematic Comonad z f)
	, Bringable z f
	) => Adaptable (t :< u :< v :< w :< x :< y :< z :< f) z where
	adapt = bring . flick . flick . flick . flick . flick . flick

instance
	( Covariant (t :> u :> v :> w :> x :> y :> z :> f :> h)
	, Layable t (Schematic Monad u (v :> w :> x :> y :> z :> f :> h))
	, Layable u (Schematic Monad v (w :> x :> y :> z :> f :> h))
	, Layable v (Schematic Monad w (x :> y :> z :> f :> h))
	, Layable w (Schematic Monad x (y :> z :> f :> h))
	, Layable x (Schematic Monad y (z :> f :> h))
	, Layable y (Schematic Monad z (f :> h))
	, Layable z (Schematic Monad f h)
	, Layable f h
	) => Adaptable h (t :> u :> v :> w :> x :> y :> z :> f :> h) where
	adapt = lay . lay . lay . lay . lay . lay . lay . lay

instance
	( Covariant (t :> u :> v :> w :> x :> y :> z :> f :> h)
	, Layable t (Schematic Monad u (v :> w :> x :> y :> z :> f :> h))
	, Layable u (Schematic Monad v (w :> x :> y :> z :> f :> h))
	, Layable v (Schematic Monad w (x :> y :> z :> f :> h))
	, Layable w (Schematic Monad x (y :> z :> f :> h))
	, Layable x (Schematic Monad y (z :> f :> h))
	, Layable y (Schematic Monad z (f :> h))
	, Layable z (Schematic Monad f h)
	, Wrappable f h
	) => Adaptable f (t :> u :> v :> w :> x :> y :> z :> f :> h) where
	adapt = lay . lay . lay . lay . lay . lay . lay . wrap

instance
	( Covariant (t :< u :< v :< w :< x :< y :< z :< f :< h)
	, Flickable t (Schematic Comonad u (v :< w :< x :< y :< z :< f :< h))
	, Flickable u (Schematic Comonad v (w :< x :< y :< z :< f :< h))
	, Flickable v (Schematic Comonad w (x :< y :< z :< f :< h))
	, Flickable w (Schematic Comonad x (y :< z :< f :< h))
	, Flickable x (Schematic Comonad y (z :< f :< h))
	, Flickable y (Schematic Comonad z (f :< h))
	, Flickable z (Schematic Comonad f h)
	, Flickable f h
	) => Adaptable (t :< u :< v :< w :< x :< y :< z :< f :< h) h where
	adapt = flick . flick . flick . flick . flick . flick . flick . flick

instance
	( Covariant (t :< u :< v :< w :< x :< y :< z :< f :< h)
	, Flickable t (Schematic Comonad u (v :< w :< x :< y :< z :< f :< h))
	, Flickable u (Schematic Comonad v (w :< x :< y :< z :< f :< h))
	, Flickable v (Schematic Comonad w (x :< y :< z :< f :< h))
	, Flickable w (Schematic Comonad x (y :< z :< f :< h))
	, Flickable x (Schematic Comonad y (z :< f :< h))
	, Flickable y (Schematic Comonad z (f :< h))
	, Flickable z (Schematic Comonad f h)
	, Bringable f h
	) => Adaptable (t :< u :< v :< w :< x :< y :< z :< f :< h) f where
	adapt = bring . flick . flick . flick . flick . flick . flick . flick