很多函数式编程爱好者都把FP称为Monadic Programming,意思是用Monad进行编程。我想FP作为一种比较成熟的编程模式,应该有一套比较规范的操作模式吧。因为Free能把任何F[A]升格成Monad,所以Free的算式(AST)、算法(Interpreter)关注分离(separation of concern)模式应该可以成为一种规范的FP编程模式。我们在前面的几篇讨论中都涉及了一些AST的设计和运算,但都是一些功能单一,离散的例子。如果希望通过Free获取一个完整可用的程序,就必须想办法把离散的Free AST组合成一体运算。我们先从单一的Free AST例子开始:
1 import scalaz._
2 import Scalaz._
3 import scala.language.higherKinds
4 import scala.language.implicitConversions
5 object FreeModules {
6 object FreeInteract {
7 trait Interact[+A]
8 type FreeInteract[A] = Free.FreeC[Interact,A]
9 object Interact {
10 case class Ask(prompt: String) extends Interact[String]
11 case class Tell(msg: String) extends Interact[Unit]
12 implicit def interactToFreeC[A](ia: Interact[A]) = Free.liftFC(ia)
13 object InteractConsole extends (Interact ~> Id) {
14 def apply[A](ia: Interact[A]): Id[A] = ia match {
15 case Ask(p) => println(p); readLine
16 case Tell(m) => println(m)
17 }
18 }
19 }
20 import Interact._
21 val interactScript = for {
22 first <- Ask("What's your first name?")
23 last <- Ask("What's your last name?")
24 _ <- Tell(s"Hello ${first} ${last}, nice to meet you!")
25 } yield ()
26 }
27 }
这是一个我们在前面讨论中重复描述几次的简单交互例子,包括了ADT、AST和Interpreter。我们可以直接运行这个程序:
1 object freePrgDemo extends App {
2 import FreeModules._
3 import FreeInteract._
4 import Interact._
5 Free.runFC(interactScript)(InteractConsole)
6 }
运算结果如下:
1 What's your first name?
2 Tiger
3 What's your last name?
4 Chan
5 Hello Tiger Chan, nice to meet you!
就是简单的两句界面提示和键盘输入,然后提示输入结果,没什么意义。作为测试,我们也可以模拟Console交互:用Map[String,String]来模拟Map[提问,回答],然后把这个Map提供给Interpreter,返回结果(List[String],A),其中List[String]是运行跟踪记录,A是模拟的键盘输入:
1 object FreeUserLogin {
2 import Dependencies._
3 trait UserLogin[+A]
4 type FreeUserLogin[A] = Free.FreeC[UserLogin,A]
5 object UserLogin {
6 case class Login(user: String, pswd: String) extends UserLogin[Boolean]
7 implicit def loginToFree[A](ul: UserLogin[A]) = Free.liftFC(ul)
8 type LoginService[A] = Reader[PasswordControl,A]
9 object LoginInterpreter extends (UserLogin ~> LoginService) {
10 def apply[A](ul: UserLogin[A]): LoginService[A] = ul match {
11 case Login(u,p) => Reader( cr => cr.matchPassword(u, p))
12 }
13 }
14 }
15 import UserLogin._
16 val loginScript = for {
17 b <- Login("Tiger","1234")
18 } yield b
19 }
这个例子里只有Login一个ADT,它的功能是把输入的User和Password与一个用户登录管理系统内的用户身份信息进行验证。由于如何进行用户密码验证不是这个ADT的功能,它可能涉及另一特殊功能系统的调用,刚好用来做个Reader依赖注入示范。以下是这项依赖定义:
1 object Dependencies {
2 trait PasswordControl {
3 type User = String
4 type Password = String
5 val pswdMap: Map[User, Password]
6 def matchPassword(u: User, p: Password): Boolean
7 }
8 }
对loginScript进行测试运算时必须先获取PasswordControl实例,然后注入运算:
1 import Dependencies._
2 import FreeUserLogin._
3 import UserLogin._
4 object Passwords extends PasswordControl { //依赖实例
5 val pswdMap = Map (
6 "Tiger" -> "1234",
7 "John" -> "0332"
8 )
9 def matchPassword(u: User, p: Password) = pswdMap.getOrElse(u, p+"!") === p
10 }
11 val result = Free.runFC(loginScript)(LoginInterpreter).run(Passwords) //注入依赖
12 println(result)
不过即使能够运行,loginScsript的功能明显不完整,还需要像Interact那样的互动部分来获取用户输入信息。那么我们是不是考虑在ADT层次上把Interact和UserLogin合并起来,像这样:
1 case class Ask(prompt: String) extends Interact[String]
2 case class Tell(msg: String) extends Interact[Unit]
3 case class Login(user: String, pswd: String) extends Interact[Boolean]
明显这是可行的。但是,Interact和Login被紧紧捆绑在了一起形成了一个新的ADT。如果我们设计另一个同样需要互动的ADT,我们就需要重复同样的Interact功能设计,显然这样做违背了FP的原则:从功能单一的基本计算开始,按需要对基本函数进行组合实现更复杂的功能。Interact和UserLogin都是基础ADT,从编程语言角度描述Interact和UserLogin属于两种类型的编程语句。我们最终需要的AST是这样的:
1 val interLogin: Free[???, A] = for {
2 user <- Ask("Enter User ID:") //Free[Interact,A]
3 pswd <- Ask("Enter Password:") //Free[Interact,A]
4 ok <- Login(user,pswd) //Free[UserLogin,A]
5 } 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):
1 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实例存在:
1 val selfInj = implicitly[Inject[Interact,Interact]]
2 type LeftInterLogin[A] = Coproduct[Interact,UserLogin,A]
3 val leftInj = implicitly[Inject[Interact,LeftInterLogin]]
4 type RightInterLogin[A] = Coproduct[UserLogin,LeftInterLogin,A]
5 val rightInj = implicitly[Inject[Interact,RightInterLogin]]
现在我们需要把Coproduct[F,G,A]的F与G合并然后把F[A]升格成Free[G,A]:
1 object coproduct {
2 def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))
3 }
我们可以用这个lift把Interact和UserLogin的ADT统一升格成Free[G,A]:
1 object coproduct {
2 import FreeInteract._
3 import Interact._
4 import FreeUserLogin._
5 import UserLogin._
6 def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))
7 class Interacts[G[_]](implicit I: Inject[Interact,G]) {
8 def ask(prompt: String): Free.FreeC[G,String] = lift(Ask(prompt))
9 def tell(msg: String): Free.FreeC[G,Unit] = lift(Tell(msg))
10 }
11 class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
12 def login(u: String, p: String): Free.FreeC[G,Boolean] = lift(Login(u,p))
13 }
14 }
我们用lift把基础Interact和UserLogin的语句注入了联合的语句集G[A],然后升格成FreeC[G,A]。现在我们可以把Interact,UserLogin这两种语句用在同一个for-comprehension里了:
1 def loginScript[G[_]](implicit I: Interacts[G], L: Logins[G]) ={
2 import I._
3 import L._
4 for {
5 uid <- ask("ya id?")
6 pwd <- ask("password?")
7 login <- login(uid,pwd)
8 _ <- if (login) tell("ya lucky bastard!") else tell("geda fk outa here!")
9 } yield()
10 }
有了Inject和Lift,现在已经成功的用两种ADT集成了一个AST。不过我们还必须提供Interacts[G]和Logins[G]实例:
1 object CoproductModules {
2 object CoproductFunctions {
3 import FreeInteract._
4 import Interact._
5 import FreeUserLogin._
6 import UserLogin._
7 def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))
8 class Interacts[G[_]](implicit I: Inject[Interact,G]) {
9 def ask(prompt: String): Free.FreeC[G,String] = lift(Ask(prompt))
10 def tell(msg: String): Free.FreeC[G,Unit] = lift(Tell(msg))
11 }
12 object Interacts {
13 implicit def instance[G[_]](implicit I: Inject[Interact,G]) = new Interacts[G]
14 }
15 class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
16 def login(u: String, p: String): Free.FreeC[G,Boolean] = lift(Login(u,p))
17 }
18 object Logins {
19 implicit def instance[G[_]](implicit I: Inject[UserLogin,G]) = new Logins[G]
20 }
21 }
现在我们的语句集(AST)是一个联合的语句集(Coproduct)。那么,我们应该怎么去运算它呢?我们应该如何实现它的Interpreter?现在我们面对的Monadic程序类型是个Coproduct:
1 type InteractLogin[A] = Coproduct[Interact,UserLogin,A]
2 val loginPrg = loginScript[InteractLogin]
现在语句集Interact和UserLogin是分别放在Coproduce的左右两边。那么我们可以历遍这个Coproduct来分别运算Interact和UserLogin语句:
1 def or[F[_],G[_],H[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
2 new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
3 def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
4 case -\/(fa) => fg(fa)
5 case \/-(ha) => hg(ha)
6 }
7 }
值得注意的是如果or函数用在Interact和UserLogin上时它们自然转换(NaturalTransformation)的目标类型必须一致,应该是一个更大的类型,而且必须是Monad,这是NaturalTransformation的要求。所以我们可以把InteractInterpreter的转换目标类型由Id变成Reader,也就是LoginInterpreter的转换目标类型:
1 object InteractReader extends (Interact ~> LoginService) {
2 def apply[A](ia: Interact[A]): LoginService[A] = ia match {
3 case Ask(p) => println(p); Reader(cr => readLine)
4 case Tell(m) => println(m); Reader(cr => ())
5 }
6 }
好了,现在我们可以这样来测试运算:
1 object freePrgDemo extends App {
2 import FreeModules._
3 import FreeInteract._
4 import Interact._
5 //Free.runFC(interactScript)(InteractConsole)
6 //val result = Free.runFC(interactScript)(InteractTesterMap).apply(
7 /* val result = Free.runFC(interactScript)(InteractTesterWriter).run(
8 Map(
9 "What's your first name?" -> "tiger",
10 "What's your last name?" -> "chan"
11 ))
12 println(result)
13 */
14 import Dependencies._
15 import FreeUserLogin._
16 import UserLogin._
17
18 object Passwords extends PasswordControl {
19 val pswdMap = Map (
20 "Tiger" -> "1234",
21 "John" -> "0332"
22 )
23 def matchPassword(u: User, p: Password) = pswdMap.getOrElse(u, p+"!") === p
24 }
25 /*
26 val result = Free.runFC(loginScript)(LoginInterpreter).run(Passwords)
27 println(result)
28 */
29
30 import CoproductDemo._
31 Free.runFC(loginPrg)(or(InteractReader,LoginInterpreter)).run(Passwords)
32 }
我们把密码管理依赖也注入进去了。看看结果:
1 ya id?
2 Tiger
3 password?
4 2012
5 geda fk outa here!
6
7 ya id?
8 Tiger
9 password?
10 1234
11 ya lucky bastard!
12
13 ya id?
14 John
15 password?
16 0332
17 ya lucky bastard!
OK, 把这节示范源代码提供在下面:
1 package demos
2 import scalaz._
3 import Scalaz._
4 import scala.language.higherKinds
5 import scala.language.implicitConversions
6 object FreeModules {
7 object FreeInteract {
8 trait Interact[+A]
9 type FreeInteract[A] = Free.FreeC[Interact,A]
10 object Interact {
11 case class Ask(prompt: String) extends Interact[String]
12 case class Tell(msg: String) extends Interact[Unit]
13 implicit def interactToFreeC[A](ia: Interact[A]) = Free.liftFC(ia)
14 object InteractConsole extends (Interact ~> Id) {
15 def apply[A](ia: Interact[A]): Id[A] = ia match {
16 case Ask(p) => println(p); readLine
17 case Tell(m) => println(m)
18 }
19 }
20 type InteractMapTester[A] = Map[String,String] => (List[String], A)
21 implicit val mapTesterMonad = new Monad[InteractMapTester] {
22 def point[A](a: => A) = _ => (List(), a)
23 def bind[A,B](ia: InteractMapTester[A])(f: A => InteractMapTester[B]): InteractMapTester[B] =
24 m => {
25 val (o1,a1) = ia(m)
26 val (o2,a2) = f(a1)(m)
27 (o1 ++ o2, a2)
28 }
29 }
30 object InteractTesterMap extends (Interact ~> InteractMapTester) {
31 def apply[A](ia: Interact[A]): InteractMapTester[A] = ia match {
32 case Ask(p) => { m => (List(), m(p)) } //m(p)返回提问对应的答案作为键盘输入
33 case Tell(s) => { m => (List(s), ()) } //List(s)在bind函数中的o1++o2形成跟踪记录
34 //在运算AST时会用到InteractMapTester的bind
35 }
36 }
37 type WriterTF[A] = Map[String,String] => A
38 type InteractWriterTester[A] = WriterT[WriterTF,List[String],A]
39 def testerToWriter[A](f: Map[String,String] => (List[String], A)) =
40 WriterT[WriterTF,List[String],A](f)
41 implicit val writerTesterMonad = WriterT.writerTMonad[WriterTF, List[String]]
42 object InteractTesterWriter extends (Interact ~> InteractWriterTester) {
43 def apply[A](ia: Interact[A]): InteractWriterTester[A] = ia match {
44 case Ask(p) => testerToWriter { m => (List(), m(p)) }
45 case Tell(s) => testerToWriter { m => (List(s), ())}
46 }
47 }
48 }
49 import Interact._
50 val interactScript = for {
51 first <- Ask("What's your first name?")
52 last <- Ask("What's your last name?")
53 _ <- Tell(s"Hello ${first} ${last}, nice to meet you!")
54 } yield ()
55 }
56 object FreeUserLogin {
57 import Dependencies._
58 trait UserLogin[+A]
59 type FreeUserLogin[A] = Free.FreeC[UserLogin,A]
60 object UserLogin {
61 case class Login(user: String, pswd: String) extends UserLogin[Boolean]
62 implicit def loginToFree[A](ul: UserLogin[A]) = Free.liftFC(ul)
63 type LoginService[A] = Reader[PasswordControl,A]
64 object LoginInterpreter extends (UserLogin ~> LoginService) {
65 def apply[A](ul: UserLogin[A]): LoginService[A] = ul match {
66 case Login(u,p) => Reader( cr => cr.matchPassword(u, p))
67 }
68 }
69 }
70 import UserLogin._
71 val loginScript = for {
72 b <- Login("Tiger","1234")
73 } yield b
74 }
75 }
76 object Dependencies {
77 trait PasswordControl {
78 type User = String
79 type Password = String
80 val pswdMap: Map[User, Password]
81 def matchPassword(u: User, p: Password): Boolean
82 }
83 }
84 object CoproductDemo {
85 import FreeModules._
86 import FreeUserLogin._
87 import UserLogin._
88 import FreeInteract._
89 import Interact._
90 import Dependencies._
91 def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))
92 class Interacts[G[_]](implicit I: Inject[Interact,G]) {
93 def ask(prompt: String) = lift(Ask(prompt))
94 def tell(msg: String) = lift(Tell(msg))
95 }
96 object Interacts {
97 implicit def instance[F[_]](implicit I: Inject[Interact,F]) = new Interacts[F]
98 }
99 class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
100 def login(user: String, pswd: String) = lift(Login(user,pswd))
101 }
102 object Logins {
103 implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F]
104 }
105 def loginScript[G[_]](implicit I: Interacts[G], L: Logins[G]) ={
106 import I._
107 import L._
108 for {
109 uid <- ask("ya id?")
110 pwd <- ask("password?")
111 login <- login(uid,pwd)
112 _ <- if (login) tell("ya lucky bastard!") else tell("geda fk outa here!")
113 } yield()
114 }
115
116 def or[F[_],G[_],H[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
117 new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
118 def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
119 case -\/(fa) => fg(fa)
120 case \/-(ha) => hg(ha)
121 }
122 }
123
124 type InteractLogin[A] = Coproduct[Interact,UserLogin,A]
125 val loginPrg = loginScript[InteractLogin]
126 object InteractReader extends (Interact ~> LoginService) {
127 def apply[A](ia: Interact[A]): LoginService[A] = ia match {
128 case Ask(p) => println(p); Reader(cr => readLine)
129 case Tell(m) => println(m); Reader(cr => ())
130 }
131 }
132
133 }
134
135 object freePrgDemo extends App {
136 import FreeModules._
137 import FreeInteract._
138 import Interact._
139 //Free.runFC(interactScript)(InteractConsole)
140 //val result = Free.runFC(interactScript)(InteractTesterMap).apply(
141 /* val result = Free.runFC(interactScript)(InteractTesterWriter).run(
142 Map(
143 "What's your first name?" -> "tiger",
144 "What's your last name?" -> "chan"
145 ))
146 println(result)
147 */
148 import Dependencies._
149 import FreeUserLogin._
150 import UserLogin._
151
152 object Passwords extends PasswordControl {
153 val pswdMap = Map (
154 "Tiger" -> "1234",
155 "John" -> "0332"
156 )
157 def matchPassword(u: User, p: Password) = pswdMap.getOrElse(u, p+"!") === p
158 }
159 /*
160 val result = Free.runFC(loginScript)(LoginInterpreter).run(Passwords)
161 println(result)
162 */
163
164 import CoproductDemo._
165 Free.runFC(loginPrg)(or(InteractReader,LoginInterpreter)).run(Passwords)
166 }