https://scastie.scala-lang.org/B6KaG7tjTVew0zbxvs58SA

eveff.scala

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)

  }
}

https://eed3si9n.com/herding-cats/tail-recursive-monads.html