Fr

Coyoneda.scala

import scala.util.control.Exception
import scalaz._
import scalaz.Free.FreeC
import scalaz.Scalaz._

object Kasten {

  /////////////////////////
  // The State stuff
  /////////////////////////

  sealed trait EffState[S, A]

  case class Get[S]() extends EffState[S, S]

  case class Put[S](s: S) extends EffState[S, Unit]

  trait EffStateFree[S] {

    type EffStateS[A] = EffState[S, A]

    implicit def ls[A](esa: EffState[S, A]): FreeC[EffStateS, A] = {
      Free.liftFC[EffStateS, A](esa)
    }

    def sGet: EffState[S, S] = Get[S]()

    def sPut(s: S): EffState[S, Unit] = Put[S](s)
  }

  val effStateFreeInt = new EffStateFree[Int] {}

  import effStateFreeInt._

  val daStateFree: FreeC[EffStateS, Unit] =
    for {
      _ <- sPut(3)
      i <- sGet
      _ <- sPut(i * 3)
    } yield ()


  trait EffStateInterpret[S] {

    type EffStateS[A] = EffState[S, A]

    type StateS[A] = State[S, A]

    val transToState: (EffStateS ~> StateS) = new (EffStateS ~> StateS) {
      def apply[A](fa: EffState[S, A]): State[S, A] = fa match {
        case Get() => State.get[S].asInstanceOf[State[S, A]]
        case Put(s) => State.put(s).asInstanceOf[State[S, A]]
      }
    }
  }

  val effStateInterpretInt = new EffStateInterpret[Int] {}

  import effStateInterpretInt._

  val daState = Free.runFC(daStateFree)(transToState)

  /////////////////////////
  // The Exception stuff
  /////////////////////////

  sealed trait EffException[E]

  case class Raise[E](e: E) extends EffException[E]

  trait EffExceptionFree[E] {

    type EffExceptionE[A] = EffException[E] // A is simply ignored here

    implicit def le[A](ee: EffException[E]): FreeC[EffExceptionE, A] = {
      Free.liftFC[EffExceptionE, A](ee)
    }

    def sRaise(e: E): EffException[E] = Raise(e)
  }

  val effExceptionFreeString = new EffExceptionFree[String] {}

  import effExceptionFreeString._

  val daExceptionFree: FreeC[EffExceptionE, Unit] = le(sRaise("Error!"))

  trait EffExceptionInterpret[E] {
    type EffExceptionE[A] = EffException[E] // A is simply ignored here

    type OptionE[A] = Option[A]

    val transToOption: (EffExceptionE ~> OptionE) = new (EffExceptionE ~> OptionE) {
      override def apply[A](fa: EffExceptionE[A]): OptionE[A] = fa match {
        case Raise(e) => None
      }
    }

    type EitherE[A] = E \/ A

    val transToEither: (EffExceptionE ~> EitherE) = new (EffExceptionE ~> EitherE) {
      override def apply[A](fa: EffExceptionE[A]): EitherE[A] = fa match {
        case Raise(e) => -\/(e)
      }
    }
  }

  val effExceptionInterpretString = new EffExceptionInterpret[String] {}

  import effExceptionInterpretString._

  lazy val daOption = Free.runFC(daExceptionFree)(transToOption)

  lazy val daEither = Free.runFC(daExceptionFree)(transToEither)
}

CoyonedaT.scala

import scalaz._
import scalaz.Free.FreeC
import scalaz.Scalaz._
import scalaz.concurrent.Task

object KastenT {

  /////////////////////////
  // The State stuff as a MonadTransformer
  /////////////////////////

  /**
   * Compare to Kasten
   * @tparam M a Monad
   *
   *           As opposed to Kasten, where I just transformed to State,
   *           I want to transform to StateT[M] now, and also allow other
   *           operations of M
   */
  trait TransformEffState[M[_]] {

    implicit def MM: Monad[M]

    sealed trait EffState[S, A]

    case class Get[S]() extends EffState[S, S]

    case class Put[S](s: S) extends EffState[S, Unit]

    case class OtherState[S, A](ma: M[A]) extends EffState[S, A]

    trait EffStateFree[S] {

      type EffStateS[A] = EffState[S, A]

      type FreeCT[A] = FreeC[EffStateS, A]

      def ls[A](esa: EffStateS[A]): FreeCT[A] = {
        Free.liftFC[EffStateS, A](esa)
      }

      implicit def lss[A](ma: M[A]): FreeCT[A] = {
        Free.liftFC[EffStateS, A](OtherState[S, A](ma))
      }

      def sGet: FreeCT[S] = ls(Get[S]())

      def sPut(s: S): FreeCT[Unit] = ls(Put[S](s))

      def sOtherState[A](ma: M[A]): FreeCT[A] = lss[A](ma)
    }

    trait EffStateInterpret[S] {

      type EffStateS[A] = EffState[S, A]

      type StateTS[A] = StateT[M, S, A]

      val STM = StateT.stateTMonadState[S, M]

      val transToState: (EffStateS ~> StateTS) = new (EffStateS ~> StateTS) {
        def apply[A](fa: EffState[S, A]): StateT[M, S, A] = fa match {
          case Get() => STM.get.asInstanceOf[StateT[M, S, A]]
          case Put(s) => STM.put(s).asInstanceOf[StateT[M, S, A]]
          case OtherState(ma) => StateT[M, S, A](s => ma.map(a => (s, a)))
        }
      }
    }

  }

  ///////////// For Id

  val transformEffStateId = new TransformEffState[Id] {
    def MM = implicitly[Monad[Id]]

    val effStateFreeInt = new EffStateFree[Int] {}

    import effStateFreeInt._

    val daStateFree: FreeCT[Unit] =
      for {
        _ <- sPut(3)
        i <- sGet
        _ <- sPut(i * 3)
      } yield ()

    val effStateInterpretInt = new EffStateInterpret[Int] {}

    import effStateInterpretInt._

    val daState = Free.runFC(daStateFree)(transToState)
  }

  ///////////// For List

  val transformEffStateList = new TransformEffState[List] {
    def MM = implicitly[Monad[List]]

    val effStateFreeInt = new EffStateFree[Int] {}

    import effStateFreeInt._

    val daStateFree: FreeCT[Int] =
      for {
        e <- List(1, 2, 3): FreeCT[Int]
        _ <- sPut(e)
        i <- sGet
        _ <- sPut(i * 3)
      } yield e

    val effStateInterpretInt = new EffStateInterpret[Int] {}

    import effStateInterpretInt._

    val daState = Free.runFC(daStateFree)(transToState)
  }

  ///////////// For Task, now we are talking...

  val transformEffStateTask = new TransformEffState[Task] {
    def MM = implicitly[Monad[Task]]

    val effStateFreeInt = new EffStateFree[Int] {}

    import effStateFreeInt._

    val daStateFree: FreeCT[Int] =
      for {
        e <- Task.delay(readLine).map(_.toInt): FreeCT[Int]
        i <- sGet
        _ <- sPut(i * e)
      } yield e

    val effStateInterpretInt = new EffStateInterpret[Int] {}

    import effStateInterpretInt._

    val daState = Free.runFC(daStateFree)(transToState)
  }

  /////////////////////////
  // The Exception stuff as a MonadTransformer
  /////////////////////////

  trait TransformEffException[M[_]] {

    implicit def MM: Monad[M]

    sealed trait EffException[E]

    case class Raise[E](e: E) extends EffException[E]

    case class OtherException[E, A](ma: M[A]) extends EffException[E]

    trait EffExceptionFree[E] {

      type EffExceptionE[A] = EffException[E] // A is simply ignored here

      type FreeCT[A] = FreeC[EffExceptionE, A]

      def le[A](ee: EffExceptionE[A]): FreeCT[A] = {
        Free.liftFC[EffExceptionE, A](ee)
      }

      implicit def lee[A](ma: M[A]): FreeCT[A] = {
        Free.liftFC[EffExceptionE, A](OtherException[E, A](ma))
      }

      def sRaise[A](e: E): FreeCT[A] = le(Raise(e))

      def sOtherException[A](ma: M[A]): FreeCT[A] = lee(ma)
    }

    trait EffExceptionInterpret[E] {
      type EffExceptionE[A] = EffException[E] // A is simply ignored here

      type OptionTE[A] = OptionT[M, A]

