Last active
May 6, 2019 21:48
-
-
Save dmgcodevil/ddc3d3fa13f70d15db9f13cf383bfc04 to your computer and use it in GitHub Desktop.
modular function eval that interprets expressions that are constructed using the a la carte ` technique
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import cats.implicits._ | |
import cats.{Functor, MonadError} | |
// links: | |
// [1] http://www.cs.nott.ac.uk/~pszgmh/alacarte.pdf | |
// [2] http://www.cs.ru.nl/~W.Swierstra/Publications/DataTypesALaCarte.pdf | |
object LaCarte { | |
type ErrorOr[A] = Either[String, A] | |
case class Coproduct[F[_], G[_], A](run: Either[F[A], G[A]]) | |
sealed trait Arith[A] | |
case class Val[A](x: Int) extends Arith[A] | |
case class Add[A](a: A, b: A) extends Arith[A] | |
sealed trait Except[A] | |
case class Throw[A](error: String) extends Except[A] | |
case class Catch[A](e: A, h: A) extends Except[A] | |
trait Fix[F[_]] | |
case class In[F[_]](exp: F[Fix[F]]) extends Fix[F] | |
type ArithOrExcept[A] = Coproduct[Arith, Except, A] | |
implicit object ArithFunctor extends Functor[Arith] { | |
override def map[A, B](fa: Arith[A])(f: A => B): Arith[B] = { | |
fa match { | |
case Val(x) => Val(x) | |
case Add(a, b) => Add(f(a), f(b)) | |
} | |
} | |
} | |
implicit object ExceptFunctor extends Functor[Except] { | |
override def map[A, B](fa: Except[A])(f: A => B): Except[B] = { | |
fa match { | |
case Throw(e) => Throw(e) | |
case Catch(e, h) => Catch(f(e), f(h)) | |
} | |
} | |
} | |
implicit def coproductFunctor[F[_] : Functor, G[_] : Functor]: Functor[Coproduct[F, G, ?]] = new Functor[Coproduct[F, G, ?]] { | |
override def map[A, B](fa: Coproduct[F, G, A])(f: A => B): Coproduct[F, G, B] = { | |
fa match { | |
case Coproduct(Left(value)) => Coproduct(Either.left(implicitly[Functor[F]].map(value)(f))) | |
case Coproduct(Right(value)) => Coproduct(Either.right(implicitly[Functor[G]].map(value)(f))) | |
} | |
} | |
} | |
trait Eval[F[_]] { | |
def evAlg(f: F[ErrorOr[Int]])(implicit functor: Functor[F]): ErrorOr[Int] | |
} | |
implicit object ArithEval extends Eval[Arith] { | |
override def evAlg(f: Arith[ErrorOr[Int]])(implicit functor: Functor[Arith]): ErrorOr[Int] = { | |
f match { | |
case Val(x) => MonadError[ErrorOr, String].pure(x) | |
case Add(a, b) => for { | |
a1 <- a | |
b1 <- b | |
} yield a1 + b1 | |
} | |
} | |
} | |
implicit object ExceptEval extends Eval[Except] { | |
override def evAlg(f: Except[ErrorOr[Int]])(implicit functor: Functor[Except]): ErrorOr[Int] = { | |
f match { | |
case Throw(error) => MonadError[ErrorOr, String].raiseError(error) | |
case Catch(x, h) => x >> h | |
} | |
} | |
} | |
implicit def coproductEval[G[_] : Eval : Functor, F[_] : Eval : Functor]: Eval[Coproduct[F, G, ?]] = new Eval[Coproduct[F, G, ?]] { | |
override def evAlg(f: Coproduct[F, G, ErrorOr[Int]]) | |
(implicit functor: Functor[Coproduct[F, G, ?]]): ErrorOr[Int] = { | |
val functorF = implicitly[Eval[F]] | |
val functorG = implicitly[Eval[G]] | |
f match { | |
case Coproduct(Left(x)) => functorF.evAlg(x) | |
case Coproduct(Right(y)) => functorG.evAlg(y) | |
} | |
} | |
} | |
def fold[F[_] : Functor, A](f: F[A] => A): Fix[F] => A = { | |
case In(t) => | |
val g: F[Fix[F]] => F[A] = implicitly[Functor[F]].lift(fold(f)) | |
f(g(t)) | |
} | |
def eval[F[_] : Eval : Functor](f: Fix[F]): ErrorOr[Int] = fold(implicitly[Eval[F]].evAlg).apply(f) | |
def main(args: Array[String]): Unit = { | |
// val 1 ‘add‘ val 2 | |
val three: Fix[Arith] = In(Add(In(Val(1)), In(Val(2)))) | |
println(eval(three)) // Right(3) | |
// val 42 ‘add‘ throw | |
var error: Fix[ArithOrExcept] = In(Coproduct(Either.left(Add(In(Coproduct(Either.left(Val(42)))), In(Coproduct(Either.right(Throw("unexpected error")))))))) | |
println(eval(error)) // Left(unexpected error) | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment