Cats(4)- 叠加Free程序运算结果,Stacking monadic result types详解编程语言

   在前面的几篇关于Free编程的讨论示范中我们均使用了基础类型的运算结果。但在实际应用中因为需要考虑运算中出现异常的情况,常常会需要到更高阶复杂的运算结果类型如Option、Xor等。因为Monad无法实现组合(monad do not compose),我们如何在for-comprehension中组合这些运算呢?假如在我们上一篇讨论里的示范DSL是这样的:

1 trait Login[+A] 
2  case class Authenticate(uid: String, pwd: String) extends Login[Option[Boolean]] 
3   
4  trait Auth[+A] 
5  case class Authorize(uid: String) extends Auth[Xor[String,Boolean]]

这两个ADT在for-comprehension里如果我们勉强将Option和Xor叠加在一起就会产生所谓下台阶式运算(stair-stepping),因为monad do not compose! 我们可以看看下面的示范: 

1  type Result[A] = Xor[String,Option[A]] 
2  def getResult: Result[Int] = 62.some.right       //> getResult: => demo.ws.catsMTX.Result[Int] 
3  for { 
4    optValue <- getResult 
5  } yield { 
6    for { 
7      valueA <- optValue 
8    } yield valueA + 18                            //> res0: cats.data.Xor[String,Option[Int]] = Right(Some(80)) 
9  }

我们必须用两层for-comprehension来组合最终结果。这就是所谓的下台阶运算了。如果遇到三层叠加类型,那么整个程序会变得更加复杂了。其实不单是程序结构复杂问题,更重要的是运算效果(effect)无法正确体现:出现None和Left值时并不能立即终止for-comprehension、再就是如果第一层是有副作用(side-effect)运算时,由于我们必须先得出第一层的运算结果才能进行下一层运算,所以这个for-comprehension产生了不纯代码(impure-code),如下:

1 for { 
2   optionData <- IO {readDB()} 
3 } yield { 
4   for { 
5     data <- optionData 
6   } yield Process(data) 
7 }

我们必须先运算IO才能开始运算Process。这就使这段程序变成了不纯代码。我在一篇scalaz-monadtransform的博客中介绍了如何用MonadTransformer来解决这种类型堆叠的问题,大家可以参考。cats同样实现了几个类型的MonadTransformer如:OptionT、EitherT、StateT、WriterT、Kleisli等等,命名方式都是以类型名称尾缀加T的规范方式,如:

final case class OptionT[F[_], A](value: F[Option[A]]) {...} 
inal case class EitherT[F[_], A, B](value: F[Either[A, B]]) {...} 
final class StateT[F[_], S, A](val runF: F[S => F[(S, A)]]) extends Serializable {...} 
final case class WriterT[F[_], L, V](run: F[(L, V)]) {...}

我们可以从MonadTransformer的value或run,runF获取其代表的数据类型,如:

OptionT[Xor,A](value: Xor[?,Option[A]]) >>> 代表的类型:Xor[?,Option[A]]

XorT[OptionT,A](value: Option[Xor[?,A]]) >>>代表的类型:Option[Xor[?,A]]

我们可以用Applicative.pure来把一个值升格成堆叠类型:

 1 import cats._,cats.instances.all._ 
 2 import cats.data.{Xor,XorT} 
 3 import cats.syntax.xor._ 
 4 import cats.data.OptionT 
 5 import cats.syntax.option._ 
 6 import cats.syntax.applicative._ 
 7  
 8  type Error[A] = Xor[String,A] 
 9  type XResult[A] = OptionT[Error,A] 
10  type OResult[A] = XorT[Option,String,A] 
11  Applicative[XResult].pure(62)             //> res0: demo.ws.catsMTX.XResult[Int] = OptionT(Right(Some(62))) 
12  62.pure[XResult]                          //> res1: demo.ws.catsMTX.XResult[Int] = OptionT(Right(Some(62))) 
13  Applicative[OResult].pure(62)             //> res2: demo.ws.catsMTX.OResult[Int] = XorT(Some(Right(62))) 
14  62.pure[OResult]                          //> res3: demo.ws.catsMTX.OResult[Int] = XorT(Some(Right(62)))

