Scala 版 Extensible Effects 解説 Tree モナド と Choose モナド（List モナド）編 ref: http://qiita.com/amoO_O/items/166e2fdc67d0b1a51c9e

file0.scala

type Pair[A] = (A, A)

type Tree[A] = Freer[Pair, A]

def leaf[A](a: A): Tree[A] = Pure(a)

def node[A](x: Tree[A], y: Tree[A]): Tree[A] = Freer((x, y): Pair[Tree[A]])

file1.scala

type Tree[A] = (A, A)

type Maybe[A] = Unit

val tree1: Maybe :+: Tree :+: Void = Inr(Inl((0, 1): Tree[Int]))

file10.scala

def e[U <: Union](implicit m: Member[Choose, U]): Eff[U, Int] = for {
  a <- Choose(10, 20, 30)
  b <- Choose(1, 2, 3)
} yield a + b

Eff.run(Choose.makeChoice(e[Choose :+: Void]))
// Vector(11, 12, 13, 21, 22, 23, 31, 32, 33)

file11.scala

def e[U <: Union](
  implicit mp: Member[Pair, U], mc: Member[Choose, U]
): Eff[U, Int] = for {
  a <- node(leaf(10), leaf(20))
  b <- Choose(1, 2, 3)
} yield a + b

file12.scala

Eff.run(Choose.makeChoice(str(e[Pair :+: Choose :+: Void])))

/*
java.lang.ClassCastException: amo.app.eff.Pure cannot be cast to scala.Tuple2
  at amo.app.eff.Arrows.go$2(Arrows.scala:28)
  at amo.app.eff.Arrows.apply(Arrows.scala:33)
  at amo.app.eff.Arrows.apply$(Arrows.scala:23)
  at amo.app.eff.Node.apply(Arrows.scala:41)
  at amo.app.example.Choose$.$anonfun$makeChoice$1(Choose.scala:50)
  at scala.collection.Iterator$$anon$10.next(Iterator.scala:448)
  at scala.collection.Iterator$$anon$10.next(Iterator.scala:448)
  at scala.collection.Iterator.foreach(Iterator.scala:929)
  at scala.collection.Iterator.foreach$(Iterator.scala:929)
  at scala.collection.AbstractIterator.foreach(Iterator.scala:1406)
  at scala.collection.TraversableOnce.foldLeft(TraversableOnce.scala:157)
  at scala.collection.TraversableOnce.foldLeft$(TraversableOnce.scala:155)
  at scala.collection.AbstractIterator.foldLeft(Iterator.scala:1406)
  at amo.app.example.Choose$.makeChoice(Choose.scala:54)
  ... 39 elided
 */

file13.scala

def fold[U <: Union, A, B](
  t: Eff[Pair :+: U, A]
)(f: A => B)(g: (B, B) => B): Eff[U, B] = t match {
  case Pure(a) => Pure(f(a))
  case Impure(Inl((x, y)), h) => for {
    a <- fold(h(x))(f)(g)
    b <- fold(h(y))(f)(g)
  } yield g(a, b)
  case Impure(Inr(u), h) =>
    Impure(u, Leaf((x: Any) => fold(h(x))(f)(g)))
}

file14.scala

Eff.run(Choose.makeChoice(str(e[Pair :+: Choose :+: Void])))
// Vector((11, 21), (11, 22), (11, 23), (12, 21), (12, 22), (12, 23), (13, 21), (13, 22), (13, 23))
// 先に Tree を String に変換してから makeChoice を実行
// 存在しうる Tree のリストが得られる。

Eff.run(str(Choose.makeChoice(e[Choose :+: Pair :+: Void])))
// (Vector(11, 12, 13), Vector(21, 22, 23))
// 先に makeChoice を実行してから String に変換
// Tree の各 leaf が、取り得る値候補のリストになっている

file2.scala

// 計算作用 Const とその自由モナド Maybe
type Const[A] = Unit
final case class MaybeT[F[_], A](run: F[Maybe[A]]) {
  // Maybe は Const の自由モナドだが、モナド変換子の説明のため MaybeT を scalaz から引用
  // 中身 略
}

// 計算作用 Pair とその自由モナド Tree
type Pair[A] = [A, A]
type Tree[A] = Freer[Pair, A]

type MaybeTree1[A] = MaybeT[Tree, A]  // モナド変換子を使って Maybe と Tree を合成

type U = Const :+: Pair :+: Void      // Union を使って Const と Pair の直和型を定義
type MaybeTree2[A] = Eff[U, A]        // 直和型の自由モナドとして Maybe と Tree の合成を表現

file3.scala

