Skip to content

Commit

Permalink
Make it easier to create interpreters
Browse files Browse the repository at this point in the history
  • Loading branch information
@vil1
vil1 committed Feb 10, 2019
1 parent de00e7f commit 2d53a97
Show file tree
Hide file tree
Showing 6 changed files with 177 additions and 161 deletions.
53 changes: 23 additions & 30 deletions modules/core/src/main/scala/Json.scala
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,40 +13,33 @@ object Json {

trait JsonModule[R <: Realisation] extends SchemaModule[R] {
import Json._
import SchemaF._

implicit final def algebra(
implicit primNT: R.Prim ~> Encoder,
fieldLabel: R.ProductTermId <~< String,
branchLabel: R.SumTermId <~< String
): RInterpreter[Encoder] =
new Interpreter[R.Prim, R.SumTermId, R.ProductTermId, Encoder] {

val alg: HAlgebra[RSchema, Encoder] = new (RSchema[Encoder, ?] ~> Encoder) {

val encloseInBraces = (s: String) => s"{$s}"
def makeField(name: String) = (s: String) => s""""$name":$s"""

def apply[A](schema: RSchema[Encoder, A]): Encoder[A] =
schema match {

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: IsoSchema[R.Prim, R.SumTermId, R.ProductTermId, Encoder, _, A] =>
i.base.compose(i.iso.reverseGet)
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: 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")
}
}

def interpret = cataNT(alg)

}
Interpreter.cata[RSchema, Encoder](new (RSchema[Encoder, ?] ~> Encoder) {

val encloseInBraces = (s: String) => s"{$s}"
def makeField(name: String) = (s: String) => s""""$name":$s"""

def apply[A](schema: RSchema[Encoder, A]): Encoder[A] =
schema match {

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: IsoSchema[R.Prim, R.SumTermId, R.ProductTermId, Encoder, _, A] =>
i.base.compose(i.iso.reverseGet)
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: 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")
}
})
}
42 changes: 39 additions & 3 deletions modules/core/src/main/scala/SchemaModule.scala
View file
Original file line number Diff line number Diff line change
Expand Up @@ -155,13 +155,38 @@ final case class IsoSchema[Prim[_], SumTermId, ProductTermId, F[_], A0, A](
* Such interpreters will usually be implemented using a recursion scheme like
* 'cataNT`or hyloNT`.
*/
trait Interpreter[Prim[_], SumTermId, ProductTermId, F[_]] {
trait Interpreter[F[_], G[_]] { self =>

/**
* A natural transformation that will transform a schema for any type `A`
* into an `F[A]`.
*/
def interpret: SchemaF.FSchema[Prim, SumTermId, ProductTermId, ?] ~> F
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: SchemaF.HAlgebra[S, F]
)(implicit ev: HFunctor[S])
extends Interpreter[Fix[S, ?], F] {
final override val interpret = SchemaF.cataNT(algebra)
}

class HyloInterpreter[S[_[_], _], F[_], G[_]](
coalgebra: SchemaF.HCoalgebra[S, G],
algebra: SchemaF.HAlgebra[S, F]
)(implicit ev: HFunctor[S])
extends Interpreter[G, F] {
final override val interpret = SchemaF.hyloNT(coalgebra, algebra)
}

object SchemaF {
Expand Down Expand Up @@ -266,7 +291,7 @@ trait SchemaModule[R <: Realisation] {

import SchemaF._

type RInterpreter[F[_]] = Interpreter[R.Prim, R.SumTermId, R.ProductTermId, F]
type RInterpreter[F[_]] = Interpreter[Schema, F]

type RSchema[F[_], A] = SchemaF[R.Prim, R.SumTermId, R.ProductTermId, F, A]

Expand All @@ -286,6 +311,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
////////////////
Expand Down
174 changes: 88 additions & 86 deletions modules/play-json/src/main/scala/PlayJsonModule.scala
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,10 +17,10 @@ trait PlayJsonModule[R <: Realisation] extends SchemaModule[R] {

private def ascribeWith(
label: Boolean
): FSchema[R.Prim, R.SumTermId, R.ProductTermId, ?] ~> LabelledSchema =
new (FSchema[R.Prim, R.SumTermId, R.ProductTermId, ?] ~> LabelledSchema) {
): Schema ~> LabelledSchema =
new (Schema ~> LabelledSchema) {

def apply[A](fschema: FSchema[R.Prim, R.SumTermId, R.ProductTermId, A]): LabelledSchema[A] =
def apply[A](fschema: Schema[A]): LabelledSchema[A] =
(label, fschema)
}

Expand Down Expand Up @@ -66,9 +66,9 @@ trait PlayJsonModule[R <: Realisation] extends SchemaModule[R] {
}

final private val labellingSeed =
new (FSchema[R.Prim, R.SumTermId, R.ProductTermId, ?] ~> LabelledSchema) {
new (Schema ~> LabelledSchema) {

def apply[A](fSchema: FSchema[R.Prim, R.SumTermId, R.ProductTermId, A]): LabelledSchema[A] =
def apply[A](fSchema: Schema[A]): LabelledSchema[A] =
(false, fSchema)
}

Expand All @@ -77,94 +77,96 @@ trait PlayJsonModule[R <: Realisation] extends SchemaModule[R] {
branchLabel: R.SumTermId <~< String,
fieldLabel: R.ProductTermId <~< String
): RInterpreter[Reads] =
new Interpreter[R.Prim, R.SumTermId, R.ProductTermId, Reads] {

val alg = new (HEnvT[Boolean, RSchema, Reads, ?] ~> Reads) {

def apply[A](schema: HEnvT[Boolean, RSchema, Reads, A]): Reads[A] = schema.fa match {
case One() =>
Reads {
case JsNull => JsSuccess(())
case _ => JsError(Seq(JsPath -> Seq(JsonValidationError("error.expected.null"))))
}
case :+:(left, right) =>
Reads(
json =>
left
.reads(json)
.fold(
el =>
right.reads(json).map(\/-.apply) match {
case JsError(er) => JsError(JsError.merge(el, er))
case x => x
},
a => JsSuccess(-\/(a))
)
)
case p: :*:[Reads, a, b, R.Prim, R.SumTermId, R.ProductTermId] =>
if (schema.ask)
p.left.and(p.right)((x: a, y: b) => (x, y))
else
(JsPath \ "_1")
.read(p.left)
.and((JsPath \ "_2").read(p.right))((x: a, y: b) => (x, y))
case PrimSchema(p) => primNT(p)
case SumTerm(id, schema) => undefinedAsNull(branchLabel(id), schema)
case u: Union[R.Prim, R.SumTermId, R.ProductTermId, Reads, A, a] =>
u.choices.map(u.iso.get)
case ProductTerm(id, schema) => undefinedAsNull(fieldLabel(id), schema)
case r: Record[R.Prim, R.SumTermId, R.ProductTermId, Reads, A, a] =>
r.fields.map(r.iso.get)
case SeqSchema(elem) =>
Reads {
case JsArray(elems) =>
elems.toList.traverse(elem.reads _)
case _ => JsError(Seq(JsPath -> Seq(JsonValidationError("error.expected.jsarray"))))
}
case i: IsoSchema[R.Prim, R.SumTermId, R.ProductTermId, Reads, a0, A] =>
i.base.map(i.iso.get)
Interpreter
.hylo(
labelRecordFields,
new (HEnvT[Boolean, RSchema, Reads, ?] ~> Reads) {

def apply[A](schema: HEnvT[Boolean, RSchema, Reads, A]): Reads[A] = schema.fa match {
case One() =>
Reads {
case JsNull => JsSuccess(())
case _ => JsError(Seq(JsPath -> Seq(JsonValidationError("error.expected.null"))))
}
case :+:(left, right) =>
Reads(
json =>
left
.reads(json)
.fold(
el =>
right.reads(json).map(\/-.apply) match {
case JsError(er) => JsError(JsError.merge(el, er))
case x => x
},
a => JsSuccess(-\/(a))
)
)
case p: :*:[Reads, a, b, R.Prim, R.SumTermId, R.ProductTermId] =>
if (schema.ask)
p.left.and(p.right)((x: a, y: b) => (x, y))
else
(JsPath \ "_1")
.read(p.left)
.and((JsPath \ "_2").read(p.right))((x: a, y: b) => (x, y))
case PrimSchema(p) => primNT(p)
case SumTerm(id, schema) => undefinedAsNull(branchLabel(id), schema)
case u: Union[R.Prim, R.SumTermId, R.ProductTermId, Reads, A, a] =>
u.choices.map(u.iso.get)
case ProductTerm(id, schema) => undefinedAsNull(fieldLabel(id), schema)
case r: Record[R.Prim, R.SumTermId, R.ProductTermId, Reads, A, a] =>
r.fields.map(r.iso.get)
case SeqSchema(elem) =>
Reads {
case JsArray(elems) =>
elems.toList.traverse(elem.reads _)
case _ => JsError(Seq(JsPath -> Seq(JsonValidationError("error.expected.jsarray"))))
}
case i: IsoSchema[R.Prim, R.SumTermId, R.ProductTermId, Reads, a0, A] =>
i.base.map(i.iso.get)
}
}
}

def interpret = hyloNT(labelRecordFields, alg).compose(labellingSeed)
}
)
.compose(labellingSeed)

implicit final def writes(
implicit primNT: R.Prim ~> Writes,
branchLabel: R.SumTermId <~< String,
fieldLabel: R.ProductTermId <~< String
): RInterpreter[Writes] =
new Interpreter[R.Prim, R.SumTermId, R.ProductTermId, Writes] {

val alg = new (HEnvT[Boolean, RSchema, Writes, ?] ~> Writes) {

def apply[A](env: HEnvT[Boolean, RSchema, Writes, A]): Writes[A] = env.fa match {
case One() => Writes(_ => JsNull)
case :+:(left, right) => Writes(_.fold(left.writes, right.writes))
case :*:(left, right) =>
if (env.ask)
Writes(
pair =>
(left.writes(pair._1), right.writes(pair._2)) match {
case (l @ JsObject(_), r @ JsObject(_)) => l ++ r
// the following case is impossible, but scalac cannot know that.
case (l, r) => Json.obj("_1" -> l, "_2" -> r)
}
)
else
Writes(pair => Json.obj("_1" -> left.writes(pair._1), "_2" -> right.writes(pair._2)))
case PrimSchema(p) => primNT(p)
case SumTerm(id, s) => Writes(a => Json.obj(branchLabel(id) -> s.writes(a)))
case Union(base, iso) => base.contramap(iso.reverseGet)
case ProductTerm(id, s) => Writes(a => Json.obj(fieldLabel(id) -> s.writes(a)))
case Record(base, iso) => base.contramap(iso.reverseGet)
case SeqSchema(elem) => Writes(seq => JsArray(seq.map(elem.writes(_))))
case IsoSchema(base, iso) => base.contramap(iso.reverseGet)
}

}
Interpreter
.hylo(
labelRecordFields,
new (HEnvT[Boolean, RSchema, Writes, ?] ~> Writes) {

def apply[A](env: HEnvT[Boolean, RSchema, Writes, A]): Writes[A] = env.fa match {
case One() => Writes(_ => JsNull)
case :+:(left, right) => Writes(_.fold(left.writes, right.writes))
case :*:(left, right) =>
if (env.ask)
Writes(
pair =>
(left.writes(pair._1), right.writes(pair._2)) match {
case (l @ JsObject(_), r @ JsObject(_)) => l ++ r
// the following case is impossible, but scalac cannot know that.
case (l, r) => Json.obj("_1" -> l, "_2" -> r)
}
)
else
Writes(
pair => Json.obj("_1" -> left.writes(pair._1), "_2" -> right.writes(pair._2))
)
case PrimSchema(p) => primNT(p)
case SumTerm(id, s) => Writes(a => Json.obj(branchLabel(id) -> s.writes(a)))
case Union(base, iso) => base.contramap(iso.reverseGet)
case ProductTerm(id, s) => Writes(a => Json.obj(fieldLabel(id) -> s.writes(a)))
case Record(base, iso) => base.contramap(iso.reverseGet)
case SeqSchema(elem) => Writes(seq => JsArray(seq.map(elem.writes(_))))
case IsoSchema(base, iso) => base.contramap(iso.reverseGet)
}

def interpret = hyloNT(labelRecordFields, alg).compose(labellingSeed)
}
)
.compose(labellingSeed)

}
}
51 changes: 21 additions & 30 deletions modules/scalacheck/src/main/scala/GenModule.scala
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,40 +6,31 @@ package scalacheck

import org.scalacheck._

import org.scalacheck._

trait GenModule[R <: Realisation] extends SchemaModule[R] {

import SchemaF._

implicit final def algebra(
implicit primNT: R.Prim ~> Gen
): RInterpreter[Gen] =
new Interpreter[R.Prim, R.SumTermId, R.ProductTermId, Gen] {

val alg: HAlgebra[RSchema, Gen] = new (RSchema[Gen, ?] ~> Gen) {

def apply[A](schema: RSchema[Gen, A]): Gen[A] =
schema match {
case PrimSchema(prim) => primNT(prim)
case :*:(left, right) =>
for {
l <- left
r <- right
} yield (l, r)
case :+:(left, right) => Gen.oneOf(left.map(-\/(_)), right.map(\/-(_)))
case IsoSchema(base, iso) => base.map(iso.get)
case Record(fields, iso) => fields.map(iso.get)
case SeqSchema(element) => Gen.listOf(element)
case ProductTerm(_, base) => base
case Union(choices, iso) => choices.map(iso.get)
case SumTerm(_, base) => base
case One() => Gen.const(())
}
}

def interpret = cataNT(alg)

}
Interpreter.cata(new (RSchema[Gen, ?] ~> Gen) {

def apply[A](schema: RSchema[Gen, A]): Gen[A] =
schema match {
case PrimSchema(prim) => primNT(prim)
case :*:(left, right) =>
for {
l <- left
r <- right
} yield (l, r)
case :+:(left, right) => Gen.oneOf(left.map(-\/(_)), right.map(\/-(_)))
case IsoSchema(base, iso) => base.map(iso.get)
case Record(fields, iso) => fields.map(iso.get)
case SeqSchema(element) => Gen.listOf(element)
case ProductTerm(_, base) => base
case Union(choices, iso) => choices.map(iso.get)
case SumTerm(_, base) => base
case One() => Gen.const(())
}

})

}
Loading

0 comments on commit 2d53a97

Please sign in to comment.