Branching with free monads

Test.scala

package test

import scala.language.implicitConversions
import scala.language.higherKinds

import scalaz.Free.FreeC
import scalaz.Free
import scalaz.Monad
import scalaz.Coyoneda

object Test {

  // Very much like EitherT, only using different types for type related stuff, see flatmap 
  case class Branch[F[_], L, R](value: F[Either[L, R]]) {
    /*
     * This flatMap allows you to change the L type
     * 
     * L1 >: L allows you to change the L type from Nothing to Something
     * Z => L1 allows you to flatMap with Branch[F, Nothing, R1] without changing 
     *         the L type
     */
    def flatMap[L1 >: L, R1, Z](f: R => Branch[F, Z, R1])(
        implicit ev: Z => L1, F: Monad[F]): Branch[F, L1, R1] = 
      Branch(F.bind(value)(_.fold(l => F.point(Left(l)), r => F.map(f(r).value)(_.left.map(ev)))))

    def map[R1](f: R => R1)(implicit F: Monad[F]): Branch[F, L, R1] =
      flatMap[L, R1, L](r => Branch(F.point(Right(f(r)))))

    def merge[A](implicit F: Monad[F], ev1: L => A, ev2: R => A): F[A] =
      F.map(value)(_.left.map(ev1).right.map(ev2).merge)
  }

  type Partial[F[_]] = {
    type Free[A] = FreeC[F, A]
  }

  type FreeBranch[F[_], L, R] = Branch[Partial[F]#Free, L, R]
  object FreeBranch {
    def apply[F[_], L, R](fa: FreeC[F, Either[L, R]]) =
      // Needs type annotation because Branch expects F[_] and Free is F[_, _]
      Branch[Partial[F]#Free, L, R](fa)
  }

  implicit def freeMonad[F[_]] = new Monad[Partial[F]#Free] {
    def point[A](a: => A): FreeC[F, A] =
      Free.point[Coyoneda.CoyonedaF[F]#A, A](a)

    def bind[A, B](fa: FreeC[F, A])(f: A => FreeC[F, B]) =
      fa.flatMap(f)
  }

  implicit def toFreeBranch[F[_], R](fa: F[R])(implicit ev: ToCorrectType[F[R], FreeBranch[F, Nothing, R]]) = ev(fa)

  trait ToCorrectType[I, O] {
    def apply(in: I): O
  }

  implicit def toBranch[F[_], L, R] =
    new ToCorrectType[F[R], FreeBranch[F, L, R]] {
      def apply(fr: F[R]) = FreeBranch(Free.liftFC(fr).map(Right(_):Either[L, R]))
    }

  implicit def toFree1[F[_], A, Z](implicit ev: Z => F[A]) =
    new ToCorrectType[Z, FreeC[F, A]] {
      def apply(z: Z) = Free.liftFC(ev(z))
    }
  implicit def same[F[_], A] =
    new ToCorrectType[FreeC[F, A], FreeC[F, A]] {
      def apply(fa: FreeC[F, A]) = fa
    }

  trait Result

  trait Action[T]
  case object Action0 extends Action[String]
  case class Action1(value: String) extends Action[Option[String]]
  case class Action2(value: String) extends Action[Result]

  implicit class OptionEnhancements[R, F[_]](right: F[Option[R]]) {
    def ifEmpty[L, Z](left: Z)(implicit ev: ToCorrectType[Z, FreeC[F, L]]): Branch[Partial[F]#Free, L, R] = {
      right.flatMap {
        case Some(r) => FreeBranch(freeMonad.point(Right(r):Either[L, R]))
        case None => FreeBranch(ev(left).map(Left(_):Either[L, R]))
      }
    }
  }

  def branchedProgram =
    for {
      value1 <- Action0
      value2 <- Action1(value1) ifEmpty otherProgram
      value3 <- Action1(value2) ifEmpty Action2(value2)
      result <- Action2(value2)
    } yield result

  def otherProgram: FreeC[Action, Result] = ???

  val program = branchedProgram.merge // FreeC[Action, Result]
}

This is sorcery!

Exactly what I needed. Thanks.