      val transToOption: (EffExceptionE ~> OptionTE) = new (EffExceptionE ~> OptionTE) {
        override def apply[A](fa: EffExceptionE[A]): OptionTE[A] = fa match {
          case Raise(e) => OptionT.none[M, A]
          case OtherException(ma) => OptionT[M, A](ma.map(a => Some(a.asInstanceOf[A])))
        }
      }

      type EitherTE[A] = EitherT[M, E, A]

      val transToEither: (EffExceptionE ~> EitherTE) = new (EffExceptionE ~> EitherTE) {
        override def apply[A](fa: EffExceptionE[A]): EitherTE[A] = fa match {
          case Raise(e) => EitherT.left(MM.point(e))
          case OtherException(ma) => EitherT.right[M, E, A](ma.asInstanceOf[M[A]])
        }
      }
    }

  }

  ///////////// For Id

  val transformedEffExceptionId = new TransformEffException[Id] {
    def MM = implicitly[Monad[Id]]

    val effExceptionFreeString = new EffExceptionFree[String] {}

    import effExceptionFreeString._

    val daExceptionFree: FreeCT[Unit] =
      for {
        _ <- sRaise("Error!"): FreeCT[Unit]
      } yield ()

    val effExceptionInterpretString = new EffExceptionInterpret[String] {}

    import effExceptionInterpretString._

    lazy val daOption = Free.runFC(daExceptionFree)(transToOption)

    lazy val daEither = Free.runFC(daExceptionFree)(transToEither)
  }

  ///////////// For List

  val transformedEffExceptionList = new TransformEffException[List] {
    def MM = implicitly[Monad[List]]

    val effExceptionFreeString = new EffExceptionFree[String] {}

    import effExceptionFreeString._

    val daExceptionFree: FreeCT[Int] =
      for {
        i <- List(1, 2, 3): FreeCT[Int]
        j <- {
          if (i < 3) sRaise("Error!"): FreeCT[Int] else List(i): FreeCT[Int]
        }
      } yield j

    val effExceptionInterpretString = new EffExceptionInterpret[String] {}

    import effExceptionInterpretString._

    lazy val daOption = Free.runFC(daExceptionFree)(transToOption)

    lazy val daEither = Free.runFC(daExceptionFree)(transToEither)
  }

  ///////////// For Task

  val transformedEffExceptionTask = new TransformEffException[Task] {
    def MM = implicitly[Monad[Task]]

    val effExceptionFreeString = new EffExceptionFree[String] {}

    import effExceptionFreeString._

    val daExceptionFree: FreeCT[Int] =
      for {
        i <- Task.delay(readLine).map(_.toInt): FreeCT[Int]
        j <- {
          if (i < 3) sRaise("Error!"): FreeCT[Int] else Task.now(i): FreeCT[Int]
        }
      } yield j

    val effExceptionInterpretString = new EffExceptionInterpret[String] {}

    import effExceptionInterpretString._

    lazy val daOption = Free.runFC(daExceptionFree)(transToOption)

    lazy val daEither = Free.runFC(daExceptionFree)(transToEither)
  }
}

CoyonedaTT.scala

// guckst du https://github.com/davidpeklak/effectcompose

DoubleFreeFr.scala

import scalaz.concurrent.Task
import scalaz.Free.{Return, Suspend}
import scalaz._

// explore scalaz.Free with Free Functor and >1 IO description type, namely Console and DB
object DoubleFreeFr {

  sealed trait FreeFunctor[F[_], +A] {
    def map[B](f: A => B): FreeFunctor[F, B]
  }

  case class Map[F[_], I, +A](fa: F[I], g: I => A) extends FreeFunctor[F, A] {
    def map[B](f: A => B) = Map(fa, g andThen f)
  }

  def freeFunctorFunctor[F[_]]: Functor[({type λ[A] = FreeFunctor[F, A]})#λ] = new Functor[({type λ[A] = FreeFunctor[F, A]})#λ] {
    def map[A, B](fa: FreeFunctor[F, A])(f: A => B): FreeFunctor[F, B] = fa map f
  }

