Describing Data

Kris Nuttycombe (@nuttycom)

September, 2017

Goals

Prerequisites

Resources

Overview

Problem: Serialization

Solution:

  • Build a description of the data structure as a value.
  • Build interpreters for that description that produce serializers, deserializers, and more.

Example

A simple sums-of-products data type.

case class Person(
  name: String, 
  birthDate: Instant,
  roles: Vector[Role]
)

sealed trait Role

case object User extends Role
final case class Administrator(department: String, subordinateCount: Long) extends Role

Example JSON Representation

{
  "name": "Kris Nuttycombe",
  "birthDate": 201470280000,
  "roles": [
    {
      "admin": { 
        "department": "windmill-tilting",
        "subordinateCount": 0
      }
    } 
  ]
}
{
  "name": "Jon Pretty",
  "birthDate": 411436800000,
  "roles": [
    {
      "user": {}
    }
  ]
}

Example Schema - Product

val personSchema: Schema[Prim, Person] = rec(
  ^^(
    required("name",      Prim.str,                            Person.name.asGetter),
    required("birthDate", Prim.long composeIso isoLongInstant, Person.birthDate.asGetter),
    required("roles",     Prim.arr(roleSchema),                Person.roles.asGetter)
  )(Person.apply _)
)

val isoLongInstant = Iso(new Instant(_:Long))((_:Instant).getMillis)

To avoid type ascriptions, use all of @tpolecat's flags from here

Example Schema - Sum

val roleSchema: Schema[Prim, Role] = Schema.oneOf(
  alt[Prim, Role, User.type](
    "user", 
    Schema.const(User),
    User.prism
  ) ::
  alt[Prim, Role, Administrator](
    "administrator", 
    rec(
      ^(
        required("department",       Prim.str, Administrator.department.asGetter),
        required("subordinateCount", Prim.int, Administrator.subordinateCount.asGetter)
      )(Administrator.apply _)
    ),
    Administrator.prism
  ) :: Nil
)

Primitives

Use a GADT to describe the kinds of elements that can exist.

sealed trait JSchema[A]

case object JNumT extends JSchema[Long]
case object JBoolT extends JSchema[Boolean]
case object JStrT extends JSchema[String]

Primitive Serialization

Use a GADT to describe the kinds of elements that can exist.

sealed trait JSchema[A]

case object JNumT extends JSchema[Long]
case object JBoolT extends JSchema[Boolean]
case object JStrT extends JSchema[String]
import argonaut.Json
import argonaut.Json._


def serialize[A](schema: JSchema[A], value: A): Json = {
  schema match {
    case JBoolT => jBool(value)
    case JStrT  => jString(value)
    case JNumT  => jNumber(value)
  }
}

Primitive Parsing

Create a parser by generating a function between a schema and an argonaut DecodeJson instance.

sealed trait JSchema[A]

case object JNumT extends JSchema[Long]
case object JBoolT extends JSchema[Boolean]
case object JStrT extends JSchema[String]
import argonaut.DecodeJson
import argonaut.DecodeJson._


def decoder[A](schema: JSchema[A]): DecodeJson[A] = {
  schema match {
    case JBoolT => BooleanDecodeJson
    case JStrT  => StringDecodeJson
    case JNumT  => LongDecodeJson
  }
}

Primitive Parsing

Create a parser by generating a function between a schema and an argonaut DecodeJson instance.

sealed trait JSchema[A]

case object JNumT extends JSchema[Long]
case object JBoolT extends JSchema[Boolean]
case object JStrT extends JSchema[String]
import argonaut.DecodeJson
import argonaut.DecodeJson._


  def apply[A](schema: JSchema[A]): DecodeJson[A] = {
    schema match {
      case JBoolT => BooleanDecodeJson
      case JStrT  => StringDecodeJson
      case JNumT  => LongDecodeJson
    }
  }

Primitive Parsing

Create a parser by generating a function natural transformation between a schema and a DecodeJson instance.

sealed trait JSchema[A]

case object JNumT extends JSchema[Long]
case object JBoolT extends JSchema[Boolean]
case object JStrT extends JSchema[String]
import argonaut.DecodeJson
import argonaut.DecodeJson._

val decoder = new (JSchema ~> DecodeJson) {
  def apply[A](schema: JSchema[A]): DecodeJson[A] = {
    schema match {
      case JBoolT => BooleanDecodeJson
      case JStrT  => StringDecodeJson
      case JNumT  => LongDecodeJson
    }
  }
}

Natural Transformations

With a little rearranging, we can also make serialization a natural transformation.

def serialize[A](schema: JSchema[A], value: A): Json

Natural Transformations

With a little rearranging, we can also make serialization a natural transformation.

def serialize[A](schema: JSchema[A]): A => Json
val serializer: JSchema ~> (? => Json)
val serializer = new (JSchema ~> (? => Json)) {
  def apply[A](schema: JSchema[A]): A => Json = {
    schema match {
      case JBoolT => jBool(_)
      case JStrT  => jString(_)
      case JNumT  => jNumber(_)
    }
  }
}

Natural Transformations

When we're working at the level of descriptions of data, what we end up writing are natural transformations between our description and value-level functions.

val serializer: JSchema ~> (? => Json)
val decoder: JSchema ~> JsonDecoder

Natural Transformations

When we're working at the level of descriptions of data, what we end up writing are natural transformations between our description and value-level functions.

val serializer: JSchema ~> (? => Json)
val decoder: JSchema ~> (Json => Either[ParseError, ?])

Sequences

Sequences are simple to describe because the only thing you need to represent is the type of the element.

case class JVecT[A](elemType: JSchema[A]) extends JSchema[Vector[A]]
val boolsSchema: JSchema[Vector[Boolean]] = JVecT(JBoolT)
val serializer = new (JSchema ~> (? => Json)) = {
  def apply[A](schema: JSchema[A]): A => Json = {
    schema match {
      case JVecT(elemSchema) => 
        value => jArray(value.map(serializer(elemSchema)))
      //...
    }
  }
}

Sequence Parsing

Sequences are simple to describe because the only thing you need to represent is the type of the element.

case class JVecT[A](elemType: JSchema[A]) extends JSchema[Vector[A]]
val boolsSchema: JSchema[Vector[Boolean]] = JVecT(JBoolT)
val decoder = new (JSchema ~> DecodeJson) {
  def apply[A](schema: JSchema[A]) = {
    schema match {
      case JVecT(elemSchema) => 
        VectorDecodeJson(decoder(elemSchema))
      //...
    }
  }
}

Records

For records, however, we have to be able to relate schema for multiple values of different types.

case class Person(
  name: String, 
  birthDate: Instant
)
def liftA2[A, B, C, F[_]: Applicative](fa: F[A], fb: F[B])(f: (A, B) => C): F[C]
val personSchema: JSchema[Person] = liftA2(JStrT, JNumT) { Person.apply _ }

Records

So, how do we define Applicative for this data type?

sealed trait JSchema[A]

case object JStrT extends JSchema[String]
case object JNumT extends JSchema[Long]
case object JBoolT extends JSchema[Boolean]

case class JVecT[A](elemType: JSchema[A]) extends JSchema[Vector[A]]
trait Applicative[F[_]] {
  def pure[A](a: A): F[A]
  def map[A, B](fa: F[A])(f: A => B): F[B]
  def ap[A, B](fa: F[A])(ff: F[A => B]): F[B]
}

pure and map don't make any sense!

Records, Take 2

We need an applicative functor, but maybe not for the whole schema type. What about just for the record (product) types?

case class JObjT[A](props: Props[A]) extends JSchema[A]

To define our record builder first define a class that captures the name and the schema for a single property.

case class PropSchema[O, A](fieldName: String, valueSchema: JSchema[A], accessor: O => A)

Now, wrap that up in a data structure for which we can define the applicative operations.

sealed trait Props[O, A] 

case class ApProps[O, A, B](
  prop: PropSchema[O, B], 
  rest: Props[O, B => A]
) extends Props[O, A]

case class PureProps[O, A](a: A) extends Props[O, A]

Records, Take 2

def applicative[O] = new Applicative[Props[O, ?]] {
  def point[A](a: => A): Props[O, A] = PureProps(a)

  override def map[A, B](fa: Props[O, A])(f: A => B): Props[O, B] = {
    fa match {
      case PureProps(a) => PureProps(f(a))
      case ApProps(prop, rest) => ApProps(prop, map(rest)(f compose _))
    }
  }

  def ap[A,B](fa: => Props[O, A])(ff: => Props[O, A => B]): Props[O, B] = {
    def flip[I, J, K](f: I => (J => K)) = (j: J) => (i: I) => f(i)(j)

    ff match {
      case PureProps(f) => map(fa)(f)

      case aprb: ApProps[O, (A => B), i] =>
        ApProps(aprb.hd, ap(fa)(map(aprb.tl)(flip[i, A, B])))
    }
  }
}

Records, Take 2

sealed trait Props[O, A] 

case class PureProps[O, A](a: A) extends Props[O, A]

case class ApProps[O, A, B](
  prop: PropSchema[O, B], 
  rest: Props[O, B => A]
) extends Props[O, A]
case class JObjT[A](props: Props[A, A]) extends JSchema[A]

case class PropSchema[O, A](fieldName: String, valueSchema: JSchema[A], accessor: O => A)

Records, Take 2

sealed trait Props[F[_, _], O, A] 

case class PureProps[F[_, _], O, A](a: A) extends Props[F, O, A]

case class ApProps[F[_, _], O, A, B](
  prop: F[O, B], 
  rest: Props[F, O, B => A]
) extends Props[F, O, A]
case class JObjT[A](props: Props[PropSchema, A, A]) extends JSchema[A]

case class PropSchema[O, A](fieldName: String, valueSchema: JSchema[A], accessor: O => A)

Records, Take 2

sealed trait Props[F[_], A] 

case class PureProps[F[_], A](a: A) extends Props[F, A]

case class ApProps[F[_], A, B](
  prop: F[B], 
  rest: Props[F, B => A]
) extends Props[F, A]
case class JObjT[A](props: Props[PropSchema[A, ?], A]) extends JSchema[A]

case class PropSchema[O, A](fieldName: String, valueSchema: JSchema[A], accessor: O => A)

Records, Take 3

sealed trait FreeAp[F[_], A] 

case class Pure[F[_], A](a: A) extends FreeAp[F, A]

case class Ap[F[_], A, B](
  head: F[B], 
  tail: FreeAp[F, B => A]
) extends FreeAp[F, A]
case class JObjT[A](props: FreeAp[PropSchema[A, ?], A]) extends JSchema[A]

case class PropSchema[O, A](fieldName: String, valueSchema: JSchema[A], accessor: O => A)

Records, Take 3

import scalaz.FreeAp

case class JObjT[A](props: FreeAp[PropSchema[A, ?], A]) extends JSchema[A]

case class PropSchema[O, A](fieldName: String, valueSchema: JSchema[A], accessor: O => A)

Record serialization

  def serializeObj[A](rb: FreeAp[PropSchema[A, ?], A], value: A): Json = {
    jObject(
      rb.foldMap[State[JsonObject, ?]](
        new (PropSchema[A, ?] ~> State[JsonObject, ?]) {
          def apply[B](ps: PropSchema[A, B]): State[JsonObject, B] = {
            val elem: B = ps.accessor(value)
            for {
              _ <- modify((_: JsonObject) + (ps.fieldName, serializer(ps.valueSchema)(elem)))
            } yield elem
          }
        }
      ).exec(JsonObject.empty)
    )
  }
val serializer = new (JSchema ~> (? => Json)) = {
  def apply[A](schema: JSchema[A]): A => Json = {
    schema match {
      case JObjT(fa) => serializeObj(fa, _: A)
      //...
    }
  }
}

Record decoding

  def decodeObj[A](rb: FreeAp[PropSchema[A, ?], A]): DecodeJson[A] = {
    implicit val djap: Applicative[DecodeJson] = new Applicative[DecodeJson] {
      def point[A](a: => A) = DecodeJson(_ => DecodeResult.ok(a))
      def ap[A, B](fa: => DecodeJson[A])(ff: => DecodeJson[A => B]): DecodeJson[B] = {
        fa.flatMap(a => ff.map(_(a)))
      }
    }

    rb.foldMap(
      new (PropSchema[A, ?] ~> DecodeJson) {
        def apply[B](ps: PropSchema[A, B]): DecodeJson[B] = DecodeJson(
          _.downField(ps.fieldName).as(decoder(ps.valueSchema))
        )
      }
    )
  }
val decoder = new (JSchema ~> DecodeJson) {
  def apply[A](schema: JSchema[A]) = {
    schema match {
      case JObjT(rb) => decodeObj(rb, _: A)
      //...
    }
  }
}

Sum types

We represent sum types as a list of alternatives.

Each constructor of the sum type is associated with a value that maps from the arguments demanded by that constructor to a value of the sum type.

