Scalaz(39)- Free :a real monadic program


ずっとFPが比較的にびくびくしていると感じて、多分多すぎる学術性のもの、どのようにこれらの数学の理論から背後で支持する1セットの全く新しいデータのタイプとデータの構造を現実の開発の中で使用することを知りません.Free Monadになって、FPでプログラミングできるようになった気がします.前述したように、Free Monadを理解するのに多くの時間を費やしましたが、今回はFree Monadを使って本当に実行できる完全なアプリケーションを作成することについて議論したいと思います.もちろん、このプログラムはFP特性を備えなければならない.例えば、関数組合せ(function composition)、純コード(pure code)、遅延副作用(delayed side effect)などである.私たちが今回シミュレーションしたアプリケーションのシーンは、コンピュータプログラムをシミュレートし、ユーザーがパスワードでログインします.次に、加算、減算、乗算、除算を含む操作を選択します.システムはユーザーの操作権限を検証する.最初の数値を入力し、別の数値を入力すると、計算結果が表示されます.プログラムはユーザがパスワードでログインした後にループして実行する.まず、プログラム要件のいくつかの操作文セットを羅列します.
1、人機対話、Interact
2、ユーザー登録、Login
3、権限制御、Permission
4、算術演算、Calculator
このうち、Login、Permission、Calculatorは、インタラクティブな手動入力が必要であるため、Interactと組み合わせて使用する必要があります.今回は、このプログラムの完全な計算式(Algebraic Data Tree)、アルゴリズム(Interpreter)、依存注入、演算、結果などを先に並べてから、セグメントごとに分析して説明します.
package run.demo
import scalaz._
import Scalaz._
import scala.language.higherKinds
import scala.language.implicitConversions
import run.demo.Modules.FreeCalculator.CalcInterp