  type FreeC[F[_], A] = Free[({type λ[+x] = FreeFunctor[F, x]})#λ, A]

  def request[F[_], A](fa: F[A]): FreeC[F, A] = {
    implicit val freeFunctorFunctorF = freeFunctorFunctor[F]
    Suspend[({type λ[+x] = FreeFunctor[F, x]})#λ, A](Map(fa, (a: A) => Return[({type λ[+x] = FreeFunctor[F, x]})#λ, A](a)))
  }

  sealed trait Console[A]

  case object ReadLine extends Console[Option[String]]

  case class PrintLine(s: String) extends Console[Unit]

  object Console {
    def readLn: Console[Option[String]] = ReadLine

    def printLn(s: String): Console[Unit] = PrintLine(s)
  }

  object RealConsoleIdTrans extends (Console ~> Id.Id) {
    def apply[A](c: Console[A]): A = c match {
      case ReadLine => Some(readLine())
      case PrintLine(s) => println(s)
    }
  }

  object RealConsoleTaskTrans extends (Console ~> Task) {
    def apply[A](c: Console[A]): Task[A] = Task(RealConsoleIdTrans(c))
  }

  sealed trait DB[A]

  case object LoadLine extends DB[Option[String]]

  case class SaveLine(s: String) extends DB[Unit]

  object DB {
    var dbVar: Option[String] = None

    def loadLine: DB[Option[String]] = LoadLine

    def saveLine(s: String): DB[Unit] = SaveLine(s)
  }

  object RealDBIdTrans extends (DB ~> Id.Id) {
    def apply[A](db: DB[A]): A = db match {
      case LoadLine => DB.dbVar
      case SaveLine(s) => DB.dbVar = Some(s)
    }
  }

  def freeLift[F[_], G[_]](fg: F ~> G)(implicit G: Functor[G]): ({type f[x] = FreeFunctor[F, x]})#f ~> G = new (({type f[x] = FreeFunctor[F, x]})#f ~> G) {
    def apply[A](f: FreeFunctor[F, A]): G[A] = f match {
      case Map(fa, g) => G.map(fg(fa))(g)
    }
  }

  val RealConsoleIdFFTrans = freeLift(RealConsoleIdTrans)

  val RealDBIdFFTrans = freeLift(RealDBIdTrans)

  type ConsoleFF[A] = FreeFunctor[Console, A]

  type IO[A] = Free[Task, A]


  object ConsoleProgram {

    import Console._

    implicit def requestConsole[A](fa: Console[A]): FreeC[Console, A] = request(fa)

    val consoleProgram: FreeC[Console, Unit] = for {
      _ <- printLn("What is your name?")
      name <- readLn
      _ <- name map {
        n => printLn(s"Hello, $n!")
      } getOrElse printLn("Fine, be that way.")
    } yield ()

    // consoleProgram.foldMap(RealConsoleIdFFTrans)
  }

  object DBProgram {

    import DB._

    implicit def requestDB[A](fa: DB[A]): FreeC[DB, A] = request(fa)

    val dbProgram: FreeC[DB, Option[String]] = for {
      _ <- saveLine("hallo")
      s <- loadLine
    } yield s

    // dbProgram.foldMap(RealDBIdFFTrans)
  }

  object BothProgram {

    import Console._
    import DB._
    import Type._ // https://gist.github.com/davidpeklak/9421853

    type ConsoleDbEvidence[F[_], A] = (Console[A] \:/ DB[A])#λ[F[A]]

    case class Wrap[+F[_], A](f: F[A])(implicit evidence: ConsoleDbEvidence[F, A])

    type wrap[A] = Wrap[Any, A]

    implicit def requestConsoleOrDB[F[_], A](fa: F[A])(implicit evidence: ConsoleDbEvidence[F, A]): FreeC[wrap, A] = request[wrap, A](Wrap(fa))

    val bothProgram = for {
      _ <- printLn("What is your name?")
      name <- readLn
      previousName <- loadLine
      _ <- saveLine(name.get)
      _ <- printLn("Saved your name to the DB. The name save previously was " + previousName.getOrElse("(None)"))
    } yield ()

    object RealBothIdTrans extends (wrap ~> Id.Id) {
      def apply[A](wr: wrap[A]): A = wr match {
        case Wrap(db: DB[A]) => RealDBIdTrans(db)
        case Wrap(co: Console[A]) => RealConsoleIdTrans(co)
      }
    }

    val RealBothIdFFTrans = freeLift(RealBothIdTrans)

    // bothProgram.foldMap(RealBothIdFFTrans)
    // request(DB.loadLine).foldMap(RealDBIdFFTrans)
  }
}

Fr.scala

package david

import scalaz.{StateT, State, Monad}
import scalaz.syntax.MonadSyntax
import scalaz.Id

object Fr {

