堆叠免费单子

Question

我正在学习 Free monad，我在 Scala 中整理了一个简单的示例，我使用它们来定义两种特定领域的语言。

第一个 monad 处理存储库的副作用。我已经实现了一个解释器，它使用 state monad 来管理状态，但在实际程序中我会使用数据库。

第二个 monad 处理 IO。

import cats.data.State
import cats.{Id, ~>}
import cats.free.Free
import cats.free.Free.liftF

final case class Todo(title: String, body: String)
def represent(todo: Todo) = s"${todo.title}: ${todo.body}"


sealed trait CRUDActionA[T]
final case class Find(key: String) extends CRUDActionA[Option[Todo]]
final case class Add(data: Todo) extends CRUDActionA[Unit]

type CRUDAction[T] = Free[CRUDActionA, T]
def find(key: String): CRUDAction[Option[Todo]] = liftF[CRUDActionA, Option[Todo]](Find(key))
def add(data: Todo): CRUDAction[Unit] = liftF[CRUDActionA, Unit](Add(data))

type TodosState[A] = State[List[Todo], A]
val repository: CRUDActionA ~> TodosState = new (CRUDActionA ~> TodosState) {
  def apply[T](fa: CRUDActionA[T]): TodosState[T] = fa match {
    case Add(todo)   => State.modify(todos => todos :+ todo)
    case Find(title) => State.inspect(todos => todos find (_.title == title))
  }
}


sealed trait IOActionA[T]
final case class Out(str: String) extends IOActionA[Unit]

type IOAction[T] = Free[IOActionA, T]
def out(str: String): IOAction[Unit] = liftF[IOActionA, Unit](Out(str))

val io: IOActionA ~> Id = new (IOActionA ~> Id) {
  override def apply[A](fa: IOActionA[A]): Id[A] = fa match {
    case Out(todo) => println(todo)
  }
}

那么，我可以把这两个“程序”放在一起

def addNewTodo: Free[CRUDActionA, Option[Todo]] = for {
  _ <- add(Todo(title = "Must do", body = "Must do something"))
  todo <- find("Must do")
} yield todo

def outProgram(todo: Todo): IOAction[Unit] = for {
  _ <- out(represent(todo))
} yield ()

然后运行它们

val (_, mayBeTodo) = (addNewTodo foldMap repository run List()).value
outProgram(mayBeTodo.get).foldMap(io)

我知道这远非理想，我想编写一个程序和一个支持的解释器：

def fullProgram = for {
  _ <- add(Todo(title = "Must do", body = "Must do something"))
  todo <- find("Must do")     // This is an option!!!
  _ <- out(represent(todo))   // But represent expects a Todo
} yield ()

所以问题是：

1. 如何将两个 monad 堆叠成一个“fullProgram”
2. 如何将两个解释器组合成一个新的解释器？
3. 如何处理find返回的Option[Todo]，然后传递给 represent

Answer 1

回答问题 1 和 2：

  type TodoApp[A] = Coproduct[IOActionA, CRUDActionA, A]


  class CRUDActions[F[_]](implicit I: Inject[CRUDActionA, F]) {
    def find(key: String): Free[F, Option[Todo]] = Free.inject[CRUDActionA, F](Find(key))
    def add(data: Todo): Free[F, Unit] = Free.inject[CRUDActionA, F](Add(data))
  }

  object CRUDActions {
    implicit def crudActions[F[_]](implicit I: Inject[CRUDActionA, F]): CRUDActions[F] = new CRUDActions[F]
  }

  class IOActions[F[_]](implicit I: Inject[IOActionA, F]) {
    def out(str: String): Free[F, Unit] = Free.inject[IOActionA, F](Out(str))
  }

  object IOActions {
    implicit def ioActions[F[_]](implicit I: Inject[IOActionA, F]): IOActions[F] = new IOActions[F]
  }

  def fullProgram(implicit C : CRUDActions[TodoApp], I : IOActions[TodoApp]): Free[TodoApp, Unit] = {
    for {
      _    <- C.add(Todo(title = "Must do", body = "Must do something"))
      todo <- C.find("Must do")
      _    <- I.out(represent(todo.get))
    } yield ()
  }

  object ConsoleCatsInterpreter extends (IOActionA ~> Id) {
    def apply[A](i: IOActionA[A]) = i match {
      case Out(prompt) => println(prompt).asInstanceOf[A]
    }
  }

  object MutableListCrudInterpreter extends (CRUDActionA ~> Id) {
    val data = new ListBuffer[Todo]

    override def apply[A](fa: CRUDActionA[A]): Id[A] = fa match {
      case Add(todo)   => data.append(todo).asInstanceOf[A]
      case Find(title) => data.find( _.title == title).asInstanceOf[A]
    }
  }

  val interpreter: TodoApp ~> Id = ConsoleCatsInterpreter or MutableListCrudInterpreter

  fullProgram.foldMap(interpreter)