Encoding Category Theory Laws (à-la-scalaz/cats) using kind-polymorphic List and compare/manipulate laws of structure

ASample.scala

/**
  * In classic Scala implementation of hierarchies of Category theory laws (scalaz/cats), the dependency between
  * different laws is encoded using inheritance (https://github.com/typelevel/cats/blob/master/core/src/main/scala/cats/Monad.scala#L14)
  *
  * This approach creates well-known issues: for example, a Monad is able to _derive_ an Applicative.
  * So sometimes, you don't have the Applicative you want but the one derived from the Monad or it doesn't
  * compile because you have 2 Applicatives in your implicit scope.
  *
  * Alois Cochard has proposed a new model to represent that in (scato project)[https://github.com/aloiscochard/scato] or
  * (scalaz/8.0.x)[https://github.com/scalaz/scalaz/blob/series/8.0.x/base/src/main/scala/typeclass/Monad.scala] branch.
  * It avoids inheritance in favor of embedding and thus ensures global coherence by forcing to have only one instance
  * of every Lawful structure (One monad, one applicative, one functor).
  * This model is interesting and really good.
  *
  * I'm currently studying a PoC to bring some adhoc Kind-Polymorphism support in Scalac and this new feature enables
  * a lot of natural ways of thinking that were not easily reachable before. Specially, we can create "PolyKinded List"
  * which are very practical to manipulate structure of the same kind (* or *->* or ...).
  * Serendipity has lead me to using that to represent a hierarchy of Category theory laws and be able to use it exactly
  * as cats or scalaz with 2 new capabilities:
  *   - ensure the same coherence as scato/scalaz8.0.x model
  *   - allow to compare & manipulate categorical laws of structures
  *
  * Here is the result of this study that is very promising to me and could bring many more ideas ;)
  */


// Pointed law as you know it already
trait Pointed[F[_]] {
  def pure[A](a: A): F[A]
}

/** Let's define "atomic" categorical Laws first */

// Functor law as you know it already
trait Functor[F[_]] {
  def map[A, B](fa: F[A])(f: A => B): F[B]
}

// Bind law as you know it already
trait Bind[F[_]] {
  def bind[A, B](fa: F[A])(f: A => F[B]): F[B]
}

/** Now let's define "molecular" categorical Laws aggregating different atomic laws */

// An applicative Functor is a Functor equipped with Pointed law
type Applicative[F[_]] = (LawsBuild[F]{ type Laws = Functor :: Pointed :: PKNil[F] })#Laws

// An Monad has Bind & Pointed laws
type Monad[F[_]] = (LawsBuild[F]{ type Laws = Bind :: Pointed :: PKNil[F] })#Laws

/** Now we provide 2 utils to check laws in the type-system
  * - HasLaw (for one single atomic law)
  *     HasLaw[F, Pointed[F]] // OK
  *     HasLaw[F, Bind[F]]  // OK
  *
  * - HasLaws (for multiple laws)
  *     HasLaws[F, Monad[F]
  *     HasLaws[F, Applicative[F]]
  */

// the operations & implicits obtained directly
object DirectImplicits {
  // to be able to write 5.pure[List]
  implicit class toPointed[A](a: A) {
    def pure[F[_]](implicit hasLaw: HasLaw[F, Pointed[F]]): F[A] = hasLaw.law.pure(a)
  }

  // to be able to write Foo(5).map(a => a.toString)
  implicit class toFunctor[F[_], A](fa: F[A]) {
    def map[B](f: A => B)(implicit hasLaw: HasLaw[F, Functor[F]]): F[B] = hasLaw.law.map(fa)(f)
  }

  // the direct implicits
  implicit def implFunctor[F[_]](implicit hasLaw: HasLaw[F, Functor[F]]): Functor[F] = hasLaw.law
  implicit def implPointed[F[_]](implicit hasLaw: HasLaw[F, Pointed[F]]): Pointed[F] = hasLaw.law
  implicit def implBind[F[_]](implicit hasLaw: HasLaw[F, Bind[F]]): Bind[F] = hasLaw.law

}

/** Let's create some structures with some Laws */
case class Foo[A](a: A)
object Foo {
  /** Let's implement atomic laws for this structure */
  // the functor
  val functor: Functor[Foo] = new Functor[Foo] {
    def map[A, B](fa: Foo[A])(f: A => B): Foo[B] = Foo(f(fa.a))
  }

  // the pointed
  val pointed: Pointed[Foo] = new Pointed[Foo] {
    def pure[A](a: A): Foo[A] = Foo(a)
  }

  // the bind
  val bind: Bind[Foo] = new Bind[Foo] {
    def bind[A, B](fa: Foo[A])(f: A => Foo[B]): Foo[B] = f(fa.a)
  }

  // Foo is equipped by pointed, functor and bind laws
  // Please remark that we have only one implicit in this case Laws[Foo]
  implicit val laws = Laws[Foo](bind :: functor :: pointed :: HNilF[Foo]())
}

case class Bar[A](a: A)
object Bar {
  /** Let's implement atomic laws for this structure */
  // the pointed
  val pointed: Pointed[Bar] = new Pointed[Bar] {
    def pure[A](a: A): Bar[A] = Bar(a)
  }

  // the bind
  val bind: Bind[Bar] = new Bind[Bar] {
    def bind[A, B](fa: Bar[A])(f: A => Bar[B]): Bar[B] = f(fa.a)
  }

  // Bar is equipped by pointed and bind laws but NOT functor
  // Please remark that we have only one implicit in this case Laws[Bar]
  implicit val laws = Laws[Bar](bind :: pointed :: HNilF[Bar]())
}

/** Use it now */
import DirectImplicits._

Foo(5).map(i => i.toString)
5.pure[Foo]

// Foo has Functor laws
HasLaw[Foo, Functor[Foo]]
// Foo has Applicative laws
HasLaws[Foo, Applicative[Foo]]
// Foo has Monad laws
HasLaws[Foo, Monad[Foo]]

// But with direct implicits, Bar hasn't laws for Functor or Applicative (need below DerivedImplicits to derive it from Monads)
// implicitly[Functor[Bar]] // KO
// HasLaws[Bar, Applicative[Bar]] // KO


/** Now let's create laws that are derived from other laws */
object DerivedImplicits {
  // From a monad, you can derive a Functor using bind/pure
  implicit def monadFunctor[F[_]](implicit hasLaws: HasLaws[F, Monad[F]]): Functor[F] = new Functor[F] {
    def map[A, B](fa: F[A])(f: A => B): F[B] = hasLaws[Bind[F]].bind(fa)(a => hasLaws[Pointed[F]].pure(f(a)))
  }

  // From a monad, you can prove it has also applicative laws (because it can derive the previous Functor)
  implicit def monadApplicative[F[_]](implicit hasLaws: HasLaws[F, Monad[F]]): HasLaws[F, Applicative[F]] =
    new HasLaws[F, Applicative[F]] {
      def laws: Applicative[F] = monadFunctor[F] :: hasLaws[Pointed[F]] :: HNilF[F]
    }
}

/** Now Let's use derived implicits to see the difference */
// import derived implicits
import DerivedImplicits._
// With derived implicits, Bar has a Functor and can be Applicative too
implicitly[Functor[Bar]]
HasLaws[Bar, Applicative[Bar]]

/** Cherry on the cake: Comparing Laws of structures (and later manipulating)
  * 
  * Imagine you need to implement an abstract function taking 2 structures in input but those structures
  * need to have the same laws to be used in the function
  * As we have represented our laws in a data structure, we can compare them & even manipulate them
  */
// Another typeclass Toto having the same laws as Foo
case class Toto[A](a: A)
object Toto {
  val functor: Functor[Toto] = new Functor[Toto] {
    def map[A, B](fa: Toto[A])(f: A => B): Toto[B] = Toto(f(fa.a))
  }
  val pointed: Pointed[Toto] = new Pointed[Toto] {
    def pure[A](a: A): Toto[A] = Toto(a)
  }

  val bind: Bind[Toto] = new Bind[Toto] {
    def bind[A, B](fa: Toto[A])(f: A => Toto[B]): Toto[B] = f(fa.a)
  }

  // Toto is equipped by same laws as Foo (see above)
  implicit val laws = Laws[Toto](functor :: pointed :: bind :: HNilF[Toto]())
}

/** We provide another polykinded utils called SameLaws[F <: AnyKind, G <: AnyKind] that checks
  * both structures F & G have same laws
  */
SameLaws[Foo, Foo]
SameLaws[Foo, Toto]
// SameLaws[Foo, Bar] // KO

/** Please remark that all the tools used to build this sample are all kind-polymorphic and could re-used in other contexts
  * So, they can't be used in normal scala but need this (Scalac PR)[https://github.com/scala/scala/pull/5538]
  *
  * Now, let's imagine what else we can do with that ;)
  */

FullCode.scala

object Test {

  // PKList or the Any-Order heterogenous list
  sealed trait PKList[Args <: AnyKind]

  trait PKNil[Args <: AnyKind] extends PKList[Args]

  sealed trait PKCons[Args <: AnyKind, HA, TA <: PKList[Args]] extends PKList[Args] {
    def head: HA
    def tail: TA
  }

  object PKList {


    trait PKConsBuilder[Args <: AnyKind, HA, UL <: PKList[Args]] {
      type OutA
      def ::(l: UL)(ha: HA): OutA
    }

    implicit class PKListOps[
      Args <: AnyKind
    ](l: PKNil[Args]) {
      def ::[HA0](ha: HA0)(implicit unap: PKConsBuilder[Args, HA0, PKNil[Args]]): unap.OutA = unap.::(l)(ha)
    }

    implicit class PKListOps2[
      Args <: AnyKind
    , HA
    , T <: PKList[Args]
    ](l: PKCons[Args, HA, T]) {
      def ::[HA0](ha: HA0)(implicit unap: PKConsBuilder[Args, HA0, PKCons[Args, HA, T]]): unap.OutA = unap.::(l)(ha)
    }

    trait Contains[Args <: AnyKind, H, L <: PKList[Args]] {
      def apply(l: L): H
    }

    object Contains {
      def apply[Args <: AnyKind, H, L2 <: PKList[Args]](implicit is: Contains[Args, H, L2]) = is

      implicit def head[Args <: AnyKind, H, L2 <: PKList[Args]] = new Contains[Args, H, PKCons[Args, H, L2]] {
        def apply(l: PKCons[Args, H, L2]): H = l.head
      }

      implicit def corec[Args <: AnyKind, H, H2, L2 <: PKList[Args]] (
        implicit next: Contains[Args, H, L2]
      ) = new Contains[Args, H, PKCons[Args, H2, L2]]  {
        def apply(l: PKCons[Args, H2, L2]): H = next(l.tail)
      }
    }

    trait SameContainer[F <: AnyKind, G <: AnyKind]
    
    object SameContainer {
      def apply[F <: AnyKind, G <: AnyKind](implicit sc: SameContainer[F, G]) = sc

      implicit def sc1[F[_], A, B] = new SameContainer[F[A], F[B]] {}
      implicit def sc2[M[_[_]], F[_], G[_]] = new SameContainer[M[F], M[G]] {}
    }

    trait Contains2[Args <: AnyKind, H, L <: PKList[Args]] {
      type HO
      def apply(l: L): HO
    }

    object Contains2 {
      type Aux[Args <: AnyKind, H, L <: PKList[Args], H0] = Contains2[Args, H, L] { type HO = H0 }

      def apply[Args <: AnyKind, H, L2 <: PKList[Args]](implicit is: Contains2[Args, H, L2]) = is

      implicit def head[Args <: AnyKind, H, H2, L2 <: PKList[Args]](
        implicit sc: SameContainer[H, H2]
      ) = new Contains2[Args, H, PKCons[Args, H2, L2]] {
        type HO = H2
        def apply(l: PKCons[Args, H2, L2]): H2 = l.head
      }

      implicit def corec[Args <: AnyKind, H, H2, HO0, L2 <: PKList[Args]] (
        implicit next: Contains2.Aux[Args, H, L2, HO0]
      ) = new Contains2[Args, H, PKCons[Args, H2, L2]]  {
        type HO = HO0
        def apply(l: PKCons[Args, H2, L2]): HO0 = next(l.tail)
      }
    }

    trait IsSubPKList[Args <: AnyKind, L1 <: PKList[Args], L2 <: PKList[Args]] {
      def sub(l2: L2): L1
    }

    object IsSubPKList {
      def apply[Args <: AnyKind, L1 <: PKList[Args], L2 <: PKList[Args]](implicit is: IsSubPKList[Args, L1, L2]) = is

      implicit def nil[Args <: AnyKind, L2 <: PKList[Args]] = new IsSubPKList[Args, PKNil[Args], L2] {
        def sub(l2: L2): PKNil[Args] = new PKNil[Args] {}
      }

      implicit def head[Args <: AnyKind, H, L1 <: PKList[Args], L2 <: PKList[Args]](
        implicit c: Contains[Args, H, L2], next: IsSubPKList[Args, L1, L2]
      ) = new IsSubPKList[Args, PKCons[Args, H, L1], L2]  {
        def sub(l2: L2): PKCons[Args, H, L1] = new PKCons[Args, H, L1] {
          val head = c(l2)
          val tail = next.sub(l2)
        }
      }
    }

    trait IsSubPKList2[Args1 <: AnyKind, Args2 <: AnyKind, L1 <: PKList[Args1], L2 <: PKList[Args2]]

    object IsSubPKList2 {
      def apply[Args1 <: AnyKind, Args2 <: AnyKind, L1 <: PKList[Args1], L2 <: PKList[Args2]](implicit is: IsSubPKList2[Args1, Args2, L1, L2]) = is

      implicit def nil[Args1 <: AnyKind, Args2 <: AnyKind, L1 <: PKList[Args1], L2 <: PKList[Args2]] =
        new IsSubPKList2[Args1, Args2, PKNil[Args1], L2] {}

      implicit def head[Args1 <: AnyKind, Args2 <: AnyKind, H, L1 <: PKList[Args1], L2 <: PKList[Args2]](
        implicit c: Contains2[Args2, H, L2], next: IsSubPKList2[Args1, Args2, L1, L2]
      ) = new IsSubPKList2[Args1, Args2, PKCons[Args1, H, L1], L2]  {}
      
    }

  }

  object Lawful {
    import PKList._

    case class HNilF[F <: AnyKind]() extends PKNil[F]

    implicit def buildMCons[M[_ <: AnyKind], F <: AnyKind, T <: PKList[F]] =
      new PKConsBuilder[F, M[F], T] {
        type OutA = PKCons[F, M[F], T]

        def ::(l: T)(h: M[F]): OutA = new PKCons[F, M[F], T] {
          val head = h
          val tail = l
        }
      }

    trait Laws[F <: AnyKind] {
      type L <: PKList[F]
      def laws: L

    }

    object Laws {
      type Aux[F <: AnyKind, L0 <: PKList[F]] = Laws[F] { type L = L0 }

      class Builder[F] {
        def apply[L0 <: PKList[F]](l0: L0): Laws.Aux[F, L0] = new Laws[F] {
          type L = L0

          val laws = l0
        }
      }
      def apply[F <: AnyKind] = new Builder[F]

    }

    trait HasLaws[Args <: AnyKind, LS <: PKList[Args]] {
      def laws: LS
      def apply[HA](implicit c: Contains[Args, HA, LS]): HA = c(laws)
    }

