Grokking Free Monads

In this post I’m going to try and demystify free monads and show you that they’re not some strange abstract creature, but in fact can be very useful for solving certain problems. Rather than focusing on the theory, our aim here will be to get a solid intuition about free monads, you'll then find learning the theory much easier. So in keeping with the rest of this series we’ll discover the free monad ourselves by solving a real software problem.

Pre-requisites

I try to keep these posts as independent from each other as possible, but in this case there's not much getting around the fact that you're probably going to need to have already grokked monads. If you haven't yet done so, then have a browse through Grokking Monads and once you're done you'll be all set to continue here.

The Scenario

Let's say we work at an e-commerce store and we need to implement a chargeUser function. This function should take a UserId and an amount. It should lookup the user's profile to get hold of the credit card, then it should charge the user's card the specified amount. If the user has an email address it should send them a receipt.

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 }

let chargeUser (amount: float) (userId: UserId): TransactionId =
    // TODO: Implement this as part of the domain model

Our main aim in this post is to be able to write the chargeUser function in our domain model. By domain model, we're referring to the very thing we're writing our program for in the first place. In this case as we're an e-commerce store that means our domain model includes things like user profiles, products and orders.

Typically when we write our application we want to keep our domain model completely decoupled from any infrastructure or application layer code, because those things are the incidental complexity that we have to solve. Our domain model should be pure and abstract in the sense that if we were to use a different database or a different cloud provider, the domain model should be unaffected.

It's easy to write types in our domain layer to represent the objects in the model without introducing any unwanted coupling, but what about the functions like chargeUser? On the one hand we know it's going to need to call external services, so does that mean we should define it outside of the domain model where we have access to the database etc? On the other hand it's not uncommon to want to take decisions in functions like this, such as whether or not we should email the user a receipt, and that logic definitely feels like domain logic that we'd want to test independent of the database.

Functions as data

There are several ways to make domain operations pure and agnostic to any infrastructure concerns. We've touched on one before in Grokking the Reader Monad. One interesting way to do it though is to treat functions as if they were data.

What do we mean by functions as data? The best way to understand this is to see some code. Let's take the chargeUser function and write a data model to describe the operations it needs to perform.

type ChargeUserOperations =
    | LookupUser of (UserId -> User)
    | ChargeCreditCard of (float -> CreditCard -> TransactionId)
    | EmailReceipt of (Email -> unit)

We've created a type called ChargeUserOperations that has a case for each of the operations we want to perform as part of chargeUser. Each case is parameterised by the function signature that we want it to have. So instead of being functions that we call, we've just got some abstract data representing the functions that we want to invoke and we'd like to use it like so.

let chargeUser amount userId: TransactionId =
    let user = LookupUser userId
    let transactionId = ChargeCreditCard amount user.CreditCard
    match user.EmailAddress with
    | Some emailAddress ->
        let email = 
          { To = emailAddress
            Body =  $"TransactionId {transactionId}" }
        EmailReceipt email
        return transactionId
    | None -> return transactionId

Obviously, this isn't going to work. We can't simply write LookupUser userId and assign that to something of type User. For starters LookupUser is expecting a function as an argument, not a UserId. This idea of functions as data is an interesting one though, so let's see if we can find a way to make it work.

It doesn't really make sense to try and extract a return value from data. All we can really do with data is create it. So what about if we instead created each operation with another operation nested inside it, kind of like a callback that would take the output of the current computation and produce a new output. Something like this.

