mpilquist · January 17, 2022 19:39 · Jan 17, 2022
diff --git a/veryfreemonads.scala b/veryfreemonads.scala
@@ -0,0 +1,66 @@
+// using scala 3.1.1-RC2
+trait Monad[F[_]]:
+  def unit[A](a: => A): F[A]
+  extension [A](fa: F[A])
+    def flatMap[B](f: A => F[B]): F[B]
+    def map[B](f: A => B): F[B] =
+      flatMap(a => unit(f(a)))
+
+object Monad:
+  given function0Monad: Monad[Function0] with
+    def unit[A](a: => A) = () => a
+    extension [A](fa: () => A)
+      def flatMap[B](f: A => () => B) = () => f(fa())()
+
+enum Free[+F[_], A]:
+  case Return(a: A)
+  case Suspend(s: F[A])
+  case FlatMap[F[_], A, B](
+    s: Free[F, A],
+    f: A => Free[F, B]) extends Free[F, B]
+
+  def flatMap[F2[x] >: F[x], B](f: A => Free[F2,B]): Free[F2,B] =
+    FlatMap(this, f)
+
+  @annotation.tailrec
+  final def step: Free[F, A] = this match
+    case FlatMap(FlatMap(fx, f), g) =>
+      fx.flatMap[F, A](x => f(x).flatMap[F, A](g)).step
+    case FlatMap(Return(x), f) => f(x).step
+    case _ => this
+
+
+  def runFree[G[_]](t: [x] => F[x] => G[x])(using G: Monad[G]): G[A] =
+    step match
+      case Return(a) => G.unit(a)
+      case Suspend(r) => t(r)
+      case FlatMap(Suspend(r), f) => t(r).flatMap[A](a => (f(a): Free[F, A]).runFree[G](t))
+      case FlatMap(_, _) => sys.error("Impossible, since `step` eliminates these cases")
+
+enum Console[A]:
+  case ReadLine extends Console[Option[String]]
+  case PrintLine(s: String) extends Console[Unit]
+
+  def toThunk: () => A = this match
+    case ReadLine => () => ??? 
+    case PrintLine(s) => () => println(s)
+
+enum Files[A]:
+  case ReadText(file: String) extends Files[String]
+
+  def toThunk: () => A = this match
+    case ReadText(_) => () => "simulated text"
+
+def cat(file: String): Free[[x] =>> Console[x] | Files[x], Unit] =
+  Free.Suspend(Files.ReadText(file)).flatMap(text =>
+    Free.Suspend(Console.PrintLine(text)))
+
+extension [A](fa: Free[[x] =>> Console[x] | Files[x], A])
+  def toThunk: () => A =
+    fa.runFree[Function0]([x] => (fx: Console[x] | Files[x]) => fx match
+      case c: Console[x] => c.toThunk
+      case f: Files[x] => f.toThunk
+    )
+
+@main def veryFreeMonads =
+  cat("fahrenheit.txt").toThunk()