"Distributive property" with Shapeless

Question

Not sure if the correct term is "distributive property" but I remember learning this in school so here's an example of what I'm trying to do:

Given:

type MyHList = (A :+: B :+: C :+: CNil) :: (Foo :+: Bar :+: CNil) :: HNil

is there any built-in type class in Shapeless that will out this:

type Out = (A, Foo) :+: (A, Bar) :+: (B, Foo) :+: (B, Bar) :+: (C, Foo) :+: (C, Bar) :+: CNil

?

Thanks

Answer 1

I would call such transformation cartesian, tensor or direct product (i.e. a product of each term by each term, on contrary to inner product / scalar product / zipping). Although indeed it relates to distributive law.

I guess there is no such standard type class literally but it can be expressed via standard ones

import shapeless.{:+:, ::, CNil, Coproduct, HList, HNil, Poly1, poly}
import shapeless.ops.coproduct.{FlatMap, Mapper}

trait Cartesian[L <: HList] {
  type Out <: Coproduct
}
object Cartesian {
  type Aux[L <: HList, Out0 <: Coproduct] = Cartesian[L] { type Out = Out0 }

  implicit def mkCartesian[C <: Coproduct, C1 <: Coproduct](implicit
    flatMap: FlatMap[C, MapperPoly[C1]]
  ): Aux[C :: C1 :: HNil, flatMap.Out] = null

  trait MapperPoly[C <: Coproduct] extends Poly1
  object MapperPoly {
    implicit def cse[C <: Coproduct, A](implicit
      mapper: Mapper[TuplePoly[A], C]
    ): poly.Case1.Aux[MapperPoly[C], A, mapper.Out] = null
  }

  trait TuplePoly[A] extends Poly1
  object TuplePoly {
    implicit def cse[A, B]: poly.Case1.Aux[TuplePoly[A], B, (A, B)] = null
  }
}

implicitly[Cartesian.Aux[MyHList, Out]] // compiles

The type class Cartesian is now acting on type level only. It's possible that on value level its definition would be a little trickier (with poly.Case1.Aux[P, ... for P <: MapperPoly[C], poly.Case1.Aux[P, ... for P <: TuplePoly[A] rather than poly.Case1.Aux[MapperPoly[C], ..., poly.Case1.Aux[TuplePoly[A], ... and using Unpack1, see Filter a HList using a supertype ). Update: Or maybe not :)

Also there is always an option to define a custom type class recursively rather than try to deduce everything to standard type classes.

---

Here is recursive type-level implementation for multiple HLists of Coproducts (not necessary two)

// transforms an hlist of coproducts into a coproduct of tuples
trait Cartesian[L <: HList] {
  type Out <: Coproduct
}
object Cartesian {
  type Aux[L <: HList, Out0 <: Coproduct] = Cartesian[L] { type Out = Out0 }

  implicit def mkCartesian[L <: HList, C <: Coproduct](implicit
    cartesian: CartesianHelper.Aux[L, C],
    mapper: coproduct.Mapper[tuplerPoly.type, C]
  ): Aux[L, mapper.Out] = null

  object tuplerPoly extends Poly1 {
    implicit def cse[L <: HList](implicit
      tupler: hlist.Tupler[L]
    ): Case.Aux[L, tupler.Out] = null
  }
}

// transforms an hlist of coproducts into a coproduct of hlists
trait CartesianHelper[L <: HList] {
  type Out <: Coproduct
}
trait LowPriorityHelper1 {
  type Aux[L <: HList, Out0 <: Coproduct] = CartesianHelper[L] { type Out = Out0 }

  // (a + (a1+...)) * (b1+...) * (c1+...) * ... 
  //  = a * ((b1+...) * (c1+...) * ...) 
  //  + ((a1+...) * (b1+...) * (c1+...) * ...)
  implicit def recurse[H, T <: Coproduct, T1 <: HList,
    C <: Coproduct, C1 <: Coproduct, C2 <: Coproduct](implicit
    ev: T1 <:< (_ :: _),
    cartesian: Aux[T1, C],
    mapper: coproduct.Mapper.Aux[PrependPoly[H], C, C1],
    cartesian1: Aux[T :: T1, C2],
    extendBy: coproduct.ExtendBy[C1, C2]
  ): Aux[(H :+: T) :: T1, extendBy.Out] = null

  trait PrependPoly[H] extends Poly1
  object PrependPoly {
    implicit def cse[H, L <: HList]: poly.Case1.Aux[PrependPoly[H], L, H :: L] = null
  }
}
trait LowPriorityHelper extends LowPriorityHelper1 {
  implicit def one[C <: Coproduct](implicit 
    mapper: coproduct.Mapper[prependPoly.type, C]
  ): Aux[C :: HNil, mapper.Out] = null

  object prependPoly extends Poly1 {
    implicit def cse[A]: Case.Aux[A, A :: HNil] = null
  }
}
object CartesianHelper extends LowPriorityHelper {
  implicit def hnil: Aux[HNil, CNil] = null
  implicit def cnil[T <: HList]: Aux[CNil :: T, CNil] = null
}

type MyHList1 = (A :+: B :+: C :+: CNil) :: (Foo :+: Bar :+: CNil) :: (X :+: Y :+: CNil) :: HNil
type Out1 = (A, Foo, X) :+: (A, Foo, Y) :+: (A, Bar, X) :+: (A, Bar, Y) :+: (B, Foo, X) :+: (B, Foo, Y) :+:
  (B, Bar, X) :+: (B, Bar, Y) :+: (C, Foo, X) :+: (C, Foo, Y) :+:  (C, Bar, X) :+: (C, Bar, Y) :+: CNil
