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

`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 I3  def fi: F[I]4  def k(i: I): A5 }`

` 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 } 7 trait Monad[M[_]] { 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 }12 object Monad {13 def apply[M[_]: Monad]: Monad[M] = implicitly[Monad[M]]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无需Functor19 type I = A20 def fi = yo.run21 def k(i: A) = i22  }23 def map[B](f: A => B): Yoneda[F,B] = new Yoneda[F,B] { //纯粹的函数组合 map fusion24 def apply[C](g: B => C): F[C] = yo( f andThen g)25  }26 }27 trait Coyoneda[F[_],A] { coyo =>28  type I29  def fi: F[I]30  def k(i: I): A31 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需要Functor34 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.I38 def fi = coyo.fi39 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需要Functor44 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 f4849  }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无须为Functor54 def fi = fa55 def k(a: A) = a56  }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本身就是Functor59  }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  } 910 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).resume16 case Suspend(k) => Left(F.map(k)(_ flatMap f))17 case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)).resume18  }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.Unapply29 /** A free monad over the free functor generated by `S` */30 type FreeC[S[_], A] = Free[({type f[x] = Coyoneda[S, x]})#f, A]3132 /** 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]))3536 /** 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)3940 /** A free monad over a free functor of `S`. */41 def liftFC[S[_], A](s: S[A]): FreeC[S, A] =42  liftFU(Coyoneda(s))4344 /** 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 <- GetLine11 _ <- PutLine("What is your last name ?")12 last <- GetLine13 _ <- PutLine(s"Hello, \$first \$last !")14 } yield () //> res0: ch13.ex11.Free[[x]ch13.ex11.Coyoneda[ch13.ex11.Console,x],Unit] = Sus15 //| pend([email protected])`

` 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([email protected]) 910 type Id[A] = A11 implicit val idMonad = new Monad[Id] {12 def unit[A](a: A) = a13 def flatMap[A,B](fa: A)(f: A => B): B = f(fa)14 } //> idMonad : ch13.ex11.Monad[ch13.ex11.Id] = ch13.ex11\$\$anonfun\$main\$1\$\$anon\$15 //| [email protected]1617 object RealConsole extends (Console ~> Id) {18 def apply[A](ca: Console[A]): A = ca match {19 case GetLine => readLine20 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]13 implicit val logStateMonad = new Monad[LogState] {14 def unit[A](a: A) = State(s => (a, s))15 def flatMap[A,B](sa: LogState[A])(f: A => LogState[B]) = sa flatMap f16 } //> logStateMonad : ch13.ex11.Monad[ch13.ex11.LogState] = ch13.ex11\$\$anonfun\$m17 //| [email protected]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 Ch28 //| an !, What is your last name ?, What is your first name ?)))`

Top