# 泛函编程（33）－泛函IO：Free Functor - Coyoneda

```1 trait Console[A]
2 case object GetLine extends Console[String]
3 case class PutLine(line: String) extends Console[Unit]```

```1 implicit val consoleFunctor = new Functor[Console] {
2     def map[A,B](ca: Console[A])(f: A => B): Console[B] = ca match {
3         case GetLine => ?????
4         case PutLine(l) => ????
5     }
6 }```

Yoneda lemma是这样推论的：如果我们有个这样的函数定义：def map[B](f: A => B): F[B]，那我们就肯定能得出F[A]值，因为我们只需要把一个恒等函数当作f就能得到F[A]。反过来推论：如果我们有个F[A]，F是任何Functor，A是任何类型，我们同样可以得出以上的map函数。我们可以用个类型来表示：

```1 trait Yoneda[F[_],A] {
2    def map[B](f: A => B): F[B]
3 }```

map(fb: F[B])(f: B => A): F[A]。

```1 trait Coyoneda[F[_],A] { coyo =>
2  type I
3  def fi: F[I]
4  def k(i: I): A
5 }```

``` 1 trait Functor[F[_]] {
2     def map[A,B](fa: F[A])(f: A => B): F[B]
3 }
4 object Functor {
5     def apply[F[_]: Functor]: Functor[F] = implicitly[Functor[F]]
6 }
8     def unit[A](a: A): M[A]
9     def flatMap[A,B](ma: M[A])(f: A => M[B]): M[B]
10     def map[A,B](ma: M[A])(f: A => B) = flatMap(ma)(a => unit(f(a)))
11 }
14 }
15 trait Yoneda[F[_],A] { yo =>
16     def apply[B](f: A => B): F[B]
17     def run: F[A] = apply(a => a)  //无需Functor实例就可以将Yoneda转变成F[A]
18     def toCoyoneda: Coyoneda[F,A] = new Coyoneda[F,A] { //转Coyoneda无需Functor
19         type I = A
20         def fi = yo.run
21         def k(i: A) = i
22     }
23     def map[B](f: A => B): Yoneda[F,B] = new Yoneda[F,B] { //纯粹的函数组合 map fusion
24         def apply[C](g: B => C): F[C] = yo( f andThen g)
25     }
26 }
27 trait Coyoneda[F[_],A] { coyo =>
28  type I
29  def fi: F[I]
30  def k(i: I): A
31  def run(implicit F: Functor[F]): F[A] =  //Coyoneda转F需要F Functor实例
32    F.map(fi)(k)
33  def toYoneda(implicit F: Functor[F]): Yoneda[F,A] = new Yoneda[F,A] { //转Yoneda需要Functor
34      def apply[B](f: A => B): F[B] = F.map(fi)(k _ andThen f)
35  }
36  def map[B](f: A => B): Coyoneda[F,B] = new Coyoneda[F,B] {
37      type I = coyo.I
38      def fi = coyo.fi
39      def k(i: I) = f(coyo k i)
40  }
41 }
42 object Yoneda {
43     def apply[F[_]: Functor,A](fa: F[A]) = new Yoneda[F,A] { //F转Yoneda需要Functor
44         def apply[B](f: A => B): F[B] = Functor[F].map(fa)(f)
45     }
46     implicit def yonedaFunctor[F[_]] = new Functor[({type l[x] = Yoneda[F,x]})#l] {
47         def map[A,B](ya: Yoneda[F,A])(f: A => B) = ya map f
48
49     }
50 }
51 object Coyoneda {
52     def apply[F[_],A](fa: F[A]): Coyoneda[F,A] = new Coyoneda[F,A] {
53         type I = A          //把F[A]升格成Coyoneda, F无须为Functor
54         def fi = fa
55         def k(a: A) = a
56     }
57     implicit def coyonedaFunctor[F[_]] = new Functor[({type l[x] = Coyoneda[F,x]})#l] {
58         def map[A,B](ca: Coyoneda[F,A])(f: A => B) = ca map f   //Coyoneda本身就是Functor
59     }
60 }```

