Implementation of code from "Build Systems a la Carte", see: https://www.microsoft.com/en-us/research/publication/build-systems-la-carte/

buildcart.scala

package org.bykn.buildcart

import cats.{Alternative, Applicative, Id, Eq, Monad, Order, Traverse}
import cats.data.{Chain, Const, State}
import scala.collection.immutable.SortedSet

import cats.implicits._

object BuildCart {
  trait Hash[A]

  /**
   * In a real system this will probably be
   * the outer most effect monad, which includes
   * all effects possible while completing a task
   */
  trait MonadState[M[_], S] {
    def monad: Monad[M]
    def update[A](fn: S => M[(S, A)]): M[A]
    def get: M[S] =
      update { s => monad.pure((s, s)) }
    def put(s: S): M[Unit] =
      update { _ => monad.pure((s, ())) }
  }

  object MonadState {
    implicit def forCatsState[S]: MonadState[State[S, ?], S] =
      new MonadState[State[S, ?], S] {
        def monad = Monad[State[S, ?]]
        def update[A](fn: S => State[S, (S, A)]): State[S, A] =
          State.get[S].flatMap(fn).map(_._2)
      }
  }

  trait Hashable[A] {
    def hash(a: A): Hash[A]
  }

  trait Store[I, K, V] {
    def getInfo: I
    def putInfo(i: I): Store[I, K, V]
    def getValue(k: K)(implicit eqK: Eq[K]): V
    def putValue(k: K, v: V)(implicit eqK: Eq[K]): Store[I, K, V]
    def getHash(k: K)(implicit HV: Hashable[V], EK: Eq[K]): Hash[V]
  }

  object Store {
    def init[I, K, V](i: I)(fn: K => V): Store[I, K, V] = ???
  }

  trait FunctionKK[A[_[_]], B[_[_]]] {
    def apply[F[_]](a: A[F]): B[F]
  }

  /**
   * This is a kind of continuation that is generic
   * on the return value
   *
   * These are the "targets" or "rules" of your build
   * system
   */
  trait Task[-Ctx[_[_]], +K, V] { self =>
    def run[F[_]](build: K => F[V])(implicit c: Ctx[F]): F[V]

    def map[K1](fn: K => K1): Task[Ctx, K1, V] =
      new Task[Ctx, K1, V] {
        def run[F[_]](build: K1 => F[V])(implicit c: Ctx[F]): F[V] =
          self.run(fn.andThen(build))
      }
  }

