# Scalaz（40）－ Free ：versioned up，再回顾

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

`sealed abstract class Free[S[_], A] {final def map[B](f: A => B): Free[S, B] =flatMap(a => Return(f(a)))/** Alias for `flatMap` */final def >>=[B](f: A => Free[S, B]): Free[S, B] = this flatMap f/** Binds the given continuation to the result of this computation. */final def flatMap[B](f: A => Free[S, B]): Free[S, B] = gosub(this)(f).../** Return from the computation with the given value. */private case class Return[S[_], A](a: A) extends Free[S, A]/** Suspend the computation with the given suspension. */private case class Suspend[S[_], A](a: S[A]) extends Free[S, A]/** Call a subroutine and continue with the given function. */private sealed abstract case class Gosub[S[_], B]() extends Free[S, B] {type Cval a: Free[S, C]val f: C => Free[S, B]}private def gosub[S[_], B, C0](a0: Free[S, C0])(f0: C0 => Free[S, B]): Free[S, B] =new Gosub[S, B] {type C = C0val a = a0val f = f0}`

`1 trait Free[S[_],A]2 case class Return[S[_],A](a: A) extends Free[S,A]3 case class FlatMap[S[_],A,B](fa: Free[S,A], f: A => Free[S,B]) extends Free[S,B]4 case class Suspend[S[_],A](s: S[A]) extends Free[S,A]`

` /** Suspends a value within a functor in a single step. Monadic unit for a higher-order monad. */def liftF[S[_], A](value: S[A]): Free[S, A] =Suspend(value)`

` 1 object FreeADTs {2 sealed trait Interact[+NextFree]3 case class Ask[NextFree](prompt: String, onInput: String => NextFree) extends Interact[NextFree]4 case class Tell[NextFree](msg: String, next: NextFree) extends Interact[NextFree]5 sealed trait InteractInstances {6 object InteractFunctor extends Functor[Interact] {7 def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {8 case Ask(prompt,input) => Ask(prompt, input andThen f)9 case Tell(msg,next) => Tell(msg, f(next))10 }11 }12 }13 sealed trait InteractFunctions {14 def ask[G[_],A](p: String, f: String => A)(implicit I: Inject[Interact,G]): Free[G,A] =15 Free.liftF(I.inj(Ask(p,f)))16 def tell[G[_],A](m: String)(implicit I: Inject[Interact,G]): Free[G,Unit] =17 Free.liftF(I.inj(Tell(m,Free.pure(()))))18 }19 object Interacts extends InteractInstances with InteractFunctions20 }`

2、ASTs:

`1 object FreeASTs {2 import FreeADTs._3 import Interacts._4 val interactScript = for {5 first <- ask("what's your first name?",identity)6 last <- ask("your last name?",identity)7 _ <- tell(s"hello, \$first \$last")8 } yield ()9 }`

3、Interpreter:

`1 object FreeInterps {2 import FreeADTs._3 object InteractConsole extends (Interact ~> Id) {4 def apply[A](ia: Interact[A]): Id[A] = ia match {5 case Ask(p,onInput) => println(p); onInput(readLine)6 case Tell(m,n) => println(m); n7 }8 }9 }`

4、运行：

`1 object FreePrgDemo extends App {2 import FreeASTs._3 import FreeInterps._4 interactScript.foldMapRec(InteractConsole)5 }`

` final def foldMapRec[M[_]](f: S ~> M)(implicit M: Applicative[M], B: BindRec[M]): M[A] =B.tailrecM[Free[S, A], A]{_.step match {case Return(a) => M.point(\/-(a))case Suspend(t) => M.map(f(t))(\/.right)case b @ Gosub() => (b.a: @unchecked) match {case Suspend(t) => M.map(f(t))(a => -\/(b.f(a)))}}}(this)`

foldMapRec又调用了BindRec typeclass的tailrecM函数：

`/*** [[scalaz.Bind]] capable of using constant stack space when doing recursive* binds.** Implementations of `tailrecM` should not make recursive calls without the* `@tailrec` annotation.** Based on Phil Freeman's work on stack safety in PureScript, described in* [[http://functorial.com/stack-safety-for-free/index.pdf Stack Safety for* Free]].*/////trait BindRec[F[_]] extends Bind[F] { self =>////def tailrecM[A, B](f: A => F[A \/ B])(a: A): F[B]`

