HList type chain

shiritori.sc

import shapeless._
import shapeless.ops.hlist._

object typeChainCat {
  trait Id[A] {
    type Out
    def apply(l: A): Out
  }
  object Id {
    type Aux[L, O] = Id[L] { type Out = O }
    def apply[L](implicit s: Id[L]): Aux[L, s.Out] = s

    implicit def typeChainId[A]: Id.Aux[A, A :: HNil] = new Id[A] {
      type Out = A :: HNil
      def apply(a: A): Out = a :: HNil
    }
  }

  trait Compose[L, R] {
    type Out
    def apply(l: L, r: R): Out
  }
  object Compose {
    type Aux[L, R, O] = Compose[L, R] { type Out = O }
    def apply[L, R](implicit s: Compose[L, R]): Aux[L, R, s.Out] = s

    implicit def typeChainCompose[
      L <: HList,
      LL,
      R <: HList,
      TR <: HList,
      O <: HList](
    implicit
      last:    Last.Aux[L, LL],
      isHCons: IsHCons.Aux[R, LL, TR],
      prepend: Prepend.Aux[L, TR, O]
    ): Compose.Aux[L, R, prepend.Out] = new Compose[L, R] {
      type Out = prepend.Out
      def apply(l: L, r: R): Out = prepend.apply(l, isHCons.tail(r))
    }
  }

  trait Assoc[A, B, C] {
    type Out
    def apply(a: A, b: B, c: C): Out
  }
  object Assoc {
    type Aux[A, B, C, O] = Assoc[A, B, C] { type Out = O }
    def apply[A, B, C](implicit s: Assoc[A, B, C]): Aux[A, B, C, s.Out] = s

    implicit def typeChainAssociativity[
        A <: HList, B <: HList, C <: HList, AB <: HList, BC <: HList, O <: HList
      ]( implicit
        ab: typeChainCat.Compose.Aux[A,  B,  AB],
        o1: typeChainCat.Compose.Aux[AB, C,  O],
        bc: typeChainCat.Compose.Aux[B,  C,  BC],
        o2: typeChainCat.Compose.Aux[A,  BC, O]
    ): Assoc.Aux[A, B, C, O] = new Assoc[A, B, C] {
      type Out = O
      def apply(a: A, b: B, c: C): Out = o1.apply(ab.apply(a, b), c)
    }
  }

  trait LeftIdentity[A, B] {
    def apply(a: A, b: B): B
  }
  object LeftIdentity {
    def apply[A, B](implicit s: LeftIdentity[A, B]): LeftIdentity[A, B] = s
    implicit def typeChainLeftIdentity[A, IDA <: HList, B <: HList](
      implicit
        id: typeChainCat.Id.Aux[A, IDA],
        ab: typeChainCat.Compose.Aux[IDA, B, B]
      ): LeftIdentity[A, B] = (_, b) => b
  }

  trait RightIdentity[A, B] {
    def apply(a: A, b: B): A
  }
  object RightIdentity {
    def apply[A, B](implicit s: RightIdentity[A, B]): RightIdentity[A, B] = s
    implicit def typeChainRightIdentity[A <: HList, B, IDB <: HList](
      implicit
        id: typeChainCat.Id.Aux[B, IDB],
        ab: typeChainCat.Compose.Aux[A, IDB, A]
      ): RightIdentity[A, B] = (a, _) => a
  }
}

def testAssoc[
    A <: HList, B <: HList, C <: HList, O <: HList
  ](implicit ab: typeChainCat.Assoc.Aux[A, B, C, O]): Unit = ()

testAssoc[
  Int    :: String  :: HNil, // A
  String :: Double  :: HNil, // B
  Double :: Boolean :: HNil, // C
  Int    :: String  :: Double  :: Boolean :: HNil // A・B・C
]

def testLeftIdentity[A, B <: HList](
  implicit id: typeChainCat.LeftIdentity[A, B]): Unit = ()

testLeftIdentity[Int, Int :: String :: HNil]

def testRightIdentity[A <: HList, B](
  implicit ab: typeChainCat.RightIdentity[A, B]): Unit = ()

testRightIdentity[Double :: String :: HNil, String]

testAssoc[
  Int     :: HNil,            // IDa
  Int     :: Boolean :: HNil, // B
  Boolean :: HNil,            // IDc
  Int     :: Boolean :: HNil  // IDa・B = B・IDc = B
]