Combining free monads in Haskell by Mark Seemann

An example on how to compose free monads in Haskell.

In the previous article in this series on pure interactions, you saw how to write a command-line wizard in F#, using a free monad to build an Abstract Syntax Tree (AST). The example collects information about a potential restaurant reservations you'd like to make. That example, however, didn't do more than that.

For a more complete experience, you'd like your command-line interface (CLI) to not only collect data about a reservation, but actually make the reservation, using the available HTTP API. This means that you'll also need to model interaction with the HTTP API as an AST, but a different AST. Then, you'll have to figure out how to compose these two APIs into a combined API.

In order to figure out how to do this in F#, I first had to do it in Haskell. In this article, you'll see how to do it in Haskell, and in the next article, you'll see how to translate this Haskell prototype to F#. This should ensure that you get a functional F# code base as well.

Command line API #

Let's make an easy start of it. In a previous article, you saw how to model command-line interactions as ASTs, complete with syntactic sugar provided by a computation expression. That took a fair amount of boilerplate code in F#, but in Haskell, it's declarative:

import Control.Monad.Trans.Free (Free, liftF)
 
data CommandLineInstruction next =
    ReadLine (String -> next)
  | WriteLine String next
  deriving (Functor)
 
type CommandLineProgram = Free CommandLineInstruction
 
readLine :: CommandLineProgram String
readLine = liftF (ReadLine id)
 
writeLine :: String -> CommandLineProgram ()
writeLine s = liftF (WriteLine s ())

This is all the code required to define your AST and make it a monad in Haskell. Contrast that with all the code you have to write in F#!

The CommandLineInstruction type defines the instruction set, and makes use of a language extension called DeriveFunctor, which enables Haskell to automatically create a Functor instance from the type.

The type alias type CommandLineProgram = Free CommandLineInstruction creates a monad from CommandLineInstruction, since Free is a Monad when the underlying type is a Functor.

The readLine value and writeLine function are conveniences that lift the instructions from CommandLineInstruction into CommandLineProgram values. These were also one-liners in F#.

HTTP client API #

You can write a small wizard to collect restaurant reservation data with the CommandLineProgram API, but the new requirement is to make HTTP calls so that the CLI program actually makes the reservation against the back-end system. You could extend CommandLineProgram with more instructions, but that would be to mix concerns. It'd be more appropriate to define a new instruction set for making the required HTTP requests.

This API will send and receive more complex values than simple String values, so you can start by defining their types:

data Slot = Slot { slotDate :: ZonedTime, seatsLeft :: Int } deriving (Show)
 
data Reservation =
  Reservation { reservationDate :: ZonedTime
              , reservationName :: String
              , reservationEmail :: String
              , reservationQuantity :: Int }
              deriving (Show)

The Slot type contains information about how many available seats are left on a particular date. The Reservation type contains the information required in order to make a reservation. It's similar to the Reservation F# record type you saw in the previous article.

The online restaurant reservation HTTP API may afford more functionality than you need, but there's no reason to model more instructions than required:

data ReservationsApiInstruction next =
    GetSlots ZonedTime ([Slot] -> next)
  | PostReservation Reservation next
  deriving (Functor)

This instruction set models two interactions. The GetSlots case models an instruction to request, from the HTTP API, the slots for a particular date. The PostReservation case models an instruction to make a POST HTTP request with a Reservation, thereby making a reservation.

Like the above CommandLineInstruction, this type is (automatically) a Functor, which means that we can create a Monad from it:

type ReservationsApiProgram = Free ReservationsApiInstruction

Once again, the monad is nothing but a type alias.

Finally, you're going to need the usual lifts:

getSlots :: ZonedTime -> ReservationsApiProgram [Slot]
getSlots d = liftF (GetSlots d id)
 
postReservation :: Reservation -> ReservationsApiProgram ()
postReservation r = liftF (PostReservation r ())

This is all you need to write a wizard that interleaves CommandLineProgram and ReservationsApiProgram instructions in order to create a more complex AST.

Wizard #

The wizard should do the following:

• Collect the number of diners, and the date for the reservation.
• Query the HTTP API about availability for the requested date. If insufficient seats are available, it should exit.
• If sufficient capacity remains, collect name and email.
• Make the reservation against the HTTP API.

readParse :: Read a => String -> String -> CommandLineProgram a
readParse prompt errorMessage = do
  writeLine prompt
  l <- readLine
  case readMaybe l of
    Just dt -> return dt
    Nothing -> do
      writeLine errorMessage
      readParse prompt errorMessage

It first uses writeLine to write prompt to the command line - or rather, it creates an instruction to do so. The instruction is a pure value. No side-effects are involved until an interpreter evaluates the AST.

The next line uses readLine to read the user's input. While readLine is a CommandLineProgram String value, due to Haskell's do notation, l is a String value. You can now attempt to parse that String value with readMaybe, which returns a Maybe a value that you can handle with pattern matching. If readMaybe returns a Just value, then return the contained value; otherwise, write errorMessage and recursively call readParse again.

Like in the previous F# example, the only way to continue is to write something that readMaybe can parse. There's no other way to exit; there probably should be an option to quit, but it's not important for this demo purpose.

You may also have noticed that, contrary to the previous F# example, I here succumbed to the temptation to break the rule of three. It's easier to define a reusable function in Haskell, because you can leave it generic, with the proviso that the generic value must be an instance of the Read typeclass.

The readParse function returns a CommandLineProgram a value. It doesn't combine CommandLineProgram with ReservationsApiProgram. That's going to happen in another function, but before we look at that, you're also going to need another little helper:

readAnything :: String -> CommandLineProgram String
readAnything prompt = do
  writeLine prompt
  readLine

The readAnything function simply writes a prompt, reads the user's input, and unconditionally returns it. You could also have written it as a one-liner like readAnything prompt = writeLine prompt >> readLine, but I find the above code more readable, even though it's slightly more verbose.

That's all you need to write the wizard:

tryReserve :: FreeT ReservationsApiProgram CommandLineProgram ()
tryReserve = do
  q <- lift $ readParse "Please enter number of diners:" "Not an Integer."
  d <- lift $ readParse "Please enter your desired date:" "Not a date."
  availableSeats <- liftF $ (sum . fmap seatsLeft) <$> getSlots d
  if availableSeats < q
    then lift $ writeLine $ "Only " ++ show availableSeats ++ " remaining seats."
    else do
      n <- lift $ readAnything "Please enter your name:"
      e <- lift $ readAnything "Please enter your email address:"
      liftF $ postReservation Reservation
        { reservationDate = d
        , reservationName = n
        , reservationEmail = e
        , reservationQuantity = q }

The tryReserve program first prompt the user for a number of diners and a date. Once it has the date d, it calls getSlots and calculates the sum of the remaining seats. availableSeats is an Int value like q, so you can compare those two values with each other. If the number of available seats is less than the desired quantity, the program writes that and exits.

This interaction demonstrates how to interleave CommandLineProgram and ReservationsApiProgram instructions. It would be a bad user experience if the program would ask the user to input all information, and only then discover that there's insufficient capacity.

If, on the other hand, there's enough remaining capacity, the program continues collecting information from the user, by prompting for the user's name and email address. Once all data is collected, it creates a new Reservation value and invokes postReservation.

Consider the type of tryReserve. It's a combination of CommandLineProgram and ReservationsApiProgram, contained within a type called FreeT. This type is also a Monad, which is the reason the do notation still works. This also begins to explain the various lift and liftF calls sprinkled over the code.

Whenever you use a <- arrow to 'pull the value out of the monad' within a do block, the right-hand side of the arrow must have the same type as the return type of the overall function (or value). In this case, the return type is FreeT ReservationsApiProgram CommandLineProgram (), whereas readParse returns a CommandLineProgram a value. As an example, lift turns CommandLineProgram Int into FreeT ReservationsApiProgram CommandLineProgram Int.

The way the type of tryReserve is declared, when you have a CommandLineProgram a value, you use lift, but when you have a ReservationsApiProgram a, you use liftF. This depends on the order of the monads contained within FreeT. If you swap CommandLineProgram and ReservationsApiProgram, you'll also need to use lift instead of liftF, and vice versa.

Interpreters #

tryReserve is a pure value. It's an Abstract Syntax Tree that combines two separate instruction sets to describe a complex interaction between user, command line, and an HTTP client. The program doesn't do anything until interpreted.

You can write an impure interpreter for each of the APIs, and a third one that uses the other two to interpret tryReserve.

Interpreting CommandLineProgram values is similar to the previous F# example:

interpretCommandLine :: CommandLineProgram a -> IO a
interpretCommandLine program =
  case runFree program of
    Pure r -> return r
    Free (ReadLine next) -> do
      line <- getLine
      interpretCommandLine $ next line
    Free (WriteLine line next) -> do
      putStrLn line
      interpretCommandLine next

This interpreter is a recursive function that pattern-matches all the cases in any CommandLineProgram a. When it encounters a Pure case, it simply returns the contained value.

When it encounters a ReadLine value, it calls getLine, which returns an IO String value read from the command line, but thanks to the do block, line is a String value. The interpreter then calls next with line, and passes the return value of that recursively to itself.

A similar treatment is given to the WriteLine case. putStrLn line writes line to the command line, where after next is used as an input argument to interpretCommandLine.

Thanks to Haskell's type system, you can easily tell that interpretCommandLine is impure, because for every CommandLineProgram a it returns IO a. That was the intent all along.

Likewise, you can write an interpreter for ReservationsApiProgram values:

interpretReservationsApi :: ReservationsApiProgram a -> IO a
interpretReservationsApi program =
  case runFree program of
    Pure x -> return x
    Free (GetSlots zt next) -> do
      slots <- HttpClient.getSlots zt
      interpretReservationsApi $ next slots
    Free (PostReservation r next) -> do
      HttpClient.postReservation r
      interpretReservationsApi next

The structure of interpretReservationsApi is similar to interpretCommandLine. It delegates its implementation to an HttpClient module that contains the impure interactions with the HTTP API. This module isn't shown in this article, but you can see it in the GitHub repository that accompanies this article.

From these two interpreters, you can create a combined interpreter:

interpret :: FreeT ReservationsApiProgram CommandLineProgram a -> IO a
interpret program = do
  r <- interpretCommandLine $ runFreeT program
  case r of
    Pure x -> return x
    Free p -> do
      y <- interpretReservationsApi p
      interpret y

This function has the required type: it evaluates any FreeT ReservationsApiProgram CommandLineProgram a and returns an IO a. runFreeT returns the CommandLineProgram part of the combined program. Passing this value to interpretCommandLine, you get the underlying type - the a in CommandLineProgram a, if you will. In this case, however, the a is quite a complex type that I'm not going to write out here. Suffice it to say that, at the container level, it's a FreeF value, which can be either a Pure or a Free case that you can use for pattern matching.

In the Pure case, you're done, so you can simply return the underlying value.

In the Free case, the p contained inside is a ReservationsApiProgram value, which you can interpret with interpretReservationsApi. That returns an IO a value, and due to the do block, y is the a. In this case, however, a is FreeT ReservationsApiProgram CommandLineProgram a, but that means that the function can now recursively call itself with y in order to interpret the next instruction.

Execution #

Armed with both an AST and an interpreter, executing the program is trivial:

main :: IO ()
main = interpret tryReserve

When you run the program, you could produce an interaction like this:

Please enter number of diners:
4
Please enter your desired date:
2017-11-25 18-30-00Z
Not a date.
Please enter your desired date:
2017-11-25 18:30:00Z
Please enter your name:
Mark Seemann
Please enter your email address:
mark@example.org
Status {statusCode = 200, statusMessage = "OK"}

You'll notice that I initially made a mistake on the date format, which caused readParse to prompt me again.

If you want to run this code sample yourself, you're going to need an appropriate HTTP API with which you can interact. I hosted the API on my local machine, and afterwards verified that the record was, indeed, written in the reservations database.

Summary #

This proof of concept proves that it's possible to combine separate free monads. Now that we know that it works, and the overall outline of it, it should be possible to translate this to F#. You should, however, expect more boilerplate code.

Next: Combining free monads in F#.

Comments

import Data.Functor.Sum

type Program = Free (Sum CommandLineInstruction ReservationsApiInstruction)

liftCommandLine :: CommandLineInstruction a -> Program a
liftCommandLine = liftF . InL

liftReservation :: ReservationsApiInstruction a -> Program a
liftReservation = liftF . InR

readLine :: Program String
readLine = liftCommandLine (ReadLine id)
 
writeLine :: String -> Program ()
writeLine s = liftCommandLine (WriteLine s ())

getSlots :: ZonedTime -> Program [Slot]
getSlots d = liftReservation (GetSlots d id)
 
postReservation :: Reservation -> Program ()
postReservation r = liftReservation (PostReservation r ())

tryReserve :: Program ()
tryReserve = do
  q <- readParse "Please enter number of diners:" "Not an Integer."
  d <- readParse "Please enter your desired date:" "Not a date."
  availableSeats <- (sum . fmap seatsLeft) <$> getSlots d
  if availableSeats < q
    then writeLine $ "Only " ++ show availableSeats ++ " remaining seats."
    else do
      n <- readAnything "Please enter your name:"
      e <- readAnything "Please enter your email address:"
      postReservation Reservation
        { reservationDate = d
        , reservationName = n
        , reservationEmail = e
        , reservationQuantity = q }

interpretCommandLine :: CommandLineInstruction (IO a) -> IO a
interpretCommandLine (ReadLine next) = getLine >>= next
interpretCommandLine (WriteLine line next) = putStrLn line >> next

interpretReservationsApi :: ReservationsApiInstruction (IO a) -> IO a
interpretReservationsApi (GetSlots zt next) = HttpClient.getSlots zt >>= next
interpretReservationsApi (PostReservation r next) = HttpClient.postReservation r >> next

interpret :: Program a -> IO a
interpret program =
  iterM go program
  where
    go (InL cmd) = interpretCommandLine cmd
    go (InR res) = interpretReservationsApi res

• ← Previous
• Archive
• Next →