Wrapper for Free monads that (at least I thought) makes them more usable. Different languages can be composed at will (without manual lifting). Runners should have all the used types in the composed program, but they do not have to be in the same order.

0_Program.scala

package test

import scala.language.higherKinds

case class Program[F[_], A](free: Free[F, A]) {

  import Coproduct.|

  def flatMap[G[_], B](f: A => Program[G, B])(
    implicit c: F | G): Program[c.Out, B] =
    Program(free
      .mapSuspension(c.transformLeft)
      .flatMap(f andThen (_.free.mapSuspension(c.transformRight))))

  def map[B](f: A => B): Program[F, B] =
    Program(free.map(f))

  def run[G[_]: Free.Monad](transform: F ~> G): G[A] =
    free.foldMap(transform)
}

1_Free.scala

package test

import scala.language.higherKinds

trait Free[F[_], A] {

  def flatMap[B](f: A => Free[F, B]): Free[F, B] =
    this match {
      case Apply(a) => f(a)
      case FlatMap(i, k) =>
        FlatMap(i, k andThen (_ flatMap f))
    }

  def map[B](f: A => B): Free[F, B] =
    flatMap(a => Apply(f(a)))

  def mapSuspension[G[_]](implicit transform: F ~> G): Free[G, A] =
    this match {
      case Apply(a) => Apply(a)
      case FlatMap(i, k) =>
        FlatMap(transform(i), k andThen (_.mapSuspension))
    }

  def foldMap[G[_]: Free.Monad](transform: F ~> G): G[A] = {
    val G = Free.Monad[G]
    this match {
      case Apply(a) => G(a)
      case FlatMap(fa, f) =>
        G.flatMap(transform(fa), f andThen (_ foldMap transform))
    }
  }
}

object Free {

  def apply[F[_], A](f: F[A]): Free[F, A] = FlatMap(f, Apply(_: A))

  type Id[x] = x

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

  object Monad {
    def apply[F[_]: Monad]: Monad[F] = implicitly

    type Id[x] = x

    implicit val idMonad =
      new Monad[Id] {
        def apply[A](a: A) = a
        def flatMap[A, B](a: Id[A], f: A => Id[B]) = f(a)
      }

    implicit def freeMonad[F[_]] =
      new Monad[({ type T[x] = Free[F, x] })#T] {
        def apply[A](a: A) = Apply(a)
        def flatMap[A, B](fa: Free[F, A], f: A => Free[F, B]) = fa flatMap f
      }
  }
}

case class Apply[F[_], A](value: A) extends Free[F, A]

case class FlatMap[F[_], A, B](input: F[A], f: A => Free[F, B]) extends Free[F, B]

2_Coproduct.scala

package test

import scala.language.higherKinds
import scala.language.implicitConversions
import scala.annotation.implicitNotFound

/*
 * When we define this as Coproduct[F[_], G[_], x] implicit 
 * resolution falters in combination with partial application
 * like this: ({type T[x] = Coproduct[F, G, x]})#T 
 * 
 * For nested Coproducts, the X[_] will not match the partially applied
 * Coproduct.   
 */
class Co[Head[_], Tail[_]] {

  type T[x] = Product[x]

  case class Product[x](value: Either[Head[x], Tail[x]])(
    implicit ev: Coproduct.NotAtLeft[Head])

}

object Co {
  def apply[Head[_], Tail[_]] = new Co[Head, Tail]
}

object Coproduct {

  def apply[Head[_], Tail[_], x](value: Either[Head[x], Tail[x]])(
    implicit ev: Coproduct.NotAtLeft[Head]) = Co[Head, Tail].Product(value)

  trait Is[F[_]]

  object Is {
    implicit def coproduct[Head[_], Tail[_]]: Is[Co[Head, Tail]#Product] = null
  }

  @implicitNotFound("There can be no coproducts on the left, import Coproduct.proof._ if this is wrong, found: ${F}")
  type NotAtLeft[F[_]] = IsNotCoproduct[F]

  type IsNotCoproduct[F[_]] = IsNot[F]

  trait IsNot[F[_]]

  object IsNot {
    /*
       For types that are a coproduct we provide an ambigous IsNot
       value, this makes the real one unusable
     */
    implicit def isCoproduct[F[_]](implicit ev: Is[F]): IsNot[F] = null
    implicit def isNotCoproduct[F[_]]: IsNot[F] = null
    implicit def nothingIsNotCoproduct: IsNot[Nothing] = null
  }

  type ::[Head[_], Tail[_]] = Co[Head, Tail]

  trait contains[List[_], Elem[_]]

