泛函编程（30）－泛函IO：Free Monad－Monad生产线

在上节我们介绍了Trampoline。它主要是为了解决堆栈溢出（StackOverflow）错误而设计的。Trampoline类型是一种数据结构，它的设计思路是以heap换stack：对应传统递归算法运行时在堆栈上寄存程序状态，用Trampoline进行递归算法时程序状态是保存在Trampoline的数据结构里的。数据结构是在heap上的，所以可以实现以heap换stack的效果。这种以数据结构代替函数调用来解决问题的方式又为泛函编程提供了更广阔的发展空间。

我们知道，任何涉及IO的运算都会面临堆栈溢出问题。这是因为IO通常针对无法预计的数据量以及重复循环操作。所以IO算法设计也会采用与Trampoline一样的数据结构。或者我们应该沿用Trampoline数据结构和算法来设计IO组件库。如此思考那么我们就必须对Trampoline进行深度抽象了。Free Monad就是Trampline的延伸。在介绍Free Monad之前我们先从一个现实的例子来展开讨论：

假设我们要编写一个银行转账的函数，我们可能先把这个函数的款式（function signature）推导出来：

 def transfer(amount: Double, from: Account, to: Account, user: User,
   context: Authorization with Logger with ErrorHandler with Storage): Unit

首先我们在这里采用了参数注入（parameter injection）方式：在transfer函数输入参数中注入context object。这个context object里包括了身份验证、操作跟踪、错误处理、数据存取等等。这算是传统OOP编程模式吧。对于一个泛函编程人员来讲：通过这个context object 可以进行一系列的操作。包括IO操作，也就是说可以进行一些含有副作用（side effect）的操作。那么这个函数是无法实现函数组合（function composition）。transfer函数就不是一个泛函编程人员该使用的函数了。

也许我们应该从泛函编程角度来尝试设计这个函数：用泛函编程提倡的不可蜕变（immutability）方式来设计，也就是向函数调用方返回一些东西。

