Play JSON codecs (#37)

* First (almost) working draft for an interpreter to play Json Reads

* Add naive interperter for `play.api.libs.json.Writes`

* Add `hyloNT` and use it to make Reads/Writes interpreters symmetric

* Handle errors slightly more correctly

* Add tests

* Remove unused `CataInterpreter` and `HyloInterpreter`

* Moved tests according to changes introduced by #39

* Fix and refactor after rebasing on `prototyping`

* Make it easier to create interpreters

* Move all recursion-related code to a separate file/package

* Rename interpreters

build.sbt

@@ -47,6 +47,16 @@ lazy val scalacheck = project
   )
   .dependsOn(core)
 
+lazy val playJson = project
+  .in(file("modules/play-json"))
+  .settings(
+    name := "scalaz-schema-play-json",
+    libraryDependencies ++= Seq(
+      "com.typesafe.play" %% "play-json" % "2.6.10"
+    )
+  )
+  .dependsOn(core)
+
 lazy val tests = project
   .in(file("modules/tests"))
   .settings(
@@ -57,4 +67,4 @@ lazy val tests = project
       "org.scalaz" %% "testz-runner" % testzVersion
     )
   )
-  .dependsOn(core, scalacheck, generic)
+  .dependsOn(core, scalacheck, generic, playJson)

modules/core/src/main/scala/Json.scala

