Instrumentation.scala

import cats._
import cats.implicits._
import cats.effect.IO
import scala.io.StdIn

// Port of https://gist.github.com/danidiaz/112c5de83dc9c9b2ece1bf4d3581da24 to Scala

/** An algebraic data type for expressions to add and multiply integers. */
sealed trait Exp

object Exp {
  implicit val show: Show[Exp] = Show.fromToString
}

case class Val(value: Int) extends Exp
case class Add(e1: Exp, e2: Exp) extends Exp
case class Mul(e1: Exp, e2: Exp) extends Exp

object Inst extends App {

  /** A traditional interpreter: structural recursion over recursive structures. */
  def eval0[F[_]: Applicative]: Exp => F[Int] = {
    case Val(value)  => Applicative[F].pure(value)
    case Add(e1, e2) => (eval0[F].apply(e1), eval0[F].apply(e2)).mapN(_ + _)
    case Mul(e1, e2) => (eval0[F].apply(e1), eval0[F].apply(e2)).mapN(_ * _)
  }

  /** What if we factor-out the recursion? This is called "open" recursion. */
  def eval[F[_]: Applicative](rec: Exp => F[Int]): Exp => F[Int] = {
    case Val(value)  => Applicative[F].pure(value)
    case Add(e1, e2) => (rec(e1), rec(e2)).mapN(_ + _)
    case Mul(e1, e2) => (rec(e1), rec(e2)).mapN(_ * _)
  }

  /** To get our intepreter back, we need to take the fixed-point of our non-recursive interpreter. */
  val boring: Exp => Int = fix(eval[Id])

  /** Definition: fix(f) = f(fix(f)).
    *
    * {{{
    * val f: (A => B) => (A => B)
    * val x: A => B = fix(f)
    *               = f(this)
    *               = f(fix(f))
    *               = f(f(this))
    *               = f(f(fix(f)))
    *               = f(f(f(this)))
    *               = f(f(f(fix(f)))
    *               = ...
    * }}}
    */
  def fix[A, B](f: (A => B) => (A => B)): (A => B) = new Function1[A, B] {
    def apply(t: A): B = f(this)(t)
  }

  /** If we can intercept the recursion function, we can transform
    * an open-recursion intepreter into another open-recursion interpreter
    * that can perform some effect--some "instrumentation"--before and/or
    * after the recursion step. */
  type Instrumentation[F[_], E, R] =
    ((E => F[R]) => (E => F[R])) => ((E => F[R]) => (E => F[R]))

  /** No instrumentation is the identity function over open-recursion interpreters. */
  def nop[F[_], E, R]: Instrumentation[F, E, R] = identity

  /** Get an interpreter with no instrumentation. */
  val boring2: Exp => Int = fix(nop(eval[Id]))

  /** Instrument an open-recursion interpreter with a stepping debugger.
    *
    * We delegate the debugger "user interface" to a `DebuggerUI` typeclass instance.
    * The debugger instrumentation prints the current expression, asks for a command,
    * then executes it.
    */
  def debugger[F[_]: Monad, E: Show, R: Read: Show](
      implicit F: DebuggerUI[F, E, R]
  ): Instrumentation[F, E, R] =
    base => // the open-recursion interpreter to instrument
      rec => // the recursive step of the instrumented interpreter
        e => // the expression given to the instrumented interpreter
          for {
            _ <- F.setCurrentExpression(e)
            cmd <- F.getCommand
            value <- cmd match {
              case DebuggerUI.Command.GiveValue(r) =>
                r.pure[F] // the user overrides the expression's value
              case DebuggerUI.Command.StepOver =>
                fix(base)(e) // evaluate the current expression with no instrumented recursion
              case DebuggerUI.Command.StepReturn =>
                // evaluate the current expression, with no instrumented recursion, and print its value
                for {
                  r <- fix(base)(e)
                  _ <- F.setReturnValue(r)
                } yield r
              case DebuggerUI.Command.StepInto =>
                // evaluate the current expression with recursion provided by the *instrumented* interpreter,
                // which "debugs" the first sub-expression
                base(rec)(e)
            }
          } yield value

  val v = Add(Mul(Val(2), Val(3)), Add(Val(5), Add(Val(11), Val(13))))
  println(boring(v))
  println(boring2(v))

  // WARNING: reading from the console is broken in bloop, you probably need to run via sbt
  implicit val ui: DebuggerUI[IO, Exp, Int] = DebuggerUI.console
  val debug: Exp => IO[Int] = fix(debugger[IO, Exp, Int].apply(eval))
  println(debug(v).unsafeRunSync)
  /*
    35
    35
    current expression: Add(Mul(Val(2),Val(3)),Add(Val(5),Add(Val(11),Val(13))))
    enter a command: give value, step over, step return, or <ENTER> to step into

    current expression: Mul(Val(2),Val(3))
    enter a command: give value, step over, step return, or <ENTER> to step into
    step return
    return value is 6
    current expression: Add(Val(5),Add(Val(11),Val(13)))
    enter a command: give value, step over, step return, or <ENTER> to step into
    give value
    specify a value:
    1
    7
  */
}

trait DebuggerUI[F[_], Expr, Result] {
  def getCommand(): F[DebuggerUI.Command[Result]]
  def setCurrentExpression(expr: Expr): F[Unit]
  def setReturnValue(value: Result): F[Unit]
}

object DebuggerUI {
  sealed trait Command[+A]

  object Command {
    case class GiveValue[A](a: A) extends Command[A]
    case object StepOver extends Command[Nothing]
    case object StepReturn extends Command[Nothing]
    case object StepInto extends Command[Nothing]
  }

  def console[Expr: Show, Result: Read: Show]: DebuggerUI[IO, Expr, Result] =
    new DebuggerUI[IO, Expr, Result] {
      import Read.syntax._

      def setCurrentExpression(expr: Expr): IO[Unit] =
        IO(println(show"current expression: $expr"))

      def getCommand(): IO[Command[Result]] =
        for {
          _ <- IO(println(s"enter a command: ${commands.mkString(", ")}"))
          s <- IO(StdIn.readLine)
          command <- s match {
            case `giveValue` =>
              for {
                _ <- IO(println("specify a value:"))
                value <- IO(StdIn.readLine.read[Result])
              } yield Command.GiveValue(value)
            case `stepOver`   => Command.StepOver.pure[IO]
            case `stepReturn` => Command.StepReturn.pure[IO]
            case _            => Command.StepInto.pure[IO]
          }
        } yield command

      def setReturnValue(value: Result): IO[Unit] =
        IO(println(show"return value is $value"))

      val commands = List(
        "give value",
        "step over",
        "step return",
        "or <ENTER> to step into"
      )
      val giveValue :: stepOver :: stepReturn :: _ = commands
    }
}

/** cats doesn't provide the `Read` typeclass, so we define it:
  * `Read[A]` parses `String` to a value of type A. */
trait Read[A] {
  def read(s: String): A
}

object Read {
  implicit val readInt: Read[Int] = _.toInt

  object syntax {

    /** `read[A]` extension method on `String`s. */
    implicit class ReadOps(s: String) {
      def read[A](implicit R: Read[A]): A = R.read(s)
    }
  }
}