EitherTKleisli

EitherTKleisli.scala

package smt.util

import scalaz.syntax.Ops
import scalaz._
import Kleisli._

object EitherTKleisli {

  type EitherTKleisli[M[+ _], D, E, A] = EitherT[({type λ[+α] = Kleisli[M, D, α]})#λ, E, A]

  trait EitherTKleisliOps[M[+ _], D, E, A] extends Ops[EitherTKleisli[M, D, E, A]] {

    def runE: D => EitherT[M, E, A] = (d: D) => EitherT(self.run(d))

    def >=>[B](k: EitherTKleisli[M, A, E, B])(implicit eb: Bind[({type λ[+α] = EitherT[M, E, α]})#λ]): EitherTKleisli[M, D, E, B] = {
      val syn = eitherTKleisliSyntax[M, A, E]
      import syn._
      EitherT[({type λ[+α] = Kleisli[M, D, α]})#λ, E, B](kleisli((d: D) => eb.bind(this.runE(d))(k.runE).run))
    }
  }

  trait EitherTKleisliSyntax[M[+ _], D, E] {
    implicit def toEitherTKleisliOps[A](v: EitherTKleisli[M, D, E, A]): EitherTKleisliOps[M, D, E, A] = new EitherTKleisliOps[M, D, E, A] {
      val self = v
    }
  }

  def eitherTKleisliSyntax[M[+ _], D, E]: EitherTKleisliSyntax[M, D, E] = new EitherTKleisliSyntax[M, D, E] {}
}

InProgess.scala

package smt.util

import scalaz.syntax.Ops
import scalaz._
import Kleisli._

object EitherTKleisli {

  type EitherTKleisli[M[+ _], D, E, A] = EitherT[({type λ[+α] = Kleisli[M, D, α]})#λ, E, A]

  trait EitherTKleisliOps[M[+ _], D, E, A] extends Ops[EitherTKleisli[M, D, E, A]] {

    def runE: D => EitherT[M, E, A] = (d: D) => EitherT(self.run(d))

    def >=>[B](k: EitherTKleisli[M, A, E, B])(implicit eb: Bind[({type λ[+α] = EitherT[M, E, α]})#λ]): EitherTKleisli[M, D, E, B] = {
      val syn = eitherTKleisliSyntax[M, A, E]
      import syn._
      EitherT[({type λ[+α] = Kleisli[M, D, α]})#λ, E, B](kleisli((d: D) => eb.bind(this.runE(d))(k.runE).run))
    }
  }

  trait EitherTKleisliSyntax[M[+ _], D, E] {
    implicit def toEitherTKleisliOps[A](v: EitherTKleisli[M, D, E, A]): EitherTKleisliOps[M, D, E, A] = new EitherTKleisliOps[M, D, E, A] {
      val self = v
    }
  }

  def eitherTKleisliSyntax[M[+ _], D, E]: EitherTKleisliSyntax[M, D, E] = new EitherTKleisliSyntax[M, D, E] {}
}

object Stack {

  /**
   * a typeclass that provides functions to stack a monad-transformer
   * and to unstack a monad-transformer
   * Data: the value type that the transformer expects
   * Stacked: the data tapye that results when the transformer is applied,
   * the first type-parameter is the underlying monad, the second parameter the value type
   */
  trait TStacking[Data[+_], Stacked[_[+_], +_]] {

    def stack[M[+_], A](m: M[Data[A]]): Stacked[M, A]

    def unstack[M[+_], A](s: Stacked[M, A]): M[Data[A]]
  }

  trait EitherTStackingTypes[E] {
    type Data[+A] = E \/ A

    type Stacked[M[+_], +A] = EitherT[M, E, A]
  }

  def EitherTStacking[E]: TStacking[EitherTStackingTypes[E]#Data, EitherTStackingTypes[E]#Stacked] = new TStacking[EitherTStackingTypes[E]#Data, EitherTStackingTypes[E]#Stacked] {

    def stack[M[+ _], A](m: M[EitherTStackingTypes[E]#Data[A]]): EitherTStackingTypes[E]#Stacked[M, A] = EitherT[M, E, A](m)

    def unstack[M[+ _], A](s: EitherTStackingTypes[E]#Stacked[M, A]): M[EitherTStackingTypes[E]#Data[A]] = s.run
  }

  /**
   * @tparam Data - the data type that the transformer expects
   *              e.g. for EitherT: Data[+A] = E \/ A,
   *              for WriterT:  Data[+A] = (W, A),
   *              for StateT: Data[+A] = (S, A)
   *              for Kleisli: Data[+A] = A
   * @tparam Stacked - the type that results when applying the transformer
   *                 e.g for EitherT: Stacked[M[+_], +A] = EitherT[M, E, A],
   *                 for WriterT: Stacked[M[+_], +A] = WriterT[M, W, A]
   *                 for StateT: Stacked[M[+_], +A] = StateT[M, S, A]
   *                 for Kleisli: Stacked[M[+_], +A] = Kleisli[M, De, A]
   * @tparam Shape - the type that is needed to construct the transformer, where the argument for D will always be 'Data'
   *               e.g for EitherT: Shape[M[+_], D[+_], A] = M[D[A]]
   *               for WriterT: Shape[M[+_], D[+_], A] = M[D[A] ]
   *               for StateT: Shape[M[+_], D[+_], A] = S => M[D[A]]
   *               for Kleisli: Shape[M[+_], D[+_], A] = De => M[D[A]]
   */
  trait TStacking2[Data[+_], Stacked[_[+_], +_], Shape[_[+_], _[+_], +_]] {

    def stack[M[+_], A](m: Shape[M, Data, A]): Stacked[M, A]

    def unstack[M[+_], A](s: Stacked[M, A]): Shape[M, Data, A]

    def mapShape[M[+_], N[+_], A](m: Shape[M, Data, A])(f: M[A] => N[A]): Shape[N, Data, A] // similar to hoist?
  }

  trait Experiment {
    type Data[+_]
    type Stacked[_[+_], +_]
    type Shape[_[+_], _[+_], +_]

    val TS: TStacking2[Data, Stacked, Shape]

    type D

    trait For[M[+_]] {
      type Kλ[+α] =  Kleisli[M, D, α]
      type Shape[+α] = D => M[α]
    }

    type TKleisli[M[+_], D, +A] = Stacked[({type λ[+α] = Kleisli[M, D, α]})#λ, A]

    def unstackBoth[M[+_], A](s: Stacked[For[M]#Kλ, A]) = {
      val us: Shape[For[M]#Kλ, Data, A] = TS.unstack[For[M]#Kλ, A](s)
      val mus: Shape[For[M]#Shape, Data, A] = TS.mapShape[For[M]#Kλ, For[M]#Shape, A](us)((k: For[M]#Kλ[A]) => (d: D) => k.run(d))
    }
  }

  trait StateTStackingTypes[S] {
    type Data[+A] = (S, A)

    type Shape[M[+_], D[+_], A] = S => M[D[A]]

    type Stacked[M[+_], +A] = StateT[M, S, A]
  }

  class TKleisli[Data[+_], Stacked[_[+_], +_]](S: TStacking[Data, Stacked]) {

    type TKleisli[M[+_], D, +A] = Stacked[({type λ[+α] = Kleisli[M, D, α]})#λ, A]

    trait TKleisliOps[M[+ _], D, E, A] extends Ops[TKleisli[M, D, A]] {

      def runE: D => Stacked[M, A] = (d: D) => S.stack(S.unstack[({type λ[+α] = Kleisli[M, D, α]})#λ, A](self)(d))

      def runE2: Kleisli[({type λ[+α] = Stacked[M, α]})#λ, D, A] = {
        val un: Kleisli[M, D, Data[A]] = S.unstack[({type λ[+α] = Kleisli[M, D, α]})#λ, A](self)
        un.mapK[({type λ[+α] = Stacked[M, α]})#λ, A]((m: M[Data[A]]) => S.stack(m))
      }

      def >=>[B](k: TKleisli[M, A, B])(implicit eb: Bind[({type λ[+α] = Stacked[M, α]})#λ]): TKleisli[M, D, B] = {
        val syn = tKleisliSyntax[M, A, E]
        import syn._
        S.stack[({type λ[+α] = Kleisli[M, D, α]})#λ, B](kleisli((d: D) => S.unstack(eb.bind(this.runE(d))(k.runE))))
      }
    }

    trait TKleisliSyntax[M[+ _], D, E] {
      implicit def toTKleisliOps[A](v: TKleisli[M, D, A]): TKleisliOps[M, D, E, A] = new TKleisliOps[M, D, E, A] {
        val self = v
      }
    }

    def tKleisliSyntax[M[+ _], D, E]: TKleisliSyntax[M, D, E] = new TKleisliSyntax[M, D, E] {}
  }

}

object Test extends App {
  import Stack._

  //  val x: EitherTStackingTypes[String]#Stacked[Option, Int] = EitherT(Some(\/-(3)))
  //  val ue: Option[String \/ Int] = e.unstack(x)

  val e = EitherTStacking[String]
  val k = new TKleisli[EitherTStackingTypes[String]#Data, EitherTStackingTypes[String]#Stacked](e)

  val synt = k.tKleisliSyntax[Option, Int, Int]

  import synt._
  import _root_.scalaz.Scalaz._

  val eithKl = EitherT[({type l[+a] = Kleisli[Option, Int, a]})#l, String, Int](kleisli((x: Int) => Option(\/-(2 * x))))

  val mult = eithKl >=> eithKl
  println(mult.run.apply(3))
}


object WriterTKleisli {

  type WriterTKleisli[M[+ _], D, W, A] = WriterT[({type λ[+α] = Kleisli[M, D, α]})#λ, W, A]

  trait WriterTKleisliOps[M[+ _], D, W, A] extends Ops[WriterTKleisli[M, D, W, A]] {

    def runE: D => WriterT[M, W, A] = (d: D) => WriterT(self.run(d))

    def >=>[B](k: WriterTKleisli[M, A, W, B])(implicit eb: Bind[({type λ[+α] = WriterT[M, W, α]})#λ]): WriterTKleisli[M, D, W, B] = {
      val syn = eitherTKleisliSyntax[M, A, W]
      import syn._
      WriterT[({type λ[+α] = Kleisli[M, D, α]})#λ, W, B](kleisli((d: D) => eb.bind(this.runE(d))(k.runE).run))
    }
  }

  trait WriterTKleisliSyntax[M[+ _], D, W] {
    implicit def toWriterTKleisliOps[A](v: WriterTKleisli[M, D, W, A]): WriterTKleisliOps[M, D, W, A] = new WriterTKleisliOps[M, D, W, A] {
      val self = v
    }
  }

  def eitherTKleisliSyntax[M[+ _], D, W]: WriterTKleisliSyntax[M, D, W] = new WriterTKleisliSyntax[M, D, W] {}
}

object StateTKleisli {

  type StateTKleisli[M[+ _], D, S, A] = StateT[({type λ[+α] = Kleisli[M, D, α]})#λ, S, A]

  trait StateTKleisliOps[M[+ _], D, S, A] extends Ops[StateTKleisli[M, D, S, A]] {

    def runE: D => StateT[M, S, A] = (d: D) => {
      val sel: StateTKleisli[M, D, S, A] = self
      val sRun: S => Kleisli[M, D, (S, A)] = (s: S) => sel.run(s)

      val kRun: S => M[(S, A)] = (s: S) => sRun(s).run(d)

      StateT(kRun)
    }

    def runE2: Kleisli[({type λ[+α] = StateT[M, S, α]})#λ, D, A] = {
      val un: S => Kleisli[M, D, (S, A)] = (s: S) => self.run(s)
      val unun1: S => D => M[(S, A)] = (s: S) => (d: D) => un(s).run(d)
      val unun: D => S => M[(S, A)] = (d: D) => (s: S) => un(s).run(d)
      val ununS: D => StateT[M, S, A] = (d: D) => StateT(unun(d))
      val ununKS: Kleisli[({type λ[+α] = StateT[M, S, α]})#λ, D, A] = kleisli[({type λ[+α] = StateT[M, S, α]})#λ, D, A](ununS)
      ununKS
    }

    def >=>[B](k: StateTKleisli[M, A, S, B])(implicit eb: Bind[({type λ[+α] = StateT[M, S, α]})#λ]): StateTKleisli[M, D, S, B] = {
      val syn = stateTKleisliSyntax[M, A, S]
      import syn._
      StateT[({type λ[+α] = Kleisli[M, D, α]})#λ, S, B]((s: S) => kleisli((d: D) => eb.bind(this.runE(d))(k.runE).run(s)))
    }
  }

  trait StateTKleisliSyntax[M[+ _], D, S] {
    implicit def toStateTKleisliOps[A](v: StateTKleisli[M, D, S, A]): StateTKleisliOps[M, D, S, A] = new StateTKleisliOps[M, D, S, A] {
      val self = v
    }
  }

  def stateTKleisliSyntax[M[+ _], D, S]: StateTKleisliSyntax[M, D, S] = new StateTKleisliSyntax[M, D, S] {}
}

runE2Signature.scala

  // EitherT[({type λ[+α] = Kleisli[M, D, α]})#λ, E, A]
  // =>
  // Kleisli[({type λ[+α] = EitherT[M, E, α]})#λ, D, A]

  // StateT[({type λ[+α] = Kleisli[M, D, α]})#λ, S, A]
  // =>
  // Kleisli[({type λ[+α] = StateT[M, S, α]})#λ, D, A]