implicitly[Cartesian.Aux[MyHList1, Out1]] // compiles

---

Adding value level:

def cartesian[L <: HList](l: L)(implicit cart: Cartesian[L]): cart.Out = cart(l)

trait Cartesian[L <: HList] extends DepFn1[L] {
  type Out <: Coproduct
}
object Cartesian {
  type Aux[L <: HList, Out0 <: Coproduct] = Cartesian[L] { type Out = Out0 }
  def instance[L <: HList, Out0 <: Coproduct](f: L => Out0): Aux[L, Out0] =
    new Cartesian[L] {
      override type Out = Out0
      override def apply(l: L): Out0 = f(l)
    }

  implicit def mkCartesian[L <: HList, C <: Coproduct](implicit
    cartesian: CartesianHelper.Aux[L, C],
    mapper: coproduct.Mapper[tuplerPoly.type, C]
  ): Aux[L, mapper.Out] = instance(l => mapper(cartesian(l)))

  object tuplerPoly extends Poly1 {
    implicit def cse[L <: HList](implicit
      tupler: hlist.Tupler[L]
    ): Case.Aux[L, tupler.Out] = at(tupler(_))
  }
}

trait CartesianHelper[L <: HList] extends DepFn1[L] {
  type Out <: Coproduct
}
trait LowPriorityHelper1 {
  type Aux[L <: HList, Out0 <: Coproduct] = CartesianHelper[L] { type Out = Out0 }
  def instance[L <: HList, Out0 <: Coproduct](f: L => Out0): Aux[L, Out0] =
    new CartesianHelper[L] {
      override type Out = Out0
      override def apply(l: L): Out0 = f(l)
    }

  implicit def recurse[H, T <: Coproduct, T1 <: HList,
    C <: Coproduct, C1 <: Coproduct, C2 <: Coproduct](implicit
    ev: T1 <:< (_ :: _),
    cartesian: Aux[T1, C],
    prepend: Prepend.Aux[H, C, C1],
    cartesian1: Aux[T :: T1, C2],
    extendBy: coproduct.ExtendBy[C1, C2]
  ): Aux[(H :+: T) :: T1, extendBy.Out] =
    instance(l => {
      val t1 = l.tail
      val c = cartesian(t1)
      l.head.eliminate(h => {
        val c1 = prepend(h, c)
        extendBy.right(c1)
      }, t => {
        val c2 = cartesian1(t :: t1)
        extendBy.left(c2)
      })
    })

  // custom type class instead of mapping with a generic Poly
  trait Prepend[H, C <: Coproduct] extends DepFn2[H, C] {
    type Out <: Coproduct
  }
  object Prepend {
    type Aux[H, C <: Coproduct, Out0 <: Coproduct] = Prepend[H, C] { type Out = Out0 }
    def instance[H, C <: Coproduct, Out0 <: Coproduct](f: (H, C) => Out0): Aux[H, C, Out0] =
      new Prepend[H, C] {
        override type Out = Out0
        override def apply(h: H, c: C): Out0 = f(h, c)
      }

    implicit def cnil[H]: Aux[H, CNil, CNil] = instance((_, _) => unexpected)
    implicit def ccons[H, L <: HList, C <: Coproduct](implicit
      prepend: Prepend[H, C]
    ): Aux[H, L :+: C, (H :: L) :+: prepend.Out] =
      instance((h, c) =>
        c.eliminate(
          l => Inl(h :: l),
          c => Inr(prepend(h, c))
        )
      )
  }
}
trait LowPriorityHelper extends LowPriorityHelper1 {
  implicit def one[C <: Coproduct](implicit
    mapper: coproduct.Mapper[prependPoly.type, C]
  ): Aux[C :: HNil, mapper.Out] = instance(l => mapper(l.head))

  object prependPoly extends Poly1 {
    implicit def cse[A]: Case.Aux[A, A :: HNil] = at(_ :: HNil)
  }
}
object CartesianHelper extends LowPriorityHelper {
  implicit def hnil: Aux[HNil, CNil] = instance(_ => unexpected)
  implicit def cnil[T <: HList]: Aux[CNil :: T, CNil] = instance(_ => unexpected)
}

val c: C = new C {}
val bar: Bar = new Bar {}
val myHList: MyHList = Inr(Inr(Inl(c))) :: Inr(Inl(bar)) :: HNil
val res = cartesian(myHList)
res: Out // compiles
res == Inr(Inr(Inr(Inr(Inr(Inl((c, bar))))))) // true

I replaced mapping a coproduct with PrependPoly[H] by a custom type class Prepend[H, C <: Coproduct] because generic Poly are tricky and not everything can be done with them on value level.

issue #198: Injecting values to a Poly defined outside of calling method is awkward

issue #154: Improve support for partial application of Polys

Passing an extra argument into a polymorphic function?

Pick out the Nth element of a HList of Lists and return that value as a HList of values

Dynamically parametrize Poly1 function in shapeless

shapeless-dev: How to "parameterize" poly function?

HList folding function that requires the HList

Parameterise filtering of element in of shapeless Hlist of Lists

---

See also:

Taking HList of Seq[_] and generating Seq[HList] with cartesian product of values

Cartesian product of heterogeneous lists (Haskell)