stack safety

core/src/main/scala/tut/Zed.scala

@@ -1,123 +1,26 @@
 package tut
 
-import java.io.OutputStream
+// A stub of the old Zed micro-library, just to let us replace it without disturbing other code.
+object Zed extends tut.felix.Syntax {
 
-object Zed {
-  trait Monad[M[_]] {
-    def point[A](a: A): M[A]
-    def map[A, B](ma: M[A])(f: A => B): M[B]
-    def flatMap[A, B](ma: M[A])(f: A => M[B]): M[B]
-  }
-
-  implicit class MonadOps[M[_], A](ma: M[A])(implicit M: Monad[M]) {
-    def map[B](f: A => B): M[B] = M.map(ma)(f)
-    def flatMap[B](f: A => M[B]): M[B] = M.flatMap(ma)(f)
-    def >>=[B](f: A => M[B]): M[B] = M.flatMap(ma)(f)
-    def >>[B](mb: M[B]): M[B] = M.flatMap(ma)(_ => mb)
-    def void: M[Unit] = ma.map(_ => ())
-    def as[B](b: B): M[B] = ma.map(_ => b)
-  }
-
-  implicit class IdOps[A](a: A) {
-    def point[M[_]](implicit M: Monad[M]) = M.point(a)
-    def <|(f: A => Any): A = { f(a); a }
-  }
+  type IO[A]              = tut.felix.IO[A]
+  type Monad[F[_]]        = tut.felix.Monad[F]
+  type StateT[F[_], S, A] = tut.felix.StateT[F, S, A]
+  type LiftIO[F[_]]       = tut.felix.LiftIO[F]
+  type Resource[A]        = tut.felix.Resource[A]
 
-  implicit class Tuple2Ops[A](a: (A, A)) {
-    def umap[B](f: A => B): (B, B) = (f(a._1), f(a._2))
-  }
-
-  final case class State[S, A](run: S => (A, S)) {
-    def map[B](f: A => B): State[S, B] = State { s => val (a, s0) = run(s); (f(a), s0) }
-    def flatMap[B](f: A => State[S, B]): State[S, B] = State { s => val (a, s0) = run(s); f(a).run(s0) }
-    def lift[M[_]: Monad]: StateT[M, S, A] = StateT { s => run(s).point[M] }
-    def exec(s: S): S = run(s)._2
-  }
+  val IO     = tut.felix.IO
+  val StateT = tut.felix.StateT
 
   object State {
-    implicit def StateInstances[S] = new Monad[({ type l[a] = State[S, a] })#l] {
-      def point[A](a: A) = State(s => (a, s))
-      def map[A,B](ma: State[S, A])(f: A => B) = ma.map(f)
-      def flatMap[A,B](ma: State[S, A])(f: A => State[S, B]) = ma.flatMap(f)
+    def get[A] = new GetPartial[A]
+    class GetPartial[A] {
+      def lift[F[_]: Monad]: StateT[F, A, A] = StateT.get[F, A]
     }
-
-    def get[S]: State[S, S] = State(s => (s, s))
-
-    def modify[S](f: S => S): State[S, Unit] = State(s => ((), f(s)))
-  }
-
-  trait LiftIO[M[_]] {
-    def liftIO[A](ma: IO[A]): M[A]
-  }
-
-  final case class StateT[M[_]: Monad, S, A](run: S => M[(A, S)]) {
-    def map[B](f: A => B): StateT[M, S, B] = StateT(s => run(s).map { case (a, s) => (f(a), s) })
-    def flatMap[B](f: A => StateT[M, S, B]): StateT[M, S, B] =
-      StateT(s => run(s).flatMap { case (a, s) => f(a).run(s) })
-    def exec(s: S): M[S] = run(s).map(_._2)
-  }
-
-  object StateT {
-    implicit def StateTInstances[M[_]: Monad, S] = new Monad[({ type l[a] = StateT[M, S, a]})#l] {
-      def point[A](a: A) = StateT(s => (a, s).point[M])
-      def map[A,B](ma: StateT[M, S, A])(f: A => B) = ma.map(f)
-      def flatMap[A,B](ma: StateT[M, S, A])(f: A => StateT[M, S, B]) = ma.flatMap(f)
-    }
-    implicit def StateTLiftIO[S] = new LiftIO[({ type l[a] = StateT[IO, S, a]})#l] {
-      def liftIO[A](ma: IO[A]): StateT[IO, S, A] = StateT(s => (ma.map(a => (a, s)) : IO[(A, S)]))
+    def modify[A](f: A => A) = new ModifyPartial[A](f)
+    class ModifyPartial[A](f: A => A) {
+      def lift[F[_]: Monad]: StateT[F, A, Unit] = StateT.modify[F, A](f)
     }
   }
 
-  trait Resource[A] {
-    def close(a: A): Unit
-  }
-
-  object Resource {
-    implicit def CloseableResource[A <: java.io.Closeable] = new Resource[A] {
-      def close(a: A): Unit = a.close
-    }
-  }
-
-  object RealWorld
-
-  type IO[A] = State[RealWorld.type, A]
-
-  object IO {
-    def apply[A](a: => A): IO[A] = State[RealWorld.type,A](s => (a, s))
-
-    def fail[A](t: Throwable): IO[A] = State(_ => throw t)
-
-    def putStrLn(s: String): IO[Unit] = IO(Console.println(s))
-  }
-
-  implicit class IOOps[A](ma: IO[A]) {
-    def liftIO[M[_]](implicit M: LiftIO[M]): M[A] = M.liftIO(ma)
-    def using[B](f: A => IO[B])(implicit A: Resource[A]): IO[B] =
-      ma.flatMap(a => f(a).flatMap(b => IO(A.close(a)).map(_ => b)))
-    def ensuring[B](mb: IO[B]): IO[A] =
-      State(rw => try { ma.run(rw) } finally { void(mb.run(rw)) } )
-    def unsafePerformIO(): A = ma.run(RealWorld)._1
-    def withOut(o: OutputStream): IO[A] =
-      State[RealWorld.type,A](s => Console.withOut(o)(ma.run(s)))
-  }
-
-  implicit class ListOps[A](as: List[A]) {
-    def traverse[M[_]: Monad, B](f: A => M[B]): M[List[B]] =
-      as.foldRight(List.empty[B].point[M])((a, mlb) => f(a).flatMap(b => mlb.map(b :: _)))
-  }
-
-  implicit class BooleanOps(b: Boolean) {
-    def whenM[M[_]: Monad, A](ma: M[A]): M[Unit] = if (b) ma.void else ().point[M]
-    def unlessM[M[_]: Monad, A](ma: M[A]): M[Unit] = if (!b) ma.void else ().point[M]
-    def fold[A](t: => A, f: => A): A = if (b) t else f
-  }
-
-  implicit val ListInstances = new Monad[List] {
-    def point[A](a: A) = List(a)
-    def map[A,B](ma: List[A])(f: A => B) = ma.map(f)
-    def flatMap[A,B](ma: List[A])(f: A => List[B]) = ma.flatMap(f)
-  }
-
-  def void[A](a: A): Unit = ()
-
 }

core/src/main/scala/tut/felix/IO.scala

@@ -0,0 +1,129 @@
+package tut.felix
+
+import scala.annotation.tailrec
+
+/** A stacksafe IO monad derived from cats.data.Eval, originally written by Erik Osheim. */
+sealed abstract class IO[+A] { self =>
+
+  def unsafePerformIO(): A
+
+  def map[B](f: A => B): IO[B] =
+    flatMap(a => IO.point(f(a)))
+
+  def flatMap[B](f: A => IO[B]): IO[B] =
+    this match {
+      case c: IO.Compute[A] =>
+        new IO.Compute[B] {
+          type Start = c.Start
+          val start: () => IO[Start] = c.start
+          val run: Start => IO[B] = (s: c.Start) =>
+            new IO.Compute[B] {
+              type Start = A
+              val start = () => c.run(s)
+              val run = f
+            }
+        }
+      case c: IO.Call[A] =>
+        new IO.Compute[B] {
+          type Start = A
+          val start = c.thunk
+          val run = f
+        }
+      case _ =>
+        new IO.Compute[B] {
+          type Start = A
+          val start = () => self
+          val run = f
+        }
+    }
+
+}
+
+object IO {
+
+  def apply[A](a: => A): IO[A] =
+    new Primitive(a _)
+
+  def point[A](a: A): IO[A] =
+    Pure(a)
+
+  val unit: IO[Unit] =
+    Pure(())
+
+  def putStrLn(s: String): IO[Unit] =
+    IO(Console.println(s))
+
+  def fail[A](t: Throwable): IO[A] =
+    IO(throw t)
+
+  implicit val MonadIO: Monad[IO] =
+    new Monad[IO] {
+      def point[A](a: A) = IO.point(a)
+      def map[A, B](fa: IO[A])(f: A => B) = fa.map(f)
+      def flatMap[A, B](fa: IO[A])(f: A => IO[B]) = fa.flatMap(f)
+    }
+
+  implicit val LiftIOIO: LiftIO[IO] =
+    new LiftIO[IO] {
+      def liftIO[A](ioa: IO[A]) = ioa
+    }
+
+  private final case class Pure[A](value: A) extends IO[A] {
+    def unsafePerformIO() = value
+  }
+
+  private final class Primitive[A](f: () => A) extends IO[A] {
+    def unsafePerformIO(): A = f()
+  }
+
+  private sealed abstract class Call[A](val thunk: () => IO[A]) extends IO[A] {
+    def unsafePerformIO(): A = Call.loop(this).unsafePerformIO()
+  }
+
+  private object Call {
+
+    @tailrec private def loop[A](fa: IO[A]): IO[A] = fa match {
+      case call: IO.Call[A] =>
+        loop(call.thunk())
+      case compute: IO.Compute[A] =>
+        new IO.Compute[A] {
+          type Start = compute.Start
+          val start: () => IO[Start] = () => compute.start()
+          val run: Start => IO[A] = s => loop1(compute.run(s))
+        }
+      case other => other
+    }
+
+    private def loop1[A](fa: IO[A]): IO[A] = loop(fa)
+
+  }
+
+  private sealed abstract class Compute[A] extends IO[A] {
+    type Start
+    val start: () => IO[Start]
+    val run: Start => IO[A]
+    def unsafePerformIO(): A = {
+      type L = IO[Any]
+      type C = Any => IO[Any]
+      @tailrec def loop(curr: L, fs: List[C]): Any =
+        curr match {
+          case c: Compute[_] =>
+            c.start() match {
+              case cc: Compute[_] =>
+                loop(
+                  cc.start().asInstanceOf[L],
+                  cc.run.asInstanceOf[C] :: c.run.asInstanceOf[C] :: fs)
+              case xx =>
+                loop(c.run(xx.unsafePerformIO()), fs)
+            }
+          case x =>
+            fs match {
+              case f :: fs => loop(f(x.unsafePerformIO()), fs)
+              case Nil => x.unsafePerformIO()
+            }
+        }
+      loop(this.asInstanceOf[L], Nil).asInstanceOf[A]
+    }
+  }
+
+}

core/src/main/scala/tut/felix/LiftIO.scala

@@ -0,0 +1,5 @@
+package tut.felix
+
+trait LiftIO[F[_]] {
+  def liftIO[A](ioa: IO[A]): F[A]
+}

core/src/main/scala/tut/felix/Monad.scala

@@ -0,0 +1,7 @@
+package tut.felix
+
+trait Monad[F[_]] {
+  def point[A](a: A): F[A]
+  def map[A, B](fa: F[A])(f: A => B): F[B]
+  def flatMap[A, B](fa: F[A])(f: A => F[B]): F[B]
+}

core/src/main/scala/tut/felix/Resource.scala

@@ -0,0 +1,12 @@
+package tut.felix
+
+trait Resource[A] {
+  def close(a: A): IO[Unit]
+}
+
+object Resource {
+  implicit def CloseableResource[A <: java.io.Closeable] =
+    new Resource[A] {
+      def close(a: A) = IO(a.close)
+    }
+}

core/src/main/scala/tut/felix/StateT.scala

@@ -0,0 +1,65 @@
+package tut.felix
+
+/** State monad transformer, derived from cats.data.StateT */
+final class StateT[F[_], S, A](val runF: F[S => F[(S, A)]]) extends Serializable {
+
+  def flatMap[B](fas: A => StateT[F, S, B])(implicit F: Monad[F]): StateT[F, S, B] =
+    StateT.applyF(F.map(runF) { sfsa =>
+      sfsa.andThen { fsa =>
+        F.flatMap(fsa) { case (s, a) =>
+          fas(a).run(s)
+        }
+      }
+    })
+
+  def map[B](f: A => B)(implicit F: Monad[F]): StateT[F, S, B] =
+    transform { case (s, a) => (s, f(a)) }
+
+  def run(initial: S)(implicit F: Monad[F]): F[(S, A)] =
+    F.flatMap(runF)(f => f(initial))
+
+  def exec(s: S)(implicit F: Monad[F]): F[S] = F.map(run(s))(_._1)
+
+  def runA(s: S)(implicit F: Monad[F]): F[A] = F.map(run(s))(_._2)
+
+  def transform[B](f: (S, A) => (S, B))(implicit F: Monad[F]): StateT[F, S, B] =
+    StateT.applyF(
+      F.map(runF) { sfsa =>
+        sfsa.andThen { fsa =>
+          F.map(fsa) { case (s, a) => f(s, a) }
+        }
+      })
+
+}
+
+object StateT {
+
+  def apply[F[_], S, A](f: S => F[(S, A)])(implicit F: Monad[F]): StateT[F, S, A] =
+    new StateT(F.point(f))
+
+  def applyF[F[_], S, A](runF: F[S => F[(S, A)]]): StateT[F, S, A] =
+    new StateT(runF)
+
+  def point[F[_], S, A](a: A)(implicit F: Monad[F]): StateT[F, S, A] =
+    StateT(s => F.point((s, a)))
+
+  def modify[F[_], S](f: S => S)(implicit F: Monad[F]): StateT[F, S, Unit] =
+    StateT(s => F.point((f(s), ())))
+
+  def get[F[_], S](implicit F: Monad[F]): StateT[F, S, S] =
+    StateT(s => F.point((s, s)))
+
+  implicit def monadStateT[F[_]: Monad, S]: Monad[({ type λ[α] = StateT[F, S, α] })#λ] =
+    new Monad[({ type λ[α] = StateT[F, S, α] })#λ] {
+      def point[A](a: A): StateT[F,S,A] = StateT.point(a)
+      def map[A, B](fa: StateT[F,S,A])(f: A => B): StateT[F,S,B] = fa.map(f)
+      def flatMap[A, B](fa: StateT[F,S,A])(f: A => StateT[F,S,B]) = fa.flatMap(f)
+    }
+
+  implicit def liftIOStateT[F[_]: Monad, S](implicit ev: LiftIO[F]): LiftIO[({ type λ[α] = StateT[F, S, α] })#λ] =
+    new LiftIO[({ type λ[α] = StateT[F, S, α] })#λ] {
+      def liftIO[A](ioa: IO[A]): StateT[F,S,A] =
+        StateT[F, S, A](s => ev.liftIO(ioa.map((s, _))))
+    }
+
+}