Commit 004ee025 authored by Johannes Kohlmann's avatar Johannes Kohlmann
Browse files

Initial commit.

# bloop and metals
# metals
# vs code
# scala 3
# sbt
# eclipse
# intellij idea
# mac
# other?
### Content
This repository contains implementations and examples related to the talk 'The Free Monad in Scala' as part of the Seminar 'Functional Programming' (Summer Term 2021).
name := "freeMonadTalk"
version := "0.1"
scalaVersion := "2.13.6"
sbt.version = 1.5.5
\ No newline at end of file
package example
import free.Free
import free.Id.Id
import free.NaturalTransformation.~>
import scala.collection.mutable.ListBuffer
object Console extends App {
// Define all basic operations of our program
sealed trait ConsoleOp[A]
final case object ReadLine extends ConsoleOp[String]
final case class WriteLine(line: String) extends ConsoleOp[Unit]
// Free the instruction type and define smart constructors that lift the instructions
type Console[A] = Free[ConsoleOp, A]
def readLine: Console[String] = Free.liftF(ReadLine)
def writeLine(line: String): Console[Unit] = Free.liftF(WriteLine(line))
// Define a program
val program: Console[Unit] = for {
_ <- writeLine("What's your name?")
name <- readLine
_ <- writeLine(s"Hello, $name!")
} yield ()
// Define some interpreters
val idInterpreter: ConsoleOp ~> Id = new (ConsoleOp ~> Id) {
override def apply[A](fa: ConsoleOp[A]): Id[A] = fa match {
case WriteLine(line) => println(line)
case ReadLine => io.StdIn.readLine
def testInterpreter(stdIn: ListBuffer[String], stdOut: ListBuffer[String]): ConsoleOp ~> Id = new (ConsoleOp ~> Id) {
override def apply[A](fa: ConsoleOp[A]): Id[A] = fa match {
case WriteLine(line) =>
stdOut += line
case ReadLine => stdIn.remove(0)
// Bring the Monad instance for Id into scope
import free.Id._
// Run the program in "production"
// And test it with the testInterpreter
// Setup
val name = "Mr. Free"
val in: ListBuffer[String] = ListBuffer(name)
val out: ListBuffer[String] = ListBuffer.empty[String]
val testInterpreter: ConsoleOp ~> Id = testInterpreter(in, out)
// Execute
// Check whether the output matches the expected output
println(s"Standard out contains exactly two line? ${out.length == 2}")
println(s"Standard out contains correct name? ${out.last.contains(name)}")
package example
import free.Free
import free.Id.Id
import free.NaturalTransformation.~>
// This is a more involved example concerning CRUD operations on some API
object Crud extends App {
final case class Response[A](status: Int, body: A)
Define the basic operations of our programs. Note that RequestOp does not have to be covariant, but declaring it
covariant makes IntelliJ freak out less when typechecking.
sealed trait RequestOp[+A]
type R[A] = RequestOp[Response[A]]
final case class Create[T](url: String, data: T) extends R[Int]
final case class Read[T](url: String, id: Int) extends R[Option[T]]
final case class Update[T](url: String, id: Int, f: T => T) extends R[Option[T]]
final case class Delete(url: String, id: Int) extends R[Unit]
// Free the instruction type and define smart constructors that lift the instructions
type Request[A] = Free[RequestOp, A]
def create[A](url: String, data: A): Request[Response[Int]] = Free.liftF[RequestOp,Response[Int]](Create(url, data))
def read[A](url: String, id: Int): Request[Response[Option[A]]] = Free.liftF[RequestOp,Response[Option[A]]](Read(url, id))
def delete(url: String, id: Int): Request[Response[Unit]] = Free.liftF[RequestOp, Response[Unit]](Delete(url, id))
def update[A](url: String, id: Int, f: A => A): Request[Response[Option[A]]] = Free.liftF[RequestOp, Response[Option[A]]](Update(url, id, f))
Define an interpreter. The one below uses a mutable map to represent the API but one could also sent out HTTP
requests, write the changes to the file system or update a database.
def localInterpreter(store: collection.mutable.Map[(String, Int), Any]): RequestOp ~> Id = new (RequestOp ~> Id) {
override def apply[A](fa: RequestOp[A]): Id[A] = fa match {
case Create(url, data) =>
// Find the next free id
val id = + 1
store((url, id)) = data
Response(200, id)
case Read(url, id) =>
val value = store.get((url, id))
if (value.isDefined) Response(200,[A]))
else Response(404, None)
case Update(url, id, f) =>
val value = store.get((url, id))
if (value.isDefined) {
val updated = f(value.get.asInstanceOf[A])
store((url, id)) = updated
Response(200, Some(updated))
} else Response(404, None)
case Delete(url, id) => store.remove((url, id))
Response(200, ())
Now, we can start writing our business logic in terms of our free instructions. In this case, we model the customer
and account management of a bank.
// A customer has an id and a name. They may also have an account associated via an id.
case class Customer(id: Int, name: String, accountId: Option[Int])
// A account is identified by it a id and holds the current balance.
case class Account(id: Int, balance: Float)
// These are the URLs to the API endpoints
val customerUrl = "/customer"
val accountUrl = "/accountUrl"
Create a customer with the provided name, adjust and return it if successful.
@param name The name of the new customer.
@return The newly created customer or None in case of failure.
def createCustomer(name: String): Request[Response[Option[Customer]]] = for {
r <- create(customerUrl, Customer(0, name, None))
u <- update[Customer](customerUrl, r.body, _.copy(id = r.body))
} yield u
* Create an account for the specified customer and return it if successful.
* @param customerId The id of the customer that wants to create an account.
* @return The newly created account or None in case of failure.
def createAccount(customerId: Int): Request[Response[Option[Account]]] = for {
r <- create(accountUrl, Account(0, 0))
u <- update[Account](accountUrl, r.body, _.copy(id = r.body))
_ <- update[Customer](customerUrl, customerId, _.copy(accountId = Some(r.body)))
} yield u
* Helper that allows us to return a 404 Response if something was not found.
def notFound[A]: Request[Response[Option[A]]] = Free.pure[RequestOp,Response[Option[A]]](Response(404, None))
* Allows the user to deposit a given amount into their account if it exists.
* @param customerId The id of the customer that wants to deposit.
* @param amount The amount to deposit.
* @return An updated account object or None in case of failure.
def deposit(customerId: Int, amount: Float): Request[Response[Option[Account]]] = for {
c <- read[Customer](customerUrl, customerId)
a <- => read[Account](accountUrl, accId)).getOrElse(notFound)).getOrElse(notFound)
h <- => update[Account](accountUrl,, x => x.copy(balance = x.balance + amount))).getOrElse(notFound)
} yield h
* A welcome offer for new customers. Creates the customer and gifts them 500 money.
* @param name The name of the new customer.
def welcomeOffer(name: String): Request[Unit] = for {
c <- createCustomer(name)
_ <- => createAccount(
_ <- => deposit(, 500)).getOrElse(notFound)
} yield ()
// Bring the Monad instance for Id into scope
import free.Id._
// Test the welcome offer locally
val api = collection.mutable.Map.empty[(String, Int), Any]
val interpreter: RequestOp ~> Id = localInterpreter(api)
val name = "Mr. Free"
val program: Request[Unit] = welcomeOffer(name)
// Check that the program actually worked
val customer: Option[Customer] = api.get((customerUrl, 1)).asInstanceOf[Option[Customer]]
println(s"Customer '$name' was created? ${customer.isDefined}")
println(s"Customer '$name' has an account associated? ${customer.flatMap(_.accountId).isDefined}")
val account: Option[Account] =
customer.flatMap(_.accountId).flatMap(id => api.get(accountUrl, id).asInstanceOf[Option[Account]])
println(s"Associated account actually exists? ${account.isDefined}")
println(s"Associated account has the correct balance? ${account.exists(_.balance == 500)}")
package free
import free.Free.{Bind, FlatMap, Pure}
import free.NaturalTransformation.~>
sealed trait Free[F[_], A] {
def pure(a: A): Free[F,A] = Free.pure(a)
def flatMap[B](f: A => Free[F,B]): Free[F,B] =
FlatMap(this, f)
// Map is necessary for for-comprehensions
def map[B](f: A => B): Free[F, B] = this.flatMap {
a => Free.pure(f(a))
def foldMap[G[_] : Monad](nt: F ~> G): G[A] = this match {
case Pure(a) => Monad[G].pure(a)
case Bind(fa) => nt(fa)
case FlatMap(fa, f) =>
val subExpr = fa.foldMap(nt)
object Free {
final case class Pure[F[_], A](a: A) extends Free[F,A]
final case class Bind[F[_], A](fa: F[A]) extends Free[F,A]
final case class FlatMap[F[_],A, B](fa: Free[F,A], f: A => Free[F,B]) extends Free[F,B]
def pure[F[_],A](a: A) : Free[F,A] = Pure(a)
def liftF[F[_],A](fa: F[A]): Free[F,A] = Bind(fa)
package free
object Id {
type Id[A] = A
implicit val idIsMonad: Monad[Id] = new Monad[Id] {
override def pure[A](a: A): Id[A] = a
override def flatMap[A, B](fa: Id[A])(f: A => Id[B]): Id[B] = f(fa)
package free
trait Monad[F[_]] {
def pure[A](a: A): F[A]
def flatMap[A,B](fa: F[A])(f: A => F[B]): F[B]
object Monad {
def apply[F[_]](implicit monad: Monad[F]): Monad[F] = monad
package free
trait NaturalTransformation[F[_],G[_]] {
def apply[A](fa: F[A]): G[A]
object NaturalTransformation {
type ~>[F[_],G[_]] = NaturalTransformation[F,G]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment