Interpreting Free Monads

In the last post in this series we grokked Free Monads and saw that they gave us a way to neatly build an abstract representation of a computation using only data. That’s all well and good when we’re writing our domain model, but eventually we need to actually do some real computing to run the side effects and produce the results. In this post we’ll learn how to write interpreters for free monads; first an interpreter to run the computation in the context of our application and then a different interpreter that lets us write “mockless” unit tests for our domain operations.

Recap 🧢

Let’s quickly remind ourselves of the problem we were solving last time. We wanted to write a chargeUser function which looked up a user by their id, then charged their card the specified amount and finally emailed them a receipt if they had an email address on their profile. Here's the domain model we were using.

type EmailAddress = EmailAddress of string

type Email = 
    { To: EmailAddress
      Body: string }

type CreditCard =
    { Number: string
      Expiry: string
      Cvv: string }

type TransactionId = TransactionId of string

type UserId = UserId of string

type User =
    { Id: UserId
      CreditCard: CreditCard
      EmailAddress: EmailAddress option }

We then wrote a discriminated union to represent the operations we needed to perform as part of the chargeUser computation which looked like this.

type ChargeUserOperation<'next> =
    | LookupUser of UserId * (User -> 'next)
    | ChargeCreditCard of (float * CreditCard) * (TransactionId -> 'next)
    | EmailReceipt of Email * (unit -> 'next)
    static member Map(op, f) =
        match op with
        | LookupUser (x, next) -> LookupUser(x, next >> f)
        | ChargeCreditCard (x, next) -> ChargeCreditCard(x, next >> f)
        | EmailReceipt (x, next) -> EmailReceipt(x, next >> f)

Finally, with the help of some smart constructors we could write the abstract version of chargeUser, which builds a free monad to represent the computation we want to eventually perform.

#r "nuget: FSharpPlus"

open FSharpPlus
open FSharpPlus.Data

let lookupUser userId = LookupUser(userId, id) |> Free.liftF

let chargeCreditCard amount card =
    ChargeCreditCard((amount, card), id) |> Free.liftF

let emailReceipt email = EmailReceipt(email, id) |> Free.liftF

let chargeUser (amount: float) (userId: UserId) =
    monad {
        let! user = lookupUser userId
        let! transactionId = chargeCreditCard amount user.CreditCard

        match user.EmailAddress with
        | Some emailAddress ->
            do!
                emailReceipt
                    { To = emailAddress
                      Body = $"TransactionId {transactionId}" }

            return transactionId

        | None -> return transactionId
    }

I've made use of FSharpPlus here for a couple of things:

1. The monad computation expression, which is just a generic computation expression that works for any monad.
2. The Free data type which uses the names Roll and Pure in place of the names Operation and Return that we made up last time. It also provides us with Free.liftF, meaning "lift functor", which lifts the operation functor to a free monad. As we discovered last time, as long as our operations are mappable we can always lift them into a free monad.

A trivial interpreter

Our goal previously, when writing the domain model, was to remove and "real" calls to infrastructure functions from the domain model. We're now going to shift focus to writing the application layer where we want to actually do the "real" work.

The application layer is responsible for receiving external requests (e.g. via a REST API) and then calling the domain model to process them. It should be able to "wire up" the actual infrastructure in order to implement the operations like LookupUser. So our job here is to take the abstract data structure output from chargeUser in the domain model and turn it into a real computation with real side effects - this is the job of the interpreter.

What we need to do is write a function called interpret which goes from Free<ChargeUserOperation<TransactionId>, TransactionId>, to TransactionId. That perhaps seems a bit tricky, so let's start by writing out chargeUser "long hand" to see more clearly what it is that we need to interpret.

let chargeUser amount userId =
    Roll(
        LookupUser(
            userId,
            fun user ->
                Roll(
                    ChargeCreditCard(
                        (amount, user.CreditCard),
                        fun transactionId ->
                            match user.EmailAddress with
                            | Some emailAddress ->
                                Roll(
                                    EmailReceipt(
                                        { To = emailAddress
                                          Body = $"TransactionId {transactionId}" },
                                        fun () -> Pure transactionId
                                    )
                                )
                            | None -> Pure transactionId
                    )
                )
        )
    )

Hopefully the strategy for writing interpret is clearer now that we've removed the syntactic sugar of the monad computation expression. We can see that we're going to need to recursively pattern matching on Roll operation until we hit a Pure value case. Let's give that a try.

let rec interpret chargeUserOutput : TransactionId =
    match chargeUserOutput with
    | Roll op ->
        match op with
        | LookupUser (userId, next) ->
            let user = // some hard coded user value
            user |> next |> interpret
        | ChargeCreditCard ((amount, card), next) ->
            TransactionId "123" |> next |> interpret
        | EmailReceipt (email, next) -> 
            () |> next |> interpret
    | Pure x -> x

Just as we'd planned, if we match on a Roll case then we unwrap a ChargeUserOperation which we can then pattern match on again. When we match on an operation the only sensible thing we can do is call next with the type of input it's expecting (for example next in LookupUser wants a User). This generates us another Free<_>, so we recursively call interpret to interpret that result until we hit a Pure case and we can just return the result. Note, if you want to play with this code then you'll actually need to write match Free.run chargeUserOutput due to the way FSharpPlus has implemented Free internally.

In this example we've just hardcoded a bunch of values, so we're still not doing any "real" work, but we can at least test this in the F# REPL now to see what happens.

> chargeUser 1.0 (UserId "1") |> interpret;;                                                            
val it : TransactionId = TransactionId "123"

👌 Great, it's produced the hard coded TransactionId.

One thing that stands out from this trivial implementation of interpret is that the outer pattern match doesn't depend on the type of operation at all. So let's see if we can refactor interpret such that it works for any type of operation.

let rec inline interpret interpretOp freeMonad =
    match freeMonad with
    | Roll op -> 
        let nextFreeMonad = op |> interpretOp 
        interpret interpretOp nextFreeMonad
    | Pure x -> x

In the Roll case we now delegate the job of interpreting the operation to the interpretOp function. Calling this with an op returns the nested callback, another free monad, which we can then pass back into interpret. As an example, let's write out interpretChargeUserOp, which is just the inner pattern match from our very first interpret function above.

let interpretChargeUserOp op =
    match op with
    | LookupUser (userId, next) ->
        let user = // some hard coded user value
        user |> next
    | ChargeCreditCard ((amount, card), next) -> 
        TransactionId "123" |> next
    | EmailReceipt (email, next) -> 
        () |> next

This is nice because we've now got a universal function for interpreting any free monad. We just have to supply it with a function for interpreting our use-case specific operations. We can interpret the free monad produced by chargeUser in the F# REPL like this now.

> chargeUser 1.0 (UserId "1") |> interpret interpretChargeUserOp;;                                                            
val it : TransactionId = TransactionId "123"

To make this more concrete, let's step through what happens when we interpret the first operation:

1. The interpret function sees Roll(LookupUser(...)), so it matches on Roll.
2. It then asks interpretChargeUserOp to deal with LookupUser, which it handles through its pattern matching. 1. In our trivial example this just passes a hard coded user to next, and we know (from writing chargeUser out "long hand") that next will be Roll(ChargeCreditCard(...)).
3. So when control returns to interpret it will recursively pass Roll(ChargeCreditCard(...)) back into itself along with the same interpretChargeUserOp function.
4. This will continue until it finds an operation whose continuation is just Pure. 🥵

If you've followed that then you've grokked it! We can now move on to writing a proper interpreter for our application 🙌

A real world interpreter

Enough of all of this abstract nonsense, we've got an application to ship. So let's get stuck in and write an actual interpreter that will do something useful. We'll assume we have the following infrastructure code already defined elsewhere in some appropriate projects or libraries.

module DB =
    let lookupUser userId =
        async {
            // Create a DB connection
            // Query the DB for the user
            // Return the user
        }

module PaymentGateway =
    let chargeCard amount card = 
        async {
            // Perform an async operation to charge the card
            // Return the transaction id
        }

module EmailClient = 
    let send email = async { // send the email }

With these already written, writing the interpreter for our operations is a straight forward job.

let interpretChargeUserOp (op: ChargeUserOperation<'a>): Async<'a> =
    match op with
    | LookupUser (userId, next) ->
        async {
            let! user = DB.lookupUser userId
            return user |> next
        }
    | ChargeCreditCard ((amount, card), next) ->
        async {
            let! transactionId = PaymentGateway.chargeCard amount card
            return transactionId |> next
        }
    | EmailReceipt (email, next) ->
        async {
            do! EmailClient.send email
            return () |> next
        }

We can see from the type of interpretChargeUserOp that we're turning each domain operation into an Async operation, which is exactly the separation that we wanted to achieve when we set out on our free monadic voyage. Our domain model doesn't even need to know that in reality the operations are going to be async, the only requirement is that they're monadic. The application is free to choose the monad it actually wants to work with, it could just have easily have used Task.

We're nearly home and dry, we just need to make sure this produces the correct result. We try and write chargeUser 1.0 (UserId "1") |> interpret interpretChargeUserOp, but the compiler says no! What's happened?

If we look at the signature of interpret more closely, we'll see that it's expecting interpretOp to return a Free<_>. The problem is that we're now returning Async<_> from interpretChargeCardOp. In general we're going to want to interpret our operations into other monads such as Async, Task, State etc, rather than just as plain values, because these operations are going to be performing side-effects. So we need to make a small change to interpret, what we now desire is for it to have the following signature.

let rec inline interpret
    (interpretOp: '``Functor<'T>`` -> '``Monad<'T>``)
    (freeMonad: Free<'``Functor<'U>``, 'U>)
    : '``Monad<'U>``

This is saying that, given some function that can turn functors (our operation is a functor) that contain a value of type T into some Monad that contains the same type T then we can use this to convert a free monad based on these operations into a different monad. In order to implement this we're going to have to fix the Roll case by this time unwrapping the monad produced by interpretOp before passing it back in to the recursive call to interpret.

let rec inline interpret
    (interpretOp: '``Functor<'T>`` -> '``Monad<'T>``)
    (freeMonad: Free<'``Functor<'U>``, 'U>)
    : '``Monad<'U>`` =
    match freeMonad with
    | Roll op ->
        monad {
            let! nextFreeMonad = interpretOp op
            return! interpret interpretOp nextFreeMonad
        }
    | Pure x -> monad { return x }

We've also had to change Pure slightly so that it basically lifts the value up into the target monad type too. For instance, if we were trying to convert the free monad to an async computation you could read the above like this instead.

let rec inline interpretAsync
    (interpretOp: '``Functor<'T>`` -> Async<_>)
    (freeMonad: Free<'``Functor<'U>``, 'U>)
    : Async<_> =
    match freeMonad with
    | Roll op ->
        async {
            let! nextFreeMonad = interpretOp op
            return! interpretAsync interpretOp nextFreeMonad
        }
    | Pure x -> async { return x }

Finally, let's make sure this new interpreter works now.

> chargeUser 1.0 (UserId "1")
-     |> interpret interpretChargeUserOp
-     |> Async.RunSynchronously;;
val it : TransactionId = TransactionId "123"

You've just discovered Free.fold 📃

What we've been calling interpret is actually the fold function for the Free data type. It replaces all of the abstract Roll operation elements of the data structure with the results of calling the function f that runs the operation function in a particular monad, like Async. We've seen here how we can use it in the application layer to turn the abstract domain computation into "real" calls to the database etc. The fun doesn't end there though, because we've decoupled the "what" from the "how", we can interpret our domain model in lots of different ways, let's take a look at another useful way of folding it.

A test interpreter 🧪

Let's imagine that we want to verify that chargeUser only sends an email if the user has an email address. How can we test this? Well we can just write a different interpreter of course, one that lets us track how many times the EmailReceipt case was present in the computation.

We're going to need our interpreter to do a couple of things:

1. Return a specific User object from LookupUser so that we can control whether or not there is an EmailAddress on the profile.
2. Count the number of times EmailReceipt is present in the computation.

Taking care of point 1 is easy because we already saw in the first trivial interpreter we wrote how to return hard coded values. What about point 2 though? Well we know that we can interpret our free monad as any other monad, so why not pick one that lets us track some state, where that state is a counter for the number of times EmailReceipt is called. For this we can use the Writer monad, which is just a monad that lets us update some value that gets passed through the entire computation. Using that our test could look like this.

module Tests =
    let shouldOnlySendReceiptWhenUserHasEmailAddress user =
        let output =
            chargeUser 1. (UserId "1")
            |> Free.fold
                (function
                | LookupUser (_, next) -> 
                    monad {
                        return user |> next
                    }
                | ChargeCreditCard (_, next) ->
                    monad {
                        return TransactionId "123" |> next
                    }
                | EmailReceipt (_, next) ->
                    monad {
                        do! Writer.tell ((+) 1)
                        return () |> next
                    })

        Writer.exec output 0

For the LookupUser operation we just pass the user argument that was passed to this test function into next. That allows us to have precise control over the User that is used in a particular test run. Interpreting ChargeCreditCard is boring here, we just hard code a TransactionId and pass it to next, because we're not interested in that part for this test. In EmailReceipt we use the Writer monad to increment the counter to track the fact that a call to EmailReceipt has been made. Finally we call Writer.exec output 0 to run the computation with an initial count of 0.

Let's give this a try in the REPL and see what results we get.

> let userNoEmail =                                       
-     { Id = UserId "1"
-       EmailAddress = None
-       CreditCard =
-           { Number = "1234"
-             Expiry = "12"
-             Cvv = "123" } };;

> Tests.shouldOnlySendReceiptWhenUserHasEmailAddress userNoEmail;;
val it : int = 0

✅ When the user doesn't have an email address the call count is 0.

> let userWithEmail =
-     { Id = UserId "1"
-       EmailAddress = Some(EmailAddress "[e-mail]")
-       CreditCard =
-           { Number = "1234"
-             Expiry = "12"
-             Cvv = "123" } };;

> Tests.shouldOnlySendReceiptWhenUserHasEmailAddress userWithEmail;;  
val it : int = 1

✅ When the user does have an email address the call count is 1.

But I don't need a monad 🤷‍♀️

Sometimes, particularly when testing, you don't need to interpret the operations into a monad. For example, you might just want to check the output of the computation based on some inputs or based on the data returned from the call to the database. In that case you can use the Identity monad. Let's see what that looks like.

let shouldReturnTransactionIdFromPayment user =
    let output =
        chargeUser 1. (UserId "1")
        |> Free.fold
            (function
            | LookupUser (_, next) ->
                monad {
                    return user |> next
                }
            | ChargeCreditCard (_, next) ->
                monad {
                    return TransactionId "1" |> next
                }
            | EmailReceipt (_, next) ->
                monad {
                    return () |> next
                })

    output |> Identity.run

What did we learn? 🤓

We've seen that free monads provide an excellent means of decoupling the "what" from the "how". They allow us to write our domain model computations declaratively and leave the interpretation of how that should be done up to another layer of the application. In this post we learnt that we can use fold to interpret a free monad and all we have to do is supply it with a function to interpret our particular operations into some target monad.

This decoupling is particularly powerful when it comes to testing our domain models because it gives us precise control over the functions being tested. We don't have to worry about async calls in our test suite because we can choose to interpret the computation synchronously in the tests. It even eliminates the need for any mocking frameworks because it's trivial for us to check the number invocations for a particular operation or verify that particular arguments were supplied to a function.

Free monads might be abstract, but so should our domain models and the two go hand-in-hand very nicely.