object Modules {
  object FreeInteract {
    trait Interact[+NextAct]
    object Interact {
      case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct]
      case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct]
      implicit object interactFunctor extends Functor[Interact] {
         def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
           case Ask(p,onInput) => Ask(p, onInput andThen f)
           case Tell(m,n) => Tell(m, f(n))
         }
      } 
    }
    import Interact._
    object InteractConsole extends (Interact ~> Id) {
      def apply[A](ia: Interact[A]): Id[A] = ia match {
        case Ask(p,onInput) => println(p); onInput(readLine)
        case Tell(m, n) => println(m); n
      }
    }
    import FreeLogin._
    object InteractLogin extends (Interact ~> PasswordReader) {
      def apply[A](ia: Interact[A]): PasswordReader[A] = ia match {
        case Ask(p,onInput) => println(p); Reader(m => onInput(readLine))
        case Tell(m, n) => println(m); Reader(m => n)
      }
    }
    import FreePermission._
    object InteractPermission extends(Interact ~> PermissionReader) {
      def apply[A](ia: Interact[A]): PermissionReader[A] = ia match {
        case Ask(p,onInput) => println(p);Reader(m => onInput(readLine))
        case Tell(m,n) => println(m); Reader(m => n)
      }
    }
  }
  object FreeLogin {
    trait UserLogin[+A]
    object UserLogin {
      case class Login(uid: String, pswd: String) extends UserLogin[Boolean]
    } 
    import UserLogin._
    import Dependencies._
    type PasswordReader[A] = Reader[PasswordControl, A]
    object LoginInterp extends (UserLogin ~> PasswordReader) {
      def apply[A](la: UserLogin[A]): PasswordReader[A] = la match {
        case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd))
      }
    }
  }
  object FreePermission {
    trait Permission[+A]
    object Permission {
      case class HasPermission(uid: String, opr: String) extends Permission[Boolean]
    }
    import Dependencies._
    import Permission._
    type PermissionReader[A] = Reader[PermissionControl,A]
    object PermissionInterp extends (Permission ~> PermissionReader) {
      def apply[A](pa: Permission[A]): PermissionReader[A] = pa match {
        case HasPermission(uid,opr) => Reader {m => m.matchPermission(uid, opr)}
      }
    }
  }
  object FreeCalculator {
    trait Calculator[+A]
    object Calculator {
      case class Calc(opr: String, lop: Int, rop: Int) extends Calculator[Int]
    }
    import Calculator._
    object CalcInterp extends (Calculator ~> Id) {
      def apply[A](ca: Calculator[A]): Id[A] = ca match {
        case Calc(opr,op1,op2) => opr.toUpperCase match {
          case "ADD" => op1 + op2
          case "SUB" => op1 - op2
          case "MUL" => op1 * op2
          case "DIV" => op1 / op2
        }
      }
    }
  }
  object FreeFunctions {
    import FreeInteract._
    import Interact._
    import FreeLogin._
    import UserLogin._
    import FreePermission._
    import Permission._
    import FreeCalculator._
    import Calculator._
    def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = 
       Free.liftFC(I.inj(fa)) 
    class Interacts[G[_]](implicit I: Inject[Interact,G]) {
      def ask[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput)))
      def tell[A](msg: String) = Free.liftFC(I.inj(Tell(msg, ())))
    }
    object Interacts {
      implicit def instance[F[_]](implicit I: Inject[Interact,F]) = new Interacts[F]
    }
    class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
      def login(uid: String, pswd: String) = lift(Login(uid,pswd))
    }
    object Logins {
      implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F]
    }
    class Permissions[G[_]](implicit I: Inject[Permission,G]) {
      def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr))
    }
    object Permissions {
      implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F]
    }
    class Calculators[G[_]](implicit I: Inject[Calculator,G]) {
      def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2))
    }
    object Calculators {
      implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F]
    }
    def or[F[_],H[_],G[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
      new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
       def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
         case -\/(x) => fg(x)
         case \/-(y) => hg(y)
       }
    }
  }
  object FreeProgs {
    import FreeFunctions._
    import FreeInteract._
    import FreeLogin._
    import FreePermission._
    import FreeCalculator._
    def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l]
    def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = {
      import I._
      import L._
      for {
        uid <- ask("ya id:",identity)
        pwd <- ask("password:",identity)
        login <- login(uid,pwd)
        _ <- if (login) tell("ya in, ya lucky bastard!")
                else tell("geta fk outa here!")
        usr <- if (login) freeCMonad[F].point(uid) 
               else freeCMonad[F].point("???")
      } yield usr
    }
    def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = {
      import I._
      import P._
      for {
        inp <- ask("votiu vangto do?",identity)
        cando <- hasPermission(uid,inp)
        _ <- if (cando) tell("ok, go on ...")
                else tell("na na na, cant do that!")   
        opr <- if (cando) freeCMonad[F].point(inp) 
               else freeCMonad[F].point("XXX")
      } yield opr
       
    }

    def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = {
      import I._;import C._;
      for {
        op1 <- ask("fus num:", _.toInt)
        op2 <- ask("nx num:", _.toInt)
        result <- calc(opr,op1,op2)
      } yield result
    }

    type LoginScript[A] = Coproduct[Interact, UserLogin, A]
    type CalcScript[A] = Coproduct[Interact, Calculator, A]
    type AccessScript[A] = Coproduct[Interact, Permission, A]
    val accessPrg = accessScript[AccessScript] _
    val loginPrg = loginScript[LoginScript]
    val calcPrg = calcScript[CalcScript] _
  }
}
object Dependencies {
  trait PasswordControl {
    val pswdMap: Map[String,String]
    def matchPassword(uid: String, pswd: String): Boolean
  }
  trait PermissionControl {
    val permMap: Map[String,List[String]]
    def matchPermission(uid: String, operation: String): Boolean
  }
}
object FreeProgram extends App {
  import Modules._
  import FreeInteract._
  import FreeLogin._
  import FreePermission._
  import FreeFunctions._
  import FreeProgs._
  import Dependencies._
  object Passwords extends PasswordControl {
     val pswdMap = Map (
       "Tiger" -> "1234",
       "John" -> "0332"
     )
     def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd
  }
  object AccessRights extends PermissionControl {
     val permMap = Map (
       "Tiger" -> List("Add","Sub"),
       "John" -> List("Mul","Div")
     )
     def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr}
  }
  
  val uid = Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords)
  val opr = Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).run(AccessRights)
  val sum = Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp))
  println(uid)
  println(opr)
  println(sum)
}
//      
ya id:
Tiger
password:
1234
ya in, ya lucky bastard!
votiu vangto do?
Add
ok, go on ...
fus num:
3
nx num:
7
Tiger
Add
10

苦労してそんなことをしたようだ.しかし、私たちがFree Monadicプログラミングの規範に従ってやれば、すべては考えなくてもいいだけで、それはそれだけのことです.実際には、より大規模で複雑なプログラムを作成する際に、成功した関数の組み合わせが多くの重複コードを回避できるため、構想がより明確で、コード量がより簡素になると感じているはずです.基本的なFree Monadicプログラミング手順は大体以下の通りです.
1、ADT design  
2、ADT Free lifting
3、ADT composition、AST composition
4、Dependency design
5、Interpreter design
6、Running and dependency injection
1、ADTs:機能要求に従ってプログラミング文を設計する.その中で注目すべきはInteractです.
   trait Interact[+NextAct]
    object Interact {
      case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct]
      case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct]
      implicit object interactFunctor extends Functor[Interact] {
         def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
           case Ask(p,onInput) => Ask(p, onInput andThen f)
           case Tell(m,n) => Tell(m, f(n))
         }
      } 
    }
 

Interactはmapをサポートできるので、Functorでなければなりません.これは、いずれかの状態Askが入力Stringを変換して次の状態に入る必要があるためである.
2、昇格lifting:これらのADTをFreeに昇格させる必要があります.一部のADTはFunctorではないので、liftFCでFreeCに統一的に昇格します.
  object FreeFunctions {
    import FreeInteract._
    import Interact._
    import FreeLogin._
    import UserLogin._
    import FreePermission._
    import Permission._
    import FreeCalculator._
    import Calculator._
    def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = 
       Free.liftFC(I.inj(fa)) 
    class Interacts[G[_]](implicit I: Inject[Interact,G]) {
      def ask[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput)))
      def tell[A](msg: String) = Free.liftFC(I.inj(Tell(msg, ())))
    }
    object Interacts {
      implicit def instance[F[_]](implicit I: Inject[Interact,F]) = new Interacts[F]
    }
    class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
      def login(uid: String, pswd: String) = lift(Login(uid,pswd))
    }
    object Logins {
      implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F]
    }
    class Permissions[G[_]](implicit I: Inject[Permission,G]) {
      def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr))
    }
    object Permissions {
      implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F]
    }
    class Calculators[G[_]](implicit I: Inject[Calculator,G]) {
      def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2))
    }
    object Calculators {
      implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F]
    }
    def or[F[_],H[_],G[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
      new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
       def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
         case -\/(x) => fg(x)
         case \/-(y) => hg(y)
       }
    }
  }

