http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html

Free.scala

import language.{ higherKinds, implicitConversions }

trait Unapply[TC[_[+_]], FA] {
  type F[+_]
  type A
  def TC: TC[F]
  def apply(fa: FA): F[A]
}

object Unapply {
  implicit def unapply0[TC[_[+_]], F0[+_], A0](implicit TC0: TC[F0]) = new Unapply[TC, F0[A0]] {
    type F[+α] = F0[α]
    type A = A0
    def TC = TC0
    def apply(fa: F0[A0]): F[A] = fa
  }

  implicit def unapply1[TC[_[+_]], F0[_[+_], +_], G0[+_], A0](implicit TC0: TC[({ type λ[+α] = F0[G0, α] })#λ]) = new Unapply[TC, F0[G0, A0]] {
    type F[+α] = F0[G0, α]
    type A = A0
    def TC = TC0
    def apply(fa: F0[G0, A0]): F[A] = fa
  }
}

trait Functor[F[+_]] {
  def fmap[A, B](fa: F[A])(f: A => B): F[B]
}

object Functor {
  final class Ops[F[+_], A](fa: F[A], F: Functor[F]) {
    def map[B](f: A => B): F[B] = F.fmap(fa)(f)
  }
  implicit def functorOps[FA](fa: FA)(implicit FA: Unapply[Functor, FA]) = new Ops(FA(fa), FA.TC)
}

trait Applicative[F[+_]] extends Functor[F] {
  def pure[A](a: A): F[A]
  def ap[A, B](fa: F[A])(ff: F[A => B]): F[B]
  override def fmap[A, B](fa: F[A])(f: A => B): F[B] = ap(fa)(pure(f))
}

object Applicative {
  final class Ops[F[+_], A](fa: F[A], F: Applicative[F]) {
    def ap[B](ff: F[A => B]): F[B] = F.ap(fa)(ff)
  }
  implicit def applicativeOps[FA](fa: FA)(implicit FA: Unapply[Applicative, FA]) = new Ops(FA(fa), FA.TC)
}

trait Monad[F[+_]] extends Applicative[F] {
  def bind[A, B](fa: F[A])(f: A => F[B]): F[B]
  override def fmap[A, B](fa: F[A])(f: A => B): F[B] = bind(fa)(f andThen pure)
  override def ap[A, B](fa: F[A])(ff: F[A => B]): F[B] = bind(ff)(fmap(fa))
}

object Monad {
  final class Ops[F[+_], A](fa: F[A], F: Monad[F]) {
    def flatMap[B](f: A => F[B]): F[B] = F.bind(fa)(f)
  }
  implicit def monadOps[FA](fa: FA)(implicit FA: Unapply[Monad, FA]) = new Ops(FA(fa), FA.TC)
}

sealed trait Free[F[+_], +A]
object Free {
  case class Pure[F[+_], +A](get: A) extends Free[F, A]
  case class Bind[F[+_], +A](run: F[Free[F, A]]) extends Free[F, A]

  implicit def freeMonad[F[+_]](implicit F: Functor[F]) = new Monad[({ type λ[+α] = Free[F, α] })#λ] {
    override def pure[A](a: A): Free[F, A] = Pure(a)
    override def bind[A, B](fa: Free[F, A])(f: A => Free[F, B]): Free[F, B] = fa match {
      case Pure(a) => f(a)
      case Bind(ff) => Bind(F.fmap(ff) { bind(_)(f) })
    }
  }

  import Functor._
  def lift[F[+_]: Functor, A](fa: F[A]): Free[F, A] = Bind(fa map { Pure(_) })
}

sealed trait Toy[+A]
object Toy {
  case class Output[+A](message: String, cont: A) extends Toy[A]
  case class Bell[+A](cont: A) extends Toy[A]
  case object Done extends Toy[Nothing]

  implicit val toyFunctor = new Functor[Toy] {
    override def fmap[A, B](fa: Toy[A])(f: A => B): Toy[B] = fa match {
      case Output(message, cont) => Output(message, f(cont))
      case Bell(cont) => Bell(f(cont))
      case Done => Done
    }
  }

  def output(message: String) = Free.lift(Output(message, ()): Toy[Unit])
  def bell = Free.lift(Bell(): Toy[Unit])
  def done = Free.lift(Done: Toy[Unit])

  def test: Unit = {
    import Functor._
    import Monad._

    val lol = for {
      _ <- output("hello")
      _ <- output("world")
      _ <- bell
      _ <- done
    } yield ()
    println(lol)
  }
}