Free Kvs

.gitignore

.*swp
.*un~

kvs.scala

package gist

import scalaz.{Free, Functor}
import scalaz.Free.{Gosub, Return, Suspend}

// See: https://gist.github.com/2424662

sealed trait Kvs[K, V, +A]
private case class Get[K, V, +A](key: K, h: V => A) extends Kvs[K, V, A]
private case class Put[K, V, +A](key: K, value: V, a: A) extends Kvs[K, V, A]
private case class Has[K, V, +A](key: K, h: Boolean => A) extends Kvs[K, V, A]

trait KvsInstances {
  implicit def kvsFunctor[K, V]: Functor[({type l[+a] = Kvs[K, V, a]})#l] =
    new Functor[({type l[+a] = Kvs[K, V, a]})#l] {
      def map[A, B](a: Kvs[K, V, A])(f: A => B): Kvs[K, V, B] = a match {
        case Get(k, h) => Get(k, x => f(h(x)))
        case Put(k, v, a) => Put(k, v, f(a))
        case Has(k, h) => Has(k, x => f(h(x)))
      }
    }
}

trait KvsFunctions {
  def get[K, V](k: K): Free[({type l[+a] = Kvs[K, V, a]})#l, V] =
    Suspend[({type l[+a] = Kvs[K, V, a]})#l, V](Get(k, v => Return[({type l[+a] = Kvs[K, V, a]})#l, V](v)))

  def put[K, V](k: K, v: V): Free[({type l[+a] = Kvs[K, V, a]})#l, Unit] =
    Suspend[({type l[+a] = Kvs[K, V, a]})#l, Unit](Put(k, v, Return[({type l[+a] = Kvs[K, V, a]})#l, Unit](())))

  def has[K, V](k: K): Free[({type l[+a] = Kvs[K, V, a]})#l, Boolean] =
    Suspend[({type l[+a] = Kvs[K, V, a]})#l, Boolean](Has(k, v => Return[({type l[+a] = Kvs[K, V, a]})#l, Boolean](v)))

  def modify[K, V](k: K, f: V => V): Free[({type l[+a] = Kvs[K, V, a]})#l, Unit] =
    for {
      v <- get(k)
      _ <- put(k, f(v))
    } yield ()
}

trait KvsInterpreters {
  def run[K, V, A](p: Free[({type l[+a] = Kvs[K, V, a]})#l, A], table: Map[K, V]): Map[K, V] =
    p.resume.fold({
      case Get(k, h) =>
        run(h(table(k)), table)
      case Put(k, v, a) =>
        run(a, table + (k -> v))
      case Has(k, h) =>
        run(h(table.contains(k)), table)
    }, r => table)

  import scalaz.\/
  import scalaz.syntax.std.option._
  type Error = String
  def run2[K, V, A](p: Free[({type l[+a] = Kvs[K, V, a]})#l, A], table: Map[K, V]): Error \/ Map[K, V] =
    p.resume.fold({
      case Get(k, h) =>
        table.get(k).\/>("Error!").flatMap(v => run2(h(v), table))
      case Put(k, v, a) =>
        run2(a, table + (k -> v))
      case Has(k, h) =>
        run2(h(table.contains(k)), table)
    }, r => \/.right(table))
}

object Kvs extends KvsInstances with KvsFunctions with KvsInterpreters

import scalaz.{Cofree, Zap}

sealed trait KvsDual[K, V, +A]
private case class GetDual[K, V, +A](a: A, h: K => V) extends KvsDual[K, V, A]
private case class PutDual[K, V, +A](h: (K, V) => A) extends KvsDual[K, V, A]
private case class HasDual[K, V, +A](a: A, h: K => Boolean) extends KvsDual[K, V, A]

trait KvsDualInstances {
  implicit def kvsDualFunctor[K, V]: Functor[({type l[+a] = KvsDual[K, V, a]})#l] =
    new Functor[({type l[+a] = KvsDual[K, V, a]})#l] {
      def map[A, B](a: KvsDual[K, V, A])(f: A => B): KvsDual[K, V, B] = a match {
        case GetDual(a, h) => GetDual(f(a), h)
        case PutDual(h) => PutDual((k, v) => f(h(k, v)))
        case HasDual(a, h) => HasDual(f(a), h)
      }
    }

  implicit def zapKvsDual[K, V]: Zap[({type l[+a] = Kvs[K, V, a]})#l, ({type l[+a] = KvsDual[K, V, a]})#l] =
    new Zap[({type l[+a] = Kvs[K, V, a]})#l, ({type l[+a] = KvsDual[K, V, a]})#l] {
      def zapWith[A, B, C](fa: Kvs[K, V, A], gb: KvsDual[K, V, B])(f: (A, B) => C) =
        (fa, gb) match {
          case (Get(k, h), GetDual(b, i)) => f(h(i(k)), b)
          case (Put(k, v, a), PutDual(i)) => f(a, i(k, v))
          case (Has(k, h), HasDual(b, i)) => f(h(i(k)), b)
          case _ => sys.error("todo!")
        }
    }
}

trait KvsDualInterpreters {
  def run[K, V](table: Map[K, V]) =
    Cofree.unfoldC[({type l[+a] = KvsDual[K, V, a]})#l, Unit](()) { _ =>
      GetDual((), k => table(k))
    }
}

object KvsDual extends KvsDualInstances with KvsDualInterpreters

object TryIt {
  import Kvs._
  import KvsDual._
  def go() = {
    val a =
      for {
        v <- get[String, String]("a")
      } yield v

    a.zapWith[({type l[+a] = KvsDual[String, String, a]})#l, Unit, Unit](KvsDual.run(Map("a" -> "b")))((a, _) => a)
  }
}

Note sure yet how to write the Kvs dual, the above is not correct.