``` 1 trait Free[F[_],A] {
2  private case class FlatMap[B](a: Free[F,A], f: A => Free[F,B]) extends Free[F,B]
3  def unit(a: A): Free[F,A] = Return(a)
4  def flatMap[B](f: A => Free[F,B])(implicit F: Functor[F]): Free[F,B] = this match {
5      case Return(a) => f(a)
6      case Suspend(k) => Suspend(F.map(k)(a => a flatMap f))
7   case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f))
8  }
9
10  def map[B](f: A => B)(implicit F: Functor[F]): Free[F,B] = flatMap(a => Return(f(a)))
11  def resume(implicit F: Functor[F]): Either[F[Free[F,A]],A] = this match {
12      case Return(a) => Right(a)
13      case Suspend(k) => Left(k)
14      case FlatMap(a,f) => a match {
15          case Return(b) => f(b).resume
16          case Suspend(k) => Left(F.map(k)(_ flatMap f))
17          case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)).resume
18      }
19  }
20  def foldMap[G[_]](f: (F ~> G))(implicit F: Functor[F], G: Monad[G]): G[A] = resume match {
21        case Right(a) => G.unit(a)
22        case Left(k) => G.flatMap(f(k))(_ foldMap f)
23  }
24 }
25 case class Return[F[_],A](a: A) extends Free[F,A]
26 case class Suspend[F[_],A](ffa: F[Free[F,A]]) extends Free[F,A]
27 object Free {
28 import scalaz.Unapply
29   /** A free monad over the free functor generated by `S` */
30   type FreeC[S[_], A] = Free[({type f[x] = Coyoneda[S, x]})#f, A]
31
32   /** Suspends a value within a functor in a single step. Monadic unit for a higher-order monad. */
33   def liftF[S[_], A](value: => S[A])(implicit S: Functor[S]): Free[S, A] =
34     Suspend(S.map(value)(Return[S, A]))
35
36   /** A version of `liftF` that infers the nested type constructor. */
37   def liftFU[MA](value: => MA)(implicit MA: Unapply[Functor, MA]): Free[MA.M, MA.A] =
38     liftF(MA(value))(MA.TC)
39
40   /** A free monad over a free functor of `S`. */
41   def liftFC[S[_], A](s: S[A]): FreeC[S, A] =
42     liftFU(Coyoneda(s))
43
44   /** Interpret a free monad over a free functor of `S` via natural transformation to monad `M`. */
45   def runFC[S[_], M[_], A](sa: FreeC[S, A])(interp: S ~> M)(implicit M: Monad[M]): M[A] =
46     sa.foldMap[M](new (({type λ[α] = Coyoneda[S, α]})#λ ~> M) {
47       def apply[A](cy: Coyoneda[S, A]): M[A] =
48         M.map(interp(cy.fi))(cy.k)
49       })
50 }```

type FreeC[S[_],A] = Free[({type f[x] = Coyoneda[F,x]})#f, A]

def liftF[S[_],A](sa: S[A])(implicit S: Functor[S])，这里的S就是Coyoneda。

Interpreter沿用了foldMap但是调整了转换源目标类型 Functor >>> Coyoneda。其它如Trampoline机制维持不变。

``` 1 trait Console[A]
2 case object GetLine extends Console[String]
3 case class PutLine(line: String) extends Console[Unit]
4 import Free._
5 implicit def liftConsole[A](ca: Console[A]): FreeC[Console,A] = liftFC(ca)
6                                                   //> liftConsole: [A](ca: ch13.ex11.Console[A])ch13.ex11.Free.FreeC[ch13.ex11.Co
7                                                   //| nsole,A]
8 for {
9     _ <- PutLine("What is your first name ?")
10     first <- GetLine
11     _ <- PutLine("What is your last name ?")
12     last <- GetLine
13     _ <- PutLine(s"Hello, \$first \$last !")
14 } yield ()                                        //> res0: ch13.ex11.Free[[x]ch13.ex11.Coyoneda[ch13.ex11.Console,x],Unit] = Sus
15                                                   //| pend(ch13.ex11\$Coyoneda\$\$anon\$4@50f8360d)```

``` 1 val ioprg = for {
2     _ <- PutLine("What is your first name ?")
3     first <- GetLine
4     _ <- PutLine("What is your last name ?")
5     last <- GetLine
6     _ <- PutLine(s"Hello, \$first \$last !")
7 } yield ()                                        //> ioprg  : ch13.ex11.Free[[x]ch13.ex11.Coyoneda[ch13.ex11.Console,x],Unit] =
8                                                   //| Suspend(ch13.ex11\$Coyoneda\$\$anon\$4@13c78c0b)
9
10 type Id[A] = A
12     def unit[A](a: A) = a
13     def flatMap[A,B](fa: A)(f: A => B): B = f(fa)
15                                                   //| 10@12843fce
16
17 object RealConsole extends (Console ~> Id) {
18     def apply[A](ca: Console[A]): A = ca match {
20         case PutLine(l) => println(l)
21     }
22 }
23 Free.runFC(ioprg)(RealConsole)                    //> What is your first name ?/```

``` 1 case class State[S,A](runState: S => (A,S)) {
2     def map[B](f: A => B) = State[S,B](s => {
3         val (a1,s1) = runState(s)
4         (f(a1),s1)
5     })
6     def flatMap[B](f: A => State[S,B]) = State[S,B](s => {
7         val (a1,s1) = runState(s)
8         f(a1).runState(s1)
9     })
10 }
11 case class InOutLog(inLog: List[String], outLog: List[String])
12 type LogState[A] = State[InOutLog, A]
14     def unit[A](a: A) = State(s => (a, s))
15     def flatMap[A,B](sa: LogState[A])(f: A => LogState[B]) = sa flatMap f
17                                                   //| ain\$1\$\$anon\$11@3dd3bcd
18 object MockConsole extends(Console ~> LogState) {
19     def apply[A](c: Console[A]): LogState[A] = State(
20         s => (c,s) match {
21             case (GetLine, InOutLog(in,out)) => (in.head, InOutLog(in.tail, out))
22           case (PutLine(l), InOutLog(in,out)) => ((),InOutLog(in, l :: out))
23         })
24 }
25 val s = Free.runFC(ioprg)(MockConsole)            //> s  : ch13.ex11.LogState[Unit] = State(<function1>)
26 val ls = s.runState(InOutLog(List("Tiger","Chan"),List()))
27                                                   //> ls  : (Unit, ch13.ex11.InOutLog) = ((),InOutLog(List(),List(Hello, Tiger Ch
28                                                   //| an !, What is your last name ?, What is your first name ?)))```

0 条评论

2139

26011

2008

1465

3408

1909

612

2954

932

3605