    object HasLaws {
      def apply[Args <: AnyKind, LS <: PKList[Args]](implicit hasLaws: HasLaws[Args, LS]) = hasLaws

      implicit def hasLaws[Args <: AnyKind, LS <: PKList[Args], LS2 <: PKList[Args]](
        implicit la: Laws.Aux[Args, LS], issub: IsSubPKList[Args, LS2, LS]
      ) = new HasLaws[Args, LS2] {
        val laws = issub.sub(la.laws)
      }
    }

    trait HasLaw[Args <: AnyKind, L] {
      def law: L
    }

    object HasLaw {
      def apply[Args <: AnyKind, L](implicit hasLaws: HasLaws[Args, PKCons[Args, L, PKNil[Args]]]) =
        new HasLaw[Args, L] {
          val law = hasLaws.laws.head
        }

      implicit def hasLaw[Args <: AnyKind, L](implicit hasLaws: HasLaws[Args, PKCons[Args, L, PKNil[Args]]]) =
        new HasLaw[Args, L] {
          val law = hasLaws.laws.head
        }

    }

    trait LawsBuild[F <: AnyKind] {
      type ::[M[_ <: AnyKind], L <: PKList[F]] = PKCons[F, M[F], L]
      // type :::[M[_ <: AnyKind], L[_] <: PKList[F]] = PKCons[F, M[F], L[F]]

      type Laws <: PKList[F]
    }


    trait SameLaws[F <: AnyKind, G <: AnyKind]

    object SameLaws {
      def apply[ArgsF <: AnyKind, ArgsG <: AnyKind](implicit hasSame: SameLaws[ArgsF, ArgsG]) = hasSame

      implicit def hsl[ArgsF <: AnyKind, ArgsG <: AnyKind, LF <: PKList[ArgsF], LG <: PKList[ArgsG]] (
        implicit  
          fLaws: Laws.Aux[ArgsF, LF]
        , gLaws: Laws.Aux[ArgsG, LG]
        , sub1: IsSubPKList2[ArgsF, ArgsG, LF, LG]
        , sub2: IsSubPKList2[ArgsG, ArgsF, LG, LF]
      ) = new SameLaws[ArgsF, ArgsG] {}
    }
  }
  
  import PKList._
  import Lawful._

  // Pointed law
  trait Pointed[F[_]] {
    def pure[A](a: A): F[A]
  }

  // Functor law
  trait Functor[F[_]] {
    def map[A, B](fa: F[A])(f: A => B): F[B]
  }

  // Bind law
  trait Bind[F[_]] {
    def bind[A, B](fa: F[A])(f: A => F[B]): F[B]
  }

  // An applicative Functor is a Functor equipped with Pointed law
  type Applicative[F[_]] = (LawsBuild[F]{ type Laws = Functor :: Pointed :: PKNil[F] })#Laws

  // An Monad has Bind & Pointed laws
  type Monad[F[_]] = (LawsBuild[F]{ type Laws = Bind :: Pointed :: PKNil[F] })#Laws


  // the operations & implicits obtained directly
  object DirectImplicits {
    // to be able to write 5.pure[List]
    implicit class toPointed[A](a: A) {
      def pure[F[_]](implicit hasLaw: HasLaw[F, Pointed[F]]): F[A] = hasLaw.law.pure(a)
    }

    // to be able to write Foo(5).map(a => a.toString)
    implicit class toFunctor[F[_], A](fa: F[A]) {
      def map[B](f: A => B)(implicit hasLaw: HasLaw[F, Functor[F]]): F[B] = hasLaw.law.map(fa)(f)
    }

    // the direct implicits
    implicit def implFunctor[F[_]](implicit hasLaw: HasLaw[F, Functor[F]]): Functor[F] = hasLaw.law
    implicit def implPointed[F[_]](implicit hasLaw: HasLaw[F, Pointed[F]]): Pointed[F] = hasLaw.law
    implicit def implBind[F[_]](implicit hasLaw: HasLaw[F, Bind[F]]): Bind[F] = hasLaw.law

  }

