Example usage of the Cats Free Monad data type

FreeMonadExample.scala

package effects

import cats._
import cats.data._
import cats.free.Free
import cats.implicits._

// Example usage of the Cats Free Monad data type
// A free monad lets you build a Monad from any Functor

// Here we will build a DSL for a key value store
// The DSL is separate from the DSL compiler/interpreter, which can have multiple implementations

object FreeMonadExample extends App {

  sealed trait KVStoreInstructions[A]
  case class Put[T](key: String, value: T) extends KVStoreInstructions[Unit]
  case class Get[T](key: String) extends KVStoreInstructions[Option[T]]
  case class Delete(key: String) extends KVStoreInstructions[Unit]

  type KVFree[A] = Free[KVStoreInstructions, A]

  // operations, lifting above KVStoreInstructions[_] values into KVFree[_]
  // mechanical

  def put[T](key: String, value: T): KVFree[Unit] =
    Free.liftF[KVStoreInstructions, Unit](Put(key, value))

  def get[T](key: String): KVFree[Option[T]] =
    Free.liftF[KVStoreInstructions, Option[T]](Get(key))

  def delete(key: String): KVFree[Unit] =
    Free.liftF(Delete(key))

  // here we compose an update operation from the above

  def update[T](key: String, f: T => T): KVFree[Option[T]] =
    for {
      option <- get[T](key)
      _ <- option.map(t => put[T](key, f(t))).getOrElse(Free.pure(()))
      newOption <- get[T](key)
    } yield newOption

  // this is a collection of instructions, that will get run against a compiler implementation
  def setup(start: Int): KVFree[Option[Int]] =
    for {
      _ <- put("cats", start)
      n <- update[Int]("cats", (_ + 10))
      _ <- put("dogs", 5)
      _ <- delete("dogs")
      _ <- put("mice", 7)
    } yield n

  def add13: KVFree[Option[Int]] =
    for {
      n <- update[Int]("cats", (_ + 13))
    } yield n

  import scala.collection.mutable

  // this compiler will crash if a key is not found,
  // or if a type is incorrectly specified.

  def impureCompiler: KVStoreInstructions ~> Id = new (KVStoreInstructions ~> Id) {

    // a very simple (and imprecise) key-value store
    val kvs = mutable.Map.empty[String, Any]

    def apply[A](fa: KVStoreInstructions[A]): Id[A] =
      fa match {
        case Put(key, value) =>
          println(s"put($key, $value)")
          kvs(key) = value
          ()
        case Get(key) =>
          println(s"get($key)")
          kvs.get(key).map(_.asInstanceOf[A])
        case Delete(key) =>
          println(s"delete($key)")
          kvs.remove(key)
          ()
      }
  }

  val result: Option[Int] = setup(20).foldMap(impureCompiler)

  println(result)

  // a pure compiler using State, no mutation
  // For an example usage of State https://gist.github.com/fancellu/082ee9614046081aa06a250960eab9ff

  type KVStoreState[A] = State[Map[String, Any], A]

  val pureCompiler: KVStoreInstructions ~> KVStoreState = new (KVStoreInstructions ~> KVStoreState) {
    def apply[A](fa: KVStoreInstructions[A]): KVStoreState[A] =
      fa match {
        case Put(key, value) => State.modify(_.updated(key, value))
        case Get(key) =>
          State.inspect(_.get(key).map(_.asInstanceOf[A]))
        case Delete(key) => State.modify(_ - key)
      }
  }

  // see how we compose existing Free

  val letsDoSomecomposing1 =for {
    _<-setup(2)
    p2<-add13
  } yield p2

  val result2 = letsDoSomecomposing1.foldMap(pureCompiler).run(Map.empty).value
  println(result2)
  // (2+10)+(13)==25

  val letsDoSomecomposing2 =for {
    p1<-setup(2)
    _ <- put("inflight_cats", p1)
    p2<-add13
  } yield p1 |+| p2

  val result3 = letsDoSomecomposing2.foldMap(pureCompiler).run(Map("ignoreme"->99)).value
  println(result3)
  // (2+10)+(12+13)==37
}

output.txt

put(cats, 20)
get(cats)
put(cats, 30)
get(cats)
put(dogs, 5)
delete(dogs)
put(mice, 7)
Some(30)
(Map(cats -> 25, mice -> 7),Some(25))
(Map(ignoreme -> 99, cats -> 25, mice -> 7, inflight_cats -> Some(12)),Some(37))