Skip to content

Instantly share code, notes, and snippets.

@moleike
Last active March 27, 2023 11:21
Show Gist options
  • Save moleike/119fcdb423ff87bffd29ab72716f05e1 to your computer and use it in GitHub Desktop.
Save moleike/119fcdb423ff87bffd29ab72716f05e1 to your computer and use it in GitHub Desktop.
package eveff
import cats.Monad
import cats.Applicative
import cats.Monoid
import cats.Semigroup
import cats.Functor
import cats.MonadThrow
import cats.data.Chain
import cats.data.Ior
import scala.annotation.tailrec
import cats.implicits._
import java.util.concurrent.atomic.AtomicLong
import java.util.concurrent.atomic.AtomicReference
import scala.util.Try
import scala.util.NotGiven
import cats.mtl.Ask
import cats.mtl.Local
import cats.mtl.Raise
import cats.mtl.Tell
import cats.mtl.Stateful
import scala.Conversion
import scala.language.implicitConversions
import Ctl.*
type :*[+H[_, _], E]
// a heterogeneous list of marker and handler pairs (so-called evidence)
enum Ctx[+E]:
case CNil extends Ctx[Nothing]
case CCons[+H[_, _], E, EE, Ans](
marker: Marker[Ans],
handler: H[EE, Ans],
trans: Ctx[E] => Ctx[EE],
tail: Ctx[E]
) extends Ctx[H :* E]
trait SubCtx[+H[_, _]] {
type T
def value: Ctx[H :* T]
}
trait In[+H[_, _], E]:
def subCtx(ctx: Ctx[E]): SubCtx[H]
object In:
given [H[_, _], E]: In[H, H :* E] with
def subCtx(ctx: Ctx[H :* E]): SubCtx[H] = new SubCtx[H] {
type T = E; val value = ctx
}
given [H[_, _], G[_, _], E, Ans](using
NotGiven[H[E, Ans] =:= G[E, Ans]],
In[G, E]
): In[G, H :* E] with
def subCtx(ctx: Ctx[H :* E]): SubCtx[G] = ctx match
case Ctx.CCons(_, _, _, xs) => summon[In[G, E]].subCtx(xs)
type :?[H[_, _], E] = In[H, E]
// An abstract prompt marker
type Marker[A] = Long
object Marker:
private val counter = new AtomicLong(0)
def fresh[A](f: Marker[A] => Ctl[A]): Ctl[A] = f(
counter.getAndIncrement()
)
// control monad for multi-prompt delimited continuations
enum Ctl[+A]:
case Pure(result: A)
case Yield[A, B, Ans](
marker: Marker[Ans],
op: (B => Ctl[Ans]) => Ctl[Ans],
cont: B => Ctl[A]
) extends Ctl[A]
def lift[E]: Eff[E, A] = _ => this
object Ctl:
given Monad[Ctl] with {
def pure[A](x: A): Ctl[A] = Pure(x)
def flatMap[A, B](ca: Ctl[A])(f: A => Ctl[B]): Ctl[B] =
ca match
case Pure(x) => f(x)
case Yield(m, op, cont) => Yield(m, op, kcompose(f, cont))
def tailRecM[A, B](x: A)(f: A => Ctl[Either[A, B]]): Ctl[B] =
flatMap(f(x)) {
case Right(x) => pure(x)
case Left(nextA) => tailRecM(nextA)(f)
}
}
final case class Error(message: String) extends Throwable(message)
def kcompose[A, B, C](g: B => Ctl[C], f: A => Ctl[B])(x: A): Ctl[C] =
f(x) match
case Ctl.Pure(x) => g(x)
case Ctl.Yield(m, op, cont) => Ctl.Yield(m, op, kcompose(g, cont))
def under[E, A](ctx: Ctx[E], eff: Eff[E, A]): Ctl[A] = eff(ctx)
def run[F[_]: MonadThrow, A](ctl: Ctl[A]): F[A] = ctl match
case Pure(x) => x.pure[F]
case Yield(_, _, _) => Ctl.Error("Unhandled operation").raiseError[F, A]
def mprompt[A](m: Marker[A], ctl: Ctl[A]): Ctl[A] = ctl match
case Pure(a) => Pure(a)
case Yield(n, op, cont): Yield[A, _, A] if m == n =>
op(x => mprompt(m, cont(x)))
case Yield(n, op, cont) => Yield(n, op, x => mprompt(m, cont(x)))
def prompt[A](action: Marker[A] => Ctl[A]): Ctl[A] =
Marker.fresh(m => mprompt(m, action(m)))
trait Eff[E, +A] extends (Ctx[E] => Ctl[A])
object Eff:
given [E]: Monad[Eff[E, *]] with {
def pure[A](x: A): Eff[E, A] = _ => x.pure[Ctl]
def flatMap[A, B](ea: Eff[E, A])(f: A => Eff[E, B]): Eff[E, B] = ctx =>
for
ctl <- ea(ctx)
res <- Ctl.under(ctx, f(ctl))
yield res
def tailRecM[A, B](x: A)(f: A => Eff[E, Either[A, B]]): Eff[E, B] =
flatMap(f(x)) {
case Right(x) => pure(x)
case Left(nextA) => tailRecM(nextA)(f)
}
}
def perform[A, B, E, H[_, _]](
selectOp: [EE, Ans] => H[EE, Ans] => Op[A, B, EE, Ans]
)(x: A): H :? E ?=> Eff[E, B] = ctx =>
summon[H :? E].subCtx(ctx).value match
case Ctx.CCons(m, h, f, cs) => selectOp(h)(m, f(cs), x)
def handler[E, Ans, H[_, _]](
h: H[E, Ans],
action: Eff[H :* E, Ans]
): Eff[E, Ans] = ctx =>
prompt(m => under(Ctx.CCons(m, h, identity[Ctx[E]], ctx), action))
def handlerRet[E, Ans, H[_, _], A](
ret: A => Ans,
h: H[E, Ans],
action: Eff[H :* E, A]
): Eff[E, Ans] =
handler(h, action.map(ret(_)))
def handlerHide[E, Ans, H[_, _], H0[_, _]](
h: H[H0 :* E, Ans],
action: Eff[H :* E, Ans]
): Eff[H0 :* E, Ans] =
case Ctx.CCons(m0, h0, f, cs) =>
prompt(m =>
under(
Ctx.CCons(
m,
h,
(c: Ctx[E]) => Ctx.CCons(m0, h0, f, c),
cs
),
action
)
)
extension [A](eff: Eff[Nothing, A])
def run: A = eff(Ctx.CNil) match
case Pure(x) => x
case Yield(_, _, _) =>
throw new Ctl.Error("Unhandled operation") // should never happen
def runF[F[_]](implicit F: MonadThrow[F]): F[A] = F.catchNonFatal(run)
trait Op[-A, +B, E, Ans] extends ((Marker[Ans], Ctx[E], A) => Ctl[B])
object Op:
private def yield_[B, E, Ans](
m: Marker[Ans],
ctx: Ctx[E],
f: (B => Ctl[Ans]) => Eff[E, Ans]
): Ctl[B] =
Yield(m, (k: B => Ctl[Ans]) => under(ctx, f(k)), Pure(_))
// general operation with resumptions
def apply[A, B, E, Ans](
f: (A, B => Eff[E, Ans]) => Eff[E, Ans]
): Op[A, B, E, Ans] = (m, ctx, x) =>
yield_(m, ctx, (k: B => Ctl[Ans]) => f(x, k(_).lift))
// resume once, more efficient version of:
// Op((x, k) => f(x).flatMap(k))
def function[A, B, E, Ans](f: A => Eff[E, B]): Op[A, B, E, Ans] =
(_, ctx, x) => under(ctx, f(x))
// resume with a constant value, same as:
// Op((_, k) => k(x))
def value[A, E, Ans](x: A): Op[Unit, A, E, Ans] = function(_ => x.pure)
// create an operation that never resumes (an exception).
def except[A, E, Ans](f: A => Eff[E, Ans]): Op[A, Nothing, E, Ans] =
(m, ctx, x) => yield_(m, ctx, _ => f(x))
type Reader[+A] = [E, Ans] =>> Reader.Syn[A, E, Ans]
object Reader:
trait Syn[+A, E, Ans]:
def ask: Op[Unit, A, E, Ans]
def apply[A]: Ops[A] = new Ops[A]
private[eveff] final class Ops[A](val dummy: Boolean = true) extends AnyVal:
def ask[E](using In[Reader[A], E]): Eff[E, A] =
Eff.perform[Unit, A, E, Reader[A]](
[EE, Ans] => (r: Syn[A, EE, Ans]) => r.ask
)(())
def local[A, E, Ans](
f: A => A
): Eff[Reader[A] :* E, Ans] => Eff[Reader[A] :* E, Ans] =
Eff.handlerHide(
new Syn[A, Reader[A] :* E, Ans]:
val ask = Op.function(_ => Reader[A].ask.map(f))
,
_
)
def scope[A, E, Ans](
a: A
): Eff[Reader[A] :* E, Ans] => Eff[Reader[A] :* E, Ans] = local(_ => a)
def const[A, E, Ans](a: A): Eff[Reader[A] :* E, Ans] => Eff[E, Ans] =
Eff.handler(
new Syn[A, E, Ans]:
val ask = Op.value(a)
,
_
)
given [E, A](using Reader[A] :? E, Applicative[Eff[E, *]]): Ask[Eff[E, *], A] =
new Ask[Eff[E, *], A]:
val applicative: Applicative[Eff[E, *]] = Applicative[Eff[E, *]]
def ask[A2 >: A]: Eff[E, A2] = Reader[A].ask
type MEff[M[_]] = [E, Ans] =>> MEff.Syn[M, E, Ans]
object MEff:
trait Syn[M[_], E, Ans]:
def runM[A]: Op[M[A], A, E, Ans]
type Except[-A] = [E, Ans] =>> Except.Syn[A, E, Ans]
object Except:
trait Syn[-A, E, Ans]:
def raise: Op[A, Nothing, E, Ans]
def raise[A, E](a: A): Except[A] :? E ?=> Eff[E, Nothing] =
Eff.perform[A, Nothing, E, Except[A]](
[E, Ans] => (e: Syn[A, E, Ans]) => e.raise
)(a)
def handleErrorWith[A, E, Ans](
f: A => Eff[E, Ans]
): Eff[Except[A] :* E, Ans] => Eff[E, Ans] =
Eff.handler(
new Syn[A, E, Ans]:
def raise = Op.except[A, E, Ans](f(_))
,
_
)
def handleError[A, E, Ans](
f: A => Ans
): Eff[Except[A] :* E, Ans] => Eff[E, Ans] = handleErrorWith(f(_).pure)
def recoverWith[A, E, Ans](
pf: PartialFunction[A, Eff[E, Ans]]
): Eff[Except[A] :* E, Ans] => Except[A] :? E ?=> Eff[E, Ans] =
handleErrorWith(a => pf.applyOrElse(a, raise[A, E]))(_)
def recover[A, E, Ans](
pf: PartialFunction[A, Ans]
): Eff[Except[A] :* E, Ans] => Except[A] :? E ?=> Eff[E, Ans] = recoverWith(
pf(_).pure
)
def toOption[A, E, Ans]: Eff[Except[A] :* E, Ans] => Eff[E, Option[Ans]] =
Eff.handlerRet(
(b: Ans) => b.some,
new Syn[A, E, Option[Ans]] {
val raise = Op.except[A, E, Option[Ans]](_ => None.pure)
},
_
)
// Note we can't derive an ApplicativeError instance since handleErrorWith
// would need this type:
// def handleErrorWith[Ans](fa: Eff[Except[A] :* E, Ans])(
// f: A => Eff[E, Ans]
// ): Eff[E, Ans] = ???
given [E, A](using Except[A] :? E, Functor[Eff[E, *]]): Raise[Eff[E, *], A] =
new Raise[Eff[E, *], A]:
def functor: Functor[Eff[E, *]] = Functor[Eff[E, *]]
def raise[A2 <: A, Ans](a: A2): Eff[E, Ans] = Except.raise(a)
def toEither[A, E, Ans]: Eff[Except[A] :* E, Ans] => Eff[E, Either[A, Ans]] =
Eff.handlerRet(
(b: Ans) => Right(b),
new Syn[A, E, Either[A, Ans]] {
val raise = Op.except[A, E, Either[A, Ans]](Left(_).pure)
},
_
)
extension [A, E, Ans](eff: Eff[Except[A] :* E, Ans])
def toEither: Eff[E, Either[A, Ans]] = Except.toEither[A, E, Ans](eff)
type Console = [E, Ans] =>> Console.Syn[E, Ans]
object Console:
trait Syn[E, Ans]:
def println: Op[String, Unit, E, Ans]
def readLine: Op[Unit, String, E, Ans]
def println[E](msg: String): Console :? E ?=> Eff[E, Unit] =
Eff.perform[String, Unit, E, Console](
[EE, Ans] => (e: Syn[EE, Ans]) => e.println
)(msg)
def readLine[E]: Console :? E ?=> Eff[E, String] =
Eff.perform[Unit, String, E, Console](
[EE, Ans] => (e: Syn[EE, Ans]) => e.readLine
)(())
def console[E, Ans]: Eff[Console :* E, Ans] => Eff[E, Ans] =
Eff.handler(
new Syn[E, Ans]:
val println =
Op.function[String, Unit, E, Ans](System.out.println(_).pure)
val readLine =
Op.function[Unit, String, E, Ans](_ => scala.io.StdIn.readLine().pure)
,
_
)
// runs an Eff compuation with default Console handler
extension [A](eff: Eff[Console :* Nothing, A])
def runC: A = Console.console(eff).run
type Amb = [E, Ans] =>> Amb.Syn[E, Ans]
object Amb:
trait Syn[E, Ans]:
def flip: Op[Unit, Boolean, E, Ans]
def flip[E]: Amb :? E ?=> Eff[E, Boolean] =
Eff.perform[Unit, Boolean, E, Amb](
[EE, Ans] => (e: Syn[EE, Ans]) => e.flip
)(())
def allResults[E, Ans]: Eff[Amb :* E, Ans] => Eff[E, List[Ans]] =
Eff.handlerRet(
(x: Ans) => List(x),
new Syn[E, List[Ans]]:
val flip = Op((_, k) =>
for
xs <- k(false)
ys <- k(true)
yield xs ++ ys
)
,
_
)
type State[A] = [E, Ans] =>> State.Syn[A, E, Ans]
object State:
trait Syn[A, E, Ans]:
def get: Op[Unit, A, E, Ans]
def put: Op[A, Unit, E, Ans]
// handler using the state-as-a-function representation
def state[A, E, Ans](init: A): Eff[State[A] :* E, Ans] => Eff[E, (Ans, A)] =
action =>
for
f <- Eff.handler(
new Syn[A, E, A => Eff[E, (Ans, A)]]:
val get = Op((_, k) => ((s: A) => k(s).flatMap(r => r(s))).pure)
val put = Op((s, k) => ((_: A) => k(()).flatMap(r => r(s))).pure)
,
for ans <- action
yield (s => (ans, s).pure)
)
result <- f(init)
yield result
def get[A, E]: State[A] :? E ?=> Eff[E, A] =
Eff.perform[Unit, A, E, State[A]](
[EE, Ans] => (r: Syn[A, EE, Ans]) => r.get
)(())
def put[A, E](a: A): State[A] :? E ?=> Eff[E, Unit] =
Eff.perform[A, Unit, E, State[A]](
[EE, Ans] => (r: Syn[A, EE, Ans]) => r.put
)(a)
given [E, S](using State[S] :? E, Monad[Eff[E, *]]): Stateful[Eff[E, *], S] =
new Stateful[Eff[E, *], S]:
val monad: Monad[Eff[E, *]] = Monad[Eff[E, *]]
def get: Eff[E, S] = State.get
def set(s: S): Eff[E, Unit] = State.put(s)
type Writer[-A] = [E, Ans] =>> Writer.Syn[A, E, Ans]
object Writer:
trait Syn[-A, E, Ans]:
def tell: Op[A, Unit, E, Ans]
def tell[A, E](a: A): Writer[A] :? E ?=> Eff[E, Unit] =
Eff.perform[A, Unit, E, Writer[A]](
[EE, Ans] => (r: Syn[A, EE, Ans]) => r.tell
)(a)
// TODO add listen as a Writer operation
def listen[E, A, Ans]: (
Monoid[A],
Writer[A] :? E
) ?=> Eff[Writer[A] :* E, Ans] => Eff[E, (Ans, A)] = action =>
writer(action).flatTap((a, w) => tell(w))
def censor[E, A, Ans](f: A => A): (
Monoid[A],
Writer[A] :? E
) ?=> Eff[Writer[A] :* E, Ans] => Eff[E, Ans] = action =>
writer(action).flatMap((a, w) => tell(f(w)).as(a))
def writer[E, A, Ans]
: Monoid[A] ?=> Eff[Writer[A] :* E, Ans] => Eff[E, (Ans, A)] = action =>
State.state(Monoid[A].empty)(
Eff.handlerHide(
new Syn[A, State[A] :* E, Ans]:
val tell =
Op.function(x => State.get.flatMap(xs => State.put(xs.combine(x))))
,
action
)
)
given [E, L](using Writer[L] :? E, Functor[Eff[E, *]]): Tell[Eff[E, *], L] =
new Tell[Eff[E, *], L]:
val functor: Functor[Eff[E, *]] = Functor[Eff[E, *]]
def tell(l: L): Eff[E, Unit] = Writer.tell(l)
extension [E, L, A](eff: Eff[Writer[L] :* E, A])(using Monoid[L])
def runW: Eff[E, (A, L)] = Writer.writer[E, L, A](eff)
def censor(f: L => L): Writer[L] :? E ?=> Eff[E, A] = Writer.censor(f)(eff)
def listen: Writer[L] :? E ?=> Eff[E, (A, L)] = Writer.listen(eff)
// An hybrid error/writer monad that allows both accumulating outputs and
// aborting computation with a final output.
type Chronicle[-A] = [E, Ans] =>> Chronicle.Syn[A, E, Ans]
object Chronicle:
trait Syn[-A, E, Ans]:
def dictate: Op[A, Unit, E, Ans]
def confess: Op[A, Nothing, E, Ans]
def confess[A, E](a: A): Chronicle[A] :? E ?=> Eff[E, Nothing] =
Eff.perform[A, Nothing, E, Chronicle[A]](
[E, Ans] => (e: Syn[A, E, Ans]) => e.confess
)(a)
def dictate[A, E](a: A): Chronicle[A] :? E ?=> Eff[E, Unit] =
Eff.perform[A, Unit, E, Chronicle[A]](
[EE, Ans] => (r: Syn[A, EE, Ans]) => r.dictate
)(a)
def materialize[A, Ans, E]
: Semigroup[A] ?=> Eff[Chronicle[A] :* E, Ans] => Eff[E, A Ior Ans] =
Eff.handlerRet(
Ior.right[A, Ans](_),
new Syn[A, E, A Ior Ans]:
val dictate = Op((a, k) =>
k(()).map {
case l @ Ior.Left(_) => l
case other => other.addLeft(a)
}
)
val confess = Op.except[A, E, A Ior Ans](Ior.left(_).pure)
,
_
)
object Main {
def main(args: Array[String]): Unit = {
def greet[E]: (Reader[Long] :? E, Reader[String] :? E) ?=> Eff[E, String] =
for
p <- Reader[String].ask
a <- Reader[Long].ask
yield s"Hello, $p, $a times!"
def greet5Times[E]: Reader[String] :? E ?=> Eff[E, String] =
Reader.const(5L)(greet)
println(Reader.const("Leiva")(greet5Times).run)
def there[E]: Eff[Reader[String] :* E, String] =
Reader.scope("there")(greet5Times)
println(Reader.const("Leiva")(there).run)
// using cats-mtl
import Reader.given
def greetMtl[F[_]: Monad](using ask: Ask[F, String]): F[String] =
for p <- ask.ask
yield s"Hello, $p"
println(Reader.const("mtl")(greetMtl).run)
// exceptions
object DivByZeroError extends Throwable
def div[E](x: Long, y: Long): Except[Throwable] :? E ?=> Eff[E, Long] =
if y == 0 then Except.raise(DivByZeroError)
else (x / y).pure
println(div(42, 0).toEither.run)
def safeDiv[E](
x: Long,
y: Long
): Except[Throwable] :? E ?=> Eff[E, Long] =
Except.recover[Throwable, E, Long] { case DivByZeroError =>
0L
}(div(x, y))
println(safeDiv(42, 0).toEither.runF[Try])
// using cats-mtl
import Except.given
def divMtl[F[_]: Applicative](x: Long, y: Long)(implicit
F: Raise[F, Throwable]
): F[Long] =
if y == 0 then F.raise(new ArithmeticException)
else (x / y).pure
def divEff[E](x: Long, y: Long): Except[Throwable] :? E ?=> Eff[E, Long] =
divMtl[Eff[E, *]](x, y)
def foo[E]: (
Reader[String] :? E,
Except[String] :? E,
Console :? E,
State[Int] :? E
) ?=> Eff[E, String] =
for
name <- Reader[String].ask
str <-
if name == "Joe" then "nice!".pure[Eff[E, *]]
else Except.raise("ouch")
_ <- Console.println(s"His name is $name")
yield str
println(
(State
.state(0)(Reader.const("Joe")(Except.handleError(_ => "not Joe")(foo))))
.runC
)
implicitly[ArithmeticException <:< Throwable]
implicitly[
Except[Throwable][Unit, Unit] <:< Except[ArithmeticException][Unit, Unit]
]
def invert[E]: State[Boolean] :? E ?=> Eff[E, Unit] =
for
a <- State.get
_ <- State.put(!a)
yield ()
println(State.state(true)(invert).run)
type Log = Chain[String]
def ex[E]: Writer[Log] :? E ?=> Eff[E, Unit] =
for
_ <- Writer.tell(Chain.one("foo"))
_ <- Writer.tell(Chain.one("bar"))
yield ()
println(ex.runW.run)
def xor[E]: Amb :? E ?=> Eff[E, Boolean] =
for
x <- Amb.flip
y <- Amb.flip
yield (x && !y) || (!x && y)
println(Amb.allResults(xor).run)
def logging[F[_]: Monad](implicit F: Tell[F, Log]): F[Unit] =
// Example of some logging activity in your application
for {
_ <- F.tell(Chain.one("First log"))
_ <- F.tell(Chain.one("Second log"))
} yield ()
def sendLogsToStdOut[A, E](
logProgram: Eff[Writer[Log] :* E, A]
): (
Console :? E,
Writer[Log] :? E,
Monoid[Log]
) ?=> Eff[E, A] =
logProgram.listen
.flatMap((a, logs) => logs.traverse_(Console.println(_)).as(a))
def prependMessage[E, A](
logProgram: Eff[Writer[Log] :* E, A]
): Writer[Log] :? E ?=> Eff[E, A] =
logProgram.censor((log: Log) => log.prepend("Hello"))
println(
Writer
.writer[Console :* Nothing, Log, Unit](
sendLogsToStdOut(prependMessage(logging))
)
.runC
)
def ex2[E]: Chronicle[String] :? E ?=> Eff[E, Int] =
for
_ <- Chronicle.dictate("foo")
_ <- Chronicle.dictate("bar")
//_ <- Chronicle.confess("ohoh")
yield 42
println(Chronicle.materialize[String, Int, Nothing](ex2).run)
}
}
@moleike
Copy link
Author

moleike commented Mar 27, 2023

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment