Scalaz（40）－ Free ：versioned up，再回顾
在上一篇讨论里我在设计示范例子时遇到了一些麻烦。由于Free Monad可能是一种主流的FP编程规范，所以在进入实质编程之前必须把所有东西都搞清楚。前面遇到的问题主要与scalaz Free的FreeC类型有关系。这个类型主要是针对一些非Functor的F[A]特别设计的。FreeC是Coyoneda[F,A]的Free Monad类型，任何F[A]都可以被转换成Coyoneda[F,A]，而Coyoneda[F,A]本身是个Functor。因为我们通常都在Functor和非Functor ADT混合应用环境下，所以倾向于通用一些的类型和结构，特别是使用联合语句Coproduct时是不容许不同Free类型的。所以在前面的示范程序里我们只能选用scalaz提供的基于Coyoneda的类型FreeC、升格函数liftFC、及运算函数runFC。最头疼的是使用Coproduct时：Inject的目标语句集G[_]是后置的，在Inject时是否Functor还不明确：
def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = Free.liftFC(I.inj(fa))
由于G[_]是否Functor还不明确，唯一选项也就只能是liftFC了。实际上造成FreeC类型麻烦的根本是Free[S[_],A]类型其中一个实例case class Suspend[S[_],A](s: S[Free[S,A]])，这个实例必须用monad的join来运算，因而要求S必须是个Functor，所以这个版本的Free被称为Free for Functor。另一个原因可能是scalaz借鉴了haskell的实现方式。无论如何，为了解决我们遇到的问题，必须想办法绕过S必须是Functor这个门槛。在查找相关资料时发现Cats的Free里根本没有FreeC这个类型。当然也就没有liftFC这么个升格函数了。Cats Free的Suspend形式是不同的：case class Suspend[F[_],A](s: F[A])，这正是我们所想得到的方式。正想着如何用Cats的Free来替代scalaz Free时才发现最新scalaz版本722（前面我一直使用是scalaz v7.1）里面的Free结构定义竟然已经升级了，看来许多其他的scalaz使用者都应该遇到了相同的麻烦。研究了一下前后两个版本的Free结构定义后发现实际上我们可以用另一个方式来代表Free结构：scalaz/Free.scala
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 C
val 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 = C0
val a = a0
val f = f0
}
上面这段可以用更简单的方式表达，与下面的结构定义相同：
trait Free[S[_],A] case class Return[S[_],A](a: A) extends Free[S,A] case class FlatMap[S[_],A,B](fa: Free[S,A], f: A => Free[S,B]) extends Free[S,B] case class Suspend[S[_],A](s: S[A]) extends Free[S,A]
好了，现在有了这个Suspend我们可以很方便的把任何F[A]升格成Free，这是v722的liftF函数：
/** 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)
在上次的示范例子中遗留下来最需要解决的问题是如何实现多于两种ADT联合语句集的编程，这还是由于联合语句集G[_]是后置的原因。上次遇到的具体问题是无法识别多于两个隐式参数（implicit parameter）、无法编译多于两层的Coproduct、及无法运算（interpret）多于两种联合语句集。在下面我们试试用scalaz722然后设计一套新的编程规范来编写一个由三种ADT组成的Monadic程序：
1、ADTs:
object FreeADTs {
sealed trait Interact[+NextFree]
case class Ask[NextFree](prompt: String, onInput: String => NextFree) extends Interact[NextFree]
case class Tell[NextFree](msg: String, next: NextFree) extends Interact[NextFree]
sealed trait InteractInstances {
object InteractFunctor extends Functor[Interact] {
def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
case Ask(prompt,input) => Ask(prompt, input andThen f)
case Tell(msg,next) => Tell(msg, f(next))
}
}
}
sealed trait InteractFunctions {
def ask[G[_],A](p: String, f: String => A)(implicit I: Inject[Interact,G]): Free[G,A] =
Free.liftF(I.inj(Ask(p,f)))
def tell[G[_],A](m: String)(implicit I: Inject[Interact,G]): Free[G,Unit] =
Free.liftF(I.inj(Tell(m,Free.pure(()))))
}
object Interacts extends InteractInstances with InteractFunctions
}
2、ASTs:
object FreeASTs {
import FreeADTs._
import Interacts._
val interactScript = for {
first <- ask("what's your first name?",identity)
last <- ask("your last name?",identity)
_ <- tell(s"hello, $first $last")
} yield ()
}
object FreeInterps {
import FreeADTs._
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
}
}
}
4、运行：
object FreePrgDemo extends App {
import FreeASTs._
import FreeInterps._
interactScript.foldMapRec(InteractConsole)
}
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)
/**
* [[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 f
def bind[A, B](a: Free[S, A])(f: A => Free[S, B]) = a flatMap f
def 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? tiger your last name? chan hello, tiger chan
现在我们再示范两种ADT的联合语句集编程：
1、ADTs: 增加一个非Functor的ADT UserLogin
sealed trait UserLogin[+A] //非Functor 高阶类
case class CheckId(uid: String) extends UserLogin[Boolean]
case class Login(uid: String, pswd: String) extends UserLogin[Boolean]
sealed trait LoginFunctions {
def checkId[G[_]](uid: String)(implicit I: Inject[UserLogin,G]): Free[G,Boolean] =
Free.liftF(I.inj(CheckId(uid)))
def login[G[_]](uid: String, pswd: String)(implicit I: Inject[UserLogin, G]): Free[G,Boolean] =
Free.liftF(I.inj(Login(uid,pswd)))
}
object Logins extends LoginFunctions
import Logins._
type InteractLogin[A] = Coproduct[Interact,UserLogin,A]
val loginScript = for {
uid <- ask[InteractLogin,String]("what's you id?",identity)
idok <- checkId[InteractLogin](uid)
_ <- if (idok) tell[InteractLogin](s"hi, $uid") else tell[InteractLogin]("sorry, don't know you!")
pwd <- if (idok) ask[InteractLogin,String](s"what's your password?",identity)
else Free.point[InteractLogin,String]("")
login <- if (idok) login[InteractLogin](uid,pwd)
else Free.point[InteractLogin,Boolean](false)
_ <- if (login) tell[InteractLogin](s"congratulations，$uid")
else tell[InteractLogin](idok ? "sorry, no pass!" | "")
} yield login
UserLogin需要验证用户编号和密码，我们通过依赖注入来提供验证功能：
object Dependencies {
trait UserControl {
val pswdMap: Map[String,String]
def validateId: Boolean
def validatePassword: Boolean
}
}
import Dependencies._
type AuthReader[A] = Reader[UserControl,A]
object InteractLogin extends (Interact ~> AuthReader) {
def apply[A](ia: Interact[A]): AuthReader[A] = ia match {
case Ask(p,onInput) => println(p); Reader {m => onInput(readLine)}
case Tell(msg,n) => println(msg); Reader {m => n}
}
}
object LoginConsole extends (UserLogin ~> AuthReader) {
def apply[A](ua: UserLogin[A]): AuthReader[A] = ua match {
case CheckId(uid) => Reader {m => m.validateId(uid)}
case Login(uid,pwd) => Reader {m => m.validatePassword(uid, pwd)}
}
}
def or[F[_],H[_],G[_]](f: F~>G, h: H~>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 -\/(fg) => f(fg)
case \/-(hg) => h(hg)
}
}
object FreeDemo extends App {
import FreeASTs._
import FreeInterps._
import Dependencies._
object AuthControl extends UserControl {
val pswdMap = Map (
"Tiger" -> "1234",
"John" -> "0000"
)
override def validateId(uid: String) =
pswdMap.getOrElse(uid,"???") /== "???"
override def validatePassword(uid: String, pswd: String) =
pswdMap.getOrElse(uid, pswd+"!") === pswd
}
loginScript.foldMapRec(or(InteractLogin,LoginConsole)).run(AuthControl)
what's you id? Tiger hi, Tiger what's your password? 0123 sorry, no pass! ... what's you id? foo sorry, don't know you! ... what's you id? Tiger hi, Tiger what's your password? 1234 congratulations，Tiger
1、ADTs:
sealed trait Permission[+A]
case class HasPermission(uid: String, acc: Int) extends Permission[Boolean]
sealed trait PermissionFunctions {
def hasPermission[G[_]](uid: String, acc: Int)(implicit I: Inject[Permission,G]): Free[G,Boolean] =
Free.liftF(I.inj(HasPermission(uid,acc)))
}
object Permissions extends PermissionFunctions
import Permissions._
type InteractLoginPermission[A] = Coproduct[Permission,InteractLogin,A]
type T[A] = InteractLoginPermission[A]
val authScript = for {
uid <- ask[T,String]("what's you id?",identity)
idok <- checkId[T](uid)
_ <- if (idok) tell[T](s"hi, $uid")
else tell[T]("sorry, don't know you!")
pwd <- if (idok) ask[T,String](s"what's your password?",identity)
else Free.point[T,String]("")
login <- if (idok) login[T](uid,pwd)
else Free.point[T,Boolean](false)
_ <- if (login) tell[T](s"congratulations，$uid")
else tell[T](idok ? "sorry, no pass!" | "")
acc <- if (login) ask[T,Int](s"what's your access code, $uid?",_.toInt)
else Free.point[T,Int](0)
perm <- if (login) hasPermission[T](uid,acc)
else Free.point[T,Boolean](false)
_ <- if (perm) tell[T](s"you may use the system，$uid")
else tell[T]((idok && login) ? "sorry, you are banned!" | "")
} yield ()
这次我们还要通过依赖来验证用户权限Permission，所以需要调整Dependencies：
object Dependencies {
trait UserControl {
val pswdMap: Map[String,String]
def validateId(uid: String): Boolean
def validatePassword(uid: String, pswd: String): Boolean
}
trait AccessControl {
val accMap: Map[String, Int]
def grandAccess(uid: String, acc: Int): Boolean
}
trait Authenticator extends UserControl with AccessControl
}
3、Interpreters：
import Dependencies._
type AuthReader[A] = Reader[Authenticator,A]
object InteractLogin extends (Interact ~> AuthReader) {
def apply[A](ia: Interact[A]): AuthReader[A] = ia match {
case Ask(p,onInput) => println(p); Reader {m => onInput(readLine)}
case Tell(msg,n) => println(msg); Reader {m => n}
}
}
object LoginConsole extends (UserLogin ~> AuthReader) {
def apply[A](ua: UserLogin[A]): AuthReader[A] = ua match {
case CheckId(uid) => Reader {m => m.validateId(uid)}
case Login(uid,pwd) => Reader {m => m.validatePassword(uid, pwd)}
}
}
// type AccessReader[A] = Reader[AccessControl,A]
object PermConsole extends (Permission ~> AuthReader) {
def apply[A](pa: Permission[A]): AuthReader[A] = pa match {
case HasPermission(uid,acc) => Reader {m => m.grandAccess(uid, acc)}
}
}
def or[F[_],H[_],G[_]](f: F~>G, h: H~>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 -\/(fg) => f(fg)
case \/-(hg) => h(hg)
}
}
def among3[F[_],H[_],K[_],G[_]](f: F~>G, h: H~>G, k: K~>G) = {
type FH[A] = Coproduct[F,H,A]
type KFH[A] = Coproduct[K,FH,A]
new (({type l[x] = Coproduct[K,FH,x]})#l ~> G) {
def apply[A](kfh: KFH[A]): G[A] = kfh.run match {
case -\/(kg) => k(kg)
case \/-(cfh) => cfh.run match {
case -\/(fg) => f(fg)
case \/-(hg) => h(hg)
}
}
}
}
4、运算
object FreeDemo extends App {
import FreeASTs._
import FreeInterps._
import Dependencies._
object AuthControl extends Authenticator {
val pswdMap = Map (
"Tiger" -> "1234",
"John" -> "0000"
)
override def validateId(uid: String) =
pswdMap.getOrElse(uid,"???") /== "???"
override def validatePassword(uid: String, pswd: String) =
pswdMap.getOrElse(uid, pswd+"!") === pswd
val accMap = Map (
"Tiger" -> 8,
"John" -> 0
)
override def grandAccess(uid: String, acc: Int) =
accMap.getOrElse(uid, -1) > acc
}
authScript.foldMapRec(among3(InteractLogin,LoginConsole,PermConsole)).run(AuthControl)
// loginScript.foldMapRec(or(InteractLogin,LoginConsole)).run(AuthControl)
// interactScript.foldMapRec(InteractConsole)
}
what's you id? Tiger hi, Tiger what's your password? 1234 congratulations，Tiger what's your access code, Tiger? 3 you may use the system，Tiger
package demo.app
import scalaz._
import Scalaz._
import scala.language.implicitConversions
import scala.language.higherKinds
import com.sun.beans.decoder.FalseElementHandler
import java.rmi.server.UID
object FreeADTs {
sealed trait Interact[NextFree]
case class Ask[NextFree](prompt: String, onInput: String => NextFree) extends Interact[NextFree]
case class Tell[NextFree](msg: String, next: NextFree) extends Interact[NextFree]
sealed trait InteractInstances {
object InteractFunctor extends Functor[Interact] {
def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
case Ask(prompt,input) => Ask(prompt, input andThen f)
case Tell(msg,next) => Tell(msg, f(next))
}
}
}
sealed trait InteractFunctions {
def ask[G[_],A](p: String, f: String => A)(implicit I: Inject[Interact,G]): Free[G,A] =
Free.liftF(I.inj(Ask(p,f)))
def tell[G[_]](m: String)(implicit I: Inject[Interact,G]): Free[G,Unit] =
Free.liftF(I.inj(Tell(m,Free.pure(()))))
}
object Interacts extends InteractInstances with InteractFunctions
sealed trait UserLogin[+A] //非Functor 高阶类
case class CheckId(uid: String) extends UserLogin[Boolean]
case class Login(uid: String, pswd: String) extends UserLogin[Boolean]
sealed trait LoginFunctions {
def checkId[G[_]](uid: String)(implicit I: Inject[UserLogin,G]): Free[G,Boolean] =
Free.liftF(I.inj(CheckId(uid)))
def login[G[_]](uid: String, pswd: String)(implicit I: Inject[UserLogin, G]): Free[G,Boolean] =
Free.liftF(I.inj(Login(uid,pswd)))
}
object Logins extends LoginFunctions
sealed trait Permission[+A]
case class HasPermission(uid: String, acc: Int) extends Permission[Boolean]
sealed trait PermissionFunctions {
def hasPermission[G[_]](uid: String, acc: Int)(implicit I: Inject[Permission,G]): Free[G,Boolean] =
Free.liftF(I.inj(HasPermission(uid,acc)))
}
object Permissions extends PermissionFunctions
}
object FreeASTs {
import FreeADTs._
import Interacts._
val interactScript = for {
first <- ask("what's your first name?",identity)
last <- ask("your last name?",identity)
_ <- tell(s"hello, $first $last")
} yield ()
import Logins._
type InteractLogin[A] = Coproduct[Interact,UserLogin,A]
val loginScript = for {
uid <- ask[InteractLogin,String]("what's you id?",identity)
idok <- checkId[InteractLogin](uid)
_ <- if (idok) tell[InteractLogin](s"hi, $uid") else tell[InteractLogin]("sorry, don't know you!")
pwd <- if (idok) ask[InteractLogin,String](s"what's your password?",identity)
else Free.point[InteractLogin,String]("")
login <- if (idok) login[InteractLogin](uid,pwd)
else Free.point[InteractLogin,Boolean](false)
_ <- if (login) tell[InteractLogin](s"congratulations，$uid")
else tell[InteractLogin](idok ? "sorry, no pass!" | "")
} yield login
import Permissions._
type InteractLoginPermission[A] = Coproduct[Permission,InteractLogin,A]
type T[A] = InteractLoginPermission[A]
val authScript = for {
uid <- ask[T,String]("what's you id?",identity)
idok <- checkId[T](uid)
_ <- if (idok) tell[T](s"hi, $uid")
else tell[T]("sorry, don't know you!")
pwd <- if (idok) ask[T,String](s"what's your password?",identity)
else Free.point[T,String]("")
login <- if (idok) login[T](uid,pwd)
else Free.point[T,Boolean](false)
_ <- if (login) tell[T](s"congratulations，$uid")
else tell[T](idok ? "sorry, no pass!" | "")
acc <- if (login) ask[T,Int](s"what's your access code, $uid?",_.toInt)
else Free.point[T,Int](0)
perm <- if (login) hasPermission[T](uid,acc)
else Free.point[T,Boolean](false)
_ <- if (perm) tell[T](s"you may use the system，$uid")
else tell[T]((idok && login) ? "sorry, you are banned!" | "")
} yield ()
}
object FreeInterps {
import FreeADTs._
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 Dependencies._
type AuthReader[A] = Reader[Authenticator,A]
object InteractLogin extends (Interact ~> AuthReader) {
def apply[A](ia: Interact[A]): AuthReader[A] = ia match {
case Ask(p,onInput) => println(p); Reader {m => onInput(readLine)}
case Tell(msg,n) => println(msg); Reader {m => n}
}
}
object LoginConsole extends (UserLogin ~> AuthReader) {
def apply[A](ua: UserLogin[A]): AuthReader[A] = ua match {
case CheckId(uid) => Reader {m => m.validateId(uid)}
case Login(uid,pwd) => Reader {m => m.validatePassword(uid, pwd)}
}
}
object PermConsole extends (Permission ~> AuthReader) {
def apply[A](pa: Permission[A]): AuthReader[A] = pa match {
case HasPermission(uid,acc) => Reader {m => m.grandAccess(uid, acc)}
}
}
def or[F[_],H[_],G[_]](f: F~>G, h: H~>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 -\/(fg) => f(fg)
case \/-(hg) => h(hg)
}
}
def among3[F[_],H[_],K[_],G[_]](f: F~>G, h: H~>G, k: K~>G) = {
type FH[A] = Coproduct[F,H,A]
type KFH[A] = Coproduct[K,FH,A]
new (({type l[x] = Coproduct[K,FH,x]})#l ~> G) {
def apply[A](kfh: KFH[A]): G[A] = kfh.run match {
case -\/(kg) => k(kg)
case \/-(cfh) => cfh.run match {
case -\/(fg) => f(fg)
case \/-(hg) => h(hg)
}
}
}
}
}
object Dependencies {
trait UserControl {
val pswdMap: Map[String,String]
def validateId(uid: String): Boolean
def validatePassword(uid: String, pswd: String): Boolean
}
trait AccessControl {
val accMap: Map[String, Int]
def grandAccess(uid: String, acc: Int): Boolean
}
trait Authenticator extends UserControl with AccessControl
}
object FreeDemo extends App {
import FreeASTs._
import FreeInterps._
import Dependencies._
object AuthControl extends Authenticator {
val pswdMap = Map (
"Tiger" -> "1234",
"John" -> "0000"
)
override def validateId(uid: String) =
pswdMap.getOrElse(uid,"???") /== "???"
override def validatePassword(uid: String, pswd: String) =
pswdMap.getOrElse(uid, pswd+"!") === pswd
val accMap = Map (
"Tiger" -> 8,
"John" -> 0
)
override def grandAccess(uid: String, acc: Int) =
accMap.getOrElse(uid, -1) > acc
}
authScript.foldMapRec(among3(InteractLogin,LoginConsole,PermConsole)).run(AuthControl)
// loginScript.foldMapRec(or(InteractLogin,LoginConsole)).run(AuthControl)
// interactScript.foldMapRec(InteractConsole)
}