"Distributive property" with Shapeless - scala

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)