Scalaz（39）－ Free ：a real monadic program
一直感觉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.demo
import scalaz._
import Scalaz._
import scala.language.higherKinds
import scala.language.implicitConversions
import run.demo.Modules.FreeCalculator.CalcInterp object 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" -> "",
"John" -> ""
)
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:
Tiger
password: ya in, ya lucky bastard!
votiu vangto do?
Add
ok, go on ...
fus num: nx num: Tiger
Add
看起来好像费了老大劲就做那么点事。但如果我们按照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：
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)
}
}
}
在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来实现这些语句集的联合：
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] _
这里有个环节特别需要注意：理论上我们可以用Coproduct联合两种以上语句集：
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.
我初步分析可能是因为scalaz对Free设下的门槛：F[A]必须是个Functor。在lift函数的Inject[F,G]中，目标类型G[_]最终会被升格为Free Monad，如果我们使用Free.liftF函数的话G[_]必须是Functor。可能使用Free.liftFC后造成compiler无法正常进行类型推断吧。最近新推出的Cats组件库中Free的定义不需要Functor，有可能解决这个问题。因为Free可能成为将来的一种主要编程模式，所以必须想办法解决多语句集联合使用的问题。不过我们把这个放到以后再说。
现在我们可以用升格了的语句编程了，也就是函数组合：
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))
}
}
注意，当两种语句联合使用时，它们会被转换（natural transformation）成同一个目标语句集，所以当Interact和UserLogin联合使用时都会进行PasswordReader类型的转换。由于Interact是一项最基本的功能，与其它ADT联合使用发挥功能，所以要为每个联合ADT提供特殊的Interpreter：
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)
}
}
同样，联合语句集编成的程序必须有相应的运算方法。我们特别为Coproduct类型的运算提供了or函数：
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)
}
Coproduce是把两个语句集放在左右两边。我们只需要历遍Coproduct结构逐个运算结构中的语句。
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" -> "",
"John" -> ""
)
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]
}
}
在这个函数里我们增加了uid="XXX"，opr.toUpperCase.startWith("Q")以及opr="???"这几个状态。需要调整一下AccessScript和LoginScript:
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!")
}
这是一个尾递归算法（tail recursion）。测试运行 ：
object FreeProgram extends App {
import Modules._
import FreeRunner._
whileRun(Login.right)
}
下面是测试结果：
ya id:
Tiger
password: ya in, man!
votiu vangto do?
Add
fus num: nx num: got ya self a .
votiu vangto do? na na na, can't do that!
votiu vangto do?
Sub
fus num: nx num: got ya self a .
votiu vangto do?
quit
End at user request。
ya id:
John
password: geta fk outa here!, you bastard
Termination! Login failed
ya id:
John
password: ya in, man!
votiu vangto do?
Add
na na na, can't do that!
votiu vangto do?
Mul
fus num: nx num: got ya self a .
votiu vangto do?
Div
fus num: nx num: got ya self a .
votiu vangto do?
Div
fus num: nx num: Abnormal 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:
Tiger
password: ya in, man!
votiu vangto do?
Sub
fus num: nx num: got ya self a -.
votiu vangto do?
Mul
na na na, can't do that!
votiu vangto do?
Add
fus num: nx num: got ya self a .
votiu vangto do?
quit
End at user request。
好了，下面是这个示范的完整源代码：
package run.demo
import scalaz._
import Scalaz._
import scala.language.higherKinds
import scala.language.implicitConversions
import run.demo.Modules.FreeCalculator.CalcInterp object 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" -> "",
"John" -> ""
)
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
}
Scalaz（39）－ Free ：a real monadic program的更多相关文章
- Scalaz（25）－ Monad： Monad Transformer-叠加Monad效果
中间插播了几篇scalaz数据类型,现在又要回到Monad专题.因为FP的特征就是Monad式编程(Monadic programming),所以必须充分理解认识Monad.熟练掌握Monad运用.曾 ...
- Scalaz（44）－ concurrency ：scalaz Future，尚不完整的多线程类型
scala已经配备了自身的Future类.我们先举个例子来了解scala Future的具体操作: import scala.concurrent._ import ExecutionContext. ...
- Scalaz（43）－ 总结 ：FP就是实用的编程模式
完成了对Free Monad这部分内容的学习了解后,心头豁然开朗,存在心里对FP的疑虑也一扫而光.之前也抱着跟大多数人一样的主观概念,认为FP只适合学术性探讨.缺乏实际应用.运行效率低,很难发展成现实 ...
- Scalaz（41）－ Free ：IO Monad－Free特定版本的FP语法
我们不断地重申FP强调代码无副作用,这样才能实现编程纯代码.像通过键盘显示器进行交流.读写文件.数据库等这些IO操作都会产生副作用.那么我们是不是为了实现纯代码而放弃IO操作呢?没有IO的程序就是一段 ...
- Scalaz（40）－ Free ：versioned up，再回顾
在上一篇讨论里我在设计示范例子时遇到了一些麻烦.由于Free Monad可能是一种主流的FP编程规范,所以在进入实质编程之前必须把所有东西都搞清楚.前面遇到的问题主要与scalaz Free的Free ...
- Scalaz（38）－ Free ：Coproduct－Monadic语句组合
很多函数式编程爱好者都把FP称为Monadic Programming,意思是用Monad进行编程.我想FP作为一种比较成熟的编程模式,应该有一套比较规范的操作模式吧.因为Free能把任何F[A]升格 ...
- Scalaz（37）－ Free ：实践－DB Transaction free style
我一直在不断的提示大家:FP就是Monadic Programming,是一种特殊的编程风格.在我们熟悉的数据库编程领域能不能实现FP风格呢?我们先设计一些示范例子来分析一下惯用的数据库编程过程: i ...
- Scalaz（36）－ Free ：实践－Free In Action - 实用体验
在上面几期讨论中我们连续介绍了Free Monad.因为FP是纯函数编程,也既是纯函数的组合集成,要求把纯代码和副作用代码可以分离开来.Free Monad的程序描述(AST)和程序实现(Interp ...
- Scalaz（35）－ Free ：运算－Trampoline，say NO to StackOverflowError
在前面几次讨论中我们介绍了Free是个产生Monad的最基本结构.它的原理是把一段程序(AST)一连串的运算指令(ADT)转化成数据结构存放在内存里,这个过程是个独立的功能描述过程.然后另一个独立运算 ...
随机推荐
- Atitit 基于图片图像 与文档混合文件夹的分类
Atitit 基于图片图像 与文档混合文件夹的分类 太小的文档(txt doc csv exl ppt pptx)单独分类 Mov10KminiDoc 但是可能会有一些书法图片迁移,因为他们很微小,需 ...
- Atitti css transition Animation differ区别
Atitti css transition Animation differ区别 1.1. transition的优点在于简单易用,但是它有几个很大的局限. 1 1.2. Transition ...
- salesforce 零基础学习（二十三）数据记录导出至excel（自定义报表导出）
我们都知道,报表有个功能为导出excel,但是有的时候客户需求往往标准的报表达不到,比如导出excel,其中本月修改的数据字段标红,如下图所示. 这就需要我们去写VF来实现此功能. 需求:将数据表记录 ...
- [转] SSH原理与运用（2）：远程操作与端口转发
英文:阮一峰 链接:http://www.ruanyifeng.com/blog/2011/12/ssh_port_forwarding.html 接着前一次的文章,继续介绍SSH的用法. (Imag ...
- 分享系列--面试JAVA架构师--链家网
本月7日去了一趟链家网面试,虽然没有面上,但仍有不少收获,在此做个简单的分享,当然了主要是分享给自己,让大家见笑了.因为这次是第一次面试JAVA网站架构师相关的职位,还是有些心虚的,毕竟之前大部分时间 ...
- ZOJ3805Machine(二叉树左右子树变换)
/* 题意:建立一棵二叉树,左子树和父节点占一个宽度,右子树另外占一个宽度! 使任意左右子树交换顺序,使得整个树的宽度最小! 思路:递归交换左右子树 ! 开始写的代码复杂了,其实左右子树不用真的交换, ...
- Yii的学习(1)--安装配置
之前在sina博客写过Yii的文章,来到博客园之后,没再写过关于Yii的文章,正好端午假期没啥事,就结合以前的博客,Yii的官方文档,再加上最近的关于Yii的收获总结一下,写个系列~~ Yii是一个基 ...
- 12个学习 CSS3 网站布局设计的优秀案例
网络上有很多的 CSS 画廊站点供大家对各类网站作品进行打分和评论,每天有数以百计的优秀网站被推荐上面,这对于网页设计师来说是很好的灵感来源.今天,我们选择了15赢得 CSS 设计大奖的优秀作品,帮助 ...
- 【转】FastCgi与PHP-fpm关系
刚开始对这个问题我也挺纠结的,看了<HTTP权威指南>后,感觉清晰了不少. 首先,CGI是干嘛的?CGI是为了保证web server传递过来的数据是标准格式的,方便CGI程序的编写者. ...
- js文件合并，压缩，缓存，延迟加载
做web前段也有一段时间了,对于web中js文件的加载有些体会想跟大家一起分享一下. 1.首先说说js文件的合并和压缩吧 为了便于集中式管理js的合并和压缩我们创建一个Js.ashx文件来专门处理合并 ...