Naperian Functors

naperian.scala

trait Naperian[F[_]] {
  val F: Distributive[F]

  def hdistribute[W[?[_], _]: HFunctor]: W[F, ?] ~> Nested[F, W[Id, ?], ?]

  def ncotraverse[W[?[_], _]: HFunctor, A, B](f: W[Id, A] => B)(wf: W[F, A]): F[B] =
    F.lift(f).apply(hdistribute[W].apply[A](wf).value)

  def ncollect[W[?[_], _]: HFunctor, G[_]](f: G ~> F): W[G, ?] ~> Nested[F, W[Id, ?], ?] =
    new (W[G, ?] ~> Nested[F, W[Id, ?], ?]) {
      override def apply[A](fa: W[G, A]): Nested[F, W[Id, ?], A] =
        hdistribute.apply(HFunctor[W].hmap(f)(fa))
    }

  def ntwiddle[W[?[_], _]: HFunctor, G[_], A, B](f: W[Id, A] => B)(ff: G ~> F)(wg: W[G, A]): F[B] =
    F.map(hdistribute.apply(HFunctor[W].hmap(ff)(wg)).value)(f)

  def ntabulate[A](f: (F ~> Id) => A): F[A] = ncotraverse[Tabulation, A, A](
    (h: Tabulation[Id, A]) => h(FunctionK.id[Id])
  )(f)
}