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
    }

上面这段可以用更简单的方式表达,与下面的结构定义相同:

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]

我们把Suspend(S[Free[S,A]])变成Suspend(S[A]),增加了一个实例FlatMap。现在这个Suspend状态代表了一步运算,FlatMap状态代表连续运算,FlatMap和Suspend(S[A])加在一起可以替代Suspend(S[Free[S,A]])状态。我们知道Suspend的主要意义是在于对Free结构进行Interpret时对存放在内存里的各种状态进行运算时:如果是Return返回结果、FlatMap是连续运算,那么Suspend就扮演着Free[S,A] => M[A]这么个函数角色了。分析上面的代码不难发现FlatMap就是Gusub。

好了,现在有了这个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)

上面的描述不正确:a value within a functor 应该是 a value within a type constructor。

在上次的示范例子中遗留下来最需要解决的问题是如何实现多于两种ADT联合语句集的编程,这还是由于联合语句集G[_]是后置的原因。上次遇到的具体问题是无法识别多于两个隐式参数(implicit parameter)、无法编译多于两层的Coproduct、及无法运算(interpret)多于两种联合语句集。在下面我们试试用scalaz722然后设计一套新的编程规范来编写一个由三种ADT组成的Monadic程序:

1、ADTs:

 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 InteractFunctions
20 }

如上所述,我们采用了一种 xxx trait, xxxInstances, xxxFunctions, xxxs 规范。

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); n
7     }
8   }  
9 }

4、运行:

1 object FreePrgDemo extends App {
2   import FreeASTs._
3   import FreeInterps._
4   interactScript.foldMapRec(InteractConsole)
5 }

我们在这里调用了新版本scalaz Free里的foldMapRec函数:

  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]

这个BindRec typeclass可以保证递归运算的堆栈安全。在Free.scala里可以找到BindRec的实例,它具体实现了这个tailrecM函数:

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(_)))
    }
...

有了foldMapRec我们可以放心运算任何规模的AST。下面是运行结果样本:

what's your first name?
tiger
your last name?
chan
hello, tiger chan

现在我们再示范两种ADT的联合语句集编程:

1、ADTs: 增加一个非Functor的ADT UserLogin

 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 

 UserLogin需要验证用户编号和密码,我们通过依赖注入来提供验证功能:

1 object Dependencies {
2   trait UserControl {
3     val pswdMap: Map[String,String]
4     def validateId: Boolean
5     def validatePassword: Boolean
6   }
7 }

3、Interpreter:需要用Reader来注入UserControl依赖。现在的AST是个两种ADT的联合语句集,所以需要符合类型的语法解析函数,并且两种ADT的最终运算环境(context)必须一致用Reader:

 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+"!") === pswd
14   }
15   
16   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

下面我们在这个基础上再增加一个ADT:Permission

1、ADTs:

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!" | "") 
21            
22   } yield ()

这次我们还要通过依赖来验证用户权限Permission,所以需要调整Dependencies:

 1 object Dependencies {
 2   trait UserControl {
 3     val pswdMap: Map[String,String]
 4     def validateId(uid: String): Boolean
 5     def validatePassword(uid: String, pswd: String): Boolean
 6   }
 7   trait AccessControl {
 8     val accMap: Map[String, Int]
 9     def grandAccess(uid: String, acc: Int): Boolean
10   }
11   trait Authenticator extends UserControl with AccessControl
12 }

增加了AccessControl,然后用Authenticator统一它们

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   }

调整了依赖类型。增加三种ADT语句集解析函数among3。

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+"!") === pswd
14       
15    val accMap = Map (
16      "Tiger" -> 8,
17      "John" -> 0
18    )  
19    override def grandAccess(uid: String, acc: Int) =
20      accMap.getOrElse(uid, -1) > acc
21   }
22   authScript.foldMapRec(among3(InteractLogin,LoginConsole,PermConsole)).run(AuthControl)
23 //  loginScript.foldMapRec(or(InteractLogin,LoginConsole)).run(AuthControl)
24 //  interactScript.foldMapRec(InteractConsole)
25   
26 }

运算结果:

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

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

  1 package demo.app
  2 import scalaz._
  3 import Scalaz._
  4 import scala.language.implicitConversions
  5 import scala.language.higherKinds
  6 import com.sun.beans.decoder.FalseElementHandler
  7 import java.rmi.server.UID
  8 
  9 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 InteractFunctions
 28   
 29   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 LoginFunctions
 39   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 PermissionFunctions
 46 }
 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 login
 68   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!" | "") 
 88            
 89   } 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); n
 97     }
 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): Boolean
143     def validatePassword(uid: String, pswd: String): Boolean
144   }
145   trait AccessControl {
146     val accMap: Map[String, Int]
147     def grandAccess(uid: String, acc: Int): Boolean
148   }
149   trait Authenticator extends UserControl with AccessControl
150 }
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+"!") === pswd
164       
165    val accMap = Map (
166      "Tiger" -> 8,
167      "John" -> 0
168    )  
169    override def grandAccess(uid: String, acc: Int) =
170      accMap.getOrElse(uid, -1) > acc
171   }
172   authScript.foldMapRec(among3(InteractLogin,LoginConsole,PermConsole)).run(AuthControl)
173 //  loginScript.foldMapRec(or(InteractLogin,LoginConsole)).run(AuthControl)
174 //  interactScript.foldMapRec(InteractConsole)
175   
176 }

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

发表于

我来说两句

0 条评论
登录 后参与评论

相关文章

来自专栏CDA数据分析师

10个应该早点知道的Python技巧

我的这一生都在编程,但是我没有成为一名程序员。最初,我的大部分工作都是用Visual Basic来完成的,还包括一些其它语言工具,比如R语言,C语言、JavaS...

2099
来自专栏刘笑江的专栏

通过Swift学函数式编程

在文章SWIFT IS A LOT LIKE SCALA [1] 提到Swift和Scala有很大的相似之处,在某些特性甚至比Scala对函数式编程的支持更友好...

1445
来自专栏Java学习网

编程的智慧特点

  编程是一种创造性的工作,是一门艺术。精通任何一门艺术,都需要很多的练习和领悟,所以这里提出的“智慧”,并不是号称一天瘦十斤的减肥药,它并不能代替你自己的勤奋...

3216
来自专栏一个会写诗的程序员的博客

第1章 JVM语言家族概览

所谓编程语言只是一个抽象的规范,而编译器是这个规范的实现,它是在这个规范的严格定义下被实现的.

873
来自专栏编舟记

我是怎样学习新编程语言的

学习新的编程语言的最终目的是解决实际问题。掌握编程语言的过程,在某种程度上近似学习一种新的工程实践。不仅解决问题固然可乐,学习的过程也同样充满了新鲜感,不过需要...

673
来自专栏王亚昌的专栏

Google C++ 风格指南 - 中文版 [值得收藏]

http://yangyubo.com/google-cpp-styleguide/ 很实用的手册,感觉象是effective c++,但其中明确指出了一些...

611
来自专栏数据库

httpclient如何快速往数据库里添加测试用例

本人在使用httpclient做接口测试的过程中,使用数据库管理用例,其中存的key-value的形式,由于接口的参数可能比较多,所以一个个用例写起来会比较麻烦...

1679
来自专栏生信宝典

Python学习没有捷径,但可以加速,零基础九天你也可以会编程

在小学生都学Python了,你还不知道怎么开始文中介绍了Python的应用广泛,功能强大,提供了Python的在线学习视频和资料等 (收集资料是我们的最爱)。...

17410
来自专栏walterlv - 吕毅的博客

不再为命名而苦恼!使用 MSTestEnhancer 单元测试扩展,写契约就够了

发布于 2018-02-22 11:52 更新于 2018-08...

571
来自专栏ImportSource

设计模式-用接口来实现filter!梭梭就是干!

本期分享的内容是如何通过接口来实现filter。我们可以叫此模式为filter pattern,过滤器模式。 没错,正如题所说,核心就是接口。 实际需求 抽象...

2545

扫码关注云+社区