Types are data and data are types

Data.scala

package data

import cats.Cartesian
import cats.data.{NonEmptyList, State, StateT, Validated}
import cats.functor.Invariant
import cats.implicits._
import eu.timepit.refined._
import eu.timepit.refined.api.{Refined, Validate}
import eu.timepit.refined.boolean._
import eu.timepit.refined.collection._
import eu.timepit.refined.numeric.Positive
import io.circe.Decoder.Result
import io.circe._
import matryoshka._
import matryoshka.data._
import matryoshka.implicits._
import shapeless._
import shapeless.labelled.{FieldType, field}

import scala.reflect.ClassTag
import scalaz.{Functor, ~>}

/**
  * The dual of Cartesian (product)
  */
trait CoCartesian[F[_]] {
  def sum[A, B](fa: F[A], fb: F[B]): F[Either[A, B]]
}

/**
  * A GADT describing data types
  */
trait AlgebraF[F[_]] extends Cartesian[F] with CoCartesian[F] with Invariant[F] {

  def empty[A]: F[A]

  def pure[A](value: A): F[A]

  def int(description: Option[String]): F[Int]

  def string(description: Option[String]): F[String]

  def lit[A](name: String, about: F[A]): F[A]

  def obj[A](name: String, about: F[A]): F[A]

  def validation[A, B](f: A => Validated[NonEmptyList[String], B], g: B => A, codec: F[A]): F[B]

  def discriminator[A, B](fieldName: String, codec: F[A], expect: A, tail: F[B]): F[B]
}

trait Data[A] {
  def apply[F[_] : AlgebraF] : F[A]
}

/**
  * DSL to construct the algebra and pull in the interpreter
  */
object Data {

  def int(description: Option[String]): Data[Int] = new Data[Int] {
    override def apply[F[_] : AlgebraF]: F[Int] = implicitly[AlgebraF[F]].int(description)
  }
  def string(description: Option[String]): Data[String] = new Data[String] {
    override def apply[F[_] : AlgebraF]: F[String] = implicitly[AlgebraF[F]].string(description)
  }

  implicit val int: Data[Int] = int(None)
  implicit val string: Data[String] = string(None)

  def empty[A] = new Data[A] {
    override def apply[F[_] : AlgebraF]: F[A] = implicitly[AlgebraF[F]].empty[A]
  }

  def pure[A](value: A) = new Data[A] {
    override def apply[F[_] : AlgebraF]: F[A] = implicitly[AlgebraF[F]].pure(value)
  }

  def lit[A](fieldName: String, about: Data[A]) = new Data[A] {
    override def apply[F[_] : AlgebraF]: F[A] = implicitly[AlgebraF[F]].lit(fieldName, about.apply[F])
  }

  def obj[A](name: String, about: Data[A]) = new Data[A] {
    override def apply[F[_] : AlgebraF]: F[A] = implicitly[AlgebraF[F]].obj(name, about.apply[F])
  }

  def imap[A, B](fa: Data[A])(f: (A) => B)(g: (B) => A): Data[B] = new Data[B] {
    override def apply[F[_] : AlgebraF]: F[B] = implicitly[AlgebraF[F]].imap(fa.apply[F])(f)(g)
  }

  def product[A, B](fa: Data[A], fb: Data[B]): Data[(A, B)] = new Data[(A,B)] {
    override def apply[F[_] : AlgebraF]: F[(A, B)] = implicitly[AlgebraF[F]].product(fa.apply[F], fb.apply[F])
  }

  def discriminator[A, B](fieldName: String, discriminator: Data[A], tail: Data[B])(expect: A) = new Data[B] {
    override def apply[F[_] : AlgebraF]: F[B] = implicitly[AlgebraF[F]].discriminator(fieldName, discriminator.apply[F], expect, tail.apply[F])
  }

  def sum[A, B](x: Data[A], y: Data[B]): Data[Either[A, B]] = new Data[Either[A, B]] {
    override def apply[F[_] : AlgebraF]: F[Either[A, B]] = implicitly[AlgebraF[F]].sum(x.apply[F], y.apply[F])
  }

