Implementation of Kind-Polymorphism Category, Functor & Rec for generic (un)folding

cat_functor_rec.scala

// WARNING... NOT FOR THE FAINT HEARTED
// Scala Conversion of haskell code in http://blog.functorial.com/posts/2012-02-02-Polykinded-Folds.html
// to study more samples of kind polymorphism in Scala
// 
// It provides the implementation of Kind-Polymorphism Category, Functor & Rec for generic folding

// HASKELL CODE
// class Category hom where
//   ident :: hom a a
//   compose :: hom a b -> hom b c -> hom a c
trait Category[->[_<:AnyKind, _<:AnyKind]] {
  def ident[A <: AnyKind] : A -> A
  def compose[A <: AnyKind, B <: AnyKind, C <: AnyKind] : (A -> B) => (B -> C) => (A -> C)
}

/** Category for => */
implicit object Function1Category extends Category[Function1] {
  def ident[A] : A => A = identity
  def compose[A, B, C] = (f: A => B) => (g: B => C) => g.compose(f)
}

// Test
assert(implicitly[Category[Function1]].ident(5) == 5)
assert(implicitly[Category[Function1]].compose((i: Int) => i.toString)((i:String) => i.toLong)(5) == 5L)

/** Category for ~> Natural Transformation */
trait ~>[F[_], G[_]] {
  def apply[A](fa: F[A]): G[A]
}

implicit object NatCategory extends Category[~>] {
  def ident[A[_]] : A ~> A = new (A ~> A) {
    def apply[T](a: A[T]) = a
    }
    
  def compose[A[_], B[_], C[_]] = (f: A ~> B) => (g: B ~> C) => new (A ~> C) {
    def apply[T](a: A[T]): C[T] = g(f(a))
  }
}

// Test
assert(implicitly[Category[~>]].ident[List](List(5)) == List(5))

val list2Option = new (List ~> Option) {
  def apply[A](l: List[A]) = l.headOption
}
val option2List = new (Option ~> List) {
  def apply[A](l: Option[A]) = l.toList
}
assert(implicitly[Category[~>]].compose(list2Option)(option2List)(List(5, 6)) == List(5))

// HASKELL CODE
// class HFunctor hom f where
//   hmap :: hom a b -> hom (f a) (f b)  
/**
  * HFunctor is a higher-kind functor transforming a morphism A -> B into (F[A] -> F[B])
  * where F[A] is A applied to polykinded type F (considered as curried type function)
  * for example: if F is TC[?[_], ?] and we apply A[_] to F, it gives F[A] = TC[A, ?]
  */
trait HFunctor[F <: AnyKind, ->[_<:AnyKind, _<:AnyKind]] {
  /** In Scala, types are not naturally currified type function so we need to help scalac with this HMorph structure
    * that transform the morphism A -> B into morphism F[A] -> F[B] where F[A] means A applied to F 
    */ 
  def hmap[A <: AnyKind, B <: AnyKind](f: => A -> B)(implicit hmorph: HMorph[F, ->, A, B]): hmorph.Out = hmorph(f)
}

object HFunctor {
  def apply[F <: AnyKind, ->[_<:AnyKind, _<:AnyKind]](implicit hf: HFunctor[F, ->]): hf.type = hf
}


/** Transform a morphism A -> B into another morphism (F[A] -> F[B]) where F[A] means type A applied to type function F
  *
  * For example, for TC[M[_], A] and Natural Transformation ~>, 
  * it could transform (F ~> G) into (TC[F, ?] ~> TC[G, ?]) applying F and G on TC
  */
trait HMorph[F <: AnyKind, ->[_<:AnyKind, _<:AnyKind], A <: AnyKind, B <: AnyKind] {
  type OutA <: AnyKind
  type OutB <: AnyKind
  type Out = OutA -> OutB
  def apply(f: => A -> B): Out
}

// HASKELL CODE
// class Rec hom f t where
//   _in :: hom (f t) t
//   out :: hom t (f t)
/** A Generic Recursion structure used in classic (un)folding techniques (like cata/ana)... cf matryoschka */
trait Rec[F <: AnyKind, ->[_<:AnyKind, _<:AnyKind], T <: AnyKind, FT <: AnyKind] {
  def in: FT -> T
  def out: T -> FT
}

// SAMPLE with Tree
// data FCTree f a = FCLeaf a | FCBranch (f (a, a))
sealed trait FCTree[F[_], A]
case class FCLeaf[F[_], A](a: A) extends FCTree[F, A]
case class FCBranch[F[_], A](fa: F[(A, A)]) extends FCTree[F, A]

// data CTree a = CLeaf a | CBranch (CTree (a, a))
sealed trait CTree[A]
case class CLeaf[A](a: A) extends CTree[A]
case class CBranch[A](fa: CTree[(A, A)]) extends CTree[A]