  sealed trait Free[F[_], A]

  case class Return[F[_], A](a: A) extends Free[F, A]

  case class Suspend[F[_], A](s: F[Free[F, A]]) extends Free[F, A]

  case class FlatMap[F[_], A, B](s: Free[F, A],
                                 f: A => Free[F, B]) extends Free[F, B]

  def freeInstance[F[_]]: Monad[({type λ[A] = Free[F, A]})#λ] = new Monad[({type λ[A] = Free[F, A]})#λ] {

    type λ[A] = Free[F, A]

    def point[A](a: => A) = Return(a)

    def bind[A, B](a: λ[A])(f: A => λ[B]): λ[B] = FlatMap(a, f)
  }

  sealed trait Console[R]

  case class ReadLine[R](k: Option[String] => R)
    extends Console[R]

  case class PrintLine[R](s: String, k: () => R)
    extends Console[R]

  object Console {
    type FreeConsole[A] = Free[Console, A]

    def readLn: FreeConsole[Option[String]] =
      Suspend(ReadLine((s: Option[String]) => Return(s)))

    def printLn(s: String): FreeConsole[Unit] =
      Suspend(PrintLine(s, () => Return(())))
  }

  trait CoPoint[F[_]] {
    def copoint[A](p: F[A]): A
  }

  trait StatefulInterpreter[F[_]] {
    def interpret[A](p: F[A]): (StatefulInterpreter[F], A)
  }

  trait ~>[F[_], G[_]] {
    def apply[A](f: F[A]): G[A]
  }

  // Free[Console, _] Interpreter
  object fci {

    import Console._

    val syntax = new MonadSyntax[FreeConsole] {
      def F: Monad[FreeConsole] = freeInstance[Console]
    }

    object consoleInterpreter extends CoPoint[Console] {
      def copoint[R](c: Console[R]): R = c match {
        case ReadLine(k) => k(Some(readLine()))
        case PrintLine(s, k) => {
          println(s)
          k()
        }
      }
    }

    object mockInterpreter extends CoPoint[Console] {
      def copoint[R](c: Console[R]): R = c match {
        case ReadLine(k) => k(Some("mock"))
        case PrintLine(s, k) => k()
      }
    }

    def runConsole[A](coPoint: CoPoint[Console])(io: FreeConsole[A]): A = io match {
      case Return(a) => a
      case Suspend(s) => runConsole(coPoint)(coPoint.copoint(s))
      case FlatMap(s, f) => runConsole(coPoint)(f(runConsole(coPoint)(s)))
    }

    case class BufferedInterpreter(reads: Seq[String], prints: Seq[String]) extends StatefulInterpreter[Console] {
      def interpret[A](c: Console[A]): (StatefulInterpreter[Console], A) = c match {
        case ReadLine(k) => (copy(reads = reads.drop(1)), k(reads.headOption))
        case PrintLine(s, k) => (copy(prints = prints :+ s), k())
      }
    }

    def runConsoleS[A](inter: StatefulInterpreter[Console])(io: FreeConsole[A]): (StatefulInterpreter[Console], A) = io match {
      case Return(a) => (inter, a)
      case Suspend(s) => {
        val (inter2, a) = inter.interpret(s)
        runConsoleS(inter2)(a)
      }
      case FlatMap(s, f) => {
        val (inter2, a) = runConsoleS(inter)(s)
        runConsoleS(inter2)(f(a))
      }
    }

    // def runConsoleSt[A](io: ConsoleIO[A]): State[StatefulInterpreter[Console], A] = State(si => runConsoleS(si)(io))