注意,用Applicative.pure来升格None或者Left会产生错误结果:

 1  Applicative[XResult].pure(none[Int])              
 2 //> res4: demo.ws.catsMTX.XResult[Option[Int]] = OptionT(Right(Some(None))) 
 3  (None: Option[Int]).pure[XResult]                 
 4 //> res5: demo.ws.catsMTX.XResult[Option[Int]] = OptionT(Right(Some(None))) 
 5  Applicative[XResult].pure("oh no".left[Int])     
 6  //> res6: demo.ws.catsMTX.XResult[cats.data.Xor[String,Int]] = OptionT(Right(Some(Left(oh no)))) 
 7  (Left[String,Int]("oh no")).pure[XResult]       
 8 //> res7: demo.ws.catsMTX.XResult[scala.util.Left[String,Int]] = OptionT(Right(Some(Left(oh no)))) 
 9  Applicative[OResult].pure(Left[String,Int]("oh no")) 
10 //> res8: demo.ws.catsMTX.OResult[scala.util.Left[String,Int]] = XorT(Some(Right(Left(oh no)))) 
11  "oh no".left[Int].pure[OResult]                   
12 //> res9: demo.ws.catsMTX.OResult[cats.data.Xor[String,Int]] = XorT(Some(Right(Left(oh no)))) 
13  Applicative[OResult].pure(none[Int])              
14 //> res10: demo.ws.catsMTX.OResult[Option[Int]] = XorT(Some(Right(None))) 
15  (None: Option[Int]).pure[OResult]                 
16 //> res11: demo.ws.catsMTX.OResult[Option[Int]] = XorT(Some(Right(None))) 
17  Applicative[OResult].pure("oh no".left[Int]) 
18 //> res12: demo.ws.catsMTX.OResult[cats.data.Xor[String,Int]] = XorT(Some(Right(Left(oh no)))) 
19  (Left[String,Int]("oh no")).pure[OResult] 
20 //> res13: demo.ws.catsMTX.OResult[scala.util.Left[String,Int]] = XorT(Some(Right(Left(oh no))))

Some(None),Right(Left(“oh no)))是什么意思呢?明显是错误。我们必须用MonadTransformer的构建器(constructor)才能正确的对这些边际值进行升格:

1  OptionT(none[Int].pure[Error])                    
2 //> res14: cats.data.OptionT[demo.ws.catsMTX.Error,Int] = OptionT(Right(None)) 
3  OptionT("oh no".left: Error[Option[Int]]) 
4 //> res15: cats.data.OptionT[demo.ws.catsMTX.Error,Int] = OptionT(Left(oh no)) 
5  XorT(none[Error[Int]])                            
6 //> res16: cats.data.XorT[Option,String,Int] = XorT(None) 
7  XorT("oh no".left[Int].pure[Option])              
8 //> res17: cats.data.XorT[Option,String,Int] = XorT(Some(Left(oh no)))

下面我们示范一下在for-comprehension中运算Xor[?Option[A]]这种堆叠类型:

 1  type Error[A] = Xor[String,A] 
 2  type XResult[A] = OptionT[Error,A] 
 3  type OResult[A] = XorT[Option,String,A] 
 4  def getXor(s: String): Error[String] = s.right   //> getXor: (s: String)demo.ws.catsMTX.Error[String] 
 5  def getOption(s: String): Option[String] = s.some 
 6                                                   //> getOption: (s: String)Option[String] 
 7   val composed: XResult[String] = 
 8    for { 
 9       s1 <- OptionT.liftF(getXor("Hello ")) 
10       s2 <- OptionT.liftF(getXor("World!")) 
11       s3 <- OptionT(getOption("come to papa!").pure[Error]) 
12    } yield s1 + s2 + s3     //> composed  : demo.ws.catsMTX.XResult[String] = OptionT(Right(Some(Hello World!come to papa!))) 
13    composed.value           //> res18: demo.ws.catsMTX.Error[Option[String]] = Right(Some(Hello World!come to papa!))

测试一下Xor,Option的left和none效果:

 1  val composed: XResult[String] = 
 2    for { 
 3       s1 <- OptionT.liftF(getXor("Hello ")) 
 4       s0 <- OptionT(none[String].pure[Error]) 
 5       s2 <- OptionT.liftF(getXor("World!")) 
 6       s3 <- OptionT(getOption("come to papa!").pure[Error]) 
 7    } yield s1 + s2 + s3      //> composed  : demo.ws.catsMTX.XResult[String] = OptionT(Right(None)) 
 8    composed.value            //> res18: demo.ws.catsMTX.Error[Option[String]] = Right(None) 
 9  
10   val composed: XResult[String] = 
11    for { 
12       s1 <- OptionT.liftF(getXor("Hello ")) 
13       s0 <- OptionT("oh no".left: Error[Option[Int]]) 
14       s2 <- OptionT.liftF(getXor("World!")) 
15       s3 <- OptionT(getOption("come to papa!").pure[Error]) 
16    } yield s1 + s2 + s3       //> composed  : demo.ws.catsMTX.XResult[String] = OptionT(Left(oh no)) 
17    composed.value             //> res18: demo.ws.catsMTX.Error[Option[String]] = Left(oh no)

从运算结果我们看到在for-comprehension中这个堆叠类型的组成类型Xor和Option的效果可以得到体现。

在现实中三层以上的运算结果类型堆叠还是很普遍的,如:Future[Xor[?,Option[A]]]。要注意MonadTransformer类型堆叠的顺序是重要的,而且是由内向外的,决定着最终运算结果的类型。如果增加一层Future类型,我们就需要把它放到堆叠结构的最内部:

 

1    type FError[A] = XorT[Future,String,A] 
2    type FResult[A] = OptionT[FError,A]

 

现在我们需要考虑如何进行MonadTransformer类型的升格了。请相信我,这项工作绝对是一场噩梦。具体示范可以在我这篇博客scalaz-monadtransformer中找到。我的意思是如果没有更好的办法,这项工作基本是一项不可能的任务(mission impossible)。

对于上面提出的问题,freeK提供了很好的解决方法。freeK的Onion数据类型就是为简化Monad堆叠操作而设计的。Onion表达形式如下:

 

1 type Stack[A] = F[G[H[I[A]]]] 
2 type O = F :&: G :&: H :&: I :&: Bulb 
3 type Stack[A] = O#Layers[A]

 

O就是Onion类型,代表了一个Monad堆叠。我们可以用O#Layers[A]返还原始的多层Monad,如下面的示例:

 

1   import freek._ 
2    type O = Xor[String,?] :&: Option :&: Bulb 
3    type MStack[A] = O#Layers[A]

 

我们用一个具体的Free程序来示范堆叠Monad运算结果的操作。假如例子的ADT是这样的:

 1    sealed trait Foo[A] 
 2    final case class Foo1(s: String) extends Foo[Option[Int]] 
 3    final case class Foo2(i: Int) extends Foo[Xor[String, Int]] 
 4    final case object Foo3 extends Foo[Unit] 
 5    final case class Foo4(i: Int) extends Foo[Xor[String, Option[Int]]] 
 6  
 7    sealed trait Bar[A] 
 8    final case class Bar1(s: String) extends Bar[Option[String]] 
 9    final case class Bar2(i: Int) extends Bar[Xor[String, String]] 
10     
11    sealed trait Laa[A] 
12    final case class Push(s: String) extends Laa[List[String]]

从模拟运算结果类型来看,我们将面对相当复杂的三层Monad堆叠。我们先用Foo,Bar来示范两层堆叠的DSL。首先,我们希望使用DSL的语法如下:

 

1 for { 
2   i   <- Foo1("5").freek[PRG] // 运算结果是: Option[String] 
3   s   <- Bar2(i).freek[PRG]   // 运算结果是: Xor[String, String] 
4   ... 
5 } yield (())

 

我们希望对运算结果进行一种升格:把它们升格成一致堆叠类型,如下:

 

 1 Free[PRG.Cop, Option[A]] 
 2 // 和这个类型 
 3 Free[PRG.Cop, Xor[String, A]] 
 4  
 5 // 一致升格成 
 6 Free[PRG.Cop, Xor[String, Option[A]]] 
 7  
 8 // 也就是这个 
 9 type O = Xor[String, ?] :&: Option :&: Bulb 