case class JSumT[A](alternatives: List[Alt[A, B] forSome { type B }]) extends JSchema[A]

case class Alt[A, B](id: String, base: JSchema[B], review: B => A, preview: A => Option[B])

The combination of 'review' and 'preview' is better expressed as a prism.

case class JSumT[A](alternatives: List[Alt[A, B] forSome { type B }]) extends JSchema[A]

case class Alt[A, B](id: String, base: JSchema[B], prism: Prism[A, B])

Sum types

case class JSumT[A](alternatives: List[Alt[A, B] forSome { type B }]) extends JSchema[A]

case class Alt[A, B](id: String, base: JSchema[B], prism: Prism[A, B])
import monocle.macros._

case object User extends Role {
  val prism = GenPrism[Role, User.type]
}

// "user": {}

val userRoleAlt = Alt[Role, Unit](
  "user", 
  JObjT(FreeAp.pure(())), 
  User.prism composeIso GenIso.unit[User.type]
)

Sum types

case class JSumT[A](alternatives: List[Alt[A, B] forSome { type B }]) extends JSchema[A]

case class Alt[A, B](id: String, base: JSchema[B], prism: Prism[A, B])
import monocle.macros._

final case class Administrator(department: String, subordinateCount: Long) extends Role
object Administrator {
  val prism = GenPrism[Role, Administrator]
}

// { "admin": { "department": "windmill-tilting", "subordinateCount": 0 } } 

val adminRoleAlt = Alt[Role, Administrator](
  "admin", 
  JObjT(
    ^(
      FreeAp.lift(PropSchema("department", JStrT, (_:Administrator).department)),
      FreeAp.lift(PropSchema("subordinateCount", JNumT, (_:Administrator).subordinateCount)),
    )(Administrator.apply _)
  ),
  Administrator.prism 
)

Sum types

val roleSchema: JSchema[Role] = JSumT(userRoleAlt :: adminRoleAlt :: Nil)

Sum type serialization

