Cats（1）－从Free开始，Free cats详解编程语言

cats是scala的一个新的函数式编程工具库，其设计原理基本继承了scalaz：大家都是haskell typeclass的scala版实现。当然，cats在scalaz的基础上从实现细节、库组织结构和调用方式上进行了一些优化，所以对用户来说：cats的基础数据类型、数据结构在功能上与scalaz是大致相同的，可能有一些语法上的变化。与scalaz著名抽象、复杂的语法表现形式相比，cats的语法可能更形象、简单直白。在scalaz的学习过程中，我们了解到所谓函数式编程就是monadic Programming：即用monad这样的数据类型来构建程序。而实际可行的monadic programming就是用Free-Monad编程了。因为Free-Monad程序是真正可运行的，或者说是可以实现安全运行的，因为它可以保证在固定的堆栈内实现无限运算。我们知道：函数式编程模式的运行方式以递归算法为主，flatMap函数本身就是一种递归算法。这就预示着monadic programming很容易造成堆栈溢出问题（StackOverflowError）。当我们把普通的泛函类型F[A]升格成Free-Monad后就能充分利用Free-Monad安全运算能力来构建实际可运行的程序了。由于我们在前面已经详细的了解了scalaz的大部分typeclass，包括Free，对cats的讨论就从Free开始，聚焦在cats.Free编程模式方面。同时，我们可以在使用cats.Free的过程中对cats的其它数据类型进行补充了解。

cats.Free的类型款式如下：

sealed abstract class Free[S[_], A] extends Product with Serializable {...}

S是个高阶类，就是一种函数式运算。值得注意的是：现在S不需要是个Functor了。因为Free的一个实例Suspend类型是这样的：

/** Suspend the computation with the given suspension. */ 
  private final case class Suspend[S[_], A](a: S[A]) extends Free[S, A]

我们不需要map就可以把F[A]升格成Free

/** 
   * Suspend a value within a functor lifting it to a Free. 
   */ 
  def liftF[F[_], A](value: F[A]): Free[F, A] = Suspend(value)

我们在scalaz.Free的讨论中并没能详尽地分析在什么情况下S[_]必须是个Functor。下面我们需要用一些篇幅来解析。

Free程序的特点是算式（description）／算法（implementation）关注分离（separation of concern）：我们用一组数据类型来模拟一种编程语句ADT（algebraic data type），这一组ADT就形成了一种定制的编程语言DSL（domain specific language）。Free的编程部分就是用DSL来描述程序功能（description of purpose），即算式了。算法即用DSL描述的功能的具体实现，可以有多种的功能实现方式。我们先看个简单的DSL：

 1 import cats.free._ 
 2 import cats.Functor 
 3 object catsFree { 
 4   object ADTs { 
 5     sealed trait Interact[+A] 
 6     object Interact { 
 7       case class Ask(prompt: String) extends Interact[String] 
 8       case class Tell(msg: String) extends Interact[Unit] 
 9        
10       def ask(prompt: String): Free[Interact,String] = Free.liftF(Ask(prompt)) 
11       def tell(msg: String): Free[Interact,Unit] = Free.liftF(Tell(msg)) 
12  
13  
14       implicit object interactFunctor extends Functor[Interact]  { 
15         def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ??? 
16       /*   ia match { 
17            case Ask(p) => ??? 
18            case Tell(m) => ??? 
19         } */ 
20       }   
21     } 
22   } 
23   object DSLs { 
24     import ADTs._ 
25     import Interact._ 
26     val prg: Free[Interact,Unit] = for { 
27       first <- ask("What's your first name?") 
28       last <- ask("What's your last name?") 
29       _ <- tell(s"Hello $first $last") 
30     } yield() 
31   }

在这个例子里Interact并不是一个Functor，因为我们无法获取Interact Functor实例的map函数。先让我们分析一下Functor的map：

1      implicit object interactFunctor extends Functor[Interact]  { 
2         def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match { 
3            case Ask(p) => ??? 
4            case Tell(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调整成下面这样呢：

 1       sealed trait FunInteract[NS] 
 2       object FunInteract { 
 3         case class FunAsk[NS](prompt: String, onInput: String =>  NS) extends FunInteract[NS] 
 4         case class FunTell[NS](msg: String, ns: NS) extends FunInteract[NS] 
 5          
 6         def funAsk(prompt: String): Free[FunInteract,String] = Free.liftF(FunAsk(prompt,identity)) 
 7         def funAskInt(prompt: String): Free[FunInteract,Int] = Free.liftF(FunAsk(prompt,_.toInt)) 
 8         def funTell(msg: String): Free[FunInteract,Unit] = Free.liftF(FunTell(msg,())) 
 9          
10         implicit object funInteract extends Functor[FunInteract] { 
11            def map[A,NS](fa: FunInteract[A])(f: A => NS) = fa match { 
12               case FunAsk(prompt,input) => FunAsk(prompt,input andThen f) 
13               case FunTell(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]…。所以我们可以很顺利的实现object funInteract的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）：

1     import ADTs._ 
2     object iconsole extends (Interact ~> Id) { 
3       def apply[A](ia: Interact[A]): Id[A] = ia match { 
4          case Ask(p) => {println(p); readLine} 
5          case Tell(m) => println(m) 
6       } 
7     } 
8   }

DSL程序的功能实现就是把ADT F[A]对应到实际的指令集G[A]，在Free编程里用NaturalTransformation ～>来实现。注意G[A]必须是个Monad。在上面的例子里对应关系是：Interact～>Id，代表直接对应到运算指令println和readLine。我们也可以实现另一个版本：

 1     type Prompt = String 
 2     type Reply = String 
 3     type Message = String 
 4     type Tester[A] = Map[Prompt,Reply] => (List[Message],A) 
 5     object tester extends (Interact ~> Tester) { 
 6       def apply[A](ia: Interact[A]): Tester[A] = ia match { 
 7         case Ask(p) => { m => (List(), m(p)) } 
 8         case Tell(m) => { _ => (List(m), ()) } 
 9       } 
10     } 
11     import cats.Monad 
12     implicit val testerMonad = new Monad[Tester] { 
13       override def pure[A](a: A): Tester[A] = _ => (List(),a) 
14       override def flatMap[A,B](ta: Tester[A])(f: A => Tester[B]): Tester[B] = m => { 
15         val (o1,a1) = ta(m) 
16         val (o2,a2) = f(a1)(m) 
17         (o1 ++ o2, a2) 
18       } 
19       override def tailRecM[A,B](a: A)(f: A => Tester[Either[A,B]]): Tester[B] = 
20          defaultTailRecM(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：

 1    import cats.data.WriterT 
 2     type WF[A] = Map[Prompt,Reply] => A 
 3     type WriterTester[A] = WriterT[WF,List[Message],A] 
 4     def testerToWriter[A](f: Map[Prompt,Reply] => (List[Message],A)) = 
 5     WriterT[WF,List[Message],A](f) 
 6     object testWriter extends (Interact ~> WriterTester) { 
 7       import Interact._ 
 8       def apply[A](ia: Interact[A]): WriterTester[A] = ia match { 
 9         case Ask(p) => testerToWriter(m => (List(),m(p))) 
10         case Tell(m) => testerToWriter(_ => (List(m),())) 
11       } 
12     }

如果我们用Writer来实现Interact，实际上就是把Ask和Tell都升格成Writer类型。

我们再来看看在cats里是如何运算Free DSL程序的。相对scalaz而言，cats的运算函数简单的多，就一个foldMap，我们来看看它的定义：

/** 
   * Catamorphism for `Free`. 
   * 
   * Run to completion, mapping the suspension with the given 
   * transformation at each step and accumulating into the monad `M`. 
   * 
   * This method uses `tailRecM` to provide stack-safety. 
   */ 
  final def foldMap[M[_]](f: FunctionK[S, M])(implicit M: Monad[M], r: RecursiveTailRecM[M]): M[A] = 
    r.sameType(M).tailRecM(this)(_.step match { 
      case Pure(a) => M.pure(Right(a)) 
      case Suspend(sa) => M.map(f(sa))(Right(_)) 
      case FlatMapped(c, g) => M.map(c.foldMap(f))(cc => Left(g(cc))) 
    })

除了要求M是个Monad之外，cats还要求M的RecursiveTailRecM隐式实例。那么什么是RecursiveTailRecM呢：

/** 
 * This is a marker type that promises that the method 
 * .tailRecM for this type is stack-safe for arbitrary recursion. 
 */ 
trait RecursiveTailRecM[F[_]] extends Serializable { 
  /* 
   * you can call RecursiveTailRecM[F].sameType(Monad[F]).tailRec 
   * to have a static check that the types agree 
   * for safer usage of tailRecM 
   */ 
  final def sameType[M[_[_]]](m: M[F]): M[F] = m 
}

我们用RecursiveTailRecM来保证这个Monad类型与tailRecM是匹配的，这是一种运算安全措施，所以在foldMap函数里r.sameType(M).tailRecM保证了tailRecM不会造成StackOverflowError。cats.Free里还有一种不需要类型安全检验的函数foldMapUnsafe：

/** 
   * Same as foldMap but without a guarantee of stack safety. If the recursion is shallow 
   * enough, this will work 
   */ 
  final def foldMapUnsafe[M[_]](f: FunctionK[S, M])(implicit M: Monad[M]): M[A] = 
    foldMap[M](f)(M, RecursiveTailRecM.create)

这个函数不需要RecursiveTailRecM。下面我们选择能保证运算安全的方法来运算tester：首先我们需要Tester类型的Monad和RecursiveTailRecM实例：

 1     import cats.Monad 
 2     implicit val testerMonad = new Monad[Tester] with RecursiveTailRecM[Tester]{ 
 3       override def pure[A](a: A): Tester[A] = _ => (List(),a) 
 4       override def flatMap[A,B](ta: Tester[A])(f: A => Tester[B]): Tester[B] = m => { 
 5         val (o1,a1) = ta(m) 
 6         val (o2,a2) = f(a1)(m) 
 7         (o1 ++ o2, a2) 
 8       } 
 9       override def tailRecM[A,B](a: A)(f: A => Tester[Either[A,B]]): Tester[B] = 
10         defaultTailRecM(a)(f) 
11     }

然后我们制造一些测试数据：

1   val testData = Map("What's your first name?" -> "Tiger", 
2   "What's your last name?" -> "Chan")             //> testData  : scala.collection.immutable.Map[String,String] = Map(What's your first name? -> Tiger, What's your last name? -> Chan)

测试运算：

1 import ADTs._,DSLs._,IMPLs._ 
2    val testData = Map("What's your first name?" -> "Tiger", 
3   "What's your last name?" -> "Chan")    //> testData  : scala.collection.immutable.Map[String,String] = Map(What's your first name? -> Tiger, What's your last name? -> Chan) 
4   val prgRunner = prg.foldMap(tester)    //> prgRunner  : demo.ws.catsFree.IMPLs.Tester[Unit] = <function1> 
5   prgRunner(testData)                    //> res0: (List[demo.ws.catsFree.IMPLs.Message], Unit) = (List(Hello Tiger Chan),())

那么如果运算testWriter呢？我们先取得WriterT的Monad实例：

1    implicit val testWriterMonad =  WriterT.catsDataMonadWriterForWriterT[WF,List[Message]]

然后构建一个RecursiveTailRecM实例后再用同样的测试数据来运算：

1  implicit val testWriterRecT = new RecursiveTailRecM[WriterTester]{} 
2            //> testWriterRecT  : cats.RecursiveTailRecM[demo.ws.catsFree.IMPLs.WriterTester] = [email protected] 
3   val prgRunner = prg.foldMap(testWriter)         //> prgRunner  : demo.ws.catsFree.IMPLs.WriterTester[Unit] = WriterT(<function1>) 
4   prgRunner.run(testData)._1.map(println)         //> Hello Tiger Chan 
5                                                   //| res0: List[Unit] = List(())

运算结果一致。

我们再示范一下cats官方文件里关于free monad例子：模拟一个KVStore的put,get,delete功能。ADT设计如下：

1   object ADTs { 
2     sealed trait KVStoreA[+A] 
3     case class Put[T](key: String, value: T) extends KVStoreA[Unit] 
4     case class Get[T](key: String) extends KVStoreA[Option[T]] 
5     case class Del(key: String) extends KVStoreA[Unit] 
6   }

对应的模拟功能函数设计如下：

 1     type KVStore[A] = Free[KVStoreA,A] 
 2     object KVStoreA { 
 3       def put[T](key: String, value: T): KVStore[Unit] = 
 4         Free.liftF[KVStoreA,Unit](Put[T](key,value)) 
 5       def get[T](key: String): KVStore[Option[T]] = 
 6         Free.liftF[KVStoreA,Option[T]](Get[T](key)) 
 7       def del(key: String): KVStore[Unit] = 
 8         Free.liftF[KVStoreA,Unit](Del(key)) 
 9       def mod[T](key: String, f: T => T): KVStore[Unit] = 
10         for { 
11           opt <- 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程序了：

 1  object DSLs { 
 2     import ADTs._ 
 3     import KVStoreA._ 
 4     def prg: KVStore[Option[Int]] = 
 5     for { 
 6       _ <- put[Int]("wild-cats", 2) 
 7       _ <- mod[Int]("wild-cats", (_ + 12)) 
 8       _ <- put[Int]("tame-cats", 5) 
 9       n <- get[Int]("wild-cats") 
10       _ <- del("tame-cats") 
11     } yield n 
12   }

我们可以通过State数据结纯代码（pure code）方式来实现用immutable map的KVStore：

 1  object IMPLs { 
 2     import ADTs._ 
 3     import cats.{~>} 
 4     import cats.data.State 
 5     
 6     type KVStoreState[A] = State[Map[String, Any], A] 
 7     val kvsToState: KVStoreA ~> KVStoreState = new (KVStoreA ~> KVStoreState) { 
 8       def apply[A](fa: KVStoreA[A]): KVStoreState[A] = 
 9         fa match { 
10           case Put(key, value) => State { (s:Map[String, Any]) => 
11              (s.updated(key, value),()) } 
12           case Get(key) => State { (s:Map[String, Any]) => 
13             (s,s.get(key).asInstanceOf[A]) } 
14           case Del(key) => State { (s:Map[String, Any]) => 
15               (s - key, (())) } 
16         } 
17     } 
18   }

我们把KVStoreA ADT模拟成对State结构的S转换（mutation），返回State{S=>(S,A)}。KVStoreState[A]类型的S参数为immutable.Map[String, Any]，所以我们在S转换操作时用immutable map的操作函数来构建新的map返回，典型的pure code。我们来运算一下KVStoreA程序：

1   import ADTs._,DSLs._,IMPLs._ 
2   val prgRunner = prg.foldMap(kvsToState)    //> prgRunner  : demo.ws.catsFreeKVS.IMPLs.KVStoreState[Option[Int]] = [email protected] 
3   prgRunner.run(Map.empty).value       //> res0: (Map[String,Any], Option[Int]) = (Map(wild-cats -> 14),Some(14))

但是难道不需要Monad、RecursiveTailRecM实例了吗？实际上cats已经提供了State的Monad和RecursiveTailRecM实例：

1   import cats.{Monad,RecursiveTailRecM} 
2   implicitly[Monad[KVStoreState]]      //> res1: cats.Monad[demo.ws.catsFreeKVS.IMPLs.KVStoreState] = cats.data.StateT [email protected] 
3   implicitly[RecursiveTailRecM[KVStoreState]]     //> res2: cats.RecursiveTailRecM[demo.ws.catsFreeKVS.IMPLs.KVStoreState] = [email protected]

在cats的StateT.scala里可以找到这段代码：

private[data] sealed trait StateTInstances2 { 
  implicit def catsDataMonadForStateT[F[_], S](implicit F0: Monad[F]): Monad[StateT[F, S, ?]] = 
    new StateTMonad[F, S] { implicit def F = F0 } 
 
  implicit def catsDataRecursiveTailRecMForStateT[F[_]: RecursiveTailRecM, S]: RecursiveTailRecM[StateT[F, S, ?]] = RecursiveTailRecM.create[StateT[F, S, ?]] 
 
  implicit def catsDataSemigroupKForStateT[F[_], S](implicit F0: Monad[F], G0: SemigroupK[F]): SemigroupK[StateT[F, S, ?]] = 
    new StateTSemigroupK[F, S] { implicit def F = F0; implicit def G = G0 } 
}

我把上面两个示范的源代码提供在下面：

Interact:

  1 import cats.free._ 
  2 import cats.{Functor, RecursiveTailRecM} 
  3 object catsFree { 
  4   object ADTs { 
  5     sealed trait Interact[+A] 
  6     object Interact { 
  7       case class Ask(prompt: String) extends Interact[String] 
  8       case class Tell(msg: String) extends Interact[Unit] 
  9  
 10       def ask(prompt: String): Free[Interact,String] = Free.liftF(Ask(prompt)) 
 11       def tell(msg: String): Free[Interact,Unit] = Free.liftF(Tell(msg)) 
 12  
 13  
 14       implicit object interactFunctor extends Functor[Interact]  { 
 15         def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ??? 
 16         /*   ia match { 
 17              case Ask(p) => ??? 
 18              case Tell(m) => ??? 
 19           } */ 
 20       } 
 21  
 22       sealed trait FunInteract[NS] 
 23       object FunInteract { 
 24         case class FunAsk[NS](prompt: String, onInput: String =>  NS) extends FunInteract[NS] 
 25         case class FunTell[NS](msg: String, ns: NS) extends FunInteract[NS] 
 26  
 27         def funAsk(prompt: String): Free[FunInteract,String] = Free.liftF(FunAsk(prompt,identity)) 
 28         def funAskInt(prompt: String): Free[FunInteract,Int] = Free.liftF(FunAsk(prompt,_.toInt)) 
 29         def funTell(msg: String): Free[FunInteract,Unit] = Free.liftF(FunTell(msg,())) 
 30  
 31         implicit object funInteract extends Functor[FunInteract] { 
 32           def map[A,NS](fa: FunInteract[A])(f: A => NS) = fa match { 
 33             case FunAsk(prompt,input) => FunAsk(prompt,input andThen f) 
 34             case FunTell(msg,ns) => FunTell(msg,f(ns)) 
 35           } 
 36         } 
 37       } 
 38     } 
 39   } 
 40   object DSLs { 
 41     import ADTs._ 
 42     import Interact._ 
 43     val prg: Free[Interact,Unit] = for { 
 44       first <- ask("What's your first name?") 
 45       last <- ask("What's your last name?") 
 46       _ <- tell(s"Hello $first $last") 
 47     } yield() 
 48   } 
 49   object IMPLs { 
 50     import cats.{Id,~>} 
 51     import ADTs._ 
 52     import Interact._ 
 53     object iconsole extends (Interact ~> Id) { 
 54       def apply[A](ia: Interact[A]): Id[A] = ia match { 
 55         case Ask(p) => {println(p); readLine} 
 56         case Tell(m) => println(m) 
 57       } 
 58     } 
 59  
 60     type Prompt = String 
 61     type Reply = String 
 62     type Message = String 
 63     type Tester[A] = Map[Prompt,Reply] => (List[Message],A) 
 64     object tester extends (Interact ~> Tester) { 
 65       def apply[A](ia: Interact[A]): Tester[A] = ia match { 
 66         case Ask(p) => { m => (List(), m(p)) } 
 67         case Tell(m) => { _ => (List(m), ()) } 
 68       } 
 69     } 
 70     import cats.Monad 
 71     implicit val testerMonad = new Monad[Tester] with RecursiveTailRecM[Tester]{ 
 72       override def pure[A](a: A): Tester[A] = _ => (List(),a) 
 73       override def flatMap[A,B](ta: Tester[A])(f: A => Tester[B]): Tester[B] = m => { 
 74         val (o1,a1) = ta(m) 
 75         val (o2,a2) = f(a1)(m) 
 76         (o1 ++ o2, a2) 
 77       } 
 78       override def tailRecM[A,B](a: A)(f: A => Tester[Either[A,B]]): Tester[B] = 
 79         defaultTailRecM(a)(f) 
 80     } 
 81     import cats.data.WriterT 
 82     import cats.instances.all._ 
 83     type WF[A] = Map[Prompt,Reply] => A 
 84     type WriterTester[A] = WriterT[WF,List[Message],A] 
 85     def testerToWriter[A](f: Map[Prompt,Reply] => (List[Message],A)) = 
 86       WriterT[WF,List[Message],A](f) 
 87     implicit val testWriterMonad =  WriterT.catsDataMonadWriterForWriterT[WF,List[Message]] 
 88     object testWriter extends (Interact ~> WriterTester) { 
 89       import Interact._ 
 90       def apply[A](ia: Interact[A]): WriterTester[A] = ia match { 
 91         case Ask(p) => testerToWriter(m => (List(),m(p))) 
 92         case Tell(m) => testerToWriter(_ => (List(m),())) 
 93       } 
 94     } 
 95   } 
 96  
 97   import ADTs._,DSLs._,IMPLs._ 
 98    val testData = Map("What's your first name?" -> "Tiger", 
 99   "What's your last name?" -> "Chan") 
100   //val prgRunner = prg.foldMap(tester) 
101   //prgRunner(testData) 
102   implicit val testWriterRecT = new RecursiveTailRecM[WriterTester]{} 
103   val prgRunner = prg.foldMap(testWriter) 
104   prgRunner.run(testData)._1.map(println) 
105 }

KVStore：

 1 import cats.free._ 
 2 import cats.instances.all._ 
 3 object catsFreeKVS { 
 4   object ADTs { 
 5     sealed trait KVStoreA[+A] 
 6     case class Put[T](key: String, value: T) extends KVStoreA[Unit] 
 7     case class Get[T](key: String) extends KVStoreA[Option[T]] 
 8     case class Del(key: String) extends KVStoreA[Unit] 
 9     type KVStore[A] = Free[KVStoreA,A] 
10     object KVStoreA { 
11       def put[T](key: String, value: T): KVStore[Unit] = 
12         Free.liftF[KVStoreA,Unit](Put[T](key,value)) 
13       def get[T](key: String): KVStore[Option[T]] = 
14         Free.liftF[KVStoreA,Option[T]](Get[T](key)) 
15       def del(key: String): KVStore[Unit] = 
16         Free.liftF[KVStoreA,Unit](Del(key)) 
17       def mod[T](key: String, f: T => T): KVStore[Unit] = 
18         for { 
19           opt <- get[T](key) 
20           _ <- opt.map {t => put[T](key,f(t))}.getOrElse(Free.pure(())) 
21         } yield() 
22     } 
23   } 
24   object DSLs { 
25     import ADTs._ 
26     import KVStoreA._ 
27     def prg: KVStore[Option[Int]] = 
28     for { 
29       _ <- put[Int]("wild-cats", 2) 
30       _ <- mod[Int]("wild-cats", (_ + 12)) 
31       _ <- put[Int]("tame-cats", 5) 
32       n <- get[Int]("wild-cats") 
33       _ <- del("tame-cats") 
34     } yield n 
35   } 
36   object IMPLs { 
37     import ADTs._ 
38     import cats.{~>} 
39     import cats.data.State 
40     
41     type KVStoreState[A] = State[Map[String, Any], A] 
42     val kvsToState: KVStoreA ~> KVStoreState = new (KVStoreA ~> KVStoreState) { 
43       def apply[A](fa: KVStoreA[A]): KVStoreState[A] = 
44         fa match { 
45           case Put(key, value) => State { (s:Map[String, Any]) => 
46              (s.updated(key, value),()) } 
47           case Get(key) => State { (s:Map[String, Any]) => 
48             (s,s.get(key).asInstanceOf[A]) } 
49           case Del(key) => State { (s:Map[String, Any]) => 
50               (s - key, (())) } 
51         } 
52     } 
53   } 
54   import ADTs._,DSLs._,IMPLs._ 
55   val prgRunner = prg.foldMap(kvsToState) 
56   prgRunner.run(Map.empty).value 
57    
58   import cats.{Monad,RecursiveTailRecM} 
59   implicitly[Monad[KVStoreState]] 
60   implicitly[RecursiveTailRecM[KVStoreState]] 
61 }

原创文章，作者：Maggie-Hunter，如若转载，请注明出处：https://blog.ytso.com/12890.html

Cats（1）－ 从Free开始，Free cats详解编程语言

相关推荐

发表回复

Cats（1）－从Free开始，Free cats详解编程语言