Scalaz（39）－ Free ：a real monadic program
来源：互联网 发布：明阳智慧能源知乎 编辑：程序博客网 时间：2024/05/21 10:19
一直感觉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）以及依赖注入、运算、结果等等先摆出来，然后再逐段分析说明：
package run.demoimport scalaz._import Scalaz._import scala.language.higherKindsimport scala.language.implicitConversionsimport run.demo.Modules.FreeCalculator.CalcInterpobject Modules { object FreeInteract { trait Interact[+NextAct] object Interact { case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct] case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct] implicit object interactFunctor extends Functor[Interact] { def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match { case Ask(p,onInput) => Ask(p, onInput andThen f) case Tell(m,n) => Tell(m, f(n)) } } } import Interact._ object InteractConsole extends (Interact ~> Id) { def apply[A](ia: Interact[A]): Id[A] = ia match { case Ask(p,onInput) => println(p); onInput(readLine) case Tell(m, n) => println(m); n } } import FreeLogin._ object InteractLogin extends (Interact ~> PasswordReader) { def apply[A](ia: Interact[A]): PasswordReader[A] = ia match { case Ask(p,onInput) => println(p); Reader(m => onInput(readLine)) case Tell(m, n) => println(m); Reader(m => n) } } import FreePermission._ object InteractPermission extends(Interact ~> PermissionReader) { def apply[A](ia: Interact[A]): PermissionReader[A] = ia match { case Ask(p,onInput) => println(p);Reader(m => onInput(readLine)) case Tell(m,n) => println(m); Reader(m => n) } } } object FreeLogin { trait UserLogin[+A] object UserLogin { case class Login(uid: String, pswd: String) extends UserLogin[Boolean] } import UserLogin._ import Dependencies._ type PasswordReader[A] = Reader[PasswordControl, A] object LoginInterp extends (UserLogin ~> PasswordReader) { def apply[A](la: UserLogin[A]): PasswordReader[A] = la match { case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd)) } } } object FreePermission { trait Permission[+A] object Permission { case class HasPermission(uid: String, opr: String) extends Permission[Boolean] } import Dependencies._ import Permission._ type PermissionReader[A] = Reader[PermissionControl,A] object PermissionInterp extends (Permission ~> PermissionReader) { def apply[A](pa: Permission[A]): PermissionReader[A] = pa match { case HasPermission(uid,opr) => Reader {m => m.matchPermission(uid, opr)} } } } object FreeCalculator { trait Calculator[+A] object Calculator { case class Calc(opr: String, lop: Int, rop: Int) extends Calculator[Int] } import Calculator._ object CalcInterp extends (Calculator ~> Id) { def apply[A](ca: Calculator[A]): Id[A] = ca match { case Calc(opr,op1,op2) => opr.toUpperCase match { case "ADD" => op1 + op2 case "SUB" => op1 - op2 case "MUL" => op1 * op2 case "DIV" => op1 / op2 } } } } object FreeFunctions { import FreeInteract._ import Interact._ import FreeLogin._ import UserLogin._ import FreePermission._ import Permission._ import FreeCalculator._ import Calculator._ 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[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput))) def tell[A](msg: String) = Free.liftFC(I.inj(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(uid: String, pswd: String) = lift(Login(uid,pswd)) } object Logins { implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F] } class Permissions[G[_]](implicit I: Inject[Permission,G]) { def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr)) } object Permissions { implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F] } class Calculators[G[_]](implicit I: Inject[Calculator,G]) { def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2)) } object Calculators { implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F] } def or[F[_],H[_],G[_]](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 -\/(x) => fg(x) case \/-(y) => hg(y) } } } object FreeProgs { import FreeFunctions._ import FreeInteract._ import FreeLogin._ import FreePermission._ import FreeCalculator._ def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l] def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = { import I._ import L._ for { uid <- ask("ya id:",identity) pwd <- ask("password:",identity) login <- login(uid,pwd) _ <- if (login) tell("ya in, ya lucky bastard!") else tell("geta fk outa here!") usr <- if (login) freeCMonad[F].point(uid) else freeCMonad[F].point("???") } yield usr } def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = { import I._ import P._ for { inp <- ask("votiu vangto do?",identity) cando <- hasPermission(uid,inp) _ <- if (cando) tell("ok, go on ...") else tell("na na na, cant do that!") opr <- if (cando) freeCMonad[F].point(inp) else freeCMonad[F].point("XXX") } yield opr } def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = { import I._;import C._; for { op1 <- ask("fus num:", _.toInt) op2 <- ask("nx num:", _.toInt) result <- calc(opr,op1,op2) } yield result } type LoginScript[A] = Coproduct[Interact, UserLogin, A] type CalcScript[A] = Coproduct[Interact, Calculator, A] type AccessScript[A] = Coproduct[Interact, Permission, A] val accessPrg = accessScript[AccessScript] _ val loginPrg = loginScript[LoginScript] val calcPrg = calcScript[CalcScript] _ }}object Dependencies { trait PasswordControl { val pswdMap: Map[String,String] def matchPassword(uid: String, pswd: String): Boolean } trait PermissionControl { val permMap: Map[String,List[String]] def matchPermission(uid: String, operation: String): Boolean }}object FreeProgram extends App { import Modules._ import FreeInteract._ import FreeLogin._ import FreePermission._ import FreeFunctions._ import FreeProgs._ import Dependencies._ object Passwords extends PasswordControl { val pswdMap = Map ( "Tiger" -> "1234", "John" -> "0332" ) def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd } object AccessRights extends PermissionControl { val permMap = Map ( "Tiger" -> List("Add","Sub"), "John" -> List("Mul","Div") ) def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr} } val uid = Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords) val opr = Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).run(AccessRights) val sum = Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp)) println(uid) println(opr) println(sum)}//测试运算结果ya id:Tigerpassword:1234ya in, ya lucky bastard!votiu vangto do?Addok, go on ...fus num:3nx num:7TigerAdd101、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：
trait Interact[+NextAct] object Interact { case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct] case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct] implicit object interactFunctor extends Functor[Interact] { def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match { case Ask(p,onInput) => Ask(p, onInput andThen f) case Tell(m,n) => Tell(m, f(n)) } } } Interact能够支持map，必须是个Functor。这是因为其中一个状态Ask需要对输入String进行转换后进入下一个状态。
2、升格lifting：我们需要把这些ADT都升格成Free。因为有些ADT不是Functor，所以用liftFC把它们统一升格为FreeC:
object FreeFunctions { import FreeInteract._ import Interact._ import FreeLogin._ import UserLogin._ import FreePermission._ import Permission._ import FreeCalculator._ import Calculator._ 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[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput))) def tell[A](msg: String) = Free.liftFC(I.inj(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(uid: String, pswd: String) = lift(Login(uid,pswd)) } object Logins { implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F] } class Permissions[G[_]](implicit I: Inject[Permission,G]) { def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr)) } object Permissions { implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F] } class Calculators[G[_]](implicit I: Inject[Calculator,G]) { def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2)) } object Calculators { implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F] } def or[F[_],H[_],G[_]](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 -\/(x) => fg(x) case \/-(y) => hg(y) } } }3、ASTs：现在有了这些基础语句集，按照功能要求，我们可以用某一种语句组合成一个程序AST，或者结合用两种以上语句组合程序，甚至把产生的AST组合成更大的程序。我们可以用scalaz的Coproduct来实现这些语句集的联合：
type LoginScript[A] = Coproduct[Interact, UserLogin, A] type CalcScript[A] = Coproduct[Interact, Calculator, A] type AccessScript[A] = Coproduct[Interact, Permission, A] val accessPrg = accessScript[AccessScript] _ val loginPrg = loginScript[LoginScript] val calcPrg = calcScript[CalcScript] _
type F0[A] = Coproduct[Interact,UserLogin,A] type F1[A] = Coproduct[Permission,F0,A] type F2[A] = Coproduct[Calculator,F1,A] 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.
现在我们可以用升格了的语句编程了，也就是函数组合：
object FreeProgs { import FreeFunctions._ import FreeInteract._ import FreeLogin._ import FreePermission._ import FreeCalculator._ def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l] def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = { import I._ import L._ for { uid <- ask("ya id:",identity) pwd <- ask("password:",identity) login <- login(uid,pwd) _ <- if (login) tell("ya in, ya lucky bastard!") else tell("geta fk outa here!") usr <- if (login) freeCMonad[F].point(uid) else freeCMonad[F].point("???") } yield uid } def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = { import I._ import P._ for { inp <- ask("votiu vangto do?",identity) cando <- hasPermission(uid,inp) _ <- if (cando) tell("ok, go on ...") else tell("na na na, cant do that!") opr <- if (cando) freeCMonad[F].point(inp) else freeCMonad[F].point("XXX") } yield inp } def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = { import I._;import C._; for { op1 <- ask("fus num:", _.toInt) op2 <- ask("nx num:", _.toInt) result <- calc(opr,op1,op2) } yield result } type LoginScript[A] = Coproduct[Interact, UserLogin, A] type CalcScript[A] = Coproduct[Interact, Calculator, A] type AccessScript[A] = Coproduct[Interact, Permission, A] val accessPrg = accessScript[AccessScript] _ val loginPrg = loginScript[LoginScript] val calcPrg = calcScript[CalcScript] _ }可以看出，以上每一个程序都比较简单，容易理解。这也是FP的特点：从简单基本的程序开始，经过不断组合形成完整应用。
4、Dependency injection：稍有规模的程序都有可能需要依赖其它程序来提供一些功能。所以在这个例子里示范了一些依赖注入：
object Dependencies { trait PasswordControl { val pswdMap: Map[String,String] def matchPassword(uid: String, pswd: String): Boolean } trait PermissionControl { val permMap: Map[String,List[String]] def matchPermission(uid: String, operation: String): Boolean }}5、Interpreter：在运算程序时（program interpretation），可以根据需要调用依赖中的功能：
import Dependencies._ type PasswordReader[A] = Reader[PasswordControl, A] object LoginInterp extends (UserLogin ~> PasswordReader) { def apply[A](la: UserLogin[A]): PasswordReader[A] = la match { case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd)) } } object InteractConsole extends (Interact ~> Id) { def apply[A](ia: Interact[A]): Id[A] = ia match { case Ask(p,onInput) => println(p); onInput(readLine) case Tell(m, n) => println(m); n } } import FreeLogin._ object InteractLogin extends (Interact ~> PasswordReader) { def apply[A](ia: Interact[A]): PasswordReader[A] = ia match { case Ask(p,onInput) => println(p); Reader(m => onInput(readLine)) case Tell(m, n) => println(m); Reader(m => n) } } import FreePermission._ object InteractPermission extends(Interact ~> PermissionReader) { def apply[A](ia: Interact[A]): PermissionReader[A] = ia match { case Ask(p,onInput) => println(p);Reader(m => onInput(readLine)) case Tell(m,n) => println(m); Reader(m => n) } } def or[F[_],H[_],G[_]](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 -\/(x) => fg(x) case \/-(y) => hg(y) }6、running program：由于我们把所有语句都升格成了FreeC类型，所以必须调用runFC函数来运行。作为FP程序延迟副作用示范，我们在程序真正运算时才把依赖注入进去：
object FreeProgram extends App { import Modules._ import FreeInteract._ import FreeLogin._ import FreePermission._ import FreeFunctions._ import FreeProgs._ import Dependencies._ object Passwords extends PasswordControl { val pswdMap = Map ( "Tiger" -> "1234", "John" -> "0332" ) def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd } object AccessRights extends PermissionControl { val permMap = Map ( "Tiger" -> List("Add","Sub"), "John" -> List("Mul","Div") ) def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr} } val uid = Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords) val opr = Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).run(AccessRights) val sum = Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp)) println(uid) println(opr) println(sum)}不过这个例子还不算是一个完整的程序。我们印象中的完整应用应该还要加上交互循环、错误提示等等。我们能不能用FP方式来完善这个例子呢？先说循环吧（looping）：FP循环不就是递归嘛（recursion），实在不行就试试Trampoline。关于程序的流程控制：我们可以在节点之间传递一个状态，代表下一步的操作：
trait NextStep //状态： 下一步操作 case object Login extends NextStep //登录，用户信息验证 case class End(msg: String) extends NextStep //正常结束退出 case class Opr(uid: String) extends NextStep //计算操作选项及权限验证 case class Calc(uid: String, opr: String) extends NextStep //计算操作
def runStep(step: NextStep): Exception \/ NextStep = { try { step match { case Login => { Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords) match { case "???" => End("Termination! Login failed").right case uid: String => Opr(uid).right case _ => End("Abnormal Termination! Unknown error.").right } } case Opr(uid) => Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)). run(AccessRights) match { case "XXX" => Opr(uid).right case opr: String => if (opr.toUpperCase.startsWith("Q")) End("End at user request。").right else Calc(uid,opr).right case _ => End("Abnormal Termination! Unknown error.").right } case Calc(uid,opr) => println(Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp))) Opr(uid).right } } catch { case e: Exception => e.left[NextStep] } } object FreeProgs { import FreeFunctions._ import FreeInteract._ import FreeLogin._ import FreePermission._ import FreeCalculator._ def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l] def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = { import I._ import L._ for { uid <- ask("ya id:",identity) pwd <- ask("password:",identity) login <- login(uid,pwd) _ <- if (login) tell("ya in, ya lucky bastard!") else tell("geta fk outa here!") usr <- if (login) freeCMonad[F].point(uid) else freeCMonad[F].point("???") } yield usr } def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = { import I._ import P._ for { inp <- ask("votiu vangto do?",identity) cando <- if (inp.toUpperCase.startsWith("Q")) freeCMonad[F].point(true) else hasPermission(uid,inp) _ <- if (cando) freeCMonad[F].point("") else tell("na na na, cant do that!") opr <- if (cando) freeCMonad[F].point(inp) else freeCMonad[F].point("XXX") } yield opr } def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = { import I._;import C._; for { op1 <- ask("fus num:", _.toInt) op2 <- ask("nx num:", _.toInt) result <- calc(opr,op1,op2) } yield result } import scala.annotation.tailrec @tailrec def whileRun(state: Exception \/ NextStep): Unit = state match { case \/-(End(msg)) => println(msg) case \/-(nextStep: NextStep) => whileRun(runStep(nextStep)) case -\/(e) => println(e) case _ => println("Unknown exception!") }object FreeProgram extends App { import Modules._ import FreeRunner._ whileRun(Login.right)}下面是测试结果：
ya id:Tigerpassword:1234ya in, man!votiu vangto do?Addfus num:12nx num:5got ya self a 17.votiu vangto do?23na na na, can't do that!votiu vangto do?Subfus num:23nx num:5got ya self a 18.votiu vangto do?quitEnd at user request。
ya id:Johnpassword:1234geta fk outa here!, you bastardTermination! Login failed
ya id:Johnpassword:0332ya in, man!votiu vangto do?Addna na na, can't do that!votiu vangto do?Mulfus num:3nx num:7got ya self a 21.votiu vangto do?Divfus num:10nx num:3got ya self a 3.votiu vangto do?Divfus num:12nx num:0Abnormal termination!java.lang.ArithmeticException: / by zero
我们也可以用Trampoline来循环运算这个示范：
import scalaz.Free.Trampoline import scalaz.Trampoline._ def runTrampoline(state: Exception \/ NextStep): Trampoline[Unit] = state match { case \/-(End(msg)) => done(println(msg)) case \/-(nextStep: NextStep) => suspend(runTrampoline(runStep(nextStep))) case -\/(e) => done({println("Abnormal termination!"); println(e)}) case _ => done(println("Unknown exception!")) }测试运算：
object FreeProgram extends App { import Modules._ import FreeRunner._// whileRun(Login.right) runTrampoline(Login.right).run}ya id:Tigerpassword:1234ya in, man!votiu vangto do?Subfus num:12nx num:15got ya self a -3.votiu vangto do?Mulna na na, can't do that!votiu vangto do?Addfus num:10nx num:5got ya self a 15.votiu vangto do?quitEnd at user request。
好了，下面是这个示范的完整源代码：
package run.demoimport scalaz._import Scalaz._import scala.language.higherKindsimport scala.language.implicitConversionsimport run.demo.Modules.FreeCalculator.CalcInterpobject Modules { object FreeInteract { trait Interact[+NextAct] object Interact { case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct] case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct] implicit object interactFunctor extends Functor[Interact] { def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match { case Ask(p,onInput) => Ask(p, onInput andThen f) case Tell(m,n) => Tell(m, f(n)) } } } import Interact._ object InteractConsole extends (Interact ~> Id) { def apply[A](ia: Interact[A]): Id[A] = ia match { case Ask(p,onInput) => println(p); onInput(readLine) case Tell(m, n) => println(m); n } } import FreeLogin._ object InteractLogin extends (Interact ~> PasswordReader) { def apply[A](ia: Interact[A]): PasswordReader[A] = ia match { case Ask(p,onInput) => println(p); Reader(m => onInput(readLine)) case Tell(m, n) => println(m); Reader(m => n) } } import FreePermission._ object InteractPermission extends(Interact ~> PermissionReader) { def apply[A](ia: Interact[A]): PermissionReader[A] = ia match { case Ask(p,onInput) => println(p);Reader(m => onInput(readLine)) case Tell(m,n) => println(m); Reader(m => n) } } } object FreeLogin { trait UserLogin[+A] object UserLogin { case class Login(uid: String, pswd: String) extends UserLogin[Boolean] } import UserLogin._ import Dependencies._ type PasswordReader[A] = Reader[PasswordControl, A] object LoginInterp extends (UserLogin ~> PasswordReader) { def apply[A](la: UserLogin[A]): PasswordReader[A] = la match { case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd)) } } } object FreePermission { trait Permission[+A] object Permission { case class HasPermission(uid: String, opr: String) extends Permission[Boolean] } import Dependencies._ import Permission._ type PermissionReader[A] = Reader[PermissionControl,A] object PermissionInterp extends (Permission ~> PermissionReader) { def apply[A](pa: Permission[A]): PermissionReader[A] = pa match { case HasPermission(uid,opr) => Reader {m => m.matchPermission(uid, opr)} } } } object FreeCalculator { trait Calculator[+A] object Calculator { case class Calc(opr: String, lop: Int, rop: Int) extends Calculator[Int] } import Calculator._ object CalcInterp extends (Calculator ~> Id) { def apply[A](ca: Calculator[A]): Id[A] = ca match { case Calc(opr,op1,op2) => opr.toUpperCase match { case "ADD" => op1 + op2 case "SUB" => op1 - op2 case "MUL" => op1 * op2 case "DIV" => op1 / op2 } } } } object FreeFunctions { import FreeInteract._ import Interact._ import FreeLogin._ import UserLogin._ import FreePermission._ import Permission._ import FreeCalculator._ import Calculator._ 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[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput))) def tell[A](msg: String) = Free.liftFC(I.inj(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(uid: String, pswd: String) = lift(Login(uid,pswd)) } object Logins { implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F] } class Permissions[G[_]](implicit I: Inject[Permission,G]) { def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr)) } object Permissions { implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F] } class Calculators[G[_]](implicit I: Inject[Calculator,G]) { def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2)) } object Calculators { implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F] } def or[F[_],H[_],G[_]](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 -\/(x) => fg(x) case \/-(y) => hg(y) } } } object FreeProgs { import FreeFunctions._ import FreeInteract._ import FreeLogin._ import FreePermission._ import FreeCalculator._ def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l] def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = { import I._ import L._ for { uid <- ask("ya id:",identity) pwd <- ask("password:",identity) login <- login(uid,pwd) _ <- if (login) tell("ya in, man!") else tell("geta fk outa here!, you bastard") usr <- if (login) freeCMonad[F].point(uid) else freeCMonad[F].point("???") } yield usr } def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = { import I._ import P._ for { inp <- ask("votiu vangto do?",identity) cando <- if (inp.toUpperCase.startsWith("Q")) freeCMonad[F].point(true) else hasPermission(uid,inp) _ <- if (cando) freeCMonad[F].point("") else tell("na na na, can't do that!") opr <- if (cando) freeCMonad[F].point(inp) else freeCMonad[F].point("XXX") } yield opr } def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = { import I._;import C._; for { op1 <- ask("fus num:", _.toInt) op2 <- ask("nx num:", _.toInt) result <- calc(opr,op1,op2) } yield result } type LoginScript[A] = Coproduct[Interact, UserLogin, A] type CalcScript[A] = Coproduct[Interact, Calculator, A] type AccessScript[A] = Coproduct[Interact, Permission, A] val accessPrg = accessScript[AccessScript] _ val loginPrg = loginScript[LoginScript] val calcPrg = calcScript[CalcScript] _ } object FreeRunner { import FreeInteract._ import FreeLogin._ import FreePermission._ import FreeFunctions._ import FreeProgs._ import Dependencies._ trait NextStep //状态： 下一步操作 case object Login extends NextStep //登录，用户信息验证 case class End(msg: String) extends NextStep //正常结束退出 case class Opr(uid: String) extends NextStep //计算操作选项及权限验证 case class Calc(uid: String, opr: String) extends NextStep //计算操作 object Passwords extends PasswordControl { val pswdMap = Map ( "Tiger" -> "1234", "John" -> "0332" ) def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd } object AccessRights extends PermissionControl { val permMap = Map ( "Tiger" -> List("Add","Sub"), "John" -> List("Mul","Div") ) def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr} } def runStep(step: NextStep): Exception \/ NextStep = { try { step match { case Login => { Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords) match { case "???" => End("Termination! Login failed").right case uid: String => Opr(uid).right case _ => End("Abnormal Termination! Unknown error.").right } } case Opr(uid) => Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)). run(AccessRights) match { case "XXX" => Opr(uid).right case opr: String => if (opr.toUpperCase.startsWith("Q")) End("End at user request。").right else Calc(uid,opr).right case _ => End("Abnormal Termination! Unknown error.").right } case Calc(uid,opr) => println(s"got ya self a ${Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp))}.") Opr(uid).right } } catch { case e: Exception => e.left[NextStep] } } import scala.annotation.tailrec @tailrec def whileRun(state: Exception \/ NextStep): Unit = state match { case \/-(End(msg)) => println(msg) case \/-(nextStep: NextStep) => whileRun(runStep(nextStep)) case -\/(e) => println("Abnormal termination!"); println(e) case _ => println("Unknown exception!") } import scalaz.Free.Trampoline import scalaz.Trampoline._ def runTrampoline(state: Exception \/ NextStep): Trampoline[Unit] = state match { case \/-(End(msg)) => done(println(msg)) case \/-(nextStep: NextStep) => suspend(runTrampoline(runStep(nextStep))) case -\/(e) => done({println("Abnormal termination!"); println(e)}) case _ => done(println("Unknown exception!")) } }}object Dependencies { trait PasswordControl { val pswdMap: Map[String,String] def matchPassword(uid: String, pswd: String): Boolean } trait PermissionControl { val permMap: Map[String,List[String]] def matchPermission(uid: String, operation: String): Boolean }}object FreeProgram extends App { import Modules._ import FreeRunner._// whileRun(Login.right) runTrampoline(Login.right).run} 0 0
- Scalaz（39）－ Free ：a real monadic program
- Scalaz（33）－ Free ：算式－Monadic Programming
- Scalaz（38）－ Free ：Coproduct－Monadic语句组合
- Scalaz（22）－ 泛函编程思维： Coerce Monadic Thinking
- Scalaz（29）－ Free ：Coyoneda - Functor for free
- Scalaz（54）－ scalaz-stream: 函数式多线程编程模式－Free Streaming Programming Model
- Scalaz（34）－ Free ：算法－Interpretation
- Scalaz（32）－ Free ：lift - Monad生产线
- Scalaz（32）－ Free ：lift - Monad生产线 企
- Scalaz（40）－ Free ：versioned up，再回顾
- Cats（4）－ 叠加Free程序运算结果，Stacking monadic result types
- Scalaz（36）－ Free ：实践－Free In Action - 实用体验
- Scalaz（37）－ Free ：实践－DB Transaction free style
- Scalaz（41）－ Free ：IO Monad－Free特定版本的FP语法
- Scalaz（30）－ Free ：Natural Tranformation ~> - map higher kinded types for free
- Scalaz（31）－ Free ：自由数据结构－算式和算法的关注分离
- Scalaz（35）－ Free ：运算－Trampoline，say NO to StackOverflowError
- Scalaz（42）－ Free ：FreeAp－Applicative Style Programming Language
- linux编程之pipe()函数
- 自定義控件
- redis配置说明
- SGU 142 Keyword（水~）
- 错误日记 quartz No Session found for current thread
- Scalaz（39）－ Free ：a real monadic program
- Linux与几种电脑系统的区别
- 【Unity闲谈】关于制作 Voxel（体素，3D像素）模型并导入Unity
- 打造H5动感影集的爱恨情仇(动画性能篇)
- C++ primer plus第六版课后编程练习答案：6.4
- 密码学
- 使用RecyclerView实现多样的View
- 欢迎使用CSDN-markdown编辑器
- C++ primer plus第六版课后编程练习答案：6.5
