Simple Schema implementation derived from Xenomorph to practice around with all the concepts

Xenolittle.scala

import jason.HFunctor.HAlgebra
import scalaz._
import scalaz.Scalaz._
import io.circe._

trait HFunctor[F[_[_], _]] {
  def hfmap[M[_], N[_]](nt: M ~> N): F[M, ?] ~> F[N, ?]
}

object HFunctor {
  def apply[F[_[_], _]](implicit v: HFunctor[F]) = v

  final implicit class HFunctorOps[F[_[_], _], M[_], A](val fa: F[M, A])(implicit F: HFunctor[F]) {
    def hfmap[N[_]](nt: M ~> N): F[N, A] = F.hfmap(nt)(fa)
  }

  type HAlgebra[F[_[_], _], G[_]] = F[G, ?] ~> G
}

final case class HFix[F[_[_], _], I](unfix: Name[F[HFix[F, ?], I]])

object HFix {

  import HFunctor._

  def hfix[F[_[_], _], I](fa: => F[HFix[F, ?], I]): HFix[F, I] =
    HFix[F, I](Need(fa))

  def cataNT[F[_[_], _] : HFunctor, G[_]](alg: HAlgebra[F, G]): HFix[F, ?] ~> G =
    new (HFix[F, ?] ~> G) {
      self =>
      def apply[I](f: HFix[F, I]): G[I] = {
        alg.apply[I](f.unfix.value.hfmap[G](self))
      }
    }

  implicit class HFixOps[F[_[_], _], I](fa: HFix[F, I]) {
    def cata[G[_]](alg: HAlgebra[F, G])(implicit F: HFunctor[F]): G[I] =
      cataNT[F, G](alg)(F)(fa)
  }
}

sealed trait PropSchema[O, F[_], I] {
  def fieldName: String
  def getter: O => I

  def hfmap[G[_]](nt: F ~> G): PropSchema[O, G, I]
}

object PropSchema {
  final case class Required[O, F[_], I](fieldName: String, base: F[I], getter: O => I, default: Option[I]) extends PropSchema[O, F, I] {
    override def hfmap[G[_]](nt: ~>[F, G]): PropSchema[O, G, I] = Required(fieldName, nt(base), getter, default)
  }

  final case class Optional[O, F[_], I](fieldName: String, base: F[I], getter: O => Option[I]) extends PropSchema[O, F, Option[I]] {
    override def hfmap[G[_]](nt: ~>[F, G]): PropSchema[O, G, Option[I]] = Optional(fieldName, nt(base), getter)
  }

  implicit def hfunctor[O]: HFunctor[PropSchema[O, ?[_], ?]] = new HFunctor[PropSchema[O, ?[_], ?]] {
    override def hfmap[M[_], N[_]](nt: ~>[M, N]): PropSchema[O, M, ?] ~> PropSchema[O, N, ?] = new (PropSchema[O, M, ?] ~> PropSchema[O, N, ?]) {
      override def apply[A](fa: PropSchema[O, M, A]): PropSchema[O, N, A] = fa.hfmap(nt)
    }
  }
}

sealed trait SchemaF[F[_], A] {
  def hfmap[G[_]](nt: F ~> G): SchemaF[G, A]
}

object SchemaF {

  type Schema[A] = HFix[SchemaF, A]
  type Props[O, F[_], I] = FreeAp[PropSchema[O, F, ?], I]

  final case class Record[F[_], A](props: FreeAp[PropSchema[A, F, ?], A]) extends SchemaF[F, A] {
    override def hfmap[G[_]](nt: ~>[F, G]): SchemaF[G, A] =
      Record(props.hoist[PropSchema[A, G, ?]](PropSchema.hfunctor.hfmap(nt)))
  }
  final case class Str[F[_], A]() extends SchemaF[F, String] {
    override def hfmap[G[_]](nt: ~>[F, G]): SchemaF[G, String] =
      Str()
  }
  final case class Integer[F[_], A]() extends SchemaF[F, Int] {
    override def hfmap[G[_]](nt: ~>[F, G]): SchemaF[G, Int] =
      Integer()
  }

//  final case class Alt[F[_], I, O](id: String, base: F[O], view: I => O, review: O => Option[I]) {
//    def hfmap[G[_]](nt: ~>[F, G]): Alt[G, I, O] =
//      Alt(id, nt(base), view, review)
//  }
//  final case class OneOfSchema[F[_], I](items: NonEmptyList[Alt[F, I, I0] forSome { type I0 }]) extends SchemaF[F, I] {
//    override def hfmap[G[_]](nt: ~>[F, G]): SchemaF[G, I] =
//      OneOfSchema(items.map(_.hfmap(nt)))
//  }

  def required[O, I](fieldName: String, base: Schema[I], getter: O => I, default: Option[I]): Props[O, Schema, I] =
    FreeAp.lift(PropSchema.Required[O, Schema, I](fieldName, base, getter, default))

  def record[A](props: FreeAp[PropSchema[A, Schema, ?], A]): Schema[A] =
    HFix.hfix(Record[Schema, A](props))

  def string: Schema[String] = HFix.hfix(Str[Schema, String]())
  def int: Schema[Int] = HFix.hfix(Integer[Schema, Int]())

  implicit val hfunctor: HFunctor[SchemaF] = new HFunctor[SchemaF] {
    override def hfmap[M[_], N[_]](nt: ~>[M, N]): (SchemaF[M, ?] ~> SchemaF[N, ?]) = new (SchemaF[M, ?] ~> SchemaF[N, ?]) {
      override def apply[A](fa: SchemaF[M, A]): SchemaF[N, A] = fa.hfmap(nt)
    }
  }

  val encoder = new HAlgebra[SchemaF, Encoder] {

    def trans[B](b: B) = new (PropSchema[B, Encoder, ?] ~> State[List[(String, Json)], ?]) {
      override def apply[A](fa: PropSchema[B, Encoder, A]): State[List[(String, Json)], A] =
        for {
          _ <- modify { o: List[(String, Json)] =>
            fa match {
              case req: PropSchema.Required[B, Encoder, i] =>
                (req.fieldName -> req.base.apply(req.getter(b))) :: o

              case req: PropSchema.Optional[B, Encoder, i] =>
                req.getter(b).fold(o)(v => (req.fieldName -> req.base(v)) :: o)
            }
          }
        } yield fa.getter(b)
    }

    def encodeProps[B](props: FreeAp[PropSchema[B, Encoder, ?], B]) =
      new Encoder[B] {
        override def apply(a: B): Json = Json.fromFields(props.foldMap[State[List[(String, Json)], ?]](trans(a)).exec(List.empty[(String, Json)]))
      }

    override def apply[A](fa: SchemaF[Encoder, A]): Encoder[A] = fa match {
      case Record(props) => encodeProps(props)
      case Str() => Encoder.encodeString
      case Integer() => Encoder.encodeInt
    }
  }
}

case class Person(name: String, age: Int)

object Program extends App {
  import SchemaF._

  val person = record[Person]((required[Person, String]("name", string, _.name, Some("")) |@| required[Person, Int]("age", int, _.age, None))(Person.apply))
  

  println(person.cata(encoder).apply(Person("Mark", 31)))

}