module Control.Monad.Operational.Mini (Program(..)
, interpret
, cloneProgram
, ReifiedProgram(..)
, fromReified
, module Control.Monad.Operational.Class
, module Control.Monad.Operational.TH) where
import Control.Monad.Operational.Class
import Control.Monad.Operational.TH
import Control.Applicative
infixl 1 :>>=
newtype Program t a = Program { unProgram :: forall r. (a -> r) -> (forall x. t x -> (x -> r) -> r) -> r }
instance Functor (Program t) where
fmap f (Program m) = Program $ \p i -> m (p . f) i
instance Applicative (Program t) where
pure a = Program $ \p _ -> p a
Program mf <*> Program ma = Program $ \p i -> mf (\f -> ma (p . f) i) i
instance Monad (Program t) where
return a = Program $ \p _ -> p a
Program m >>= k = Program $ \p i -> m (\a -> unProgram (k a) p i) i
interpret :: Monad m => (forall x. t x -> m x) -> Program t a -> m a
interpret e (Program m) = m return (\t f -> e t >>= f)
cloneProgram :: (t :! m) => Program t a -> m a
cloneProgram (Program m) = m return (\t c -> singleton t >>= c)
instance t :! Program t where
singleton t = Program $ \p i -> i t p
data ReifiedProgram t a where
Return :: a -> ReifiedProgram t a
(:>>=) :: t a -> (a -> ReifiedProgram t b) -> ReifiedProgram t b
fromReified :: ReifiedProgram t a -> Program t a
fromReified m = Program $ \p i ->
let go (Return a) = p a
go (t :>>= c) = i t (go . c) in go m
instance Functor (ReifiedProgram t) where
fmap f = go where
go (Return a) = Return (f a)
go (t :>>= k) = t :>>= go . k
instance Applicative (ReifiedProgram t) where
pure = Return
Return f <*> Return a = Return (f a)
mf <*> m = mf >>= \f -> fmap f m
instance Monad (ReifiedProgram t) where
return = Return
Return a >>= f = f a
(t :>>= m) >>= k = t :>>= (>>= k) . m
instance t :! ReifiedProgram t where
singleton t = t :>>= Return