Scala Functor, Applicative and Monad thanks to context bounds

Applicative.scala

package control

trait Applicative[M[_]] extends Functor[M] {

  def pure[A](a: A): M[A]

  def applicative[A, B](f: M[A => B])(a: M[A]): M[B]

  override def map[A, B](f: A => B)(a: M[A]): M[B] = applicative(pure(f))(a)

}

object Applicative {

  def apply[F[_] : Applicative]: Applicative[F] = implicitly[Applicative[F]]

  def pure[M[_] : Applicative, A](a: A): M[A] = Applicative[M].pure(a)

  object Implicits {
    implicit def wrapApplicative[M[_] : Applicative, A, B](f: M[A => B]): ApplicativeW[M, A, B] = new ApplicativeW(f)
  }

  class ApplicativeW[M[_] : Applicative, A, B](f: M[A => B]) {

    def applicative(a: M[A]): M[B] = Applicative[M].applicative(f)(a)

    def <*>(a: M[A]): M[B] = applicative(a)

  }

}

class DemoApplicative[M[_] : Applicative] {

  import Applicative.Implicits._
  import Applicative._
  import Functor.Implicits._

  val adder: Int => Int => Int = { x: Int => y: Int => x + y }
  val result: M[Int] = adder <@> pure(1) <*> pure(2)
}

Freer.scala

package control

sealed trait Freer[F[_], A] {
  def map[B](f: A => B): Freer[F, B] = flatMap(a => Return(f(a)))

  def flatMap[B](f: A => Freer[F, B]): Freer[F, B]
}

case class Return[F[_], A](a: A) extends Freer[F, A] {
  def flatMap[B](f: A => Freer[F, B]): Freer[F, B] = f(a)
}

case class FlatMap[F[_], I, A](intermediate: F[I], continuation: I => Freer[F, A]) extends Freer[F, A] {
  def flatMap[B](f: A => Freer[F, B]): Freer[F, B] =
    FlatMap(intermediate, continuation andThen (_ flatMap f))
}

sealed trait ~>[F[_], G[_]] {
  def apply[A](fa: F[A]): G[A]
}

object Freer {

  implicit def liftF[F[_], A](fa: F[A]): Freer[F, A] = FlatMap(fa, Return.apply)

  def run[F[_], G[_] : Monad, A](program: Freer[F, A], transformation: F ~> G): G[A] = {

    program match {
      case Return(a) =>
        Monad[G].pure(a)
      case FlatMap(intermediate, continuation) =>
        Monad[G].flatMap(transformation(intermediate)) { a =>
          run(continuation(a), transformation)
        }
    }
  }
}

class DemoFreer[M[_] : Monad] {

  sealed trait UserInteraction[A]

  case class Tell(statement: String) extends UserInteraction[Unit]

  case class Ask(question: String) extends UserInteraction[String]

  // ---------------------------------------------------------------------------------------------------------
  // Program construction layer i.e. AST built thanks to a DSL
  // ---------------------------------------------------------------------------------------------------------

  type InteractionDsl[A] = Freer[UserInteraction, A]

  def tell(str: String): InteractionDsl[Unit] = Freer.liftF(Tell(str))

  def ask(answer: String): InteractionDsl[String] = Freer.liftF(Ask(answer))

  // ---------------------------------------------------------------------------------------------------------
  // Building a program
  // ---------------------------------------------------------------------------------------------------------

  val sayHello: InteractionDsl[Unit] = for {
    _ <- tell("Hello!")
  } yield ()

  val askForName: InteractionDsl[String] = for {
    name <- ask("What is your name?")
  } yield name

  def sayHi(name: String): InteractionDsl[Unit] = for {
    _ <- tell(s"Hi, $name")
  } yield ()

  // The program composition is allowed of course!

  val program: InteractionDsl[Unit] = for {
    _ <- sayHello
    name <- askForName
    _ <- sayHi(name)
  } yield ()


  def consoleIO[G[_]:Monad]: UserInteraction ~> G = new (UserInteraction ~> G) {

    override def apply[A](fa: UserInteraction[A]): G[A] = fa match {
      case Tell(str) =>
        Monad[G].pure(println(str))
      case Ask(question) =>
        println(question)
        Monad[G].pure(scala.io.StdIn.readLine())
    }
  }

  Freer.run(program, consoleIO)

}

Function.scala

package control

class Function {

  def apply[A, B](f: A => B)(a: A): B = f(a)

  def compose[A, B, C](f: A => B)(g: C => A): C => B = { a: C => f(g(a)) }

  def pipeline[A, B, C](f: A => B)(g: B => C): A => C = compose(g)(f)
}

object Function {

  object Implicits {
    private lazy val function: Function = new Function

    implicit def wrapFunction[A, B](f: A => B): FunctionW[A, B] = new FunctionW(f)(function)
  }

  class FunctionW[A, B](f: A => B)(function: Function) {

    def apply(a: A): B = function.apply(f)(a)

    def compose[C](g: C => A): C => B = function.compose(f)(g)

    def pipeline[C](g: B => C): A => C = function.compose(g)(f)

    def |>[C](g: B => C): A => C = function.pipeline(f)(g)

  }

}

object DemoFunction {

  import Function.Implicits._

  val incr: Int => Int = { a: Int => a + 1 }
  val result: Int = incr |> incr apply 2

}

Functor.scala

package control

trait Functor[M[_]] {
  def map[A, B](f: A => B)(a: M[A]): M[B]
}

object Functor {

  def apply[F[_] : Functor]: Functor[F] = implicitly[Functor[F]]

