module Language.Syntactic.Frontend.Monad where
import Control.Monad.Cont
import Data.Typeable
import Language.Syntactic
import Language.Syntactic.Constructs.Binding.HigherOrder
import Language.Syntactic.Constructs.Monad
newtype Mon dom pVar m a
where
Mon
:: { unMon :: forall r
. (Monad m, Typeable r, InjectC (MONAD m) dom (m r))
=> Cont (ASTF (HODomain dom Typeable pVar) (m r)) a
}
-> Mon dom pVar m a
deriving instance Functor (Mon dom pVar m)
instance (Monad m) => Monad (Mon dom pVar m)
where
return a = Mon $ return a
ma >>= f = Mon $ unMon ma >>= unMon . f
desugarMonad
:: ( InjectC (MONAD m) dom (m a)
, Monad m
, Typeable1 m
, Typeable a
)
=> Mon dom pVar m (ASTF (HODomain dom Typeable pVar) a)
-> ASTF (HODomain dom Typeable pVar) (m a)
desugarMonad = flip runCont (sugarSymC Return) . unMon
sugarMonad
:: ( Monad m
, Typeable1 m
, Typeable a
, pVar a
)
=> ASTF (HODomain dom Typeable pVar) (m a)
-> Mon dom pVar m (ASTF (HODomain dom Typeable pVar) a)
sugarMonad ma = Mon $ cont $ sugarSymC Bind ma
instance ( Syntactic a
, Domain a ~ HODomain dom Typeable pVar
, InjectC (MONAD m) dom (m (Internal a))
, Monad m
, Typeable1 m
, Typeable (Internal a)
, pVar (Internal a)
) =>
Syntactic (Mon dom pVar m a)
where
type Domain (Mon dom pVar m a) = Domain a
type Internal (Mon dom pVar m a) = m (Internal a)
desugar = desugarMonad . fmap desugar
sugar = fmap sugar . sugarMonad