def leaf[U <: Union, A](a: A)(implicit member: Member[Tree, U]): Eff[U, A] = Pure(a)

def node[U <: Union, A](x: Eff[U, A], y: Eff[U, A])(implicit member: Member[Tree, U]): Eff[U, A] = Eff((x, y): Tree[Eff[U, A]])

def fold[U <: Union, A, B](t: Eff[Tree :+: U, A])(f: A => B)(g: (B, B) => B): Eff[U, B] =
  t match {
    case Pure(a) => Pure(f(a))
    case Impure(u, h) =>
      def k(t: Tree[Any]): Eff[U, B] =
        t match {
          case (x, y) =>
            for {
              a <- fold(h(x))(f)(g)
              b <- fold(h(y))(f)(g)
            } yield g(a, b)
        }
      u match {
        case Inl(t) => k(t)
        case Inr(u) => Impure(u, Leaf(k))
      }
  }

def str[U <: Union, A, B](t: Eff[Tree :+: U, A]): Eff[U, String] = fold(t)(_.toString)((x, y) => s"($x, $y)")

file4.scala

type Pair[A] = (A, A)
def leaf[U <: Union, A](a: A)(implicit member: Member[Pair, U]): Eff[U, A] = Pure(a)

def node[U <: Union, A](x: Eff[U, A], y: Eff[U, A])(implicit member: Member[Pair, U]): Eff[U, A] = Eff((x, y): Pair[Eff[U, A]])

def fold[U <: Union, A, B](t: Eff[Pair :+: U, A])(f: A => B)(g: (B, B) => B): Eff[U, B] =
  t match {
    case Pure(a) => Pure(f(a))
    case Impure(u, h) =>
      def k(pair: Pair[Any]): Eff[U, B] =
        pair match {
          case (x, y) =>
            for {
              a <- fold(h(x))(f)(g)
              b <- fold(h(y))(f)(g)
            } yield g(a, b)
        }
      u match {
        case Inl(l) => k(l)
        case Inr(r) => Impure(r, Leaf(k))
      }
  }

def str[U <: Union, A, B](t: Eff[Pair :+: U, A]): Eff[U, String] = fold(t)(_.toString)((x, y) => s"($x, $y)")

file5.scala

// Freer
sealed trait Freer[F[_], A] { ... }
case class Pure[F[_], A](a: A) extends Freer[F, A]
case class Impure[F[_], X, A](fx: F[X], f: X => Freer[F, A]) extends Freer[F, A]

// Eff
sealed trait Eff[U <: Union, A] { ... }
case class Pure[U <: Union, A](a: A) extends Eff[U, A]
case class Impure[U <: Union, X, A](u: U, f: Arrows[U, X, A]) extends Eff[U, A]

file6.scala

def fold[U <: Union, A, B](t: Eff[Pair :+: U, A])(f: A => B)(g: (B, B) => B): Eff[U, B] =
  t match {
    case Pure(a) => Pure(f(a))
    case Impure(u, h) =>
      def k(pair: Pair[Any]): Eff[U, B] =
        pair match {
          case (x, y) =>
            for {
              a <- fold(h(x))(f)(g)
              b <- fold(h(y))(f)(g)
            } yield g(a, b)
        }
      u match {
        case Inl(l) => k(l)
        case Inr(r) => Impure(r, Leaf(k))
      }
  }

file7.scala

    case Pure(a) => Pure(f(a))

file8.txt

    case Impure(u, h) =>

file9.scala

sealed trait Choose[T]
object Choose {
  private[this] case class ConcreteChoose[A, T](as: Vector[A], f: A => T) extends Choose[T]

  def apply[U <: Union, A](as: A*)(
    implicit m: Member[Choose, U]
  ): Eff[U, A] =
    Eff(ConcreteChoose(as.toVector, {(a: A) => Pure(a)}): Choose[Eff[U, A]]

  def makeChoice[U <: Union, A](
    e: Eff[Choose :+: U, A]
  ): Eff[U, Vector[A]] = e match {
    case Pure(a) => Pure(Vector(a))
    case Impure(Inl(ConcreteChoose(xs, f)), h) =>
      xs.toIterator
        .map(f)
        .map(h(_))
        .map(makeChoice)
        .foldLeft(Pure(Vector.empty): Eff[U, Vector[A]]){
          (bEff: Eff[U, Vector[A]], aEff: Eff[U, Vector[A]]) => for {
            bs <- bEff
            as <- aEff
          } yield bs ++ as
        }
      case Impure(Inr(u), h) =>
        Impure(u, Leaf((x: Any) => makeChoice(h(x))))
}