Expeirmental Functor,Monad,Applicative implementation that supports MTL

mtl.scala

import scala.annotation.tailrec
import scala.language.higherKinds

object jazz {

  trait Functor[F[_]] {
    def fmap[A,B](value: F[A])(func: A => B): F[B]
  }

  abstract class Applicative[F[_]](val functor: Functor[F]) extends Functor[F] {
    def pure[A](a: A): F[A]

    def ap[A,B](value: F[A])(func: F[A => B]): F[B]

    def fmap[A,B](value: F[A])(func: A => B): F[B] = functor.fmap(value)(func)
  }

  abstract class Monad[F[_]](val applicative: Applicative[F]) extends Applicative[F](applicative.functor) {
    def bind[A,B](value: F[A])(func: A => F[B]): F[B]

    def pure[A](a: A) = applicative.pure(a)
    def ap[A,B](value: F[A])(func: F[A => B]): F[B] = applicative.ap(value)(func)
  }

  /**
   * The famous monads
   */
  type Identity[A] = A

  /****************************************************************************
   ******************************** OPTION ************************************
   ***************************************************************************/

  implicit lazy val optionFunctor: Functor[Option] = new Functor[Option] {
    def fmap[A,B](value: Option[A])(func: A => B): Option[B] = {
      value match {
        case None => None
        case Some(a) => Some(func(a))
      }
    }
  }

  implicit lazy val optionApplicative: Applicative[Option] = new Applicative[Option](optionFunctor) {

    def pure[A](a: A): Option[A] = Some(a)

    def ap[A,B](value: Option[A])(func: Option[A => B]): Option[B] = {
      func match {
        case None => None
        case Some(f) => functor.fmap(value)(f)
      }
    }
  }

  implicit lazy val optionMonad: Monad[Option] = new Monad[Option](optionApplicative) {
    def bind[A,B](value: Option[A])(func: A => Option[B]): Option[B] = {
      value match {
        case None => None
        case Some(a) => func(a)
      }
    }
  }

  /****************************************************************************
   ******************************** EITHER ************************************
   ***************************************************************************/

  type AnEither[A] = Either[String, A]

  val eitherFunctorInst: Functor[AnEither] = new Functor[AnEither] {
    def fmap[A,B](value: Either[String,A])(func: A => B): Either[String, B] = {
      value match {
        case Left(e) => Left(e)
        case Right(a) => Right(func(a))
      }
    }
  }

  type CurriedEither[Error] = {
    type E[A] = Either[Error, A]
  }

  //implicit def eitherFunctor[Error] = new Functor[({type E[A] = Either[Error,A]})#E] {
  implicit def eitherFunctor[Error] = new Functor[CurriedEither[Error]#E] {
    def fmap[A,B](value: Either[Error,A])(func: A => B): Either[Error, B] = {
      value match {
        case Left(e) => Left(e)
        case Right(a) => Right(func(a))
      }
    }
  }

  implicit def eitherApplicative[Error] = new Applicative[CurriedEither[Error]#E](eitherFunctor) {
    def pure[A](a: A): Either[Error, A] = Right(a)

    def ap[A,B](value: Either[Error, A])(func: Either[Error, A => B]): Either[Error, B] = {
      func match {
        case Left(e) => Left(e)
        case Right(f) => functor.fmap(value)(f)
      }
    }
  }

  implicit def eitherMonad[Error] = new Monad[CurriedEither[Error]#E](eitherApplicative) {
    def bind[A,B](value: Either[Error, A])(func: A => Either[Error,B]): Either[Error,B] = {
      value match {
        case Left(e) => Left(e)
        case Right(a) => func(a)
      }
    }
  }

  /****************************************************************************
   ********************************  LIST  ************************************
   ***************************************************************************/

  implicit val listFunctor = new Functor[List] {
    @tailrec private def loop[A,B](value: List[A], func: A => B, acc: List[B]): List[B] = {
      value match {
        case Nil => acc.reverse
        case head :: tail => loop(tail, func, func(head) :: acc)
      }
    }

    def fmap[A,B](value: List[A])(func: A => B): List[B] = {
      loop(value, func, Nil)
    }
  }

