Last active
May 2, 2016 18:28
-
-
Save bqm/bee72c18fa4baa708f7cf2b146bbc872 to your computer and use it in GitHub Desktop.
Naive implementation of an hybrid free monad / free applicative
This file contains hidden or 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._ | |
import cats.free._ | |
import cats.arrow.NaturalTransformation | |
object ApFree { | |
/** | |
* Return from the computation with the given value. | |
*/ | |
private final case class Pure[S[_], A](a: A) extends ApFree[S, A] | |
/** Suspend the computation with the given suspension. */ | |
private final case class Suspend[S[_], A](a: S[A]) extends ApFree[S, A] | |
/** Call a subroutine and continue with the given function. */ | |
private final case class Gosub[S[_], B, C](c: ApFree[S, C], f: C => ApFree[S, B]) extends ApFree[S, B] | |
/** Join two ApFree instances */ | |
private final case class Ap[S[_], B, C](a: ApFree[S, B], b: ApFree[S, B => C]) extends ApFree[S, C] | |
def liftF[F[_], A](value: F[A]): ApFree[F, A] = Suspend(value) | |
/** Lift a pure value into Free */ | |
def pure[S[_], A](a: A): ApFree[S, A] = Pure(a) | |
} | |
import ApFree._ | |
sealed abstract class ApFree[S[_], A] extends Product with Serializable { | |
final def map[B](f: A => B): ApFree[S, B] = | |
flatMap(a => Pure(f(a))) | |
final def flatMap[B](f: A => ApFree[S, B]): ApFree[S, B] = | |
Gosub(this, f) | |
final def join[B](b: ApFree[S, B]): ApFree[S, (A, B)] = | |
Ap(this, b.map((b: B) => (a: A) => (a, b))) | |
final def fold[G[_]]( | |
f: NaturalTransformation[({type f[a] = S[ApFree[S, a]]})#f, G] | |
)(implicit S: Functor[S], G: Monad[G]): G[A] = this match { | |
case Pure(a) => G.pure(a) | |
case Suspend(t) => f(S.map(t)(Pure(_))) | |
case Ap(a, b) => { | |
val foldedLeft = a.fold(f) | |
val foldedRight = b.fold(f) | |
G.ap(foldedRight)(foldedLeft) | |
} | |
case Gosub(c, ff) => c match { | |
case Pure(a) => ff(a).fold(f) | |
case _ => | |
G.flatMap(c.fold(f)){ el => | |
val newEl = ff(el) | |
newEl.fold(f) | |
} | |
} | |
} | |
final def fold2[G[_]]( | |
f: NaturalTransformation[({type f[a] = S[ApFree[S, a]]})#f, ({type f[a] = G[ApFree[S, a]]})#f] | |
)(implicit S: Functor[S], G: Monad[G]): G[A] = { | |
def interpret[B](apf: ApFree[S, B]): G[B] = apf.fold( | |
new NaturalTransformation[({type f[a] = S[ApFree[S, a]]})#f, G] { | |
def apply[C](b: S[ApFree[S, C]]): G[C] = { | |
G.flatMap(f(b))(interpret) | |
} | |
}) | |
interpret(this) | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment