Free + Option による List 実装のうち、FreeをScalazから単純な実装に移したもの

FreeMonadList.scala

/**
 * "FreeモナドでListを表現する" の理解のため
 * 元のコードで使用されているScalazのFreeをシンプルな実装のFreeに置き換えたもの.
 *
 * 参照
 *   Freeモナド in Scala: http://yuroyoro.hatenablog.com/entry/2012/11/16/171834
 *   FreeモナドでListを表現する: http://d.hatena.ne.jp/xuwei/20131123/1385215528
 *   - scalaz 7.1版: https://gist.github.com/xuwei-k/31c2317a5b9035932399
 */
import scalaz._
import scala.language.higherKinds

object FreeMonadList extends App {
  /**
   * Freeモナド.
   * 理解を補うために、LiftFreeを別途用意
   */
  import scalaz.syntax.functor._

  abstract class Free[S[_] : Functor, A] {
    def flatMap[B](f: A => Free[S, B]): Free[S, B]
    def map[B](f: A => B): Free[S, B] = flatMap(x => Pure(f(x)))
  }

  case class Suspend[S[_] : Functor, A](x: S[Free[S, A]]) extends Free[S, A] {
    def flatMap[B](f: A => Free[S, B]): Free[S, B] =
      Suspend[S, B](x.map( _.flatMap(f) ))
  }

  case class LiftFree[S[_] : Functor, A](x: S[A]) extends Free[S, A] {
    def flatMap[B](f: A => Free[S, B]): Free[S, B] =
      Suspend[S, B](x.map(f))
  }

  case class Pure[S[_] : Functor, A](x: A) extends Free[S, A] {
    def flatMap[B](f: A => Free[S, B]): Free[S, B] =
      f(x)
  }

  /**
   * FreeへのLift用ヘルパ関数(返り値型をFreeで統一すると、型の記述が少し楽に)
   */
  def pure[S[_]: Functor, A](x: A): Free[S, A] = Pure[S, A](x)

  def liftF[S[_]: Functor, A](x: S[A]): Free[S, A] =  {
    // Suspend を使って実装するならば
    //   Suspend[S, A](Functor[S].map(x)(pure[S, A]))
    //
    // 今回はLiftFreeで考えたいので、SuspendによるLiftは行わないが
    // 以下のように map(identity) を付けると
    // LiftFreeのmapで最終的にpureが呼ばれるため、実質Suspendによる上のコードと同じになる
    //
    // 本当はmap(identity)をつけなくともFreeとして一通り動くが
    // 後々、インタプリタ内でパターンマッチするときLiftFreeのcaseを用意するのを避けるため
    // こうして map(identity)することで、LiftFree を Suspend に変えておく
    LiftFree(x).map(identity)
  }

  // Free用のモナドインスタンスはScalazのものを
  def freeMonad[S[_]:Functor]: Monad[({type f[x] = Free[S, x]})#f] = {
    new Monad[({type f[x] = Free[S, x]})#f] {
      def point[A](a: => A) = pure(a)
      override def map[A, B](fa: Free[S, A])(f: A => B) = fa map f
      def bind[A, B](a: Free[S, A])(f: A => Free[S, B]) = a flatMap f
    }
  }

  /**
   * Option と Freeによる List実装
   */

  type PairOpt[α] = Option[(α, α)]

  type List[A] = Free[PairOpt, A]

  implicit val pairOptFunctor: Functor[PairOpt] =
    new Functor[PairOpt] {
      def map[A, B](fa: PairOpt[A])(f: A => B) = fa match{
        case Some((_1, _2)) => Some((f(_1), f(_2)))
        case None => None
      }
    }

  def nil[A]: List[A] = liftF[PairOpt, A](None)

  def cons[A](head: A, tail: List[A]): List[A] = {
    freeMonad[PairOpt].join {
      liftF[PairOpt, List[A]](
        Option(pure[PairOpt, A](head) -> tail)
      )
    }
  }

  // Suspendへ直接Liftする古いやり方(Scalaz 7.1 のFree実装では出来ない)
  // def cons[A](head: A, tail: List[A]): List[A] = {
  //   Suspend[PairOpt, A](Option(pure[PairOpt, A](head) -> tail))
  // }

  def toScalaList[A](list: List[A]): scala.List[A] = list match {
    case Pure(a) => a :: Nil
    case Suspend(None) => Nil
    case Suspend(Some((x, y))) =>  toScalaList(x) ::: toScalaList(y)
  }

  val list = cons(1, cons(2, cons(3, nil[Int])))

  println(list)

  /*
    この list の内部状態は
    Suspend(Some((Pure(1),Suspend(Some((Pure(2),Suspend(Some((Pure(3),Suspend(None))))))))))
    となっている.
    headとして与えられるただのInt値はPureに包まれ、
    tailとして与えられるList[A]という名のTupleは、Suspendに包まれているのが分かる.
   */

  println(toScalaList(list))

  // おまけ
  //  {
  //    import std.AllInstances._
  //    val a: Free[Option, Int] = liftF[Option, Int](Option(100))
  //    val b: Free[Option, Int] = pure [Option, Int](100)
  //    val p: PairOpt[Free[Option, Int]] = Option(a, b)
  //  }

}