type ChargeUserOperation =
    | LookupUser of (UserId * (User -> ChargeUserOperation)
    | ChargeCreditCard of (float * CreditCard * (TransactionId -> ChargeUserOperation)
    | EmailReceipt of (Email * (unit -> ChargeUserOperation)

We've made a couple of changes here. Firstly each operation is now parameterised by a tuple instead of a function. We can think of the tuple as the list of arguments to the function. Secondly, the final argument in the tuple is our callback. What that’s saying is that when you create an operation, you should tell it which operation you'd like to perform next that needs the result of this one. Let's give this new format a try.

let chargeUser (amount: float) (userId: UserId): TransactionId =
    LookupUser(
        userId,
        (fun user ->
            ChargeCreditCard(
                (amount, user.CreditCard),
                (fun transactionId ->
                    match user.EmailAddress with
                    | Some emailAddress ->
                        EmailReceipt(
                            { To = emailAddress
                              Body = $"TransactionId {transactionId}" },
                            (fun _ -> // Hmmm, how do we get out of this?)
                        )
                    | None -> // Hmmm, how do we get out of this?)
            ))
    )

Ok, it's getting better. We can see that this data structure is capturing the abstract logic of what the chargeUser function needs to do, without actually depending on any particular implementation. The only snag is we don't have a way to return a value at the end. Each of our operations has been defined such that it needs to be passed another callback, so how do we signal that we should actually just return a value?

What we need is a case in ChargeUserOperation that doesn't require a callback, one that just "returns" a value. Let's call it Return. We also need to make ChargeUserOperation generic on the return type to encapsulate the fact that each operation returns some value, but that the values returned by each operation might differ.

type ChargeUserOperation<'next> =
    | LookupUser of (UserId * (User -> ChargeUserOperation<'next>))
    | ChargeCreditCard of (float * CreditCard * (TransactionId -> ChargeUserOperation<'next>))
    | EmailReceipt of (Email * (unit -> ChargeUserOperation<'next>))
    | Return of 'next

We've chosen the name 'next for the generic parameter to signify the fact that it's the value returned by the "next" computation in the chain. In the case of Return then it's just immediately "returned". We're now finally in a position to write chargeUser.

let chargeUser (amount: float) (userId: UserId): ChargeUserOperation<TransactionId> =
    LookupUser(
        userId,
        (fun user ->
            ChargeCreditCard(
                (amount, user.CreditCard),
                (fun transactionId ->
                    match user.EmailAddress with
                    | Some emailAddress ->
                        EmailReceipt(
                            { To = emailAddress
                              Body = $"TransactionId {transactionId}" },
                            (fun _ -> Return transactionId)
                        )
                    | None -> Return transactionId)
            ))
    )

That's it! We've captured the logic of chargeUser in a completely abstract data structure. We know that it's got no dependence on any infrastructure because we fabricated it purely out of data types. We've taken our domain modelling to the next level, by modelling its computations as data too! ✅

One thing to note is that chargeUser now returns ChargeUserOperation<TransactionId>. This might seem weird, but we can think of it this way; chargeUser is now a function that produces a data structure which represents the the domain operation of charging and user and returning the TransactionId.

If you've grokked it this far, then you've made the fundamental mental leap; the fact that we're just representing a computation as data. The rest of this post is just going to be dedicated to cleaning this up to make it easier to read and write chargeUser. Things might get a bit abstract, but just keep in mind the fact that all we're doing is trying to build this data structure to represent our computation.

Flattening the pyramid ⏪

One problem with chargeUser in its current form is that we're back in nested callback hell, (a.k.a the Pyramid of Doom. We already know that monads are useful at flattening nested computations, so let's see if we can make ChargeUserOperation a monad.

The recipe for making something a monad is to implement bind for that type. We start by defining the types for the function signature and use that to guide us. In this case the signature is.

('a -> ChargeUserOperation<'b>) -> ChargeUserOperation<'a> -> ChargeUserOperation<'b>

So we're going to have to unwrap the ChargeUserOperation to get at the value 'a and then apply that the to the function we've been passed to generate a ChargeUserOperation<'b>. Let's get stuck in.

let bind (f: 'a -> ChargeUserOperation<'b>) (a: ChargeUserOperation<'a>) =
    match a with
    | LookupUser (userId, next) -> ??
    | ChargeCreditCard (amount, card, next) -> ??
    | EmailReceipt (unit, next) -> ??
    | Return x -> f x

As usual we've used a pattern match to unwrap the ChargeUserOperation in order to get at the inner value. In the case of Return it's a straight forward case of just calling f on the value x. But what about for those other operations? We don't have a value of type 'a to hand, so how can we invoke f?

Well what we do have to hand is next which is capable of producing a new ChargeUserOperation when supplied with a value. So what we can do is call that and recursively pass this new ChargeUserOperation to bind. The idea being that by recursively calling bind we'll eventually hit the Return case, at which point we can successfully extract the value and call f on it.

module ChargeUserOperation =
    let rec bind (f: 'a -> ChargeUserOperation<'b>) (a: ChargeUserOperation<'a>) =
        match a with
        | LookupUser (userId, next) -> LookupUser(userId, (fun user -> bind f (next user)))
        | ChargeCreditCard (amount, card, next) ->
            ChargeCreditCard(amount, card, (fun transactionId -> bind f (next transactionId)))
        | EmailReceipt (email, next) ->
            EmailReceipt(email, (fun () -> bind f (next())))
        | Return x -> f x

This might be a bit mind bending, but another way to view it is that we're just doing exactly the same callback nesting that we were forced to do by hand when we previously wrote chargeUser. Except now we've hidden the act of nesting these operations inside the bind function.

Each call to bind introduces another layer of nesting and pushes the Return down inside this new layer. For example if we had written LookupUser(userId, Return) |> bind (fun user -> ChargeCreditCard(amount, user.CreditCard, Return)) it would be equivalent to writing it in nested form like LookupUser(userId, (fun user -> ChargeCreditCard(amount, user.CreditCard, Return)).

With that we can easily write a computation expression called chargeUserOperation and use it to flatten that pyramid in chargeUser.

type ChargeUserOperationBuilder() =
    member _.Bind(a, f) = ChargeUserOperation.bind f a
    member x.Combine(a, b) = x.Bind(a, (fun () -> b))
    member _.Return(x) = Return x
    member _.ReturnFrom(x) = x
    member _.Zero() = Return()

let chargeUserOperation = ChargeUserOperationBuilder()

let chargeUser (amount: float) (userId: UserId) =
    chargeUserOperation {
        let! user = LookupUser(userId, Return)
        let! transactionId = ChargeCreditCard((amount, user.CreditCard), Return)

        match user.EmailAddress with
        | Some emailAddress ->
            let email =
                { To = emailAddress
                  Body = $"TransactionId {transactionId}" }

            do! EmailReceipt(email, Return)
            return transactionId
        | None -> return transactionId
    }

If do! is unfamiliar then it’s basically just let! except it ignores the result. Which we don’t care about when sending them email because it returns unit anyway.

Making data look like functions 🥸

The function is looking pretty nice now, but it's perhaps a bit unnatural to have to write LookupUser(userId, Return) instead of just lookupUser userId. It's also a bit annoying to have to constantly keep writing Return as the final argument to the ChargeUserOperation case constructors. Well it's easy to fix that, we can just write a "smart constructor" for each case that hides that detail away.

let lookupUser userId = LookupUser(userId, Return)

let chargeCreditCard amount card = ChargeCreditCard(amount, card, Return)

let emailReceipt email = EmailReceipt(email, Return)

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

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

            return transactionId

        | None -> return transactionId
    }

🔥 Nice! Now the function perfectly expresses the logic of our operation. It looks just like a regular monadic function, except under the hood it's actually building up an abstract data structure that represents our desired computation, rather than invoking any real calls to real infrastructure.

Factoring out a functor

Our chargeUser function is looking pretty good now, but there's some optimisations we can make to the definition of ChargeUserOperation. Let's consider what would happen if we wanted to write a different computation. We'd have to write a data type with a case for each operation we want to support, plus a case for Return and then finally implement bind for it. Wouldn't it be nice if we could implement bind once for any computation type?

Let's take a look at the definition of bind for ChargeUserOperation again and see if we can refactor it to something a bit more generic.

let rec bind (f: 'a -> ChargeUserOperation<'b>) (a: ChargeUserOperation<'a>) =
    match a with
    | LookupUser (userId, next) -> LookupUser(userId, (fun user -> bind f (next user)))
    | ChargeCreditCard (amount, card, next) ->
        ChargeCreditCard(amount, card, (fun transactionId -> bind f (next transactionId)))
    | EmailReceipt (email, next) ->
        EmailReceipt(email, (fun () -> bind f (next ())))
    | Return x -> f x

If we mandate that each operation must be of the form Operation of ('inputs * (‘output -> Operation<'next>) then they only differ by parameter types, which we could make generic. How should we do this for ChargeCreditCard though, because that currently has two inputs. Well we can combine the inputs into a single tuple like this ChargeCreditCard of ((float * CreditCard) * (TransactionId -> ChargeUserOperation<'next>)).

The form of bind for each operation is now identical, specifically it is Operation(inputs, next) -> Operation(inputs, (fun output -> bind f (next output)). So really, we actually only have two cases to consider, either it's an Operation or it's a Return. So let's create a type called Computation that encapsulates that.

type Computation<'op, 'next> =
    | Operation of 'op
    | Return of 'next

Which we can write bind for to turn it into a monad.

let rec inline bind (f: 'a -> Computation< ^op, 'b >) (a: Computation< ^op, 'a >) =
    match a with
    | Operation op -> Operation(op |> map (bind f))
    | Return x -> f x

The trick to making this work in the Operation case is to note that we require each Operation to be mappable. That is, we require it to be a functor. Mapping an operation is just a case of applying the function to the return value to transform it into something else. So by recursively calling bind f, as we did when writing for this ChargeUserOperation, we eventually hit the Return case, get access to the return value and just apply the current op to it by calling map.

So now when we're writing our operations we've reduced the task from having to implement bind to instead having to implement map, which is an easier task. For example we can express ChargeUserOperation 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)

Unfortunately, we can't eliminate any more boilerplate beyond here in F#. In other languages like Haskell it is possible to automatically derive the Map function for the operation functors, but in F# using FSharpPlus the best we can do today is write the static member Map ourselves. FSharpPlus then provides us the map function which will automatically pick the correct one by calling this static member Map when mapping an instance of ChargeUserOperation through the use of statically resolved type parameters.

We just have one final change to make to the smart constructors. Now that ChargeUserOperation is now just a functor, we need to lift them up into the Computation monad by wrapping them in an Operation.

let lookupUser userId = LookupUser(userId, Return) |> Operation

let chargeCreditCard amount card =
    ChargeCreditCard((amount, card), Return) |> Operation

let emailReceipt email =
    EmailReceipt(email, Return) |> Operation

let chargeUser (amount: float) (userId: UserId) =
    computation {
        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
    }

You just discovered the Free Monad 🥳

The data type we called Computation is usually called Free, the Operation case is often called Roll and the Return case is often called Pure. Other than that though we've discovered the basis of the free monad. It's just a data type and associated bind function that fundamentally describes sequential computations.

If you're a C# developer and you're familiar with LINQ then this might seem familiar to you. LINQ provides a way to build up a computation and defer its evaluation until sometime later. It's what allows LINQ to run in different environments, such as in a DB, because people are able to write interprets for it that turn the LINQ statements into SQL etc on the database server.

Should I use free monads 🤔

You might be wondering whether to use free monads in F# in your project. On the one hand they provide an excellent means of abstraction when it comes to defining computations in a domain model. They're also a joy to test because we can just interpret them as pure data and verify that for a given set of inputs we have produced the right data structure and hence computation; no more mocking 🙌.

Another plus is that with free monads we've actually achieved what object oriented programmers would call the interface segregation principle. Each computation only has access to the operations it needs to do its work. No more injecting wide interfaces into domain handlers and then having to write tests that verify we didn't call the wrong operation; it's literally impossible under this design!

On the other hand it seems to be pushing F# to the limits as it technically requires features like higher-kinded types, which F# doesn't technically support. So we have to resort to making heavy use of statically resolved type parameters to make it work. You might also find them to be quite abstract, although I hope that this post has at least helped to make their usage seem more intuitive, even if the internal implementation is still quite abstract.

On balance I don't think there's a one-size-fits-all answer here. You're going to have to weigh up the pros and cons for your project and team and decide whether this level of purity is worth it in order to warrant overcoming the initial learning curve and potentially cryptic compiler errors when things don't line up.

If you're thinking of taking the plunge and giving them a try then I would recommend using FSharpPlus which has done all the hard work of defining the free monad machinery for you. Also see the appendix at the end for a full example using FSharpPlus.

What did we learn 🧑‍🎓

The name free monad, might be cryptic and even misleading at first, but the concept is relatively straight forward. Free monads are just a data structure that represents a chain of computations that should be run sequentially. By building a data structure we're able to leave it up to someone else to come along and interpret it in anyway they see fit. They’re “free” to do it how they need to providing they respect the ordering of the computations in the data structure we have handed to them.

A free monad is just a way for us to describe our computation in very abstract terms. We're placing the fewest restrictions possible on what the computation has to do and making no assumptions about how it should be done. We've completely decoupled the "what" from the "how", which is one of the fundamental pillars of good Domain Driven Design, because it means that the domain model is a pure abstract representation of the problem at hand unburdened by the details of how it is hosted.

Next time ⏭

We've covered a lot in this post but we haven't talked about how we actually go about running these computations. So far we've just built some abstract representations of them in data. Next time we'll see how we can actually interpret them to do some real work.

Appendix

If you want to see a complete, top-to-bottom, example of writing a free monadic workflow using FSharpPlus, then I've included one in the section below.

#r "nuget: FSharpPlus"

open FSharpPlus
open FSharpPlus.Data

type ChargeUserOperation<'next> =
    | LookupUser of UserId * (User -> 'next)
    | ChargeCreditCard of (float * CreditCard) * (TransactionId -> 'next)
    | EmailReceipt of TransactionId * (TransactionId -> '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)

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
    }

When writing the smart constructors here, e.g lookUser we pass the identity function, id, as the second argument. The reason for this is because Free.liftF maps the functor with Pure and then lifts it up with Roll. So by using id and then writing Free.liftF we end up with the desired Roll (LookupUser(userId, Pure)). The other way to think of id here is that the default "callback" when creating an operation is to just return the value produced by this computation and not do anything else.