Higher-Kinded Data Pattern in Scala

hkd.scala

import scala.languageFeature.higherKinds
import cats.{Applicative, Id, ~>}

object Shapes {
  case class Child[F[_]](nickname: F[String], age: F[Int])

  case class Adult[F[_]](job: F[String], innerChild: Child[F])

  class ApplicativeTrans[F[_]](implicit applicativeF: Applicative[F]) extends ~>[Id, F] {
    override def apply[A](value: A): F[A] = applicativeF.pure(value)
  }

  trait HKD[D[_[_]]] {
    type IdType = D[Id]

    def compile[F[_], G[_]](data: D[F], trans: F ~> G): D[G]

    def fold[F[+_]](data: D[F])(implicit applicativeF: Applicative[F]): F[IdType]

    def foldMap[F[_], G[+_]](data: D[F], trans: F ~> G)(implicit applicativeG: Applicative[G]): G[IdType] =
      fold[G](compile[F, G](data, trans))

    def pure[F[_]](data: IdType)(implicit applicativeF: Applicative[F]): D[F] =
      compile[Id, F](data, new ApplicativeTrans[F])
  }

  object HKD {
    def apply[D[_[_]]](implicit hkdD: HKD[D]): HKD[D] = hkdD
  }

  class ChildHKDManual extends HKD[Child] {
    override def compile[F[_], G[_]](data: Child[F], trans: F ~> G): Child[G] =
      Child[G](
        nickname = trans(data.nickname),
        age = trans(data.age)
      )

    override def fold[F[+_]](data: Child[F])(implicit applicativeF: Applicative[F]): F[IdType] =
      applicativeF.map2(data.nickname, data.age) { (nickname, age) =>
        Child[Id](
          nickname = nickname,
          age = age
        )
      }
  }

  class AdultHKDManual(implicit childHKD: HKD[Child]) extends HKD[Adult] {
    override def compile[F[_], G[_]](data: Adult[F], trans: ~>[F, G]): Adult[G] =
      Adult[G](
        job = trans(data.job),
        innerChild = childHKD.compile(data.innerChild, trans)
      )

    override def fold[F[+_]](data: Adult[F])(implicit applicativeF: Applicative[F]): F[IdType] =
      applicativeF.map2(data.job, childHKD.fold(data.innerChild)) { (job, innerChild) =>
        Adult[Id](
          job = job,
          innerChild = innerChild
        )
      }
  }

  object Shapeless {
    import shapeless.{::, Generic, HList, HNil}

    private[this] def mkId[A](a: A): Id[A] = a

    sealed abstract class FList[F[_]] extends Product with Serializable {
      type HType <: HList
      type WithType[G[_]] <: FList[G]
      def toHList: HType
      def compile[G[_]](trans: F ~> G): WithType[G]
      def fold(implicit applicativeF: Applicative[F]): F[WithType[Id]]
    }

    final case class FNil[F[_]]() extends FList[F] {
      override type HType = HNil
      override type WithType[G[_]] = FNil[G]
      override def toHList: HType = HNil
      override def compile[G[_]](trans: F ~> G): WithType[G] = FNil()
      override def fold(implicit applicativeF: Applicative[F]): F[WithType[Id]] = applicativeF.pure(FNil())
    }

    final case class FCons[F[_], H, T <: FList[F]](head: F[H], tail: T) extends FList[F] {
      override type HType = F[H] :: tail.HType
      override type WithType[G[_]] = FCons[G, H, tail.WithType[G]]
      override def toHList: HType = head :: tail.toHList
      override def compile[G[_]](trans: F ~> G): WithType[G] = FCons(trans(head), tail.compile(trans))
      override def fold(implicit applicativeF: Applicative[F]): F[WithType[Id]] =
        applicativeF.map2(head, tail.fold) { (h, t) => FCons(mkId(h), t) }
    }

    object FList {
      def fromHList[F[_], H <: HList](hlist: H)(implicit generic: Generic.Aux[H, FList[F]]): generic.Repr = generic.to(hlist)

      implicit def genericHNil[F[_]]: Generic.Aux[HNil, FNil[F]] = new GenericHNil[F]
      implicit def genericHCons[F[_], H, T <: HList, U <: FList[F]](
        implicit genericTail: Generic.Aux[T, U]
      ): Generic.Aux[F[H] :: T, FCons[F, H, U]] =
        new GenericHCons[F, H, T, U]

      class GenericHNil[F[_]] extends Generic[HNil] {
        override type Repr = FNil[F]
        override def to(t: HNil): Repr = FNil[F]()
        override def from(r: Repr): HNil = HNil
      }

      // NOTE: Some part of the compiler/ide doesn't like these definitions in the same scope as `Repr`...

      private[this] def hackConsTo[F[_], H, T <: HList, U <: FList[F]](
        t: F[H] :: T
      )(
        implicit genericTail: Generic.Aux[T, U]
      ): FCons[F, H, U] =
        t match {
          case head :: tail =>
            FCons[F, H, U](head, genericTail.to(tail))
        }

      private[this] def hackConsFrom[F[_], H, T <: HList, U <: FList[F]](
        r: FCons[F, H, U]
      )(
        implicit genericTail: Generic.Aux[T, U]
      ): F[H] :: T =
        r match {
          case FCons(head, tail) => head :: genericTail.from(tail)
        }

      class GenericHCons[F[_], H, T <: HList, U <: FList[F]](
        implicit genericTail: Generic.Aux[T, U]
      ) extends Generic[F[H] :: T] {
        override type Repr = FCons[F, H, U]
        override def to(t: F[H] :: T): Repr = hackConsTo[F, H, T, U](t)
        override def from(r: Repr): F[H] :: T = hackConsFrom[F, H, T, U](r)
      }
    }

    class FListHKD extends HKD[FList] {
      override def compile[F[_], G[_]](data: FList[F], trans: F ~> G): FList[G] = data.compile(trans)
      override def fold[F[+_]](data: FList[F])(implicit applicativeF: Applicative[F]): F[IdType] = data.fold
    }
  }
}