(Coyoneda編) 型引数の基本から学ぶ、FreeモナドとCoyoneda http://awekuit.hatenablog.com/entry/2015/01/30/172010

FreeMonad_blog_2.scala

import scala.language.higherKinds
import scala.language.implicitConversions
import scala.language.reflectiveCalls
 
trait Functor[F[_]] {
  def map[A, B](m: F[A])(f: A => B): F[B]
}
 
implicit def functorOps[F[_] : Functor, A](self: F[A]) = new {
  def map[B](f: A => B): F[B] = implicitly[Functor[F]].map(self)(f)
}
 
abstract class LazyMap[F[_], A] { coyo =>
  type I
  val fi: F[I]
  val k: I => A
 
  import LazyMap.apply
 
  def map[B](f: A => B): LazyMap[F, B] = apply[F,I,B](fi)(f compose k)
  def run(implicit F: Functor[F]): F[A] = F.map(fi)(k)
}
 
object LazyMap {
  def apply[F[_], A, B](fa: F[A])(_k: A => B): LazyMap[F, B] =
    new LazyMap[F, B]{
      type I = A
      val k = _k
      val fi = fa
    }
  def liftLazyMap[F[_], A](x: F[A]) = apply[F,A,A](x)(identity[A])
 
  implicit def lazymapFunctor[F[_]] : Functor[({type LM[X] = LazyMap[F, X]})#LM] = {
    type LM[X] = LazyMap[F, X]
    new Functor[LM] {
      def map[A, B](fa: LazyMap[F, A])(f: A => B): LazyMap[F, B] = fa.map(f)
    }
  }
}
 
abstract class HKFold[F[_] : Functor, A] {
  def point[B]  (x: B): HKFold[F, B] =
    F0[F,B](x)
  def map[B]    (f: A => B): HKFold[F, B] =
    flatMap(x => point(f(x)))
  def flatMap[B](f: A => HKFold[F, B]): HKFold[F, B]
}
 
case class F0[F[_] : Functor, A](x: A) extends HKFold[F, A] {
  def flatMap[B](f: A => HKFold[F, B]): HKFold[F, B] =
    f(x)
}
 
case class F1[F[_] : Functor, A](x: F[A]) extends HKFold[F, A] {
  def flatMap[B](f: A => HKFold[F, B]): HKFold[F, B] = {
    val y = x.map(f)
    F3[F,B](y)
  }
}
 
case class F3[F[_] : Functor, A](x: F[HKFold[F, A]]) extends HKFold[F, A] {
  def flatMap[B](f: A => HKFold[F, B]): HKFold[F, B] = {
    val res = x.map{y =>
      y.flatMap(z => f(z))
    }
    F3(res)
  }
}
 
import LazyMap._
 
case class MyBox[A](x: A)
 
// 型推論を補うため.
type LMMyBox[X] = LazyMap[MyBox, X]
 
// 型の記述を省力化するための関数(LMMyBox[A]として返す)
def lazyMyBox[A](x: MyBox[A]): LMMyBox[A] = liftLazyMap(x)
 
val res = for {
  a <- F1(lazyMyBox(MyBox(3)))
  b <- F1(lazyMyBox(MyBox("5")))
  c <- F1(liftLazyMap(MyBox(10)) : LMMyBox[Int]) // もしlazyMyBox関数を使わないならこのように型注釈が必要
} yield (a * b.toInt + c).toString + "です！"
 
implicit val myboxFunctor = new Functor[MyBox] {
  def map[A,B](fa: MyBox[A])(f: A => B): MyBox[B] = MyBox(f(fa.x))
}
 
def interpreter[A](program: HKFold[LMMyBox, A]): A = program match {
  case F0(a) => a
  case F3(a) => a.run match {
    case MyBox(b) => interpreter(b)
  }
}
 
interpreter(res)