1+ // Adapted from github:mandubian/kind-polymorphic-semigroup.scala
2+ sealed trait HList
3+ case class HCons [+ HD , + TL ](hd : HD , tl : TL ) extends HList
4+ case object HNil extends HList
5+
6+ object Test {
7+
8+ type HNil = HNil .type
9+
10+ // Kind Extractor
11+ trait Kinder [MA ] { type M <: AnyKind }
12+ object Kinder extends KinderLowerImplicits {
13+ type Aux [MA , M0 <: AnyKind ] = Kinder [MA ] { type M = M0 }
14+
15+ implicit def kinder1 [M0 [_], A0 ]: Kinder .Aux [M0 [A0 ], M0 ] =
16+ new Kinder [M0 [A0 ]] { type M [t] = M0 [t] }
17+ implicit def kinder2 [M0 [_, _], A0 , B0 ]: Kinder .Aux [M0 [A0 , B0 ], M0 ] =
18+ new Kinder [M0 [A0 , B0 ]] { type M [t, u] = M0 [t, u]; type Args = HCons [A0 , HCons [B0 , HNil ]] }
19+ }
20+ trait KinderLowerImplicits {
21+ implicit def kinder0 [A ]: Kinder .Aux [A , A ] = new Kinder [A ] { type M = A ; type Args = HNil }
22+ }
23+
24+ // Kind Polymorphic Semigroup using shapeless "Polymorphic function"-style
25+ trait SemiGroup [M <: AnyKind ] {
26+ // Just a mirror type of itself to ensure the owning of AppendFunction...
27+ type Self
28+ // the function accepting only monomorphic type MA allowed by this scoped Semigroup AppendFunction
29+ def append [MA ](m1 : MA , m2 : MA )(implicit appender : SemiGroup .AppendFunction [Self , MA , M ]) = appender(m1, m2)
30+ }
31+
32+ object SemiGroup {
33+ type Aux [M <: AnyKind , Self0 ] = SemiGroup [M ] { type Self = Self0 }
34+
35+ // the monomorphic append function (yes we need to reify monomorphic types sometimes)
36+ trait AppendFunction [P , FA , F <: AnyKind ] {
37+ def apply (m1 : FA , m2 : FA ): FA
38+ }
39+ }
40+
41+ // Int SemiGroup instance
42+ implicit object SemiGroupInt extends SemiGroup [Int ] {
43+ type Self = this .type
44+ implicit val appender : SemiGroup .AppendFunction [Self , Int , Int ]= new SemiGroup .AppendFunction [Self , Int , Int ] {
45+ def apply (m1 : Int , m2 : Int ) = m1 + m2
46+ }
47+ }
48+
49+ // List SemiGroup instance
50+ implicit object SemiGroupList extends SemiGroup [List ] {
51+ type Self = this .type
52+ implicit def appender [A ]: SemiGroup .AppendFunction [Self , List [A ], List ] = new {
53+ def apply (m1 : List [A ], m2 : List [A ]) = m1 ++ m2
54+ }
55+ }
56+
57+ // Map SemiGroup instance
58+ implicit object SemiGroupMap extends SemiGroup [Map ] {
59+ type Self = this .type
60+ implicit def appender [A , B ]: SemiGroup .AppendFunction [Self , Map [A , B ], Map ] = new {
61+ def apply (m1 : Map [A , B ], m2 : Map [A , B ]) = m1 ++ m2
62+ }
63+ }
64+
65+ // Searching a semigroup and using it
66+ def semiGroup [M <: AnyKind ](implicit sg : SemiGroup [M ]): SemiGroup .Aux [M , sg.Self ] = sg
67+
68+ semiGroup[Int ].append(5 , 8 )
69+ semiGroup[List ].append(List (1 ), List (3 ))
70+ semiGroup[Map ].append(Map (" toto" -> 1L ), Map (" tata" -> 3L ))
71+
72+ // higher level append function
73+ def append [MA , M <: AnyKind , Self ](m1 : MA , m2 : MA )(
74+ implicit kinder : Kinder .Aux [MA , M ], semiGroup : SemiGroup .Aux [M , Self ], appender : SemiGroup .AppendFunction [Self , MA , M ]
75+ ): MA = semiGroup.append(m1, m2)
76+
77+ import SemiGroupList .appender
78+ import SemiGroupMap .appender
79+
80+ val r1 : Int = append(5 , 8 )
81+
82+ // TODO: Figure igure out why `M` below cannot be inferred
83+ val r2 : List [Int ] = append[M = List ](List (1 ), List (3 ))
84+ val r3 : Map [String , Long ] = append[M = Map ](Map (" toto" -> 1L ), Map (" tata" -> 3L ))
85+ }
0 commit comments