Merge pull request #247 from victorg1991/victorg-setkw

Add wrapper class for Set

Author: pakoito

kategory-test/src/main/kotlin/kategory/laws/MonoidKLaws.kt

@@ -7,16 +7,21 @@ object MonoidKLaws {
 
     inline fun <reified F> laws(SGK: MonoidK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): List<Law> =
             SemigroupKLaws.laws(SGK, AP, EQ) + listOf(
-                    Law("MonoidK Laws: Left identity", { monoidKLeftIdentity(SGK, AP, EQ) }),
-                    Law("MonoidK Laws: Right identity", { monoidKRightIdentity(SGK, AP, EQ) }))
+                    Law("MonoidK Laws: Left identity", { monoidKLeftIdentity(SGK, AP::pure, EQ) }),
+                    Law("MonoidK Laws: Right identity", { monoidKRightIdentity(SGK, AP::pure, EQ) }))
 
-    inline fun <reified F> monoidKLeftIdentity(SGK: MonoidK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): Unit =
-            forAll(genApplicative(Gen.int(), AP), { fa: HK<F, Int> ->
+    inline fun <reified F> laws(SGK: MonoidK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): List<Law> =
+            SemigroupKLaws.laws(SGK, f, EQ) + listOf(
+                    Law("MonoidK Laws: Left identity", { monoidKLeftIdentity(SGK, f, EQ) }),
+                    Law("MonoidK Laws: Right identity", { monoidKRightIdentity(SGK, f, EQ) }))
+
+    inline fun <reified F> monoidKLeftIdentity(SGK: MonoidK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): Unit =
+            forAll(genConstructor(Gen.int(), f), { fa: HK<F, Int> ->
                 SGK.combineK(SGK.empty<Int>(), fa).equalUnderTheLaw(fa, EQ)
             })
 
-    inline fun <reified F> monoidKRightIdentity(SGK: MonoidK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): Unit =
-            forAll(genApplicative(Gen.int(), AP), { fa: HK<F, Int> ->
+    inline fun <reified F> monoidKRightIdentity(SGK: MonoidK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): Unit =
+            forAll(genConstructor(Gen.int(), f), { fa: HK<F, Int> ->
                 SGK.combineK(fa, SGK.empty<Int>()).equalUnderTheLaw(fa, EQ)
             })
 }

kategory-test/src/main/kotlin/kategory/laws/SemigroupKlaws.kt

@@ -6,10 +6,13 @@ import io.kotlintest.properties.forAll
 object SemigroupKLaws {
 
     inline fun <reified F> laws(SGK: SemigroupK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): List<Law> =
-            listOf(Law("SemigroupK: associativity", { semigroupKAssociative(SGK, AP, EQ) }))
+            listOf(Law("SemigroupK: associativity", { semigroupKAssociative(SGK, AP::pure, EQ) }))
 
-    inline fun <reified F> semigroupKAssociative(SGK: SemigroupK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): Unit =
-            forAll(genApplicative(Gen.int(), AP), genApplicative(Gen.int(), AP), genApplicative(Gen.int(), AP), { a, b, c ->
+    inline fun <reified F> laws(SGK: SemigroupK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): List<Law> =
+            listOf(Law("SemigroupK: associativity", { semigroupKAssociative(SGK, f, EQ) }))
+
+    inline fun <reified F> semigroupKAssociative(SGK: SemigroupK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): Unit =
+            forAll(genConstructor(Gen.int(), f), genConstructor(Gen.int(), f), genConstructor(Gen.int(), f), { a, b, c ->
                 SGK.combineK(SGK.combineK(a, b), c).equalUnderTheLaw(SGK.combineK(a, SGK.combineK(b, c)), EQ)
             })
 }

kategory/src/main/kotlin/kategory/data/SetKW.kt

@@ -0,0 +1,31 @@
+package kategory
+
+@higherkind
+@deriving(Foldable::class, MonoidK::class)
+data class SetKW<out A>(val set: Set<A>) : SetKWKind<A>, Set<A> by set {
+
+    fun <B> foldL(b: B, f: (B, A) -> B): B = this.fold(b, f)
+
+    fun <B> foldR(lb: Eval<B>, f: (A, Eval<B>) -> Eval<B>): Eval<B> {
+        fun loop(fa_p: SetKW<A>): Eval<B> = when {
+            fa_p.set.isEmpty() -> lb
+            else -> f(fa_p.set.first(), Eval.defer { loop(fa_p.set.drop(1).toSet().k()) })
+        }
+        return Eval.defer { loop(this) }
+    }
+
+    companion object {
+
+        fun <A> pure(a: A): SetKW<A> = setOf(a).k()
+
+        fun <A> empty(): SetKW<A> = emptySet<A>().k()
+
+        fun <A> semigroup(): SetKWMonoid<A> = object : SetKWMonoid<A> {}
+
+        fun semigroupK(): SetKWHKMonoidKInstance = SetKW.monoidK()
+    }
+}
+
+fun <A> SetKW<A>.combineK(y: SetKWKind<A>): SetKW<A> = (this.set + y.ev().set).k()
+
+fun <A> Set<A>.k(): SetKW<A> = SetKW(this)

kategory/src/main/kotlin/kategory/instances/SetKWInstances.kt

@@ -0,0 +1,8 @@
+package kategory
+
+interface SetKWMonoid<A> : Monoid<SetKW<A>> {
+    override fun combine(a: SetKW<A>, b: SetKW<A>): SetKW<A> = (a + b).k()
+
+    override fun empty(): SetKW<A> = emptySet<A>().k()
+}
+

kategory/src/test/kotlin/kategory/data/SetKWTest.kt

@@ -0,0 +1,14 @@
+package kategory
+
+import io.kotlintest.KTestJUnitRunner
+import org.junit.runner.RunWith
+
+@RunWith(KTestJUnitRunner::class)
+class SetKWTest : UnitSpec() {
+
+    init {
+        testLaws(SemigroupKLaws.laws(SetKW.semigroupK(), { SetKW.pure(it) }, Eq.any()))
+        testLaws(MonoidKLaws.laws(SetKW.monoidK(), { SetKW.pure(it) }, Eq.any()))
+        testLaws(FoldableLaws.laws(SetKW.foldable(), { SetKW.pure(it) }, Eq.any()))
+    }
+}