`sealed abstract class FreeInstances extends FreeInstances0 with TrampolineInstances with SinkInstances with SourceInstances {implicit def freeMonad[S[_]]: Monad[Free[S, ?]] with BindRec[Free[S, ?]] =new Monad[Free[S, ?]] with BindRec[Free[S, ?]] {override def map[A, B](fa: Free[S, A])(f: A => B) = fa map fdef bind[A, B](a: Free[S, A])(f: A => Free[S, B]) = a flatMap fdef point[A](a: => A) = Free.point(a)// Free trampolines, should be alright to just perform binds.def tailrecM[A, B](f: A => Free[S, A \/ B])(a: A): Free[S, B] =f(a).flatMap(_.fold(tailrecM(f), point(_)))}...`

`what's your first name?tigeryour last name?chanhello, tiger chan`

` 1 sealed trait UserLogin[+A] //非Functor 高阶类2 case class CheckId(uid: String) extends UserLogin[Boolean]3 case class Login(uid: String, pswd: String) extends UserLogin[Boolean]4 sealed trait LoginFunctions {5 def checkId[G[_]](uid: String)(implicit I: Inject[UserLogin,G]): Free[G,Boolean] =6 Free.liftF(I.inj(CheckId(uid)))7 def login[G[_]](uid: String, pswd: String)(implicit I: Inject[UserLogin, G]): Free[G,Boolean] =8 Free.liftF(I.inj(Login(uid,pswd)))9 }10 object Logins extends LoginFunctions`

2、ASTs：

` 1 import Logins._2 type InteractLogin[A] = Coproduct[Interact,UserLogin,A]3 val loginScript = for {4 uid <- ask[InteractLogin,String]("what's you id?",identity)5 idok <- checkId[InteractLogin](uid)6 _ <- if (idok) tell[InteractLogin](s"hi, \$uid") else tell[InteractLogin]("sorry, don't know you!")7 pwd <- if (idok) ask[InteractLogin,String](s"what's your password?",identity)8 else Free.point[InteractLogin,String]("")9 login <- if (idok) login[InteractLogin](uid,pwd)10 else Free.point[InteractLogin,Boolean](false)11 _ <- if (login) tell[InteractLogin](s"congratulations，\$uid")12 else tell[InteractLogin](idok ? "sorry, no pass!" | "")13 } yield login `

`1 object Dependencies {2 trait UserControl {3 val pswdMap: Map[String,String]4 def validateId: Boolean5 def validatePassword: Boolean6 }7 }`

` 1 import Dependencies._2 type AuthReader[A] = Reader[UserControl,A]3 object InteractLogin extends (Interact ~> AuthReader) {4 def apply[A](ia: Interact[A]): AuthReader[A] = ia match {5 case Ask(p,onInput) => println(p); Reader {m => onInput(readLine)}6 case Tell(msg,n) => println(msg); Reader {m => n}7 }8 }9 object LoginConsole extends (UserLogin ~> AuthReader) {10 def apply[A](ua: UserLogin[A]): AuthReader[A] = ua match {11 case CheckId(uid) => Reader {m => m.validateId(uid)}12 case Login(uid,pwd) => Reader {m => m.validatePassword(uid, pwd)}13 }14 }15 def or[F[_],H[_],G[_]](f: F~>G, h: H~>G) =16 new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {17 def apply[A](ca: Coproduct[F,H,A]):G[A] = ca.run match {18 case -\/(fg) => f(fg)19 case \/-(hg) => h(hg)20 }21 }`

4、运算时把依赖注入：

` 1 object FreeDemo extends App {2 import FreeASTs._3 import FreeInterps._4 import Dependencies._5 object AuthControl extends UserControl {6 val pswdMap = Map (7 "Tiger" -> "1234",8 "John" -> "0000"9 )10 override def validateId(uid: String) =11 pswdMap.getOrElse(uid,"???") /== "???"12 override def validatePassword(uid: String, pswd: String) =13 pswdMap.getOrElse(uid, pswd+"!") === pswd14 }1516 loginScript.foldMapRec(or(InteractLogin,LoginConsole)).run(AuthControl)`

`what's you id?Tigerhi, Tigerwhat's your password?0123sorry, no pass!...what's you id?foosorry, don't know you!...what's you id?Tigerhi, Tigerwhat's your password?1234congratulations，Tiger`

