tagless https://typelevel.org/blog/2017/12/27/optimizing-final-tagless.html

tagless.scala

import scala.language.higherKinds

trait KVStore[F[_]] {
  def get(key: String): F[Option[String]]
  def put(key: String, a: String): F[Unit]
}

import cats._
import cats.data._
import cats.implicits._

object Program1 {
  def program[M[_]: FlatMap, F[_]](K: KVStore[M], a: String)(implicit P: Parallel[M, F]) =
    for {
      _ <- K.put("A", a)
      x <- (K.get("B"), K.get("C")).parMapN(_ |+| _)
      _ <- K.put("X", x.getOrElse("-"))
    } yield x
}

object Program2 {
  def program[F[_]: Apply](F: KVStore[F]): F[List[String]] =
    (F.get("Cats"), F.get("Dogs"), F.put("Mice", "42"), F.get("Cats"))
      .mapN((f, s, _, t) => List(f, s, t).flatten)

  val analysisInterpreter: KVStore[Const[(Set[String], Map[String, String]), ?]] =
    new KVStore[Const[(Set[String], Map[String, String]), ?]] {
      def get(key: String) = Const((Set(key), Map.empty))
      def put(key: String, a: String) = Const((Set.empty, Map(key -> a)))
    }

  val result = program(analysisInterpreter).getConst
}

object Program3 {
  import Program2._

  def optimizedProgram[F[_]: Applicative](F: KVStore[F]): F[List[String]] = {
    val (gets, puts) = program(analysisInterpreter).getConst
    puts.toList.traverse { case (k, v) => F.put(k, v) } *> gets.toList.traverse(F.get).map(_.flatten)
  }
}

object Program4 {
  def program[F[_]: Apply](mouse: String)(F: KVStore[F]): F[List[String]] =
    (F.get("Cats"), F.get("Dogs"), F.put("Mice", mouse), F.get("Cats"))
      .mapN((f, s, _, t) => List(f, s, t).flatten)

  import Program2.analysisInterpreter

  def optimizedProgram[F[_]: Applicative](mouse: String)(F: KVStore[F]): F[List[String]] = {
    val (gets, puts) = program(mouse)(analysisInterpreter).getConst

    puts.toList.traverse { case (k, v) => F.put(k, v) } *> gets.toList.traverse(F.get).map(_.flatten)
  }

  def monadicProgram[F[_]: Monad](F: KVStore[F]) = for {
    mouse <- F.get("Mice")
    list <- optimizedProgram(mouse.getOrElse("64"))(F)
    _ <- F.put("Birds", List().headOption.getOrElse("128"))
  } yield ()
}

object Program5 {
  trait Program[Alg[_[_]], A] {
    def apply[F[_]: Applicative](interpreter: Alg[F]) : F[A]
  }

  def optimize[Alg[_[_]], F[_]: Applicative, A, M: Monoid]
    (program: Program[Alg, A])
    (extract: Alg[Const[M, ?]])
    (restructure: M => F[A]): Alg[F] => F[A] = { interp =>
    val m = program(extract).getConst

    restructure(m)
  }

  def program[F[_]: Apply](mouse: String)(F: KVStore[F]): F[List[String]] =
    (F.get("Cats"), F.get("Dogs"), F.put("Mice", mouse), F.get("Cats"))
      .mapN((f, s, _, t) => List(f, s, t).flatten)

  def wrappedProgram(mouse: String) = new Program[KVStore, List[String]] {
    def apply[F[_]: Applicative](alg: KVStore[F]): F[List[String]] = program(mouse)(alg)
  }

  import Program2.analysisInterpreter

  def optimizedProgram[F[_]: Applicative](mouse: String)(F: KVStore[F]): KVStore[F] => F[List[String]] = {
    optimize(wrappedProgram(mouse))(analysisInterpreter) { case (gets, puts) =>
      puts.toList.traverse { case (k, v) => F.put(k, v) } *> gets.toList.traverse(F.get).map(_.flatten)
    }
  }
}

import monix.eval.Task

object Program6 {
  import Program5.Program

  trait Optimizer[Alg[_[_]], F[_]] {
    type M

    def monoidM: Monoid[M]
    def monadF: Monad[F]

    def extract: Alg[Const[M, ?]]
    def rebuild(m: M, interpreter: Alg[F]): F[Alg[F]]

    def optimize[A](p: Program[Alg, /*Applicative,*/ A]): Alg[F] => F[A] = { interpreter =>
      implicit val M: Monoid[M] = monoidM
      implicit val F: Monad[F] = monadF

      val m: M = p(extract).getConst

      rebuild(m, interpreter).flatMap(interp => p(interp))
    }
  }

  implicit class OptimizerOps[Alg[_[_]], A](val value: Program[Alg, A]) extends AnyVal {
    def optimize[F[_]: Monad](interp: Alg[F])(implicit O: Optimizer[Alg, F]): F[A] =
      O.optimize(value)(interp)
  }

  implicit val kvStoreTaskOptimizer: Optimizer[KVStore, Task] = new Optimizer[KVStore, Task] {
    type M = Set[String]

    def monoidM = implicitly

    def monadF = implicitly

    def extract = new KVStore[Const[Set[String], ?]] {
      def get(key: String) = Const(Set(key))
      def put(key: String, a: String): Const[Set[String], Unit] = Const(Set.empty)
    }

    def rebuild(gs: Set[String], interp: KVStore[Task]): Task[KVStore[Task]] =
      gs.toList
        .parTraverse(key => interp.get(key).map(_.map(s => (key, s))))
        .map(_.collect { case Some(v) => v }.toMap)
        .map { m =>
          new KVStore[Task] {
            override def get(key: String) = m.get(key) match {
              case Some(a) => Option(a).pure[Task]
              case None => interp.get(key)
            }

            def put(key: String, a: String): Task[Unit] = interp.put(key, a)
          }
        }

  }

  import Program5.wrappedProgram

  def monadicProgram[F[_]: Monad](F: KVStore[F])(implicit O: Optimizer[KVStore, F]): F[Unit] = for {
    mouse <- F.get("Mice")
    list <- wrappedProgram(mouse.getOrElse("64")).optimize(F)
    _ <- F.put("Birds", list.headOption.getOrElse("128"))
  } yield ()
}

object TestInterpreter extends KVStore[Task] {
  def get(key: String): Task[Option[String]] = Task {

    println("Hit network for " + key)

    Option(key + "!")
  }

  def put(key: String, a: String): Task[Unit] = Task {
    println("Put something: " + a)
    ()
  }
}

object Main extends App {
  //println(Program2.result)

  import monix.execution.Scheduler.Implicits.global
  Program6.monadicProgram(TestInterpreter).runAsync
}