一直感觉FP比较虚，可能太多学术性的东西，不知道如何把这些由数学理论在背后支持的一套全新数据类型和数据结构在现实开发中加以使用。直到Free Monad，才真正感觉能用FP方式进行编程了。在前面我们已经花了不小篇幅来了解Free Monad，这次我想跟大家讨论一下用Free Monad来编写一个真正能运行的完整应用程序。当然，这个程序必须具备FP特性，比如函数组合（function composition）,纯代码（pure code），延迟副作用（delayed side effect）等等。我们这次模拟的一个应用场景是这样的：模拟一个计算器程序，用户先用密码登录；然后选择操作，包括加、减、乘、除；系统验证用户的操作权限；输入第一个数字，输入另一个数字，系统给出计算结果。程序在用户通过了密码登录后循环运行。我们先把程序要求里的一些操作语句集罗列出来：
1、人机交互，Interact
2、用户登录，Login
3、权限控制，Permission
4、算术运算，Calculator
这其中Login,Permission,Calculator都必须与Interact组合使用，因为它们都需要交互式人工输入。这次我们把讨论流程反过来：先把这个程序完整的算式（Algebraic Data Tree）、算法（Interpreter）以及依赖注入、运算、结果等等先摆出来，然后再逐段分析说明：
1 package run.demo
2 import scalaz._
3 import Scalaz._
4 import scala.language.higherKinds
5 import scala.language.implicitConversions
6 import run.demo.Modules.FreeCalculator.CalcInterp
7
8 object Modules {
9 object FreeInteract {
10 trait Interact[+NextAct]
11 object Interact {
12 case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct]
13 case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct]
14 implicit object interactFunctor extends Functor[Interact] {
15 def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
16 case Ask(p,onInput) => Ask(p, onInput andThen f)
17 case Tell(m,n) => Tell(m, f(n))
18 }
19 }
20 }
21 import Interact._
22 object InteractConsole extends (Interact ~> Id) {
23 def apply[A](ia: Interact[A]): Id[A] = ia match {
24 case Ask(p,onInput) => println(p); onInput(readLine)
25 case Tell(m, n) => println(m); n
26 }
27 }
28 import FreeLogin._
29 object InteractLogin extends (Interact ~> PasswordReader) {
30 def apply[A](ia: Interact[A]): PasswordReader[A] = ia match {
31 case Ask(p,onInput) => println(p); Reader(m => onInput(readLine))
32 case Tell(m, n) => println(m); Reader(m => n)
33 }
34 }
35 import FreePermission._
36 object InteractPermission extends(Interact ~> PermissionReader) {
37 def apply[A](ia: Interact[A]): PermissionReader[A] = ia match {
38 case Ask(p,onInput) => println(p);Reader(m => onInput(readLine))
39 case Tell(m,n) => println(m); Reader(m => n)
40 }
41 }
42 }
43 object FreeLogin {
44 trait UserLogin[+A]
45 object UserLogin {
46 case class Login(uid: String, pswd: String) extends UserLogin[Boolean]
47 }
48 import UserLogin._
49 import Dependencies._
50 type PasswordReader[A] = Reader[PasswordControl, A]
51 object LoginInterp extends (UserLogin ~> PasswordReader) {
52 def apply[A](la: UserLogin[A]): PasswordReader[A] = la match {
53 case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd))
54 }
55 }
56 }
57 object FreePermission {
58 trait Permission[+A]
59 object Permission {
60 case class HasPermission(uid: String, opr: String) extends Permission[Boolean]
61 }
62 import Dependencies._
63 import Permission._
64 type PermissionReader[A] = Reader[PermissionControl,A]
65 object PermissionInterp extends (Permission ~> PermissionReader) {
66 def apply[A](pa: Permission[A]): PermissionReader[A] = pa match {
67 case HasPermission(uid,opr) => Reader {m => m.matchPermission(uid, opr)}
68 }
69 }
70 }
71 object FreeCalculator {
72 trait Calculator[+A]
73 object Calculator {
74 case class Calc(opr: String, lop: Int, rop: Int) extends Calculator[Int]
75 }
76 import Calculator._
77 object CalcInterp extends (Calculator ~> Id) {
78 def apply[A](ca: Calculator[A]): Id[A] = ca match {
79 case Calc(opr,op1,op2) => opr.toUpperCase match {
80 case "ADD" => op1 + op2
81 case "SUB" => op1 - op2
82 case "MUL" => op1 * op2
83 case "DIV" => op1 / op2
84 }
85 }
86 }
87 }
88 object FreeFunctions {
89 import FreeInteract._
90 import Interact._
91 import FreeLogin._
92 import UserLogin._
93 import FreePermission._
94 import Permission._
95 import FreeCalculator._
96 import Calculator._
97 def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] =
98 Free.liftFC(I.inj(fa))
99 class Interacts[G[_]](implicit I: Inject[Interact,G]) {
100 def ask[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput)))
101 def tell[A](msg: String) = Free.liftFC(I.inj(Tell(msg, ())))
102 }
103 object Interacts {
104 implicit def instance[F[_]](implicit I: Inject[Interact,F]) = new Interacts[F]
105 }
106 class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
107 def login(uid: String, pswd: String) = lift(Login(uid,pswd))
108 }
109 object Logins {
110 implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F]
111 }
112 class Permissions[G[_]](implicit I: Inject[Permission,G]) {
113 def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr))
114 }
115 object Permissions {
116 implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F]
117 }
118 class Calculators[G[_]](implicit I: Inject[Calculator,G]) {
119 def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2))
120 }
121 object Calculators {
122 implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F]
123 }
124 def or[F[_],H[_],G[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
125 new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
126 def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
127 case -/(x) => fg(x)
128 case /-(y) => hg(y)
129 }
130 }
131 }
132 object FreeProgs {
133 import FreeFunctions._
134 import FreeInteract._
135 import FreeLogin._
136 import FreePermission._
137 import FreeCalculator._
138 def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l]
139 def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = {
140 import I._
141 import L._
142 for {
143 uid <- ask("ya id:",identity)
144 pwd <- ask("password:",identity)
145 login <- login(uid,pwd)
146 _ <- if (login) tell("ya in, ya lucky bastard!")
147 else tell("geta fk outa here!")
148 usr <- if (login) freeCMonad[F].point(uid)
149 else freeCMonad[F].point("???")
150 } yield usr
151 }
152 def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = {
153 import I._
154 import P._
155 for {
156 inp <- ask("votiu vangto do?",identity)
157 cando <- hasPermission(uid,inp)
158 _ <- if (cando) tell("ok, go on ...")
159 else tell("na na na, cant do that!")
160 opr <- if (cando) freeCMonad[F].point(inp)
161 else freeCMonad[F].point("XXX")
162 } yield opr
163
164 }
165
166 def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = {
167 import I._;import C._;
168 for {
169 op1 <- ask("fus num:", _.toInt)
170 op2 <- ask("nx num:", _.toInt)
171 result <- calc(opr,op1,op2)
172 } yield result
173 }
174
175 type LoginScript[A] = Coproduct[Interact, UserLogin, A]
176 type CalcScript[A] = Coproduct[Interact, Calculator, A]
177 type AccessScript[A] = Coproduct[Interact, Permission, A]
178 val accessPrg = accessScript[AccessScript] _
179 val loginPrg = loginScript[LoginScript]
180 val calcPrg = calcScript[CalcScript] _
181 }
182 }
183 object Dependencies {
184 trait PasswordControl {
185 val pswdMap: Map[String,String]
186 def matchPassword(uid: String, pswd: String): Boolean
187 }
188 trait PermissionControl {
189 val permMap: Map[String,List[String]]
190 def matchPermission(uid: String, operation: String): Boolean
191 }
192 }
193 object FreeProgram extends App {
194 import Modules._
195 import FreeInteract._
196 import FreeLogin._
197 import FreePermission._
198 import FreeFunctions._
199 import FreeProgs._
200 import Dependencies._
201 object Passwords extends PasswordControl {
202 val pswdMap = Map (
203 "Tiger" -> "1234",
204 "John" -> "0332"
205 )
206 def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd
207 }
208 object AccessRights extends PermissionControl {
209 val permMap = Map (
210 "Tiger" -> List("Add","Sub"),
211 "John" -> List("Mul","Div")
212 )
213 def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr}
214 }
215
216 val uid = Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords)
217 val opr = Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).run(AccessRights)
218 val sum = Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp))
219 println(uid)
220 println(opr)
221 println(sum)
222 }
223 //测试运算结果
224 ya id:
225 Tiger
226 password:
227 1234
228 ya in, ya lucky bastard!
229 votiu vangto do?
230 Add
231 ok, go on ...
232 fus num:
233 3
234 nx num:
235 7
236 Tiger
237 Add
238 10
看起来好像费了老大劲就做那么点事。但如果我们按照Free Monadic编程的规范来做，一切仅仅有条无需多想，那也就是那么点事。实际上在编写更大型更复杂的程序时应该会觉着思路更清晰，代码量会更精简，因为成功的函数组合可以避免许多重复代码。基本的Free Monadic 编程步骤大体如下：
1、ADT design
2、ADT Free lifting
3、ADT composition、AST composition
4、Dependency design
5、Interpreter design
6、Running and dependency injection
1、ADTs: 按照功能要求设计编程语句。其中值得注意的是Interact：
1 trait Interact[+NextAct]
2 object Interact {
3 case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct]
4 case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct]
5 implicit object interactFunctor extends Functor[Interact] {
6 def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
7 case Ask(p,onInput) => Ask(p, onInput andThen f)
8 case Tell(m,n) => Tell(m, f(n))
9 }
10 }
11 }
12
Interact能够支持map，必须是个Functor。这是因为其中一个状态Ask需要对输入String进行转换后进入下一个状态。
2、升格lifting：我们需要把这些ADT都升格成Free。因为有些ADT不是Functor，所以用liftFC把它们统一升格为FreeC:
1 object FreeFunctions {
2 import FreeInteract._
3 import Interact._
4 import FreeLogin._
5 import UserLogin._
6 import FreePermission._
7 import Permission._
8 import FreeCalculator._
9 import Calculator._
10 def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] =
11 Free.liftFC(I.inj(fa))
12 class Interacts[G[_]](implicit I: Inject[Interact,G]) {
13 def ask[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput)))
14 def tell[A](msg: String) = Free.liftFC(I.inj(Tell(msg, ())))
15 }
16 object Interacts {
17 implicit def instance[F[_]](implicit I: Inject[Interact,F]) = new Interacts[F]
18 }
19 class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
20 def login(uid: String, pswd: String) = lift(Login(uid,pswd))
21 }
22 object Logins {
23 implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F]
24 }
25 class Permissions[G[_]](implicit I: Inject[Permission,G]) {
26 def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr))
27 }
28 object Permissions {
29 implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F]
30 }
31 class Calculators[G[_]](implicit I: Inject[Calculator,G]) {
32 def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2))
33 }
34 object Calculators {
35 implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F]
36 }
37 def or[F[_],H[_],G[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
38 new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
39 def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
40 case -/(x) => fg(x)
41 case /-(y) => hg(y)
42 }
43 }
44 }
在lift函数中使用了scalaz提供的Inject类型实例，用来把F[A]这种类型转换成G[A]。可以理解为把一组语句F[A]注入更大的语句集G[A]（G[A]可以是F[A]，这时转换结果为一摸一样的语句集）。可能因为Interact和其它ADT不同，是个Functor，所以在调用lift函数进行升格时compiler会产生错误类型推导结果，直接调用liftFC可以解决问题，这个留到以后继续研究。现在这些升格了的语句集都具备了隐式实例implicit instance，随时可以在隐式解析域内提供操作语句支持。
3、ASTs：现在有了这些基础语句集，按照功能要求，我们可以用某一种语句组合成一个程序AST，或者结合用两种以上语句组合程序，甚至把产生的AST组合成更大的程序。我们可以用scalaz的Coproduct来实现这些语句集的联合：
1 type LoginScript[A] = Coproduct[Interact, UserLogin, A]
2 type CalcScript[A] = Coproduct[Interact, Calculator, A]
3 type AccessScript[A] = Coproduct[Interact, Permission, A]
4 val accessPrg = accessScript[AccessScript] _
5 val loginPrg = loginScript[LoginScript]
6 val calcPrg = calcScript[CalcScript] _
这里有个环节特别需要注意：理论上我们可以用Coproduct联合两种以上语句集：
1 type F0[A] = Coproduct[Interact,UserLogin,A]
2 type F1[A] = Coproduct[Permission,F0,A]
3 type F2[A] = Coproduct[Calculator,F1,A]
4 val loginPrg2 = loginScript[F1]
但loginPrg2产生以下编译错误：
not enough arguments for method loginScript: (implicit I: run.demo.Modules.FreeFunctions.Interacts[run.demo.Modules.FreeProgs.F1], implicit L: run.demo.Modules.FreeFunctions.Logins[run.demo.Modules.FreeProgs.F1], implicit P: run.demo.Modules.FreeFunctions.Permissions[run.demo.Modules.FreeProgs.F1])scalaz.Free[[x]scalaz.Coyoneda[run.demo.Modules.FreeProgs.F1,x],String]. Unspecified value parameters L, P.
我初步分析可能是因为scalaz对Free设下的门槛：F[A]必须是个Functor。在lift函数的Inject[F,G]中，目标类型G[_]最终会被升格为Free Monad，如果我们使用Free.liftF函数的话G[_]必须是Functor。可能使用Free.liftFC后造成compiler无法正常进行类型推断吧。最近新推出的Cats组件库中Free的定义不需要Functor，有可能解决这个问题。因为Free可能成为将来的一种主要编程模式，所以必须想办法解决多语句集联合使用的问题。不过我们把这个放到以后再说。
现在我们可以用升格了的语句编程了，也就是函数组合：
1 object FreeProgs {
2 import FreeFunctions._
3 import FreeInteract._
4 import FreeLogin._
5 import FreePermission._
6 import FreeCalculator._
7 def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l]
8 def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = {
9 import I._
10 import L._
11 for {
12 uid <- ask("ya id:",identity)
13 pwd <- ask("password:",identity)
14 login <- login(uid,pwd)
15 _ <- if (login) tell("ya in, ya lucky bastard!")
16 else tell("geta fk outa here!")
17 usr <- if (login) freeCMonad[F].point(uid)
18 else freeCMonad[F].point("???")
19 } yield uid
20 }
21 def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = {
22 import I._
23 import P._
24 for {
25 inp <- ask("votiu vangto do?",identity)
26 cando <- hasPermission(uid,inp)
27 _ <- if (cando) tell("ok, go on ...")
28 else tell("na na na, cant do that!")
29 opr <- if (cando) freeCMonad[F].point(inp)
30 else freeCMonad[F].point("XXX")
31 } yield inp
32
33 }
34
35 def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = {
36 import I._;import C._;
37 for {
38 op1 <- ask("fus num:", _.toInt)
39 op2 <- ask("nx num:", _.toInt)
40 result <- calc(opr,op1,op2)
41 } yield result
42 }
43
44 type LoginScript[A] = Coproduct[Interact, UserLogin, A]
45 type CalcScript[A] = Coproduct[Interact, Calculator, A]
46 type AccessScript[A] = Coproduct[Interact, Permission, A]
47 val accessPrg = accessScript[AccessScript] _
48 val loginPrg = loginScript[LoginScript]
49 val calcPrg = calcScript[CalcScript] _
50 }
可以看出，以上每一个程序都比较简单，容易理解。这也是FP的特点：从简单基本的程序开始，经过不断组合形成完整应用。
4、Dependency injection：稍有规模的程序都有可能需要依赖其它程序来提供一些功能。所以在这个例子里示范了一些依赖注入：
1 object Dependencies {
2 trait PasswordControl {
3 val pswdMap: Map[String,String]
4 def matchPassword(uid: String, pswd: String): Boolean
5 }
6 trait PermissionControl {
7 val permMap: Map[String,List[String]]
8 def matchPermission(uid: String, operation: String): Boolean
9 }
10 }
5、Interpreter：在运算程序时（program interpretation），可以根据需要调用依赖中的功能：
1 import Dependencies._
2 type PasswordReader[A] = Reader[PasswordControl, A]
3 object LoginInterp extends (UserLogin ~> PasswordReader) {
4 def apply[A](la: UserLogin[A]): PasswordReader[A] = la match {
5 case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd))
6 }
7 }
注意，当两种语句联合使用时，它们会被转换（natural transformation）成同一个目标语句集，所以当Interact和UserLogin联合使用时都会进行PasswordReader类型的转换。由于Interact是一项最基本的功能，与其它ADT联合使用发挥功能，所以要为每个联合ADT提供特殊的Interpreter：
1 object InteractConsole extends (Interact ~> Id) {
2 def apply[A](ia: Interact[A]): Id[A] = ia match {
3 case Ask(p,onInput) => println(p); onInput(readLine)
4 case Tell(m, n) => println(m); n
5 }
6 }
7 import FreeLogin._
8 object InteractLogin extends (Interact ~> PasswordReader) {
9 def apply[A](ia: Interact[A]): PasswordReader[A] = ia match {
10 case Ask(p,onInput) => println(p); Reader(m => onInput(readLine))
11 case Tell(m, n) => println(m); Reader(m => n)
12 }
13 }
14 import FreePermission._
15 object InteractPermission extends(Interact ~> PermissionReader) {
16 def apply[A](ia: Interact[A]): PermissionReader[A] = ia match {
17 case Ask(p,onInput) => println(p);Reader(m => onInput(readLine))
18 case Tell(m,n) => println(m); Reader(m => n)
19 }
20 }
同样，联合语句集编成的程序必须有相应的运算方法。我们特别为Coproduct类型的运算提供了or函数：
1 def or[F[_],H[_],G[_]](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 -/(x) => fg(x)
5 case /-(y) => hg(y)
6 }
Coproduce是把两个语句集放在左右两边。我们只需要历遍Coproduct结构逐个运算结构中的语句。
6、running program：由于我们把所有语句都升格成了FreeC类型，所以必须调用runFC函数来运行。作为FP程序延迟副作用示范，我们在程序真正运算时才把依赖注入进去：
1 object FreeProgram extends App {
2 import Modules._
3 import FreeInteract._
4 import FreeLogin._
5 import FreePermission._
6 import FreeFunctions._
7 import FreeProgs._
8 import Dependencies._
9 object Passwords extends PasswordControl {
10 val pswdMap = Map (
11 "Tiger" -> "1234",
12 "John" -> "0332"
13 )
14 def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd
15 }
16 object AccessRights extends PermissionControl {
17 val permMap = Map (
18 "Tiger" -> List("Add","Sub"),
19 "John" -> List("Mul","Div")
20 )
21 def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr}
22 }
23
24 val uid = Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords)
25 val opr = Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).run(AccessRights)
26 val sum = Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp))
27 println(uid)
28 println(opr)
29 println(sum)
30 }
不过这个例子还不算是一个完整的程序。我们印象中的完整应用应该还要加上交互循环、错误提示等等。我们能不能用FP方式来完善这个例子呢？先说循环吧（looping）：FP循环不就是递归嘛（recursion），实在不行就试试Trampoline。关于程序的流程控制：我们可以在节点之间传递一个状态，代表下一步的操作：
1 trait NextStep //状态： 下一步操作
2 case object Login extends NextStep //登录，用户信息验证
3 case class End(msg: String) extends NextStep //正常结束退出
4 case class Opr(uid: String) extends NextStep //计算操作选项及权限验证
5 case class Calc(uid: String, opr: String) extends NextStep //计算操作
现在我们可以编写一个函数来运算每一个步骤：
1 def runStep(step: NextStep): Exception / NextStep = {
2 try {
3 step match {
4 case Login => {
5 Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords) match {
6 case "???" => End("Termination! Login failed").right
7 case uid: String => Opr(uid).right
8 case _ => End("Abnormal Termination! Unknown error.").right
9 }
10 }
11 case Opr(uid) =>
12 Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).
13 run(AccessRights) match {
14 case "XXX" => Opr(uid).right
15 case opr: String => if (opr.toUpperCase.startsWith("Q")) End("End at user request。").right
16 else Calc(uid,opr).right
17 case _ => End("Abnormal Termination! Unknown error.").right
18 }
19 case Calc(uid,opr) =>
20 println(Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp)))
21 Opr(uid).right
22 }
23 }
24 catch {
25 case e: Exception => e.left[NextStep]
26 }
27 }
在这个函数里我们增加了uid="XXX"，opr.toUpperCase.startWith("Q")以及opr="???"这几个状态。需要调整一下AccessScript和LoginScript:
1 object FreeProgs {
2 import FreeFunctions._
3 import FreeInteract._
4 import FreeLogin._
5 import FreePermission._
6 import FreeCalculator._
7 def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l]
8 def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = {
9 import I._
10 import L._
11 for {
12 uid <- ask("ya id:",identity)
13 pwd <- ask("password:",identity)
14 login <- login(uid,pwd)
15 _ <- if (login) tell("ya in, ya lucky bastard!")
16 else tell("geta fk outa here!")
17 usr <- if (login) freeCMonad[F].point(uid)
18 else freeCMonad[F].point("???")
19 } yield usr
20 }
21 def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = {
22 import I._
23 import P._
24 for {
25 inp <- ask("votiu vangto do?",identity)
26 cando <- if (inp.toUpperCase.startsWith("Q")) freeCMonad[F].point(true) else hasPermission(uid,inp)
27 _ <- if (cando) freeCMonad[F].point("")
28 else tell("na na na, cant do that!")
29 opr <- if (cando) freeCMonad[F].point(inp)
30 else freeCMonad[F].point("XXX")
31 } yield opr
32
33 }
34
35 def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = {
36 import I._;import C._;
37 for {
38 op1 <- ask("fus num:", _.toInt)
39 op2 <- ask("nx num:", _.toInt)
40 result <- calc(opr,op1,op2)
41 } yield result
42 }
然后我们可以进行循环互动了：
1 import scala.annotation.tailrec
2 @tailrec
3 def whileRun(state: Exception / NextStep): Unit = state match {
4 case /-(End(msg)) => println(msg)
5 case /-(nextStep: NextStep) => whileRun(runStep(nextStep))
6 case -/(e) => println(e)
7 case _ => println("Unknown exception!")
8 }
这是一个尾递归算法（tail recursion）。测试运行 ：
1 object FreeProgram extends App {
2 import Modules._
3 import FreeRunner._
4 whileRun(Login.right)
5 }
下面是测试结果：
ya id:
Tiger
password:
1234
ya in, man!
votiu vangto do?
Add
fus num:
12
nx num:
5
got ya self a 17.
votiu vangto do?
23
na na na, can't do that!
votiu vangto do?
Sub
fus num:
23
nx num:
5
got ya self a 18.
votiu vangto do?
quit
End at user request。
ya id:
John
password:
1234
geta fk outa here!, you bastard
Termination! Login failed
ya id:
John
password:
0332
ya in, man!
votiu vangto do?
Add
na na na, can't do that!
votiu vangto do?
Mul
fus num:
3
nx num:
7
got ya self a 21.
votiu vangto do?
Div
fus num:
10
nx num:
3
got ya self a 3.
votiu vangto do?
Div
fus num:
12
nx num:
0
Abnormal termination!
java.lang.ArithmeticException: / by zero
我们也可以用Trampoline来循环运算这个示范：
1 import scalaz.Free.Trampoline
2 import scalaz.Trampoline._
3 def runTrampoline(state: Exception / NextStep): Trampoline[Unit] = state match {
4 case /-(End(msg)) => done(println(msg))
5 case /-(nextStep: NextStep) => suspend(runTrampoline(runStep(nextStep)))
6 case -/(e) => done({println("Abnormal termination!"); println(e)})
7 case _ => done(println("Unknown exception!"))
8 }
测试运算：
1 object FreeProgram extends App {
2 import Modules._
3 import FreeRunner._
4 // whileRun(Login.right)
5 runTrampoline(Login.right).run
6 }
测试运算结果：
ya id:
Tiger
password:
1234
ya in, man!
votiu vangto do?
Sub
fus num:
12
nx num:
15
got ya self a -3.
votiu vangto do?
Mul
na na na, can't do that!
votiu vangto do?
Add
fus num:
10
nx num:
5
got ya self a 15.
votiu vangto do?
quit
End at user request。
好了，下面是这个示范的完整源代码：
1 package run.demo
2 import scalaz._
3 import Scalaz._
4 import scala.language.higherKinds
5 import scala.language.implicitConversions
6 import run.demo.Modules.FreeCalculator.CalcInterp
7
8 object Modules {
9 object FreeInteract {
10 trait Interact[+NextAct]
11 object Interact {
12 case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct]
13 case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct]
14 implicit object interactFunctor extends Functor[Interact] {
15 def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
16 case Ask(p,onInput) => Ask(p, onInput andThen f)
17 case Tell(m,n) => Tell(m, f(n))
18 }
19 }
20 }
21 import Interact._
22 object InteractConsole extends (Interact ~> Id) {
23 def apply[A](ia: Interact[A]): Id[A] = ia match {
24 case Ask(p,onInput) => println(p); onInput(readLine)
25 case Tell(m, n) => println(m); n
26 }
27 }
28 import FreeLogin._
29 object InteractLogin extends (Interact ~> PasswordReader) {
30 def apply[A](ia: Interact[A]): PasswordReader[A] = ia match {
31 case Ask(p,onInput) => println(p); Reader(m => onInput(readLine))
32 case Tell(m, n) => println(m); Reader(m => n)
33 }
34 }
35 import FreePermission._
36 object InteractPermission extends(Interact ~> PermissionReader) {
37 def apply[A](ia: Interact[A]): PermissionReader[A] = ia match {
38 case Ask(p,onInput) => println(p);Reader(m => onInput(readLine))
39 case Tell(m,n) => println(m); Reader(m => n)
40 }
41 }
42 }
43 object FreeLogin {
44 trait UserLogin[+A]
45 object UserLogin {
46 case class Login(uid: String, pswd: String) extends UserLogin[Boolean]
47 }
48 import UserLogin._
49 import Dependencies._
50 type PasswordReader[A] = Reader[PasswordControl, A]
51 object LoginInterp extends (UserLogin ~> PasswordReader) {
52 def apply[A](la: UserLogin[A]): PasswordReader[A] = la match {
53 case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd))
54 }
55 }
56 }
57 object FreePermission {
58 trait Permission[+A]
59 object Permission {
60 case class HasPermission(uid: String, opr: String) extends Permission[Boolean]
61 }
62 import Dependencies._
63 import Permission._
64 type PermissionReader[A] = Reader[PermissionControl,A]
65 object PermissionInterp extends (Permission ~> PermissionReader) {
66 def apply[A](pa: Permission[A]): PermissionReader[A] = pa match {
67 case HasPermission(uid,opr) => Reader {m => m.matchPermission(uid, opr)}
68 }
69 }
70 }
71 object FreeCalculator {
72 trait Calculator[+A]
73 object Calculator {
74 case class Calc(opr: String, lop: Int, rop: Int) extends Calculator[Int]
75 }
76 import Calculator._
77 object CalcInterp extends (Calculator ~> Id) {
78 def apply[A](ca: Calculator[A]): Id[A] = ca match {
79 case Calc(opr,op1,op2) => opr.toUpperCase match {
80 case "ADD" => op1 + op2
81 case "SUB" => op1 - op2
82 case "MUL" => op1 * op2
83 case "DIV" => op1 / op2
84 }
85 }
86 }
87 }
88 object FreeFunctions {
89 import FreeInteract._
90 import Interact._
91 import FreeLogin._
92 import UserLogin._
93 import FreePermission._
94 import Permission._
95 import FreeCalculator._
96 import Calculator._
97 def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] =
98 Free.liftFC(I.inj(fa))
99 class Interacts[G[_]](implicit I: Inject[Interact,G]) {
100 def ask[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput)))
101 def tell[A](msg: String) = Free.liftFC(I.inj(Tell(msg, ())))
102 }
103 object Interacts {
104 implicit def instance[F[_]](implicit I: Inject[Interact,F]) = new Interacts[F]
105 }
106 class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
107 def login(uid: String, pswd: String) = lift(Login(uid,pswd))
108 }
109 object Logins {
110 implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F]
111 }
112 class Permissions[G[_]](implicit I: Inject[Permission,G]) {
113 def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr))
114 }
115 object Permissions {
116 implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F]
117 }
118 class Calculators[G[_]](implicit I: Inject[Calculator,G]) {
119 def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2))
120 }
121 object Calculators {
122 implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F]
123 }
124 def or[F[_],H[_],G[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
125 new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
126 def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
127 case -/(x) => fg(x)
128 case /-(y) => hg(y)
129 }
130 }
131 }
132 object FreeProgs {
133 import FreeFunctions._
134 import FreeInteract._
135 import FreeLogin._
136 import FreePermission._
137 import FreeCalculator._
138 def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l]
139 def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = {
140 import I._
141 import L._
142 for {
143 uid <- ask("ya id:",identity)
144 pwd <- ask("password:",identity)
145 login <- login(uid,pwd)
146 _ <- if (login) tell("ya in, man!")
147 else tell("geta fk outa here!, you bastard")
148 usr <- if (login) freeCMonad[F].point(uid)
149 else freeCMonad[F].point("???")
150 } yield usr
151 }
152 def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = {
153 import I._
154 import P._
155 for {
156 inp <- ask("votiu vangto do?",identity)
157 cando <- if (inp.toUpperCase.startsWith("Q")) freeCMonad[F].point(true) else hasPermission(uid,inp)
158 _ <- if (cando) freeCMonad[F].point("")
159 else tell("na na na, can't do that!")
160 opr <- if (cando) freeCMonad[F].point(inp)
161 else freeCMonad[F].point("XXX")
162 } yield opr
163
164 }
165
166 def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = {
167 import I._;import C._;
168 for {
169 op1 <- ask("fus num:", _.toInt)
170 op2 <- ask("nx num:", _.toInt)
171 result <- calc(opr,op1,op2)
172 } yield result
173 }
174
175 type LoginScript[A] = Coproduct[Interact, UserLogin, A]
176 type CalcScript[A] = Coproduct[Interact, Calculator, A]
177 type AccessScript[A] = Coproduct[Interact, Permission, A]
178 val accessPrg = accessScript[AccessScript] _
179 val loginPrg = loginScript[LoginScript]
180 val calcPrg = calcScript[CalcScript] _
181 }
182 object FreeRunner {
183 import FreeInteract._
184 import FreeLogin._
185 import FreePermission._
186 import FreeFunctions._
187 import FreeProgs._
188 import Dependencies._
189 trait NextStep //状态： 下一步操作
190 case object Login extends NextStep //登录，用户信息验证
191 case class End(msg: String) extends NextStep //正常结束退出
192 case class Opr(uid: String) extends NextStep //计算操作选项及权限验证
193 case class Calc(uid: String, opr: String) extends NextStep //计算操作
194 object Passwords extends PasswordControl {
195 val pswdMap = Map (
196 "Tiger" -> "1234",
197 "John" -> "0332"
198 )
199 def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd
200 }
201 object AccessRights extends PermissionControl {
202 val permMap = Map (
203 "Tiger" -> List("Add","Sub"),
204 "John" -> List("Mul","Div")
205 )
206 def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr}
207 }
208 def runStep(step: NextStep): Exception / NextStep = {
209 try {
210 step match {
211 case Login => {
212 Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords) match {
213 case "???" => End("Termination! Login failed").right
214 case uid: String => Opr(uid).right
215 case _ => End("Abnormal Termination! Unknown error.").right
216 }
217 }
218 case Opr(uid) =>
219 Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).
220 run(AccessRights) match {
221 case "XXX" => Opr(uid).right
222 case opr: String => if (opr.toUpperCase.startsWith("Q")) End("End at user request。").right
223 else Calc(uid,opr).right
224 case _ => End("Abnormal Termination! Unknown error.").right
225 }
226 case Calc(uid,opr) =>
227 println(s"got ya self a ${Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp))}.")
228 Opr(uid).right
229 }
230 }
231 catch {
232 case e: Exception => e.left[NextStep]
233 }
234 }
235 import scala.annotation.tailrec
236 @tailrec
237 def whileRun(state: Exception / NextStep): Unit = state match {
238 case /-(End(msg)) => println(msg)
239 case /-(nextStep: NextStep) => whileRun(runStep(nextStep))
240 case -/(e) => println("Abnormal termination!"); println(e)
241 case _ => println("Unknown exception!")
242 }
243 import scalaz.Free.Trampoline
244 import scalaz.Trampoline._
245 def runTrampoline(state: Exception / NextStep): Trampoline[Unit] = state match {
246 case /-(End(msg)) => done(println(msg))
247 case /-(nextStep: NextStep) => suspend(runTrampoline(runStep(nextStep)))
248 case -/(e) => done({println("Abnormal termination!"); println(e)})
249 case _ => done(println("Unknown exception!"))
250 }
251 }
252 }
253 object Dependencies {
254 trait PasswordControl {
255 val pswdMap: Map[String,String]
256 def matchPassword(uid: String, pswd: String): Boolean
257 }
258 trait PermissionControl {
259 val permMap: Map[String,List[String]]
260 def matchPermission(uid: String, operation: String): Boolean
261 }
262 }
263 object FreeProgram extends App {
264 import Modules._
265 import FreeRunner._
266 // whileRun(Login.right)
267 runTrampoline(Login.right).run
268 }