Higher-order free constructions in Scala

Hf.scala

import scala.language.higherKinds

trait Tc1 {
  type T[_]
}

trait Functor extends Tc1 {
  def map[A, B](f: A => B)(ta: T[A]): T[B]
}

trait Applicative extends Functor {
  def unit[A](a: A): T[A]
  def ap[A, B](ff: T[A => B])(fa: T[A]): T[B]
}

trait Monad extends Applicative {
  def bind[A, B](k: A => T[B])(ta: T[A]): T[B]
}

object Monad {
  type Aux[M[_]] = Monad { type T = M }
}

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

trait Fm[F[_], A] {
  def apply[M[_]](phi: F ~> M, ev: Monad.Aux[M]): M[A]
}

object Fm {

  def _Monad[F]: Monad = new Monad {
    type T[A] = Fm[F, A]

    def unit[A](a: A): T[A] =
      new Fm[F, A] {
        def apply[M[_]](phi: F ~> M, ev: Monad.Aux[M]): M[A] =
          ev.unit(a)
      }

    def bind[A, B](k: A => T[B])(ta: T[A]): T[B] =
      new Fm[F, B] {
        def apply[M[_]](phi: F ~> M, ev: Monad.Aux[M]): M[B] =
          ev.bind[A, B](a => k(a)(phi, ev))(ta(phi, ev))
      }

    def ap[A, B](ff: T[(A) => B])(fa: T[A]): T[B] =
      new Fm[F, B] {
        def apply[M[_]](phi: F ~> M, ev: Monad.Aux[M]): M[B] =
          ev.ap(ff(phi,ev))(fa(phi, ev))
      }

    def map[A, B](f: A => B)(ta: T[A]): T[B] =
      new Fm[F, B] {
        def apply[M[_]](phi: F ~> M, ev: Monad.Aux[M]): M[B] =
          ev.map(f)(ta(phi, ev))
      }
  }

}