recursiveScheme.scala

package recursion.scheme
import scalaz.Functor
//http://blog.sumtypeofway.com/recursion-schemes-part-iii-folds-in-context/
object Part1 {
  sealed trait Expr[A]
  case class Ident[A](name: String) extends Expr[A]
  case class Index[A](target: A, idx: A) extends Expr[A]
  case class Call[A](func: A, args: List[A]) extends Expr[A]
  case class Unary[A](op: String, target: A) extends Expr[A]
  case class Binary[A](lhs: A, op: String, rhs: A) extends Expr[A]
  case class Paren[A](target: A) extends Expr[A]
  case class Literal[A](intVal: Int) extends Expr[A]

  implicit def exprFunctor = new Functor[Expr] {
    def map[A, B](fa: Expr[A])(f: A => B): Expr[B] = fa match {
      case Index(fst, snd) => Index(f(fst), f(snd))
      case Call(a, as) => Call(f(a), as.map(f))
      case Unary(s, a) => Unary(s, f(a))
      case Binary(a, s, b) => Binary(f(a), s, f(b))
      case Paren(a) => Paren(f(a))
      case Literal(a) => Literal(a).asInstanceOf[Expr[B]]
      case Ident(a) => Ident(a).asInstanceOf[Expr[B]]
    }
  }

  case class Fix[F[_]](out: F[Fix[F]])

  def bottomUp[F[_]](fn: Fix[F] => Fix[F])(a: Fix[F])(implicit F: Functor[F]): Fix[F] =
    fn(Fix(F.map(a.out) { x => bottomUp(fn)(x) }))

  def topDown[F[_]](fn: Fix[F] => Fix[F])(a: Fix[F])(implicit F: Functor[F]): Fix[F] =
    Fix(F.map(fn(a).out) { x => topDown(fn)(x) })

  def flattenFix(a: Fix[Expr]): Fix[Expr] = a match {
    case Fix(Paren(o)) => o
    case _ => a
  }
  val flatten = bottomUp(flattenFix)(_)
}
object Part2 {
  import Part1._
  type Algebra[F[_], A] = F[A] => A
  def cata[F[_], A](alg: Algebra[F, A], fix: Fix[F])(implicit F: Functor[F]): A =
    alg(F.map(fix.out)(cata(alg, _)))
  type CoAlgebra[F[_], A] = A => F[A]
  def ana[F[_], A](coalg: CoAlgebra[F, A], a: A)(implicit F: Functor[F]): Fix[F] =
    Fix(F.map(coalg(a)) { ana(coalg, _) })

  def bottomUp2[F[_]](fn: Fix[F] => Fix[F])(a: Fix[F])(implicit F: Functor[F]): Fix[F] =
    cata((x: F[Fix[F]]) => fn(Fix(x)), a)
}

object Part3 {
  import Part1._
  type RAlgebra[F[_], A] = F[(Fix[F], A)] => A
  def para[F[_], A](r: RAlgebra[F, A], fix: Fix[F])(implicit F: Functor[F]): A = {
    def fanout(f: Fix[F]): (Fix[F], A) = (f, para(r, f))
    r(F.map(fix.out)(fanout))
  }
  type RCoAlgebra[F[_], A] = A => F[Either[Fix[F], A]]
  def apo[F[_], A](rc: RCoAlgebra[F, A], a: A)(implicit F: Functor[F]): Fix[F] = {
    def fanin(in: Either[Fix[F], A]): Fix[F] = in match {
      case Left(l) => l
      case Right(r) => apo(rc, r)
    }
    Fix(F.map(rc(a)) { x => fanin(x) })
  }
}