  val zipListApplicative = new Applicative[List](listFunctor) {
    def pure[A](a: A): List[A] = a :: Nil

    def ap[A,B](value: List[A])(func: List[A => B]): List[B] = {
      functor.fmap(value.zip(func)){ case (a,f) => f(a) }
    }
  }

  implicit val listApplicative = new Applicative[List](listFunctor) {
    def pure[A](a: A): List[A] = a :: Nil

    @tailrec private def loop[A,B](copy: List[A], value: List[A], func: List[A => B], acc: List[B]): List[B] = {
      value match {
        case Nil => {
          func match {
            case Nil => acc.reverse
            case _ :: tailFuncs => loop(copy, copy, tailFuncs, acc)
          }
        }
        case head :: tail => {
          func match {
            case Nil => ???
            case headFunc :: _ => loop(copy, tail, func, headFunc(head) :: acc)
          }
        }
      }
    }

    def ap[A,B](value: List[A])(func: List[A => B]): List[B] = loop(value, value, func, Nil)
  }

  implicit lazy val listMonad = new Monad[List](listApplicative) {
    @tailrec private def loop[A,B](value: List[A], func: A => List[B], acc: List[B], acc2: List[B]): List[B] = {
      acc2 match {
        case Nil =>
          value match {
            case Nil => acc.reverse
            case head :: tail => loop(tail, func, acc, func(head))
          }
        case head :: tail => loop(value, func, head :: acc, tail)
      }
    }

    def bind[A,B](value: List[A])(func: A => List[B]): List[B] = {
      loop(value, func, Nil, Nil)
    }
  }

  /****************************************************************************
   ******************************** READER ************************************
   ***************************************************************************/

  case class Reader[R,A](f: R => A)

  type CurriedReader[R] = {
    type F[A] = Reader[R,A]
  }

  implicit def readerFunctor[R] = new Functor[CurriedReader[R]#F] {
    def fmap[A,B](value: Reader[R,A])(func: A => B): Reader[R,B] = {
      Reader(r => func(value.f(r)))
    }
  }

  implicit def readerApplicative[R] = new Applicative[CurriedReader[R]#F](readerFunctor[R]) {
    def pure[A](a: A): Reader[R,A] = Reader(r => a)

    def ap[A,B](value: Reader[R,A])(func: Reader[R, A => B]): Reader[R,B] = {
      Reader({r =>
        val a = value.f(r)
        val f = func.f(r)
        f(a)
      })
    }
  }

  implicit def readerMonad[R] = new Monad[CurriedReader[R]#F](readerApplicative[R]) {
    def bind[A,B](value: Reader[R,A])(func: A => Reader[R,B]): Reader[R,B] = {
      Reader({r =>
        val a: A = value.f(r)
        val readerB: Reader[R,B] = func(a)
        readerB.f(r)
      })
    }
  }

  /****************************************************************************
   ******************************** STATE *************************************
   ***************************************************************************/
  case class State[S,A](action: S => (A, S))

  type CurriedState[S] = {
    type F[A] = State[S,A]
  }

  implicit def stateFunctor[S] = new Functor[CurriedState[S]#F] {
    def fmap[A,B](value: State[S,A])(func: A => B): State[S,B] = {
      State({ s =>
        val (a,newState) = value.action(s)
        (func(a), newState)
      })
    }
  }

  implicit def stateApplicative[S] = new Applicative[CurriedState[S]#F](stateFunctor[S]) {
    def pure[A](a: A): State[S,A] = State(s => (a,s))

    def ap[A,B](value: State[S,A])(func: State[S,A => B]): State[S,B] = {
      State({ s =>
        val (f, newState) = func.action(s)
        val (a, newerState) = value.action(newState)
        (f(a), newerState)
      })
    }
  }

  implicit def stateMonad[S] = new Monad[CurriedState[S]#F](stateApplicative[S]) {
    def bind[A,B](value: State[S,A])(func: A => State[S,B]): State[S,B] = {
      State({ s =>
        val (a, newState) = value.action(s)
        func(a).action(newState)
      })
    }
  }

  /****************************************************************************
   ******************************** WRITER ************************************
   ***************************************************************************/

  /****************************************************************************
   ********************************* CONST ************************************
   ***************************************************************************/

  case class Const[X,A](x: X)

  type CurriedConst[X] = {
    type F[A] = Const[X,A]
  }

  implicit def constFunctor[X] = new Functor[CurriedConst[X]#F] {
    def fmap[A,B](value: Const[X,A])(func: A => B): Const[X,B] = {
      value.asInstanceOf[Const[X,B]]
    }
  }


  /****************************************************************************
   ****************************** TRANSFORMERS ********************************
   ***************************************************************************/

  /****************************************************************************
   ********************************** StateT **********************************
   ***************************************************************************/

  final case class StateT[S, F[_],A](runState: S => F[(A,S)])

  type CurriedStateT[S, M[_]] = {
    type F[A] = StateT[S,M,A]
  }

  implicit def stateTFunctor[S, F[_]](implicit functorF: Functor[F]) = new Functor[CurriedStateT[S,F]#F] {
    def fmap[A,B](value: StateT[S,F,A])(func: A => B): StateT[S,F,B] = StateT[S,F,B]({ s =>
      functorF.fmap(value.runState(s)){ case (a,s) => (func(a), s)}
    })
  }

  implicit def stateTApplicative[S,F[_]](implicit monadF: Monad[F]) = new Applicative[CurriedStateT[S,F]#F](stateTFunctor[S,F](monadF.applicative.functor)) {
    def pure[A](a: A): StateT[S,F,A] = StateT[S,F,A](s => monadF.applicative.pure((a,s)))

    def ap[A,B](value: StateT[S,F,A])(func: StateT[S,F,A => B]): StateT[S,F,B] = StateT[S,F,B]({ s =>
      val actionInF = func.runState(s)
      monadF.bind(actionInF){ case (action, newState) =>
        val newStateInF = value.runState(newState)
        monadF.applicative.functor.fmap(newStateInF){case (a,finalState) => (action(a), finalState) }
      }
    })
  }

  implicit def stateTMonad[S,F[_]](implicit monadF: Monad[F]) = new Monad[CurriedStateT[S,F]#F](stateTApplicative[S,F]) {

    def bind[A,B](value: StateT[S,F,A])(func: A => StateT[S,F,B]): StateT[S,F,B] = StateT[S,F,B]({s =>
      val stateInContext = value.runState(s)
      monadF.bind(stateInContext)({ case (a, newState) =>
        func(a).runState(newState)
      })
    })
  }

  implicit def monadStateStateT[S, F[_]](implicit monadF: Monad[F]) = new MonadState[S,CurriedStateT[S,F]#F] {
    def get: StateT[S,F,S] = StateT[S,F,S]{s => monadF.applicative.pure((s,s))}
    def set(s: S): StateT[S,F,Unit] = StateT[S,F,Unit](_ => monadF.applicative.pure((Unit,s)))
  }


  /****************************************************************************
   ********************************** ReaderT *********************************
   ***************************************************************************/

  final case class ReaderT[R,F[_],A](runReaderT: R => F[A])

  type CurriedReaderT[R, M[_]] = {
    type F[A] = ReaderT[R,M,A]
  }

  implicit def readerTFunctor[R, F[_]](implicit functorF: Functor[F]) = new Functor[CurriedReaderT[R,F]#F] {
    def fmap[A,B](value: ReaderT[R,F,A])(func: A => B): ReaderT[R,F,B] = ReaderT[R,F,B]({ r =>
      functorF.fmap(value.runReaderT(r))(func)
    })
  }

  implicit def readerTApplicative[R,F[_]](implicit monadF: Monad[F]) = new Applicative[CurriedReaderT[R,F]#F](readerTFunctor[R,F](monadF.applicative.functor)) {

    def pure[A](a: A): ReaderT[R,F,A] = ReaderT[R,F,A]({ r => monadF.applicative.pure(a) })

    def ap[A,B](value: ReaderT[R,F,A])(func: ReaderT[R,F,A => B]) = ReaderT[R,F,B]({ r =>
      val valueInF = value.runReaderT(r)
      monadF.bind(valueInF)({ a =>
        val funcInF = func.runReaderT(r)
        monadF.applicative.functor.fmap(funcInF){ f => f(a) }
      })
    })
  }

  implicit def readerTMonad[R,F[_]](implicit monadF: Monad[F]) =
    new Monad[CurriedReaderT[R,F]#F](readerTApplicative[R,F]) {
      def bind[A,B](value: ReaderT[R,F,A])(func: A => ReaderT[R,F,B]) = ReaderT[R,F,B]({ r =>
        val valueInF = value.runReaderT(r)
        monadF.bind(valueInF){ a => func(a).runReaderT(r) }
      })
    }

  implicit def monadReaderReaderT[R,F[_]](implicit monadF: Monad[F]) = new MonadReader[R,CurriedReaderT[R,F]#F] {
    def ask: ReaderT[R,F,R] = ReaderT[R,F,R](r => monadF.applicative.pure(r))
  }

  /****************************************************************************
   *********************************  MTL  ************************************
   ***************************************************************************/

  abstract class MonadState[S,F[_]](implicit val monad: Monad[F]) {
    def get: F[S]
    def set(s: S): F[Unit]
  }

  abstract class MonadReader[R, F[_]](implicit val monad: Monad[F]) {
    def ask: F[R]
  }

  implicit def monadReaderStateT[S,R,F[_]](
    implicit
    monadF: Monad[F],
    monadReader: MonadReader[R,F]
  ) = new MonadReader[R,CurriedStateT[S,F]#F] {
    def ask: StateT[S,F,R] = StateT[S,F,R]({ s =>
      val askValue: F[R] = monadReader.ask
      monadF.applicative.functor.fmap(askValue)(r => (r,s))
    })
  }

  implicit def monadStateReaderT[S,R,F[_]](
    implicit
    monadF: Monad[F],
    monadState: MonadState[S,F]
  ) = new MonadState[S,CurriedReaderT[R,F]#F] {
    def get: ReaderT[R,F,S] = ReaderT[R,F,S]({_ => monadState.get})

    def set(s: S): ReaderT[R,F,Unit] = ReaderT[R,F,Unit]({_ => monadState.set(s) })
  }


  /****************************************************************************
   ******************************** HELPERS ***********************************
   ***************************************************************************/

  implicit class MonadOps[F[_], A](f: F[A])(implicit monad: Monad[F]) {
    def flatMap[B](func: A => F[B]): F[B] = monad.bind(f)(func)
    def map[B](func: A => B): F[B] = monad.applicative.functor.fmap(f)(func)
  }

  /****************************************************************************
   ****************************** USER CODE ***********************************
   ***************************************************************************/

  type CState[A] = StateT[MyState, Option, A]
  type MonadStack[A] = ReaderT[Config,CState,A]

  val monad = implicitly[Monad[MonadStack]]

  case class MyState(i: Int)
  case class Config(env: String)
  
  def myProgram[F[_]](
    implicit
    monad: Monad[F],
    ms: MonadState[MyState, F],
    mr: MonadReader[Config, F]
  ): F[String] = {
    for {
      config <- mr.ask
      state <- ms.get
    } yield (config.env + state.i.toString)
  }

  def main(args: Array[String]): Unit = {
    val of: Option[Long => Long] = Some({ s => s + 1})
    println(s"option applicative: ${optionApplicative.ap(Some(1L))(of)}")
    println(s"stack: ${monad.applicative.pure(10)}")
    println(s"mtl: ${myProgram[MonadStack]}")
  }

}