Scalaz（38）－ Free ：Coproduct－Monadic语句组合

来源：互联网发布：apache性能测试工具ab 编辑：程序博客网时间：2024/05/21 15:43

很多函数式编程爱好者都把FP称为Monadic Programming，意思是用Monad进行编程。我想FP作为一种比较成熟的编程模式，应该有一套比较规范的操作模式吧。因为Free能把任何F[A]升格成Monad，所以Free的算式（AST）、算法（Interpreter）关注分离（separation of concern）模式应该可以成为一种规范的FP编程模式。我们在前面的几篇讨论中都涉及了一些AST的设计和运算，但都是一些功能单一，离散的例子。如果希望通过Free获取一个完整可用的程序，就必须想办法把离散的Free AST组合成一体运算。我们先从单一的Free AST例子开始：

import scalaz._import Scalaz._import scala.language.higherKinds import scala.language.implicitConversionsobject FreeModules {  object FreeInteract {    trait Interact[+A]    type FreeInteract[A] = Free.FreeC[Interact,A]    object Interact {      case class Ask(prompt: String) extends Interact[String]      case class Tell(msg: String) extends Interact[Unit]      implicit def interactToFreeC[A](ia: Interact[A]) = Free.liftFC(ia)      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)        }      }    }    import Interact._    val interactScript = for {      first <- Ask("What's your first name?")      last <- Ask("What's your last name?")      _ <- Tell(s"Hello ${first} ${last}, nice to meet you!")    } yield ()  }}

这是一个我们在前面讨论中重复描述几次的简单交互例子，包括了ADT、AST和Interpreter。我们可以直接运行这个程序：

object freePrgDemo extends App {  import FreeModules._  import FreeInteract._  import Interact._  Free.runFC(interactScript)(InteractConsole)  }

运算结果如下：

What's your first name?TigerWhat's your last name?ChanHello Tiger Chan, nice to meet you!

