从Free开始，Freecats
cats是scala的一个新的函数式编程工具库，其设计原理基本继承了scalaz：大家都是haskelltypeclass的scala版实现。当然，cats在scalaz的基础上从实现细节、库组织结构和调用方式上进行了一些优化，所以对用户来说：cats的基础数据类型、数据结构在功能上与scalaz是大致相同的，可能有一些语法上的变化。与scalaz著名抽象、复杂的语法表现形式相比，cats的语法可能更形象、简单直白。在scalaz的学习过程中，我们了解到所谓函数式编程就是monadicProgramming：即用monad这样的数据类型来构建程序。而实际可行的monadicprogramming就是用Free-Monad编程了。因为Free-Monad程序是真正可运行的，或者说是可以实现安全运行的，因为它可以保证在固定的堆栈内实现无限运算。我们知道：函数式编程模式的运行方式以递归算法为主，flatMap函数本身就是一种递归算法。这就预示着monadicprogramming很容易造成堆栈溢出问题（StackOverflowError）。当我们把普通的泛函类型F[A]升格成Free-Monad后就能充分利用Free-Monad安全运算能力来构建实际可运行的程序了。由于我们在前面已经详细的了解了scalaz的大部分typeclass，包括Free，对cats的讨论就从Free开始，聚焦在cats.Free编程模式方面。同时，我们可以在使用cats.Free的过程中对cats的其它数据类型进行补充了解。
cats.Free的类型款式如下：
sealedabstractclassFree[S[_],A]extendsProductwithSerializable{...}
S是个高阶类，就是一种函数式运算。值得注意的是：现在S不需要是个Functor了。因为Free的一个实例Suspend类型是这样的：
/Suspendthecomputationwiththegivensuspension./
privatefinalcaseclassSuspend[S[_],A](a:S[A])extendsFree[S,A]
我们不需要map就可以把F[A]升格成Free
/
SuspendavaluewithinafunctorliftingittoaFree.
/
defliftF[F[_],A](value:F[A]):Free[F,A]=Suspend(value)
我们在scalaz.Free的讨论中并没能详尽地分析在什么情况下S[_]必须是个Functor。下面我们需要用一些篇幅来解析。
Free程序的特点是算式（description）／算法（implementation）关注分离（separationofconcern）：我们用一组数据类型来模拟一种编程语句ADT（algebraicdatatype），这一组ADT就形成了一种定制的编程语言DSL（domainspecificlanguage）。Free的编程部分就是用DSL来描述程序功能（descriptionofpurpose），即算式了。算法即用DSL描述的功能的具体实现，可以有多种的功能实现方式。我们先看个简单的DSL：
1importcats.free._
2importcats.Functor
3objectcatsFree{
4objectADTs{
5sealedtraitInteract[+A]
6objectInteract{
7caseclassAsk(prompt:String)extendsInteract[String]
8caseclassTell(msg:String)extendsInteract[Unit]
9
10defask(prompt:String):Free[Interact,String]=Free.liftF(Ask(prompt))
11deftell(msg:String):Free[Interact,Unit]=Free.liftF(Tell(msg))
12
13
14implicitobjectinteractFunctorextendsFunctor[Interact]{
15defmap[A,B](ia:Interact[A])(f:A=>B):Interact[B]=???
16/iamatch{
17caseAsk(p)=>???
18caseTell(m)=>???
19}/
20}
21}
22}
23objectDSLs{
24importADTs._
25importInteract._
26valprg:Free[Interact,Unit]=for{
27first<-ask("What''syourfirstname?")
28last<-ask("What''syourlastname?")
29_<-tell(s"Hello$first$last")
30}yield()
31}
在这个例子里Interact并不是一个Functor，因为我们无法获取InteractFunctor实例的map函数。先让我们分析一下Functor的map：
1implicitobjectinteractFunctorextendsFunctor[Interact]{
2defmap[A,B](ia:Interact[A])(f:A=>B):Interact[B]=iamatch{
3caseAsk(p)=>???
4caseTell(m)=>???
5}
6}
map的作用是用一个函数A=>B把F[A]转成F[B]。也就是把语句状态从F[A]转成F[B]，但在Interact的情况里F[B]已经是明确的Interact[Unit]和Interact[String]两种状态，而map的f是A=>B，在上面的示范里我们该如何施用f来获取这个Interact[B]呢？从上面的示范里我们观察可以得出Ask和Tell这两个ADT纯粹是为了模拟ask和tell这两个函数。ask和tell分别返回Free版本的String,Unit结果。可以说：Interact并没有转换到下一个状态的要求。那么假如我们把ADT调整成下面这样呢：
1sealedtraitFunInteract[NS]
2objectFunInteract{
3caseclassFunAsk[NS](prompt:String,onInput:String=>NS)extendsFunInteract[NS]
4caseclassFunTell[NS](msg:String,ns:NS)extendsFunInteract[NS]
5
6deffunAsk(prompt:String):Free[FunInteract,String]=Free.liftF(FunAsk(prompt,identity))
7deffunAskInt(prompt:String):Free[FunInteract,Int]=Free.liftF(FunAsk(prompt,_.toInt))
8deffunTell(msg:String):Free[FunInteract,Unit]=Free.liftF(FunTell(msg,()))
9
10implicitobjectfunInteractextendsFunctor[FunInteract]{
11defmap[A,NS](fa:FunInteract[A])(f:A=>NS)=famatch{
12caseFunAsk(prompt,input)=>FunAsk(prompt,inputandThenf)
13caseFunTell(msg,ns)=>FunTell(msg,f(ns))
14}
15}
16}
现在这两个ADT是有类型参数NS的了：FunAsk[NS],FunTell[NS]。NS代表了ADT当前类型，如FunAsk[Int]、FunTell[String]...，现在这两个ADT都通过类型参数NS变成了可map的对象了，如FunAsk[String]>>>FunAsk[String],FunAsk[String]>>>FunAsk[Int]...。所以我们可以很顺利的实现objectfunInteract的map函数。但是，一个有趣的现象是：为了实现这种状态转换，如果ADT需要返回操作结果，就必须具备一个引领状态转换的机制，如FunAsk类型里的onInput:String=>NS：它代表funAsk函数返回的结果可以指向下一个状态。新增函数funAskInt是个很好的示范：通过返回的String结果将状态转换到FunAsk[Int]状态。函数funTell不返回结果，所以FunTell没有状态转换机制。scalaz旧版本Free.Suspend的类型款式是：Suspend[F[Free,A]]，这是一个递归类型，内部的Free代表下一个状态。由于我们必须用F.map才能取出下一个状态，所以F必须是个Functor。我们应该注意到如果ADT是Functor的话会造成Free程序的冗余代码。既然cats.Free对F[A]没有设置Functor门槛，那么我们应该尽量避免使用Functor。
得出对ADT类型要求结论后，我们接着示范cats的Free编程。下面是Free程序的功能实现interpret部分（implementation）：
1importADTs._
2objecticonsoleextends(Interact~>Id){
3defapply[A](ia:Interact[A]):Id[A]=iamatch{
4caseAsk(p)=>{println(p);readLine}
5caseTell(m)=>println(m)
6}
7}
8}
DSL程序的功能实现就是把ADTF[A]对应到实际的指令集G[A]，在Free编程里用NaturalTransformation～>来实现。注意G[A]必须是个Monad。在上面的例子里对应关系是：Interact～>Id，代表直接对应到运算指令println和readLine。我们也可以实现另一个版本：
1typePrompt=String
2typeReply=String
3typeMessage=String
4typeTester[A]=Map[Prompt,Reply]=>(List[Message],A)
5objecttesterextends(Interact~>Tester){
6defapply[A](ia:Interact[A]):Tester[A]=iamatch{
7caseAsk(p)=>{m=>(List(),m(p))}
8caseTell(m)=>{_=>(List(m),())}
9}
10}
11importcats.Monad
12implicitvaltesterMonad=newMonad[Tester]{
13overridedefpure[A](a:A):Tester[A]=_=>(List(),a)
14overridedefflatMap[A,B](ta:Tester[A])(f:A=>Tester[B]):Tester[B]=m=>{
15val(o1,a1)=ta(m)
16val(o2,a2)=f(a1)(m)
17(o1++o2,a2)
18}
19overridedeftailRecM[A,B](a:A)(f:A=>Tester[Either[A,B]]):Tester[B]=
20defaultTailRecM(a)(f)
21}
22}
上面是个模拟测试：我们用个Map[K,V]来模拟互动，K模拟问prompt，V模拟获取回答Input。测试方式是个Function1，输入测试数据Map，在List[Message]里返回所有Tell产生的信息。上面提到过Tester[A]必须是个Monad，所以我们实现了Tester的Monad实例testMonad。实际上m=>(List,a)就是个writer函数。所谓的Writer就是包嵌一个对值pair(L,V)的Monad，L代表Log，V代表运算值。Writer的特性就是log所有V的运算过程。我们又可以用Writer来实现这个tester：
1importcats.data.WriterT
2typeWF[A]=Map[Prompt,Reply]=>A
3typeWriterTester[A]=WriterT[WF,List[Message],A]
4deftesterToWriter[A](f:Map[Prompt,Reply]=>(List[Message],A))=
5WriterT[WF,List[Message],A](f)
6objecttestWriterextends(Interact~>WriterTester){
7importInteract._
8defapply[A](ia:Interact[A]):WriterTester[A]=iamatch{
9caseAsk(p)=>testerToWriter(m=>(List(),m(p)))
10caseTell(m)=>testerToWriter(_=>(List(m),(www.hunanwang.net)))
11}
12}
如果我们用Writer来实现Interact，实际上就是把Ask和Tell都升格成Writer类型。
我们再来看看在cats里是如何运算FreeDSL程序的。相对scalaz而言，cats的运算函数简单的多，就一个foldMap，我们来看看它的定义：
/
Catamorphismfor`Free`.
Runtocompletion,mappingthesuspensionwiththegiven
transformationateachstepandaccumulatingintothemonad`M`.
Thismethoduses`tailRecM`toprovidestack-safety.
/
finaldeffoldMap[M[_]](f:FunctionK[S,M])(implicitM:Monad[M],r:RecursiveTailRecM[M]):M[A]=
r.sameType(M).tailRecM(this)(_.stepmatch{
casePure(a)=>M.pure(Right(a))
caseSuspend(sa)=>M.map(f(sa))(Right(_))
caseFlatMapped(c,g)=>M.map(c.foldMap(f))(cc=>Left(g(cc)))
})
除了要求M是个Monad之外，cats还要求M的RecursiveTailRecM隐式实例。那么什么是RecursiveTailRecM呢：
/
Thisisamarkertypethatpromisesthatthemethod
.tailRecMforthistypeisstack-safeforarbitraryrecursion.
/
traitRecursiveTailRecM[F[_]]extendsSerializable{
/
youcancallRecursiveTailRecM[F].sameType(Monad[F]).tailRec
tohaveastaticcheckthatthetypesagree
forsaferusageoftailRecM
/
finaldefsameType[M[_[_]]](m:M[F]):M[F]=m
}
我们用RecursiveTailRecM来保证这个Monad类型与tailRecM是匹配的，这是一种运算安全措施，所以在foldMap函数里r.sameType(M).tailRecM保证了tailRecM不会造成StackOverflowError。cats.Free里还有一种不需要类型安全检验的函数foldMapUnsafe：
/
SameasfoldMapbutwithoutaguaranteeofstacksafety.Iftherecursionisshallow
enough,thiswillwork
/
finaldeffoldMapUnsafe[M[_]](f:FunctionK[S,M])(implicitM:Monad[M]):M[A]=
foldMap[M](f)(M,RecursiveTailRecM.create)
这个函数不需要RecursiveTailRecM。下面我们选择能保证运算安全的方法来运算tester：首先我们需要Tester类型的Monad和RecursiveTailRecM实例：
1importcats.Monad
2implicitvaltesterMonad=newMonad[Tester]withRecursiveTailRecM[Tester]{
3overridedefpure[A](a:A):Tester[A]=_=>(List(),a)
4overridedefflatMap[A,B](ta:Tester[A])(f:A=>Tester[B]):Tester[B]=m=>{
5val(o1,a1)=ta(m)
6val(o2,a2)=f(a1)(m)
7(o1++o2,a2)
8}
9overridedeftailRecM[A,B](a:A)(f:A=>Tester[Either[A,B]]):Tester[B]=
10defaultTailRecM(a)(f)
11}
然后我们制造一些测试数据：
1valtestData=Map("What''syourfirstname?"->"Tiger",
2"What''syourlastname?"->"Chan")//>testData:scala.collection.immutable.Map[String,String]=Map(What''syourfirstname?->Tiger,What''syourlastname?->Chan)
测试运算：
1importADTs._,DSLs._,IMPLs._
2valtestData=Map("What''syourfirstname?"->"Tiger",
3"What''syourlastname?"->"Chan")?//>testData:scala.collection.immutable.Map[String,String]=Map(What''syourfirstname?->Tiger,What''syourlastname?->Chan)
4valprgRunner=prg.foldMap(tester)?//>prgRunner:demo.ws.catsFree.IMPLs.Tester[Unit]=
5prgRunner(testData)?//>res0:(List[demo.ws.catsFree.IMPLs.Message],Unit)=(List(HelloTigerChan),(www.visa158.com))
那么如果运算testWriter呢？我们先取得WriterT的Monad实例：
1implicitvaltestWriterMonad=WriterT.catsDataMonadWriterForWriterT[WF,List[Message]]
然后构建一个RecursiveTailRecM实例后再用同样的测试数据来运算：
1implicitvaltestWriterRecT=newRecursiveTailRecM[WriterTester]{}
2?//>testWriterRecT:cats.RecursiveTailRecM[demo.ws.catsFree.IMPLs.WriterTester]=demo.ws.catsFree$$anonfun$main$1$$anon$2@6093dd95
3valprgRunner=prg.foldMap(testWriter)//>prgRunner:demo.ws.catsFree.IMPLs.WriterTester[Unit]=WriterT()
4prgRunner.run(testData)._1.map(println)//>HelloTigerChan
5//|res0:List[Unit]=List(())
运算结果一致。
我们再示范一下cats官方文件里关于freemonad例子：模拟一个KVStore的put,get,delete功能。ADT设计如下：
1objectADTs{
2sealedtraitKVStoreA[+A]
3caseclassPut[T](key:String,value:T)extendsKVStoreA[Unit]
4caseclassGet[T](key:String)extendsKVStoreA[Option[T]]
5caseclassDel(key:String)extendsKVStoreA[Unit]
6}
对应的模拟功能函数设计如下：
1typeKVStore[A]=Free[KVStoreA,A]
2objectKVStoreA{
3defput[T](key:String,value:T):KVStore[Unit]=
4Free.liftF[KVStoreA,Unit](Put[T](key,value))
5defget[T](key:String):KVStore[Option[T]]=
6Free.liftF[KVStoreA,Option[T]](Get[T](key))
7defdel(key:String):KVStore[Unit]=
8Free.liftF[KVStoreA,Unit](Del(key))
9defmod[T](key:String,f:T=>T):KVStore[Unit]=
10for{
11opt<-get[T](key)
12_<-opt.map{t=>put[T](key,f(t))}.getOrElse(Free.pure(()))
13}yield()
14}
注意一下mod函数：它是由基础函数get和put组合而成。我们要求所有在for内的类型为Free[KVStoreA,?]，所以当f函数施用后如果opt变成None时就返回结果Free.pure(())，它的类型是：Free[Nothing,Unit]，Nothing是KVStoreA的子类。
现在我们可以用这个DSL来编制KVS程序了：
1objectDSLs{
2importADTs._
3importKVStoreA._
4defprg:KVStore[Option[Int]]=
5for{
6_<-put[Int]("wild-cats",2)
7_<-mod[Int]("wild-cats",(_+12))
8_<-put[Int]("tame-cats",5)
9n<-get[Int]("wild-cats")
10_<-del("tame-cats")
11}yieldn
12}
我们可以通过State数据结纯代码（purecode）方式来实现用immutablemap的KVStore：
1objectIMPLs{
2importADTs._
3importcats.{~>}
4importcats.data.State
5
6typeKVStoreState[A]=State[Map[String,Any],A]
7valkvsToState:KVStoreA~>KVStoreState=new(KVStoreA~>KVStoreState){
8defapply[A](fa:KVStoreA[A]):KVStoreState[A]=
9famatch{
10casePut(key,value)=>State{(s:Map[String,Any])=>
11(s.updated(key,value),())}
12caseGet(key)=>State{(s:Map[String,Any])=>
13(s,s.get(key).asInstanceOf[A])}
14caseDel(key)=>State{(s:Map[String,Any])=>
15(s-key,(()))}
16}
17}
18}
我们把KVStoreAADT模拟成对State结构的S转换（mutation），返回State{S=>(S,A)}。KVStoreState[A]类型的S参数为immutable.Map[String,Any]，所以我们在S转换操作时用immutablemap的操作函数来构建新的map返回，典型的purecode。我们来运算一下KVStoreA程序：
1importADTs._,DSLs._,IMPLs._
2valprgRunner=prg.foldMap(kvsToState)//>prgRunner:demo.ws.catsFreeKVS.IMPLs.KVStoreState[Option[Int]]=cats.data.StateT@2cfb4a64
3prgRunner.run(Map.empty).value//>res0:(Map[String,Any],Option[Int])=(Map(wild-cats->14),Some(14))
但是难道不需要Monad、RecursiveTailRecM实例了吗？实际上cats已经提供了State的Monad和RecursiveTailRecM实例：
1importcats.{Monad,RecursiveTailRecM}
2implicitly[Monad[KVStoreState]]//>res1:cats.Monad[demo.ws.catsFreeKVS.IMPLs.KVStoreState]=cats.data.StateTInstances$$anon$2@71bbf57e
3implicitly[RecursiveTailRecM[KVStoreState]]//>res2:cats.RecursiveTailRecM[demo.ws.catsFreeKVS.IMPLs.KVStoreState]=cats.RecursiveTailRecM$$anon$1@7f13d6e
在cats的StateT.scala里可以找到这段代码：
private[data]sealedtraitStateTInstances2{
implicitdefcatsDataMonadForStateT[F[_],S](implicitF0:Monad[F]):Monad[StateT[F,S,?]]=
newStateTMonad[F,S]{implicitdefF=F0}
implicitdefcatsDataRecursiveTailRecMForStateT[F[_]:RecursiveTailRecM,S]:RecursiveTailRecM[StateT[F,S,?]]=RecursiveTailRecM.create[StateT[F,S,?]]
implicitdefcatsDataSemigroupKForStateT[F[_],S](implicitF0:Monad[F],G0:SemigroupK[F]):SemigroupK[StateT[F,S,?]]=
newStateTSemigroupK[F,S]{implicitdefF=F0;implicitdefG=G0}
}
我把上面两个示范的源代码提供在下面：
Interact:
1importcats.free._
2importcats.{Functor,RecursiveTailRecM}
3objectcatsFree{
4objectADTs{
5sealedtraitInteract[+A]
6objectInteract{
7caseclassAsk(prompt:String)extendsInteract[String]
8caseclassTell(msg:String)extendsInteract[Unit]
9
10defask(prompt:String):Free[Interact,String]=Free.liftF(Ask(prompt))
11deftell(msg:String):Free[Interact,Unit]=Free.liftF(Tell(msg))
12
13
14implicitobjectinteractFunctorextendsFunctor[Interact]{
15defmap[A,B](ia:Interact[A])(f:A=>B):Interact[B]=???
16/iamatch{
17caseAsk(p)=>???
18caseTell(m)=>???
19}/
20}
21
22sealedtraitFunInteract[NS]
23objectFunInteract{
24caseclassFunAsk[NS](prompt:String,onInput:String=>NS)extendsFunInteract[NS]
25caseclassFunTell[NS](msg:String,ns:NS)extendsFunInteract[NS]
26
27deffunAsk(prompt:String):Free[FunInteract,String]=Free.liftF(FunAsk(prompt,identity))
28deffunAskInt(prompt:String):Free[FunInteract,Int]=Free.liftF(FunAsk(prompt,_.toInt))
29deffunTell(msg:String):Free[FunInteract,Unit]=Free.liftF(FunTell(msg,()))
30
31implicitobjectfunInteractextendsFunctor[FunInteract]{
32defmap[A,NS](fa:FunInteract[A])(f:A=>NS)=famatch{
33caseFunAsk(prompt,input)=>FunAsk(prompt,inputandThenf)
34caseFunTell(msg,ns)=>FunTell(msg,f(ns))
35}
36}
37}
38}
39}
40objectDSLs{
41importADTs._
42importInteract._
43valprg:Free[Interact,Unit]=for{
44first<-ask("What''syourfirstname?")
45last<-ask("What''syourlastname?")
46_<-tell(s"Hello$first$last")
47}yield()
48}
49objectIMPLs{
50importcats.{Id,~>}
51importADTs._
52importInteract._
53objecticonsoleextends(Interact~>Id){
54defapply[A](ia:Interact[A]):Id[A]=iamatch{
55caseAsk(p)=>{println(p);readLine}
56caseTell(m)=>println(m)
57}
58}
59
60typePrompt=String
61typeReply=String
62typeMessage=String
63typeTester[A]=Map[Prompt,Reply]=>(List[Message],A)
64objecttesterextends(Interact~>Tester){
65defapply[A](ia:Interact[A]):Tester[A]=iamatch{
66caseAsk(p)=>{m=>(List(),m(p))}
67caseTell(m)=>{_=>(List(m),())}
68}
69}
70importcats.Monad
71implicitvaltesterMonad=newMonad[Tester]withRecursiveTailRecM[Tester]{
72overridedefpure[A](a:A):Tester[A]=_=>(List(),a)
73overridedefflatMap[A,B](ta:Tester[A])(f:A=>Tester[B]):Tester[B]=m=>{
74val(o1,a1)=ta(m)
75val(o2,a2)=f(a1)(m)
76(o1++o2,a2)
77}
78overridedeftailRecM[A,B](a:A)(f:A=>Tester[Either[A,B]]):Tester[B]=
79defaultTailRecM(a)(f)
80}
81importcats.data.WriterT
82importcats.instances.all._
83typeWF[A]=Map[Prompt,Reply]=>A
84typeWriterTester[A]=WriterT[WF,List[Message],A]
85deftesterToWriter[A](f:Map[Prompt,Reply]=>(List[Message],A))=
86WriterT[WF,List[Message],A](f)
87implicitvaltestWriterMonad=WriterT.catsDataMonadWriterForWriterT[WF,List[Message]]
88objecttestWriterextends(Interact~>WriterTester){
89importInteract._
90defapply[A](ia:Interact[A]):WriterTester[A]=iamatch{
91caseAsk(p)=>testerToWriter(m=>(List(),m(p)))
92caseTell(m)=>testerToWriter(_=>(List(m),()))
93}
94}
95}
96
97importADTs._,DSLs._,IMPLs._
98valtestData=Map("What''syourfirstname?"->"Tiger",
99"What''syourlastname?"->"Chan")
100//valprgRunner=prg.foldMap(tester)
101//prgRunner(testData)
102implicitvaltestWriterRecT=newRecursiveTailRecM[WriterTester]{}
103valprgRunner=prg.foldMap(testWriter)
104prgRunner.run(testData)._1.map(println)
105}
KVStore：
1importcats.free._
2importcats.instances.all._
3objectcatsFreeKVS{
4objectADTs{
5sealedtraitKVStoreA[+A]
6caseclassPut[T](key:String,value:T)extendsKVStoreA[Unit]
7caseclassGet[T](key:String)extendsKVStoreA[Option[T]]
8caseclassDel(key:String)extendsKVStoreA[Unit]
9typeKVStore[A]=Free[KVStoreA,A]
10objectKVStoreA{
11defput[T](key:String,value:T):KVStore[Unit]=
12Free.liftF[KVStoreA,Unit](Put[T](key,value))
13defget[T](key:String):KVStore[Option[T]]=
14Free.liftF[KVStoreA,Option[T]](Get[T](key))
15defdel(key:String):KVStore[Unit]=
16Free.liftF[KVStoreA,Unit](Del(key))
17defmod[T](key:String,f:T=>T):KVStore[Unit]=
18for{
19opt<-get[T](key)
20_<-opt.map{t=>put[T](key,f(t))}.getOrElse(Free.pure(()))
21}yield()
22}
23}
24objectDSLs{
25importADTs._
26importKVStoreA._
27defprg:KVStore[Option[Int]]=
28for{
29_<-put[Int]("wild-cats",2)
30_<-mod[Int]("wild-cats",(_+12))
31_<-put[Int]("tame-cats",5)
32n<-get[Int]("wild-cats")
33_<-del("tame-cats")
34}yieldn
35}
36objectIMPLs{
37importADTs._
38importcats.{~>}
39importcats.data.State
40
41typeKVStoreState[A]=State[Map[String,Any],A]
42valkvsToState:KVStoreA~>KVStoreState=new(KVStoreA~>KVStoreState){
43defapply[A](fa:KVStoreA[A]):KVStoreState[A]=
44famatch{
45casePut(key,value)=>State{(s:Map[String,Any])=>
46(s.updated(key,value),())}
47caseGet(key)=>State{(s:Map[String,Any])=>
48(s,s.get(key).asInstanceOf[A])}
49caseDel(key)=>State{(s:Map[String,Any])=>
50(s-key,(()))}
51}
52}
53}
54importADTs._,DSLs._,IMPLs._
55valprgRunner=prg.foldMap(kvsToState)
56prgRunner.run(Map.empty).value
57
58importcats.{Monad,RecursiveTailRecM}
59implicitly[Monad[KVStoreState]]
60implicitly[RecursiveTailRecM[KVStoreState]]
61}
|
|