`1 sealed trait Permission[+A]2 case class HasPermission(uid: String, acc: Int) extends Permission[Boolean]3 sealed trait PermissionFunctions {4 def hasPermission[G[_]](uid: String, acc: Int)(implicit I: Inject[Permission,G]): Free[G,Boolean] =5 Free.liftF(I.inj(HasPermission(uid,acc)))6 }7 object Permissions extends PermissionFunctions`

2、ASTs:

` 1 import Permissions._2 type InteractLoginPermission[A] = Coproduct[Permission,InteractLogin,A]3 type T[A] = InteractLoginPermission[A]4 val authScript = for {5 uid <- ask[T,String]("what's you id?",identity)6 idok <- checkId[T](uid)7 _ <- if (idok) tell[T](s"hi, \$uid")8 else tell[T]("sorry, don't know you!")9 pwd <- if (idok) ask[T,String](s"what's your password?",identity)10 else Free.point[T,String]("")11 login <- if (idok) login[T](uid,pwd)12 else Free.point[T,Boolean](false)13 _ <- if (login) tell[T](s"congratulations，\$uid")14 else tell[T](idok ? "sorry, no pass!" | "")15 acc <- if (login) ask[T,Int](s"what's your access code, \$uid?",_.toInt)16 else Free.point[T,Int](0)17 perm <- if (login) hasPermission[T](uid,acc)18 else Free.point[T,Boolean](false)19 _ <- if (perm) tell[T](s"you may use the system，\$uid")20 else tell[T]((idok && login) ? "sorry, you are banned!" | "")2122 } yield ()`

` 1 object Dependencies {2 trait UserControl {3 val pswdMap: Map[String,String]4 def validateId(uid: String): Boolean5 def validatePassword(uid: String, pswd: String): Boolean6 }7 trait AccessControl {8 val accMap: Map[String, Int]9 def grandAccess(uid: String, acc: Int): Boolean10 }11 trait Authenticator extends UserControl with AccessControl12 }`

3、Interpreters：

` 1 import Dependencies._2 type AuthReader[A] = Reader[Authenticator,A]3 object InteractLogin extends (Interact ~> AuthReader) {4 def apply[A](ia: Interact[A]): AuthReader[A] = ia match {5 case Ask(p,onInput) => println(p); Reader {m => onInput(readLine)}6 case Tell(msg,n) => println(msg); Reader {m => n}7 }8 }9 object LoginConsole extends (UserLogin ~> AuthReader) {10 def apply[A](ua: UserLogin[A]): AuthReader[A] = ua match {11 case CheckId(uid) => Reader {m => m.validateId(uid)}12 case Login(uid,pwd) => Reader {m => m.validatePassword(uid, pwd)}13 }14 }15 // type AccessReader[A] = Reader[AccessControl,A]16 object PermConsole extends (Permission ~> AuthReader) {17 def apply[A](pa: Permission[A]): AuthReader[A] = pa match {18 case HasPermission(uid,acc) => Reader {m => m.grandAccess(uid, acc)}19 }20 }21 def or[F[_],H[_],G[_]](f: F~>G, h: H~>G) =22 new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {23 def apply[A](ca: Coproduct[F,H,A]):G[A] = ca.run match {24 case -\/(fg) => f(fg)25 case \/-(hg) => h(hg)26 }27 }28 def among3[F[_],H[_],K[_],G[_]](f: F~>G, h: H~>G, k: K~>G) = {29 type FH[A] = Coproduct[F,H,A]30 type KFH[A] = Coproduct[K,FH,A]31 new (({type l[x] = Coproduct[K,FH,x]})#l ~> G) {32 def apply[A](kfh: KFH[A]): G[A] = kfh.run match {33 case -\/(kg) => k(kg)34 case \/-(cfh) => cfh.run match {35 case -\/(fg) => f(fg)36 case \/-(hg) => h(hg)37 }38 }39 }40 }`

4、运算：

