From 01573ad2e39a5b361fd67cb1957e0a59c3f18c71 Mon Sep 17 00:00:00 2001 From: Andy Scott Date: Wed, 6 Dec 2017 00:25:50 -0800 Subject: [PATCH 1/2] Add hunchbacked Quasimonad; both friendly and a monster --- build.sbt | 26 +- .../main/scala/iota/quasi/quasi/package.scala | 258 ++++++++++++++++++ 2 files changed, 282 insertions(+), 2 deletions(-) create mode 100644 modules/quasi/src/main/scala/iota/quasi/quasi/package.scala diff --git a/build.sbt b/build.sbt index 17d2c97..c71d9cd 100644 --- a/build.sbt +++ b/build.sbt @@ -1,11 +1,13 @@ lazy val root = (project in file(".")) .settings(noPublishSettings) .aggregate(coreJVM, coreJS) + .aggregate(quasiJVM, quasiJS) .aggregate(testsJVM, testsJS) .aggregate(examplesCatsJVM, examplesCatsJS) .aggregate(examplesScalazJVM, examplesScalazJS) .aggregate(bench) .aggregate(corezJVM, corezJS) + .aggregate(quasizJVM, quasizJS) .aggregate(testszJVM, testszJS) .aggregate(readme, docs) @@ -15,8 +17,8 @@ lazy val core = module("core", hideFolder = true) flags = "cats" :: Nil, yaxScala = true)) .crossDepSettings( - %%("cats-core"), - %%("cats-free")) + "org.typelevel" %% "cats-core" % "1.0.0-RC1", + "org.typelevel" %% "cats-free" % "1.0.0-RC1") lazy val coreJVM = core.jvm lazy val coreJS = core.js @@ -32,6 +34,26 @@ lazy val corez = module("core", hideFolder = true, prefixSuffix = "z") lazy val corezJVM = corez.jvm lazy val corezJS = corez.js +lazy val quasi = module("quasi", hideFolder = true) + .dependsOn(core) + .settings(macroSettings) + .settings(yax(file("modules/quasi/src/main/scala"), Compile, + flags = "cats" :: Nil, + yaxScala = true)) + +lazy val quasiJVM = quasi.jvm +lazy val quasiJS = quasi.js + +lazy val quasiz = module("quasi", hideFolder = true, prefixSuffix = "z") + .dependsOn(corez) + .settings(macroSettings) + .settings(yax(file("modules/quasi/src/main/scala"), Compile, + flags = "scalaz" :: Nil, + yaxScala = true)) + +lazy val quasizJVM = quasiz.jvm +lazy val quasizJS = quasiz.js + lazy val tests = module("tests", hideFolder = true) .dependsOn(core) .settings(noPublishSettings) diff --git a/modules/quasi/src/main/scala/iota/quasi/quasi/package.scala b/modules/quasi/src/main/scala/iota/quasi/quasi/package.scala new file mode 100644 index 0000000..9326daa --- /dev/null +++ b/modules/quasi/src/main/scala/iota/quasi/quasi/package.scala @@ -0,0 +1,258 @@ +package iota //#=cats +package iotaz //#=scalaz + +import cats._ //#=cats +import scalaz._ //#=scalaz + +import TListK.:: + +package object quasi { + + type Quasi[S[_], A] = quasiImpl.Quasi[S, A] + type Concur[S[_], A] = quasiImpl.Concur[S, A] + type Subseq[S[_], A] = quasiImpl.Subseq[S, A] + + implicit final class QuasiOps[S[_], A](val quasi: Quasi[S, A]) extends AnyVal { + def concur: Concur[S, A] = quasiImpl.toConcur(quasi) + def subseq: Subseq[S, A] = quasiImpl.toSubseq(quasi) + } + + final implicit class ConcurOps[S[_], A](val concur: Concur[S, A]) extends AnyVal { + def quasi: Quasi[S, A] = quasiImpl.fromConcur(concur) + def subseq: Subseq[S, A] = quasi.subseq + + def ap[B](f: Concur[S, A => B]): Concur[S, B] = + quasiImpl.ap(f.quasi)(concur.quasi).concur + + def map[B](f: A => B): Concur[S, B] = ap(Quasi.pure(f).concur) + } + + final implicit class SubseqOps[S[_], A](val subseq: Subseq[S, A]) extends AnyVal { + def quasi: Quasi[S, A] = quasiImpl.fromSubseq(subseq) + def concur: Concur[S, A] = quasi.concur + + def map[B](f: A => B): Subseq[S, B] = + flatMap(a => Quasi.pure(f(a)).subseq) + + def flatMap[B](f: A => Subseq[S, B]): Subseq[S, B] = + quasiImpl.flatMap(subseq.quasi)(f.andThen(_.quasi)).subseq + } + + implicit def subseqMonad[S[_]]: Monad[Subseq[S, ?]] = new Monad[Subseq[S, ?]] { + def pure[A](a: A): Subseq[S, A] = Quasi.pure(a).subseq + def flatMap[A, B](fa: Subseq[S, A])(f: A => Subseq[S, B]): Subseq[S, B] = + fa.flatMap(f) + + def tailRecM[A, B](a: A)(f: A => Subseq[S, Either[A, B]]): Subseq[S, B] = ??? + } + + implicit def concurApplicative[S[_]]: Applicative[Concur[S, ?]] = new Applicative[Concur[S, ?]] { + def pure[A](a: A): Concur[S, A] = Quasi.pure(a).concur + def ap[A, B](ff: Concur[S, A => B])(fa: Concur[S, A]): Concur[S, B] = + fa.ap(ff) + } + + implicit def subseqConcurParallel[S[_]]: Parallel[Subseq[S, ?], Concur[S, ?]] = + new Parallel[Subseq[S, ?], Concur[S, ?]] { + val parallel: Subseq[S, ?] ~> Concur[S, ?] = + λ[Subseq[S, ?] ~> Concur[S, ?]](_.quasi.concur) + val sequential: Concur[S, ?] ~> Subseq[S, ?] = + λ[Concur[S, ?] ~> Subseq[S, ?]](_.quasi.subseq) + val applicative: Applicative[Concur[S, ?]] = Applicative[Concur[S, ?]] + val monad: Monad[Subseq[S, ?]] = Monad[Subseq[S, ?]] + } + + object Quasi { + + def pure[S[_], A](a: A): Quasi[S, A] = quasiImpl.pure(a) + def liftF[S[_], A](value: S[A]): Quasi[S, A] = quasiImpl.suspend(value) + + def toConcur[S[_]]: Quasi[S, ?] ~> Concur[S, ?] = + λ[Quasi[S, ?] ~> Concur[S, ?]](_.concur) + + def toSubseq[S[_]]: Quasi[S, ?] ~> Subseq[S, ?] = + λ[Quasi[S, ?] ~> Subseq[S, ?]](_.subseq) + + def foldMap[S[_], M[_], A](quasi: Quasi[S, A])(f: S ~> M)(implicit M: Parallel[M, M]): M[A] = + quasiImpl.evaluator(f, + M.parallel, M.sequential, + M.monad, M.applicative)(quasi) + } + + private[quasi] sealed trait QuasiImpl { + type Quasi [S[_], A] + type Concur[S[_], A] + type Subseq[S[_], A] + + type Effects[S[_]] = + Pure [S, ?] :: + Suspend [S, ?] :: + FlatMap [S, _, ?] :: + Ap [S, _, ?] :: + Raise [S, _, ?] :: + Handle [S, _, ?] :: + TNilK + + type Pure[S[_], A] = A + type Suspend[S[_], A] = S[A] + final case class FlatMap[S[_], A, B](fa: Quasi[S, A], f: A => Quasi[S, B]) + final case class Ap[S[_], A, B](ff: Quasi[S, A => B], fa: Quasi[S, A]) + type Raise[S[_], E, A] = E + final case class Handle[S[_], E, A](fe: E => Quasi[S, A]) + //type Handle[S[_], E, A] = E => Quasi[S, A] + + def toRaw[S[_], A](quasi: Quasi[S, A]): CopK[Effects[S], A] + def fromRaw[S[_], A](copK: CopK[Effects[S], A]): Quasi[S, A] + + def toConcur[S[_], A](quasi: Quasi[S, A]): Concur[S, A] + def fromConcur[S[_], A](subseq: Concur[S, A]): Quasi[S, A] + + def toSubseq[S[_], A](quasi: Quasi[S, A]): Subseq[S, A] + def fromSubseq[S[_], A](subseq: Subseq[S, A]): Quasi[S, A] + + def pure[S[_], A](a: A): Quasi[S, A] + def suspend[S[_], A](value: S[A]): Quasi[S, A] + def flatMap[S[_], A, B](fa: Quasi[S, A])(f: A => Quasi[S, B]): Quasi[S, B] + def ap[S[_], A, B](ff: Quasi[S, A => B])(fa: Quasi[S, A]): Quasi[S, B] + + type Evaluator[S[_], M[_]] = Quasi[S, ?] ~> M + + def evaluator[S[_], Zm[_], Za[_]]( + f : S ~> Zm, + parallel : Zm ~> Za, + sequential: Za ~> Zm, + Zm : Monad[Zm], + Za : Applicative[Za] + ): Evaluator[S, Zm] + } + + private[quasi] val quasiImpl: QuasiImpl = new QuasiImpl { + type Quasi [S[_], A] = CopK[Effects[S], A] + type Concur[S[_], A] = CopK[Effects[S], A] + type Subseq[S[_], A] = CopK[Effects[S], A] + + def toRaw[S[_], A](quasi: Quasi[S, A]): CopK[Effects[S], A] = quasi + def fromRaw[S[_], A](copK: CopK[Effects[S], A]): Quasi[S, A] = copK + + def toConcur[S[_], A](quasi: Quasi[S, A]): Concur[S, A] = quasi + def fromConcur[S[_], A](subseq: Concur[S, A]): Quasi[S, A] = subseq + + def toSubseq[S[_], A](quasi: Quasi[S, A]): Subseq[S, A] = quasi + def fromSubseq[S[_], A](subseq: Subseq[S, A]): Quasi[S, A] = subseq + + def pure[S[_], A](a: A): Quasi[S, A] = + CopK.unsafeApply[Effects[S], Pure[S, ?], A](0, a) + + def suspend[S[_], A](value: S[A]): Quasi[S, A] = + CopK.unsafeApply[Effects[S], Suspend[S, ?], A](1, value) + + def flatMap[S[_], A, B](fa: Quasi[S, A])(f: A => Quasi[S, B]): Quasi[S, B] = + CopK.unsafeApply[Effects[S], FlatMap[S, A, ?], B](2, FlatMap[S, A, B](fa, f)) + + def ap[S[_], A, B](ff: Quasi[S, A => B])(fa: Quasi[S, A]): Quasi[S, B] = + CopK.unsafeApply[Effects[S], Ap[S, A, ?], B](3, Ap[S, A, B](ff, fa)) + + def evaluator[S[_], Zm[_], Za[_]]( + f : S ~> Zm, + parallel : Zm ~> Za, + sequential: Za ~> Zm, + Zm : Monad[Zm], + Za : Applicative[Za] + ): Evaluator[S, Zm] = new Evaluator[S, Zm] { + def apply[A](quasi: Quasi[S, A]): Zm[A] = + Zm.tailRecM(quasi)(q => (q.index: @scala.annotation.switch) match { + case 0 => + val a: A = q.value.asInstanceOf[A] + Zm.pure(Right(a)) + case 1 => + val sa: S[A] = q.value.asInstanceOf[S[A]] + Zm.map(f(sa))(Right(_)) + case 2 => + val n: FlatMap[S, Any, A] = q.value.asInstanceOf[FlatMap[S, Any, A]] + Zm.map(this(n.fa))(z => Left(n.f(z))) + case 3 => + val n: Ap[S, Any, A] = q.value.asInstanceOf[Ap[S, Any, A]] + Zm.map( + sequential(Za.ap( + parallel(this(n.ff)))( + parallel(this(n.fa)))) + )(Right(_)) + case _ => scala.Predef.??? + }) + } + + } + +} + +// example +//#+cats +import cats.implicits._ +package quasi { + + object Example { + + def main(args: Array[String]): Unit = { + + trait MathOp[A] + case class ConstInt(value: Int) extends MathOp[Int] + case class Add(x: Int, y: Int) extends MathOp[Int] + case class Neg(x: Int) extends MathOp[Int] + + trait Math[F[_]] { underlying => + def const(value: Int): F[Int] + def add(x: Int, y: Int): F[Int] + def neg(x: Int): F[Int] + + final def mapK[G[_]](f: F ~> G): Math[G] = new Math[G] { + def const(value: Int): G[Int] = f(underlying.const(value)) + def add(x: Int, y: Int): G[Int] = f(underlying.add(x, y)) + def neg(x: Int): G[Int] = f(underlying.neg(x)) + } + } + + object Math { + def quasi: Math[Quasi[MathOp, ?]] = new Math[Quasi[MathOp, ?]] { + def const(value: Int): Quasi[MathOp, Int] = Quasi.liftF(ConstInt(value)) + def add(x: Int, y: Int): Quasi[MathOp, Int] = Quasi.liftF(Add(x, y)) + def neg(x: Int): Quasi[MathOp, Int] = Quasi.liftF(Neg(x)) + } + + def concur: Math[Concur[MathOp, ?]] = quasi.mapK[Concur[MathOp, ?]](Quasi.toConcur) + def subseq: Math[Subseq[MathOp, ?]] = quasi.mapK[Subseq[MathOp, ?]](Quasi.toSubseq) + } + + val interp: MathOp ~> Id = λ[MathOp ~> Id] { + case ConstInt(value) => value + case Add(x, y) => x + y + case Neg(x) => -x + } + + val math = Math.subseq + + val program0 = for { + x <- math.const(1) + y <- math.const(2) + z <- math.add(x, y) + } yield z + 10 + + val program1 = for { + a <- math.const(100) + b <- math.neg(a) + } yield a + b + + val program2 = for { + foo <- math.const(0) + bar <- List(program0, program1).parSequence + } yield bar.foldLeft(foo)(_ + _) + + scala.Predef.println(program2) + + val res = Quasi.foldMap(program2.quasi)(interp) + scala.Predef.println(res) + + } + + } +} +//#-cats From f8a79afc55de0b4f1e4b72a22808ea9d775ce75e Mon Sep 17 00:00:00 2001 From: Andy Scott Date: Thu, 7 Dec 2017 00:37:44 -0800 Subject: [PATCH 2/2] Add error handling to quasi free monad --- .../main/scala/iota/quasi/quasi/package.scala | 264 ++++++++++-------- 1 file changed, 153 insertions(+), 111 deletions(-) diff --git a/modules/quasi/src/main/scala/iota/quasi/quasi/package.scala b/modules/quasi/src/main/scala/iota/quasi/quasi/package.scala index 9326daa..1bf433f 100644 --- a/modules/quasi/src/main/scala/iota/quasi/quasi/package.scala +++ b/modules/quasi/src/main/scala/iota/quasi/quasi/package.scala @@ -8,158 +8,181 @@ import TListK.:: package object quasi { - type Quasi[S[_], A] = quasiImpl.Quasi[S, A] - type Concur[S[_], A] = quasiImpl.Concur[S, A] - type Subseq[S[_], A] = quasiImpl.Subseq[S, A] + type Quasi [S[_], E, A] = quasiImpl.Quasi [S, E, A] + type Concur[S[_], E, A] = quasiImpl.Concur[S, E, A] + type Subseq[S[_], E, A] = quasiImpl.Subseq[S, E, A] - implicit final class QuasiOps[S[_], A](val quasi: Quasi[S, A]) extends AnyVal { - def concur: Concur[S, A] = quasiImpl.toConcur(quasi) - def subseq: Subseq[S, A] = quasiImpl.toSubseq(quasi) + implicit final class QuasiOps[S[_], E, A](val quasi: Quasi[S, E, A]) extends AnyVal { + def concur: Concur[S, E, A] = quasiImpl.toConcur(quasi) + def subseq: Subseq[S, E, A] = quasiImpl.toSubseq(quasi) } - final implicit class ConcurOps[S[_], A](val concur: Concur[S, A]) extends AnyVal { - def quasi: Quasi[S, A] = quasiImpl.fromConcur(concur) - def subseq: Subseq[S, A] = quasi.subseq + final implicit class ConcurOps[S[_], E, A](val concur: Concur[S, E, A]) extends AnyVal { + def quasi: Quasi[S, E, A] = quasiImpl.fromConcur(concur) + def subseq: Subseq[S, E, A] = quasi.subseq - def ap[B](f: Concur[S, A => B]): Concur[S, B] = + def ap[B](f: Concur[S, E, A => B]): Concur[S, E, B] = quasiImpl.ap(f.quasi)(concur.quasi).concur - def map[B](f: A => B): Concur[S, B] = ap(Quasi.pure(f).concur) + def map[B](f: A => B): Concur[S, E, B] = ap(Quasi.pure(f).concur) } - final implicit class SubseqOps[S[_], A](val subseq: Subseq[S, A]) extends AnyVal { - def quasi: Quasi[S, A] = quasiImpl.fromSubseq(subseq) - def concur: Concur[S, A] = quasi.concur + final implicit class SubseqOps[S[_], E, A](val subseq: Subseq[S, E, A]) extends AnyVal { + def quasi: Quasi[S, E, A] = quasiImpl.fromSubseq(subseq) + def concur: Concur[S, E, A] = quasi.concur - def map[B](f: A => B): Subseq[S, B] = + def map[B](f: A => B): Subseq[S, E, B] = flatMap(a => Quasi.pure(f(a)).subseq) - def flatMap[B](f: A => Subseq[S, B]): Subseq[S, B] = + def flatMap[B](f: A => Subseq[S, E, B]): Subseq[S, E, B] = quasiImpl.flatMap(subseq.quasi)(f.andThen(_.quasi)).subseq } - implicit def subseqMonad[S[_]]: Monad[Subseq[S, ?]] = new Monad[Subseq[S, ?]] { - def pure[A](a: A): Subseq[S, A] = Quasi.pure(a).subseq - def flatMap[A, B](fa: Subseq[S, A])(f: A => Subseq[S, B]): Subseq[S, B] = + implicit def subseqMonadError[S[_], E]: MonadError[Subseq[S, E, ?], E] = new MonadError[Subseq[S, E, ?], E] { + def pure[A](a: A): Subseq[S, E, A] = Quasi.pure(a).subseq + def flatMap[A, B](fa: Subseq[S, E, A])(f: A => Subseq[S, E, B]): Subseq[S, E, B] = fa.flatMap(f) - def tailRecM[A, B](a: A)(f: A => Subseq[S, Either[A, B]]): Subseq[S, B] = ??? + def tailRecM[A, B](a: A)(f: A => Subseq[S, E, Either[A, B]]): Subseq[S, E, B] = ??? + + def handleErrorWith[A](fa: Subseq[S, E, A])(f: E => Subseq[S, E, A]): Subseq[S, E, A] = + quasiImpl.guard(fa.quasi, f.andThen(_.quasi)).subseq + + def raiseError[A](e: E): Subseq[S, E, A] = + quasiImpl.raise(e).subseq } - implicit def concurApplicative[S[_]]: Applicative[Concur[S, ?]] = new Applicative[Concur[S, ?]] { - def pure[A](a: A): Concur[S, A] = Quasi.pure(a).concur - def ap[A, B](ff: Concur[S, A => B])(fa: Concur[S, A]): Concur[S, B] = + implicit def concurApplicative[S[_], E]: Applicative[Concur[S, E, ?]] = new Applicative[Concur[S, E, ?]] { + def pure[A](a: A): Concur[S, E, A] = Quasi.pure(a).concur + def ap[A, B](ff: Concur[S, E, A => B])(fa: Concur[S, E, A]): Concur[S, E, B] = fa.ap(ff) } - implicit def subseqConcurParallel[S[_]]: Parallel[Subseq[S, ?], Concur[S, ?]] = - new Parallel[Subseq[S, ?], Concur[S, ?]] { - val parallel: Subseq[S, ?] ~> Concur[S, ?] = - λ[Subseq[S, ?] ~> Concur[S, ?]](_.quasi.concur) - val sequential: Concur[S, ?] ~> Subseq[S, ?] = - λ[Concur[S, ?] ~> Subseq[S, ?]](_.quasi.subseq) - val applicative: Applicative[Concur[S, ?]] = Applicative[Concur[S, ?]] - val monad: Monad[Subseq[S, ?]] = Monad[Subseq[S, ?]] + implicit def subseqConcurParallel[S[_], E]: Parallel[Subseq[S, E, ?], Concur[S, E, ?]] = + new Parallel[Subseq[S, E, ?], Concur[S, E, ?]] { + val parallel: Subseq[S, E, ?] ~> Concur[S, E, ?] = + λ[Subseq[S, E, ?] ~> Concur[S, E, ?]](_.quasi.concur) + val sequential: Concur[S, E, ?] ~> Subseq[S, E, ?] = + λ[Concur[S, E, ?] ~> Subseq[S, E, ?]](_.quasi.subseq) + val applicative: Applicative[Concur[S, E, ?]] = Applicative[Concur[S, E, ?]] + val monad: Monad[Subseq[S, E, ?]] = Monad[Subseq[S, E, ?]] } object Quasi { - def pure[S[_], A](a: A): Quasi[S, A] = quasiImpl.pure(a) - def liftF[S[_], A](value: S[A]): Quasi[S, A] = quasiImpl.suspend(value) - - def toConcur[S[_]]: Quasi[S, ?] ~> Concur[S, ?] = - λ[Quasi[S, ?] ~> Concur[S, ?]](_.concur) - - def toSubseq[S[_]]: Quasi[S, ?] ~> Subseq[S, ?] = - λ[Quasi[S, ?] ~> Subseq[S, ?]](_.subseq) - - def foldMap[S[_], M[_], A](quasi: Quasi[S, A])(f: S ~> M)(implicit M: Parallel[M, M]): M[A] = - quasiImpl.evaluator(f, - M.parallel, M.sequential, - M.monad, M.applicative)(quasi) + def pure[S[_], E, A](a: A): Quasi[S, E, A] = quasiImpl.pure(a) + def liftF[S[_], E, A](value: S[A]): Quasi[S, E, A] = quasiImpl.suspend(value) + + def toConcur[S[_], E]: Quasi[S, E, ?] ~> Concur[S, E, ?] = + λ[Quasi[S, E, ?] ~> Concur[S, E, ?]](_.concur) + + def toSubseq[S[_], E]: Quasi[S, E, ?] ~> Subseq[S, E, ?] = + λ[Quasi[S, E, ?] ~> Subseq[S, E, ?]](_.subseq) + + def foldMap[S[_], Zm[_], Za[_], E, A] + (quasi: Quasi[S, E, A])(f: S ~> Zm)(implicit Z: Parallel[Zm, Za], E: MonadError[Zm, E]): Zm[A] = + quasiImpl.evaluator( + f, + Z.parallel, + Z.sequential, + Z.monad, + Z.applicative, + λ[λ[α => (Zm[α], E => Zm[α])] ~> Zm](n => E.handleErrorWith(n._1)(n._2)), + λ[λ[α => E] ~> Zm](E.raiseError(_)))(quasi) } private[quasi] sealed trait QuasiImpl { - type Quasi [S[_], A] - type Concur[S[_], A] - type Subseq[S[_], A] - - type Effects[S[_]] = - Pure [S, ?] :: - Suspend [S, ?] :: - FlatMap [S, _, ?] :: - Ap [S, _, ?] :: - Raise [S, _, ?] :: - Handle [S, _, ?] :: + type Quasi [S[_], E, A] + type Concur[S[_], E, A] + type Subseq[S[_], E, A] + + type Effects[S[_], E] = + Pure [ ?] :: + Suspend [S, ?] :: + FlatMap [S, E, _, ?] :: + Ap [S, E, _, ?] :: + Guard [S, E, ?] :: + Raise [S, E, ?] :: TNilK - type Pure[S[_], A] = A + type Pure[A] = A type Suspend[S[_], A] = S[A] - final case class FlatMap[S[_], A, B](fa: Quasi[S, A], f: A => Quasi[S, B]) - final case class Ap[S[_], A, B](ff: Quasi[S, A => B], fa: Quasi[S, A]) + final case class FlatMap[S[_], E, A, B](fa: Quasi[S, E, A], f: A => Quasi[S, E, B]) + final case class Ap[S[_], E, A, B](ff: Quasi[S, E, A => B], fa: Quasi[S, E, A]) + final case class Guard[S[_], E, A](fa: Quasi[S, E, A], f: E => Quasi[S, E, A]) type Raise[S[_], E, A] = E - final case class Handle[S[_], E, A](fe: E => Quasi[S, A]) - //type Handle[S[_], E, A] = E => Quasi[S, A] - def toRaw[S[_], A](quasi: Quasi[S, A]): CopK[Effects[S], A] - def fromRaw[S[_], A](copK: CopK[Effects[S], A]): Quasi[S, A] + def toRaw[S[_], E, A](quasi: Quasi[S, E, A]): CopK[Effects[S, E], A] + def fromRaw[S[_], E, A](copK: CopK[Effects[S, E], A]): Quasi[S, E, A] - def toConcur[S[_], A](quasi: Quasi[S, A]): Concur[S, A] - def fromConcur[S[_], A](subseq: Concur[S, A]): Quasi[S, A] + def toConcur[S[_], E, A](quasi: Quasi[S, E, A]): Concur[S, E, A] + def fromConcur[S[_], E, A](subseq: Concur[S, E, A]): Quasi[S, E, A] - def toSubseq[S[_], A](quasi: Quasi[S, A]): Subseq[S, A] - def fromSubseq[S[_], A](subseq: Subseq[S, A]): Quasi[S, A] + def toSubseq[S[_], E, A](quasi: Quasi[S, E, A]): Subseq[S, E, A] + def fromSubseq[S[_], E, A](subseq: Subseq[S, E, A]): Quasi[S, E, A] - def pure[S[_], A](a: A): Quasi[S, A] - def suspend[S[_], A](value: S[A]): Quasi[S, A] - def flatMap[S[_], A, B](fa: Quasi[S, A])(f: A => Quasi[S, B]): Quasi[S, B] - def ap[S[_], A, B](ff: Quasi[S, A => B])(fa: Quasi[S, A]): Quasi[S, B] + def pure [S[_], E, A](a: A): Quasi[S, E, A] + def suspend[S[_], E, A](value: S[A]): Quasi[S, E, A] + def flatMap[S[_], E, A, B](fa: Quasi[S, E, A])(f: A => Quasi[S, E, B]): Quasi[S, E, B] + def ap [S[_], E, A, B](ff: Quasi[S, E, A => B])(fa: Quasi[S, E, A]): Quasi[S, E, B] + def guard [S[_], E, A](fa: Quasi[S, E, A], f: E => Quasi[S, E, A]): Quasi[S, E, A] + def raise [S[_], E, A](e: E): Quasi[S, E, A] - type Evaluator[S[_], M[_]] = Quasi[S, ?] ~> M + type Evaluator[S[_], M[_], E] = Quasi[S, E, ?] ~> M - def evaluator[S[_], Zm[_], Za[_]]( + def evaluator[S[_], Zm[_], Za[_], E]( f : S ~> Zm, parallel : Zm ~> Za, sequential: Za ~> Zm, Zm : Monad[Zm], - Za : Applicative[Za] - ): Evaluator[S, Zm] + Za : Applicative[Za], + guard : λ[α => (Zm[α], E => Zm[α])] ~> Zm, + raise : λ[α => E] ~> Zm + ): Evaluator[S, Zm, E] } private[quasi] val quasiImpl: QuasiImpl = new QuasiImpl { - type Quasi [S[_], A] = CopK[Effects[S], A] - type Concur[S[_], A] = CopK[Effects[S], A] - type Subseq[S[_], A] = CopK[Effects[S], A] + type Quasi [S[_], E, A] = CopK[Effects[S, E], A] + type Concur[S[_], E, A] = CopK[Effects[S, E], A] + type Subseq[S[_], E, A] = CopK[Effects[S, E], A] - def toRaw[S[_], A](quasi: Quasi[S, A]): CopK[Effects[S], A] = quasi - def fromRaw[S[_], A](copK: CopK[Effects[S], A]): Quasi[S, A] = copK + def toRaw[S[_], E, A](quasi: Quasi[S, E, A]): CopK[Effects[S, E], A] = quasi + def fromRaw[S[_], E, A](copK: CopK[Effects[S, E], A]): Quasi[S, E, A] = copK - def toConcur[S[_], A](quasi: Quasi[S, A]): Concur[S, A] = quasi - def fromConcur[S[_], A](subseq: Concur[S, A]): Quasi[S, A] = subseq + def toConcur[S[_], E, A](quasi: Quasi[S, E, A]): Concur[S, E, A] = quasi + def fromConcur[S[_], E, A](subseq: Concur[S, E, A]): Quasi[S, E, A] = subseq - def toSubseq[S[_], A](quasi: Quasi[S, A]): Subseq[S, A] = quasi - def fromSubseq[S[_], A](subseq: Subseq[S, A]): Quasi[S, A] = subseq + def toSubseq[S[_], E, A](quasi: Quasi[S, E, A]): Subseq[S, E, A] = quasi + def fromSubseq[S[_], E, A](subseq: Subseq[S, E, A]): Quasi[S, E, A] = subseq - def pure[S[_], A](a: A): Quasi[S, A] = - CopK.unsafeApply[Effects[S], Pure[S, ?], A](0, a) + def pure[S[_], E, A](a: A): Quasi[S, E, A] = + CopK.unsafeApply[Effects[S, E], Pure, A](0, a) - def suspend[S[_], A](value: S[A]): Quasi[S, A] = - CopK.unsafeApply[Effects[S], Suspend[S, ?], A](1, value) + def suspend[S[_], E, A](value: S[A]): Quasi[S, E, A] = + CopK.unsafeApply[Effects[S, E], Suspend[S, ?], A](1, value) - def flatMap[S[_], A, B](fa: Quasi[S, A])(f: A => Quasi[S, B]): Quasi[S, B] = - CopK.unsafeApply[Effects[S], FlatMap[S, A, ?], B](2, FlatMap[S, A, B](fa, f)) + def flatMap[S[_], E, A, B](fa: Quasi[S, E, A])(f: A => Quasi[S, E, B]): Quasi[S, E, B] = + CopK.unsafeApply[Effects[S, E], FlatMap[S, E, A, ?], B](2, FlatMap[S, E, A, B](fa, f)) - def ap[S[_], A, B](ff: Quasi[S, A => B])(fa: Quasi[S, A]): Quasi[S, B] = - CopK.unsafeApply[Effects[S], Ap[S, A, ?], B](3, Ap[S, A, B](ff, fa)) + def ap[S[_], E, A, B](ff: Quasi[S, E, A => B])(fa: Quasi[S, E, A]): Quasi[S, E, B] = + CopK.unsafeApply[Effects[S, E], Ap[S, E, A, ?], B](3, Ap[S, E, A, B](ff, fa)) - def evaluator[S[_], Zm[_], Za[_]]( + def guard[S[_], E, A](fa: Quasi[S, E, A], f: E => Quasi[S, E, A]): Quasi[S, E, A] = + CopK.unsafeApply[Effects[S, E], Guard[S, E, ?], A](4, Guard[S, E, A](fa, f)) + + def raise[S[_], E, A](e: E): Quasi[S, E, A] = + CopK.unsafeApply[Effects[S, E], Raise[S, E, ?], A](5, e) + + def evaluator[S[_], Zm[_], Za[_], E]( f : S ~> Zm, parallel : Zm ~> Za, sequential: Za ~> Zm, Zm : Monad[Zm], - Za : Applicative[Za] - ): Evaluator[S, Zm] = new Evaluator[S, Zm] { - def apply[A](quasi: Quasi[S, A]): Zm[A] = + Za : Applicative[Za], + guard : λ[α => (Zm[α], E => Zm[α])] ~> Zm, + raise : λ[α => E] ~> Zm + ): Evaluator[S, Zm, E] = new Evaluator[S, Zm, E] { + def apply[A](quasi: Quasi[S, E, A]): Zm[A] = Zm.tailRecM(quasi)(q => (q.index: @scala.annotation.switch) match { case 0 => val a: A = q.value.asInstanceOf[A] @@ -168,16 +191,23 @@ package object quasi { val sa: S[A] = q.value.asInstanceOf[S[A]] Zm.map(f(sa))(Right(_)) case 2 => - val n: FlatMap[S, Any, A] = q.value.asInstanceOf[FlatMap[S, Any, A]] + val n: FlatMap[S, E, Any, A] = q.value.asInstanceOf[FlatMap[S, E, Any, A]] Zm.map(this(n.fa))(z => Left(n.f(z))) case 3 => - val n: Ap[S, Any, A] = q.value.asInstanceOf[Ap[S, Any, A]] + val n: Ap[S, E, Any, A] = q.value.asInstanceOf[Ap[S, E, Any, A]] Zm.map( sequential(Za.ap( parallel(this(n.ff)))( parallel(this(n.fa)))) )(Right(_)) - case _ => scala.Predef.??? + case 4 => + val n: Guard[S, E, A] = q.value.asInstanceOf[Guard[S, E, A]] + Zm.map(guard((this(n.fa), n.f.andThen(this(_)))))(Right(_)) + case 5 => + val e: E = q.value.asInstanceOf[E] + Zm.map(raise(e))(Right(_)) + case _ => + sys.error("unreachable internal state") }) } @@ -197,35 +227,43 @@ package quasi { trait MathOp[A] case class ConstInt(value: Int) extends MathOp[Int] case class Add(x: Int, y: Int) extends MathOp[Int] + case class Div(x: Int, y: Int) extends MathOp[Int] case class Neg(x: Int) extends MathOp[Int] trait Math[F[_]] { underlying => def const(value: Int): F[Int] def add(x: Int, y: Int): F[Int] + def div(x: Int, y: Int): F[Int] def neg(x: Int): F[Int] final def mapK[G[_]](f: F ~> G): Math[G] = new Math[G] { def const(value: Int): G[Int] = f(underlying.const(value)) def add(x: Int, y: Int): G[Int] = f(underlying.add(x, y)) + def div(x: Int, y: Int): G[Int] = f(underlying.div(x, y)) def neg(x: Int): G[Int] = f(underlying.neg(x)) } } object Math { - def quasi: Math[Quasi[MathOp, ?]] = new Math[Quasi[MathOp, ?]] { - def const(value: Int): Quasi[MathOp, Int] = Quasi.liftF(ConstInt(value)) - def add(x: Int, y: Int): Quasi[MathOp, Int] = Quasi.liftF(Add(x, y)) - def neg(x: Int): Quasi[MathOp, Int] = Quasi.liftF(Neg(x)) + def quasi: Math[Quasi[MathOp, Throwable, ?]] = new Math[Quasi[MathOp, Throwable, ?]] { + def const(value: Int): Quasi[MathOp, Throwable, Int] = Quasi.liftF(ConstInt(value)) + def add(x: Int, y: Int): Quasi[MathOp, Throwable, Int] = Quasi.liftF(Add(x, y)) + def div(x: Int, y: Int): Quasi[MathOp, Throwable, Int] = Quasi.liftF(Div(x, y)) + def neg(x: Int): Quasi[MathOp, Throwable, Int] = Quasi.liftF(Neg(x)) } - def concur: Math[Concur[MathOp, ?]] = quasi.mapK[Concur[MathOp, ?]](Quasi.toConcur) - def subseq: Math[Subseq[MathOp, ?]] = quasi.mapK[Subseq[MathOp, ?]](Quasi.toSubseq) + def concur: Math[Concur[MathOp, Throwable, ?]] = quasi.mapK[Concur[MathOp, Throwable, ?]](Quasi.toConcur) + def subseq: Math[Subseq[MathOp, Throwable, ?]] = quasi.mapK[Subseq[MathOp, Throwable, ?]](Quasi.toSubseq) } - val interp: MathOp ~> Id = λ[MathOp ~> Id] { - case ConstInt(value) => value - case Add(x, y) => x + y - case Neg(x) => -x + import scala.util.Try + implicit val parallelTry: Parallel[Try, Try] = Parallel.identity + + val interp: MathOp ~> Try = λ[MathOp ~> Try] { + case ConstInt(value) => Try(value) + case Add(x, y) => Try(x + y) + case Div(x, y) => Try(x / y) + case Neg(x) => Try(-x) } val math = Math.subseq @@ -244,11 +282,15 @@ package quasi { val program2 = for { foo <- math.const(0) bar <- List(program0, program1).parSequence - } yield bar.foldLeft(foo)(_ + _) + } yield bar.foldLeft(foo)(_ / _) + + val program3 = program2.handleErrorWith(_ => math.const(-100)) - scala.Predef.println(program2) + scala.Predef.println("program:") + scala.Predef.println(program3) - val res = Quasi.foldMap(program2.quasi)(interp) + val res = Quasi.foldMap(program3.quasi)(interp) + scala.Predef.println("res:") scala.Predef.println(res) }