  object Implicits {
    implicit def wrapToFunctorW[M[_] : Functor, A, B](f: A => B): FunctorW[M, A, B] = new FunctorW(f)
  }

  class FunctorW[M[_] : Functor, A, B](f: A => B) {
    def map(a: M[A]): M[B] = Functor[M].map(f)(a)

    def <@>(a: M[A]): M[B] = Functor[M].map(f)(a)
  }

}

class DemoFunctor[M[_] : Functor] {

  import Functor.Implicits._

  val adder: Int => Int = { x: Int => x + 1 }
  val result: M[Int] => M[Int] = { s: M[Int] => adder <@> s }

}

Kleisli.scala

package control

import scala.language.implicitConversions

trait Kleisli[M[_]] extends Monad[M] {

  import control.Function.Implicits._

  def compose[A, B, C](f: A => M[B])(g: B => M[C]): A => M[C] = f |> { flatMap(_)(g)  }
}

object Kleisli {

  def apply[M[_] : Kleisli]: Kleisli[M] = implicitly[Kleisli[M]]

  object Implicits {
    implicit def wrapKleisli[M[_] : Kleisli, A, B](f: A => M[B]): KleisliW[M, A, B] = new KleisliW(f)
  }

  class KleisliW[M[_] : Kleisli, A, B](f: A => M[B]) {

    def compose[C](g: B => M[C]): A => M[C] = Kleisli[M].compose(f)(g)

    def >=>[C](g: B => M[C]): A => M[C] = Kleisli[M].compose(f)(g)

  }

}

class DemoKleisli[M[_] : Kleisli] {

  import Kleisli.Implicits._
  import Monad._

  val incr: Int => M[Int] = x => returns(x + 1)
  val str: Int => M[String] = x => returns(x.toString)

  val result: M[String] = (incr >=> incr >=> str) (42)

}

Monad.scala

package control

import control.Applicative.ApplicativeW

trait Monad[M[_]] extends Applicative[M] {
  def returns[A](a: A): M[A] = pure(a)

  def flatten[A](a: M[M[A]]): M[A]

  def flatMap[A, B](a: M[A])(f: A => M[B]): M[B] = flatten(map(f)(a))
}

object Monad {

  def apply[M[_] : Monad]: Monad[M] = implicitly[Monad[M]]

  def join[M[_] : Monad, A](a: M[M[A]]): M[A] = Monad[M].flatten(a)

  def returns[M[_] : Monad, A](a: A): M[A] = Monad[M].returns(a)

  object Implicits {
    implicit def wrapMonad[M[_] : Monad, A](a: M[A]): MonadW[M, A] = new MonadW(a)

    implicit def wrapFunMonad[M[_] : Monad, A, B](a: M[A => B]): MonadFunW[M, A, B] = new MonadFunW(a)
  }

  class MonadW[M[_] : Monad, A](a: M[A]) {
    def flatMap[B](f: A => M[B]): M[B] = Monad[M].flatMap(a)(f)

    def >>=[B](f: A => M[B]): M[B] = flatMap(f)
  }

  class MonadFunW[M[_] : Monad, A, B](a: M[A => B]) extends ApplicativeW[M, A, B](a) {
    def flatMap[C](f: (A => B) => M[C]): M[C] = Monad[M].flatMap(a)(f)

    def >>=[C](f: (A => B) => M[C]): M[C] = Monad[M].flatMap(a)(f)
  }

}

class DemoMonad[M[_] : Monad] {

  import Monad.Implicits._
  import Monad._

  val incr: Int => M[Int => Int] = { x: Int => returns { y: Int => x + y } }
  val result: M[Int] = (returns(1) >>= incr) <*> returns(1)

}

Recursive.scala

// Fix definition

case class Fix[F[_] : Functor](unfix: F[Fix[F]]) {

  import Functor.Implicits._

  def fold[A](interpret: F[A] => A): A = interpret({ e: Fix[F] => e fold interpret } map this.unfix)
}

trait Lists {
  type List = [V] =>> [A] =>> ListF[V,A]

  sealed trait ListF[V, A]
  case class Nil[V, A]() extends ListF[V, A]
  case class Cons[V, A](h: V, t: A) extends ListF[V, A]

  class FunctorList[V] extends Functor[List[V]] {
    override def map[A, B](f: A => B)(a: List[V][A]): List[V][B] =
      a match {
        case Nil() => Nil()
        case Cons(h, t) => Cons(h, f(t))
      }
  }

  object Helpers {
    def nil[V](): Fix[List[V]] = Fix(Nil())(FunctorList[V])
    def cons[V](h: V, t: Fix[List[V]]) = Fix(Cons(h, t))(FunctorList[V])
  }
  
  def pretty(a: List[Int][String]): String =
    a match {
      case Nil() => "[]"
      case Cons(h, t) => h.toString + "::" + t
    }

  object Demo {
    import Helpers._
    
    val l: Fix[List[Int]] = cons(1, nil())
    val s: String = l fold pretty
  }
}

Yoneda.scala

package control

trait Yoneda[F[_], A] {

  def map[B](f: A => B): F[B]

}

object Yoneda {

  def toYoneda[F[_] : Functor, A](a: F[A]): Yoneda[F, A] = new Yoneda[F, A] {

    def map[B](f: A => B): F[B] = Functor[F].map(f)(a)

  }

}

class DemoYoneda[M[_] : Applicative] {

  import Applicative._

  val result: M[String] = Yoneda.toYoneda(pure(1)).map(it => (it + 41).toString)

}