` 1 object FreeDemo extends App {2 import FreeASTs._3 import FreeInterps._4 import Dependencies._5 object AuthControl extends Authenticator {6 val pswdMap = Map (7 "Tiger" -> "1234",8 "John" -> "0000"9 )10 override def validateId(uid: String) =11 pswdMap.getOrElse(uid,"???") /== "???"12 override def validatePassword(uid: String, pswd: String) =13 pswdMap.getOrElse(uid, pswd+"!") === pswd1415 val accMap = Map (16 "Tiger" -> 8,17 "John" -> 018 )19 override def grandAccess(uid: String, acc: Int) =20 accMap.getOrElse(uid, -1) > acc21 }22 authScript.foldMapRec(among3(InteractLogin,LoginConsole,PermConsole)).run(AuthControl)23 // loginScript.foldMapRec(or(InteractLogin,LoginConsole)).run(AuthControl)24 // interactScript.foldMapRec(InteractConsole)2526 }`

`what's you id?Tigerhi, Tigerwhat's your password?1234congratulations，Tigerwhat's your access code, Tiger?3you may use the system，Tiger`

Beautiful! 下面是本文示范的完整代码：

` 1 package demo.app2 import scalaz._3 import Scalaz._4 import scala.language.implicitConversions5 import scala.language.higherKinds6 import com.sun.beans.decoder.FalseElementHandler7 import java.rmi.server.UID89 object FreeADTs {10 sealed trait Interact[NextFree]11 case class Ask[NextFree](prompt: String, onInput: String => NextFree) extends Interact[NextFree]12 case class Tell[NextFree](msg: String, next: NextFree) extends Interact[NextFree]13 sealed trait InteractInstances {14 object InteractFunctor extends Functor[Interact] {15 def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {16 case Ask(prompt,input) => Ask(prompt, input andThen f)17 case Tell(msg,next) => Tell(msg, f(next))18 }19 }20 }21 sealed trait InteractFunctions {22 def ask[G[_],A](p: String, f: String => A)(implicit I: Inject[Interact,G]): Free[G,A] =23 Free.liftF(I.inj(Ask(p,f)))24 def tell[G[_]](m: String)(implicit I: Inject[Interact,G]): Free[G,Unit] =25 Free.liftF(I.inj(Tell(m,Free.pure(()))))26 }27 object Interacts extends InteractInstances with InteractFunctions2829 sealed trait UserLogin[+A] //非Functor 高阶类30 case class CheckId(uid: String) extends UserLogin[Boolean]31 case class Login(uid: String, pswd: String) extends UserLogin[Boolean]32 sealed trait LoginFunctions {33 def checkId[G[_]](uid: String)(implicit I: Inject[UserLogin,G]): Free[G,Boolean] =34 Free.liftF(I.inj(CheckId(uid)))35 def login[G[_]](uid: String, pswd: String)(implicit I: Inject[UserLogin, G]): Free[G,Boolean] =36 Free.liftF(I.inj(Login(uid,pswd)))37 }38 object Logins extends LoginFunctions39 sealed trait Permission[+A]40 case class HasPermission(uid: String, acc: Int) extends Permission[Boolean]41 sealed trait PermissionFunctions {42 def hasPermission[G[_]](uid: String, acc: Int)(implicit I: Inject[Permission,G]): Free[G,Boolean] =43 Free.liftF(I.inj(HasPermission(uid,acc)))44 }45 object Permissions extends PermissionFunctions46 }47 object FreeASTs {48 import FreeADTs._49 import Interacts._50 val interactScript = for {51 first <- ask("what's your first name?",identity)52 last <- ask("your last name?",identity)53 _ <- tell(s"hello, \$first \$last")54 } yield ()55 import Logins._56 type InteractLogin[A] = Coproduct[Interact,UserLogin,A]57 val loginScript = for {58 uid <- ask[InteractLogin,String]("what's you id?",identity)59 idok <- checkId[InteractLogin](uid)60 _ <- if (idok) tell[InteractLogin](s"hi, \$uid") else tell[InteractLogin]("sorry, don't know you!")61 pwd <- if (idok) ask[InteractLogin,String](s"what's your password?",identity)62 else Free.point[InteractLogin,String]("")63 login <- if (idok) login[InteractLogin](uid,pwd)64 else Free.point[InteractLogin,Boolean](false)65 _ <- if (login) tell[InteractLogin](s"congratulations，\$uid")66 else tell[InteractLogin](idok ? "sorry, no pass!" | "")67 } yield login68 import Permissions._69 type InteractLoginPermission[A] = Coproduct[Permission,InteractLogin,A]70 type T[A] = InteractLoginPermission[A]71 val authScript = for {72 uid <- ask[T,String]("what's you id?",identity)73 idok <- checkId[T](uid)74 _ <- if (idok) tell[T](s"hi, \$uid")75 else tell[T]("sorry, don't know you!")76 pwd <- if (idok) ask[T,String](s"what's your password?",identity)77 else Free.point[T,String]("")78 login <- if (idok) login[T](uid,pwd)79 else Free.point[T,Boolean](false)80 _ <- if (login) tell[T](s"congratulations，\$uid")81 else tell[T](idok ? "sorry, no pass!" | "")82 acc <- if (login) ask[T,Int](s"what's your access code, \$uid?",_.toInt)83 else Free.point[T,Int](0)84 perm <- if (login) hasPermission[T](uid,acc)85 else Free.point[T,Boolean](false)86 _ <- if (perm) tell[T](s"you may use the system，\$uid")87 else tell[T]((idok && login) ? "sorry, you are banned!" | "")8889 } yield ()90 }91 object FreeInterps {92 import FreeADTs._93 object InteractConsole extends (Interact ~> Id) {94 def apply[A](ia: Interact[A]): Id[A] = ia match {95 case Ask(p,onInput) => println(p); onInput(readLine)96 case Tell(m,n) => println(m); n97 }98 }99 import Dependencies._100 type AuthReader[A] = Reader[Authenticator,A]101 object InteractLogin extends (Interact ~> AuthReader) {102 def apply[A](ia: Interact[A]): AuthReader[A] = ia match {103 case Ask(p,onInput) => println(p); Reader {m => onInput(readLine)}104 case Tell(msg,n) => println(msg); Reader {m => n}105 }106 }107 object LoginConsole extends (UserLogin ~> AuthReader) {108 def apply[A](ua: UserLogin[A]): AuthReader[A] = ua match {109 case CheckId(uid) => Reader {m => m.validateId(uid)}110 case Login(uid,pwd) => Reader {m => m.validatePassword(uid, pwd)}111 }112 }113 object PermConsole extends (Permission ~> AuthReader) {114 def apply[A](pa: Permission[A]): AuthReader[A] = pa match {115 case HasPermission(uid,acc) => Reader {m => m.grandAccess(uid, acc)}116 }117 }118 def or[F[_],H[_],G[_]](f: F~>G, h: H~>G) =119 new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {120 def apply[A](ca: Coproduct[F,H,A]):G[A] = ca.run match {121 case -\/(fg) => f(fg)122 case \/-(hg) => h(hg)123 }124 }125 def among3[F[_],H[_],K[_],G[_]](f: F~>G, h: H~>G, k: K~>G) = {126 type FH[A] = Coproduct[F,H,A]127 type KFH[A] = Coproduct[K,FH,A]128 new (({type l[x] = Coproduct[K,FH,x]})#l ~> G) {129 def apply[A](kfh: KFH[A]): G[A] = kfh.run match {130 case -\/(kg) => k(kg)131 case \/-(cfh) => cfh.run match {132 case -\/(fg) => f(fg)133 case \/-(hg) => h(hg)134 }135 }136 }137 }138 }139 object Dependencies {140 trait UserControl {141 val pswdMap: Map[String,String]142 def validateId(uid: String): Boolean143 def validatePassword(uid: String, pswd: String): Boolean144 }145 trait AccessControl {146 val accMap: Map[String, Int]147 def grandAccess(uid: String, acc: Int): Boolean148 }149 trait Authenticator extends UserControl with AccessControl150 }151 object FreeDemo extends App {152 import FreeASTs._153 import FreeInterps._154 import Dependencies._155 object AuthControl extends Authenticator {156 val pswdMap = Map (157 "Tiger" -> "1234",158 "John" -> "0000"159 )160 override def validateId(uid: String) =161 pswdMap.getOrElse(uid,"???") /== "???"162 override def validatePassword(uid: String, pswd: String) =163 pswdMap.getOrElse(uid, pswd+"!") === pswd164165 val accMap = Map (166 "Tiger" -> 8,167 "John" -> 0168 )169 override def grandAccess(uid: String, acc: Int) =170 accMap.getOrElse(uid, -1) > acc171 }172 authScript.foldMapRec(among3(InteractLogin,LoginConsole,PermConsole)).run(AuthControl)173 // loginScript.foldMapRec(or(InteractLogin,LoginConsole)).run(AuthControl)174 // interactScript.foldMapRec(InteractConsole)175176 }`