val serializer = new (JSchema ~> (? => Json)) = {
  def apply[A](schema: JSchema[A]): A => Json = {
    schema match {
      case JSumT(alts) => 
        (value: A) => alts.flatMap({
          case Alt(id, base, prism) => 
            prism.getOption(value).map(serializer(base)).toList map { json =>
              jObject(JsonObject.single(id, json))
            }
        }).head

      //...
    }
}

Sum type parsing

val decoder = new (JSchema ~> DecodeJson) {
  def apply[A](schema: JSchema[A]) = {
    schema match {
      //...
      case JSumT(alts) => DecodeJson { (c: HCursor) => 
        val results = for {
          fields <- c.fields.toList
          altResult <- alts flatMap {
            case Alt(id, base, prism) =>
              fields.exists(_ == id).option(
                c.downField(id).as(decoder(base)).map(prism.reverseGet)
              ).toList
          }
        } yield altResult 

        val altIds = alts.map(_.id)
        results match {
          case x :: Nil => x
          case Nil => DecodeResult.fail(s"No fields found matching any of ${altIds}", c.history)
          case xs => DecodeResult.fail(s"More than one matching field found among ${altIds}", c.history)
        }
      }
    }
  }
}

What else can we do?

So... what's the catch?

Problem 1: Primitives

sealed trait JSchema[A]

case object JStrT extends JSchema[String]
case object JNumT extends JSchema[Long]
case object JBoolT extends JSchema[Boolean]


case class JVecT[A](elemType: JSchema[A]) extends JSchema[Vector[A]]

case class JSumT[A](alternatives: List[Alt[A, B] forSome { type B }]) extends JSchema[A]

case class JObjT[A](props: FreeAp[PropSchema[A, ?], A]) extends JSchema[A]

Problem 1: Primitives

sealed trait JSchema[A]

case object JStrT extends JSchema[String]
case object JNumT extends JSchema[Long]
case object JBoolT extends JSchema[Boolean]
case object JDateT extends JSchema[DateTime]

case class JVecT[A](elemType: JSchema[A]) extends JSchema[Vector[A]]

case class JSumT[A](alternatives: List[Alt[A, B] forSome { type B }]) extends JSchema[A]

case class JObjT[A](props: FreeAp[PropSchema[A, ?], A]) extends JSchema[A]

Problem 1: Primitives

sealed trait JSchema[P[_], A]

case class JPrimT[P[_], A](prim: P[A]) extends JSchema[P, A]




case class JVecT[P[_], A](elemType: JSchema[P, A]) extends JSchema[P, Vector[A]]

case class JSumT[P[_], A](alternatives: List[Alt[P, A, B] forSome { type B }]) extends JSchema[P, A]

case class JObjT[P[_], A](props: FreeAp[PropSchema[P, A, ?], A]) extends JSchema[P, A]
sealed trait JsonPrim[A]
case object JStrT extends JsonPrim[String]
case object JNumT extends JsonPrim[Long]
case object JBoolT extends JsonPrim[Boolean]
case object JDateT extends JsonPrim[DateTime]
type MySchema[A] = JSchema[JsonPrim, A]

Problem 1: Primitives

trait ToJson[S[_]] {
  def serializer: S ~> (? => Json)
}

trait FromJson[S[_]] {
  def decoder: S ~> DecodeJson
}

Problem 1: Primitives

implicit def jSchemaToJson[P[_]: ToJson] = new ToJson[JSchema[P, ?]] {
  val serializer = new (JSchema[P, ?] ~> (? => Json)) {
    def apply[A](schema: JSchema[P, A]): A => Json = {
      schema match {
        case JPrimT(p) => implicitly[ToJson[P]].serializer(p)

        // handling the other constructors stays the same
      }
    }
  }
}
implicit val JsonPrimToJson = new ToJson[JsonPrim] {
  val serializer = new (JsonPrim ~> (? => Json)) {
    def apply[A](p: JsonPrim[A]): A => Json = {
      schema match {
        case JStrT  => jString(_)
        case JNumT  => jNumber(_)
        case JBoolT => jBool(_)
        case JDateT => (dt: DateTime) => jString(dt.toString)
      }
    }
  }
}

Coproducts

implicit def primCoToJson[P[_]: ToJson, Q[_]: ToJson] = new ToJson[Coproduct[P, Q, ?]] {
  val serializer = new (Coproduct[P, Q, ?] ~> (A => Json)) {
    def apply[A](p: Coproduct[P, Q, A]): A => Json = {
      p.run.fold(
        implicitly[ToJson[P]].serializer,
        implicitly[ToJson[Q]].serializer
      )
    }
  }
}

implicit def primCoFromJson[P[_]: FromJson, Q[_]: FromJson] = new FromJson[Coproduct[P, Q, ?]] {
  val decoder = new (Coproduct[P, Q, ?] ~> DecodeJson) {
    def apply[A](p: Coproduct[P, Q, A]): DecodeJson[A] = {
      p.run.fold(
        implicitly[FromJson[P]].decoder,
        implicitly[FromJson[Q]].decoder
      )
    }
  }
}

Coproducts

sealed trait MyPrim[A]
case object MyInt extends MyPrim[Int]
case object MyStr extends MyPrim[String]

implicit object MyPrimToJson extends ToJson[MyPrim] {
  val serializer = new (MyPrim ~> (? => Json)) {
    def apply[A](p: MyPrim[A]) = p match {
      case MyInt => jNumber(_)
      case MyStr => jString(_)
    }
  }
}
sealed trait YourPrim[A]
case object YourInt extends YourPrim[Int]
case object YourDouble extends YourPrim[Double]

implicit object YourPrimToJson extends ToJson[YourPrim] {
  val serializer = new (YourPrim ~> (? => Json)) {
    def apply[A](p: YourPrim[A]) = p match {
      case YourInt => (i: Int) => jString(s"i${i}")
      case YourDouble => (d: Double) => jString(s"d${d}")
    }
  }
}

Coproducts

type Both[A] = Coproduct[MyPrim, YourPrim, A]
def int: Both[Int] = rightc(YourInt)
def double: Both[Double] = rightc(YourDouble)
def str: Both[String] = leftc(MyStr)

implicitly[ToJson[Both]]

Either and Coproduct

Either[A, B]

Allows you to take two sum types and create a new sum type whose inhabitants are the union of the inhabitants of A and the inhabitants of B.

Coproduct[F[_], G[_]]

Allows you to take two descriptions of (sets of) types and create a new description which can describe values using either of the nested descriptions.

Problem 2: Annotations

Problem 2: Annotations

sealed trait JSchema[P[_], I]

case class JPrimT[P[_], I](prim: P[I]) extends JSchema[P, I]

case class JVecT[P[_], I](elemType: JSchema[P, I]) extends JSchema[P, Vector[I]]

case class JSumT[P[_], I](alternatives: List[Alt[P, I, J] forSome { type J }]) extends JSchema[P, I]

case class JObjT[P[_], I](props: FreeAp[PropSchema[P, I, ?], I]) extends JSchema[P, I]

Problem 2: Annotations

sealed trait JSchema[P[_], A, I]

case class JPrimT[P[_], A, I](ann: A, prim: P[I]) extends JSchema[P, A, I]

case class JVecT[P[_], A, I](ann: A, elemType: JSchema[P, A, I]) extends JSchema[A, P, Vector[I]]

case class JSumT[P[_], A, I](ann: A, alternatives: List[Alt[P, A, I, J] forSome { type J }]) extends JSchema[P, A, I]

case class JObjT[A, P[_], I](ann: A, props: FreeAp[PropSchema[P, A, I, ?], I]) extends JSchema[P, A, I]

This is a bit messy and involves a bunch of redundancy. It will work; it just doesn't seem ideal.

Directly recusive data

class Prof(
  name: String,
  students: List[Prof]
)

No longer directly recusive data

class ProfF[S](
  name: String,
  students: List[S]
)

Reintroducing recursion with Fix

class ProfF[S](
  name: String,
  students: List[S]
)
case class Fix[F[_]](f: F[Fix[F]])

type Prof = Fix[ProfF]

Annotating a tree with Cofree

class ProfF[S](
  name: String,
  students: List[S]
)
case class Fix[F[_]](f: F[Fix[F]])

type Prof = Fix[ProfF]
case class Cofree[F[_], A](f: F[Cofree[F, A]], a: A)

type IdProf = Cofree[ProfF, Int]

Hat tip to Rob Norris, go watch his talk here

Annotating a tree with Cofree

sealed trait Schema[P[_], I]

case class VecT[P[_], I](elemType: Schema[P, I]) extends Schema[P, Vector[I]]
sealed trait SchemaF[P[_], S, I]

case class VecTF[P[_], S,  I](elemType: S) extends SchemaF[P, S, Vector[I]]
type Schema[P[_], I] = Fix[SchemaF[P, ?, I]]

Does this work?

Annotating a tree with Cofree HCofree

sealed trait SchemaF[P[_], F[_], I]

case class VecTF[P[_], F[_], I](elemType: F[I]) extends SchemaF[P, F, Vector[I]]
case class HFix[F[_[_], _], I](unfix: F[HFix[F, ?], I])
type Schema[P[_], I] = HFix[SchemaF[P, ?[_], ?], I]

To add annotations, use HCofree instead of HFix

case class HCofree[A, F[_[_], _], I](a: A, f: F[HCofree[A, F, ?], I])
type AnnSchema[P[_], A] = HCofree[A, SchemaF[P, ?[_], ?]]

Rewriting our interpreters

type Schema[P[_], I] = HFix[SchemaF[P, ?[_], ?], I]
implicit def schemaToJson[P[_]: ToJson] = new ToJson[Schema[P, ?]] {
  val serializer = new (Schema[P, ?] ~> (? => Json)) = {
    def apply[I](schema: Schema[P, I]): I => Json = {
      schema.unfix match {
        case SumT(alts) => 
          (value: I) => alts.flatMap({ 
            case Alt(id, base, prism) => 
              prism.getOption(value).map(serializer(base)).toList map { 
                jObject(JsonObject.single(id, _))
              }
          }).head

        // ...
      }
    }
  }
}

HFix and HCofree

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

case class HCofree[A, F[_[_], _], I](a: A, f: F[HCofree[A, F, ?], I])
def forget[A, F[_[_], _], I](c: HCofree[A, F, I]): HFix[F, I]

HFix and HCofree

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

case class HCofree[A, F[_[_], _], I](a: A, f: F[HCofree[A, F, ?], I])
def forget[A, F[_[_], _]]: (HCofree[A, F, ?] ~> HFix[F, ?])

HFix and HCofree

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

case class HCofree[A, F[_[_], _], I](a: A, f: F[HCofree[A, F, ?], I])
def forget[A, F[_[_], _]]: (HCofree[A, F, ?] ~> HFix[F, ?]) = 
  new (HCofree[A, F, ?] ~> HFix[F, ?]) {
    def apply[I](c: HCofree[A, F, I]): HFix[F, I] = {
      c.f // this only discards one layer of annotation!
    }
  }

HFix and HCofree

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

case class HCofree[A, F[_[_], _], I](a: A, f: F[HCofree[A, F, ?], I])
def forget[A, F[_[_], _]: HFunctor]: (HCofree[A, F, ?] ~> HFix[F, ?]) = 
  new (HCofree[A, F, ?] ~> HFix[F, ?]) { self => 
    def apply[I](c: HCofree[A, F, I]): HFix[F, I] = {
      HFix(implicitly[HFunctor[F]].hfmap(self)(c.f))
    }
  }
}
trait HFunctor[F[_[_], _]] {
  def hfmap[M[_], N[_]](nt: M ~> N): F[M, ?] ~> F[N, ?]
}

