Grokking Free Monads
Tags: fsharp, functional, programming, grokking
Published: 2021-05-14 19:33:19

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](https://dev.to/choc13/grokking-monads-in-f-3j7f) 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.

```fsharp
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](https://dev.to/choc13/grokking-monads-in-f-3j7f). 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.

```fsharp
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.

```fsharp
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.

```fsharp
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.

```fsharp
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.

```fsharp
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`.

```fsharp
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](https://en.wikipedia.org/wiki/Pyramid_of_doom_(programming)). 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.

```fsharp
('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.

```fsharp
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.

```fsharp
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`.

```fsharp
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.

```fsharp
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.

```fsharp
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.

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

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

```fsharp
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.

```fsharp
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`.

```fsharp
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](https://fsprojects.github.io/FSharpPlus/reference/fsharpplus-data-free.html) 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.

{% details %}

```fsharp
#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.

{% enddetails %}