Skip to content

Instantly share code, notes, and snippets.

@d-plaindoux
Last active December 9, 2020 07:20
Show Gist options
  • Save d-plaindoux/b83be6b6d6bb7cf562d732a3e81aea5b to your computer and use it in GitHub Desktop.
Save d-plaindoux/b83be6b6d6bb7cf562d732a3e81aea5b to your computer and use it in GitHub Desktop.
Scala Functor, Applicative and Monad thanks to context bounds
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)
}
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)
}
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
}
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 }
}
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)
}
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)
}
// 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
}
}
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)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment