The first post in this series covered using free monads for DSLs, cofree comonads for interpreters, and how to pair them up. This only covered pure DSLs and interpreters.
The second post in this series tidied that code up by bringing monad transformers into play for the DSL and comonad transformers into play for the interpreter. In an aside at the end of that post, I mentioned how we could update the we we do pairing to take these transformer stacks into account, and demonstrated that by adding some console
IO into the DSL.
The third post in this series covered the use of coproducts and products to separate our concerns a little further.
Now I’ll be covering how to handle
IO in the interpreter, and will also be using our adventures with
IO to demonstrate how we can push the coproducts and products further.
At the start of this series, we introduced the
class (Functor f, Functor g) => Pairing f g where pair :: (a -> b -> r) -> f a -> g b -> r
Pairing instance between
Cofree f and
Free g, provided that we had an instance for
Pairing f g:
instance Pairing f g => Pairing (Cofree f) (Free g) where pair p (a :< _ ) (Pure x) = p a x pair p (_ :< fs) (Free gs) = pair (pair p) fs gs
That was fine until we wanted to add monad and comonad transformers into the mix.
At that point we introduced
pairEffect :: (Pairing f g, Comonad w, Monad m) => (a -> b -> r) -> CofreeT f w a -> FreeT g m b -> m r pairEffect p s c = do mb <- runFreeT c case mb of Pure x -> return $ p (extract s) x Free gs -> pair (pairEffect p) (unwrap s) gs
pair, the interaction between the free monad and the cofree comonad happens when we run into the
Pure constructor of the
We may not want to wait for that to happen when we have effects in the mix -
IO in particular - and so
pairEffect has been written to make sure that the effects of
m are interleaved with the interpretation of the DSL.
For a demonstration of this, we’ll use
IO to interact with an interpreter via the console.
consoleAdder' :: MonadIO m => FreeT AdderF m () consoleAdder' = do l <- liftIO getLine case words l of ["add", x] -> add (read x) >>= \b -> output $ "add result: " ++ show b ["clear"] -> clear ["total"] -> total >>= \t -> output $ "total result: " ++ show t _ -> output prompt where output = liftIO . putStrLn prompt = unlines [ "Commands:" , " add [int]" , " clear" , " total" ] consoleAdder :: MonadIO m => FreeT AdderF m () consoleAdder = forever consoleAdder'
This is nothing fancier than parsing some input to choose which action we want, printing a help message if the input didn’t parse, and looping continuously via
We can run it using
pairEffect with our existing pure interpreter:
run :: IO () run = pairEffect (\_ r -> r) (mkCoAdder 10 0) consoleAdder
and we’ll be able to interact with it productively, despite the fact that
consoleAdder doesn’t terminate.
That’s good, but it is a bit unsatisfactory since we can’t do any IO in the interpreter itself.
Let us change
pairEffect so that we can do IO in the interpreter:
pairEffect :: (Pairing f g, Comonad w, Monad m) => (a -> b -> r) -> CofreeT f w (m a) -> FreeT g m b -> m r pairEffect p s c = do a <- extract s mb <- runFreeT c case mb of Pure x -> return $ p a x Free gs -> pair (pairEffect p) (unwrap s) gs
This does the effect in
CofreeT before the effect in
FreeT. We can alter this function or write a new one if we want the effects to happen in the opposite order, although it seems unlikely that we’ll need that.
We may not always want or need the same monad stack on both the DSL and interpreter sides of things.
That’s easy enough to fix.
We can change our stack around on the
FreeT side using
Control.Monad.Trans.Free in the free package:
hoistFreeT :: (Monad m, Functor f) => (forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
and we can alter the stack in
CofreeT by using
After that, we can use things like
lift for simple changes, or mmorph for more complex changes.
If we can come up with morphisms
morphL :: Monad l => forall a. l a -> n a
morphM :: Monad m => forall a. m a -> n a
we can do
pairEffect' :: (Pairing f g, Comonad w, Monad l, Monad m, Monad n) => (a -> b -> r) -> CofreeT f w (l a) -> FreeT g m b -> n r pairEffect' p s c = pairEffect p (fmap morphL s) (hoistFreeT morphM c)
For now, I’ll assume we’re using the same monad stack for our effects for the DSL and the interpeter.
To show off our new
pairEffect, We’ll split the console example so that the client takes care of the parsing and the interpreter takes care of printing the results.
This begins with a new
consoleAdder' :: MonadIO m => AdderT m () consoleAdder' = do l <- liftIO getLine case words l of ["add", x] -> void $ add (read x) ["clear"] -> clear ["total"] -> void total _ -> output prompt where output = liftIO . putStrLn prompt = unlines [ "Commands:" , " add [int]" , " clear" ," total" ] consoleAdder :: MonadIO m => AdderT m () consoleAdder = forever consoleAdder'
which no longer prints the results.
We then update our old interpreter:
mkCoAdder :: Int -> Int -> CoAdder () mkCoAdder limit count = coiterT next start where next = CoAdderF <$> coAdd <*> coClear <*> coTotal start = flip StoreT count . EnvT limit . Identity $ const ()
so that it will print the results of the actions it carries out.
For each action, we’ll use the return value to create an
IO action which prints the return value, and we’ll push it down to the next level of the cofree comonad.
We’ll do this using this helper function:
addResultLogging :: Functor f => CoAdderF (f a) -> CoAdderF (f (IO ())) addResultLogging (CoAdderF a c t) = CoAdderF a' c' t' where a' x = let (b, k) = a x in (b, putStrLn ("add result: " ++ show b) <$ k) c' = return () <$ c t' = let (i, k) = t in (i, putStrLn ("total result: " ++ show i) <$ k)
We can use
addResultLogging to make a new interpreter:
mkCoAdderWithLogging :: Int -> Int -> CoAdder (IO ()) mkCoAdderWithLogging limit count = coiterT (addResultLogging <$> next) (return () <$ start) where next = CoAdderF <$> coAdd <*> coClear <*> coTotal start = flip StoreT count . EnvT limit . Identity $ const ()
which we can run with:
run :: IO () run = pairEffect (\_ r -> r) (mkCoAdderWithLogging 10 0) consoleAdder
We now have
IO in our DSL and in our interpreter.
There are other variants on this these, although they’re mostly used when the
Pure constructor of the
Free monad is driving things. Two variants I’ve seen around the internet that seem like they’d be pretty handy are
Cofree f (a -> b)and
Cofree f (a -> m b)and
FreeT m a
We need to work a little harder to use this with coproducts and products, but it was fun to play around with, and I think it’s interesting.
For the DSL side of things, we need two things for each of the components:
We’ll capture both of those in the
class ConsoleClient f where prompt :: Proxy (f ()) -> [String] parser :: (Monad m, CharParsing m) => m (f ())
For the help message data, we use a
Proxy so that we can associate the data with our instances. For the parser, we return a parser from the parsers package.
We can add instances of
ConsoleClient for each of our components:
instance ConsoleClient AddF where prompt _ = ["add (int)"] parser = string "add" >> space >> many digit >>= \xs -> return $ Add (read xs) (const ())
instance ConsoleClient TotalF where prompt _ = ["total"] parser = do void $ string "total" return $ Total (const ())
instance ConsoleClient ClearF where prompt _ = ["clear"] parser = do void $ string "clear" return $ Clear ()
and we can combine these components automatically:
instance (ConsoleClient a, ConsoleClient b) => ConsoleClient (a :+: b) where prompt _ = prompt (Proxy :: Proxy (a ())) ++ prompt (Proxy :: Proxy (b ())) parser = try (fmap InL parser) <|> fmap InR parser
These can be stitched together to form a much more general version of
runConsole' :: (Functor f, MonadIO m, ConsoleClient f, Monad m) => FreeT f m () runConsole' = liftIO getLine >>= either (\_ -> output help) liftF . parse parser "console parser" where output = liftIO . putStrLn help = unlines . ("Commands:" :) . map (" " ++) $ prompt (Proxy :: Proxy (f ())) runConsole :: (Functor f, MonadIO m, ConsoleClient f, Monad m) => FreeT f m () runConsole = forever runConsole'
The main step here is to read a line, parse it, and then either lift the parsed value to our
FreeT if the parse succeeds or print the help message if the parse fails.
This will work with any
ConsoleClients, which is nice.
Unsurprisingly, we can also abstract the changes to the interpreter on a per component basis.
To begin with, we’ll generalize
addResultLogging to a class:
class ConsoleInterpreter f where addResultLogging :: Functor g => f (g a) -> f (g (IO ()))
We create instances for each of our components:
instance ConsoleInterpreter CoAddF where addResultLogging (CoAdd f) = CoAdd (fmap (\(b, k) -> (b, putStrLn ("add result: " ++ show b) <$ k)) f)
instance ConsoleInterpreter CoTotalF where addResultLogging (CoTotal (i, k)) = CoTotal (i, putStrLn ("total result: " ++ show i) <$ k)
instance ConsoleInterpreter CoClearF where addResultLogging (CoClear k) = CoClear (return () <$ k)
and we can stitch them all together generically:
instance (ConsoleInterpreter a, ConsoleInterpreter b) => ConsoleInterpreter (a :*: b) where addResultLogging (a :*: b) = addResultLogging a :*: addResultLogging b
We can now update
mkCoAdder exactly as we did before:
mkCoAdderWithLogging :: Int -> Int -> CoAdder (IO ()) mkCoAdderWithLogging limit count = coiterT (addResultLogging <$> next) (return () <$ start) where next = coAdd *:* coClear *:* coTotal start = flip StoreT count . EnvT limit . Identity . const $ ()
At some point it’d be nice to put together something like
reiterT, with the goal of being able to rework a
CoAdder () into a
CoAdder (IO ()) more generically and without having to write a new version of
mkCoAdder. I’ll update this post if or when I get around to it (or if someone else has a good suggestion for it).
We can run this:
run :: IO () run = pairEffect' (\_ r -> r) (mkCoAdderWithLogging 10 0) (runConsole :: FreeT AdderF IO ())
but we need an explicit type signature for
We can switch from Dan Piponi’s version of
Pairing to Ed Kmett’s version at this point:
class Pairing f g | f -> g, g -> f where pair :: (a -> b -> r) -> f a -> g b -> r
FunctionalDependencies help drive the inference, although it looks like we may need
UndecidableInstances to get the pairing between
:*: to work.
This lets us write
run like this:
run :: IO () run = pairEffect' (\_ r -> r) (mkCoAdderWithLogging 10 0) runConsole
in which case the type of
runConsole will be inferred to match the type of
mkCoAdderWithLogging, which is pretty neat.
We’re starting to build up a set of handy ideas.
It’s worth mentioning that this has mostly been by me wondering if I can do something, and then following the types and adapting to them to problems as I come across them. The point is that none of this is set in stone, and there are a lot of ways these things can be sliced and diced in fun ways. So if you’re branching out and hit a roadblock with some of the pieces that I’ve mentioned in these posts, try to rework it (or replace it) - if there’s any deep theory in play here it is almost entirely unintentional.
Next time, I’ll be pairing our DSL and interpreter over a network.