object FCTree {
  /** the Morphism from A ~> Bto FCTree[A, ?] ~> FCTree[B, ?] */
  implicit def hmorph[A[_], B[_]] = new HMorph[FCTree, ~>, A, B] {
    type OutA[t] = FCTree[A, t]
    type OutB[t] = FCTree[B, t]
    def apply(f: => A ~> B): (OutA ~> OutB) = new (OutA ~> OutB) {
      def apply[T](fa: OutA[T]) = fa match {
        case FCLeaf(a) => FCLeaf(a)
        case FCBranch(fa) => FCBranch(f(fa))
      }
    }
  }

  /** Functor is trivial as HMorph does the job */
  implicit val hfunctor = new HFunctor[FCTree, ~>] {}

  /** Rec */
  implicit val rec = new Rec[FCTree, ~>, CTree, ({ type l[t] = FCTree[CTree, t] })#l] {
    type FT[t] = FCTree[CTree, t]
    val in = new (FT ~> CTree) {
      def apply[A](ft: FT[A]): CTree[A] = ft match {
        case FCLeaf(a)    => CLeaf(a)
        case FCBranch(aa) => CBranch(aa)
      }
    }
    val out = new (CTree ~> FT) {
      def apply[A](ct: CTree[A]): FT[A] = ct match {
        case CLeaf(a)    => FCLeaf(a)
        case CBranch(aa) => FCBranch(aa)
      }
    }
  }
}

val mapper = HFunctor[FCTree, ~>].hmap(list2Option)
assert(mapper(FCLeaf[List, Int](5)) == FCLeaf[Option, Int](5))
assert(mapper(FCBranch(List((5, 6)))) == FCBranch(Some((5, 6))))

/** Generic fold function (like cata) */
// HASKELL CODE
// fold :: (Category hom, HFunctor hom f, Rec hom f rec) => hom (f t) t -> hom rec t
// fold phi = compose out (compose (hmap (fold phi)) phi)
def fold[F <: AnyKind, ->[_<:AnyKind, _<:AnyKind], T <: AnyKind, R <: AnyKind, FT <: AnyKind, FR <: AnyKind](phi: FT -> T)(
  implicit  category: Category[->]
          , hfunctor: HFunctor[F, ->]
          , rec: Rec[F, ->, R, FR]
          , hmorph: HMorph[F, ->, FT, T]
): R -> T = category.compose(rec.out)(category.compose(hfunctor.hmap(fold(phi)))(phi))

/** Generic unfold function (like cata) */
// HASKELL CODE
// unfold :: (Category hom, HFunctor hom f, Rec hom f rec) => hom t (f t) -> hom t rec
// unfold phi = compose phi (compose (hmap (unfold phi)) _in)
def unfold[F <: AnyKind, ->[_<:AnyKind, _<:AnyKind], T <: AnyKind, R <: AnyKind, FT <: AnyKind, FR <: AnyKind](phi: T -> FT)(
  implicit  category: Category[->]
          , hfunctor: HFunctor[F, ->]
          , rec: Rec[F, ->, R, FR]
          , hmorph: HMorph[F, ->, FT, T]
): T -> R = category.compose(phi)(category.compose(hfunctor.hmap(unfold(phi)))(rec.in))


// HASKELL CODE
// cdepth :: CTree a -> Int
// cdepth c = let (K d) = nu (fold (Nat phi)) c in d where
//   phi :: FCTree (K Int) a -> K Int a
//   phi (FCLeaf a) = K 1
//   phi (FCBranch (K n)) = K (n + 1)
case class K[A, B](a: A)
def cdepth[A](c: CTree[A]): Int = {
  type KInt[A] = K[Int, A]
  type FK[A] = FCTree[KInt, A]
  type FC[A] = FCTree[CTree, A]

  val phi = new (FK ~> KInt) {
    def apply[A](f: FCTree[KInt, A]): KInt[A] = f match {
      case FCLeaf(a) => K(1)
      case FCBranch(K(n)) => K(n + 1)
    }
  }

  fold[FCTree, ~>, KInt, CTree, FK, FC](phi).apply(c).a
}

assert(cdepth(CBranch(CBranch(CLeaf((5, 6),(7, 8))))) == 3)

// CONCLUSION
// The rest of the code found in the article is far better in Haskell syntax following the way the author writes it.
// In Scala, it makes crazy code and actually we wouldn't take the same approach in Scala than the one taken by the author
// showing once again that Haskell and Scala have different features, techniques with each pros/cons.
// It's better to use the right techniques in the context of its language and not try to imitate...
// Yet it's clear that types being naturally curried & type inference being more clever in Haskell, 
// using the technique from the end of the article is better in Haskell