One of the things that I stumbled upon is that I don't know how to refactor usage of ProgramState. Here are some definitions:
data ProgramState = ProgramState {
a :: TypeA,
b :: TypeB,
c :: TypeC
}
type SearchFunc = ProgramState -> String -> [Completion]
type MS = ReaderT SearchFunc (StateT ProgramState IO)
instance MonadState s m => MonadState s (InputT m) where
get = lift get
put = lift . put
state = lift . state
type MS = ReaderT SearchFunc (StateT ProgramState IO)
What I do in most functions is:
func :: InputT MS ()
func = do
ProgramState a b c <- get
-- use a b c and generate newa, newb, newc
put $ ProgramState newa newb newc
There are ~300 similar usages of ProgramState throughout the program and it is a real pain when I add another element to ProgramState because then I need to change all 300 usages of ProgramState in a program. How to refactor my program to avoid this pain of necessity to change similar code in 300 different places?
The base language provides record updates essentially for this reason:
func :: InputT MS ()
func = do
-- -XNamedFieldPuns vvvvvvvvvvvvvvvvvvvvvvv can simplify this to {a, b, c}
inState#ProgramState { a = a, b = b, c = c } <- get
-- etc.
put inState { a = newA, b = newB, c = newC }
RecordWildCards also makes the following possible, but I find it less clear:
func = do
ProgramState{..} <- get -- release ALL of the fields
-- etc.
put ProgramState { a = newA, b = newB , c = newC, .. }
-- rebuild with certain specified values and then pass anything not mentioned through
Related
I am trying to define a family of state machines with somewhat different kinds of states. In particular, the more "complex" state machines have states which are formed by combining the states of simpler state machines.
(This is similar to an object oriented setting where an object has several attributes which are also objects.)
Here is a simplified example of what I want to achieve.
data InnerState = MkInnerState { _innerVal :: Int }
data OuterState = MkOuterState { _outerTrigger :: Bool, _inner :: InnerState }
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = do
i <- _innerVal <$> get
put $ MkInnerState (i + 1)
return i
outerStateFoo :: Monad m => StateT OuterState m Int
outerStateFoo = do
b <- _outerTrigger <$> get
if b
then
undefined
-- Here I want to "invoke" innerStateFoo
-- which should work/mutate things
-- "as expected" without
-- having to know about the outerState it
-- is wrapped in
else
return 666
More generally, I want a generalized framework where these nestings are more complex. Here is something I wish to know how to do.
class LegalState s
data StateLess
data StateWithTrigger where
StateWithTrigger :: LegalState s => Bool -- if this trigger is `True`, I want to use
-> s -- this state machine
-> StateWithTrigger
data CombinedState where
CombinedState :: LegalState s => [s] -- Here is a list of state machines.
-> CombinedState -- The combinedstate state machine runs each of them
instance LegalState StateLess
instance LegalState StateWithTrigger
instance LegalState CombinedState
liftToTrigger :: Monad m, LegalState s => StateT s m o -> StateT StateWithTrigger m o
liftToCombine :: Monad m, LegalState s => [StateT s m o] -> StateT CombinedState m o
For context, this is what I want to achieve with this machinery:
I want to design these things called "Stream Transformers", which are basically stateful functions: They consume a token, mutate their internal state and output something. Specifically, I am interested in a class of Stream Transformers where the output is a Boolean value; we will call these "monitors".
Now, I am trying to design combinators for these objects. Some of them are:
A pre combinator. Suppose that mon is a monitor. Then, pre mon is a monitor which always produces False after the first token is consumed and then mimicks the behaviour of mon as if the previous token is being inserted now. I would want to model the state of pre mon with StateWithTrigger in the example above since the new state is a boolean along with the original state.
An and combinator. Suppose that m1 and m2 are monitors. Then, m1 `and` m2 is a monitor which feeds the token to m1, and then to m2, and then produces True if both of the answers were true. I would want to model the state of m1 `and` m2 with CombinedState in the example above since the state of both monitors must be maintained.
For your first question, as Carl mentioned, zoom from lens does exactly what you want. Your code with lenses could be written like this:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
import Control.Monad.State.Lazy
newtype InnerState = MkInnerState { _innerVal :: Int }
deriving (Eq, Ord, Read, Show)
data OuterState = MkOuterState
{ _outerTrigger :: Bool
, _inner :: InnerState
} deriving (Eq, Ord, Read, Show)
makeLenses ''InnerState
makeLenses ''OuterState
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = do
i <- gets _innerVal
put $ MkInnerState (i + 1)
return i
outerStateFoo :: Monad m => StateT OuterState m Int
outerStateFoo = do
b <- gets _outerTrigger
if b
then zoom inner $ innerStateFoo
else pure 666
Edit: While we're at it, if you're already bringing in lens then innerStateFoo can be written like so:
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = innerVal <<+= 1
For context, this is what I want to achieve with this machinery:
I want to design these things called "Stream Transformers", which are basically stateful functions: They consume a token, mutate their internal state and output something. Specifically, I am interested in a class of Stream Transformers where the output is a Boolean value; we will call these "monitors".
I think that what you want to achieve doesn't need very much machinery.
newtype StreamTransformer input output = StreamTransformer
{ runStreamTransformer :: input -> (output, StreamTransformer input output)
}
type Monitor input = StreamTransformer input Bool
pre :: Monitor input -> Monitor input
pre st = StreamTransformer $ \i ->
-- NB: the first output of the stream transformer vanishes.
-- Is that OK? Maybe this representation doesn't fit the spec?
let (_, st') = runStreamTransformer st i
in (False, st')
and :: Monitor input -> Monitor input -> Monitor input
and left right = StreamTransformer $ \i ->
let (bleft, mleft) = runStreamTransformer left i
(bright, mright) = runStreamTransformer right i
in (bleft && bright, mleft `and` mright)
This StreamTransformer is not necessarily stateful, but admits stateful ones. You don't need to (and IMO should not! in most cases!!) reach for typeclasses in order to define these (or indeed ever! :) but that's another topic).
notStateful :: StreamTransformer input ()
notStateful = StreamTransformer $ \_ -> ((), notStateful)
stateful :: s -> (input -> s -> (output, s)) -> StreamTransformer input output
stateful s k = StreamTransformer $ \input ->
let (output, s') = k input s
in (output, stateful s' k)
alternateBool :: Monitor anything
alternateBool = stateful True $ \_ s -> (s, not s)
An idiom I use for composing a couple of procedures (with memory) is as follows:
p1 :: State (Int, String) ()
p1 = do
(a, b) <- get
... do something ...
put (a', b)
p2 :: State (Int, String) ()
p2 = do
(a, b) <- get
... do something else ...
put (a, b')
main = do
... initializing a0 b0 ...
print . flip evalState (a0, b0)
. sequence $ replicate 10 p1 ++ repeat p2
However, as the number of state variable grows, this quickly gets way more verbose than necessary:
p1 :: State (Int, String, Bool, Int, String, Bool) ()
p1 = do
(a, b, c, d, e, f) <- get
... do something ...
put (a, b, c', d, e, f')
p2 :: State (Int, String, Bool, Int, String, Bool) ()
p2 = do
(a, b, c, d, e, f) <- get
... do something ...
put (a', b', c, d, e, f)
main = do
print . flip evalState (a0, b0, c0, d0, e0, f0)
. sequence $ replicate 10 p1 ++ repeat p2
As I was wondering, is there a way of updating only a few state variables without having to refer to all the unused ones? I was thinking something like IORef but for State (in fact there is a package stateref), but I'm not sure if there are already some common idioms that other people have been using.
This seems like a job for lenses. Especially the Control.Lens.Tuple module together with .= and use:
p1 = do
a <- use _1
-- do something --
_1 .= a'
However, it's usually better if you give the things in your state proper names, e.g.
{-# LANGUAGE TemplateHaskell #-
data Record = MkRecord { _age :: Int
, _name :: String
, _programmer :: Bool
} deriving (Show, Eq)
makeLenses ''Record
That way, you have better names for your field:
p1 = do
a <- use age
-- do something --
age .= a'
Note that this still helps you if you don't want to use lenses, since you can use record syntax to update your data:
p1 = do
r <- get
let a = _age r
--- do something
put $ r{_age = a'}
This is a good situation to use records, with the gets and modify functions to manipulate subparts of the state:
data Env = Env
{ envNumber :: Int
, envText :: String
}
p1 :: State Env ()
p1 = do
a <- gets envNumber
-- ...
modify $ \r -> r { envNumber = a' }
p2 :: State Env ()
p2 = do
b <- gets envText
-- ...
modify $ \r -> r { envText = b' }
gets turns a pure getter function into a state action:
gets :: (s -> a) -> State s a
envNumber :: Env -> Int
gets envNumber :: State Env Int
And modify turns a pure update function into a state action:
modify :: (s -> s) -> State s ()
(\r -> r { envText = b' }) :: Env -> Env
modify (\r -> ...) :: State Env ()
lens's zoom combinator lifts a computation in a State monad into a computation that runs in a "larger" State monad.
zoom :: Lens' s t -> State t a -> State s a
So, given a "big" state:
data Big = Big {
_big1 :: Medium,
_big2 :: Medium
}
data Medium = Medium {
_medium1 :: Small,
_medium2 :: Small
}
data Small = Small { _small :: Int }
makeLenses ''Big
makeLenses ''Medium
makeLenses ''Small
you can "zoom in" on a part of the state:
incr :: State Int ()
incr = id += 1
incrSmall :: State Big ()
incrSmall = zoom (big2.medium1.small) incr
Of course, this'll work on big tuples as well as records, using lens's built-in tuple field accessors.
zoom's real type signature is more general than the simple one I quoted above. It uses MonadState constraints to work under a monad transformer stack, rather than in State specifically.
I am writing a framework, where the main function asks user about the function of type a -> [b].
However, because that function can be quite complex, its implementation can often look like this:
fn a = extractPartOfAAndConvert a ++ extractAnotherPartofAAndConvert a
That's why I figured using Reader might be a nice, idiomatic idea to fight that. However, at the same time I realize that some people might not want to use a monad.
While experimenting, I've crafted this solution:
class Iso a b where
isoFrom :: a -> b
isoTo :: b -> a
instance Iso a a where
isoFrom = id
isoTo = id
instance Iso (a -> b) (Reader a b) where
isoFrom f = reader f
isoTo m = runReader m
Which in turn allows me to do:
testCallback :: MyState -> Callback -> MyState
testCallback myState cb = cb myState
-- The important signature
testCallbackGeneric :: Iso Callback a => MyState -> a -> MyState
testCallbackGeneric myState cb = (isoTo cb) myState
callbackFunction :: Callback
callbackFunction s = s + 10
callbackMonad :: Reader MyState MyState
callbackMonad = do
x <- ask
return $ x - 10
-----------
let myStateA = testCallback myState callbackFunction
-- let myStateB = testCallback myState callbackMonad -- won't work, obviously
let myStateC = testCallbackGeneric myState callbackFunction
let myStateD = testCallbackGeneric myState callbackMonad
However, I feel very much like I'm reinventing the wheel.
Is there a way to express the equivalence of Reader to easily write such generic functions without resorting to creating my own type class?
You can simply use the fact that the function monad (->) r already has an instance for MonadReader r defined in Control.Monad.Reader. You can write functions using just the MonadReader constraint and use them either as normal functions or in other ReaderT monads:
f :: MonadReader Int m => m Int
f = do
a <- ask
return $ 2 * a + 3 * a
normally :: Int
normally = f 1
-- normally == 5
readerly :: Reader Int Int
readerly = do
result <- f
return $ 2 * result
> runReader f 1
5
> runReader readerly 1
10
1) I need to pass a field constructor parameter to a function. I made some tests but i was unable to do so. Is it possible? Otherwise, is it possible with lens package?
2) Is it possible in a MonadState to modify a field using modify? (I made a few attempts, but without success. For example: modify (second = "x") does not work.
import Control.Monad.State
data Test = Test {first :: Int, second :: String} deriving Show
dataTest = Test {first = 1, second = ""}
test1 = runStateT modif1 dataTest -- OK
test2 = runStateT (modif2 "!") dataTest -- OK
test3 = runStateT (modif3 second) dataTest -- WRONG
-- modif1 :: StateT Test IO ()
modif1 = do
st <- get
r <- lift getLine
put $ st {second = "x" ++ r}
-- modif2 :: String -> StateT Test IO ()
modif2 s = do
stat <- get
r <- lift getLine
put $ stat {second = "x" ++ r ++ s}
-- modif3 :: ???? -> StateT Test IO ()
modif3 fc = do
stat <- get
r <- lift getLine
put $ stat {fc = "x" ++ r}
-- When i try to load the module, this is the result:
-- ghc > Failed:
-- ProvaRecord.hs:33:16:`fc' is not a (visible) constructor field name
As you said, you're probably looking for lenses. A lens is a value that allows to read, set or modify a given field. Usually with Control.Lens, you define fields with underscores and you use makeLenses to create full-featured lenses.
There are many combinators that allow lenses to be used together within MonadState. In your case we can use %=, which in this case would be specialized to type
(MonadState s m) => Lens' s b -> (b -> b) -> m ()
which modifies a state value using a given lens and a function that operates on the inside value.
Your example could be rewritten using lenses as follows:
{-# LANGUAGE TemplateHaskell, RankNTypes #-}
import Control.Lens
import Control.Monad.State
data Test = Test { _first :: Int
, _second :: String
}
deriving Show
-- Generate `first` and `second` lenses.
$(makeLenses ''Test)
-- | An example of a universal function that modifies any lens.
-- It reads a string and appends it to the existing value.
modif :: Lens' a String -> StateT a IO ()
modif l = do
r <- lift getLine
l %= (++ r)
dataTest :: Test
dataTest = Test { _first = 1, _second = "" }
test :: IO Test
test = execStateT (modif second) dataTest
I am trying to abstract the pattern of applying a certain semantics to a free monad over some functor. The running example I am using to motivate this is applying updates to an entity in a game. So I import a few libraries and define a few example types and an entity class for the purposes of this example (I am using the free monad implementation in control-monad-free):
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.Free
import Control.Monad.Identity
import Control.Monad.Writer
-- Things which can happen to an entity
data Order = Order deriving Show
data Damage = Damage deriving Show
class Entity a where
evolve :: Double -> a -> a
order :: Order -> a -> a
damage :: Damage -> a -> a
-- Make a trivial entity for testing purposes
data Example = Example deriving Show
instance Entity Example where
evolve _ a = a
order _ a = a
damage _ a = a
-- A type to hold all the possible update types
data EntityUpdate =
UpdateTime Double
| UpdateOrder Order
| UpdateDamage Damage
deriving (Show)
-- Wrap UpdateMessage to create a Functor for constructing the free monad
data UpdateFunctor cont =
UpdateFunctor {updateMessage :: EntityUpdate, continue :: cont} deriving (Show, Functor)
-- Type synonym for the free monad
type Update = Free UpdateEntity
I now lift some basic updates into the monad:
liftF = wrap . fmap Pure
updateTime :: Double -> Update ()
updateTime t = liftUpdate $ UpdateTime t
updateOrder :: Order -> Update ()
updateOrder o = liftUpdate $ UpdateOrder o
updateDamage :: Damage -> Update ()
updateDamage d = liftUpdate $ UpdateDamage d
test :: Update ()
test = do
updateTime 8.0
updateOrder Order
updateDamage Damage
updateTime 4.0
updateDamage Damage
updateTime 6.0
updateOrder Order
updateTime 8.0
Now we have the free monad, we need to provide the possibility of different implementations, or semantic interpretations, of monad instance such as test above. The best pattern I can come up with for this is given by the following function:
interpret :: (Monad m, Functor f, fm ~ Free f c) => (f fm -> fm) -> (f fm -> a -> m a) -> fm -> a -> m a
interpret _ _ (Pure _ ) entity = return entity
interpret c f (Impure u) entity = f u entity >>= interpret c f (c u)
Then with some basic semantic functions we can give the two following possible interpretations, one as a basic evaluation and one as a writer monad preforming logging:
update (UpdateTime t) = evolve t
update (UpdateOrder o) = order o
update (UpdateDamage d) = damage d
eval :: Entity a => Update () -> a -> a
eval updates entity = runIdentity $ interpret continue update' updates entity where
update' u entity = return $ update (updateMessage u) entity
logMessage (UpdateTime t) = "Simulating time for " ++ show t ++ " seconds.\n"
logMessage (UpdateOrder o) = "Giving an order.\n"
logMessage (UpdateDamage d) = "Applying damage.\n"
evalLog :: Entity a => Update () -> a -> Writer String a
evalLog = interpret continue $ \u entity -> do
let m = updateMessage u
tell $ logMessage m
return $ update m entity
Testing this in GHCI:
> eval test Example
Example
> putStr . execWriter $ evalLog test Example
Simulating time for 8.0 seconds.
Giving an order.
Applying damage.
Simulating time for 4.0 seconds.
Applying damage.
Simulating time for 6.0 seconds.
Giving an order.
Simulating time for 8.0 seconds.
This all works fine, but it gives me a slightly uneasy feeling that it could be more general, or could be better organised. Having to provide a function to provide the continuation wasn't obvious at first and I'm not sure it is the best approach. I have made several efforts to redefine interpret in terms of functions in the Control.Monad.Free module, such as foldFree and induce. But they all seem to not quite work.
Am I on the right lines with this, or am a making a misjudgement? Most of the articles on free monads I have found concentrate on their efficiency or different ways to implement them, rather than on patterns for actually using them like this.
It also seems desirable to encapsulate this in some kind of Semantic class, so I could simply make different monad instances from my free monad by wrapping the functor in a newtype and making it an instance of this class. I couldn't quite work out how to do this however.
UPDATE --
I wish I could have accepted both answers as they are both extremely informative and thoughtfully written. In the end though, the edit to the accepted answer contains the function I was after:
interpret :: (Functor m, Monad m) => (forall x. f x -> m x) -> Free f a -> m a
interpret evalF = retract . hoistFree evalF
(retract and hoistFree are in Edward Kemmet's free package in Control.Monad.Free).
All three of pipes, operational and sacundim's free-operational package are very relevant and look like they will be very useful for me in the future. Thank you all.
You can use my pipes library, which provides higher level abstractions for working with free monads.
pipes uses free monads to reify every part of the computation:
The Producer of data (i.e. your update) is a free monad
The Consumer of data (i.e. your interpreter) is a free monad
The Pipe of data (i.e. your logger) is a free monad
In fact, they are not three separate free monads: they are all the same free monad in disguise. Once you define all three of them you connect them using pipe composition, (>->), in order to start streaming data.
I'll begin with a slightly modified version of your example that skips the type class you wrote:
{-# LANGUAGE RankNTypes #-}
import Control.Lens
import Control.Proxy
import Control.Proxy.Trans.State
import Control.Monad.Trans.Writer
data Order = Order deriving (Show)
data Damage = Damage deriving (Show)
data EntityUpdate
= UpdateTime Double
| UpdateOrder Order
| UpdateDamage Damage
deriving (Show)
Now what we do is define an Update to be a Producer of EntityUpdates:
type Update r = forall m p . (Monad m, Proxy p) => Producer p EntityUpdate m r
Then we define the actual commands. Each command yields the corresponding update using the respond pipe primitive, which sends the data further downstream for processing.
updateTime :: Double -> Update ()
updateTime t = respond (UpdateTime t)
updateOrder :: Order -> Update ()
updateOrder o = respond (UpdateOrder o)
updateDamage :: Damage -> Update ()
updateDamage d = respond (UpdateDamage d)
Since a Producer is a free monad, we can assemble it using do notation just like you did for your test function:
test :: () -> Update ()
-- i.e. () -> Producer p EntityUpdate m ()
test () = runIdentityP $ do
updateTime 8.0
updateOrder Order
updateDamage Damage
updateTime 4.0
updateDamage Damage
updateTime 6.0
updateOrder Order
updateTime 8.0
However, we can reify the interpreter as a Consumer of data, too. This is nice because we can then directly layer on state over the interpreter instead of using the Entity class you defined.
I'll use a simple state:
data MyState = MyState { _numOrders :: Int, _time :: Double, _health :: Int }
deriving (Show)
begin :: MyState
begin= MyState 0 0 100
... and define some convenient lenses for clarity:
numOrders :: Lens' MyState Int
numOrders = lens _numOrders (\s x -> s { _numOrders = x})
time :: Lens' MyState Double
time = lens _time (\s x -> s { _time = x })
health :: Lens' MyState Int
health = lens _health (\s x -> s { _health = x })
... and now I can define a stateful interpreter:
eval :: (Proxy p) => () -> Consumer (StateP MyState p) EntityUpdate IO r
eval () = forever $ do
entityUpdate <- request ()
case entityUpdate of
UpdateTime tDiff -> modify (time +~ tDiff)
UpdateOrder _ -> modify (numOrders +~ 1 )
UpdateDamage _ -> modify (health -~ 1 )
s <- get
lift $ putStrLn $ "Current state is: " ++ show s
That makes it much more clear what the interpreter is doing. We can see at a glance how it processes incoming values in a stateful way.
To connect our Producer and Consumer we use the (>->) composition operator, followed by runProxy, which transforms our pipeline back to the base monad:
main1 = runProxy $ evalStateK begin $ test >-> eval
... which produces the following result:
>>> main1
Current state is: MyState {_numOrders = 0, _time = 8.0, _health = 100}
Current state is: MyState {_numOrders = 1, _time = 8.0, _health = 100}
Current state is: MyState {_numOrders = 1, _time = 8.0, _health = 99}
Current state is: MyState {_numOrders = 1, _time = 12.0, _health = 99}
Current state is: MyState {_numOrders = 1, _time = 12.0, _health = 98}
Current state is: MyState {_numOrders = 1, _time = 18.0, _health = 98}
Current state is: MyState {_numOrders = 2, _time = 18.0, _health = 98}
Current state is: MyState {_numOrders = 2, _time = 26.0, _health = 98}
You might wonder why we have to do this in two steps. Why not just get rid of the runProxy part?
The reason why is that we may wish to compose more than two things. For example, we can very easily insert a logging stage in between test and eval. I call these intermediate stages Pipes:
logger
:: (Monad m, Proxy p)
=> () -> Pipe p EntityUpdate EntityUpdate (WriterT String m) r
logger () = runIdentityP $ forever $ do
entityUpdate <- request ()
lift $ tell $ case entityUpdate of
UpdateTime t -> "Simulating time for " ++ show t ++ " seconds.\n"
UpdateOrder o -> "Giving an order.\n"
UpdateDamage d -> "Applying damage.\n"
respond entityUpdate
Again, we can very clearly see what logger does: It requests a value, tells a representation of the value, and then passes the value further downstream using respond.
We can insert this in between test and logger. The only thing we must be aware of is that all stages must have the same base monad, so we use raiseK to insert a WriterT layer for eval so that it matches the base monad of logger:
main2 = execWriterT $ runProxy $ evalStateK begin $
test >-> logger >-> raiseK eval
... which produces the following result:
>>> main2
Current state is: MyState {_numOrders = 0, _time = 8.0, _health = 100}
Current state is: MyState {_numOrders = 1, _time = 8.0, _health = 100}
Current state is: MyState {_numOrders = 1, _time = 8.0, _health = 99}
Current state is: MyState {_numOrders = 1, _time = 12.0, _health = 99}
Current state is: MyState {_numOrders = 1, _time = 12.0, _health = 98}
Current state is: MyState {_numOrders = 1, _time = 18.0, _health = 98}
Current state is: MyState {_numOrders = 2, _time = 18.0, _health = 98}
Current state is: MyState {_numOrders = 2, _time = 26.0, _health = 98}
"Simulating time for 8.0 seconds.\nGiving an order.\nApplying damage.\nSimulating time for 4.0 seconds.\nApplying damage.\nSimulating time for 6.0 seconds.\nGiving an order.\nSimulating time for 8.0 seconds.\n"
pipes was designed to solve exactly the kind of problem you describe. A lot of the time we want to reify not only the DSL that generates the data, but the interpreters and intermediate processing stages, too. pipes treats all of these concepts identically and models all of them as connectable stream DSLs. This makes it very easy to swap in and out various behaviors without having to define your own custom interpreter framework.
If you are new to pipes, then you might want to check out the tutorial.
I don't quite understand your example, but I think you are basically reconstructing the operational package in here. Your EntityUpdate type is very much like an instruction set in the sense of operational, and your UpdateFunctor is something like the free functor over the instruction set—which is precisely the construction that relates operational and free monads. (See "Is operational really isomorphic to a free monad?" and this Reddit discussion).
But anyway, the operational package has the function you want, interpretWithMonad:
interpretWithMonad :: forall instr m b.
Monad m =>
(forall a. instr a -> m a)
-> Program instr b
-> m b
This allows you to provide a function that interprets each of the instructions in your program (each EntityUpdate value) as a monadic action, and takes care of the rest.
If I may be allowed a tad of self-promotion, I was just recently writing my own version of operational using free monads, because I wanted to have an Applicative version of operational's Program type. Since your example struck me as being purely applicative, I went through the exercise of writing your evalLog in terms of my library, and I might as well paste it here. (I couldn't understand your eval function.) Here goes:
{-# LANGUAGE GADTs, ScopedTypeVariables, RankNTypes #-}
import Control.Applicative
import Control.Applicative.Operational
import Control.Monad.Writer
data Order = Order deriving Show
data Damage = Damage deriving Show
-- UpdateI is short for "UpdateInstruction"
data UpdateI a where
UpdateTime :: Double -> UpdateI ()
UpdateOrder :: Order -> UpdateI ()
UpdateDamage :: Damage -> UpdateI ()
type Update = ProgramA UpdateI
updateTime :: Double -> Update ()
updateTime = singleton . UpdateTime
updateOrder :: Order -> Update ()
updateOrder = singleton . UpdateOrder
updateDamage :: Damage -> Update ()
updateDamage = singleton . UpdateDamage
test :: Update ()
test = updateTime 8.0
*> updateOrder Order
*> updateDamage Damage
*> updateTime 4.0
*> updateDamage Damage
*> updateTime 6.0
*> updateOrder Order
*> updateTime 8.0
evalLog :: forall a. Update a -> Writer String a
evalLog = interpretA evalI
where evalI :: forall x. UpdateI x -> Writer String x
evalI (UpdateTime t) =
tell $ "Simulating time for " ++ show t ++ " seconds.\n"
evalI (UpdateOrder Order) = tell $ "Giving an order.\n"
evalI (UpdateDamage Damage) = tell $ "Applying damage.\n"
Output:
*Main> putStr $ execWriter (evalLog test)
Simulating time for 8.0 seconds.
Giving an order.
Applying damage.
Simulating time for 4.0 seconds.
Applying damage.
Simulating time for 6.0 seconds.
Giving an order.
Simulating time for 8.0 seconds.
The trick here is the same as in the interpretWithMonad function from the original package, but adapted to applicatives:
interpretA :: forall instr f a. Applicative f =>
(forall x. instr x -> f x)
-> ProgramA instr a -> f a
If you truly need a monadic interpretation it's just a mater of importing Control.Monad.Operational (either the original one or mine) instead of Control.Applicative.Operational, and using Program instead of ProgramA. ProgramA however gives you greater power to examine the program statically:
-- Sum the total time requested by updateTime instructions in an
-- applicative UpdateI program. You can't do this with monads.
sumTime :: ProgramA UpdateI () -> Double
sumTime = sumTime' . viewA
where sumTime' :: forall x. ProgramViewA UpdateI x -> Double
sumTime' (UpdateTime t :<**> k) = t + sumTime' k
sumTime' (_ :<**> k) = sumTime' k
sumTime' (Pure _) = 0
Example usage of sumTime:
*Main> sumTime test
26.0
EDIT: In retrospect, I should have provided this shorter answer. This assumes you're using Control.Monad.Free from Edward Kmett's package:
interpret :: (Functor m, Monad m) =>
(forall x. f x -> m x)
-> Free f a -> m a
interpret evalF = retract . hoistFree evalF