Unfix.scala

import cats.Functor
import shapeless._

import scala.language.higherKinds

trait Unfix[A] {
  type F[_]
  def apply(a: A): Fix[F]
}

object Unfix {
  type Aux[A, F0[_]] = Unfix[A] { type F[x] = F0[x] }
  def apply[A](implicit unfix: Unfix[A]): Aux[A, unfix.F] = unfix

  trait In[A, B] {
    type F[_]
    def apply[G[_]](b: B, rec: A => Fix[G]): F[Fix[G]]
  }

  trait InHl[A, B] extends (A In B) {
    type F[_] <: HList
  }

  trait InCo[A, B] extends (A In B) {
    type F[_] <: Coproduct
  }

  object In extends InLP {
    type Aux[A, B, F0[_]] = In[A, B] { type F[x] = F0[x] }
    def apply[A, B](implicit in: A In B): Aux[A, B, in.F] = in

    implicit def reflexive[A]: A In A = new In[A, A] {
      type F[x] = x
      def apply[G[_]](a: A, rec: A => Fix[G]) = rec(a)
    }

    implicit def functor[A, G[_]](
      implicit fg: Functor[G]
    ): A In G[A] = new In[A, G[A]] {
      type F[x] = G[x]
      def apply[K[_]](ga: G[A], rec: A => Fix[K]) = fg.map(ga)(rec)
    }

    implicit def generic[A, B, R](
      implicit gen: Generic.Aux[B, R], ar: A In R
    ): A In B = new In[A, B] {
      type F[x] = ar.F[x]
      def apply[G[_]](b: B, rec: A => Fix[G]) = ar(gen.to(b), rec)
    }

    implicit def hnil[A]: A InHl HNil = new InHl[A, HNil] {
      type F[x] = HNil
      def apply[G[_]](nil: HNil, rec: A => Fix[G]) = nil
    }

    implicit def cnil[A]: A InCo CNil = new InCo[A, CNil] {
      type F[x] = CNil
      def apply[G[_]](nil: CNil, rec: A => Fix[G]) = nil
    }

    implicit def hcons[A, H, T <: HList](
      implicit ah: Strict[A In H], at: A InHl T
    ): InHl[A, H :: T] = new InHl[A, H :: T] {
      type F[x] = ah.value.F[x] :: at.F[x]
      def apply[K[_]](l: H :: T, rec: A => Fix[K]) =
        ah.value(l.head, rec) :: at(l.tail, rec)
    }

    implicit def ccons[A, L, R <: Coproduct](
      implicit al: Strict[A In L], ar: A InCo R
    ): InCo[A, L :+: R] = new InCo[A, L :+: R] {
      type F[x] = al.value.F[x] :+: ar.F[x]
      def apply[K[_]](c: L :+: R, rec: A => Fix[K]) = c match {
        case Inl(l) => Inl(al.value(l, rec))
        case Inr(r) => Inr(ar(r, rec))
      }
    }
  }

  trait InLP {
    implicit def const[A, B]: A In B = new In[A, B] {
      type F[x] = B
      def apply[G[_]](b: B, rec: A => Fix[G]) = b
    }
  }

  implicit def unfix[A, R](
    implicit gen: Generic.Aux[A, R], ar: A In R
  ): Aux[A, ar.F] = new Unfix[A] {
    type F[x] = ar.F[x]
    def apply(a: A): Fix[F] = Fix(ar(gen.to(a), apply))
  }
}

sealed trait IntTree
case object Leaf extends IntTree
case class Node(l: IntTree, v: Int, r: IntTree) extends IntTree
object IntTree extends App {
  val unfix = Unfix[IntTree]
  println(unfix(Node(Leaf, 42, Leaf)))
}