Monads are Monoids in the category of Endofunctors: Scala 3

worksheet.scala

// Author: Aly Cerruti
// Please follow along in Scastie, so you can see the output of statements:
//   https://scastie.scala-lang.org/CLmK5tLuRd6rxXuEnba0rQ

// A Category
trait Category[
  // A collection of objects
  Obj <: AnyKind,
  // A constraint on those objects (Scala lacks dependent typing, so i.e. `Val = [A] =>> Monoid[A]` makes the category of Monoids)
  Val[_ <: Obj],
  // A Homomorphism "Functor" (I haven't required this to be a proper Profunctor)
  Hom[_ <: Obj, _ <: Obj],
] {
  
  // We need to be able to extract constraints from the sides of morphisms
  def homExtractLeft[A <: Obj, B <: Obj](f: Hom[A, B]): Val[A]
  def homExtractRight[A <: Obj, B <: Obj](f: Hom[A, B]): Val[B]
  
  // Identity and Composition
  def id[A <: Obj](v: Val[A]): Hom[A, A]
  def compose[A <: Obj, B <: Obj, C <: Obj](f: Hom[A, B], g: Hom[B, C]): Hom[A, C]
  
}

// A Monoidal Category is a Category...
trait MonoidalCategory[
  Obj <: AnyKind,
  Val[_ <: Obj],
  Hom[_ <: Obj, _ <: Obj],
  // With an identity / "empty"
  I <: Obj,
  // And a Tensor / "product" "Bifunctor"
  Tens[_ <: Obj, _ <: Obj] <: Obj,
] extends Category[Obj, Val, Hom] {
  
  // Our identity is constrained
  def ival: Val[I]
  // And because I haven't required Tens to actually implement a Bifunctor, here's its mapVal
  def tval[A <: Obj, B <: Obj](av: Val[A], bv: Val[B]): Val[Tens[A, B]]
  
  // Again, I haven't made Bifunctor here for the purposes of brevity, but we can map both sides of Tens
  def rightMapTens[A <: Obj, B <: Obj, C <: Obj](v: Val[A], f: Hom[B, C]): Hom[Tens[A, B], Tens[A, C]]
  // And it is required that (I, A) ≅ A ≅ (A, I), but I'll only implement one of those here
  def rightUnitor[A <: Obj](v: Val[A]): Hom[A, Tens[A, I]]
  
  // I've left out the other laws of MonoidalCategory as they're not needed for this example
}

// A Monoid exists within a Monoidal Category
trait Monoid[
  Obj <: AnyKind,
  Val[_ <: Obj],
  Hom[_ <: Obj, _ <: Obj],
  I <: Obj,
  Tens[_ <: Obj, _ <: Obj] <: Obj,
  // And operates on an object within it
  A <: Obj,
] {
  
  // The monoidal category
  val monoidalCategory: MonoidalCategory[Obj, Val, Hom, I, Tens]
  
  // Traditional empty and combine
  // (1 → A) and (A ⊗ A → A) respectively
  def empty: Hom[I, A]
  def combine: Hom[Tens[A, A], A]
  
}

// An Endofunctor exists with respect to one Category (This minimal example doesn't have a non-Endo Functor)
trait Endofunctor[
  Obj <: AnyKind,
  Val[_ <: Obj],
  Hom[_ <: Obj, _ <: Obj],
  // Sends objects through the Category
  F[_ <: Obj] <: Obj,
] {
  
  // The category
  val endofunctorCategory: Category[Obj, Val, Hom]
  
  // Constraints need to be mapped (This is the mapVal I was referring to in the comment on MonoidalCategory#tval)
  def mapVal[A <: Obj](v: Val[A]): Val[F[A]]
  
  // And morphisms need to be mapped
  def map[A <: Obj, B <: Obj](f: Hom[A, B]): Hom[F[A], F[B]]
  
}

// A natural transformation between endofunctors
case class EndoNatTrans[
  Obj <: AnyKind,
  Val[_ <: Obj],
  Hom[_ <: Obj, _ <: Obj],
  F[_ <: Obj] <: Obj,
  G[_ <: Obj] <: Obj,
](
  // Evidence that both F and G are endofunctors
  endoF: Endofunctor[Obj, Val, Hom, F],
  endoG: Endofunctor[Obj, Val, Hom, G],
  // As well as the transformation itself
  t: [A <: Obj] => Val[A] => Hom[F[A], G[A]]
)

// A Monad...
trait Monad[
  Obj <: AnyKind,
  Val[_ <: Obj],
  Hom[_ <: Obj, _ <: Obj],
  F[_ <: Obj] <: Obj,
// Is a monoid
] extends Monoid[
  // In the category of endofunctors.
  [A <: Obj] =>> Obj,
  [F[_ <: Obj] <: Obj] =>> Endofunctor[Obj, Val, Hom, F],
  [F[_ <: Obj] <: Obj, G[_ <: Obj] <: Obj] =>> EndoNatTrans[Obj, Val, Hom, F, G],
  [X <: Obj] =>> X,
  [F[_ <: Obj] <: Obj, G[_ <: Obj] <: Obj] =>> [A <: Obj] =>> F[G[A]],
  F
// And we extend Endofunctor for convinience as a Monad is an Endofunctor
] with Endofunctor[Obj, Val, Hom, F]

// Let's define Scala's native category: Scal.
// There's no constraint: So [A] =>> Unit is always satisfiable.
object Scal extends MonoidalCategory[Any, [A] =>> Unit, Function1, Unit, Tuple2] {
  override def homExtractLeft[A, B](f: A => B) = ()
  override def homExtractRight[A, B](f: A => B) = ()
  override def id[A](v: Unit): A => A = x => x
  override def compose[A, B, C](f: A => B, g: B => C): A => C = x => g(f(x))
  
  override def ival: Unit = ()
  override def tval[A, B](av: Unit, bv: Unit): Unit = ()
  
  override def rightMapTens[A, B, C](v: Unit, f: B => C): ((A, B)) => (A, C) = (a, b) => (a, f(b))
  override def rightUnitor[A](v: Unit): A => (A, Unit) = x => (x, ())
}

// The category of Endofunctors...
case class EndofunctorCategory[
  Obj <: AnyKind,
  Val[_ <: Obj],
  Hom[_ <: Obj, _ <: Obj],
// in a Category `cat`. (i.e., the category of all functors `F : cat -> cat`)
](cat: Category[Obj, Val, Hom]) extends MonoidalCategory[
  // Objects are endofunctors
  [A <: Obj] =>> Obj,
  // Constrained by evidence of being an endofunctor
  [F[_ <: Obj] <: Obj] =>> Endofunctor[Obj, Val, Hom, F],
  // Morphisms are natural transformations
  [F[_ <: Obj] <: Obj, G[_ <: Obj] <: Obj] =>> EndoNatTrans[Obj, Val, Hom, F, G],
  // The identity is the identity endofunctor
  [X <: Obj] =>> X,
  // And the product of two endofunctors in this category is their composition.
  [F[_ <: Obj] <: Obj, G[_ <: Obj] <: Obj] =>> [A <: Obj] =>> F[G[A]]
] {
  
  // EndoNatTrans contains evidence of both sides being endofunctors
  override def homExtractLeft[A[_ <: Obj] <: Obj, B[_ <: Obj] <: Obj](f: EndoNatTrans[Obj, Val, Hom, A, B]): Endofunctor[Obj, Val, Hom, A] = f.endoF
  override def homExtractRight[A[_ <: Obj] <: Obj, B[_ <: Obj] <: Obj](f: EndoNatTrans[Obj, Val, Hom, A, B]): Endofunctor[Obj, Val, Hom, B] = f.endoG
  
  // Given an endofunctor, return the identity morphism
  override def id[F[_ <: Obj] <: Obj](v: Endofunctor[Obj, Val, Hom, F]): EndoNatTrans[Obj, Val, Hom, F, F] =
    EndoNatTrans(v, v, [A <: Obj] => (va: Val[A]) => cat.id[F[A]](v.mapVal(va)))
  
  // Compose two natural transformations (note that this is not composing two functors! just two natural transformations)
  override def compose[F[_ <: Obj] <: Obj, G[_ <: Obj] <: Obj, H[_ <: Obj] <: Obj](f: EndoNatTrans[Obj, Val, Hom, F, G], g: EndoNatTrans[Obj, Val, Hom, G, H]): EndoNatTrans[Obj, Val, Hom, F, H] =
    EndoNatTrans(f.endoF, g.endoG, [A <: Obj] => (va: Val[A]) => cat.compose[F[A], G[A], H[A]](f.t[A](va), g.t[A](va)))
  
  // The identity is an endofunctor
  override def ival: Endofunctor[Obj, Val, Hom, [X <: Obj] =>> X] =
    new Endofunctor[Obj, Val, Hom, [X <: Obj] =>> X] {
      override val endofunctorCategory = cat
      override def mapVal[A <: Obj](v: Val[A]): Val[A] = v
      override def map[A <: Obj, B <: Obj](f: Hom[A, B]): Hom[A, B] = f
    }
  
  // And the composition of two endofunctors is an endofunctor
  override def tval[F[_ <: Obj] <: Obj, G[_ <: Obj] <: Obj](fv: Endofunctor[Obj, Val, Hom, F], gv: Endofunctor[Obj, Val, Hom, G]): Endofunctor[Obj, Val, Hom, [A <: Obj] =>> F[G[A]]] =
    new Endofunctor[Obj, Val, Hom, [A <: Obj] =>> F[G[A]]] {
      override val endofunctorCategory = cat
      override def mapVal[A <: Obj](v: Val[A]): Val[F[G[A]]] = fv.mapVal(gv.mapVal(v))
      override def map[A <: Obj, B <: Obj](f: Hom[A, B]): Hom[F[G[A]], F[G[B]]] = fv.map(gv.map(f))
    }
  
  // If we have an F[G[A]] and a G ~> H, we can get an F[H[A]]
  def rightMapTens[F[_ <: Obj] <: Obj, G[_ <: Obj] <: Obj, H[_ <: Obj] <: Obj](v: Endofunctor[Obj, Val, Hom, F], f: EndoNatTrans[Obj, Val, Hom, G, H]): EndoNatTrans[Obj, Val, Hom, [A <: Obj] =>> F[G[A]], [A <: Obj] =>> F[H[A]]] =
    EndoNatTrans(tval[F, G](v, f.endoF), tval[F, H](v, f.endoG), [A <: Obj] => (av: Val[A]) => v.map[G[A], H[A]](f.t[A](av)))
  
  // If we have an F[A], then we also have an F[Id[A]]
  // Due to how we've defined the identity endofunctor (as the identity type function) we can special case this to "do nothing" :) 
  def rightUnitor[F[_ <: Obj] <: Obj](v: Endofunctor[Obj, Val, Hom, F]): EndoNatTrans[Obj, Val, Hom, F, F] =
    id(v)
  
}

// So, let's define Option as a Monad
object OptionMonad extends Monad[Any, [A] =>> Unit, Function1, Option] {
  
  // Our host category is Scal, and so we grab Fct_Scal as a shorthand
  val host = Scal
  val fct = EndofunctorCategory(host)
  
  // This is the category that Option belongs to as an endofunctor
  override val endofunctorCategory: Category[Any, [A] =>> Unit, Function1] = host
  
  // Not needing to preserve constraints
  override def mapVal[A](v: Unit): Unit = ()
  
  // And with the standard Functor `map`
  override def map[A, B](f: A => B): Option[A] => Option[B] = _.map(f)
  
  // And this is the category that Option belongs to as a monoid: A monad is a monoid in the category of endofunctors
  override val monoidalCategory: EndofunctorCategory[Any, [A] =>> Unit, Function1] = fct
  
  // We have our natural transformation Id ~> Option, better seen as [A] => A => Option[A]
  override def empty: EndoNatTrans[Any, [A] =>> Unit, Function1, [X] =>> X, Option] =
    EndoNatTrans(fct.ival, OptionMonad, [A] => (_: Unit) => (x: A) => Some(x))
  
  // And (Option ⊗ Option) ~> Option, better seen as [A] => Option[Option[A]] => Option[A]
  override def combine: EndoNatTrans[Any, [A] =>> Unit, Function1, [X] =>> Option[Option[X]], Option] =
    EndoNatTrans(fct.tval(OptionMonad, OptionMonad), OptionMonad, [A] => (_: Unit) => (x: Option[Option[A]]) => x.flatten)
  
}

// Does it work?
// Let's define a Monoid on Int so we can test a Monoid-abstracted method:

object IntMonoid extends Monoid[Any, [A] =>> Unit, Function1, Unit, Tuple2, Int] {
  
  override val monoidalCategory = Scal
  
  override def empty: Unit => Int = _ => 0
  
  override def combine: ((Int, Int)) => Int = (x, y) => x + y
  
}

// How about mpow?