  // the operations & implicits obtained from other laws
  object DerivedImplicits {
    // From a monad, you can obtain a Functor using bind/pure
    implicit def monadFunctor[F[_]](implicit hasLaws: HasLaws[F, Monad[F]]): Functor[F] = new Functor[F] {
      def map[A, B](fa: F[A])(f: A => B): F[B] = hasLaws[Bind[F]].bind(fa)(a => hasLaws[Pointed[F]].pure(f(a)))
    }

    // From a monad, you can prove it's also an applicative (because it can derive a Functor too)
    implicit def monadApplicative[F[_]](implicit hasLaws: HasLaws[F, Monad[F]]): HasLaws[F, Applicative[F]] =
      new HasLaws[F, Applicative[F]] {
        def laws: Applicative[F] = monadFunctor[F] :: hasLaws[Pointed[F]] :: HNilF[F]
      }
  }

  case class Foo[A](a: A)
  object Foo {
    val functor: Functor[Foo] = new Functor[Foo] {
      def map[A, B](fa: Foo[A])(f: A => B): Foo[B] = Foo(f(fa.a))
    }
    val pointed: Pointed[Foo] = new Pointed[Foo] {
      def pure[A](a: A): Foo[A] = Foo(a)
    }

    val bind: Bind[Foo] = new Bind[Foo] {
      def bind[A, B](fa: Foo[A])(f: A => Foo[B]): Foo[B] = f(fa.a)
    }

    // Foo is equipped by pointed, functor and bind laws
    implicit val laws = Laws[Foo](bind :: functor :: pointed :: HNilF[Foo]())
  }

  case class Bar[A](a: A)
  object Bar {
    val pointed: Pointed[Bar] = new Pointed[Bar] {
      def pure[A](a: A): Bar[A] = Bar(a)
    }

    val bind: Bind[Bar] = new Bind[Bar] {
      def bind[A, B](fa: Bar[A])(f: A => Bar[B]): Bar[B] = f(fa.a)
    }

    // Bar is equipped by pointed and bind laws but NOT functor
    implicit val laws = Laws[Bar](bind :: pointed :: HNilF[Bar]())
  }



  import DirectImplicits._

  Foo(5).map(i => i.toString)
  5.pure[Foo]
  HasLaw[Foo, Functor[Foo]]
  HasLaws[Foo, Applicative[Foo]]
  HasLaws[Foo, Monad[Foo]]

  // With direct implicits, Bar hasn't laws for Functor or Applicative (need DerivedImplicits to derive it from Monads)
  // implicitly[Functor[Bar]] // KO
  // HasLaws[Bar, Applicative[Bar]] // KO

  // import derived implicits
  import DerivedImplicits._
  // With derived implicits, Bar has a Functor and can be Applicative too
  implicitly[Functor[Bar]]
  HasLaws[Bar, Applicative[Bar]]

  // Another typeclass having the same laws as Foo
  case class Toto[A](a: A)
  object Toto {
    val functor: Functor[Toto] = new Functor[Toto] {
      def map[A, B](fa: Toto[A])(f: A => B): Toto[B] = Toto(f(fa.a))
    }
    val pointed: Pointed[Toto] = new Pointed[Toto] {
      def pure[A](a: A): Toto[A] = Toto(a)
    }

    val bind: Bind[Toto] = new Bind[Toto] {
      def bind[A, B](fa: Toto[A])(f: A => Toto[B]): Toto[B] = f(fa.a)
    }

    // Toto is equipped by pointed and bind laws but NOT functor
    implicit val laws = Laws[Toto](functor :: pointed :: bind :: HNilF[Toto]())
  }

  // Prove that structure has same laws or not
  SameLaws[Foo, Foo]
  SameLaws[Foo, Toto]
  // SameLaws[Foo, Bar] // KO
}