HFix and HCofree

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

case class HCofree[A, F[_[_], _], I](a: A, f: F[HCofree[A, F, ?], I])
final case class HEnvT[A, F[_[_], _], G[_], I](a: A, fg: F[G, I])

HFix and HCofree

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

//case class HCofree[A, F[_[_], _], I](a: A, f: F[HCofree[A, F, ?], I])
final case class HEnvT[A, F[_[_], _], G[_], I](a: A, fg: F[G, I])
type HCofree[A, F[_[_], _], I] = HFix[HEnvT[A, F, ?[_], ?], I]

Working with fixpoint trees

type HAlgebra[F[_[_], _], G[_]] = F[G, ?] ~> G
def cata[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.hfmap[G](self))
    }
  }
//final case class HEnvT[A, F[_[_], _], G[_], I](a: A, fg: F[G, I])
//type HCofree[A, F[_[_], _], I] = HFix[HEnvT[A, F, ?[_], ?], I]

def forgetAlg[A, F[_[_], _]] = new HAlgebra[HEnvT[A, F, ?[_], ?], HFix[F, ?]] {
  def apply[I](env: HEnvT[A, F, HFix[F, ?], I]) = HFix(env.fg)
}
def forget[F[_[_], _]: HFunctor, A]: (HCofree[A, F, ?] ~> HFix[F, ?]) = cata(forgetAlg)

Drawbacks

The Scala compiler hates me.

[error] /Users/nuttycom/personal/scala_world-2017/sample_code/xenomorph/src/main/scala/xenomorph/Schema.scala:263: type mismatch;
[error]  found   : [γ$13$]xenomorph.PropSchema[O,[γ$40$]xenomorph
.HCofree[[β$0$[_$1], γ$1$]xenomorph
.SchemaF[P,β$0$,γ$1$],A,γ$40$],γ$13$] ~> [γ$14$]xenomorph.PropSchema[N,[γ$40$]xenomorph
.HCofree[[β$0$[_$1], γ$1$]xenomorph.SchemaF[P,β$0$,γ$1$],A,γ$40$],γ$14$]
[error]     (which expands to)  scalaz.NaturalTransformation[[γ$13$]xenomorph
.PropSchema[O,[γ$40$]xenomorph.HCofree[[β$0$[_$1], γ$1$]xenomorph
.SchemaF[P,β$0$,γ$1$],A,γ$40$],γ$13$],[γ$14$]xenomorph.PropSchema[N,[γ$40$]xenomorph
.HCofree[[β$0$[_$1], γ$1$]xenomorph.SchemaF[P,β$0$,γ$1$],A,γ$40$],γ$14$]]
[error]  required: [γ$3$]xenomorph.PropSchema[O,[γ$2$]xenomorph
.HCofree[[β$0$[_$1], γ$1$]xenomorph
.SchemaF[P,β$0$,γ$1$],A,γ$2$],γ$3$] ~> G
[error]     (which expands to)  scalaz.NaturalTransformation[[γ$3$]xenomorph
.PropSchema[O,[γ$2$]xenomorph.HCofree[[β$0$[_$1], γ$1$]xenomorph
.SchemaF[P,β$0$,γ$1$],A,γ$2$],γ$3$],G]
[error]       PropSchema.contraNT[O, N, Schema[A, P, ?]](f)

That's the result of leaving off a type ascription, there's actually nothing incorrect about the code.

Conclusion

When we're working at kind *, we're dealing with data.

When we're working at kind * -> * we're dealing with descriptions of data.

A => B

F[_] ~> G[_]
Either[A, B]

Coproduct[F[_], G[_]]
trait Functor[F[_]] {
  def fmap[A, B](f: A => B): F[A] => F[B]
}

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