Skip to content

Instantly share code, notes, and snippets.

@s5bug
Last active March 8, 2024 19:40
Show Gist options
  • Save s5bug/dc9b765ee2ba11cab3d7bcfc2a0a44dc to your computer and use it in GitHub Desktop.
Save s5bug/dc9b765ee2ba11cab3d7bcfc2a0a44dc to your computer and use it in GitHub Desktop.
Monads are Monoids in the category of Endofunctors: Scala 3
// 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment