Cats（2）－ Free语法组合，Coproduct-ADT composition

    上篇我们介绍了Free类型可以作为一种嵌入式编程语言DSL在函数式编程中对某种特定功能需求进行描述。一个完整的应用可能会涉及多样的关联功能，但如果我们为每个应用都设计一套DSL的话，那么在我们的函数式编程中将会不断重复的功能相似的DSL。我们应该秉承函数式编程的核心思想：函数组合（compositionality）来实现DSL的组合：把DSL拆解成最基础语句ADT，然后用这些ADT来组合成适合应用功能要求的完整DSL。我们还是使用上篇那个Interact DSL，这次再增加一个Login功能：

package demo.app
import cats.free.{Free,Inject}
object FreeModules {
  object ADTs {
    sealed trait Interact[+A]
    object Interact {
      case class Ask(prompt: String) extends Interact[String]
      case class Tell(msg: String) extends Interact[Unit]
      type FreeInteract[A] = Free[Interact,A]
      def ask(prompt: String): FreeInteract[String] = Free.liftF(Ask(prompt))
      def tell(msg: String): FreeInteract[Unit] = Free.liftF(Tell(msg))
    }

    sealed trait Login[+A]
    object Login {
      type FreeLogin[A] = Free[Login,A]
      case class Authenticate(user: String, pswd: String) extends Login[Boolean]
      def authenticate(user: String, pswd: String): FreeLogin[Boolean] =
        Free.liftF(Authenticate(user,pswd))
    }

  }

}

上面我们增加了个Login类。我们先来进行DSL编程：

  object DSLs {
    import ADTs._
    import Interact._
    import Login._
    val interactDSL: FreeInteract[Unit]  = for {
      first <- ask("What's your first name?")
      last <- ask("What's your last name?")
      _ <- tell(s"Hello, $first $last!")
    } yield()

    val loginDSL: FreeLogin[Boolean] = for {
      login <- authenticate("Tiger","123")
    } yield login
  }

很明显，用一种DSL编程是无法满足Login功能需要的。我们需要像下面这样的DSL：

 val interactLoginDSL: Free[???,Boolean] = for {
      uid <- ask("Enter your User ID:")
      psw <- ask("Enter your Password:")
      aut <- authenticate(uid,pwd)
    } yield aut

不过上面的???应该是什么呢？它应该是Interact和Login的集合。cats提供了Coproduct，它是一个树形数据结构：

/** `F` on the left and `G` on the right of [[scala.util.Either]].
 *
 * @param run The underlying [[scala.util.Either]].
 */
final case class Coproduct[F[_], G[_], A](run: Either[F[A], G[A]]) {...}

Coproduct 的每一个节点（Either[F[A],G[A]]）都是一个ADT，F[A]或者G[A]。我们可以用多层递归Coproduce结构来构建一个多语法的树形结构，如：

type H[A] = Coproduct[F,G,A]
type I[A] = Coproduct[H,X,A]
type J[A] = Coproduct[J,Y,A]  //ADT(F,G,X,Y)

用Coproduct的树形结构可以容纳多种DSL的ADT。在上面的例子里我们需要一个组合的语法InteractLogin：

type InteractLogin[A] = Coproduct[Interact,Login,A]

cats提供了Inject类来构建Coproduct：

sealed abstract class Inject[F[_], G[_]] {
  def inj[A](fa: F[A]): G[A]

  def prj[A](ga: G[A]): Option[F[A]]
}

private[free] sealed abstract class InjectInstances {
  implicit def catsFreeReflexiveInjectInstance[F[_]]: Inject[F, F] =
    new Inject[F, F] {
      def inj[A](fa: F[A]): F[A] = fa

      def prj[A](ga: F[A]): Option[F[A]] = Some(ga)
    }

  implicit def catsFreeLeftInjectInstance[F[_], G[_]]: Inject[F, Coproduct[F, G, ?]] =
    new Inject[F, Coproduct[F, G, ?]] {
      def inj[A](fa: F[A]): Coproduct[F, G, A] = Coproduct.leftc(fa)

      def prj[A](ga: Coproduct[F, G, A]): Option[F[A]] = ga.run.fold(Some(_), _ => None)
    }

  implicit def catsFreeRightInjectInstance[F[_], G[_], H[_]](implicit I: Inject[F, G]): Inject[F, Coproduct[H, G, ?]] =
    new Inject[F, Coproduct[H, G, ?]] {
      def inj[A](fa: F[A]): Coproduct[H, G, A] = Coproduct.rightc(I.inj(fa))

      def prj[A](ga: Coproduct[H, G, A]): Option[F[A]] = ga.run.fold(_ => None, I.prj)
    }
}