就是简单的两句界面提示和键盘输入，然后提示输入结果，没什么意义。作为测试，我们也可以模拟Console交互：用Map[String,String]来模拟Map[提问，回答]，然后把这个Map提供给Interpreter，返回结果(List[String],A)，其中List[String]是运行跟踪记录，A是模拟的键盘输入：

      type InteractMapTester[A] = Map[String,String] => (List[String], A)      implicit val mapTesterMonad = new Monad[InteractMapTester] {         def point[A](a: => A) = _ => (List(), a)         def bind[A,B](ia: InteractMapTester[A])(f: A => InteractMapTester[B]): InteractMapTester[B] =           m => {             val (o1,a1) = ia(m)             val (o2,a2) = f(a1)(m)             (o1 ++ o2, a2)           }      }      object InteractTesterMap extends (Interact ~> InteractMapTester) {        def apply[A](ia: Interact[A]): InteractMapTester[A] = ia match {          case Ask(p) => { m => (List(), m(p)) } //m(p)返回提问对应的答案作为键盘输入          case Tell(s) => { m => (List(s), ()) } //List(s)在bind函数中的o1++o2形成跟踪记录                                                 //在运算AST时就会调用InteractMapTester的bind函数        }      }

使用模拟Console的Interpreter来运行：

object freePrgDemo extends App {  import FreeModules._  import FreeInteract._  import Interact._  //Free.runFC(interactScript)(InteractConsole)     val result = Free.runFC(interactScript)(InteractTesterMap).apply(    Map(    "What's your first name?" -> "tiger",    "What's your last name?" -> "chan"  ))  println(result)  }//产生以下输出结果(List(Hello tiger chan, nice to meet you!),())

从mapTesterMonad定义中的bind看到了这句：o1++o2，是Logger的典型特征。那么用Writer能不能实现同等效果呢？我们先看看WriterT：

final case class WriterT[F[_], W, A](run: F[(W, A)]) { self =>...

实际上这个W就可以满足Logger的功能，因为在WriterT的flatMap中实现了W|+|W：

  def flatMap[B](f: A => WriterT[F, W, B])(implicit F: Bind[F], s: Semigroup[W]): WriterT[F, W, B] =    flatMapF(f.andThen(_.run))  def flatMapF[B](f: A => F[(W, B)])(implicit F: Bind[F], s: Semigroup[W]): WriterT[F, W, B] =    writerT(F.bind(run){wa =>      val z = f(wa._2)      F.map(z)(wb => (s.append(wa._1, wb._1), wb._2))    })

那么如何把Map[提问,回答]传人呢？我们可以通过WriterT[F[_],W,A]的F[]来实现这一目的：

      type WriterTF[A] = Map[String,String] => A      type InteractWriterTester[A] = WriterT[WriterTF,List[String],A]

然后我们可以用WriterT的参数run来传人Map[String,String]：run:WriterTF[(W,A)] == Map[String,String]=>(W,A)。

以下是用WriterT实现的Interpreter版本：

      type WriterTF[A] = Map[String,String] => A      type InteractWriterTester[A] = WriterT[WriterTF,List[String],A]      def testerToWriter[A](f: Map[String,String] => (List[String], A)) =         WriterT[WriterTF,List[String],A](f)      implicit val writerTesterMonad = WriterT.writerTMonad[WriterTF, List[String]]      object InteractTesterWriter extends (Interact ~> InteractWriterTester) {        def apply[A](ia: Interact[A]): InteractWriterTester[A] = ia match {          case Ask(p) => testerToWriter { m => (List(), m(p)) }          case Tell(s) => testerToWriter { m => (List(s), ())}        }      }

我们可以这样运行：

object freePrgDemo extends App {  import FreeModules._  import FreeInteract._  import Interact._  //Free.runFC(interactScript)(InteractConsole)   //val result = Free.runFC(interactScript)(InteractTesterMap).apply(  val result = Free.runFC(interactScript)(InteractTesterWriter).run(    Map(    "What's your first name?" -> "tiger",    "What's your last name?" -> "chan"  ))   println(result)  }

我们再设计另一个用户登录Login的例子：

  object FreeUserLogin {      import Dependencies._    trait UserLogin[+A]    type FreeUserLogin[A] = Free.FreeC[UserLogin,A]    object UserLogin {      case class Login(user: String, pswd: String) extends UserLogin[Boolean]      implicit def loginToFree[A](ul: UserLogin[A]) = Free.liftFC(ul)      type LoginService[A] = Reader[PasswordControl,A]      object LoginInterpreter extends (UserLogin ~> LoginService) {        def apply[A](ul: UserLogin[A]): LoginService[A] = ul match {          case Login(u,p) => Reader( cr => cr.matchPassword(u, p))        }      }    }    import UserLogin._    val loginScript = for {      b <- Login("Tiger","1234")    } yield b  }

这个例子里只有Login一个ADT，它的功能是把输入的User和Password与一个用户登录管理系统内的用户身份信息进行验证。由于如何进行用户密码验证不是这个ADT的功能，它可能涉及另一特殊功能系统的调用，刚好用来做个Reader依赖注入示范。以下是这项依赖定义：

object Dependencies {  trait PasswordControl {    type User = String    type Password = String    val pswdMap: Map[User, Password]    def matchPassword(u: User, p: Password): Boolean  }}

对loginScript进行测试运算时必须先获取PasswordControl实例，然后注入运算：

  import Dependencies._  import FreeUserLogin._  import UserLogin._  object Passwords extends PasswordControl {  //依赖实例     val pswdMap = Map (       "Tiger" -> "1234",       "John" -> "0332"     )     def matchPassword(u: User, p: Password) = pswdMap.getOrElse(u, p+"!") === p  }   val result = Free.runFC(loginScript)(LoginInterpreter).run(Passwords)  //注入依赖  println(result)

不过即使能够运行，loginScsript的功能明显不完整，还需要像Interact那样的互动部分来获取用户输入信息。那么我们是不是考虑在ADT层次上把Interact和UserLogin合并起来，像这样：

      case class Ask(prompt: String) extends Interact[String]      case class Tell(msg: String) extends Interact[Unit]      case class Login(user: String, pswd: String) extends Interact[Boolean]

明显这是可行的。但是，Interact和Login被紧紧捆绑在了一起形成了一个新的ADT。如果我们设计另一个同样需要互动的ADT，我们就需要重复同样的Interact功能设计，显然这样做违背了FP的原则：从功能单一的基本计算开始，按需要对基本函数进行组合实现更复杂的功能。Interact和UserLogin都是基础ADT，从编程语言角度描述Interact和UserLogin属于两种类型的编程语句。我们最终需要的AST是这样的：

  val interLogin: Free[???, A] = for {    user <- Ask("Enter User ID:")  //Free[Interact,A]    pswd <- Ask("Enter Password:") //Free[Interact,A]    ok <- Login(user,pswd) //Free[UserLogin,A]  } yield ok

不过明显类型对不上，因为Interact和UserLogin是两种语句。scalaz的Coproduct类型可以帮助我们实现两种Monadic语句的语义（sematics）合并。Coproduct是这样定义的：scalaz/Coproduct.scala

/** `F` on the left, and `G` on the right, of [[scalaz.\/]].  *  * @param run The underlying [[scalaz.\/]]. */final case class Coproduct[F[_], G[_], A](run: F[A] \/ G[A]) {  import Coproduct._  def map[B](f: A => B)(implicit F: Functor[F], G: Functor[G]): Coproduct[F, G, B] =    Coproduct(run.bimap(F.map(_)(f), G.map(_)(f)))...

从run:F[A]\/G[A]可以理解Coproduct是两种语句F,G的联合（union）。在我们上面的例子里我们可以用下面的表达方式代表Interact和UserLogin两种语句的联合（union）：

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

这是一个语义更广泛的类型：包含了Interact和UserLogin语义。我们可以用Inject类型来把Interact和UserLogin语句集“注入”到一个更大的句集。Inject是这样定义的：scalaz/Inject.scala

/** * Inject type class as described in "Data types a la carte" (Swierstra 2008). * * @see [[http://www.staff.science.uu.nl/~swier004/Publications/DataTypesALaCarte.pdf]] */sealed abstract class Inject[F[_], G[_]] {  def inj[A](fa: F[A]): G[A]  def prj[A](ga: G[A]): Option[F[A]]}sealed abstract class InjectInstances {  implicit def reflexiveInjectInstance[F[_]] =    new Inject[F, F] {      def inj[A](fa: F[A]) = fa      def prj[A](ga: F[A]) = some(ga)    }  implicit def leftInjectInstance[F[_], G[_]] =    new Inject[F, ({type λ[α] = Coproduct[F, G, α]})#λ] {      def inj[A](fa: F[A]) = Coproduct.leftc(fa)      def prj[A](ga: Coproduct[F, G, A]) = ga.run.fold(some(_), _ => none)    }  implicit def rightInjectInstance[F[_], G[_], H[_]](implicit I: Inject[F, G]) =      new Inject[F, ({type λ[α] = Coproduct[H, G, α]})#λ] {        def inj[A](fa: F[A]) = Coproduct.rightc(I.inj(fa))        def prj[A](ga: Coproduct[H, G, A]) = ga.run.fold(_ => none, I.prj(_))      }}...

实现函数inj(fa:F[A]):G[A]代表把F[A]并入G[A]。这里还提供了三个类型的实例：

1、reflexiceInjectInstance[F[_]]：自我注入

2、leftInjectInstance[F[_],G[_]]：把F[A]注入Coproduct[F,G,A]的left(-\/)

3、rightInjectInstance[F[_],G[_],H[_]]：把F[A]注入Coproduct的right（\/-）。需要先把F注入G（inj(F[A]):G[A]）

我们可以用implicitly来证明Interact和UserLogin的Inject实例存在：

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

现在我们需要把Coproduct[F,G,A]的F与G合并然后把F[A]升格成Free[G,A]:

  object coproduct {    def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))  }

我们可以用这个lift把Interact和UserLogin的ADT统一升格成Free[G,A]：

  object coproduct {    import FreeInteract._    import Interact._    import FreeUserLogin._    import UserLogin._    def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))    class Interacts[G[_]](implicit I: Inject[Interact,G]) {      def ask(prompt: String): Free.FreeC[G,String] = lift(Ask(prompt))      def tell(msg: String): Free.FreeC[G,Unit] = lift(Tell(msg))    }    class Logins[G[_]](implicit I: Inject[UserLogin,G]) {      def login(u: String, p: String): Free.FreeC[G,Boolean] = lift(Login(u,p))    }  }

我们用lift把基础Interact和UserLogin的语句注入了联合的语句集G[A]，然后升格成FreeC[G,A]。现在我们可以把Interact,UserLogin这两种语句用在同一个for-comprehension里了：

  def loginScript[G[_]](implicit I: Interacts[G], L: Logins[G]) ={    import I._    import L._    for {      uid <- ask("ya id?")      pwd <- ask("password?")      login <- login(uid,pwd)      _ <- if (login) tell("ya lucky bastard!") else tell("geda fk outa here!")    } yield()  }

有了Inject和Lift，现在已经成功的用两种ADT集成了一个AST。不过我们还必须提供Interacts[G]和Logins[G]实例：

object CoproductModules {  object CoproductFunctions {    import FreeInteract._    import Interact._    import FreeUserLogin._    import UserLogin._    def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))    class Interacts[G[_]](implicit I: Inject[Interact,G]) {      def ask(prompt: String): Free.FreeC[G,String] = lift(Ask(prompt))      def tell(msg: String): Free.FreeC[G,Unit] = lift(Tell(msg))    }    object Interacts {      implicit def instance[G[_]](implicit I: Inject[Interact,G]) = new Interacts[G]    }    class Logins[G[_]](implicit I: Inject[UserLogin,G]) {      def login(u: String, p: String): Free.FreeC[G,Boolean] = lift(Login(u,p))    }    object Logins {      implicit def instance[G[_]](implicit I: Inject[UserLogin,G]) = new Logins[G]    }  }

现在我们的语句集（AST）是一个联合的语句集（Coproduct）。那么，我们应该怎么去运算它呢？我们应该如何实现它的Interpreter？现在我们面对的Monadic程序类型是个Coproduct：

  type InteractLogin[A] = Coproduct[Interact,UserLogin,A]  val loginPrg = loginScript[InteractLogin]

现在语句集Interact和UserLogin是分别放在Coproduce的左右两边。那么我们可以历遍这个Coproduct来分别运算Interact和UserLogin语句：

  def or[F[_],G[_],H[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =    new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {    def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {      case -\/(fa) => fg(fa)      case \/-(ha) => hg(ha)    }  }

值得注意的是如果or函数用在Interact和UserLogin上时它们自然转换（NaturalTransformation）的目标类型必须一致，应该是一个更大的类型，而且必须是Monad，这是NaturalTransformation的要求。所以我们可以把InteractInterpreter的转换目标类型由Id变成Reader，也就是LoginInterpreter的转换目标类型：

  object InteractReader extends (Interact ~> LoginService) {    def apply[A](ia: Interact[A]): LoginService[A] = ia match {    case Ask(p) => println(p);  Reader(cr => readLine)    case Tell(m) => println(m); Reader(cr => ())   }  }

好了，现在我们可以这样来测试运算：

object freePrgDemo extends App {  import FreeModules._  import FreeInteract._  import Interact._  //Free.runFC(interactScript)(InteractConsole)   //val result = Free.runFC(interactScript)(InteractTesterMap).apply( /* val result = Free.runFC(interactScript)(InteractTesterWriter).run(    Map(    "What's your first name?" -> "tiger",    "What's your last name?" -> "chan"  ))   println(result)  */  import Dependencies._  import FreeUserLogin._  import UserLogin._    object Passwords extends PasswordControl {     val pswdMap = Map (       "Tiger" -> "1234",       "John" -> "0332"     )     def matchPassword(u: User, p: Password) = pswdMap.getOrElse(u, p+"!") === p  }   /*  val result = Free.runFC(loginScript)(LoginInterpreter).run(Passwords)  println(result)  */    import CoproductDemo._  Free.runFC(loginPrg)(or(InteractReader,LoginInterpreter)).run(Passwords)}

我们把密码管理依赖也注入进去了。看看结果：

ya id?Tigerpassword?2012geda fk outa here!ya id?Tigerpassword?1234ya lucky bastard!ya id?Johnpassword?0332ya lucky bastard!

OK, 把这节示范源代码提供在下面：

package demosimport scalaz._import Scalaz._import scala.language.higherKinds import scala.language.implicitConversionsobject FreeModules {  object FreeInteract {    trait Interact[+A]    type FreeInteract[A] = Free.FreeC[Interact,A]    object Interact {      case class Ask(prompt: String) extends Interact[String]      case class Tell(msg: String) extends Interact[Unit]      implicit def interactToFreeC[A](ia: Interact[A]) = Free.liftFC(ia)      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)        }      }            type InteractMapTester[A] = Map[String,String] => (List[String], A)      implicit val mapTesterMonad = new Monad[InteractMapTester] {         def point[A](a: => A) = _ => (List(), a)         def bind[A,B](ia: InteractMapTester[A])(f: A => InteractMapTester[B]): InteractMapTester[B] =           m => {             val (o1,a1) = ia(m)             val (o2,a2) = f(a1)(m)             (o1 ++ o2, a2)           }      }      object InteractTesterMap extends (Interact ~> InteractMapTester) {        def apply[A](ia: Interact[A]): InteractMapTester[A] = ia match {          case Ask(p) => { m => (List(), m(p)) } //m(p)返回提问对应的答案作为键盘输入          case Tell(s) => { m => (List(s), ()) } //List(s)在bind函数中的o1++o2形成跟踪记录                                                 //在运算AST时会用到InteractMapTester的bind        }      }      type WriterTF[A] = Map[String,String] => A      type InteractWriterTester[A] = WriterT[WriterTF,List[String],A]      def testerToWriter[A](f: Map[String,String] => (List[String], A)) =         WriterT[WriterTF,List[String],A](f)      implicit val writerTesterMonad = WriterT.writerTMonad[WriterTF, List[String]]      object InteractTesterWriter extends (Interact ~> InteractWriterTester) {        def apply[A](ia: Interact[A]): InteractWriterTester[A] = ia match {          case Ask(p) => testerToWriter { m => (List(), m(p)) }          case Tell(s) => testerToWriter { m => (List(s), ())}        }      }    }    import Interact._    val interactScript = for {      first <- Ask("What's your first name?")      last <- Ask("What's your last name?")      _ <- Tell(s"Hello ${first} ${last}, nice to meet you!")    } yield ()  }  object FreeUserLogin {      import Dependencies._    trait UserLogin[+A]    type FreeUserLogin[A] = Free.FreeC[UserLogin,A]    object UserLogin {      case class Login(user: String, pswd: String) extends UserLogin[Boolean]      implicit def loginToFree[A](ul: UserLogin[A]) = Free.liftFC(ul)      type LoginService[A] = Reader[PasswordControl,A]      object LoginInterpreter extends (UserLogin ~> LoginService) {        def apply[A](ul: UserLogin[A]): LoginService[A] = ul match {          case Login(u,p) => Reader( cr => cr.matchPassword(u, p))        }      }    }    import UserLogin._    val loginScript = for {      b <- Login("Tiger","1234")    } yield b  }}object Dependencies {  trait PasswordControl {    type User = String    type Password = String    val pswdMap: Map[User, Password]    def matchPassword(u: User, p: Password): Boolean  }}object CoproductDemo {  import FreeModules._  import FreeUserLogin._  import UserLogin._  import FreeInteract._  import Interact._  import Dependencies._  def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))  class Interacts[G[_]](implicit I: Inject[Interact,G]) {    def ask(prompt: String) = lift(Ask(prompt))    def tell(msg: String) = lift(Tell(msg))  }  object Interacts {    implicit def instance[F[_]](implicit I: Inject[Interact,F]) = new Interacts[F]  }  class Logins[G[_]](implicit I: Inject[UserLogin,G]) {    def login(user: String, pswd: String) = lift(Login(user,pswd))  }  object Logins {    implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F]  }  def loginScript[G[_]](implicit I: Interacts[G], L: Logins[G]) ={    import I._    import L._    for {      uid <- ask("ya id?")      pwd <- ask("password?")      login <- login(uid,pwd)      _ <- if (login) tell("ya lucky bastard!") else tell("geda fk outa here!")    } yield()  }    def or[F[_],G[_],H[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =    new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {    def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {      case -\/(fa) => fg(fa)      case \/-(ha) => hg(ha)    }  }   type InteractLogin[A] = Coproduct[Interact,UserLogin,A]  val loginPrg = loginScript[InteractLogin]  object InteractReader extends (Interact ~> LoginService) {    def apply[A](ia: Interact[A]): LoginService[A] = ia match {    case Ask(p) => println(p);  Reader(cr => readLine)    case Tell(m) => println(m); Reader(cr => ())   }  }       }object freePrgDemo extends App {  import FreeModules._  import FreeInteract._  import Interact._  //Free.runFC(interactScript)(InteractConsole)   //val result = Free.runFC(interactScript)(InteractTesterMap).apply( /* val result = Free.runFC(interactScript)(InteractTesterWriter).run(    Map(    "What's your first name?" -> "tiger",    "What's your last name?" -> "chan"  ))   println(result)  */  import Dependencies._  import FreeUserLogin._  import UserLogin._    object Passwords extends PasswordControl {     val pswdMap = Map (       "Tiger" -> "1234",       "John" -> "0332"     )     def matchPassword(u: User, p: Password) = pswdMap.getOrElse(u, p+"!") === p  }   /*  val result = Free.runFC(loginScript)(LoginInterpreter).run(Passwords)  println(result)  */    import CoproductDemo._  Free.runFC(loginPrg)(or(InteractReader,LoginInterpreter)).run(Passwords)}

0 0