The Free monad explained – part 2

Remember in part 1 we implemented a little program to interact with the user. We nicely separated the business logic from the implementation. And as good as it is we now need to add more functionality to our application and this exactly what we’re going to cover here.

The idea is to define a new language for user authentication and then combine it with the user interaction language to build a more complex program.

Let’s start to define our authentication language in the same fashion that we defined Interact.

case class UserId(value: String)
case class Password(value: String)
case class User(id: UserId, name: String)
case class Permission(value: String)

sealed trait Auth[A]
case class Login(userId: UserId, password: Password) extends Auth[Option[User]]
case class HasPermission(user: User, permission: Permission) extends Auth[Boolean]

Our language defines 2 operations:

– Login: Takes a user id and a password and return a User if the password is valid.
– HasPermission: Takes a user and a permission and checks if the user can access this resource.

And we’ll need an interpreter to run our program. So let’s create one that turns Auth into Id.

object MyAuth extends (Auth ~> Id) {
   def apply[A](a: Auth[A]): Id[A] = a match {
      case Login(userId, password) =>
         if (userId.value == "jdoe" && password.value == "pass")
            Some(User(userId, name="John Doe"))
         else None
      case HasPermission(user, permission) => == "jdoe" && permission.value == "SHARE_SECRET"

Our interpreter is ready, let’s try to write a program that uses both Auth and Interact.

val prog: Free[???, Unit] = for {
   username  <- Ask("username: ")
   password  <- Ask("password: ")
   user      <- Login(UserId(username), Password(password))
   hasAccess <- user
      .map(HasPermission(_, Permission("SHARE_SECRET")))
   _ <- if (hasAccess) Tell("The secret is BLABLABLA")
        else Tell("Can't tell you anything")
} yield ()

As you can see it doesn’t compile because we don’t have a type that is both an Interact and an Auth. Basically we wouldn’t need something like Either[Interact, Auth] or a CoProduct[Interact, Auth].

Guess what? Let’s just write this type: CoProduct so that we can fix our program.

case class CoProduct[F[_], G[_], A](value: Either[F[A], G[A]])

type App[A] = CoProduct[Interact, Auth, A]

// val prog: Free[App, Unit] = ...

That’s a good start but we’re not quite there yet. We need a way to turn our language (Interact and Auth) into their co-product and a way to turn this co-product into a Free monad.

First thing first, let’s define a way to inject Interact and Auth into a CoProduct.

sealed trait Inject[F[_], G[_]] {
   def inject[A](fa: F[A]): G[A]

This trait inject an F[A] (e.g Interact[A] or Auth[A]) into a G[A] (e.g CoProduct[F, ?, A] or CoProduct[?, F, A]).

object Inject {
  // lift F into the co-product of F and F
  implicit def reflexive[F[_]]: Inject[F, F] = new Inject[F, F] {
    def inject[A](fa: F[A]): F[A] = fa
  // lift F into G where G is the co-product of F and something else
  implicit def left[F[_], G[_]]: Inject[F, ({ type T[x] = CoProduct[F, G, x] })#T] =
    new Inject[F, ({ type T[x] = CoProduct[F, G, x] })#T] {
      def inject[A](f: F[A]): CoProduct[F, G, A] = CoProduct(Left(f))
  // lift G into F where F is the co-product of G and something else
  implicit def right[F[_], G[_], H[_]](implicit i: Inject[F, G]): Inject[F, ({ type T[x] = CoProduct[H, G, x] })#T] =
    new Inject[F, ({ type T[x] = CoProduct[H, G, x] })#T] {
      // i.inject(f) is a G
      def inject[A](f: F[A]): CoProduct[H, G, A] = CoProduct(Right(i.inject(f)))

Woohoohoo!!! What’s happening here! Don’t worry it’s not as bad as it looks. Basically it builds CoProducts of the right type. (It wrap the Interact into a left-CoProduct and the Auth into a right-CoProduct making sure the types are aligned).

You got the idea. Cool! Now let’s explain what the weird type-thingy mean: ({ type T[X]=CoProduct[F, G, X] })#T.
We are trying to inject F into a CoProduct so we’d expect a type signature that looks like this

implicit def left[F[_], G[_]]: Inject[F, CoProduct[F, G, _]]

where the last _ means whatever type you put in here. Guess what this is exactly what this syntax means. It’s called a type lambda and it means CoProduct[F, G, X] for whatever X you put in here. It doesn’t look nice but this is the way to write it.

That was the hardest bit. If you got it, it’ll be smooth up to the end now.
If you can’t make any sense of it, don’t worry – you’ll still be able to use the Free monad as this is library code that is already written for you.

Moving on! We are now able to lift any F[A] (like Interact or Auth) into a CoProduct. Let’s now turn this CoProduct into a Free monad.

// lift an F[A] into a Free[G, A]
// G is our CoProduct (e.g. App)
def lift[F[_], G[_], A](fa: F[A])(implicit i: Inject[F, G]): Free[G, A] =
   Bind(i.inject(fa), (a: A) => Return(a))

To make things easier we’re going to define some smart constructors to build the Free monad of the correct type.

class Interacts[G[_]](implicit i: Inject[Interact, G]) {
   def ask(prompt: String): Free[G, String]   = lift(Ask(prompt))
   def tell(message: String): Free[G, String] = lift(Tell(message))

class Auths[G[_]](implicit i: Inject[Auth, G]) {
   def login(userId: UserId, password: Password): Free[G, Option[User]] = 
      lift(Login(userId, password)
   def hasPermission(user: User, permission: Permission): Free[G, Boolean] =
      lift(HasPermission(user, permission))

// Make an instance of the smart constructor implicitly available
object Interacts {
   implicit def instance[G[_]](implicit i: Inject[Interact, G]) = 
      new Interacts[G]
object Auth {
   implicit def instance[G[_]](implicit i: Inject[Auth, G]) =
      new Auths[G]

Finally we can write our program:

def program[G[_]](implicit interacts: Interacts[G], auths: Auth[G]): Free[G, Unit] = {
   import auths._
   import interacts._

   for {
      username  <- ask("username: ")
      password  <- ask("password: ")
      user      <- login(UserId(username), Password(password))
      hasAccess <- user
         .map(hasPermission(_, Permission("SHARE_SECRET")))
      _ <- if (hasAccess) tell("The secret is BLABLABLA")
         else tell("Can't tell you anything!")
   } yield ()

We’re almost at the end but we miss one little thing: the interpreter. We have an interpreter for Interact and one for Auth but nothing for both. We just need a way to combine them together. Let’s add a ‘or’ method to the `~>` trait.

sealed trait ~>[F[_], G[_]] { self =>
   def apply[A](fa: F[A]): G[A]

   def or[H[_]](h: H ~> G) = new (({ type T[X] = CoProduct[F, H, X] })#T ~> G) {
      def apply[A](c: CoProduct[F, H, A]): G[A] =
         c.value match {
            case Left(fa)  => self(fa)
            case Right(ha) => h(ha)

Again there is a type lambda it just reads something like

new CoProduct[F, H, _] ~> G { ....

Having define ‘or’ we can now combine our 2 interpreters and run our program.

program[App].foldMap(MyAuth or Console)

// and if we want to test it
val inputs = Map(
   "username: " -> "jdoe",
   "password: " -> "pass"
val (out, _) = program[App].foldMap(MyAuth or Tester).apply(inputs)
// out is List("The secret is BLABLABLA")

If you’ve followed this far you should have a pretty good understanding of how the Free monad works and what it allows you to do.

As a wrap up let’s summarise what we need to do to define our own DSL using the Free monad:

  1. define your language data types (sealed trait and case classes)
  2. create smart constructors to lift them into co-products
  3. define the interpreters

Then to use this DSL to write a program you need to:

  1. write a program using the smart constructors
  2. compose the interpreters
  3. foldMap the program using the interpreter from above

Using Free you can also build a layered architecture. How ? The interpreter must transform Free into another monad.
It means it can also transform Free into another Free monad that uses a lower level DSL.

Finally, if you decide to use Free in your application, remember to use a library such as Cats or Scalaz (and not the code in this post which is not production ready – especially not stack-safe).

You can have a look at the code used in these 2 posts over here: