template for implementing Monads that are executed using Free so they don't StackOverflowError

box.scala

package koto

import scalaz.{Comonad, Equal, Free, Functor, Scalaz }
import scalaz.syntax.equal._
import scalaz.syntax.monad._

object box extends Interpreted {
  trait Box[+A] extends HasFree[A] {
    def get: A = free.go { _.a }
  }

  object Box extends BoxInstances {
    def apply[A](a: A): Box[A] = a.point[Box]
  }

  type Op[+A] = BoxOp[A]
  type API[+A] = Box[A]

  val OpFunctor: Functor[BoxOp] = new Functor[BoxOp] {
    def map[A, B](box: BoxOp[A])(f: A => B) =
      BoxOp(f(box.a))
  }
  def toAPI[A]: Free[Op, A] => Box[A] = f =>
    new Box[A] {
      def free = f
    }

  case class BoxOp[+A](a: A)

  trait BoxInstances {
    implicit def BoxEqual[A]: Equal[Box[A]] =
      new Equal[Box[A]] {
        def equal(a1: Box[A], a2: Box[A]) =
          a1.get == a2.get
      }

    // for testing
    implicit object BoxComonad extends Comonad[Box] {
      def cobind[A, B](fa: Box[A])(f: Box[A] => B): Box[B] = f(fa).point[Box]
      def cojoin[A](a: Box[A]): Box[Box[A]] = a.point[Box]
      def copoint[A](p: Box[A]): A = p.get
      def map[A, B](fa: Box[A])(f: A => B): Box[B] = fa.map(f)
    }

    import Scalaz.Id
    
    object interpreter extends Interpreter[Id] {
      def apply[A](op: BoxOp[A]): Id[A] =
        op.a
    }
  }
}

interpreted.scala

package koto

import scalaz._
import Scalaz._

trait Interpreted {

  // the outer API type, must implement map
  trait HasFree[+A] {

    def map[B](f: A => B): API[B] =
      toAPI(free map f)

    def flatMap[B](f: A => API[B]): API[B] =
      toAPI(free flatMap (f(_).free))

    protected[Interpreted] def free: Free[Op, A]

    private[Interpreted] def resume: Resume[A] =
      free.resume match {
        case -\/(x) => Resume.Continue(x map toAPI)
        case \/-(x) => Resume.Terminate(x)
      }
  }

  type API[+A] <: HasFree[A]

  def toAPI[A]: Free[Op, A] => API[A]

  type Op[+_] // the inner op, impls
  implicit val OpFunctor: Functor[Op]

  trait Resumable[A] {
    def resume: Resume[A]
  }

  implicit object APIMonad extends Monad[API] {
    type FreeOp[A] = Free[Op, A]
    def point[A](a: => A): API[A] =
      toAPI(a.point[FreeOp])

    def bind[A, B](a: API[A])(f: A => API[B]): API[B] =
      a flatMap f

    override def map[A, B](a: API[A])(f: A => B): API[B] =
      a map f
  }

  def process[A, C[_]: Monad](interpret: Interpreter[C])(d: API[A]): C[A] =
    d.resume match {
      case Resume.Terminate(a) => a.point[C]
      case Resume.Continue(op) => interpret(op) >>= process(interpret)
    }

  trait Interpreter[R[_]] {
    def apply[A](op: Op[A]): R[A]
  }

  sealed trait Resume[+A] {
    import Resume._, Free._

    def map[B](f: A => B): Resume[B] =
      this match {
        case Continue(x)  => Continue(x map { _ map f })
        case Terminate(x) => Terminate(f(x))
      }

    def free: API[A] =
      toAPI {
        this match {
          case Continue(x)  => Suspend(x map { _.free })
          case Terminate(x) => Return(x)
        }
      }
  }

  object Resume {
    /** Continue in the Free */
    case class Continue[+A](op: Op[API[A]]) extends Resume[A]
    /** Terminate and return a */
    case class Terminate[+A](a: A) extends Resume[A]

    implicit object ResumeFunctor extends Functor[Resume] {
      def map[A, B](fa: Resume[A])(f: A => B) =
        fa map f
    }
  }
}

interpretedSpec.scala

package koto

import org.junit.runner.RunWith
import org.scalacheck.{ Arbitrary, Gen, Properties }
import org.specs2.{ ScalaCheck, Specification }
import org.specs2.main.{ ArgumentsArgs, ArgumentsShortcuts }
import org.specs2.matcher.Parameters
import box.Box
import koto.box.Box
import scalaz._
import scalaz.scalacheck.ScalazProperties.monad
import scalaz.syntax.comonad.ToComonadOps
import scalaz.syntax.monad.{ ApplicativeIdV, ToBindOps }
import org.specs2.runner.JUnitRunner

@RunWith(classOf[JUnitRunner])
class InterpretedSpec extends Specification with ArgumentsShortcuts with ArgumentsArgs with ScalaCheck {
  implicit def arbitraryBox[A: Arbitrary] =
    Arbitrary[Box[A]](Gen { _ => implicitly[Arbitrary[A]].arbitrary.sample.map { Box.apply } })

  def checkAll(props: Properties)(implicit p: Parameters) =
    s2"""
    ${props.name} must satisfy ${
      props.properties.map {
        case (name, prop) => s2"""    
        ${name ! check(prop)(p)} """
      }.reduce { _ append _ }
    }"""

  def is =
    s2"""
    The monadic interpreter should 
      implement Monad                                                                     ${checkAll(monad.laws[Box])}
      not blow out the stack                                                              ${noSoe}
  """
  def noSoe =
    loops[Box](10000) must beEqualTo(10000)
  // for some reason ScalaCheck doesn't appear to generate large enough posNums to get SOE for Id
  //Prop.forAll(Gen.posNum[Int]) { until: Int => loops[scalaz.Scalaz.Id](until) must beEqualTo(until) }

  def loops[C[_]: Monad: Comonad](until: Int): Int = {
    def loop(a: => C[Int]): C[Int] = {
      val c = a
      val i = c.copoint
      if (i >= until) c
      else c.flatMap(_ => loop((i + 1).point[C]))
    }
    loop(0.point[C]).copoint
  }
}