inj[A](fa: F[A]):G[A]代表将F[A]注入更大的语法集G[A]。cats提供了三种实现了ink函数的Inject隐式实例：

1、catsFreeReflexiveInjectInstance:Inject[F,F]：对单一语法，无须构建Coproduct

2、catsFreeLeftInjectInstance:Inject[F,Coproduct[F,G,?]]：构建Coproduct结构并将F放在左边

3、catsFreeRightInjectInstance:Inject[F,Coproduct[H,G,?]]：把F注入到已经包含H,G的Coproduct[H,G,?]

有了这三种实例后我们可以根据解析到的隐式实例类型使用inj函数通过Coproduct构建更大的语法集了。我们可以通过implicitly来验证一下Interact和Login语法的Inject隐式实例：

    val selfInj = implicitly[Inject[Interact,Interact]]
    type LeftInterLogin[A] = Coproduct[Interact,Login,A]
    val leftInj = implicitly[Inject[Interact,LeftInterLogin]]
    type RightInterLogin[A] = Coproduct[Login,LeftInterLogin,A]
    val rightInj = implicitly[Inject[Interact,RightInterLogin]]

现在我们可以用Inject.inj和Free.liftF把Interact和Login升格成Free[G,A]。G是个类型变量，Interact和Login在Coproduct的最终左右位置由当前Inject隐式实例类型决定：

  object ADTs {
    sealed trait Interact[+A]
    object Interact {
      case class Ask(prompt: String) extends Interact[String]
      case class Tell(msg: String) extends Interact[Unit]
      type FreeInteract[A] = Free[Interact,A]
      //def ask(prompt: String): FreeInteract[String] = Free.liftF(Ask(prompt))
      //def tell(msg: String): FreeInteract[Unit] = Free.liftF(Tell(msg))
      def ask[G[_]](prompt: String)(implicit I: Inject[Interact,G]): Free[G,String] =
        Free.liftF(I.inj(Ask(prompt)))
      def tell[G[_]](msg: String)(implicit I: Inject[Interact,G]): Free[G,Unit] =
        Free.liftF(I.inj(Tell(msg)))
    }

    sealed trait Login[+A]
    object Login {
      type FreeLogin[A] = Free[Login,A]
      case class Authenticate(user: String, pswd: String) extends Login[Boolean]
      //def authenticate(user: String, pswd: String): FreeLogin[Boolean] =
      //  Free.liftF(Authenticate(user,pswd))
      def authenticate[G[_]](user: String, pswd: String)(implicit I: Inject[Login,G]): Free[G,Boolean] =
        Free.liftF(I.inj(Authenticate(user,pswd)))
    }

现在我们可以用混合语法的DSL来编程了：

  object DSLs {
    import ADTs._
    import Interact._
    import Login._
    val interactDSL: FreeInteract[Unit] = for {
      first <- ask("What's your first name?")
      last <- ask("What's your last name?")
      _ <- tell(s"Hello, $first $last!")
    } yield()

    val loginDSL: FreeLogin[Boolean] = for {
      login <- authenticate("Tiger","123")
    } yield login

    type InteractLogin[A] = Coproduct[Interact,Login,A]
    val interactLoginDSL: Free[InteractLogin,Boolean] = for {
      uid <- ask[InteractLogin]("Enter your User ID:")
      pwd <- ask[InteractLogin]("Enter your Password:")
      aut <- authenticate[InteractLogin](uid,pwd)
    } yield aut
  }

在interactLoginDSL里所有ADT通过Inject隐式实例都被自动升格成统一的Free[Coproduct[Interact,Login,A]]。

interactLogin的功能实现方式之一示范如下：

  object IMPLs {
    import cats.{Id,~>}
    import ADTs._,Interact._,Login._
    import DSLs._
    object InteractConsole extends (Interact ~> Id) {
      def apply[A](ia: Interact[A]): Id[A] = ia match {
        case Ask(p) => {println(p); readLine}
        case Tell(m) => println(m)
      }
    }
    object LoginMock extends (Login ~> Id) {
      def apply[A](la: Login[A]): Id[A] = la match {
        case Authenticate(u,p) => if (u == "Tiger" && p == "123") true else false
      }
    }
    val interactLoginMock: (InteractLogin ~> Id) = InteractConsole.or(LoginMock)
  }

这个interactLoginMock就是一个Interact,Login混合语法程序的功能实现。不过我们还是应该赋予Login一个比较实在点的实现：我们可以用一种依赖注入方式通过Reader数据类型把外部系统的用户密码验证的方法传入：

  import Dependencies._
    import cats.data.Reader
    type ReaderPass[A] = Reader[PasswordControl,A]
    object LoginToReader extends (Login ~> ReaderPass) {
      def apply[A](la: Login[A]): ReaderPass[A] = la match {
        case Authenticate(u,p) => Reader{pc => pc.matchUserPassword(u,p)}
      }
    }
    object InteractToReader extends (Interact ~> ReaderPass) {
      def apply[A](ia: Interact[A]): ReaderPass[A] = ia match {
        case Ask(p) => {println(p); Reader(pc => readLine)}
        case Tell(m) => {println(m); Reader(pc => ())}
      }
    }
    val userLogin: (InteractLogin ~> ReaderPass) = InteractToReader or LoginToReader

假设用户密码验证由外部另一个系统负责，PasswordControl是与这个外部系统的界面（interface）：

object Dependencies {
  trait PasswordControl {
    val mapPasswords: Map[String,String]
    def matchUserPassword(uid: String, pwd: String): Boolean
  }
}

我们用Reader来注入PasswordControl这个外部依赖（dependency injection IOC）。因为Interact和Login结合形成的是一个统一的语句集，所以我们必须进行Interact与ReaderPass对应。下面我们先构建一个PasswordControl对象作为模拟数据，然后试运行：

object catsComposeFree extends App {
  import Dependencies._
  import FreeModules._
  import DSLs._
  import IMPLs._
  object UserPasswords extends PasswordControl {
    override val mapPasswords: Map[String, String] = Map(
      "Tiger" -> "123",
      "John" -> "456"
    )
    override def matchUserPassword(uid: String, pwd: String): Boolean =
      mapPasswords.getOrElse(uid,pwd+"!") == pwd
  }

  val r = interactLoginDSL.foldMap(userLogin).run(UserPasswords)
  println(r)

}

运算结果：

Enter your User ID:
Tiger
Enter your Password:
123
true
...
Enter your User ID:
Chan
Enter your Password:
123
false

我们再用这个混合的DSL编个稍微完整点的程序：

    val userLoginDSL: Free[InteractLogin,Unit] = for {
      uid <- ask[InteractLogin]("Enter your User ID:")
      pwd <- ask[InteractLogin]("Enter your Password:")
      aut <- authenticate[InteractLogin](uid,pwd)
      _ <- if (aut) tell[InteractLogin](s"Hello $uid")
           else tell[InteractLogin]("Sorry, who are you?")
    } yield()

运算这个程序不需要任何修改：

  //val r = interactLoginDSL.foldMap(userLogin).run(UserPasswords)
  //println(r)
  userLoginDSL.foldMap(userLogin).run(UserPasswords)

现在结果变成了：

Enter your User ID:
Tiger
Enter your Password:
123
Hello Tiger
...
Enter your User ID:
CHAN
Enter your Password:
123
Sorry, who are you?

如果我们在这两个语法的基础上再增加一个模拟权限管理的语法，ADT设计如下：

    sealed trait Auth[+A]
    object Auth {
      case class Authorize(uid: String) extends Auth[Boolean]
      def authorize[G[_]](uid:String)(implicit I: Inject[Auth,G]): Free[G,Boolean] =
        Free.liftF(I.inj(Authorize(uid)))
    }

假设实际的权限管理依赖外部系统，我们先定义它的界面：

object Dependencies {
  trait PasswordControl {
    val mapPasswords: Map[String,String]
    def matchUserPassword(uid: String, pwd: String): Boolean
  }
  trait PermControl {
    val mapAuthorized: Map[String,Boolean]
    def authorized(uid: String): Boolean
  }
}

再用三种语法合成的DSL来编一段程序：

    import Auth._
    type Permit[A] = Coproduct[Auth,InteractLogin,A]
    val userPermitDSL: Free[Permit,Unit] = for {
      uid <- ask[Permit]("Enter your User ID:")
      pwd <- ask[Permit]("Enter your Password:")
      auth <- authenticate[Permit](uid,pwd)
      perm <- if(auth) authorize[Permit](uid)
              else Free.pure[Permit,Boolean](false)
      _ <- if (perm) tell[Permit](s"Hello $uid, welcome to the program!")
           else tell[Permit]("Sorry, no no no!")
    } yield()

很遗憾，这段代码无法通过编译，cats还无法处理多层递归Coproduct。对Coproduct的处理scalaz还是比较成熟的，我在之前写过一篇scalaz Coproduct Free的博客，里面用的例子就是三种语法的DSL。实际上不单只是Coproduct的问题，现在看来cats.Free对即使很简单的应用功能也有着很复杂无聊的代码需求，这是我们无法接受的。由于Free编程在函数式编程里占据着如此重要的位置，我们暂时还没有其它选择，所以必须寻找一个更好的编程工具才行，freeK就是个这样的函数组件库。我们将在下篇讨论里用freeK来实现多种语法DSL编程。

无论如何，我还是把这篇讨论的示范代码附在下面：

import cats.data.Coproduct
import cats.free.{Free, Inject}
object FreeModules {
  object ADTs {
    sealed trait Interact[+A]
    object Interact {
      case class Ask(prompt: String) extends Interact[String]
      case class Tell(msg: String) extends Interact[Unit]
      type FreeInteract[A] = Free[Interact,A]
      //def ask(prompt: String): FreeInteract[String] = Free.liftF(Ask(prompt))
      //def tell(msg: String): FreeInteract[Unit] = Free.liftF(Tell(msg))
      def ask[G[_]](prompt: String)(implicit I: Inject[Interact,G]): Free[G,String] =
        Free.liftF(I.inj(Ask(prompt)))
      def tell[G[_]](msg: String)(implicit I: Inject[Interact,G]): Free[G,Unit] =
        Free.liftF(I.inj(Tell(msg)))
    }

    sealed trait Login[+A]
    object Login {
      type FreeLogin[A] = Free[Login,A]
      case class Authenticate(user: String, pswd: String) extends Login[Boolean]
      //def authenticate(user: String, pswd: String): FreeLogin[Boolean] =
      //  Free.liftF(Authenticate(user,pswd))
      def authenticate[G[_]](user: String, pswd: String)(implicit I: Inject[Login,G]): Free[G,Boolean] =
        Free.liftF(I.inj(Authenticate(user,pswd)))
    }

    sealed trait Auth[+A]
    object Auth {
      case class Authorize(uid: String) extends Auth[Boolean]
      def authorize[G[_]](uid:String)(implicit I: Inject[Auth,G]): Free[G,Boolean] =
        Free.liftF(I.inj(Authorize(uid)))
    }
    val selfInj = implicitly[Inject[Interact,Interact]]
    type LeftInterLogin[A] = Coproduct[Interact,Login,A]
    val leftInj = implicitly[Inject[Interact,LeftInterLogin]]
    type RightInterLogin[A] = Coproduct[Login,LeftInterLogin,A]
    val rightInj = implicitly[Inject[Interact,RightInterLogin]]
  }

  object DSLs {
    import ADTs._
    import Interact._
    import Login._
    val interactDSL: FreeInteract[Unit] = for {
      first <- ask("What's your first name?")
      last <- ask("What's your last name?")
      _ <- tell(s"Hello, $first $last!")
    } yield()

    val loginDSL: FreeLogin[Boolean] = for {
      login <- authenticate("Tiger","123")
    } yield login

    type InteractLogin[A] = Coproduct[Interact,Login,A]
    val interactLoginDSL: Free[InteractLogin,Boolean] = for {
      uid <- ask[InteractLogin]("Enter your User ID:")
      pwd <- ask[InteractLogin]("Enter your Password:")
      aut <- authenticate[InteractLogin](uid,pwd)
    } yield aut
    val userLoginDSL: Free[InteractLogin,Unit] = for {
      uid <- ask[InteractLogin]("Enter your User ID:")
      pwd <- ask[InteractLogin]("Enter your Password:")
      aut <- authenticate[InteractLogin](uid,pwd)
      _ <- if (aut) tell[InteractLogin](s"Hello $uid")
           else tell[InteractLogin]("Sorry, who are you?")
    } yield()
  /*  import Auth._
    type Permit[A] = Coproduct[Auth,InteractLogin,A]
    val userPermitDSL: Free[Permit,Unit] = for {
      uid <- ask[Permit]("Enter your User ID:")
      pwd <- ask[Permit]("Enter your Password:")
      auth <- authenticate[Permit](uid,pwd)
      perm <- if(auth) authorize[Permit](uid)
              else Free.pure[Permit,Boolean](false)
      _ <- if (perm) tell[Permit](s"Hello $uid, welcome to the program!")
           else tell[Permit]("Sorry, no no no!")
    } yield() */
  }
  object IMPLs {
    import cats.{Id,~>}
    import ADTs._,Interact._,Login._
    import DSLs._
    object InteractConsole extends (Interact ~> Id) {
      def apply[A](ia: Interact[A]): Id[A] = ia match {
        case Ask(p) => {println(p); readLine}
        case Tell(m) => println(m)
      }
    }
    object LoginMock extends (Login ~> Id) {
      def apply[A](la: Login[A]): Id[A] = la match {
        case Authenticate(u,p) => if (u == "Tiger" && p == "123") true else false
      }
    }
    val interactLoginMock: (InteractLogin ~> Id) = InteractConsole.or(LoginMock)
    import Dependencies._
    import cats.data.Reader
    type ReaderPass[A] = Reader[PasswordControl,A]
    object LoginToReader extends (Login ~> ReaderPass) {
      def apply[A](la: Login[A]): ReaderPass[A] = la match {
        case Authenticate(u,p) => Reader{pc => pc.matchUserPassword(u,p)}
      }
    }
    object InteractToReader extends (Interact ~> ReaderPass) {
      def apply[A](ia: Interact[A]): ReaderPass[A] = ia match {
        case Ask(p) => {println(p); Reader(pc => readLine)}
        case Tell(m) => {println(m); Reader(pc => ())}
      }
    }
    val userLogin: (InteractLogin ~> ReaderPass) = InteractToReader or LoginToReader

  }
}
object Dependencies {
  trait PasswordControl {
    val mapPasswords: Map[String,String]
    def matchUserPassword(uid: String, pwd: String): Boolean
  }
  trait PermControl {
    val mapAuthorized: Map[String,Boolean]
    def authorized(uid: String): Boolean
  }
}

object catsComposeFree extends App {
  import Dependencies._
  import FreeModules._
  import DSLs._
  import IMPLs._
  object UserPasswords extends PasswordControl {
    override val mapPasswords: Map[String, String] = Map(
      "Tiger" -> "123",
      "John" -> "456"
    )
    override def matchUserPassword(uid: String, pwd: String): Boolean =
      mapPasswords.getOrElse(uid,pwd+"!") == pwd
  }

  //val r = interactLoginDSL.foldMap(userLogin).run(UserPasswords)
  //println(r)
  userLoginDSL.foldMap(userLogin).run(UserPasswords)

}