    def runConsoleSt[A](io: FreeConsole[A]): State[StatefulInterpreter[Console], A] = io match {
      case Return(a) => State(inter => (inter, a))
      case Suspend(s) => State(inter => {
        val (inter2, a) = inter.interpret(s)
        runConsoleS(inter2)(a)
      })
      case FlatMap(s, f) => State(inter => {
        val (inter2, a) = runConsoleS(inter)(s)
        runConsoleS(inter2)(f(a))
      })
    }

    implicit val stateInstance = StateT.stateMonad[StatefulInterpreter[Console]]

    def runConsoleSt2[A](io: FreeConsole[A]): State[StatefulInterpreter[Console], A] = io match {
      case Return(a) => stateInstance.point(a)
      case Suspend(s) => State((inter: StatefulInterpreter[Console])  => inter.interpret(s)).flatMap(runConsoleSt2)
      case FlatMap(s, f) => runConsoleSt2(s).flatMap(a => runConsoleSt2(f(a)))
    }

    type ConsoleState[A] = State[StatefulInterpreter[Console], A]

    object ConsoleStateTrans extends (Console ~> ConsoleState) {
      def apply[A](c: Console[A]): ConsoleState[A] = State(si => si.interpret(c))
    }

    object RealIdTrans extends (Console ~> Id.Id) {
      def apply[A](c: Console[A]): A = c match {
        case ReadLine(k) => k(Some(readLine()))
        case PrintLine(s, k) => {
          println(s)
          k()
        }
      }
    }
  }

  object Free {
    def runFree[F[_], G[_], A](trans: F ~> G)(free: Free[F, A])(implicit G: Monad[G]): G[A] = {
      def recurse[B](free: Free[F, B]): G[B] = runFree[F, G, B](trans)(free)
      val GM = implicitly[Monad[G]]
      free match {
        case Return(a) => GM.point(a)
        case Suspend(s) => GM.bind(trans[Free[F, A]](s))(recurse)
        case FlatMap(s, f) => GM.bind(recurse[Any](s))(a => recurse(f(a)))
      }
    }
  }

  import Console._
  import fci.syntax._

  val convert = for {
    f <- readLn
    _ <- printLn(f.getOrElse("None"))
  } yield ()

  // run "for real" with: Free.runFree[Console, scalaz.Id.Id, Unit](fci.RealIdTrans)(convert)

  // run with State and Buffer:
  // val s = Free.runFree[Console, fci.ConsoleState, Unit](fci.ConsoleStateTrans)(convert)
  // s.run(fci.BufferedInterpreter(List("ans", "zwa"), Nil))
}

FrFr.scala

import scalaz.concurrent.Task
import scalaz._
import scalaz.syntax.MonadSyntax

object FrFr {

  sealed trait Free[F[_], A]

  case class Return[F[_], A](a: A) extends Free[F, A]

  case class Suspend[F[_], A](s: F[Free[F, A]]) extends Free[F, A]

  case class FlatMap[F[_], A, B](s: Free[F, A],
                                 f: A => Free[F, B]) extends Free[F, B]

  def freeInstance[F[_]]: Monad[({type λ[A] = Free[F, A]})#λ] = new Monad[({type λ[A] = Free[F, A]})#λ] {

    type λ[A] = Free[F, A]

    def point[A](a: => A) = Return(a)

    def bind[A, B](a: λ[A])(f: A => λ[B]): λ[B] = FlatMap(a, f)
  }

  sealed trait FreeFunctor[F[_], A] {
    def map[B](f: A => B): FreeFunctor[F, B]
  }

  case class Map[F[_], I, A](fa: F[I], g: I => A) extends FreeFunctor[F, A] {
    def map[B](f: A => B) = Map(fa, g andThen f)
  }

  type FreeC[F[_], A] = Free[({type λ[x] = FreeFunctor[F, x]})#λ, A]

  implicit def request[F[_], A](fa: F[A]): FreeC[F, A] =
    Suspend[({type λ[x] = FreeFunctor[F, x]})#λ, A](Map(fa, (a: A) => Return[({type λ[x] = FreeFunctor[F, x]})#λ, A](a)))

  sealed trait Console[A]

  case object ReadLine extends Console[Option[String]]

  case class PrintLine(s: String) extends Console[Unit]

  object Console {
    def readLn: Console[Option[String]] = ReadLine

    def printLn(s: String): Console[Unit] = PrintLine(s)
  }


  trait ~>[F[_], G[_]] {
    def apply[A](f: F[A]): G[A]
  }

  object Free {
    def runFree[F[_], G[_], A](trans: F ~> G)(free: Free[F, A])(implicit G: Monad[G]): G[A] = {
      def recurse[B](free: Free[F, B]): G[B] = runFree[F, G, B](trans)(free)
      val GM = implicitly[Monad[G]]
      free match {
        case Return(a) => GM.point(a)
        case Suspend(s) => GM.bind(trans[Free[F, A]](s))(recurse)
        case FlatMap(s, f) => GM.bind(recurse[Any](s))(a => recurse(f(a)))
      }
    }
  }

  object RealIdTrans extends (Console ~> Id.Id) {
    def apply[A](c: Console[A]): A = c match {
      case ReadLine => Some(readLine())
      case PrintLine(s) => println(s)
    }
  }

  object RealTaskTrans extends (Console ~> Task) {
    def apply[A](c: Console[A]): Task[A] = Task(RealIdTrans(c))
  }

  def freeLift[F[_], G[_]](fg: F ~> G)(implicit G: Functor[G]): ({type f[x] = FreeFunctor[F, x]})#f ~> G = new (({type f[x] = FreeFunctor[F, x]})#f ~> G) {
    def apply[A](f: FreeFunctor[F, A]): G[A] = f match {
      case Map(fa, g) => G.map(fg(fa))(g)
    }
  }

  val RealIdFFTrans = freeLift(RealIdTrans)

  type ConsoleFF[A] = FreeFunctor[Console, A]

  type IO[A] = Free[Task, A]

  val freeCCSyntax = new MonadSyntax[({type λ[A] = FreeC[Console, A]})#λ] {
    type FreeConsoleFunctor[A] = FreeFunctor[Console, A]

    def F: Monad[({type λ[A] = FreeC[Console, A]})#λ] = freeInstance[FreeConsoleFunctor]
  }

  import Console._

  implicit def consoleToFreeCCBindOps[A](c: Console[A]) = freeCCSyntax.ToBindOps(request(c))

  implicit def consoleToFreeCCFunctorOps[A](c: Console[A]) = freeCCSyntax.ToFunctorOps(request(c))

  val program: FreeC[Console, Unit] = for {
    _ <- printLn("What is your name?")
    name <- readLn
    _ <- name map {
      n => printLn(s"Hello, $n!")
    } getOrElse printLn("Fine, be that way.")
  } yield ()

  // Free.runFree[ConsoleFF, scalaz.Id.Id, Unit](RealIdFFTrans)(program)
}

Krach.scala

import scala.annotation.tailrec

object MyIo2 {

  sealed trait IO[+A] {
    def flatMap[B](f: A => IO[B]): IO[B] = this match {
      case FlatMap(x, g) => FlatMap(x, (a: Any) => g(a).flatMap(f))
      case x => FlatMap(x, f)
    }

    def map[B](f: A => B): IO[B] =
      FlatMap[A, B](this, a => Return(f(a)))

    def run: A = IO.run(this)
  }

  object IO {
    def apply[A](a: => A): IO[A] = Suspend(() => Return[A](a))

    def join[A](ffa: IO[IO[A]]) = ffa.flatMap(identity)

    @tailrec def run[A](io: IO[A]): A = io match {
      case Return(a) => a
      case Suspend(r) => run(r())
      case FlatMap(x, f) => x match {
        case Return(a) => run(f(a))
        case Suspend(r) => run(r() flatMap f)
        case FlatMap(y, g) => run(y flatMap (a => g(a) flatMap f))
      }
    }
  }

  case class Return[A](a: A) extends IO[A]

  case class Suspend[A](resume: () => IO[A]) extends IO[A]

  case class FlatMap[A, B](sub: IO[A], k: A => IO[B]) extends IO[B]

  def PrintLine(msg: String): IO[Unit] = IO(println(msg))

  val actions: Stream[IO[Unit]] =
    Stream.fill(1000000)(PrintLine("Still going..."))

  val composite: IO[Unit] =
    actions.foldLeft(Return(()): IO[Unit]) {
      (acc, a) => acc.flatMap {
        _ => a
      }
    }
}