比如我们可以向函数调用方返回一个描述操作的程序：一串命令（instruction）：

 def transfer(amount: Double, from: Account, to: Account, user: User）： List[Instruction]

这个版本肯定是个泛函版本了。不过假如Instruction类型包括了互动操作的话就不足够了。我们先看看简单的交互的数据类型：

 trait Interact[A] //交互数据类型
 //提问，等待返回String类型答案
 case class Ask(prompt: String) extends Interact[String]
 //告知，没有返回结果
 case class Tell(msg: String) extends Interact[Unit]

如果我们按照上面的思路返回一串命令的话：

  val prg = List(Ask("What's your first name?"),
                  Ask("What's your last name?"),
                  Tell("Hello ??? ???"))

这个程序prg是有缺陷的：无法实现交互。好像如果能把Ask指令存放到一个临时变量里就可以达到目的了。那么如果我们把这个prg改写成下面这样：

 for {
     x <- Ask("What's your first name?")
     y <- Ask("What's your last name?")
     _ <- Tell(s"Hello $y $x!")
 } yield () 

这不就是Monad款式吗？原来解决方法就是把交互类型trait Interact[A]变成Monad就行了。

不过要把Interact变成Monad就必须实现unit和flatMap两个函数，检查Interact trait，明显这是不可能的。

那我们把下面的努力都应该放在如何转变成Monad这方面了。既然我们在本篇命题里提到Free Monad是Monad生产线。那么用Free Monad能不能把Interact变成Monad呢？

我们先看看这个Free Monad类型结构：

 trait Free[F[_],A]
 case class Return[F[_],A](a: A) extends Free[F,A]
 case class Bind[F[_],I,A](a: F[I], f: I => Free[F,A]) extends Free[F,A]

这个Free结果跟Trampoline简直是太相似了。如果Free是个Monad，那么我们应该必须实现它的flatMap函数：

 trait Free[F[_],A] {
  def unit(a: A) = Return(a)
  def flatMap[B](f: A => Free[F,B]): Free[F,B] = this match {
        case Return(a) => f(a)
 //还记得Trampoline  FlatMap(FlatMap(b,g),f) == FlatMap(b, (x: Any) => FlatMap(g(x),f))
        case Bind(fa,g) => Bind(fa, (x: Any) => g(x) flatMap f)
 //下面采用了函数组合方式。具备同样功能
 //   case Bind(fa,g) => Bind(fa, g andThen (_ flatMap f))
  }
  def map[B](f: A => B): Free[F,B] = flatMap(a => Return(f(a)))

 }
 case class Return[F[_],A](a: A) extends Free[F,A]
 case class Bind[F[_],I,A](a: F[I], f: I => Free[F,A]) extends Free[F,A]

我们可以用下面的lift函数来把Interact[A]升格成Free[F,A] ：

 implicit def lift[F[_],A](fa: F[A]): Free[F,A] = Bind(fa, (a: A) => Return(a))
                                                   //> lift: [F[_], A](fa: F[A])ch13.ex6.Free[F,A]

有了lift我们可以吧prg升格成Monad：

 trait Interact[A] //交互数据类型
 //提问，等待返回String类型答案
 case class Ask(prompt: String) extends Interact[String]
 //告知，没有返回结果
 case class Tell(msg: String) extends Interact[Unit]

 implicit def lift[F[_],A](fa: F[A]): Free[F,A] = Bind(fa, (a: A) => Return(a))
                                                   //> lift: [F[_], A](fa: F[A])ch13.ex6.Free[F,A]
 for {
     x <- Ask("What's your first name?")
     y <- Ask("What's your last name?")
     _ <- Tell(s"Hello $y $x!")
 } yield ()                                        //> res0: ch13.ex6.Free[ch13.ex6.Interact,Unit] = Bind(Ask(What's your first nam
                                                   //| e?),<function1>)

这是因为implicit scope里的类型转换使Interact升格为Free，而Free是个Monad，所以我们可以使用for-comprehension。

好了，这个程序描述完成后应该如何运算呢？Free Monad包括了两部分功能，相互之间无关联，可以分开单独考虑。这就是所谓的关注分离（separation of concern）。Free Monad的两项功能分别是Monad，和Interpreter（解译器）。我们用Monad描述程序算法，用Interpreter解译程序形成针对特定运行环境的可运行代码。

Free Monad的Interpreter实现了算法和运算的分离考虑。Interpreter程序运算是通过一个转换函数实现的。这个函数把F[_]这样一个算法解译成G[_]这样一个针对可运行环境的Monad运行代码。这种转换就是自然转换（Natural Transformation），它的函数款式如下：

 trait ~>[F[_],G[_]] {
     def apply[A](fa: F[A]): G[A]
 }

很明显，这个构建函数（constructor）把传入的F[A]解译成G[A]。

现在Interpreter运行一段算法就是对算法F[_]中的表达式进行一对一的G[_]转换。就像对List结构中元素进行处理的方式一样，我们可以用折叠算法来实现F[_]结构中表达式的转换：

 def foldMap[G[_]: Monad](f: F ~> G): G[A] = this match {
           case Return(a) => Monad[G].unit(a)
           case Bind(b,g) => Monad[G].flatMap(f(b))(a => g(a).foldMap(f))
  }

我们看到，foldMap把Free Monad F[_]中的表达式与Monad G状态进行了对应。注意Bind状态是循环递归的。

现在我们可以试试最简单的解译：F,Id转换：

 ype Id[A] = A
 implicit val idMonad: Monad[Id] = new Monad[Id] {
     def unit[A](a: A) = a
     def flatMap[A,B](fa: A)(f: A => B): B = f(fa)
 }                                                 //> idMonad  : ch13.ex6.Monad[ch13.ex6.Id] = ch13.ex6$$anonfun$main$1$$anon$1@2
                                                   //| 530c12
 object Console extends (Interact ~> Id) {
     def apply[A](i: Interact[A]): A = i match {
         case Ask(prompt) => {
           println(prompt)
           readLine
         }
         case Tell(msg) => println(msg)
     }
 }

运算上面那段Interact程序：由于Id不产生任何效果，Interact到Id转换即是直接运算Interact表达式：

 val prg = for {
     x <- Ask("What's your first name?")
     y <- Ask("What's your last name?")
     _ <- Tell(s"Hello $y $x!")
 } yield ()                                        //> prg  : ch13.ex6.Free[ch13.ex6.Interact,Unit] = Bind(Ask(What's your first n
                                                   //| ame?),<function1>)

 prg.foldMap(Console)

或者我们可以试试再复杂一点的解译：

 type Tester[A] = Map[String, String] => (List[String], A)
 implicit val testerMonad = new Monad[Tester] {
     def unit[A](a: A) = (_ => (List(),a))
     def flatMap[A,B](ta: Tester[A])(f: A => Tester[B]): Tester[B] = {
         m => {
             val (l1,a) = ta(m)
             val (l2,b) = f(a)(m)
             (l1 ++ l2,b)
         }
     }
 }                                                 //> testerMonad  : ch13.ex6.Monad[ch13.ex6.Tester]{def unit[A](a: A): Map[Strin
                                                   //| g,String] => (List[Nothing], A)} = ch13.ex6$$anonfun$main$1$$anon$2@5b464ce
                                                   //| 8
 object TestConsole extends (Interact ~> Tester) {
     def apply[A](i: Interact[A]): Tester[A] = i match {
       case Ask(prompt) => m => (List(), m(prompt))
       case Tell(msg) => _ => (List(msg),())
     }
 }

以上我们把运行Interact中的交互信息存入Map[String,String]结构中。在这里进行了Interact到一个函数Map=>(List,A）的转换。

 val prg = for {
     x <- Ask("What's your first name?")
     y <- Ask("What's your last name?")
     _ <- Tell(s"Hello $y $x!")
 } yield ()                                        //> prg  : ch13.ex6.Free[ch13.ex6.Interact,Unit] = Bind(Ask(What's your first n
                                                   //| ame?),<function1>)

 prg.foldMap(TestConsole)

在上一节我们讨论了Trampoline。主要目的是解决泛函算法中不可避免的堆栈溢出问题。如果我们用Free Monad来解决IO问题的话，堆栈溢出问题也是无法避免的。我们应该考虑在Free Monad里使用Trampoline类型。这样我们才可以放心地用Free Monad来产生任何类型的Monad并在运算中以heap换stack解决堆栈溢出问题。