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.
