gistfile1.scala

/**
 * Free applicative functors
 */
sealed trait FreeA[F[_],A] {
  /**
   * The canonical monoidal natural transformation that interprets
   * this free program by giving it the semantics of the applicative functor `G`.
   */
  def foldMap[G[_]:Applicative](f: F ~> G): G[A] = this match {
    case Pure(x) => Applicative[G].pure(x)
    case Ap(x,y) => Applicative[G].apply(f(x), y foldMap f).map(a => f => f(a))
  }

  /**
   * Performs a monoidal analysis over this free program. Maps the
   * effects in `F` to values in the monoid `M`, discarding the values
   * of those effects.
   * Example:
   * 
   * {{{
   * def count[F[_],B](p: FreeA[F,B]): Int =
   *   p.analyze(new (F ~> ({ type λ[α] = Int })#λ) {
   *     def apply[A](a: F[A]) = 1
   *   })
   * }}}
   */
  def analyze[M:Monoid](f: F ~> ({ type λ[α] = M })#λ): M =
    foldMap(new (F ~> ({ type λ[α] = Const[M,α] })#λ) {
      def apply(a: F[A]): Const[M,A] = Const(f(a))
    }).value

  /**
   * The natural transformation from `FreeA[F,_]` to `FreeA[G,_]`
   */
  def hoist[G[_]](f: F ~> G): FreeA[G,A] = this match {
    case Pure(a) => Pure(a)
    case Ap(x,y) => Ap(f(x), y hoist f)
  }

  /**
   * Interprets this free `F` program using the semantics of the
   * `Applicative` instance for `F`.
   */
  def retract(implicit F: Applicative[F]): F[A] = this match {
    case Pure(a) => Applicative[F].pure(a)
    case Ap(x,y) => Applicative[F].apply(retract(y), f)
  }

  /**
   * Embeds this program in the free monad on `F`.
   */
  def monadic: Free[F,A] = foldMap(new (F ~> ({type λ[α] = Free[F,α]})) {
    def apply[B](fb: F[B]) = Suspend(fb)
  })
}
case class Pure[F[_],A](a: A) extends FreeA[F,A]
case class Ap[F[_],A,B](value: F[A], function: FreeA[F, A => B]) extends FreeA[F,A]

object FreeA {
  implicit val freeInstance[F[_]]: Applicative[({type λ[α] = FreeA[F,α]})#λ] =
    new Applicative[({type λ[α] = FreeA[F,α]})#λ] {
      def point[A](a: => A) = Pure(a)
      def apply[A,B](ff: FreeA[F, A => B], fa: FreeA[F,A]) = ff match {
        case Pure(f) => fa map f
        case Ap(x,y) => Ap(x, apply(y,fa).map(f => a => b => f(b)(a)))
      }
    }

  def lift[F[_],A](x: F[A]): FreeA[F, A] = Ap(x, Pure(a => a))
}