lift関数ではscalazが提供するInjectタイプインスタンスを用いて,F[A]というタイプをG[A]に変換する.1組の文F[A]をより大きな文セットG[A](G[A)に注入すると理解できる(G[A]はF[A]であり、この場合変換結果はタッチのような文セットになる).Interactは他のADTと異なるため、Functorであるため、lift関数を呼び出して昇格させる場合、compilerはエラータイプの導出結果を生成し、liftFCを直接呼び出すことで問題を解決することができ、これは後で検討を続ける.これらの昇格した文セットには、暗黙的なインスタンスimplicit instanceが備えられており、暗黙的な解析ドメイン内で操作文のサポートをいつでも提供できます.
3、ASTs:現在、これらの基礎文セットがあり、機能要求によって、ある文を一つのプログラムASTに組み合わせることができ、あるいは二つ以上の文を組み合わせてプログラムを組み合わせることができ、さらに発生したASTをもっと大きなプログラムに組み合わせることができる.これらの文セットの結合はscalazのCoproductで実現できます.
    type LoginScript[A] = Coproduct[Interact, UserLogin, A]
    type CalcScript[A] = Coproduct[Interact, Calculator, A]
    type AccessScript[A] = Coproduct[Interact, Permission, A]
    val accessPrg = accessScript[AccessScript] _
    val loginPrg = loginScript[LoginScript]
    val calcPrg = calcScript[CalcScript] _

ここには特に注意しなければならない部分があります.理論的には、Coproductを使用して2つ以上の文セットを結合することができます.
    type F0[A] = Coproduct[Interact,UserLogin,A]
    type F1[A] = Coproduct[Permission,F0,A]
    type F2[A] = Coproduct[Calculator,F1,A]
    val loginPrg2 = loginScript[F1]

ただしloginPrg 2コンパイルエラー:
not enough arguments for method loginScript: (implicit I: run.demo.Modules.FreeFunctions.Interacts[run.demo.Modules.FreeProgs.F1], implicit L: run.demo.Modules.FreeFunctions.Logins[run.demo.Modules.FreeProgs.F1], implicit P: run.demo.Modules.FreeFunctions.Permissions[run.demo.Modules.FreeProgs.F1])scalaz.Free[[x]scalaz.Coyoneda[run.demo.Modules.FreeProgs.F1,x],String]. Unspecified value parameters L, P.

私の初歩的な分析はscalazがFreeに設定した敷居のためかもしれません:F[A]はFunctorでなければなりません.lift関数のInject[F,G]では、ターゲットタイプG[]最終的にはFree Monadに昇格します.もし私たちがFreeを使うなら.LiftF関数ならG[]Functorでなければなりません.Freeを使うかもしれません.liftFC後にcompilerが正常に類型推定できなくなるでしょう.最近新しく発売されたCatsコンポーネントライブラリにおけるFreeの定義はFunctorを必要とせず,この問題を解決する可能性がある.Freeは将来の主なプログラミングモードになる可能性があるため,多文セットの連携使用の問題を解決する方法を考えなければならない.しかし、これを後で話しましょう.
昇格した文でプログラミングできます.つまり、関数の組み合わせです.
 object FreeProgs {
    import FreeFunctions._
    import FreeInteract._
    import FreeLogin._
    import FreePermission._
    import FreeCalculator._
    def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l]
    def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = {
      import I._
      import L._
      for {
        uid <- ask("ya id:",identity)
        pwd <- ask("password:",identity)
        login <- login(uid,pwd)
        _ <- if (login) tell("ya in, ya lucky bastard!")
                else tell("geta fk outa here!")
        usr <- if (login) freeCMonad[F].point(uid) 
               else freeCMonad[F].point("???")
      } yield uid
    }
    def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = {
      import I._
      import P._
      for {
        inp <- ask("votiu vangto do?",identity)
        cando <- hasPermission(uid,inp)
        _ <- if (cando) tell("ok, go on ...")
                else tell("na na na, cant do that!")   
        opr <- if (cando) freeCMonad[F].point(inp) 
               else freeCMonad[F].point("XXX")
      } yield inp
       
    }

    def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = {
      import I._;import C._;
      for {
        op1 <- ask("fus num:", _.toInt)
        op2 <- ask("nx num:", _.toInt)
        result <- calc(opr,op1,op2)
      } yield result
    }

    type LoginScript[A] = Coproduct[Interact, UserLogin, A]
    type CalcScript[A] = Coproduct[Interact, Calculator, A]
    type AccessScript[A] = Coproduct[Interact, Permission, A]
    val accessPrg = accessScript[AccessScript] _
    val loginPrg = loginScript[LoginScript]
    val calcPrg = calcScript[CalcScript] _   
  }

以上の各プログラムは比較的簡単で、理解しやすいことがわかります.これもFPの特徴です:簡単な基本的なプログラムから始めて、絶えず組み合わせて完全な応用を形成します.
4、Dependency injection:少し規模のあるプログラムは、他のプログラムに依存していくつかの機能を提供する必要がある可能性があります.この例では依存注入をいくつか示します
object Dependencies {
  trait PasswordControl {
    val pswdMap: Map[String,String]
    def matchPassword(uid: String, pswd: String): Boolean
  }
  trait PermissionControl {
    val permMap: Map[String,List[String]]
    def matchPermission(uid: String, operation: String): Boolean
  }
}

5、Interpreter:演算プログラムの時(program interpretation)、必要に応じて依存中の機能を呼び出すことができる:
    import Dependencies._
    type PasswordReader[A] = Reader[PasswordControl, A]
    object LoginInterp extends (UserLogin ~> PasswordReader) {
      def apply[A](la: UserLogin[A]): PasswordReader[A] = la match {
        case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd))
      }
    }

2つの文を組み合わせて使用すると、同じターゲット文セットに変換されるため、InteractとUserLoginを組み合わせて使用するとPasswordReaderタイプの変換が行われます.Interactは最も基本的な機能であり、他のADTと組み合わせて使用して機能するため、各連合ADTに特殊なInterpreterを提供します.
    object InteractConsole extends (Interact ~> Id) {
      def apply[A](ia: Interact[A]): Id[A] = ia match {
        case Ask(p,onInput) => println(p); onInput(readLine)
        case Tell(m, n) => println(m); n
      }
    }
    import FreeLogin._
    object InteractLogin extends (Interact ~> PasswordReader) {
      def apply[A](ia: Interact[A]): PasswordReader[A] = ia match {
        case Ask(p,onInput) => println(p); Reader(m => onInput(readLine))
        case Tell(m, n) => println(m); Reader(m => n)
      }
    }
    import FreePermission._
    object InteractPermission extends(Interact ~> PermissionReader) {
      def apply[A](ia: Interact[A]): PermissionReader[A] = ia match {
        case Ask(p,onInput) => println(p);Reader(m => onInput(readLine))
        case Tell(m,n) => println(m); Reader(m => n)
      }
    }

同様に、連合文セットを編成するプログラムには、対応する演算方法が必要です.特にCoproductタイプの演算にor関数を提供します.
    def or[F[_],H[_],G[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
      new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
       def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
         case -\/(x) => fg(x)
         case \/-(y) => hg(y)
       }

Coproduceは、2つの文セットを左右に配置します.Coproduct構造の各演算構造の文を遍歴するだけです.
6、running program:私たちはすべての文をFreeCタイプに昇格したので、runFC関数を呼び出して実行しなければなりません.FPプログラム遅延副作用の例として,プログラムの真の演算時に依存を注入した.
object FreeProgram extends App {
  import Modules._
  import FreeInteract._
  import FreeLogin._
  import FreePermission._
  import FreeFunctions._
  import FreeProgs._
  import Dependencies._
  object Passwords extends PasswordControl {
     val pswdMap = Map (
       "Tiger" -> "1234",
       "John" -> "0332"
     )
     def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd
  }
  object AccessRights extends PermissionControl {
     val permMap = Map (
       "Tiger" -> List("Add","Sub"),
       "John" -> List("Mul","Div")
     )
     def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr}
  }
  
  val uid = Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords)
  val opr = Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).run(AccessRights)
  val sum = Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp))
  println(uid)
  println(opr)
  println(sum)
}

しかし、この例はまだ完全なプログラムではありません.私たちの印象の完全な応用には、インタラクティブなループ、エラーのヒントなどが加わるはずです.この例をFPで改善してもらえませんか?まずループ(looping):FPループは再帰ではないか(recursion)、本当にだめならTrampolineを試してみましょう.プログラムのプロセス制御について:ノード間で次の操作を表すステータスを渡すことができます.
    trait NextStep  //  :      
    case object Login extends NextStep  //  ,      
    case class End(msg: String) extends NextStep  //      
    case class Opr(uid: String) extends NextStep  //           
    case class Calc(uid: String, opr: String) extends NextStep //    

各ステップを演算する関数を作成できます.
    def runStep(step: NextStep): Exception \/ NextStep = {
      try {
       step match {
        case Login => {
         Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords) match {
           case "???" => End("Termination! Login failed").right
           case uid: String => Opr(uid).right
           case _ => End("Abnormal Termination! Unknown error.").right
         }
        }
        case Opr(uid) =>
          Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).
          run(AccessRights) match {
            case "XXX" => Opr(uid).right
            case opr: String => if (opr.toUpperCase.startsWith("Q")) End("End at user request。").right
                                else Calc(uid,opr).right
            case _ => End("Abnormal Termination! Unknown error.").right
          }
        case Calc(uid,opr) => 
          println(Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp)))
          Opr(uid).right
       }
      }
      catch {
         case e: Exception => e.left[NextStep]  
      }
    }

この関数にuid=「XXX」を追加しました.opr.toUpperCase.startWith(「Q」)およびopr=「????」これらの状態.AccessScriptとLoginScriptを調整する必要があります.
  object FreeProgs {
    import FreeFunctions._
    import FreeInteract._
    import FreeLogin._
    import FreePermission._
    import FreeCalculator._
    def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l]
    def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = {
      import I._
      import L._
      for {
        uid <- ask("ya id:",identity)
        pwd <- ask("password:",identity)
        login <- login(uid,pwd)
        _ <- if (login) tell("ya in, ya lucky bastard!")
                else tell("geta fk outa here!")
        usr <- if (login) freeCMonad[F].point(uid) 
               else freeCMonad[F].point("???")
      } yield usr
    }
    def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = {
      import I._
      import P._
      for {
        inp <- ask("votiu vangto do?",identity)
        cando <- if (inp.toUpperCase.startsWith("Q")) freeCMonad[F].point(true) else hasPermission(uid,inp)
        _ <- if (cando) freeCMonad[F].point("")
                else tell("na na na, cant do that!")   
        opr <- if (cando) freeCMonad[F].point(inp) 
               else freeCMonad[F].point("XXX")
      } yield opr
       
    }

    def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = {
      import I._;import C._;
      for {
        op1 <- ask("fus num:", _.toInt)
        op2 <- ask("nx num:", _.toInt)
        result <- calc(opr,op1,op2)
      } yield result
    }

そして、循環的なインタラクションを行うことができます.
    import scala.annotation.tailrec
    @tailrec
    def whileRun(state: Exception \/ NextStep): Unit = state match {
      case \/-(End(msg)) => println(msg)
      case \/-(nextStep: NextStep) => whileRun(runStep(nextStep))
      case -\/(e) => println(e)
      case _ => println("Unknown exception!")
    }

これはテール再帰アルゴリズム(tail recursion)です.テスト実行:
object FreeProgram extends App {
  import Modules._
  import FreeRunner._
  whileRun(Login.right)
}

テスト結果は次のとおりです.
ya id:
Tiger
password:
1234
ya in, man!
votiu vangto do?
Add
fus num:
12
nx num:
5
got ya self a 17.
votiu vangto do?
23
na na na, can't do that!
votiu vangto do?
Sub
fus num:
23
nx num:
5
got ya self a 18.
votiu vangto do?
quit
End at user request。
ya id:
John
password:
1234
geta fk outa here!, you bastard
Termination! Login failed
ya id:
John
password:
0332
ya in, man!
votiu vangto do?
Add
na na na, can't do that!
votiu vangto do?
Mul
fus num:
3
nx num:
7
got ya self a 21.
votiu vangto do?
Div
fus num:
10
nx num:
3
got ya self a 3.
votiu vangto do?
Div
fus num:
12
nx num:
0
Abnormal termination!
java.lang.ArithmeticException: / by zero

Trampolineを使用してこの例をループ演算することもできます.
    import scalaz.Free.Trampoline
    import scalaz.Trampoline._
    def runTrampoline(state: Exception \/ NextStep): Trampoline[Unit] = state match {
      case \/-(End(msg)) => done(println(msg))
      case \/-(nextStep: NextStep) => suspend(runTrampoline(runStep(nextStep)))
      case -\/(e) => done({println("Abnormal termination!"); println(e)})
      case _ => done(println("Unknown exception!"))
    }

テスト演算:
object FreeProgram extends App {
  import Modules._
  import FreeRunner._
//  whileRun(Login.right)
  runTrampoline(Login.right).run			
}

テスト演算結果:
ya id:
Tiger
password:
1234
ya in, man!
votiu vangto do?
Sub
fus num:
12
nx num:
15
got ya self a -3.
votiu vangto do?
Mul
na na na, can't do that!
votiu vangto do?
Add
fus num:
10
nx num:
5
got ya self a 15.
votiu vangto do?
quit
End at user request。

次に、この例の完全なソースコードを示します.
package run.demo
import scalaz._
import Scalaz._
import scala.language.higherKinds
import scala.language.implicitConversions
import run.demo.Modules.FreeCalculator.CalcInterp

object Modules {
  object FreeInteract {
    trait Interact[+NextAct]
    object Interact {
      case class Ask[NextAct](prompt: String, onInput: String => NextAct) extends Interact[NextAct]
      case class Tell[NextAct](msg: String, n: NextAct) extends Interact[NextAct]
      implicit object interactFunctor extends Functor[Interact] {
         def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
           case Ask(p,onInput) => Ask(p, onInput andThen f)
           case Tell(m,n) => Tell(m, f(n))
         }
      } 
    }
    import Interact._
    object InteractConsole extends (Interact ~> Id) {
      def apply[A](ia: Interact[A]): Id[A] = ia match {
        case Ask(p,onInput) => println(p); onInput(readLine)
        case Tell(m, n) => println(m); n
      }
    }
    import FreeLogin._
    object InteractLogin extends (Interact ~> PasswordReader) {
      def apply[A](ia: Interact[A]): PasswordReader[A] = ia match {
        case Ask(p,onInput) => println(p); Reader(m => onInput(readLine))
        case Tell(m, n) => println(m); Reader(m => n)
      }
    }
    import FreePermission._
    object InteractPermission extends(Interact ~> PermissionReader) {
      def apply[A](ia: Interact[A]): PermissionReader[A] = ia match {
        case Ask(p,onInput) => println(p);Reader(m => onInput(readLine))
        case Tell(m,n) => println(m); Reader(m => n)
      }
    }
  }
  object FreeLogin {
    trait UserLogin[+A]
    object UserLogin {
      case class Login(uid: String, pswd: String) extends UserLogin[Boolean]
    } 
    import UserLogin._
    import Dependencies._
    type PasswordReader[A] = Reader[PasswordControl, A]
    object LoginInterp extends (UserLogin ~> PasswordReader) {
      def apply[A](la: UserLogin[A]): PasswordReader[A] = la match {
        case Login(uid,pswd) => Reader(m => m.matchPassword(uid, pswd))
      }
    }
  }
  object FreePermission {
    trait Permission[+A]
    object Permission {
      case class HasPermission(uid: String, opr: String) extends Permission[Boolean]
    }
    import Dependencies._
    import Permission._
    type PermissionReader[A] = Reader[PermissionControl,A]
    object PermissionInterp extends (Permission ~> PermissionReader) {
      def apply[A](pa: Permission[A]): PermissionReader[A] = pa match {
        case HasPermission(uid,opr) => Reader {m => m.matchPermission(uid, opr)}
      }
    }
  }
  object FreeCalculator {
    trait Calculator[+A]
    object Calculator {
      case class Calc(opr: String, lop: Int, rop: Int) extends Calculator[Int]
    }
    import Calculator._
    object CalcInterp extends (Calculator ~> Id) {
      def apply[A](ca: Calculator[A]): Id[A] = ca match {
        case Calc(opr,op1,op2) => opr.toUpperCase match {
          case "ADD" => op1 + op2
          case "SUB" => op1 - op2
          case "MUL" => op1 * op2
          case "DIV" => op1 / op2
        }
      }
    }
  }
  object FreeFunctions {
    import FreeInteract._
    import Interact._
    import FreeLogin._
    import UserLogin._
    import FreePermission._
    import Permission._
    import FreeCalculator._
    import Calculator._
    def lift[F[_],G[_],A](fa: F[A])(implicit I: Inject[F,G]): Free.FreeC[G,A] = 
       Free.liftFC(I.inj(fa)) 
    class Interacts[G[_]](implicit I: Inject[Interact,G]) {
      def ask[A](prompt: String, onInput: String => A) = Free.liftFC(I.inj(Ask(prompt, onInput)))
      def tell[A](msg: String) = Free.liftFC(I.inj(Tell(msg, ())))
    }
    object Interacts {
      implicit def instance[F[_]](implicit I: Inject[Interact,F]) = new Interacts[F]
    }
    class Logins[G[_]](implicit I: Inject[UserLogin,G]) {
      def login(uid: String, pswd: String) = lift(Login(uid,pswd))
    }
    object Logins {
      implicit def instance[F[_]](implicit I: Inject[UserLogin,F]) = new Logins[F]
    }
    class Permissions[G[_]](implicit I: Inject[Permission,G]) {
      def hasPermission(uid: String, opr: String) = lift(HasPermission(uid,opr))
    }
    object Permissions {
      implicit def instance[F[_]](implicit I: Inject[Permission,F]) = new Permissions[F]
    }
    class Calculators[G[_]](implicit I: Inject[Calculator,G]) {
      def calc(opr: String, op1: Int, op2: Int) = lift(Calc(opr,op1,op2))
    }
    object Calculators {
      implicit def instance[F[_]](implicit I: Inject[Calculator,F]) = new Calculators[F]
    }
    def or[F[_],H[_],G[_]](fg: F ~> G, hg: H ~> G): ({type l[x] = Coproduct[F,H,x]})#l ~> G =
      new (({type l[x] = Coproduct[F,H,x]})#l ~> G) {
       def apply[A](ca: Coproduct[F,H,A]): G[A] = ca.run match {
         case -\/(x) => fg(x)
         case \/-(y) => hg(y)
       }
    }
  }
  object FreeProgs {
    import FreeFunctions._
    import FreeInteract._
    import FreeLogin._
    import FreePermission._
    import FreeCalculator._
    def freeCMonad[S[_]] = Free.freeMonad[({type l[x] = Coyoneda[S,x]})#l]
    def loginScript[F[_]](implicit I: Interacts[F], L: Logins[F]) = {
      import I._
      import L._
      for {
        uid <- ask("ya id:",identity)
        pwd <- ask("password:",identity)
        login <- login(uid,pwd)
        _ <- if (login) tell("ya in, man!")
                else tell("geta fk outa here!, you bastard")
        usr <- if (login) freeCMonad[F].point(uid) 
               else freeCMonad[F].point("???")
      } yield usr
    }
    def accessScript[F[_]](uid: String)(implicit I: Interacts[F], P: Permissions[F]) = {
      import I._
      import P._
      for {
        inp <- ask("votiu vangto do?",identity)
        cando <- if (inp.toUpperCase.startsWith("Q")) freeCMonad[F].point(true) else hasPermission(uid,inp)
        _ <- if (cando) freeCMonad[F].point("")
                else tell("na na na, can't do that!")   
        opr <- if (cando) freeCMonad[F].point(inp) 
               else freeCMonad[F].point("XXX")
      } yield opr
       
    }

    def calcScript[F[_]](opr: String)(implicit I: Interacts[F], C: Calculators[F]) = {
      import I._;import C._;
      for {
        op1 <- ask("fus num:", _.toInt)
        op2 <- ask("nx num:", _.toInt)
        result <- calc(opr,op1,op2)
      } yield result
    }

    type LoginScript[A] = Coproduct[Interact, UserLogin, A]
    type CalcScript[A] = Coproduct[Interact, Calculator, A]
    type AccessScript[A] = Coproduct[Interact, Permission, A]
    val accessPrg = accessScript[AccessScript] _
    val loginPrg = loginScript[LoginScript]
    val calcPrg = calcScript[CalcScript] _   
  }
  object FreeRunner {
    import FreeInteract._
    import FreeLogin._
    import FreePermission._
    import FreeFunctions._
    import FreeProgs._
    import Dependencies._
    trait NextStep  //  :      
    case object Login extends NextStep  //  ,      
    case class End(msg: String) extends NextStep  //      
    case class Opr(uid: String) extends NextStep  //           
    case class Calc(uid: String, opr: String) extends NextStep //    
    object Passwords extends PasswordControl {
      val pswdMap = Map (
       "Tiger" -> "1234",
       "John" -> "0332"
      )
      def matchPassword(uid: String, pswd: String) = pswdMap.getOrElse(uid, pswd+"!") === pswd
    }   
    object AccessRights extends PermissionControl {
       val permMap = Map (
         "Tiger" -> List("Add","Sub"),
         "John" -> List("Mul","Div")
       )
       def matchPermission(uid: String, opr: String) = permMap.getOrElse(uid, List()).exists { _ === opr}
    }    
    def runStep(step: NextStep): Exception \/ NextStep = {
      try {
       step match {
        case Login => {
         Free.runFC(loginPrg)(or(InteractLogin, LoginInterp)).run(Passwords) match {
           case "???" => End("Termination! Login failed").right
           case uid: String => Opr(uid).right
           case _ => End("Abnormal Termination! Unknown error.").right
         }
        }
        case Opr(uid) =>
          Free.runFC(accessScript[AccessScript](uid))(or(InteractPermission, PermissionInterp)).
          run(AccessRights) match {
            case "XXX" => Opr(uid).right
            case opr: String => if (opr.toUpperCase.startsWith("Q")) End("End at user request。").right
                                else Calc(uid,opr).right
            case _ => End("Abnormal Termination! Unknown error.").right
          }
        case Calc(uid,opr) => 
          println(s"got ya self a ${Free.runFC(calcScript[CalcScript](opr))(or(InteractConsole, CalcInterp))}.")
          Opr(uid).right
       }
      }
      catch {
         case e: Exception => e.left[NextStep]  
      }
    }
    import scala.annotation.tailrec
    @tailrec
    def whileRun(state: Exception \/ NextStep): Unit = state match {
      case \/-(End(msg)) => println(msg)
      case \/-(nextStep: NextStep) => whileRun(runStep(nextStep))
      case -\/(e) => println("Abnormal termination!"); println(e)
      case _ => println("Unknown exception!")
    }
    import scalaz.Free.Trampoline
    import scalaz.Trampoline._
    def runTrampoline(state: Exception \/ NextStep): Trampoline[Unit] = state match {
      case \/-(End(msg)) => done(println(msg))
      case \/-(nextStep: NextStep) => suspend(runTrampoline(runStep(nextStep)))
      case -\/(e) => done({println("Abnormal termination!"); println(e)})
      case _ => done(println("Unknown exception!"))
    }
  }
}
object Dependencies {
  trait PasswordControl {
    val pswdMap: Map[String,String]
    def matchPassword(uid: String, pswd: String): Boolean
  }
  trait PermissionControl {
    val permMap: Map[String,List[String]]
    def matchPermission(uid: String, operation: String): Boolean
  }
}
object FreeProgram extends App {
  import Modules._
  import FreeRunner._
//  whileRun(Login.right)
  runTrampoline(Login.right).run			
}