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