I tried a bit different approach, which gives at least a partial answer. Since stacking monads can be sometimes problematic, and we know all our monads are constructed from some data type, I tried instead to combine the data types.
I feel more comfortable with MonadFree
so I used it, but I suppose a similar approach could be used for Operational
as well.
Let's start with the definition of our data types:
{-# LANGUAGE DeriveFunctor, FlexibleContexts,
FlexibleInstances, FunctionalDependencies #-}
import Control.Monad
import Control.Monad.Free
data SLang x = ReadStr (String -> x) | WriteStr String x
deriving Functor
data ILang x = ReadInt (Int -> x) | WriteInt Int x
deriving Functor
In order to combine two functors together for using them in a free monad, let's define their coproduct:
data EitherF f g a = LeftF (f a) | RightF (g a)
deriving Functor
If we create a free monad over EitherF f g
, we can call the commands from both of them. In order to make this process transparent, we can use MPTC to allow conversion from each of the functor into the target one:
class Lift f g where
lift :: f a -> g a
instance Lift f f where
lift = id
instance Lift f (EitherF f g) where
lift = LeftF
instance Lift g (EitherF f g) where
lift = RightF
now we can just call lift
and convert either part into the coproduct.
With a helper function
wrapLift :: (Functor g, Lift g f, MonadFree f m) => g a -> m a
wrapLift = wrap . lift . fmap return
we can finally create generic functions that allow us to call commands from anything we can lift into a functor:
readStr :: (Lift SLang f, MonadFree f m) => m String
readStr = wrapLift $ ReadStr id
writeStr :: (Lift SLang f, MonadFree f m) => String -> m ()
writeStr x = wrapLift $ WriteStr x ()
readInt :: (Lift ILang f, MonadFree f m) => m Int
readInt = wrapLift $ ReadInt id
writeInt :: (Lift ILang f, MonadFree f m) => Int -> m ()
writeInt x = wrapLift $ WriteInt x ()
Then, the program can be expressed as
myProgram :: (Lift ILang f, Lift SLang f, MonadFree f m) => m ()
myProgram = do
str <- readStr
writeStr "Length of that str is"
writeInt $ length str
n <- readInt
writeStr "you wanna have it n times; here we go:"
writeStr $ replicate n 'H'
without defining any further instances.
While all the above works nicely, the problem is how to generically run such composed free monads. I don't know if it is even possible, to have a fully generic, composable solution.
If we have just one base functor, we can run it as
runSLang :: Free SLang x -> String -> (String, x)
runSLang = f
where
f (Pure x) s = (s, x)
f (Free (ReadStr g)) s = f (g s) s
f (Free (WriteStr s' x)) _ = f x s'
If we have two, we need to thread the state of both of them:
runBoth :: Free (EitherF SLang ILang) a -> String -> Int -> ((String, Int), a)
runBoth = f
where
f (Pure x) s i = ((s, i), x)
f (Free (LeftF (ReadStr g))) s i = f (g s) s i
f (Free (LeftF (WriteStr s' x))) _ i = f x s' i
f (Free (RightF (ReadInt g))) s i = f (g i) s i
f (Free (RightF (WriteInt i' x))) s _ = f x s i'
I guess one possibility would be to express running the functors using iter :: Functor f => (f a -> a) -> Free f a -> a
from free and then create a similar, combining function
iter2 :: (Functor f, Functor g)
=> (f a -> a) -> (g a -> a) -> Free (EitherF f g) a -> a
But I haven't had time to try it out.