def mpow[
  Obj <: AnyKind,
  Val[_ <: Obj],
  Hom[_ <: Obj, _ <: Obj],
  I <: Obj,
  Tens[_ <: Obj, _ <: Obj] <: Obj,
  A <: Obj
](n: Int, monoid: Monoid[Obj, Val, Hom, I, Tens, A], toAdd: Hom[I, A]): Hom[I, A] = {
  // Grab a Val[A] for later
  val av: Val[A] = monoid.monoidalCategory.homExtractRight(monoid.empty)
  // If n = 0, then we want an identity
  if(n == 0) monoid.empty
  // Otherwise, we want to combine toAdd and our input
  else {
    // First, grab our combine morphism
    val c: Hom[Tens[A, A], A] = monoid.combine
    // And make our toAdd map the right side of a Tens
    val d: Hom[Tens[A, I], Tens[A, A]] = monoid.monoidalCategory.rightMapTens[A, I, A](av, toAdd)
    // Compose the two
    val e: Hom[Tens[A, I], A] = monoid.monoidalCategory.compose(d, c)
    // Take the fact that `A ≅ (A, I)`
    val f: Hom[A, Tens[A, I]] = monoid.monoidalCategory.rightUnitor[A](av)
    // And compose that
    val g: Hom[A, A] = monoid.monoidalCategory.compose(f, e)
    // And then transform by the next mpow
    monoid.monoidalCategory.compose(mpow(n - 1, monoid, toAdd), g)
  }
}

// Let's give it a shot for ints:

mpow(10, IntMonoid, (_: Unit) => 2)(())
mpow(20, IntMonoid, (_: Unit) => 3)(())

// Looks good! Now, check this out:

IntMonoid.empty(())
mpow(10, IntMonoid, IntMonoid.empty)(())

// `empty` to the 10th power just returns `empty` again.
// Same with our Option Monad:

OptionMonad.empty.t[String](())("Hello!")
mpow(10, OptionMonad, OptionMonad.empty).t[String](())("Hello!")

// And, quite unfortunately, there's only two possible values we can give to `mpow` for `Id ~> Option`
// 1. x => Some(x)
// 2. x => None
//
// Let's try something a bit more exciting.

// We can define the List monad just how we defined the Option monad prior:
object ListMonad extends Monad[Any, [A] =>> Unit, Function1, List] {
  
  // Our host category is Scal, and so we grab Fct_Scal as a shorthand
  val host = Scal
  val fct = EndofunctorCategory(host)
  
  // This is the category that List belongs to as an endofunctor
  override val endofunctorCategory: Category[Any, [A] =>> Unit, Function1] = host
  
  // Not needing to preserve constraints
  override def mapVal[A](v: Unit): Unit = ()
  
  // And with the standard Functor `map`
  override def map[A, B](f: A => B): List[A] => List[B] = _.map(f)
  
  // And this is the category that List belongs to as a monoid: A monad is a monoid in the category of endofunctors
  override val monoidalCategory: EndofunctorCategory[Any, [A] =>> Unit, Function1] = fct
  
  // We have our natural transformation Id ~> List, better seen as [A] => A => List[A]
  override def empty: EndoNatTrans[Any, [A] =>> Unit, Function1, [X] =>> X, List] =
    EndoNatTrans(fct.ival, ListMonad, [A] => (_: Unit) => (x: A) => List(x))
  
  // And (List ⊗ List) ~> List, better seen as [A] => List[List[A]] => List[A]
  override def combine: EndoNatTrans[Any, [A] =>> Unit, Function1, [X] =>> List[List[X]], List] =
    EndoNatTrans(fct.tval(ListMonad, ListMonad), ListMonad, [A] => (_: Unit) => (x: List[List[A]]) => x.flatten)
  
}

// Let's verify that mpow will compile with this List monad

ListMonad.empty.t[String](())("Hello!")
mpow(10, ListMonad, ListMonad.empty).t[String](())("Hello!")

// Now, for fun: let's craft an Id ~> List that takes each element and puts it in the list twice:
val twice: EndoNatTrans[Any, [A] =>> Unit, Function1, [X] =>> X, List] =
  EndoNatTrans(ListMonad.fct.ival, ListMonad, [A] => (_: Unit) => (x: A) => List(x, x))

// Now we have a List that's 2^3 = 8 elements long of "Hello!"
mpow(3, ListMonad, twice).t[String](())("Hello!")

// So, we have shown that Monads are Monoids by implementing a method using Monoid and calling it with a Monad