  object Task {
    type StateTask[IR, K, V] = Task[({type MS[M[_]] = MonadState[M, IR]})#MS, K, V]

    /**
     * This builds a given key, not very useful except for defining a Monad on Task
     */
    def key[Ctx[_[_]], K, V](k: K): Task[Ctx, K, V] =
      new Task[Ctx, K, V] {
        def run[F[_]](build: K => F[V])(implicit c: Ctx[F]): F[V] = build(k)
      }

    def value[V](value: => V): Task[Applicative, Nothing, V] =
      new Task[Applicative, Nothing, V] {
        def run[F[_]](build: Nothing => F[V])(implicit c: Applicative[F]): F[V] =
          c.pure(value)
      }

    implicit def taskMonad[Ctx[_[_]], V]: Monad[Task[Ctx, ?, V]] =
      new Monad[Task[Ctx, ?, V]] {
        def pure[A](a: A) = Task.key(a)

        override def map[A, B](fa: Task[Ctx, A, V])(fn: A => B): Task[Ctx, B, V] =
          fa.map(fn)

        override def product[A, B](fa: Task[Ctx, A, V], fb: Task[Ctx, B, V]): Task[Ctx, (A, B), V] =
          fa.product(fb)

        override def ap[A, B](fab: Task[Ctx, A => B, V])(fb: Task[Ctx, A, V]): Task[Ctx, B, V] =
          product(fab, fb).map { case (f, b) => f(b) }

        def flatMap[A, B](fa: Task[Ctx, A, V])(fn: A => Task[Ctx, B, V]): Task[Ctx, B, V] =
          fa.flatMap(fn)

        def tailRecM[A, B](a: A)(fn: A => Task[Ctx, Either[A, B], V]): Task[Ctx, B, V] =
          new Task[Ctx, B, V] {
            def run[F[_]](build: B => F[V])(implicit c: Ctx[F]): F[V] = {
              // TODO: this is not really stack safe.
              // if we had Ctx is Monad or Defer, I think we are
              // okay here.
              def go(a: A): F[V] =
                fn(a).run {
                  case Left(a) => go(a)
                  case Right(b) => build(b)
                }

              go(a)
            }
          }
      }

    implicit class InvariantTask[Ctx[_[_]], K, V](val task: Task[Ctx, K, V]) extends AnyVal {
      def reconstrain[Ctx2[_[_]]](fn: FunctionKK[Ctx2, Ctx]): Task[Ctx2, K, V] =
        new Task[Ctx2, K, V] {
          def run[F[_]](build: K => F[V])(implicit c: Ctx2[F]): F[V] =
            task.run(build)(fn(c))
        }

      def flatMap[K1](fn: K => Task[Ctx, K1, V]): Task[Ctx, K1, V] =
        new Task[Ctx, K1, V] {
          def run[F[_]](build: K1 => F[V])(implicit c: Ctx[F]): F[V] =
            task.run { k =>
              fn(k).run(build)
            }
        }

      type MapRes[F[_]] = (F[V], Ctx[F])
      type IdK[F[_]] = F[V]

      def mapResult(fn: FunctionKK[MapRes, IdK]): Task[Ctx, K, V] =
        new Task[Ctx, K, V] {
          def run[F[_]](build: K => F[V])(implicit c: Ctx[F]): F[V] =
            task.run { k =>
              val fv = build(k)
              fn((fv, c))
            }
        }

      def product[K1](that: Task[Ctx, K1, V]): Task[Ctx, (K, K1), V] =
        new Task[Ctx, (K, K1), V] {
          def run[F[_]](build: ((K, K1)) => F[V])(implicit c: Ctx[F]): F[V] =
            task.run { a =>
              that.run { b =>
                build((a, b))
              }
            }
        }
    }

    implicit class ApplicativeTask[K, V](val task: Task[Applicative, K, V]) extends AnyVal {
      // Get the list of dependencies for a given K
      // I think this also works for Alternative
      def dependencies: List[K] =
        task.run[Const[Chain[K], ?]] { k => Const(Chain.one(k)) }
          .getConst
          .toList
    }

    implicit class MonadTask[K, V](val task: Task[Monad, K, V]) extends AnyVal {
      // Run without attempting to update any dependencies
      def compute[I](store: Store[I, K, V])(implicit EK: Eq[K]): V =
        task.run[Id] { k => store.getValue(k) }

    }

    def traverse[T[_]: Traverse, K, V](tasks: T[K])(fn: T[V] => V): Task[Applicative, K, V] =
      new Task[Applicative, K, V] {
        def run[F[_]](build: K => F[V])(implicit ctx: Applicative[F]): F[V] =
          tasks.traverse(build).map(fn)
      }


    val foldTask: Task[Alternative, String, String] =
      new Task[Alternative, String, String] {
        def run[F[_]](build: String => F[String])(implicit ctx: Alternative[F]): F[String] =
          ctx.combineK(build("foo"), build("bar"))
      }

    val fooTask = value("foo")
    val barTask = value("bar")
  }

  sealed trait Tasks[Ctx[_[_]], K, V] {
    def get(k: K): Option[Task[Ctx, K, V]]

    def ++(that: Tasks[Ctx, K, V]): Tasks[Ctx, K, V]
  }

  object Tasks {
    private case class TaskMap[Ctx[_[_]], K, V](toMap: Map[K, Task[Ctx, K, V]]) extends Tasks[Ctx, K, V] {
      def get(k: K) = toMap.get(k)
      def ++(that: Tasks[Ctx, K, V]): Tasks[Ctx, K, V] =
        that match {
          case TaskMap(m2) => TaskMap(toMap ++ m2)
        }
    }
    def one[Ctx[_[_]], K, V](k: K, t: Task[Ctx, K, V]): Tasks[Ctx, K, V] =
      TaskMap(Map((k, t)))

