Freer monad in scala, just toying around.

freer.scala

trait Functor[F[_]] {
  def map[A, B](fa: F[A])(f: A => B): F[B]
}
trait Monad[F[_]] {
  def apply[A](a: A): F[A]
  def flatMap[A,B](fa: F[A])(f: A => F[B]): F[B]
}

sealed trait FFree[G[x], A] {}
case class FPure[G[x], A](data: A) extends FFree[G, A]
case class FImpure[G[x], A, B](data: G[A], effect: A => FFree[G,B]) extends FFree[G,B]


object FFree {

  def eta[G[x], A](fa : G[A]): FFree[G,A] =
    FImpure(fa, FPure.apply _)

  

  implicit def ffreeFunctor[G[x]]: Functor[({type L[x] = FFree[G,x]})#L] = 
    new Functor[({type L[x] = FFree[G,x]})#L] {
      def map[A, B](fa: FFree[G,A])(f: A => B): FFree[G,B] =
        fa match {
           case FPure(data) => FPure[G,B](f(data))
           case FImpure(data, effect) => 
             // here we chain the function onto the effect.  We may want to see if we can use some more complicated
             // way of doing this which would be more efficient...
             FImpure(data, /* (fmap f . effect) */  effect.andThen(out => map(out)(f)))
        }
    }

  implicit def ffreeMonad[G[x]]: Monad[({type L[x] = FFree[G,x]})#L] =
    new Monad[({type L[x] = FFree[G,x]})#L] {
      def apply[A](a: A): FFree[G,A] = FPure(a)
      def flatMap[A,B](fa: FFree[G,A])(f: A => FFree[G,B]): FFree[G,B] =
        fa match {
          case FPure(x) => f(x)
          // here we chain the function onto the effect.  We may want to see if we can use some more complicated
          // way of doing this which would be more efficient...
          case FImpure(data, effect) => FImpure(data, /* effect >>> f */effect.andThen(out => flatMap(out)(f)))
        }
    }

/*      (>>>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
     f >>> g = (>>= g) . f
*/
}




sealed trait State[S, X]
case class Get[S]() extends State[S,S]
case class Put[S](s: S) extends State[S, Unit]
object State {
  type FState[S,A] = FFree[({type L[x]=State[S,x]})#L, A]
  def get[S]: FState[S,S] = FFree.eta[({type L[x]=State[S,x]})#L, S](Get[S](): State[S,S])
  def put[S](s: S): FState[S,Unit] = FFree.eta[({type L[x]=State[S,x]})#L, Unit](Put(s): State[S,Unit])

  def test = {
    val m = FFree.ffreeMonad[({type L[x]=State[Int,x]})#L]
    val f = FFree.ffreeFunctor[({type L[x]=State[Int,x]})#L]
    val x = put(5)
    val y = f.map(x)(_ => "Hi")
    val z = m.flatMap(y) { _ => get[Int] }
    val z1 = f.map(z) { z => z + 1 }
    run(z1)(0)
  }
  def run[S, A](f: FState[S,A])(s: S): (S,A) = {
    /**unEffState :: StateEff s a -> (s -> (a,s))
     unEffState Get s     = (s,s)
     unEffState (Put s) _ = ((),s)*/
    def unEffState[X](s: State[S,X])(start: S): (S,X) =
      s match {
        case Get() => (start, start.asInstanceOf[X])
        case Put(x) => (x, ().asInstanceOf[X])
      }
    f match {
      case x: FPure[({type L[x]=State[S,x]})#L, A] => (s,x.data)
      case x: FImpure[({type L[x]=State[S,x]})#L, _, A] => 
        import x._
	/* runEffState (FImpure m q) s =
       let (x,s') = unEffState m s in runEffState (q x) s' */
        val (sp, nextData) = unEffState(data)(s)
        // TODO - trampoline and stuff.
        run(effect(nextData))(sp)
    }
  }
}

type-aligned-continuations.scala

import scala.language.higherKinds
import scala.language.existentials

/** A sequence of type aligned functions the look like an A => M[B]. */
sealed trait ContinuationQueue[M[_], A, B] {
  /** Appends another continuation queue to this one. */
  def ++[C](other: ContinuationQueue[M, B, C]): ContinuationQueue[M,A,C] =
    Node(this, other)
  /** Appends a new continuation to the queue. */
  def :+[C](f: B => M[C]): ContinuationQueue[M,A,C] =
    Node(this, Leaf(f))
}
/** A single continuation function. */
case class Leaf[M[_], A, B](f: A => M[B]) extends ContinuationQueue[M,A,B]
/** A chain of two continuation functions. */
case class Node[M[_], A, B, X](
  lhs: ContinuationQueue[M,A,X], 
  rhs: ContinuationQueue[M,X,B]) extends ContinuationQueue[M,A,B]
object ContinuationQueue {
  /** Constructs a continuation queue from a single continuation A => M[B]. */
  def singleton[M[_], A, B](f: A => M[B]): ContinuationQueue[M,A,B] = Leaf(f)
  /** Decomposes a continuation queue into head/tail components (lazily). */
  def leftView[M[_], A, B](queue: ContinuationQueue[M,A,B]): ContinuationListView[M,A,B] =
    queue match {
      case Leaf(f) => TOne(f)
      case Node(lhs, rhs) =>
        def go[X](lhs: ContinuationQueue[M,A,X], rhs: ContinuationQueue[M, X,B]): ContinuationListView[M,A,B] = 
          (lhs, rhs) match {
            case (Leaf(f), rhs) =>  TCons(f, rhs) 
            case (Node(l, l2), rhs) => go(l, l2 ++ rhs)
          }
        go(lhs,rhs)
    }
}

// TODO - Decompose ContinuationQueue Left->Right, such that we get:
// 1. Single (A => M[B])
// 2. head: A => M[X]), tail: ContinuationQueue[M,X,B]
sealed trait ContinuationListView[M[_], A, B]
case class TOne[M[_], A, B](f: A => M[B]) extends ContinuationListView[M,A,B]
case class TCons[M[_], A, B, C](head: A => M[B], tail: ContinuationQueue[M,B,C]) extends ContinuationListView[M,A,C]