http://qiita.com/halcat0x15a/items/7fa75de932977b7aa7cc

freer.scala

import scala.language.higherKinds
import scala.language.existentials

sealed trait Freer[F[_], A] {
  def map[B](f: A => B): Freer[F, B] = flatMap(a => Pure(f(a)))
  def flatMap[B](f: A => Freer[F, B]): Freer[F, B] =
    this match {
      case Pure(a) => f(a)
      case Impure(fa, g) => Impure(fa, g :+ f)
    }
}

case class Pure[F[_], A](a: A) extends Freer[F, A]
case class Impure[F[_], A, B](fa: F[A], f: Queue[F, A, B]) extends Freer[F, B]

sealed trait Queue[F[_], A, B] {
  def :+[C](f: B => Freer[F, C]): Queue[F, A, C] = Node(this, Leaf(f))
  def ++[C](q: Queue[F, B, C]): Queue[F, A, C] = Node(this, q)
  def apply(a: A): Freer[F, B] = {
    @scala.annotation.tailrec
    def go(q_a: (Queue[F, T, B], T) forSome { type T }): Freer[F, B] =
      q_a match {
        case (q, a) =>
          q.view match {
            case One(f) => f(a)
            case Cons(f, q) =>
              f(a) match {
                case Pure(v) => go(q, v)
                case Impure(f, r) => Impure(f, r ++ q)
              }
          }
      }
    go(this, a)
  }
  def view: View[F, A, B] =
    this match {
      case Leaf(f) => One(f)
      case Node(l, r) =>
        @scala.annotation.tailrec
        def go(x_v: (Queue[F, A, T], Queue[F, T, B]) forSome { type T }): View[F, A, B] =
          x_v match {
            case (Leaf(f), y) => Cons(f, y)
            case (Node(l, r), y) => go(l -> Node(r, y))
          }
        go(l -> r)
    }
}
case class Leaf[F[_], A, B](f: A => Freer[F, B]) extends Queue[F, A, B]
case class Node[F[_], A, B, C](left: Queue[F, A, B], right: Queue[F, B, C]) extends Queue[F, A, C]

sealed trait View[F[_], A, B]
case class One[F[_], A, B](f: A => Freer[F, B]) extends View[F, A, B]
case class Cons[F[_], A, B, C](f: A => Freer[F, B], q: Queue[F, B, C]) extends View[F, A, C]