10 Free[PRG.Cop, O#Layers]

 

像cats的MonadTransformer,freeK也提供了个OnionT,OnionT代表Monad堆叠类型容器。我们希望实现以下升格(lifting)操作:

 

1 // 
2 Free[PRG.Cop, Option[A]  
3 // 
4 Xor[String, A]]  
5 //统统转成 
6 OnionT[Free, PRG.Cop, O, A]

 

我们可以用.onionT[O]来升格:

 

 1   type PRG = Foo :|: Bar :|: NilDSL 
 2   val PRG = DSL.Make[PRG] 
 3   type O = Xor[String,?] :&: Option :&: Bulb 
 4   val prg: OnionT[Free,PRG.Cop,O,Int]= for { 
 5     i  <- Foo1("5").freek[PRG].onionT[O] 
 6     i2 <- Foo2(i).freek[PRG].onionT[O] 
 7     _  <- Foo3.freek[PRG].onionT[O] 
 8     s  <- Bar1(i2.toString).freek[PRG].onionT[O] 
 9     i3 <- Foo4(i2).freek[PRG].onionT[O] 
10   } yield (i3)

 

我们可以用比较简单点的表达形式freeko来示范同样效果:

 

1   val prg2: OnionT[Free,PRG.Cop,O,Int]= for { 
2     i  <- Foo1("5").freeko[PRG,O] 
3     i2 <- Foo2(i).freeko[PRG,O] 
4     _  <- Foo3.freeko[PRG,O] 
5     s  <- Bar1(i2.toString).freeko[PRG,O] 
6     i3 <- Foo4(i2).freeko[PRG,O] 
7   } yield (i3)

 

注意,现在程序prg的返回结果类型是OnionT。但我们的运算interpret函数是在Free上面的。OnionT.value可以返回Free类型:

1 pre.value 
2 //res12: cats.free.Free[PRG.Cop,O#Layers[Int]] = Free(...)

所以运算程序方式要调整成:prg.value.interpret(interpreters)

如果我们再增加一层Monad堆叠呢?

 

 1   type PRG3 = Laa :|: Foo :|: Bar :|: NilDSL 
 2   val PRG3 = DSL.Make[PRG3] 
 3   type O3 = List :&: Xor[String,?] :&: Option :&: Bulb 
 4   val prg3: OnionT[Free,PRG3.Cop,O3,Int]= for { 
 5     i  <- Foo1("5").freeko[PRG3,O3] 
 6     i2 <- Foo2(i).freeko[PRG3,O3] 
 7     _  <- Foo3.freeko[PRG3,O3] 
 8     s  <- Bar1(i2.toString).freeko[PRG3,O3] 
 9     i3 <- Foo4(i2).freeko[PRG3,O3] 
10     _ <- Push(s).freeko[PRG3,O3] 
11   } yield (i3)

就是这么简单。

下面我们把上篇讨论的用户验证示范例子的运算结果类型调整成复杂类型,然后用freeK.Onion来完善程序。先调整ADT:

 

 1   object ADTs { 
 2     sealed trait Interact[+A] 
 3     object Interact { 
 4       case class Ask(prompt: String) extends Interact[Xor[String,String]] 
 5       case class Tell(msg: String) extends Interact[Unit] 
 6     } 
 7     sealed trait Login[+A] 
 8     object Login { 
 9       case class Authenticate(uid: String, pwd: String) extends Login[Option[Boolean]] 
10     } 
11     sealed trait Auth[+A] 
12     object Auth { 
13       case class Authorize(uid: String) extends Auth[Option[Boolean]] 
14     } 
15   }

 

我们把运算结果改成了Xor,Option。再看看DSL调整:

 

 1   object DSLs { 
 2     import ADTs._ 
 3     import Interact._ 
 4     import Login._ 
 5     type PRG = Interact :|: Login :|: NilDSL 
 6     val PRG = DSL.Make[PRG] 
 7     type O =  Xor[String,?] :&: Option :&: Bulb 
 8     val authenticDSL: OnionT[Free,PRG.Cop, O, Boolean] = 
 9       for { 
10         uid <- Ask("Enter your user id:").freeko[PRG,O] 
11         pwd <- Ask("Enter password:").freeko[PRG,O] 
12         auth <- Authenticate(uid,pwd).freeko[PRG,O] 
13       } yield auth 
14     type O2 =  Option :&: Xor[String,?] :&: Bulb 
15     val authenticDSLX = 
16       for { 
17         uid <- Ask("Enter your user id:").freeko[PRG,O2].peelRight 
18         pwd <- Ask("Enter password:").freeko[PRG,O2].peelRight 
19         auth <- (uid,pwd) match { 
20           case (Xor.Right(u),Xor.Right(p)) => Authenticate(u,p).freeko[PRG,O2].peelRight 
21           case _ => Authenticate("","").freeko[PRG,O2].peelRight 
22         } 
23       } yield auth 
24     val interactLoginDSL: OnionT[Free,PRG.Cop, O, Unit] = 
25       for { 
26         uid <- Ask("Enter your user id:").freeko[PRG,O] 
27         pwd <- Ask("Enter password:").freeko[PRG,O] 
28         auth <- Authenticate(uid,pwd).freeko[PRG,O] 
29         _ <- if (auth) Tell(s"Hello $uid, welcome to the zoo!").freeko[PRG,O] 
30         else Tell(s"Sorry, Who is $uid?").freeko[PRG,O] 
31       } yield () 
32  
33     import Auth._ 
34     type PRG3 = Auth :|: PRG   //Interact :|: Login :|: NilDSL 
35     val PRG3 = DSL.Make[PRG3] 
36     val authorizeDSL: OnionT[Free,PRG3.Cop, O , Unit] = 
37       for { 
38         uid <- Ask("Enter your User ID:").freeko[PRG3,O] 
39         pwd <- Ask("Enter your Password:").freeko[PRG3,O] 
40         auth <- Authenticate(uid,pwd).freeko[PRG3,O] 
41         perm <-  if (auth) Authorize(uid).freeko[PRG3,O] 
42                  else OnionT.pure[Free,PRG3.Cop,O,Boolean](false) 
43         _ <- if (perm)  Tell(s"Hello $uid, access granted!").freeko[PRG3,O] 
44              else Tell(s"Sorry $uid, access denied!").freeko[PRG3,O] 
45       } yield() 
46   }

 

注意上面代码中这个authenticDSLX:当我们需要对Option:&:Xor:&:Bulb中的整个Xor值而不是运算值A来操作时可以用peelRight来获取这个Xor。如果有需要的话我们还可以用peelRight2,peelRight3来越过二、三层类型。具体实现interpreter部分也需要按照ADT的运算结果类型来调整:

 1 object IMPLs { 
 2     import ADTs._ 
 3     import Interact._ 
 4     import Login._ 
 5     import Auth._ 
 6     val idInteract = new (Interact ~> Id) { 
 7       def apply[A](ia: Interact[A]): Id[A] = ia match { 
 8         case Ask(p) => {println(p); (scala.io.StdIn.readLine).right} 
 9         case Tell(m) => println(m) 
10       } 
11     } 
12     val idLogin = new (Login ~> Id) { 
13       def apply[A](la: Login[A]): Id[A] = la match { 
14         case Authenticate(u,p) => (u,p) match { 
15           case ("Tiger","123") => true.some 
16           case _ => false.some 
17         } 
18       } 
19     } 
20     val interactLogin = idInteract :&: idLogin 
21     import Dependencies._ 
22     type ReaderContext[A] = Reader[Authenticator,A] 
23     object readerInteract extends (Interact ~> ReaderContext) { 
24       def apply[A](ia: Interact[A]): ReaderContext[A] = ia match { 
25         case Ask(p) => Reader {pc => {println(p); (scala.io.StdIn.readLine).right}} 
26         case Tell(m) => Reader {_ => println(m)} 
27       } 
28     } 
29     object readerLogin extends (Login ~> ReaderContext) { 
30       def apply[A](la: Login[A]): ReaderContext[A] = la match { 
31         case Authenticate(u,p) => Reader {pc => pc.matchUserPassword(u,p).some} 
32       } 
33     } 
34     val userInteractLogin = readerLogin :&: readerInteract 
35  
36     val readerAuth = new (Auth ~> ReaderContext) { 
37       def apply[A](aa: Auth[A]): ReaderContext[A] = aa match { 
38         case Authorize(u) => Reader {ac => ac.grandAccess(u).some} 
39       } 
40     } 
41     val userAuth = readerAuth :&: userInteractLogin 
42   }

具体运行方式需要调整成:

 

1   authorizeDSL.value.interpret(userAuth).run(AuthControl)

 

测试运行与我们上篇示范相同。

完整的示范源代码如下:

 

  1 import cats.instances.all._ 
  2 import cats.free.Free 
  3 import cats.{Id, ~>} 
  4 import cats.data.Reader 
  5 import freek._ 
  6 import cats.data.Xor 
  7 import cats.syntax.xor._ 
  8 import cats.syntax.option._ 
  9 object FreeKModules { 
 10   object ADTs { 
 11     sealed trait Interact[+A] 
 12     object Interact { 
 13       case class Ask(prompt: String) extends Interact[Xor[String,String]] 
 14       case class Tell(msg: String) extends Interact[Unit] 
 15     } 
 16     sealed trait Login[+A] 
 17     object Login { 
 18       case class Authenticate(uid: String, pwd: String) extends Login[Option[Boolean]] 
 19     } 
 20     sealed trait Auth[+A] 
 21     object Auth { 
 22       case class Authorize(uid: String) extends Auth[Option[Boolean]] 
 23     } 
 24   } 
 25   object DSLs { 
 26     import ADTs._ 
 27     import Interact._ 
 28     import Login._ 
 29     type PRG = Interact :|: Login :|: NilDSL 
 30     val PRG = DSL.Make[PRG] 
 31     type O =  Xor[String,?] :&: Option :&: Bulb 
 32     val authenticDSL: OnionT[Free,PRG.Cop, O, Boolean] = 
 33       for { 
 34         uid <- Ask("Enter your user id:").freeko[PRG,O] 
 35         pwd <- Ask("Enter password:").freeko[PRG,O] 
 36         auth <- Authenticate(uid,pwd).freeko[PRG,O] 
 37       } yield auth 
 38     type O2 =  Option :&: Xor[String,?] :&: Bulb 
 39     val authenticDSLX = 
 40       for { 
 41         uid <- Ask("Enter your user id:").freeko[PRG,O2].peelRight 
 42         pwd <- Ask("Enter password:").freeko[PRG,O2].peelRight 
 43         auth <- (uid,pwd) match { 
 44           case (Xor.Right(u),Xor.Right(p)) => Authenticate(u,p).freeko[PRG,O2].peelRight 
 45           case _ => Authenticate("","").freeko[PRG,O2].peelRight 
 46         } 
 47       } yield auth 
 48     val interactLoginDSL: OnionT[Free,PRG.Cop, O, Unit] = 
 49       for { 
 50         uid <- Ask("Enter your user id:").freeko[PRG,O] 
 51         pwd <- Ask("Enter password:").freeko[PRG,O] 
 52         auth <- Authenticate(uid,pwd).freeko[PRG,O] 
 53         _ <- if (auth) Tell(s"Hello $uid, welcome to the zoo!").freeko[PRG,O] 
 54         else Tell(s"Sorry, Who is $uid?").freeko[PRG,O] 
 55       } yield () 
 56  
 57     import Auth._ 
 58     type PRG3 = Auth :|: PRG   //Interact :|: Login :|: NilDSL 
 59     val PRG3 = DSL.Make[PRG3] 
 60     val authorizeDSL: OnionT[Free,PRG3.Cop, O , Unit] = 
 61       for { 
 62         uid <- Ask("Enter your User ID:").freeko[PRG3,O] 
 63         pwd <- Ask("Enter your Password:").freeko[PRG3,O] 
 64         auth <- Authenticate(uid,pwd).freeko[PRG3,O] 
 65         perm <-  if (auth) Authorize(uid).freeko[PRG3,O] 
 66                  else OnionT.pure[Free,PRG3.Cop,O,Boolean](false) 
 67         _ <- if (perm)  Tell(s"Hello $uid, access granted!").freeko[PRG3,O] 
 68              else Tell(s"Sorry $uid, access denied!").freeko[PRG3,O] 
 69       } yield() 
 70  
 71  
 72   } 
 73   object IMPLs { 
 74     import ADTs._ 
 75     import Interact._ 
 76     import Login._ 
 77     import Auth._ 
 78     val idInteract = new (Interact ~> Id) { 
 79       def apply[A](ia: Interact[A]): Id[A] = ia match { 
 80         case Ask(p) => {println(p); (scala.io.StdIn.readLine).right} 
 81         case Tell(m) => println(m) 
 82       } 
 83     } 
 84     val idLogin = new (Login ~> Id) { 
 85       def apply[A](la: Login[A]): Id[A] = la match { 
 86         case Authenticate(u,p) => (u,p) match { 
 87           case ("Tiger","123") => true.some 
 88           case _ => false.some 
 89         } 
 90       } 
 91     } 
 92     val interactLogin = idInteract :&: idLogin 
 93     import Dependencies._ 
 94     type ReaderContext[A] = Reader[Authenticator,A] 
 95     object readerInteract extends (Interact ~> ReaderContext) { 
 96       def apply[A](ia: Interact[A]): ReaderContext[A] = ia match { 
 97         case Ask(p) => Reader {pc => {println(p); (scala.io.StdIn.readLine).right}} 
 98         case Tell(m) => Reader {_ => println(m)} 
 99       } 
100     } 
101     object readerLogin extends (Login ~> ReaderContext) { 
102       def apply[A](la: Login[A]): ReaderContext[A] = la match { 
103         case Authenticate(u,p) => Reader {pc => pc.matchUserPassword(u,p).some} 
104       } 
105     } 
106     val userInteractLogin = readerLogin :&: readerInteract 
107  
108     val readerAuth = new (Auth ~> ReaderContext) { 
109       def apply[A](aa: Auth[A]): ReaderContext[A] = aa match { 
110         case Authorize(u) => Reader {ac => ac.grandAccess(u).some} 
111       } 
112     } 
113     val userAuth = readerAuth :&: userInteractLogin 
114   } 
115  
116 } 
117 object Dependencies { 
118   trait PasswordControl { 
119     val mapPasswords: Map[String,String] 
120     def matchUserPassword(uid: String, pswd: String): Boolean 
121   } 
122   trait AccessControl { 
123     val mapAccesses: Map[String, Boolean] 
124     def grandAccess(uid: String): Boolean 
125   } 
126   trait Authenticator extends PasswordControl with AccessControl 
127 } 
128  
129 object freeKDemo extends App { 
130   import FreeKModules._ 
131   import DSLs._ 
132   import IMPLs._ 
133   // val r0 = authenticDSL.foldMap(interactLogin.nat) 
134   // val r = authenticDSL.interpret(interactLogin) 
135   import Dependencies._ 
136   object AuthControl extends Authenticator { 
137     override val mapPasswords = Map( 
138       "Tiger" -> "1234", 
139       "John" -> "0000" 
140     ) 
141     override def matchUserPassword(uid: String, pswd: String) = 
142       mapPasswords.getOrElse(uid, pswd+"!") == pswd 
143  
144     override val mapAccesses = Map ( 
145       "Tiger" -> true, 
146       "John" -> false 
147     ) 
148     override def grandAccess(uid: String) = 
149       mapAccesses.getOrElse(uid, false) 
150   } 
151  
152   //  interactLoginDSL.value.interpret(userInteractLogin).run(AuthControl) 
153   authorizeDSL.value.interpret(userAuth).run(AuthControl) 
154 }

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

原创文章,作者:ItWorker,如若转载,请注明出处:https://blog.ytso.com/12887.html

(0)
上一篇 2021年7月19日
下一篇 2021年7月19日

相关推荐

发表回复

登录后才能评论