Lifting a stack of multiple monads at once in Scala. (like Monad Transformer)

MonadTrans.scala

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

trait Wrap[X] {
  type Out[_]
}

object Wrap {
  implicit def case0[M[_]]           = new Wrap[M[_]]     { type Out[a] = M[a]     }
  implicit def case1[M[_,_],A,B]     = new Wrap[M[A,B]]   { type Out[a] = M[A,a]   }
  implicit def case2[M[_,_,_],A,B,C] = new Wrap[M[A,B,C]] { type Out[a] = M[A,B,a] }
}

trait Apply[U[_[_]],X,A,W[_]] {
  type M[_]
  def apply():U[M]
}

object Apply {
  implicit def case0[U[_[_]],W[_]:U,T] = new Apply[U,W[T],T,W] {
    type M[a] = W[a]
    def apply():U[W] = implicitly[U[W]]
  }
  implicit def case1[U[_[_]],W[_,_],X,T](implicit w:Wrap[W[X,T]], ev:U[({ type λ[a] = W[X,a] })#λ]) = new Apply[U,W[X,T],T,w.Out] {
    type M[a] = W[X,a]
    def apply():U[M] = ev
  }
  implicit def case2[U[_[_]],W[_,_,_],X,Y,T](implicit w:Wrap[W[X,Y,T]], ev:U[({ type λ[a] = W[X,Y,a] })#λ]) = new Apply[U,W[X,Y,T],T,w.Out] {
    type M[a] = W[X,Y,a]
    def apply():U[M] = ev
  }
}

trait MonadTrans[X,M[_],A] {

  // [memo] `Z[_]` は何故か `({ type λ[X] = A[B[X]] })#λ` に単一化出来ない..
  type F[_]

  def bind[B](o:X, f: A => M[B]):F[B]
  def map[B](o:X, f: A => B):F[B]
}

object MonadTrans {
  implicit def case0[X,A,W[_]]
  (implicit ex:Apply[Monad,X,A,W]) = new MonadTrans[X,W,A]
  {
    type F[X] = ex.M[X]

    // 何故かキャストしまくらないとダメなんよ..
    def bind[B](o:X, f: A => W[B]):F[B] = ex().bind(o.asInstanceOf[F[A]])(f.asInstanceOf[A => F[B]])
    def map[B](o:X, f: A => B):F[B] = ex().map(o.asInstanceOf[F[A]])(f)
  }
  implicit def case1[M[_],W[_],X,A,T]
  (implicit ex:Apply[Monad,X,A,W], ev:MonadTrans[A,M,T]) = new MonadTrans[X,M,T]
  {
    type F[X] = ex.M[ev.F[X]]
    
    def bind[U](o:X, f: T => M[U]):F[U] = ex().map(o.asInstanceOf[ex.M[A]])(a => ev.bind(a, f))
    def map[U](o:X, f: T => U):F[U] = ex().map(o.asInstanceOf[ex.M[A]])(a => ev.map(a, f))
  }
}

trait GenMonadOps[M[_],A] {

  val lhs:M[A]

  // W[U] == V[U] の筈だが、何故かマッチしない(`V[U] =:= W[U]` は取れる)
  def flatMap[W[_],V[_],X,T,U](f: T => X)(implicit ex:Apply[Monad,X,U,V], ev:MonadTrans[M[A],W,T]):ev.F[U] = ev.bind(lhs, f.asInstanceOf[T => W[U]])

  def map[W[_],T,U](f: T => U)(implicit ev:MonadTrans[M[A],W,T]):ev.F[U] = ev.map(lhs, f)

  def withFilter[W[_],T](f: T => Boolean)(implicit ev:MonadTrans[M[A],W,T]):M[A] = lhs // <(^_^;)

}

implicit class MonadOps1[M[_],A](val lhs:M[A]) extends GenMonadOps[M,A]

implicit class MonadOps2[M[_,_],A,X](val lhs:M[X,A]) extends GenMonadOps[({ type λ[a] = M[X,a] })#λ,A]

implicit class MonadOps3[M[_,_,_],A,X,Y](val lhs:M[X,Y,A]) extends GenMonadOps[({ type λ[a] = M[X,Y,a] })#λ,A]

Usage.scala

object Main {
  def main(args:Array[String]) {
    
    // クロージャのパラメーターの型は推論出来ない？
    println( Maybe(IO(Maybe(IO(3)))).flatMap { a:IO[Int] => Maybe(a.run + a.run) }.get.run.get )
    println( Maybe(IO(IO(3))).flatMap { a:Int => IO(a * a) }.get.run.run )
    println( Maybe(IO(Maybe(5))).map { a:Int => a + a }.get.run.get )
    
    val a = IO(Maybe( Seq(1,2,3) ))
    val b = IO(Maybe( Seq[Int]() ))
    println( a.map((_:Maybe[Seq[Int]]).filter(_.nonEmpty)).run getOrElse Seq(0) )
    println( b.map((_:Maybe[Seq[Int]]).filter(_.nonEmpty)).run getOrElse Seq(0) )
    
    // `Reader[T,+A]` みたいな複数パラメーターもいける
    println( Reader { a:String => a.toInt }.map { b:Int => (b*b).toString }.run("10") )
    
    // コンパイルエラーが出てしまう・・・（上記の例で、型を省略したケースと同じような扱いに）
    // println((for {
    //   a:Int <- IO(Maybe(1))
    //   b:Int <- IO(Maybe(2))
    // } yield a + b).run.get)
  }
}

import scala.language.implicitConversions

// Maybe Monad
trait Maybe[+A] { lhs =>

  def get:A = getOrElse { throw new NoSuchElementException() }

  def getOrElse[B >: A](alt: => B):B = unlift(alt, a => a)

  def unlift[B](alt: => B, f: A => B):B

  def bind[B](f: A => Maybe[B]):Maybe[B] = new Maybe[B] {
    def unlift[C](alt: => C, g: B => C):C = lhs.unlift(alt, f(_).unlift(alt, g))
  }

  def filter(f: A => Boolean):Maybe[A] = unlift(Maybe(), a => if (f(a)) Maybe(a) else Maybe())

}

object Maybe {

  implicit def monad:Monad[Maybe] = new Monad[Maybe] {

    def pure[A](a: => A):Maybe[A] = Maybe(a)

    def bind[A,B](ma:Maybe[A])(f: A => Maybe[B]):Maybe[B] = ma.bind(f)

  }

  def apply[A](a: => A):Maybe[A] = new Maybe[A] {
    def unlift[B](alt: => B, f: A => B):B = f(a)
  }

  def apply[A]():Maybe[A] = new Maybe[A] {
    def unlift[B](alt: => B, f: A => B):B = alt
  }

  def unapply[A](o:Maybe[A]):Option[Tuple1[A]] = o.unlift(None, a => Some(Tuple1(a)))

}

// IO Monad
trait IO[+A] { lhs =>

  def run:A

  def bind[B](f: A => IO[B]):IO[B] = new IO[B] { def run:B = f(lhs.run).run }

}

object IO {

  implicit def monad:Monad[IO] = new Monad[IO] {

    def pure[A](a: => A):IO[A] = IO(a)

    def bind[A,B](ma:IO[A])(f: A => IO[B]):IO[B] = ma.bind(f)

  }

  def apply[A](a: => A):IO[A] = new IO[A] { def run:A = a }

}

// Reader Monad
trait Reader[T,+A] { lhs =>

  def run(o:T):A

  def bind[B](g: A => Reader[T,B]):Reader[T,B] =
    new Reader[T,B] {
      def run(o:T):B = g(lhs run o) run o
    }

}

object Reader {

  implicit def monad[T]:Monad[({ type λ[X] = Reader[T,X]})#λ] = new Monad[({ type λ[X] = Reader[T,X]})#λ] {

    def pure[A](a: => A):Reader[T,A] = Reader(_ => a)
    
    def bind[A,B](ma:Reader[T,A])(f: A => Reader[T,B]):Reader[T,B] = ma bind f

  }

  def apply[T,A](f: T => A):Reader[T,A] = new Reader[T,A] { def run(o:T):A = f(o) }

}