    def apply[Ctx[_[_]], K, V](tasks: (K, Task[Ctx, K, V])*): Tasks[Ctx, K, V] =
      TaskMap(Map(tasks: _*))
  }

  trait Build[Ctx[_[_]], I, K, V] {
    def update(tsks: Tasks[Ctx, K, V], key: K, store: Store[I, K, V]): Store[I, K, V]
  }

  object Build {
    /**
     * A naive applicative builder that rebuilds each time an item is needed
     */
    def busy[K: Eq, V]: Build[Applicative, Unit, K, V] =
      new Build[Applicative, Unit, K, V] {
        def update(tsks: Tasks[Applicative, K, V], key: K, store: Store[Unit, K, V]): Store[Unit, K, V] = {

          def fetch(k: K): State[Store[Unit, K, V], V] =
            tsks.get(k) match {
              case None => State.get[Store[Unit, K, V]].map(_.getValue(k))
              case Some(t) =>
                for {
                  v <- t.run(fetch(_))
                  _ <- State.modify[Store[Unit, K, V]](_.putValue(k, v))
                } yield v
            }

          fetch(key).run(store).value._1
        }
      }
  }

  trait Rebuilder[Ctx[_[_]], IR, K, V] {
    def apply(k: K, v: V, task: Task[Ctx, K, V]): Task.StateTask[IR, K, V]
  }

  object Rebuilder {
    def dirtyBit[K, V]: Rebuilder[Monad, K => Boolean, K, V] =
      new Rebuilder[Monad, K => Boolean, K, V] {
        def apply(k: K, v: V, task: Task[Monad, K, V]): Task.StateTask[K => Boolean, K, V] =
          new Task.StateTask[K => Boolean, K, V] {
            def run[F[_]](build: K => F[V])(implicit c: MonadState[F, K => Boolean]): F[V] =
              c.monad.flatMap(c.get) { isDirty =>
                if (isDirty(k)) task.run(build)(c.monad)
                else c.monad.pure(v)
            }
          }
      }
  }

  trait Scheduler[Ctx[_[_]], I, IR, K, V] {
    def apply(r: Rebuilder[Ctx, IR, K, V]): Build[Ctx, I, K, V]
  }

  object Scheduler {
    def suspending[I, K: Order, V]: Scheduler[Monad, I, I, K, V] =
      new Scheduler[Monad, I, I, K, V] {
        def apply(r: Rebuilder[Monad, I, K, V]): Build[Monad, I, K, V] =
          new Build[Monad, I, K, V] {
            type S = (Store[I, K, V], SortedSet[K])
            val monadState: MonadState[State[S, ?], I] =
              new MonadState[State[S, ?], I] {
                def monad = Monad[State[S, ?]]
                def update[A](fn: I => State[S, (I, A)]): State[S, A] =
                  for {
                    sd <- State.get[S]
                    (store, _) = sd
                    ia <- fn(store.getInfo)
                    (newI, a) = ia
                    _ <- State.modify[S] { case (store, d) => (store.putInfo(newI), d) }
                  } yield a
              }

            def update(tsks: Tasks[Monad, K, V], key: K, store: Store[I, K, V]): Store[I, K, V] = {
              def run(t: Task.StateTask[I, K, V], fn: K => State[S, V]): State[S, V] =
                t.run(fn)(monadState)

              def fetch(key: K): State[S, V] =
                State.get[S]
                  .flatMap { case (store, done) =>
                    val value = store.getValue(key)
                    tsks.get(key) match {
                      case Some(task) if !done(key) =>
                        // we need to run
                        val newTask = r(key, value, task)
                        for {
                          newValue <- run(newTask, fetch(_))
                          _ <- State.modify[S] { case (str, set) =>
                            (str.putValue(key, newValue), set + key)
                          }
                        } yield newValue
                      case _ =>
                        State.pure(value)
                    }
                  }

              fetch(key).run((store, SortedSet.empty[K](Order[K].toOrdering))).value._1._1
            }
          }
      }
  }

  case class Trace[+K, V, +R](key: K, depends: List[(K, Hash[V])], result: R)
}