Skip to content

Instantly share code, notes, and snippets.

@tonymorris
Last active December 10, 2015 23:09
Show Gist options
  • Save tonymorris/4507698 to your computer and use it in GitHub Desktop.
Save tonymorris/4507698 to your computer and use it in GitHub Desktop.
sealed trait KeyValueStore[+A] {
def map[B](f: A => B): KeyValueStore[B] =
this match {
case Put(k, v, q) => Put(k, v, f compose q)
case Get(k, q) => Get(k, f compose q)
case Del(k, q) => Del(k, f compose q)
}
}
case class Put[A](k: String, v: String, q: Option[String] => A) extends KeyValueStore[A]
case class Get[A](k: String, q: Option[String] => A) extends KeyValueStore[A]
case class Del[A](k: String, q: Option[String] => A) extends KeyValueStore[A]
object KeyValueStore {
implicit val KeyValueStoreFunctor: Functor[KeyValueStore] =
new Functor[KeyValueStore] {
def fmap[A, B](f: A => B) =
_ map f
}
}
trait Functor[F[+_]] {
def fmap[A, B](f: A => B): F[A] => F[B]
}
trait ~>[F[_], G[_]] {
def apply[A](a: F[A]): G[A]
}
case class Cont[F[+_], +A](x: F[Free[F, A]]) extends Resume[F, A]
case class Term[F[+_], +A](x: A) extends Resume[F, A]
sealed trait Resume[F[+_], +A] {
def map[B](f: A => B)(implicit F: Functor[F]): Resume[F, B] =
this match {
case Cont(x) =>
Cont(F.fmap((_: Free[F, A]) map f)(x))
case Term(a) =>
Term(f(a))
}
def free: Free[F, A] =
this match {
case Cont(x) =>
More(x)
case Term(a) =>
Done(a)
}
def term: Option[A] =
this match {
case Cont(_) =>
None
case Term(a) =>
Some(a)
}
def termOr[AA >: A](a: => AA): AA =
term getOrElse a
def cont: Option[F[Free[F, A]]] =
this match {
case Cont(x) =>
Some(x)
case Term(a) =>
None
}
def contOr[AA >: A](x: => F[Free[F, AA]]): F[Free[F, AA]] =
cont getOrElse x
}
private case class Done[F[+_], +A](a: A) extends Free[F, A]
private case class More[F[+_], +A](a: F[Free[F, A]]) extends Free[F, A]
// a.k.a. codensity hack. Scala does not have proper TCO.
private case class Bind[F[+_], A, +B](x: () => Free[F, A], f: A => Free[F, B]) extends Free[F, B]
sealed trait Free[F[+_], +A] {
def map[X](f: A => X)(implicit F: Functor[F]): Free[F, X] =
flatMap(a => Done(f(a)))
def flatMap[X](f: A => Free[F, X])(implicit F: Functor[F]): Free[F, X] =
this match {
case Bind(x, g) =>
Bind(x, (x: Any) => Bind(() => g(x), f))
case _ =>
Bind(() => this, f)
}
/*
// flatMap proper: no codensity hack
this match {
case Done(a) => f(a)
case More(k) => More(F.fmap((_: Free[F, A]) flatMap f)(k))
}
*/
@annotation.tailrec
final def resume(implicit F: Functor[F]): Resume[F, A] =
this match {
case Done(a) =>
Term(a)
case More(a) =>
Cont(a)
case Bind(x, f) =>
x() match {
case Done(a) =>
f(a).resume
case More(a) =>
Cont(F.fmap((_: Free[F, Any]) flatMap f)(a))
case Bind(y, g) =>
y().flatMap((x: Any) => g(x) flatMap f).resume
}
}
def maps[G[+_]](f: F ~> G)(implicit F: Functor[F], G: Functor[G]): Free[G, A] =
resume match {
case Cont(x) =>
More(f(F.fmap((_: Free[F, A]) maps f)(x)))
case Term(a) =>
Done(a)
}
def mapf(f: F ~> F)(implicit F: Functor[F]): Free[F, A] =
resume match {
case Cont(x) =>
More(f(x))
case Term(a) =>
Done(a)
}
final def go[AA >: A](f: F[Free[F, AA]] => Free[F, AA])(implicit F: Functor[F]): AA = {
@annotation.tailrec def go2(t: Free[F, AA]): AA = t.resume match {
case Cont(x) => go2(f(x))
case Term(a) => a
}
go2(this)
}
}
case class FreeKeyValueStore[+A](free: Free[KeyValueStore, A]) {
def map[X](f: A => X): FreeKeyValueStore[X] =
FreeKeyValueStore(free map f)
def flatMap[X](f: A => FreeKeyValueStore[X]): FreeKeyValueStore[X] =
FreeKeyValueStore(free flatMap (f(_).free))
final def resume: Resume[KeyValueStore, A] =
free.resume
// CAUTION
// Unsafe operation. Run once only.
@annotation.tailrec
final def runJHashMap(m: java.util.HashMap[String, String]): A =
resume match {
case Cont(Put(k, v, q)) =>
FreeKeyValueStore(q(Option(m put (k, v)))) runJHashMap m
case Cont(Get(k, q)) =>
FreeKeyValueStore(q(Option(m get k))) runJHashMap m
case Cont(Del(k, q)) =>
FreeKeyValueStore(q(Option(m remove k))) runJHashMap m
case Term(a) =>
a
}
}
object FreeKeyValueStore {
def put(k: String, v: String): FreeKeyValueStore[Option[String]] =
FreeKeyValueStore(More(Put(k, v, Done(_))))
def get(k: String): FreeKeyValueStore[Option[String]] =
FreeKeyValueStore(More(Get(k, Done(_))))
def del(k: String): FreeKeyValueStore[Option[String]] =
FreeKeyValueStore(More(Del(k, Done(_))))
}
object Main {
def main(args: Array[String]) {
val conf = new java.util.HashMap[String, String]
conf put ("ak", "av")
conf put ("bk", "bv")
conf put ("ck", "cv")
import FreeKeyValueStore._
val a0 = get("ak")
val a1 = get("akX")
val a2 = del("akX")
val a3 = put("akX", "avX")
val a4 = get("ak")
val a5 = get("akX")
val a6 = del("akX")
val a7 = get("akX")
val a8 = get("ak")
val a9 = put("ak", "AV")
val q: FreeKeyValueStore[List[Option[String]]] =
for {
e0 <- a0
e1 <- a1
e2 <- a2
e3 <- a3
e4 <- a4
e5 <- a5
e6 <- a6
e7 <- a7
e8 <- a8
e9 <- a9
} yield List(e0, e1, e2, e3, e4, e5, e6, e7, e8, e9)
val r = q runJHashMap conf
r.zipWithIndex foreach {
case (i, j) => println(j + ": " + i)
}
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment