[DRAFT] Layered algebras in Free and Final Tagless

FreeAlg.scala

object FreeAlg {
  import cats.data.Coproduct
  import cats.free.{Free, Inject}
  import cats.implicits._
  import cats._

  sealed trait MoveV[A]
  final case class MoveUp(current: Int) extends MoveV[Int]
  final case class MoveDown(current: Int) extends MoveV[Int]
  object MoveV {
    class Alg[F[_]](implicit i: Inject[MoveV, F]) {
      private[this] val inj = Free.inject[MoveV, F]
      def up(c: Int) = inj(MoveUp(c))
      def down(c: Int) = inj(MoveDown(c))
    }
    implicit def injector[F[_]](implicit i: Inject[MoveV, F]) = new Alg
  }

  sealed trait MoveH[A]
  final case class MoveLeft(current: Int) extends MoveH[Int]
  final case class MoveRight(current: Int) extends MoveH[Int]
  object MoveH {
    class Alg[F[_]](implicit i: Inject[MoveH, F]) {
      private[this] val inj = Free.inject[MoveH, F]
      def left(c: Int) = inj(MoveLeft(c))
      def right(c: Int) = inj(MoveRight(c))
    }
    implicit def injector[F[_]](implicit i: Inject[MoveH, F]) = new Alg
  }

  sealed trait Shape[A]
  final case class Line(from: Int, to: Int) extends Shape[Int]
  final case class Rectangle(a: Int, b: Int, c: Int, d: Int) extends Shape[Int]

  object Shape {
    class Alg[F[_]](implicit i: Inject[Shape, F]) {
      private[this] val inj = Free.inject[Shape, F]
      def line(f: Int, t: Int) = inj(Line(f, t))
      def rectangle(a: Int, b: Int, c: Int, d: Int) =
        inj(Rectangle(a, b, c, d))
    }
    implicit def injector[F[_]](implicit i: Inject[Shape, F]) = new Alg
  }

  object App {

    def run[F[_]](init: Int)(implicit V: MoveV.Alg[F],
                             H: MoveH.Alg[F]): Free[F, Either[String, Int]] = {
      import H._
      import V._
      for {
        a <- up(1)
        _ <- left(2)
        b <- down(a)
        c <- b.asRight.ensure("Nope")(_ < 2).pure[Free[F, ?]]
      } yield c
    }
  }

  object App2 {
    def run[F[_]](init: Int)(
        implicit H: Shape.Alg[F]): Free[F, Either[String, Int]] = {
      import H._
      for {
        a <- line(init, 2)
        b <- rectangle(a, 2, 3, 4)
        c <- b.asRight.ensure("Nope")(_ < 2).pure[Free[F, ?]]
      } yield c
    }
  }

  val interpreterV: MoveV ~> Id = new (MoveV ~> Id) {
    override def apply[A](fa: MoveV[A]): Id[A] = fa match {
      case MoveUp(x) => x + 1
      case MoveDown(x) => x - 1
    }
  }

  val interpreterH: MoveH ~> Id = new (MoveH ~> Id) {
    override def apply[A](fa: MoveH[A]): Id[A] = fa match {
      case MoveRight(x) => x + 1
      case MoveLeft(x) => x - 1
    }
  }

  type MoveHAndMoveV[A] = Coproduct[MoveH, MoveV, A]

  def moveInterpreter[F[_]](implicit V: MoveV.Alg[F],
                            H: MoveH.Alg[F]): Shape ~> Free[F, ?] =
    new (Shape ~> Free[F, ?]) {
      import V._
      import H._

      override def apply[A](fa: Shape[A]): Free[F, A] = fa match {
        //bogus impls
        case Line(f, t) => left(t - f)
        case Rectangle(a, b, c, d) => up(b - a) >> left(c - b)
      }
    }

  App.run[MoveHAndMoveV](1).foldMap(interpreterH or interpreterV)

  App2
    .run[Shape](1)
    .foldMap(moveInterpreter[MoveHAndMoveV])
    .foldMap(interpreterH or interpreterV)
}

FT.scala

object FT {
  import cats._, implicits._

  trait MoveV[F[_]] {
    def up(c: Int): F[Int]
    def down(c: Int): F[Int]
  }
  object MoveV {
    implicit def interpreter: MoveV[Id] = new MoveV[Id] {
      def up(c: Int) = c + 1
      def down(c: Int) = c - 1
    }
  }

  trait MoveH[F[_]] {
    def left(c: Int): F[Int]
    def right(c: Int): F[Int]
  }
  object MoveH {
    implicit def interpreter: MoveH[Id] = new MoveH[Id] {
      def right(c: Int) = c + 1
      def left(c: Int) = c - 1
    }
  }

  trait Shape[F[_]] {
    def line(f: Int, t: Int): F[Int]
    def rectangle(a: Int, b: Int, c: Int, d: Int): F[Int]
  }
  object Shape {
    implicit def moveInterpreter[F[_]: Monad](implicit V: MoveV[F],
                                              H: MoveH[F]): Shape[F] =
      new Shape[F] {
        def line(f: Int, t: Int): F[Int] = H.left(t - f)
        def rectangle(a: Int, b: Int, c: Int, d: Int): F[Int] =
          V.up(b - a) >> H.left(c - b)
      }
  }

  object App {
    def run[F[_]: Monad](init: Int)(implicit V: MoveV[F],
                                    H: MoveH[F]): F[Either[String, Int]] =
      for {
        a <- V.up(1)
        _ <- H.left(2)
        b <- V.down(a)
        c <- b.asRight.ensure("Nope")(_ < 2).pure[F]
      } yield c
  }

  object App2 {
    def run[F[_]: Monad](init: Int)(
        implicit S: Shape[F]): F[Either[String, Int]] =
      for {
        a <- S.line(init, 2)
        b <- S.rectangle(a, 2, 3, 4)
        c <- b.asRight.ensure("Nope")(_ < 2).pure[F]
      } yield c
  }

  val a = App.run[Id](1)
  val b = App2.run[Id](1)
  }