Now that we have a fairly good understanding of what the free monad is and how it works. Let’s see what it looks like to write a real program based on this concept. This time we won’t implement Free ourselves but use the cats library for that. If you don’t know all the theory behind the free monad and just want to see how to use it then read on as this post builds an application from scratch.
In this post we’ll write simple DSLs, lift them into the free monad and even combine them into one program. There is some boiler plate around but I want to get a feeling of what it looks like to combine more DSLs and see how we can architecture a whole application around the free monad.
Getting started
Let’s pretend that we are writing a stock management program to maintain an inventory of all the items inside a warehouse.
Let’s start by defining our DSL to manage the stock:
type LocationId = String
type ProductId = String
type PurchaseOrderId = String
object Stock {
sealed trait Movement[A]
// POContent list all the product and quantities inside a purchase order
case class POContent(poId: PurchaseOrderId)
extends Movement[Map[ProductId, Int]]
// Create some stock in a location
case class CreateStock(
productId: ProductId,
locationId: LocationId,
quantity: Int) extends Movement[Unit]
// Move some items from one location to the other
case class MoveStock(
productId: ProductId,
source: LocationId,
destination: LocationId,
quantity: Int) extends Movement[Unit]
}
This are our basic operations that we need in order to inbound some stock (i.e. receiving new products in the warehouse).
Before we can write our first program we need a way to lift our DSL into the Free monad.
import cats.free.Free
import cats.free.Free._
object Stock {
// DSL definitions ....
type MovementF[A] = Free[Movement, A]
def poContent(poId: PurchaseOrderId): MovementF[Map[ProductId, Int]] =
liftF(POContent(poId))
def createStock(
productId: ProductId,
locationId: LocationId,
quantity: Int): MovementF[Unit] =
liftF(CreateStock(productId, locationId, quantity))
def moveStock(
productId: ProductId,
source: LocationId,
destination: LocationId,
quantity: Int): MovementF[Unit] =
liftF(MoveStock(productId, source, destination, quantity))
}
And finally we can write our business logic.
import cats.implicits._
def inboundStock(poId: PurchaseOrderId): MovementF[Unit] =
for {
content <- poContent(poId)
_ <- content.toList.traverseU {
case (productId, quantity) =>
createStock(productId, "dock", quantity)
}
_ <- content.toList.traverseU {
case (productId, quantity) =>
moveStock(productId, "dock", "warehouse", quantity)
}
} yield ()
Here we receive a new purchase order, retrieve the products in the order and create the corresponding stock at the dock and then we move all the stock from the dock to the warehouse. This is our business logic but we can’t run it as we have yet to write an interpreter.
Let’s just create one that print all the actions to the console.
import cats.{ Id, ~> }
import Stock._
object StockConsole extends (Movement ~> Id) {
def apply[A](movement: Movement[A]): Id[A] = movement match {
case POContent(poId) =>
println(s"Listing content of $poId: [200 Mars, 100 Milkyway, 150 Galaxy]")
Map("Mars" -> 200, "Milkyway" -> 100, "Galaxy" -> 150)
case CreateStock(productId, locationId, quantity) =>
println(s"Creating $quantity $productId at $locationId")
case MoveStock(productId, source, destination, quantity) =>
println(s"Moving $quantity $productId from $source to $destination")
}
}
At last we can execute it with:
inboundStock("po-1").foldMap(StockConsole)
and this is what we get on the console
Listing content of po-1: [200 Mars, 100 Milkyway, 150 Galaxy] Creating 200 Mars at dock Creating 100 Milkyway at dock Creating 150 Galaxy at dock Moving 200 Mars from dock to warehouse Moving 100 Milkyway from dock to warehouse Moving 150 Galaxy from dock to warehouse
Dealing with errors
Now let’s imagine that there is something wrong in our business logic
def inboundInvalidStock(poId: PurchaseOrderId): MovementF[Unit] =
for {
content <- poContent(poId)
_ <- content.toList.traverseU {
case (productId, quantity) =>
createStock(productId, "dock", quantity)
}
_ <- content.toList.traverseU {
case (productId, quantity) =>
// move 1 more items than we received in the order
moveStock(productId, "dock", "warehouse", quantity + 1)
}
} yield ()
That’s not good we’re moving more items than we have received but our program runs just fine. We’d rather want it to report us an error in this case.
At this point we have 2 solutions. We can change MoveStock to extends Movement[Either[String, Unit]] but then we’ll have to modify our business logic to deal with the error case which I don’t want to. That leads us to the second solution: changing our interpreter to transform Movement[A] into Either[String, A].
// a Result can be either a an error (Left) or a valid result A (Right)
type Result[A] = Either[String, A]
object StockValidation extends (Movement ~> Result) {
val content = Map("Mars" -> 200, "Milkyway" -> 100, "Galaxy" -> 150)
def apply[A](movement: Movement[A]): Result[A] = movement match {
case POContent(poId) =>
println(s"Listing content of $poId: [200 Mars, 100 Milkyway, 150 Galaxy]")
Right(content)
case CreateStock(productId, locationId, quantity) =>
println(s"Creating $quantity $productId at $locationId")
Right(())
case MoveStock(productId, source, destination, quantity) =>
val isValid = content.get(productId).map(_ == quantity) getOrElse false
if (isValid) {
println(s"Moving $quantity $productId from $source to $destination")
Right(())
} else {
println("Error: Invalid quantity")
Left("Invalid quantity")
}
}
}
and we can run it with
inboundInvalidStock("po-1").foldMap(StockValidation)
And this time we got an error as soon as we try to move something to the warehouse
Listing content of po-1: [200 Mars, 100 Milkyway, 150 Galaxy] Creating 200 Mars at dock Creating 100 Milkyway at dock Creating 150 Galaxy at dock Error: Invalid quantity
Adding logs
Instead of using println directly in the interpreter we can define our own DSL for logging and add the logs to our program. Let’s do just that and then combine the logging instructions with the stock instructions.
object Logging {
sealed trait Log[A]
case class Info(message: String) extends Log[Unit]
case class Error(message: String) extends Log[Unit]
}
Simple enough! But this time we can’t use liftF to lift into the Free monad. Why? Because we’re going to mix Log and Movement in our program so we want to lift into a Free[F, A] where F is the coproduct of Log and Movement.
import import cats.free.Inject
object Stock {
// ....
class Movements[F[_]](implicit i: Inject[Movement, F]) {
def poContent(poId: PurchaseOrderId): Free[F, Map[ProductId, Int]] =
Free.inject[Movement, F](POContent(poId))
def moveStock(
productId: ProductId,
source: LocationId,
destination: LocationId,
quantity: Int): Free[F, Unit] =
Free.inject[Movement, F](
MoveStock(productId, source, destination, quantity)
)
def createStock(
productId: ProductId,
locationId: LocationId,
quantity: Int): Free[F, Unit] =
Free.inject[Movement, F](
CreateStock(productId, locationId, quantity)
)
}
object Movements {
implicit def movements[F[_]](implicit i: Inject[Movement, F]): Movements[F] =
new Movements[F]
}
}
object Logging {
// ...
class Logs[F[_]](implicit i: Inject[Log, F]) {
def error(message: String): Free[F, Unit] =
Free.inject[Log, F](Error(message))
def info(message: String): Free[F, Unit] =
Free.inject[Log, F](Info(message))
}
object Logs {
implicit def logs[F[_]](implicit i: Inject[Log, F]): Logs[F] = new Logs[F]
}
}
If you don’t really understand what’s going on here you can refer to the previous article where there is a longer explanation how inject lifts the operation into the Free monad with the correct type. (It’s just like liftF but with the correct type).
Alternatively you can consider this code as some boilerplate needed to make things work. There are even some plugins such as … that can generate this boilerplate for you.
Let’s write a basic console logger to interpret our logging DSL
import Logging._
object ConsoleLogger extends (Log ~> Id) {
def apply[A](log: Log[A]): Id[A] = {
val timestamp = System.currentTimeMillis()
log match {
case Error(message) =>
println(s"[ERROR] [$timestamp] $message")
case Info(message) =>
println(s"[INFO ] [$timestamp] $message")
}
}
}
We’re now ready to combine logs and movements into our inbound program.
import cats.data.Coproduct
import Stock._
import Logging._
type MovementOrLog[A] = Coproduct[Movement, Log, A]
def inboundStockWithLog(poId: PurchaseOrderId)(
implicit movements: Movements[MovementOrLog],
logs: Logs[MovementOrLog]): Free[MovementOrLog, Unit] = {
import movements._
import logs._
for {
_ <- info(s"Inbounding $poId")
content <- poContent(poId)
_ <- content.toList.traverseU {
case (productId, quantity) =>
createStock(productId, "dock", quantity)
}
_ <- content.toList.traverseU {
case (productId, quantity) =>
moveStock(productId, "dock", "warehouse", quantity)
}
} yield ()
}
And we can even execute it
val stockConsoleWithLogging: MovementOrLog ~> Id =
StockConsole or ConsoleLogger
inboundStockWithLog("po-1").foldMap(StockConsoleWithLogging)
And we have our log message on the console
[INFO ] [1482098739890] Inbounding po-1 Listing content of po-1: [200 Mars, 100 Milkyway, 150 Galaxy] Creating 200 Mars at dock Creating 100 Milkyway at dock Creating 150 Galaxy at dock Moving 200 Mars from dock to warehouse Moving 100 Milkyway from dock to warehouse Moving 150 Galaxy from dock to warehouse
More complexity
Ultimately we’d like to track the inventory at each location. For that we need a way to update the inventory at a given location and we’re going to do it with … a new DSL.
object Inventory {
sealed trait Update[A]
case class Increment(locationId: LocationId, productId: ProductId, quantity: Int)
extends Update[Unit]
case class Decrement(locationId: LocationId, productId: ProductId, quantity: Int)
extends Update[Unit]
def increment(locationId: LocationId, productId: ProductId, quantity: Int): Free[Update, Unit] =
liftF(Increment(locationId, productId, quantity))
def decrement(locationId: LocationId, productId: ProductId, quantity: Int): Free[Update, Unit] =
liftF(Decrement(locationId, productId, quantity))
class Updates[F[_]](implicit i: Inject[Update, F]) {
def increment(locationId: LocationId, productId: ProductId, quantity: Int): Free[F, Unit] =
Free.inject[Update, F](Increment(locationId, productId, quantity))
def decrement(locationId: LocationId, productId: ProductId, quantity: Int): Free[F, Unit] =
Free.inject[Update, F](Decrement(locationId, productId, quantity))
}
object Updates {
implicit def updates[F[_]](implicit i: Inject[Update, F]): Updates[F] =
new Updates[F]
}
}
along with its interpreter
import Inventory._
object InventoryConsole extends (Update ~> Id) {
def apply[A](update: Update[A]): Id[A] = {
update match {
case Increment(locationId, productId, quantity) =>
println(s"Add $quantity $productId at $locationId")
case Decrement(locationId, productId, quantity) =>
println(s"Remove $quantity $productId from $locationId")
}
}
}
And let’s at this to our business logic
type MovementOrLogOrUpdate[A] = Coproduct[Update, MovementOrLog, A]
def inboundInventory(poId: PurchaseOrderId)(
implicit movements: Movements[MovementOrLogOrUpdate],
logs: Logs[MovementOrLogOrUpdate],
updates: Updates[MovementOrLogOrUpdate]): Free[MovementOrLogOrUpdate, Unit] = {
import movements._
import logs._
import updates._
for {
_ <- info(s"Inbounding $poId")
contents <- poContent(poId)
_ <- contents.toList.traverseU {
case (productId, quantity) =>
createStock(productId, "dock", quantity)
// when we create stock we increment to quantity at the location
.flatMap(_ => increment("dock", productId, quantity))
}
_ <- contents.toList.traverseU {
case (productId, quantity) =>
moveStock(productId, "dock", "warehouse", quantity)
// when we move stock we need to decrement the stock from the source
.flatMap(_ => decrement("dock", productId, quantity))
// and increment it at the destination
.flatMap(_ => increment("warehouse", productId, quantity))
}
} yield ()
}
And finally let’s run it
val stockConsoleWithLoggingAndUpdate: MovementOrLogOrUpdate ~> Id =
InventoryConsole or stockConsoleWithLogging
inboundInventory("po-1").foldMap(stockConsoleWithLoggingAndUpdate)
[INFO ] [1482102639964] Inbounding po-1 Listing content of po-1: [200 Mars, 100 Milkyway, 150 Galaxy] Creating 200 Mars at dock Add 200 Mars at dock Creating 100 Milkyway at dock Add 100 Milkyway at dock Creating 150 Galaxy at dock Add 150 Galaxy at dock Moving 200 Mars from dock to warehouse Remove 200 Mars from dock Add 200 Mars at warehouse Moving 100 Milkyway from dock to warehouse Remove 100 Milkyway from dock Add 100 Milkyway at warehouse Moving 150 Galaxy from dock to warehouse Remove 150 Galaxy from dock Add 150 Galaxy at warehouse
I don’t know what you think but I am starting to feel a bit uncomfortable when I look at the business logic. It start to be bloated and not as clean and easy to read as it used to be. And we haven’t yet added any persistence to our program. Let’s do it to see how bad it gets and then we’ll see how we can clean this up.
Adding persistence
By now you should get used to it … let’s create another DSL
object Storage {
sealed trait Query[A]
case class Get[K, V](key: K) extends Query[Option[V]]
case class Put[K, V](key: K, value: V) extends Query[Unit]
class Queries[F[_]](implicit i: Inject[Query, F]) {
def get[K, V](key: K): Free[F, Option[V]] =
Free.inject[Query, F](Get(key))
def put[K, V](key: K, value: V): Free[F, Unit] =
Free.inject[Query, F](Put(key, value))
}
object Queries {
implicit def queries[F[_]](implicit i: Inject[Query, F]) =
new Queries[F]
}
}
Then the interpreter that will just store the data in a map
import Storage._
object KeyValueStore extends (Query ~> Id) {
var store: Map[Any, Any] = Map.empty
def apply[A](query: Query[A]): Id[A] = query match {
case Get(key) => store.get(key)
case Put(key, value) => store += key -> value
}
}
And finally let’s try to update our program to store the product quantities in the map
type MovementOrLogOrUpdateOrQuery[A] = Coproduct[Query, MovementOrLogOrUpdate, A]
def persistInboundInventory(poId: PurchaseOrderId)(
implicit movements: Movements[MovementOrLogOrUpdateOrQuery],
logs: Logs[MovementOrLogOrUpdateOrQuery],
updates: Updates[MovementOrLogOrUpdateOrQuery],
queries: Queries[MovementOrLogOrUpdateOrQuery]): Free[MovementOrLogOrUpdateOrQuery, Unit] = {
import movements._
import logs._
import updates._
import queries._
for {
_ <- info(s"Inbounding $poId")
contents <- poContent(poId)
_ <- contents.toList.traverseU { case (productId, quantity) =>
createStock(productId, "dock", quantity)
.flatMap(_ => increment("dock", productId, quantity))
.flatMap(_ => get[String, Map[String, Int]]("dock").flatMap {
case Some(products) => put("dock", products + (productId -> quantity))
case None => put("dock", Map(productId -> quantity))
})
}
_ <- contents.toList.traverseU {
case (productId, quantity) =>
moveStock(productId, "dock", "warehouse", quantity)
.flatMap(_ => decrement("dock", productId, quantity))
.flatMap(_ => increment("dock", productId, quantity))
.flatMap(_ => get[String, Map[String, Int]]("dock").flatMap {
case Some(products) => put("dock", products - productId)
case None => pure(())
})
.flatMap(_ => get[String, Map[String, Int]]("warehouse").flatMap {
case Some(products) => put("warehouse", products + (productId -> quantity))
case None => put("warehouse", Map(productId -> quantity))
})
}
} yield ()
}
and finally let’s run it
val stockConsoleWithLoggingAndPersistentUpdate: MovementOrLogOrUpdateOrQuery ~> Id =
KeyValueStore or stockConsoleWithLoggingAndUpdate
persistInboundInventory("po-1").foldMap(stockConsoleWithLoggingAndPersistentUpdate)
It produces the same output as before but this time the product quantities at each location are stored in the map.
In a real world that would be a persistent storage (e.g. a database).
Adding perspective
I don’t know about you but I wouldn’t maintain this business logic. It doesn’t read well – no one can figure out what it does without a careful look.
In fact it’s because our architecture is not right. We have created a single layer containing all the operations.
It would have been much better to write the business logic using the Stock DSL. Then turn the Movement into more basic operation (i.e. Inventory updates) which can then be turned into Storage queries.
That would make the business much clearer but how can we combine this logic vertically rather than horizontally?
Well, what does an interpreter do? It transforms a data type into a monad and it turns out that the Free monad is a monad. So we can have an interpreter for Stock that generates a Free monad of inventory updates and then an inventory update interpreter that generates a Free monad containing the storing logic.
Let’s write these interpreters
type InventoryF[A] = Free[Update, A]
def movementInterpreter =
new (Movement ~> InventoryF) {
def apply[A](movement: Movement[A]): InventoryF[A] =
movement match {
case POContent(_) =>
pure(Map("Mars" -> 200, "Milkyway" -> 100, "Galaxy" -> 150))
case CreateStock(productId, locationId, quantity) =>
increment(locationId, productId, quantity)
case MoveStock(productId, source, destination, quantity) =>
for {
_ <- decrement(source, productId, quantity)
_ <- increment(destination, productId, quantity)
} yield ()
}
}
type StorageOrLog[A] = Coproduct[Query, Log, A]
type StorageOrLogF[A] = Free[StorageOrLog, A]
def inventoryInterpreter(implicit logs: Logs[StorageOrLog], queries: Queries[StorageOrLog]) =
new (Update ~> StorageOrLogF) {
import logs._
import queries._
type Key = (LocationId, ProductId)
def apply[A](update: Update[A]): StorageOrLogF[A] = {
update match {
case Increment(locationId, productId, quantity) =>
for {
_ <- info(s"Add $quantity $productId at $locationId")
existing <- get[Key, Int]((locationId, productId)).map(_ getOrElse 0)
_ <- put((locationId, productId), existing + quantity)
} yield ()
case Decrement(locationId, productId, quantity) =>
for {
_ <- info(s"Remove $quantity $productId from $locationId")
existing <- get[Key, Int]((locationId, productId)).map(_ getOrElse 0)
_ <- put((locationId, productId), existing - quantity)
} yield ()
}
}
}
Not too bad! Each interpreter is quite clear and understandable and we can even re-use our initial implementation to define the inbound operation.
def inboundStockWithLog(poId: PurchaseOrderId)(
implicit movements: Movements[MovementOrLog],
logs: Logs[MovementOrLog]): MovementF[Unit] = {
import movements._
import logs._
for {
_ <- info("Inbounding $poId")
content <- poContent(poId)
_ <- content.toList.traverseU {
case (productId, quantity) =>
createStock(productId, "dock", quantity)
}
_ <- content.toList.traverseU {
case (productId, quantity) =>
moveStock(productId, "dock", "warehouse", quantity)
}
} yield ()
}
We are almost there – we just need to combine our interpreters into one that turns Movement into Id.
This is what we have so far:
- movementInterpreter turns Movements into InventoryF
- inventoryInterpreter turns Updates into StorageOrLogF
- KeyValueStore turns Queries into Id
- ConsoleLogger turns Logs into Id
We’re still missing some glue here. We got an InventoryF (i.e. Free[Update, A]) but our interpreter expects just an Update type. Fortunately the missing interpreters are easy to write as they just have to foldMap the free monad.
def inventoryFreeInterpreter(
implicit logs: Logs[StorageOrLog],
queries: Queries[StorageOrLog]) =
new (InventoryF ~> StorageOrLogF) {
def apply[A](inventoryF: InventoryF[A]): StorageOrLogF[A] =
inventoryF.foldMap(inventoryInterpreter)
}
def storageOrLogFreeInterpreter = new (StorageOrLogF ~> Id) {
def apply[A](fa: StorageOrLogF[A]): Id[A] =
fa.foldMap(KeyValueStore or ConsoleLogger)
}
We can then combine them all
val stackInterpreter = MovementInterpreter andThen inventoryFreeInterpreter andThen storageOrLogFreeInterpreter
and finally we can run our inbound program
inboundStockWithLog("po-1").foldMap(stackInterpreter or ConsoleLogger)
[INFO ] [1482103350405] Inbounding po-1 [INFO ] [1482103350408] Add 200 Mars at dock [INFO ] [1482103350410] Add 100 Milkyway at dock [INFO ] [1482103350410] Add 150 Galaxy at dock [INFO ] [1482103350411] Remove 200 Mars from dock [INFO ] [1482103350412] Add 200 Mars at warehouse [INFO ] [1482103350413] Remove 100 Milkyway from dock [INFO ] [1482103350413] Add 100 Milkyway at warehouse [INFO ] [1482103350413] Remove 150 Galaxy from dock [INFO ] [1482103350413] Add 150 Galaxy at warehouse
That’s much better! All the code is nicely separated and easy to follow.
Hopefully that gave you a taste of what is free-programing! There is still a bunch of boilerplate (more that I would like) – especially given that our example is quite simple after all.
You have to be very careful to combine the types and the interpreters (the order does matter a lot and the compilation errors are not always very explicit – at least for me).
And by the way, don’t trust IntelliJ as it sometimes shows inexistent errors (especially for the interpreters) so just compile your program as often as possible.