Notes on using FreeT to interleave effects with other monads.

ConsoleDsl.hs

{-# LANGUAGE DeriveFunctor, FlexibleContexts, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-}

module ConsoleDsl where

-- This file explains one technique for interleaving custom Free eDSLs with
-- existing monad stacks. This article does not explain Free or monad
-- transformers from the ground up, so some familiarity is assumed.

-- I begin by sketching out a basic Free eDSL, which enables printing to and
-- reading from the console. I then show how the eDSL doesn't play well with other
-- effects. I then sketch out a solution using FreeT.

-- Package: free-4.12.4
import Control.Monad.Free (Free, iterM, liftF)
import Control.Monad.Trans.Free (FreeT, iterT)

import Control.Monad.State.Lazy

-- The Free eDSL code is built in a fairly standard way.

-- It begins with two actions: PrintLn and ReadLn
data ConsoleAction a = PrintLn String a
                     | ReadLn (String -> a)
                     deriving (Functor)

type Console a = Free ConsoleAction a

-- `PrintLn` and `ReadLn` are lifted into `Console`, 
-- my custom console effect monad.
printConsole :: String -> Console ()
printConsole s = liftF $ PrintLn s ()

readConsole :: Console String
readConsole = liftF $ ReadLn id

-- This function gives meaning to values of type `ConsoleAction`. 
-- In other words, they are interpreted into IO actions.
consoleActionToIO :: MonadIO m => ConsoleAction (m a) -> m a
consoleActionToIO (PrintLn s next) = (liftIO (putStrLn s)) >>  next
consoleActionToIO (ReadLn next)    = (liftIO (getLine))    >>= next

-- `iterM` lifts this interpreter to operate over `Free ConsoleAction a` (ie, `Console a`) rather than just `ConsoleAction`.
runConsole :: Console a -> IO a
runConsole = iterM consoleActionToIO

-- Below is an example of `Console` in action: It reads a line from the console
-- and echos it back out.

exampleProgram :: Console ()
exampleProgram = do
  ln <- readConsole
  printConsole ln

-- To run the program, `runConsole` is invoked on the example program,
-- which interprets the Console eDSL into the IO effect specified by
-- `consoleActionToIO`.

exampleRun :: IO ()
exampleRun = runConsole exampleProgram

-- Output:
-- λ: exampleRun
-- monads
-- monads

-- This makes for a nice blog post, but unfortunately Console doesn't play well 
-- with other effects. Suppose I want to:
--
-- 1) Retrieve a string from some state.
-- 2) Print that string to the console.
-- 3) Read in a new string from the console.
-- 4) Store that string to the state.
--
-- One solution is to do all this inside `StateT String IO ()`, but this forces
-- me to interpret `Console` into `IO` whenever I want to switch between the `State` 
-- and `Console` effects. It also eliminates `Console` from the type, forcing my 
-- computation to live in IO, which is more power than needed.

examplePrintState :: StateT String IO ()
examplePrintState = do
  s <- get
  i <- liftIO $ runConsole $ do -- Console must be interpretted into IO
          printConsole s        -- because it cannot be direclty interleaved.
          readConsole
                     
  put i

exampleRunPrintState :: IO ((), String)
exampleRunPrintState = runStateT examplePrintState "start"

-- Output:
-- λ: exampleRunPrintState
-- start
-- new string
-- ((),"new string")

-- This becomes cumbersome when Console is used in a real program with an existing monad stack.

-- ** Free Transformer **

-- One solution is to embed my eDSL in FreeT rather than Free. While Free lifts my 
-- ConsoleAction into a monad, FreeT lifts it into a monad transformer, allowing it 
-- to be used with other monad stacks, and thus interleaved with other effects.

-- Rather than Console, ConsoleT is a transformer that takes a monad `m` and produces an `a`.
type ConsoleT m a = FreeT ConsoleAction m a

-- Much of the code from before can be reused, it's simply a matter of changing type 
-- signatures to use `ConsoleT`.
printConsoleT :: Monad m => String -> ConsoleT m ()
printConsoleT s = liftF $ PrintLn s ()

readConsoleT :: Monad m => ConsoleT m String
readConsoleT = liftF $ ReadLn id

-- `runConsoleT` now uses `iterT` instead of `iterM`, which operates over `FreeT` rather than 
-- `Free`. `consoleActionToIO` can be reused.
runConsoleT :: MonadIO m => ConsoleT m a -> m a
runConsoleT = iterT consoleActionToIO

-- Now I can rewrite `examplePrintState` in `ConsoleT (StateT String m) ()`, which allows
-- me to interleave State and Console actions.

examplePrintStateT :: Monad m => ConsoleT (StateT String m) ()
examplePrintStateT = do
  s <- get
  printConsoleT s    -- Console is interleaved directly.
  i <- readConsoleT
  put i

exampleRunPrintStateT :: IO ((), String)
exampleRunPrintStateT = runStateT (runConsoleT examplePrintStateT) "start"

-- λ: exampleRunPrintStateT
-- start
-- new string
-- ((),"new string")

-- Notice that now there is no need to interpert `Console` down to `IO` early. Additionally,
-- the type restricts the computation to only the `State` and `Console` effects, so I can't
-- accidentally run wild with `IO`. These are some nice wins for about the same amount of code.

-- ** mtl-Style Typeclasses **
-- Lastly, by implementing mtl style typeclasses, effects can be constrained using typeclass constraints.

-- There is no need to implement MonadTrans. `FreeT` provides that for free.

-- I create a new class for monads implementing Console effects.
class Monad m => MonadConsole m where
  printConsoleWithClass :: String -> m ()
  readConsoleWithClass :: m String

-- ConsoleT is itself a monad and implements Console effects.
-- `FreeT ConsoleAction m` is used because type synonyms cannot be
-- partially applied.
instance Monad m => MonadConsole (FreeT ConsoleAction m) where
  printConsoleWithClass = printConsoleT
  readConsoleWithClass = readConsoleT

-- I apply induction over other monads in the standard way.
-- That is, StateT, if applied to a monad that provides Console effects, also
-- provides Console effects.
instance MonadConsole m => MonadConsole (StateT a m) where
  printConsoleWithClass  = lift . printConsoleWithClass -- These effects must be lifted.
  readConsoleWithClass = lift readConsoleWithClass

-- Finally, I can constrain effects using typeclass constraints a la mtl.
examplePrintStateTWithClass :: (MonadState String m, MonadConsole m) => m ()
examplePrintStateTWithClass = do
  s <- get
  printConsoleWithClass s
  i <- readConsoleWithClass
  put i

exampleRunPrintStateTWithClass :: IO ((), String)
exampleRunPrintStateTWithClass = runConsoleT (runStateT examplePrintStateTWithClass "start")

-- Output:
-- λ: exampleRunPrintStateTWithClass
-- start
-- new string
-- ((),"new string")