More than 1 year has passed since last update.

Scalaで書くFreer Monads, More Extensible Effects

http://okmij.org/ftp/Haskell/extensible/more.pdf

Scala Advent Calendar 2015の24日目の記事です。

ここではCoyonedaとCoproductを組み込み、合成を高速化したFreeモナドを紹介します。

Freer

Freerモナドからみていきましょう。

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, (a: Any) => g(a).flatMap(f))
    }

}

case class Pure[F[_], A](a: A) extends Freer[F, A]

case class Impure[F[_], A, B](fa: F[A], f: A => Freer[F, B]) extends Freer[F, B]

FreerはFreeと違い、Functorの制約なしにモナドになります。

Freerを使ってWriterモナドを作りましょう。

case class Writer[A](value: String)

object Writer {

  def run[A](freer: Freer[Writer, A]): (A, List[String]) =
    freer match {
      case Pure(a) => (a, Nil)
      case Impure(Writer(v), f) =>
        run(f(())) match {
          case (a, l) => (a, v :: l)
        }
    }

  def tell(value: String): Freer[Writer, Unit] =
    Impure(Writer(value), (_: Any) => Pure(()))

}

これは次のように実行できます。

object Example extends App {

  val app = for {
    _ <- Writer.tell("foo")
    _ <- Writer.tell("bar")
  } yield ()

  assert(Writer.run(app) == ((), List("foo", "bar")))

}

しかし、このflatMapの実装には少し問題があります。

Impure(Hoge(), a => Impure(Hoge(), b => Pure(b))).flatMap(f)
Impure(Hoge(), a => Impure(Hoge(), b => Pure(b)).flatMap(f))
Impure(Hoge(), a => Impure(Hoge(), b => Pure(b).flatMap(f)))
Impure(Hoge(), a => Impure(Hoge(), b => f(b)))

Impureの構造がネストするほどflatMapの効率が悪くなります。

Efficient Freer

flatMapを高速化するためにデータ構造を追加します。

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)

}

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]

Queueは単なる二分木で、要素の追加と連結は定数時間で実行されます。

Queue[F, A, B]からA => Freer[F, B]を得るためにViewという構造を追加します。

sealed trait Queue[F[_], A, B] {

  def apply(a: A): Freer[F, B] = {
    @scala.annotation.tailrec
    def go(q: Queue[F, Any, B], a: Any): Freer[F, B] =
      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.asInstanceOf[Queue[F, Any, B]], a)
  }

  def view: View[F, A, B] =
    this match {
      case Leaf(f) => One(f)
      case Node(l, r) =>
        @scala.annotation.tailrec
        def go(x: Queue[F, A, Any], y: Queue[F, Any, B]): View[F, A, B] =
          x match {
            case Leaf(f) => Cons(f, y)
            case Node(l, r) => go(l, Node(r, y))
          }
        go(l, r)
    }

}

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]

Queueへの値の適用は定スペースで実行されます。

Extensible Freer

Freerを拡張可能にします。

まず、直和型を定義します。

sealed trait Union

sealed trait Void extends Union

sealed trait :+:[F[_], U <: Union] extends Union

case class Inl[F[_], A, U <: Union](fa: F[A]) extends (F :+: U)

case class Inr[F[_], U <: Union](u: U) extends (F :+: U)

VoidはUnionの終端を表現します。

FreerをUnionで書き換えると次のようになります。

sealed trait Freer[U <: Union, A] {

  def map[B](f: A => B): Freer[U, B] = flatMap(a => Pure(f(a)))

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

}

case class Pure[U <: Union, A](a: A) extends Freer[U, A]

case class Impure[U <: Union, A, B](u: U, f: Queue[U, A, B]) extends Freer[U, B]

object Freer {

  def run[A](freer: Freer[Void, A]): A =
    freer match {
      case Pure(a) => a
    }

}

Freer[Void, A]はImpureを値に持たないためFreer#runは安全に実行されます。

QueueやViewにも同じような変更を加えます。

しかし、このUnionは冗長な記述を必要とします。

val hoge: Reader :+: Writer :+: Void = Inr(Inl(Writer("hoge")))

そこで、Unionへ値を埋め込むための型クラスを定義します。

trait Member[F[_], U <: Union] {

  def inject[A](f: F[A]): U

}

object Member {

  implicit def left[F[_], U <: Union]: Member[F, F :+: U] =
    new Member[F, F :+: U] {
      def inject[A](f: F[A]): F :+: U = Inl(f)
    }

  implicit def right[F[_], G[_], U <: Union](implicit member: Member[F, U]): Member[F, G :+: U] =
    new Member[F, G :+: U] {
      def inject[A](f: F[A]): G :+: U = Inr(member.inject(f))
    }

}

これらを使って、Writerモナドは次のように定義されます。

case class Writer[A](value: String)

object Writer {

  def run[U <: Union, A](freer: Freer[Writer :+: U, A]): Freer[U, (A, List[String])] =
    freer match {
      case Pure(a) => Pure((a, Nil))
      case Impure(u, f) =>
        def k(x: Any): Freer[U, (A, List[String])] = run(f(x))
        u match {
          case Inl(Writer(v)) => k(()).map { case (a, l) => (a, v :: l) }
          case Inr(u) => Impure(u, Leaf(k))
        }
    }

  def tell[U <: Union](value: String)(implicit member: Member[Writer, U]): Freer[U, Unit] =
    Impure(member.inject(Writer(value)), Leaf((_: Any) => Pure(())))

}

同様にReaderモナドを定義します。

case class Reader[A]()

object Reader {

  def run[U <: Union, A](freer: Freer[Reader :+: U, A], s: String): Freer[U, A] =
    freer match {
      case Pure(a) => Pure(a)
      case Impure(u, f) =>
        def k(x: Any): Freer[U, A] = run(f(x), s)
        u match {
          case Inl(Reader()) => k(s)
          case Inr(u) => Impure(u, Leaf(k))
        }
    }

  def ask[U <: Union, A](implicit member: Member[Reader, U]): Freer[U, A] =
    Impure(member.inject(Reader()), Leaf((x: A) => Pure(x)))

}

これらを混合したアプリケーションを作ることが可能です。

object Example {

  def app[U <: Union](implicit w: Member[Writer, U], r: Member[Reader, U]): Freer[U, String] =
    for {
      _ <- Writer.tell("hoge")
      s <- Reader.ask[U]
      _ <- Writer.tell(s)
    } yield s

  assert(Freer.run(Writer.run(Reader.run(app[Reader :+: Writer :+: Void], "fuga"))) == ("fuga", List("hoge", "fuga")))

}

まとめ

Scalaにおける高速で拡張可能なFreerモナドを紹介しました。

しかし、まだまだ多くの問題点を抱えています。

まず、Reader#runやWriter#runで共通する処理(catamorphism)を定義するにはHaskellのforallのような機能が必要です。

Anyで代用することは可能ですが、型安全にはなりません。

forallの代わりに新たな型を定義することもできますが、記述がとても冗長になります。

この関数をスタックセーフに記述するにはトランポリンが必要で、パフォーマンスに影響が出ます。

また、* -> *でない型に関してユニフィケーションがうまくいきません。

WriterやReaderというモナドは本来Writer[O, A]やReader[I, A]のような型を持ちます。

kind-projectorを使うことでFreer[Writer[O, ?] :+: Reader[I, ?] :+: Void, A]のように型を記述することが可能ですが、Freer[F :+: U, A]に対するユニフィケーションに失敗します。