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