  object contains {

    implicit def atHead[Head[_], Tail[_]]: (Head :: Tail)#T contains Head = null

    implicit def inTail[Elem[_], Head[_], Tail[_]](
      implicit ev: Tail contains Elem): (Head :: Tail)#T contains Elem = null

    implicit def isElem[Elem[_]]: Elem contains Elem = null
  }

  trait union[Left[_], Right[_]] {
    type Out[_]
  }

  trait LowestPriorityUnion {

    implicit def pair[Left[_], Right[_]](
      implicit ev: IsNotCoproduct[Left]): (Left union Right) {
      type Out[x] = (Left :: Right)#T[x]
    } = null

    implicit def headNotInRight[Head[_], Tail[_], Right[_]](
      implicit tailRightUnion: Tail union Right): ((Head :: Tail)#T union Right) {
      type Out[x] = (Head :: tailRightUnion.Out)#T[x]
    } = null
  }

  trait LowerPriorityUnion extends LowestPriorityUnion {

    implicit def headInRight[Head[_], Tail[_], Right[_]](
      implicit ev: Right contains Head,
      tailRightUnion: Tail union Right): ((Head :: Tail)#T union Right) {
      type Out[x] = tailRightUnion.Out[x]
    } = null
  }

  object union extends LowerPriorityUnion {

    // this crashes the compiler
    //type Aux[Left[_], Right[_], O[_]] = (Left union Right) { type Out[x] = O[x] }
    trait Aux[Left[_], Right[_], O[_]]
    object Aux {
      implicit def proxy[Left[_], Right[_]](
        implicit u: Left union Right): Aux[Left, Right, u.Out] = null
    }

    implicit def leftContainsRight[Head[_], Tail[_], Right[_]](
      implicit ev: (Head :: Tail)#T contains Right): ((Head :: Tail)#T union Right) {
      type Out[x] = (Head :: Tail)#T[x]
    } = null

    implicit def rightContainsLeft[Left[_], Head[_], Tail[_]](
      implicit ev: (Head :: Tail)#T contains Left): (Left union (Head :: Tail)#T) {
      type Out[x] = (Head :: Tail)#T[x]
    } = null

    implicit def same[Elem[_]]: (Elem union Elem) {
      type Out[x] = Elem[x]
    } = null
  }

  trait IsIdentity[F[_]]
  object IsIdentity {
    type Id[x] = x
    implicit def identity[F[_]](implicit ev: F[_] =:= Id[_]): IsIdentity[F] = null
  }

  trait IsNotIdentity[F[_]]
  object IsNotIdentity {
    implicit def identity[F[_]](implicit ev: IsIdentity[F]): IsNotIdentity[F] = null
    implicit def notIdentity[F[_]]: IsNotIdentity[F] = null
  }

  trait LowerPriorityTransformations {

    implicit def identity[Elem[_]](
      implicit ev: IsNotIdentity[Elem]) =
      new (Elem ~> Elem) {
        def apply[x](elem: Elem[x]) = elem
      }

    implicit def atHead[Elem[_], Tail[_]](
      implicit ev: IsNotCoproduct[Elem]) =
      new (Elem ~> (Elem :: Tail)#T) {

        def apply[x](elem: Elem[x]) =
          new (Elem :: Tail).Product(Left(elem))
      }

    implicit def inTail[Elem[_], Head[_], Tail[_]](
      implicit ev1: IsNotCoproduct[Elem],
      ev2: IsNotCoproduct[Head],
      transformTail: Elem ~> Tail) =
      new (Elem ~> (Head :: Tail)#T) {
        def apply[x](elem: Elem[x]) =
          new (Head :: Tail).Product(Right(transformTail(elem)))
      }
  }

  /*
  trait ValueProjector[Elem[_], Target[_]] {
    def project[x](target: Target[x]): Option[Elem[x]]
  }

  type <~[Elem[_], Target[_]] = ValueProjector[Elem, Target]

  object ValueProjector {
    implicit def same[Elem[_]] =
      new (Elem <~ Elem) {
        def project[x](target: Elem[x]) = Some(target)
      }

    implicit def atHead[Elem[_], Tail[_]] =
      new (Elem <~ (Elem :: Tail)#T) {
        def project[x](target: (Elem :: Tail)#T[x]) =
          target.value.left.toOption
      }

    implicit def inTail[Elem[_], Head[_], Tail[_]](
      tailProjector: Elem <~ Tail) =
      new (Elem <~ (Head :: Tail)#T) {
        def project[x](target: (Head :: Tail)#T[x]) = {
          val tail = target.value.right.toOption
          tail.flatMap(tailProjector.project)
        }
      }
  }
  */

  object Transformations extends LowerPriorityTransformations {

    implicit def elemIsCoProduct[Elem[_], Tail[_], Target[_]](
      implicit transformHead: Elem ~> Target,
      transformTail: Tail ~> Target) =
      new ((Elem :: Tail)#T ~> Target) {
        def apply[x](elem: (Elem :: Tail)#T[x]) =
          elem.value match {
            case Left(head) => transformHead(head)
            case Right(tail) => transformTail(tail)
          }
      }

    implicit def transformSource[F[_], Target[_], G[_]](fToTarget: F ~> Target)(
      implicit transform: G ~> F) =
        new (G ~> Target) {
          def apply[x](g: G[x]) = fToTarget(transform(g))
        }

    implicit def transformTarget[F[_], Source[_], G[_]](
      implicit transform: F ~> G) =
      (sourceToF: Source ~> F) =>
        new (Source ~> G) {
          def apply[x](g: Source[x]) = transform(sourceToF(g))
        }
  }

  implicit class TranformationEnhancement[Tail[_], Target[_]](fg: Tail ~> Target) {
    def or[T[_], Head[_]](hg: Head ~> T)(implicit ev: Head ~> T => Head ~> Target) =
      new ((Head :: Tail)#T ~> Target) {
        def apply[x](elem: (Head :: Tail)#T[x]) =
          elem.value match {
            case Left(head) => ev(hg) apply head
            case Right(tail) => fg(tail)
          }
      }
  }

  type |[Left[_], Right[_]] = Combined[Left, Right]

  trait Combined[Left[_], Right[_]] {
    type Out[_]
    def transformLeft: Left ~> Out
    def transformRight: Right ~> Out
  }

  trait LowerPriorityCombined {
    implicit def combine[Left[_], Right[_], O[_]](
      implicit u: union.Aux[Left, Right, O],
      l: Left ~> O,
      r: Right ~> O) =
      new (Left | Right) {
        type Out[x] = O[x]
        val transformLeft = l
        val transformRight = r
      }
  }

  object Combined extends LowerPriorityCombined {
    implicit def single[Elem[_]] =
      new (Elem | Elem) {
        type Out[x] = Elem[x]

        val transformLeft = Transformations.identity[Elem]
        val transformRight = Transformations.identity[Elem]
      }
  }
}

3_NaturalTransformation.scala

package test

import scala.language.higherKinds

trait NaturalTransformation[-F[_], +G[_]] {
  def apply[x](f: F[x]): G[x]
}

4_package.scala

import scala.language.higherKinds

package object test {

  type ~>[-F[_], +G[_]] = NaturalTransformation[F, G]

  type <~[+G[_], -F[_]] = NaturalTransformation[F, G]
  
}

5_test.scala

package test

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

trait T1[A]
case class Test1(a: String) extends T1[String]
trait T2[A]
case class Test2(a: Int) extends T2[Int]
trait T3[A]
case class Test3(a: Boolean) extends T3[Boolean]
trait T4[A]
case class Test4(a: Double) extends T4[Double]

object test {

  import Coproduct.Transformations._
  import Coproduct.IsIdentity
  import Coproduct.TranformationEnhancement

  //implicit def toFree[F[_], A](f: F[A]) = Free(f)

  implicit def toProgram[F[_], A](fa:F[A]):Program[F, A] = 
    Program(Free(fa))
  
  type Id[x] = x

  object T1Runner extends (T1 ~> Id) {
    def apply[x](f: T1[x]) =
      f match {
        case Test1(x) => x
      }
  }
  object T2Runner extends (T2 ~> Id) {
    def apply[x](f: T2[x]) =
      f match {
        case Test2(x) => x
      }
  }
  object T3Runner extends (T3 ~> Option) {
    def apply[x](f: T3[x]) =
      f match {
        case Test3(x) => Some(x)
      }
  }

  val t1 = Test1("a")
  val t2 = Test2(2)
  val t3 = Test3(true)

  val program = for {
    b <- t2
    a <- t1
    c <- t3
    d <- t2
  } yield a + b + c + d

  implicit val optionToId =
    new (Option ~> Id) {
      def apply[x](o: Option[x]) = o.get
    }

  val runner = T1Runner or T2Runner or T3Runner

  val result = program.run(runner)
}

I think I can separate changing the suspention type (Free[F, A] to Free[X, B]) from the the flat map itself (Free[F, A] to Free[F, B)

Free is now a regular free monad.

I am not sure if the result is actually more usable.