@@ -13,14 +13,13 @@ object Json {
 
 trait JsonModule[R <: Realisation] extends SchemaModule[R] {
   import Json._
-  import SchemaF._
 
-  implicit final def algebra(
+  implicit final def encoderInterpreter(
     implicit primNT: R.Prim ~> Encoder,
     fieldLabel: R.ProductTermId <~< String,
     branchLabel: R.SumTermId <~< String
-  ): HAlgebra[RSchema, Encoder] =
-    new (RSchema[Encoder, ?] ~> Encoder) {
+  ): RInterpreter[Encoder] =
+    Interpreter.cata[RSchema, Encoder](new (RSchema[Encoder, ?] ~> Encoder) {
 
       val encloseInBraces         = (s: String) => s"{$s}"
       def makeField(name: String) = (s: String) => s""""$name":$s"""
@@ -31,16 +30,16 @@ trait JsonModule[R <: Realisation] extends SchemaModule[R] {
           case PrimSchema(prim) => primNT(prim)
           case :*:(left, right) => (a => left(a._1) + "," + right(a._2))
           case :+:(left, right) => (a => a.fold(left, right))
-          case i: RIso[Encoder, _, A] =>
+          case i: IsoSchema[R.Prim, R.SumTermId, R.ProductTermId, Encoder, _, A] =>
             i.base.compose(i.iso.reverseGet)
-          case r: RRecord[Encoder, _, A] =>
+          case r: Record[R.Prim, R.SumTermId, R.ProductTermId, Encoder, A, _] =>
             encloseInBraces.compose(r.fields).compose(r.iso.reverseGet)
           case SeqSchema(element)    => (a => a.map(element).mkString("[", ",", "]"))
           case ProductTerm(id, base) => makeField(fieldLabel(id)).compose(base)
-          case u: RUnion[Encoder, _, A] =>
+          case u: Union[R.Prim, R.SumTermId, R.ProductTermId, Encoder, A, _] =>
             encloseInBraces.compose(u.choices).compose(u.iso.reverseGet)
           case SumTerm(id, base) => makeField(branchLabel(id)).compose(base)
           case One()             => (_ => "null")
         }
-    }
+    })
 }

modules/core/src/main/scala/SchemaModule.scala

@@ -2,9 +2,9 @@ package scalaz
 
 package schema
 
-import monocle.Iso
+import recursion._
 
-final case class Fix[F[_[_], _], A](unFix: F[Fix[F, ?], A])
+import monocle.Iso
 
 trait Realisation {
   type Prim[A]
@@ -133,8 +133,62 @@ final case class IsoSchema[Prim[_], SumTermId, ProductTermId, F[_], A0, A](
     IsoSchema(nt(base), iso)
 }
 
+/**
+ * An interpreter able to derive a `F[A]` from a schema for `A` (for any `A`).
+ * Such interpreters will usually be implemented using a recursion scheme like
+ * 'cataNT`or hyloNT`.
+ */
+trait Interpreter[F[_], G[_]] { self =>
+
+  /**
+   * A natural transformation that will transform a schema for any type `A`
+   * into an `F[A]`.
+   */
+  def interpret: F ~> G
+
+  def compose[H[_]](nt: H ~> F) = self match {
+    case i: ComposedInterpreter[h, G, F] => ComposedInterpreter(i.underlying, i.nt.compose(nt))
+    case x                               => ComposedInterpreter(x, nt)
+  }
+}
+
+final case class ComposedInterpreter[F[_], G[_], H[_]](underlying: Interpreter[F, G], nt: H ~> F)
+    extends Interpreter[H, G] {
+  final override val interpret = underlying.interpret.compose(nt)
+}
+
+class CataInterpreter[S[_[_], _], F[_]](
+  algebra: HAlgebra[S, F]
+)(implicit ev: HFunctor[S])
+    extends Interpreter[Fix[S, ?], F] {
+  final override val interpret = cataNT(algebra)
+}
+
+class HyloInterpreter[S[_[_], _], F[_], G[_]](
+  coalgebra: HCoalgebra[S, G],
+  algebra: HAlgebra[S, F]
+)(implicit ev: HFunctor[S])
+    extends Interpreter[G, F] {
+  final override val interpret = hyloNT(coalgebra, algebra)
+}
+
 object SchemaF {
 
+  implicit def schemaHFunctor[Prim[_], SumTermId, ProductTermId] =
+    new HFunctor[SchemaF[Prim, SumTermId, ProductTermId, ?[_], ?]] {
+
+      def hmap[F[_], G[_]](nt: F ~> G) =
+        new (SchemaF[Prim, SumTermId, ProductTermId, F, ?] ~> SchemaF[
+          Prim,
+          SumTermId,
+          ProductTermId,
+          G,
+          ?
+        ]) {
+          def apply[A](fa: SchemaF[Prim, SumTermId, ProductTermId, F, A]) = fa.hmap(nt)
+        }
+    }
+
   type FSchema[Prim[_], SumTermId, ProductTermId, A] =
     Fix[SchemaF[Prim, SumTermId, ProductTermId, ?[_], ?], A]
 
@@ -185,24 +239,6 @@ object SchemaF {
     def toSchema = Fix(new :*:(l.toSchema, r.toSchema))
 
   }
-
-  // Schema syntax
-
-  ///////////////////////
-  // Schema operations
-  ///////////////////////
-
-  type HAlgebra[F[_[_], _], G[_]] = F[G, ?] ~> G
-
-  def cataNT[Prim[_], SumTermId, ProductTermId, F[_]](
-    alg: HAlgebra[SchemaF[Prim, SumTermId, ProductTermId, ?[_], ?], F]
-  ): (FSchema[Prim, SumTermId, ProductTermId, ?] ~> F) =
-    new (FSchema[Prim, SumTermId, ProductTermId, ?] ~> F) { self =>
-
-      def apply[A](f: FSchema[Prim, SumTermId, ProductTermId, A]): F[A] =
-        alg.apply[A](f.unFix.hmap[F](self))
-    }
-
 }
 
 trait SchemaModule[R <: Realisation] {
@@ -211,6 +247,8 @@ trait SchemaModule[R <: Realisation] {
 
   import SchemaF._
 
+  type RInterpreter[F[_]] = Interpreter[Schema, F]
+
   type RSchema[F[_], A] = SchemaF[R.Prim, R.SumTermId, R.ProductTermId, F, A]
 
   type Schema[A] = FSchema[R.Prim, R.SumTermId, R.ProductTermId, A]
@@ -229,6 +267,17 @@ trait SchemaModule[R <: Realisation] {
   type RSeq[F[_], A]         = SeqSchema[F, A, R.Prim, R.SumTermId, R.ProductTermId]
   type RIso[F[_], A, B]      = IsoSchema[R.Prim, R.SumTermId, R.ProductTermId, F, A, B]
 
+  object Interpreter {
+
+    def cata[S[_[_], _], F[_]](alg: HAlgebra[S, F])(implicit ev: HFunctor[S]) =
+      new CataInterpreter[S, F](alg)
+
+    def hylo[S[_[_], _], F[_], G[_]](coalg: HCoalgebra[S, G], alg: HAlgebra[S, F])(
+      implicit ev: HFunctor[S]
+    ) = new HyloInterpreter(coalg, alg)
+
+  }
+
   ////////////////
   // Public API
   ////////////////
@@ -243,7 +292,7 @@ trait SchemaModule[R <: Realisation] {
 
     def -+>: (id: R.SumTermId): LabelledSum[A] = LabelledSum1(id, schema)
 
-    def to[F[_]](implicit algebra: HAlgebra[RSchema, F]): F[A] = cataNT(algebra)(schema)
+    def to[F[_]](implicit interpreter: RInterpreter[F]): F[A] = interpreter.interpret(schema)
 
     def imap[B](_iso: Iso[A, B]): Schema[B] = schema.unFix match {
       case IsoSchema(base, iso) => Fix(IsoSchema(base, iso.composeIso(_iso)))

modules/core/src/main/scala/recursion.scala

@@ -0,0 +1,48 @@
+package scalaz
+
+package schema
+
+package recursion {
+
+  trait HFunctor[H[_[_], _]] {
+    def hmap[F[_], G[_]](nt: F ~> G): H[F, ?] ~> H[G, ?]
+  }
+
+  final case class Fix[F[_[_], _], A](unFix: F[Fix[F, ?], A])
+
+  final case class HEnvT[E, F[_[_], _], G[_], I](ask: E, fa: F[G, I])
+
+  object HEnvT {
+
+    implicit def hfunctor[E, F[_[_], _]](implicit F: HFunctor[F]): HFunctor[HEnvT[E, F, ?[_], ?]] =
+      new HFunctor[HEnvT[E, F, ?[_], ?]] {
+
+        def hmap[M[_], N[_]](nt: M ~> N) = new (HEnvT[E, F, M, ?] ~> HEnvT[E, F, N, ?]) {
+          def apply[I](fm: HEnvT[E, F, M, I]) = HEnvT(fm.ask, F.hmap(nt)(fm.fa))
+        }
+      }
+  }
+}
+
+package object recursion {
+  type HAlgebra[F[_[_], _], G[_]]   = F[G, ?] ~> G
+  type HCoalgebra[F[_[_], _], G[_]] = G ~> F[G, ?]
+
+  def cataNT[S[_[_], _], F[_]](
+    alg: HAlgebra[S, F]
+  )(implicit S: HFunctor[S]): (Fix[S, ?] ~> F) =
+    new (Fix[S, ?] ~> F) { self =>
+
+      def apply[A](f: Fix[S, A]): F[A] =
+        alg.apply[A](S.hmap(self)(f.unFix))
+    }
+
+  def hyloNT[S[_[_], _], F[_], G[_]](coalgebra: HCoalgebra[S, F], algebra: HAlgebra[S, G])(
+    implicit S: HFunctor[S]
+  ): F ~> G = new (F ~> G) { self =>
+
+    def apply[A](fa: F[A]): G[A] =
+      algebra(S.hmap(self)(coalgebra(fa)))
+  }
+
+}

modules/core/src/main/scala/schemas.scala

@@ -30,5 +30,5 @@ object JsonSchema extends Realisation {
   final case object JsonString extends JsonPrim[String]
   final case object JsonNumber extends JsonPrim[BigDecimal]
   final case object JsonBool   extends JsonPrim[Boolean]
-  final case object JsonNull   extends JsonPrim[Null]
+  final case object JsonNull   extends JsonPrim[Unit]
 }

modules/generic/src/main/scala/GenericAlgebra.scala

@@ -4,9 +4,9 @@ package schema
 
 package generic
 
-trait GenericSchemaModule[R <: Realisation] extends SchemaModule[R] {
+import recursion._
 
-  import SchemaF._
+trait GenericSchemaModule[R <: Realisation] extends SchemaModule[R] {
 
   def covariantTargetFunctor[H[_]](
     primNT: R.Prim ~> H,

modules/generic/src/main/scala/ShowModule.scala

@@ -4,8 +4,9 @@ package schema
 
 package generic
 
+import recursion._
+
 trait ShowModule[R <: Realisation] extends GenericSchemaModule[R] {
-  import SchemaF._
 
   implicit val showDecidableInstance: Decidable[Show] = new Decidable[Show] {
     override def choose2[Z, A1, A2](a1: => Show[A1], a2: => Show[A2])(f: Z => A1 \/ A2): Show[Z] =