  implicit class RichDsl[A](val dsl: Data[A]) {
    def withValidation[B](f: A => Validated[NonEmptyList[String], B])(g: B => A) = new Data[B] {
      override def apply[F[_] : AlgebraF]: F[B] = implicitly[AlgebraF[F]].validation(f, g, dsl.apply[F])
    }
  }

  implicit val instance = new Cartesian[Data] with Invariant[Data] with CoCartesian[Data] {

    override def imap[A, B](fa: Data[A])(f: (A) => B)(g: (B) => A): Data[B] = Data.imap(fa)(f)(g)

    override def product[A, B](fa: Data[A], fb: Data[B]): Data[(A, B)] = Data.product(fa, fb)

    override def sum[A, B](x: Data[A], y: Data[B]): Data[Either[A, B]] = Data.sum(x, y)
  }

  implicit val hnil: Data[HNil] = new Data[HNil] {
    override def apply[F[_] : AlgebraF]: F[HNil] = implicitly[AlgebraF[F]].pure(HNil)
  }

  implicit def hcons[K <: Symbol, V, T <: HList](implicit key: Witness.Aux[K], sv: Lazy[Data[V]], st: Lazy[Data[T]]): Data[FieldType[K, V] :: T] = new Data[FieldType[K, V] :: T] {
    override def apply[F[_] : AlgebraF]: F[::[FieldType[K, V], T]] = {
      val literal = lit(key.value.name, imap[V, FieldType[K, V]](sv.value)(field[K](_))(identity))
      val morph = imap[(FieldType[K,V], T), FieldType[K, V] :: T](product(literal, st.value)) { case (h,t) => h :: t} { case (h :: t) => h -> t}

      morph.apply[F]
    }
  }

  implicit def ccons[K <: Symbol, V, T <: Coproduct](implicit key: Witness.Aux[K], sv: Lazy[Data[V]], st: Data[T]): Data[FieldType[K, V] :+: T] = new Data[FieldType[K, V] :+: T] {
    override def apply[F[_] : AlgebraF]: F[:+:[FieldType[K, V], T]] = {
      val morph = imap(sum(discriminator("_type", string(Some(s"Discriminator constant value: ${key.value.name}")), sv.value)(key.value.name), st)) {
        case Left(v) => Inl(field[K](v))
        case Right(v) => Inr(v)
      } {
        case Inl(v) => Left(v)
        case Inr(v) => Right(v)
      }

      morph.apply[F]
    }
  }

  implicit val cnil: Data[CNil] = new Data[CNil] {
    override def apply[F[_] : AlgebraF]: F[CNil] = implicitly[AlgebraF[F]].empty[CNil]
  }

  implicit def generic[T, R](implicit gen: LabelledGeneric.Aux[T, R], readRepr: Lazy[Data[R]], CT: ClassTag[T]): Data[T] = new Data[T] {
    override def apply[F[_] : AlgebraF]: F[T] = {
      obj(CT.runtimeClass.getSimpleName.replace("$", ""), imap[R, T](readRepr.value)(r => gen.from(r))(t => gen.to(t))).apply[F]
    }

  }

  implicit def refined[T, P](implicit data: Data[T], V: Validate[T, P]): Data[T Refined P] =
    data.withValidation(x => Validated.fromEither(refineV[P].apply(x)).leftMap(err => NonEmptyList.of(err)))(_.get)

  def apply[T](implicit T: Data[T]) = T
}

object JsonDecoder {
  def apply[X](json: Json, dsl: Data[X]): Decoder.Result[X] = {
    val decoder = dsl.apply(new AlgebraF[Decoder] {

      override def int(description: Option[String]): Decoder[Int] = Decoder.decodeInt

      override def string(description: Option[String]): Decoder[String] = Decoder.decodeString

      override def imap[A, B](fa: Decoder[A])(f: (A) => B)(g: (B) => A): Decoder[B] = fa.map(f)

      override def lit[A](fieldName: String, about: Decoder[A]): Decoder[A] = new Decoder[A] {
        override def apply(c: HCursor): Result[A] = c.downField(fieldName).as[A](about)
      }

      override def product[A, B](fa: Decoder[A], fb: Decoder[B]): Decoder[(A, B)] = new Decoder[(A, B)] {
        override def apply(c: HCursor): Result[(A, B)] = for {
          a <- fa.apply(c).right
          b <- fb.apply(c).right
        } yield a -> b
      }


      override def validation[A, B](f: A => Validated[NonEmptyList[String], B], g: B => A, of: Decoder[A]): Decoder[B] = of.flatMap(a => new Decoder[B] {
        override def apply(c: HCursor): Result[B] = f(a).toEither.left.map(errs => DecodingFailure(s"Some errors occured: $errs", Nil))
      })

      override def pure[A](value: A): Decoder[A] = Decoder.const(value)

      override def discriminator[A, B](fieldName: String, disc: Decoder[A], expect: A, tail: Decoder[B]): Decoder[B] = new Decoder[B] {
        override def apply(c: HCursor): Result[B] = {
          c.downField(fieldName).as[A](disc).right
            .flatMap(value => if(expect == value) tail.apply(c) else Left(DecodingFailure("Failed to decode this case", Nil)))
        }
      }

      override def empty[A]: Decoder[A] = new Decoder[A] {
        override def apply(c: HCursor): Result[A] = Left(DecodingFailure("Should not decode nothing", Nil))
      }

      override def sum[A, B](fa: Decoder[A], fb: Decoder[B]): Decoder[Either[A, B]] = new Decoder[Either[A, B]] {
        override def apply(c: HCursor): Result[Either[A, B]] = {
          def left: Result[Either[A, B]]  = fa(c).right.map(Left.apply[A, B])
          def right: Result[Either[A, B]] = fb(c).right.map(Right.apply[A, B])

          left orElse right
        }
      }

      override def obj[A](name: String, about: Decoder[A]): Decoder[A] = about
    })

    decoder.decodeJson(json)
  }
}

object Validator {

  def apply[X](instance: X, dsl: Data[X]) = {
    type ValidatorType[A] = PartialFunction[A, Validated[NonEmptyList[String], A]]

    val validator = dsl.apply(new AlgebraF[ValidatorType] {

      override def int(description: Option[String]): ValidatorType[Int] = { case x => Validated.valid(x) }

      override def string(description: Option[String]): ValidatorType[String] = { case x => Validated.valid(x) }

      override def lit[A](fieldName: String, about: ValidatorType[A]): ValidatorType[A] = about

      override def validation[A, B](f: A => Validated[NonEmptyList[String], B], g: B => A, of: ValidatorType[A]): ValidatorType[B] = { case b => of(g(b)).andThen(f) }

      override def imap[A, B](fa: ValidatorType[A])(f: (A) => B)(g: (B) => A): ValidatorType[B] = { case x => fa.apply(g(x)).map(f) }

      override def product[A, B](fa: ValidatorType[A], fb: ValidatorType[B]): ValidatorType[(A, B)] = { case (a,b) => fa(a).product(fb(b)) }

      override def pure[A](value: A): ValidatorType[A] = { case _ => Validated.valid(value) }

      override def discriminator[A, B](fieldName: String, codec: ValidatorType[A], expect: A, tail: ValidatorType[B]): ValidatorType[B] = tail

      override def empty[A]: ValidatorType[A] = { case x => Validated.valid(x) }

      override def sum[A, B](fa: ValidatorType[A], fb: ValidatorType[B]): ValidatorType[Either[A, B]] = {
        case Left(v) => fa(v).map(Left.apply)
        case Right(v) => fb(v).map(Right.apply)
      }

      override def obj[A](name: String, about: ValidatorType[A]): ValidatorType[A] = about
    })

    validator.apply(instance)
  }
}

object JsonEncoder {
  def apply[X](instance: X, dsl: Data[X]) = {

    type EncoderType[A] = PartialFunction[A, Json]

    val encoder = dsl.apply(new AlgebraF[EncoderType] {

      override def int(description: Option[String]): PartialFunction[Int, Json] = { case (a: Int) => Encoder.encodeInt(a) }

      override def string(description: Option[String]): PartialFunction[String, Json] = { case (a: String) => Encoder.encodeString(a) }

      override def lit[A](fieldName: String, about: PartialFunction[A, Json]): PartialFunction[A, Json] = { case a =>
        Json.obj(fieldName -> about(a)) }

      override def imap[A, B](fa: PartialFunction[A, Json])(f: (A) => B)(g: (B) => A): PartialFunction[B, Json] = { case b => fa(g(b)) }

      override def product[A, B](fa: PartialFunction[A, Json], fb: PartialFunction[B, Json]): PartialFunction[(A, B), Json] = { case (a,b) => fa(a).deepMerge(fb(b)) }

      override def validation[A, B](f: A => Validated[NonEmptyList[String], B], g: B => A, of: EncoderType[A]): EncoderType[B] = { case b => f(g(b)) match {
        case Validated.Invalid(err) => sys.error(s"Something went wrong while encoding: $err")
        case Validated.Valid(value) => of(g(value))
      } }

      override def pure[A](value: A): EncoderType[A] = { case x => Json.obj() }

      override def discriminator[A, B](fieldName: String, codec: EncoderType[A], expect: A, tail: EncoderType[B]): EncoderType[B] = { case x => Json.obj(fieldName -> codec(expect)) deepMerge tail(x) }

      override def empty[A]: EncoderType[A] = { case _ => Json.obj() }

      override def sum[A, B](fa: EncoderType[A], fb: EncoderType[B]): EncoderType[Either[A, B]] = {
        case Left(v) => fa(v)
        case Right(v) => fb(v)
      }

      override def obj[A](name: String, about: EncoderType[A]): EncoderType[A] = { case x =>
        about(x)
      }
    })

    encoder.apply(instance)
  }
}

sealed trait Schema[+A]


object Schema {
  case class Coproduct[A](name: String, members: List[A]) extends Schema[A]
  case class ObjMembers[A](entries: Map[String, A]) extends Schema[A]
  case class UnionMembers[A](entries: List[A]) extends Schema[A]
  case class Primitive(`type`: String, description: Option[String]) extends Schema[Nothing]
  case class Property[A](name: String, entry: A) extends Schema[A]
  case class Obj[A](name: String, props: A) extends Schema[A]
  case class Product[A](left: A, right: A) extends Schema[A]
  case object Empty extends Schema[Nothing]

  implicit val functor = new Functor[Schema] {
    override def map[A, B](fa: Schema[A])(f: (A) => B): Schema[B] = fa match {
      case Coproduct(name, members) => Coproduct(name, members.map(f))
      case ObjMembers(values) => ObjMembers(values.mapValues(f))
      case UnionMembers(values) => UnionMembers(values.map(f))
      case Primitive(t, d) => Primitive(t, d)
      case Property(name, e) => Property(name, f(e))
      case Obj(name, props) => Obj(name, f(props))
      case Product(left, right) => Product(f(left), f(right))
      case Empty => Empty
    }
  }



  def gen[T, X](data: Data[X])(implicit T: Corecursive.Aux[T, Schema]): T = {
    type DocType[A] = Schema[T]

    val docGen = data.apply(new AlgebraF[DocType] {

      override def empty[A]: DocType[A] = Empty

      override def pure[A](value: A): DocType[A] = Empty

      override def int(description: Option[String]): DocType[Int] = Primitive("int", description)

      override def string(description: Option[String]): DocType[String] = Primitive("string", description)

      override def lit[A](name: String, about: DocType[A]): DocType[A] = Property[T](name, T.embed(about))

      override def obj[A](name: String, about: DocType[A]): DocType[A] = Obj[T](name, T.embed(about))

      override def validation[A, B](f: (A) => Validated[NonEmptyList[String], B], g: (B) => A, codec: DocType[A]): DocType[B] =
        codec

      override def discriminator[A, B](name: String, codec: DocType[A], expect: A, tail: DocType[B]): DocType[A] =
        Product(T.embed(Property(name, T.embed(codec))), T.embed(tail))

      override def sum[A, B](fa: DocType[A], fb: DocType[B]): DocType[Either[A, B]] = Product[T](T.embed(fa), T.embed(fb))

      override def imap[A, B](fa: DocType[A])(f: (A) => B)(g: (B) => A): DocType[B] = fa

      override def product[A, B](fa: DocType[A], fb: DocType[B]): DocType[(A, B)] = Product[T](T.embed(fa), T.embed(fb))
    })

    T.embed(docGen)
  }
}

sealed trait PreferedColor

object PreferedColor {
  case object Black extends PreferedColor
  case object White extends PreferedColor
  case class Orange(hue: Int, sat: Int) extends PreferedColor
}

case class PersonId(id: Int Refined Positive)
case class Address(street: String Refined NonEmpty, houseNumber: Int Refined Positive)
case class Person(personId: PersonId, name: String Refined NonEmpty, age: Int Refined Positive, address: Address, color: PreferedColor)

sealed trait SchemaF[+A]

object SchemaF {
  case class Obj[A](name: String, props: Map[String, A]) extends SchemaF[A]
  case class Union[A](name: String, members: List[A]) extends SchemaF[A]
  case class Primitive(`type`: String, description: Option[String]) extends SchemaF[Nothing]

  implicit val functor = new Functor[SchemaF] {
    override def map[A, B](fa: SchemaF[A])(f: (A) => B): SchemaF[B] = fa match {
      case Obj(name, props) => Obj(name, props.mapValues(f))
      case Union(name, members) => Union(name, members.map(f))
      case t: Primitive => t
    }
  }
}

object Main extends App {

  import Data._

  //  val json = """{ "color" : { "hue" : 20, "_type" : "Orange" }, "address" : { "houseNumber" : 20, "street" : "Vliestroom" }, "age" : 30, "name" : "22", "personId" : { "id" : 1 } }"""

  val x = Person(PersonId(refineMV(1)), refineMV("Mark"), refineMV(30), Address(refineMV("Vliestroom"), refineMV(20)), PreferedColor.Orange(20, 30))

  val codec = Data[Person]
  //  val json = JsonEncoder(x, codec)

  val doc = Schema.gen[Fix[Schema], Person](codec)

  import Schema._

  val schema: Algebra[Schema, Json] = {
    case Primitive(t, d) => Json.fromString(t)
    case Property(name, e) => Json.obj(name -> e)
    case Obj(name, props) => Json.obj(name -> props)
    case Product(left, right) => left deepMerge right
    case ObjMembers(map) => Json.obj(map.toList: _*)
    case UnionMembers(members) => Json.arr(members: _*)
    case Empty => Json.obj()
  }

  def cataProduct[T](implicit T: Recursive.Aux[T, Schema]): Schema[T] => Option[Schema[T]] = {
    case Product(left, right) => (left.project, right.project) match {
      case (Property(name, a), ObjMembers(current)) => Some(ObjMembers(current + (name -> a)))
      case (Property(nameA, sA), Property(nameB, sB)) => Some(ObjMembers(Map(nameA -> sA, nameB -> sB)))
      case (Property(name, a), Empty) => Some(ObjMembers(Map(name -> a)))
      case (Obj(_,_), Empty) => Some(UnionMembers(left :: Nil))
      case (Obj(_,_), Obj(_,_)) => Some(UnionMembers(left :: right :: Nil))
      case (Obj(_,_), UnionMembers(members)) => Some(UnionMembers(left :: members))
      case _ => None
    }
    case _ => None
  }

  def cata[T](implicit T: Recursive.Aux[T, Schema]): Schema[T] => Schema[T] = {
    case t @ Product(_, _) => repeatedly(cataProduct).apply(t)
    case t => t
  }

  def anaProduct[T](implicit C: Corecursive.Aux[T, Schema], R: Recursive.Aux[T, Schema]): Schema[T] => Option[Schema[T]] = {
    case Product(left, right) => (left.project, right.project) match {
      case (Property(propName, propValue), Obj(objName, objValue)) =>
        Some(Obj(objName, Product(Property(propName, propValue).embed, objValue).embed))
      case _ => None
    }
    case _ => None
  }

  def ana[T](implicit C: Corecursive.Aux[T, Schema], R: Recursive.Aux[T, Schema]): Schema[T] => Schema[T] = {
    case t @ Product(_, _) => repeatedly(anaProduct).apply(t)
    case t => t
  }

  val transformed = doc.transAna[Fix[Schema]](ana).transCata[Fix[Schema]](cata)

  pprint.pprintln(transformed)

  println(transformed.cata(schema))

  //  val person = JsonDecoder(json, codec)

  //  println(json.toString())
  //  println(person)

  //  println(Validator(x, codec))



}