{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}

module TypeMachine.TM.Liftable (LiftableTMFunction (applyTM)) where

import TypeMachine.TM

class LiftableTMFunction f where
    applyTM :: forall a b. (f ~ (a -> b)) => (a -> b) -> TM a -> b

instance LiftableTMFunction (a -> TM b) where
    applyTM :: forall a b. ((a -> TM b) ~ (a -> b)) => (a -> b) -> TM a -> b
applyTM a -> b
f TM a
v = TM a
v TM a -> (a -> TM b) -> TM b
forall a b.
WriterT [TypeMachineLog] Q a
-> (a -> WriterT [TypeMachineLog] Q b)
-> WriterT [TypeMachineLog] Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> b
a -> TM b
f

instance LiftableTMFunction (a -> b -> TM c) where
    applyTM :: forall a b. ((a -> b -> TM c) ~ (a -> b)) => (a -> b) -> TM a -> b
applyTM a -> b
f TM a
ma b
b = do
        a <- TM a
ma
        f a b

instance LiftableTMFunction (a -> b -> c -> TM d) where
    applyTM :: forall a b.
((a -> b -> c -> TM d) ~ (a -> b)) =>
(a -> b) -> TM a -> b
applyTM a -> b
f TM a
ma b
b c
c = do
        a <- TM a
ma
        f a b c

instance LiftableTMFunction (a -> b -> c -> d -> TM e) where
    applyTM :: forall a b.
((a -> b -> c -> d -> TM e) ~ (a -> b)) =>
(a -> b) -> TM a -> b
applyTM a -> b
f TM a
ma b
b c
c d
d = do
        a <- TM a
ma
        f a b c d