Skip to content

Instantly share code, notes, and snippets.

@Fristi
Last active September 5, 2018 14:23
Show Gist options
  • Save Fristi/d804aea0f1d80f8617fd285981affc14 to your computer and use it in GitHub Desktop.
Save Fristi/d804aea0f1d80f8617fd285981affc14 to your computer and use it in GitHub Desktop.
import scalaz._
import scalaz.Scalaz._
trait HFunctor[F[_[_], _]] {
def hfmap[M[_], N[_]](nt: M ~> N): F[M, ?] ~> F[N, ?]
}
object HFunctor {
def apply[F[_[_], _]](implicit v: HFunctor[F]) = v
final implicit class HFunctorOps[F[_[_], _], M[_], A](val fa: F[M, A])(implicit F: HFunctor[F]) {
def hfmap[N[_]](nt: M ~> N): F[N, A] = F.hfmap(nt)(fa)
}
type HAlgebra[F[_[_], _], G[_]] = F[G, ?] ~> G
}
final case class HFix[F[_[_], _], I](unfix: Name[F[HFix[F, ?], I]])
object HFix {
import HFunctor._
def hfix[F[_[_], _], I](fa: => F[HFix[F, ?], I]): HFix[F, I] =
HFix[F, I](Need(fa))
def cataNT[F[_[_], _] : HFunctor, G[_]](alg: HAlgebra[F, G]): HFix[F, ?] ~> G =
new (HFix[F, ?] ~> G) {
self =>
def apply[I](f: HFix[F, I]): G[I] = {
alg.apply[I](f.unfix.value.hfmap[G](self))
}
}
implicit class HFixOps[F[_[_], _], I](fa: HFix[F, I]) {
def cata[G[_]](alg: HAlgebra[F, G])(implicit F: HFunctor[F]): G[I] =
cataNT[F, G](alg)(F)(fa)
}
}
sealed trait ExprF[F[_], A]
object ExprF {
case class Const[F[_]](value: Int) extends ExprF[F, Int]
case class Add[F[_]](left: F[Int], right: F[Int]) extends ExprF[F, Int]
case class Multiply[F[_]](left: F[Int], right: F[Int]) extends ExprF[F, Int]
type Expr[I] = HFix[ExprF, I]
def const(value: Int): Expr[Int] =
HFix.hfix(Const[Expr](value))
def add(left: Expr[Int], right: Expr[Int]): Expr[Int] =
HFix.hfix(Add[Expr](left, right))
def multiply(left: Expr[Int], right: Expr[Int]): Expr[Int] =
HFix.hfix(Multiply[Expr](left, right))
implicit val hfunctor: HFunctor[ExprF] = new HFunctor[ExprF] {
override def hfmap[M[_], N[_]](nt: ~>[M, N]): ExprF[M, ?] ~> ExprF[N, ?] = new (ExprF[M, ?] ~> ExprF[N, ?]) {
override def apply[A](fa: ExprF[M, A]): ExprF[N, A] = fa match {
case Const(value) => Const(value)
case Add(left, right) => Add(nt(left), nt(right))
case Multiply(left, right) => Multiply(nt(left), nt(right))
}
}
}
def evaluator: HFunctor.HAlgebra[ExprF, Id.Id] = new HFunctor.HAlgebra[ExprF, Id.Id] {
override def apply[A](fa: ExprF[Id.Id, A]): Id.Id[A] = fa match {
case ExprF.Add(left, right) => (left |@| right)(_ + _)
case ExprF.Multiply(left, right) => (left |@| right)(_ * _)
case ExprF.Const(value) => value
}
}
case class K[X, Y](unK: X)
object K {
implicit def applicative[Y]: Applicative[K[?, Y]] = new Applicative[K[?, Y]] {
override def point[A](a: => A): K[A, Y] = K(a)
override def ap[A, B](fa: =>K[A, Y])(f: =>K[A => B, Y]): K[B, Y] = K(f.unK(fa.unK))
}
}
def printer: HFunctor.HAlgebra[ExprF, K[String, ?]] = new HFunctor.HAlgebra[ExprF, K[String, ?]] {
override def apply[A](fa: ExprF[K[String, ?], A]): K[String, A] = fa match {
case ExprF.Add(left, right) => (left |@| right)(_ + "+" + _)
case ExprF.Multiply(left, right) => (left |@| right)(_ + "*" + _)
case ExprF.Const(value) => K(value.toString)
}
}
}
object Program extends App {
import ExprF._
import HFix._
val prg = multiply(add(const(1), const(2)), const(3))
println(prg.cata(evaluator))
println(prg.cata(printer).unK)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment