module Control.Joint.Abilities.Adaptable where

import "transformers" Control.Monad.Trans.Class (MonadTrans (lift))

import Control.Joint.Core (type (~>))
import Control.Joint.Abilities.Interpreted (Interpreted (run))
import Control.Joint.Abilities.Transformer (Transformer (build), Schema, (:>) (T, trans))

class Adaptable (eff :: * -> *) (schema :: * -> *) where
        {-# MINIMAL adapt #-}
        adapt :: eff ~> schema

type Embedding t u = (Transformer t, Monad u)
type Building t u = (Transformer t, Applicative u)

instance Adaptable t t where
        adapt = id

instance (Monad u, MonadTrans ((:>) t)) => Adaptable u (t :> u) where
        adapt = lift

instance Building t u => Adaptable t (t :> u) where
        adapt = build

instance
        ( Embedding t (Schema u v)
        , MonadTrans ((:>) t)
        , Building u v
        ) => Adaptable u (t :> u :> v) where
        adapt = lift . build

instance
        ( Embedding t (Schema u v)
        , Embedding u v
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        ) => Adaptable v (t :> u :> v) where
        adapt = lift . lift

instance
        ( Embedding t (Schema u (v :> w))
        , Embedding u (Schema v w)
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , Building v w
        ) => Adaptable v (t :> u :> v :> w) where
        adapt = lift . lift . build

instance
        ( Embedding t (Schema u v)
        , Embedding t (Schema u (v :> w))
        , Embedding u (Schema v w)
        , Embedding v w
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        ) => Adaptable w (t :> u :> v :> w) where
        adapt = lift . lift . lift

instance (Embedding t (Schema u (v :> w :> x))
        , Embedding u (Schema v (w :> x))
        , Embedding v (Schema w x)
        , Embedding w x
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        ) => Adaptable x (t :> u :> v :> w :> x) where
        adapt = lift . lift . lift . lift

instance (Embedding t (Schema u (v :> w :> x))
        , Embedding u (Schema v (w :> x))
        , Embedding v (Schema w x)
        , Building w x
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        ) => Adaptable w (t :> u :> v :> w :> x) where
        adapt = lift . lift . lift . build

instance
        ( Embedding t (Schema u (v :> w :> x :> y))
        , Embedding u (Schema v (w :> x :> y))
        , Embedding v (Schema w (x :> y))
        , Embedding w (Schema x y)
        , Embedding x y
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        , MonadTrans ((:>) x)
        ) => Adaptable y (t :> u :> v :> w :> x :> y) where
        adapt = lift . lift . lift . lift . lift

instance
        ( Embedding t (Schema u (v :> w :> x :> y))
        , Embedding u (Schema v (w :> x :> y))
        , Embedding v (Schema w (x :> y))
        , Embedding w (Schema x y)
        , Building x y
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        ) => Adaptable x (t :> u :> v :> w :> x :> y) where
        adapt = lift . lift . lift . lift . build

instance
        ( Embedding t (Schema u (v :> w :> x :> y :> z))
        , Embedding u (Schema v (w :> x :> y :> z))
        , Embedding v (Schema w (x :> y :> z))
        , Embedding w (Schema x (y :> z))
        , Embedding x (Schema y z)
        , Embedding y z
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        , MonadTrans ((:>) x)
        , MonadTrans ((:>) y)
        ) => Adaptable z (t :> u :> v :> w :> x :> y :> z) where
        adapt = lift . lift . lift . lift . lift . lift

instance
        ( Embedding t (Schema u (v :> w :> x :> y :> z))
        , Embedding u (Schema v (w :> x :> y :> z))
        , Embedding v (Schema w (x :> y :> z))
        , Embedding w (Schema x (y :> z))
        , Embedding x (Schema y z)
        , Building y z
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        , MonadTrans ((:>) x)
        ) => Adaptable y (t :> u :> v :> w :> x :> y :> z) where
        adapt = lift . lift . lift . lift . lift . build

instance
        ( Embedding t (Schema u (v :> w :> x :> y :> z :> f))
        , Embedding u (Schema v (w :> x :> y :> z :> f))
        , Embedding v (Schema w (x :> y :> z :> f))
        , Embedding w (Schema x (y :> z :> f))
        , Embedding x (Schema y (z :> f))
        , Embedding y (Schema z f)
        , Embedding z f
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        , MonadTrans ((:>) x)
        , MonadTrans ((:>) y)
        , MonadTrans ((:>) z)
        ) => Adaptable f (t :> u :> v :> w :> x :> y :> z :> f) where
        adapt = lift . lift . lift . lift . lift . lift . lift

instance
        ( Embedding t (Schema u (v :> w :> x :> y :> z :> f))
        , Embedding u (Schema v (w :> x :> y :> z :> f))
        , Embedding v (Schema w (x :> y :> z :> f))
        , Embedding w (Schema x (y :> z :> f))
        , Embedding x (Schema y (z :> f))
        , Embedding y (Schema z f)
        , Building z f
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        , MonadTrans ((:>) x)
        , MonadTrans ((:>) y)
        , MonadTrans ((:>) z)
        ) => Adaptable z (t :> u :> v :> w :> x :> y :> z :> f) where
        adapt = lift . lift . lift . lift . lift . lift . build

instance
        ( Embedding t (Schema u (v :> w :> x :> y :> z :> f :> h))
        , Embedding u (Schema v (w :> x :> y :> z :> f :> h))
        , Embedding v (Schema w (x :> y :> z :> f :> h))
        , Embedding w (Schema x (y :> z :> f :> h))
        , Embedding x (Schema y (z :> f :> h))
        , Embedding y (Schema z (f :> h))
        , Embedding z (Schema f h)
        , Embedding f h
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        , MonadTrans ((:>) x)
        , MonadTrans ((:>) y)
        , MonadTrans ((:>) z)
        , MonadTrans ((:>) f)
        ) => Adaptable h (t :> u :> v :> w :> x :> y :> z :> f :> h) where
        adapt = lift . lift . lift . lift . lift . lift . lift . lift

instance
        ( Embedding t (Schema u (v :> w :> x :> y :> z :> f :> h))
        , Embedding u (Schema v (w :> x :> y :> z :> f :> h))
        , Embedding v (Schema w (x :> y :> z :> f :> h))
        , Embedding w (Schema x (y :> z :> f :> h))
        , Embedding x (Schema y (z :> f :> h))
        , Embedding y (Schema z (f :> h))
        , Embedding z (Schema f h)
        , Building f h
        , MonadTrans ((:>) t)
        , MonadTrans ((:>) u)
        , MonadTrans ((:>) v)
        , MonadTrans ((:>) w)
        , MonadTrans ((:>) x)
        , MonadTrans ((:>) y)
        , MonadTrans ((:>) z)
        ) => Adaptable f (t :> u :> v :> w :> x :> y :> z :> f :> h) where
        adapt = lift . lift . lift . lift . lift . lift . lift . build