{-# LANGUAGE GADTSyntax, ExistentialQuantification, Rank2Types, ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, FlexibleInstances #-}
module Control.Monad.Operational (
Program, singleton, ProgramView, view,
interpretWithMonad,
ProgramT, ProgramViewT(..), viewT,
liftProgram,
) where
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Applicative
import Control.Monad.Reader.Class
import Control.Monad.State.Class
type Program instr = ProgramT instr Identity
type ProgramView instr = ProgramViewT instr Identity
view :: Program instr a -> ProgramView instr a
view :: Program instr a -> ProgramView instr a
view = Identity (ProgramView instr a) -> ProgramView instr a
forall a. Identity a -> a
runIdentity (Identity (ProgramView instr a) -> ProgramView instr a)
-> (Program instr a -> Identity (ProgramView instr a))
-> Program instr a
-> ProgramView instr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program instr a -> Identity (ProgramView instr a)
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
ProgramT instr m a -> m (ProgramViewT instr m a)
viewT
interpretWithMonad :: forall instr m b.
Monad m => (forall a. instr a -> m a) -> (Program instr b -> m b)
interpretWithMonad :: (forall a. instr a -> m a) -> Program instr b -> m b
interpretWithMonad f :: forall a. instr a -> m a
f = ProgramView instr b -> m b
forall a. ProgramView instr a -> m a
eval (ProgramView instr b -> m b)
-> (Program instr b -> ProgramView instr b)
-> Program instr b
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program instr b -> ProgramView instr b
forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
view
where
eval :: forall a. ProgramView instr a -> m a
eval :: ProgramView instr a -> m a
eval (Return a :: a
a) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
eval (m :: instr b
m :>>= k :: b -> ProgramT instr Identity a
k) = instr b -> m b
forall a. instr a -> m a
f instr b
m m b -> (b -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. instr a -> m a) -> ProgramT instr Identity a -> m a
forall (instr :: * -> *) (m :: * -> *) b.
Monad m =>
(forall a. instr a -> m a) -> Program instr b -> m b
interpretWithMonad forall a. instr a -> m a
f (ProgramT instr Identity a -> m a)
-> (b -> ProgramT instr Identity a) -> b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr Identity a
k
data ProgramT instr m a where
Lift :: m a -> ProgramT instr m a
Bind :: ProgramT instr m b -> (b -> ProgramT instr m a)
-> ProgramT instr m a
Instr :: instr a -> ProgramT instr m a
instance Monad m => Monad (ProgramT instr m) where
return :: a -> ProgramT instr m a
return = m a -> ProgramT instr m a
forall (m :: * -> *) a (instr :: * -> *). m a -> ProgramT instr m a
Lift (m a -> ProgramT instr m a)
-> (a -> m a) -> a -> ProgramT instr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
>>= :: ProgramT instr m a
-> (a -> ProgramT instr m b) -> ProgramT instr m b
(>>=) = ProgramT instr m a
-> (a -> ProgramT instr m b) -> ProgramT instr m b
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
Bind
instance MonadTrans (ProgramT instr) where
lift :: m a -> ProgramT instr m a
lift = m a -> ProgramT instr m a
forall (m :: * -> *) a (instr :: * -> *). m a -> ProgramT instr m a
Lift
instance Monad m => Functor (ProgramT instr m) where
fmap :: (a -> b) -> ProgramT instr m a -> ProgramT instr m b
fmap = (a -> b) -> ProgramT instr m a -> ProgramT instr m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Monad m => Applicative (ProgramT instr m) where
pure :: a -> ProgramT instr m a
pure = a -> ProgramT instr m a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: ProgramT instr m (a -> b)
-> ProgramT instr m a -> ProgramT instr m b
(<*>) = ProgramT instr m (a -> b)
-> ProgramT instr m a -> ProgramT instr m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
singleton :: instr a -> ProgramT instr m a
singleton :: instr a -> ProgramT instr m a
singleton = instr a -> ProgramT instr m a
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Instr
data ProgramViewT instr m a where
Return :: a -> ProgramViewT instr m a
(:>>=) :: instr b
-> (b -> ProgramT instr m a)
-> ProgramViewT instr m a
viewT :: Monad m => ProgramT instr m a -> m (ProgramViewT instr m a)
viewT :: ProgramT instr m a -> m (ProgramViewT instr m a)
viewT (Lift m :: m a
m) = m a
m m a
-> (a -> m (ProgramViewT instr m a)) -> m (ProgramViewT instr m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProgramViewT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramViewT instr m a -> m (ProgramViewT instr m a))
-> (a -> ProgramViewT instr m a) -> a -> m (ProgramViewT instr m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ProgramViewT instr m a
forall a (instr :: * -> *) (m :: * -> *).
a -> ProgramViewT instr m a
Return
viewT ((Lift m :: m b
m) `Bind` g :: b -> ProgramT instr m a
g) = m b
m m b
-> (b -> m (ProgramViewT instr m a)) -> m (ProgramViewT instr m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProgramT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
ProgramT instr m a -> m (ProgramViewT instr m a)
viewT (ProgramT instr m a -> m (ProgramViewT instr m a))
-> (b -> ProgramT instr m a) -> b -> m (ProgramViewT instr m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr m a
g
viewT ((m :: ProgramT instr m b
m `Bind` g :: b -> ProgramT instr m b
g) `Bind` h :: b -> ProgramT instr m a
h) = ProgramT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
ProgramT instr m a -> m (ProgramViewT instr m a)
viewT (ProgramT instr m b
m ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` (\x :: b
x -> b -> ProgramT instr m b
g b
x ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` b -> ProgramT instr m a
h))
viewT ((Instr i :: instr b
i) `Bind` g :: b -> ProgramT instr m a
g) = ProgramViewT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (instr b
i instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a
forall (instr :: * -> *) b (m :: * -> *) a.
instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a
:>>= b -> ProgramT instr m a
g)
viewT (Instr i :: instr a
i) = ProgramViewT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (instr a
i instr a -> (a -> ProgramT instr m a) -> ProgramViewT instr m a
forall (instr :: * -> *) b (m :: * -> *) a.
instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a
:>>= a -> ProgramT instr m a
forall (m :: * -> *) a. Monad m => a -> m a
return)
liftProgram :: Monad m => Program instr a -> ProgramT instr m a
liftProgram :: Program instr a -> ProgramT instr m a
liftProgram (Lift m :: Identity a
m) = a -> ProgramT instr m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
m)
liftProgram (m :: ProgramT instr Identity b
m `Bind` k :: b -> Program instr a
k) = ProgramT instr Identity b -> ProgramT instr m b
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
Program instr a -> ProgramT instr m a
liftProgram ProgramT instr Identity b
m ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` (Program instr a -> ProgramT instr m a
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
Program instr a -> ProgramT instr m a
liftProgram (Program instr a -> ProgramT instr m a)
-> (b -> Program instr a) -> b -> ProgramT instr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Program instr a
k)
liftProgram (Instr i :: instr a
i) = instr a -> ProgramT instr m a
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Instr instr a
i
instance (MonadState s m) => MonadState s (ProgramT instr m) where
get :: ProgramT instr m s
get = m s -> ProgramT instr m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> ProgramT instr m ()
put = m () -> ProgramT instr m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ProgramT instr m ())
-> (s -> m ()) -> s -> ProgramT instr m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance (MonadIO m) => MonadIO (ProgramT instr m) where
liftIO :: IO a -> ProgramT instr m a
liftIO = m a -> ProgramT instr m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ProgramT instr m a)
-> (IO a -> m a) -> IO a -> ProgramT instr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance (MonadReader r m) => MonadReader r (ProgramT instr m) where
ask :: ProgramT instr m r
ask = m r -> ProgramT instr m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> ProgramT instr m a -> ProgramT instr m a
local r :: r -> r
r (Lift m :: m a
m) = m a -> ProgramT instr m a
forall (m :: * -> *) a (instr :: * -> *). m a -> ProgramT instr m a
Lift ((r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
r m a
m)
local r :: r -> r
r (m :: ProgramT instr m b
m `Bind` k :: b -> ProgramT instr m a
k) = (r -> r) -> ProgramT instr m b -> ProgramT instr m b
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
r ProgramT instr m b
m ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` ((r -> r) -> ProgramT instr m a -> ProgramT instr m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
r (ProgramT instr m a -> ProgramT instr m a)
-> (b -> ProgramT instr m a) -> b -> ProgramT instr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr m a
k)
local _ (Instr i :: instr a
i) = instr a -> ProgramT instr m a
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Instr instr a
i