Skip to content

Commit 3abc0c4

Browse files
authored
Merge pull request #247 from victorg1991/victorg-setkw
Add wrapper class for Set
2 parents 539de80 + fb0c924 commit 3abc0c4

File tree

5 files changed

+70
-9
lines changed

5 files changed

+70
-9
lines changed

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

+11-6
Original file line numberDiff line numberDiff line change
@@ -7,16 +7,21 @@ object MonoidKLaws {
77

88
inline fun <reified F> laws(SGK: MonoidK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): List<Law> =
99
SemigroupKLaws.laws(SGK, AP, EQ) + listOf(
10-
Law("MonoidK Laws: Left identity", { monoidKLeftIdentity(SGK, AP, EQ) }),
11-
Law("MonoidK Laws: Right identity", { monoidKRightIdentity(SGK, AP, EQ) }))
10+
Law("MonoidK Laws: Left identity", { monoidKLeftIdentity(SGK, AP::pure, EQ) }),
11+
Law("MonoidK Laws: Right identity", { monoidKRightIdentity(SGK, AP::pure, EQ) }))
1212

13-
inline fun <reified F> monoidKLeftIdentity(SGK: MonoidK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): Unit =
14-
forAll(genApplicative(Gen.int(), AP), { fa: HK<F, Int> ->
13+
inline fun <reified F> laws(SGK: MonoidK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): List<Law> =
14+
SemigroupKLaws.laws(SGK, f, EQ) + listOf(
15+
Law("MonoidK Laws: Left identity", { monoidKLeftIdentity(SGK, f, EQ) }),
16+
Law("MonoidK Laws: Right identity", { monoidKRightIdentity(SGK, f, EQ) }))
17+
18+
inline fun <reified F> monoidKLeftIdentity(SGK: MonoidK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): Unit =
19+
forAll(genConstructor(Gen.int(), f), { fa: HK<F, Int> ->
1520
SGK.combineK(SGK.empty<Int>(), fa).equalUnderTheLaw(fa, EQ)
1621
})
1722

18-
inline fun <reified F> monoidKRightIdentity(SGK: MonoidK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): Unit =
19-
forAll(genApplicative(Gen.int(), AP), { fa: HK<F, Int> ->
23+
inline fun <reified F> monoidKRightIdentity(SGK: MonoidK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): Unit =
24+
forAll(genConstructor(Gen.int(), f), { fa: HK<F, Int> ->
2025
SGK.combineK(fa, SGK.empty<Int>()).equalUnderTheLaw(fa, EQ)
2126
})
2227
}

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

+6-3
Original file line numberDiff line numberDiff line change
@@ -6,10 +6,13 @@ import io.kotlintest.properties.forAll
66
object SemigroupKLaws {
77

88
inline fun <reified F> laws(SGK: SemigroupK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): List<Law> =
9-
listOf(Law("SemigroupK: associativity", { semigroupKAssociative(SGK, AP, EQ) }))
9+
listOf(Law("SemigroupK: associativity", { semigroupKAssociative(SGK, AP::pure, EQ) }))
1010

11-
inline fun <reified F> semigroupKAssociative(SGK: SemigroupK<F>, AP: Applicative<F>, EQ: Eq<HK<F, Int>>): Unit =
12-
forAll(genApplicative(Gen.int(), AP), genApplicative(Gen.int(), AP), genApplicative(Gen.int(), AP), { a, b, c ->
11+
inline fun <reified F> laws(SGK: SemigroupK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): List<Law> =
12+
listOf(Law("SemigroupK: associativity", { semigroupKAssociative(SGK, f, EQ) }))
13+
14+
inline fun <reified F> semigroupKAssociative(SGK: SemigroupK<F>, crossinline f: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): Unit =
15+
forAll(genConstructor(Gen.int(), f), genConstructor(Gen.int(), f), genConstructor(Gen.int(), f), { a, b, c ->
1316
SGK.combineK(SGK.combineK(a, b), c).equalUnderTheLaw(SGK.combineK(a, SGK.combineK(b, c)), EQ)
1417
})
1518
}
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
package kategory
2+
3+
@higherkind
4+
@deriving(Foldable::class, MonoidK::class)
5+
data class SetKW<out A>(val set: Set<A>) : SetKWKind<A>, Set<A> by set {
6+
7+
fun <B> foldL(b: B, f: (B, A) -> B): B = this.fold(b, f)
8+
9+
fun <B> foldR(lb: Eval<B>, f: (A, Eval<B>) -> Eval<B>): Eval<B> {
10+
fun loop(fa_p: SetKW<A>): Eval<B> = when {
11+
fa_p.set.isEmpty() -> lb
12+
else -> f(fa_p.set.first(), Eval.defer { loop(fa_p.set.drop(1).toSet().k()) })
13+
}
14+
return Eval.defer { loop(this) }
15+
}
16+
17+
companion object {
18+
19+
fun <A> pure(a: A): SetKW<A> = setOf(a).k()
20+
21+
fun <A> empty(): SetKW<A> = emptySet<A>().k()
22+
23+
fun <A> semigroup(): SetKWMonoid<A> = object : SetKWMonoid<A> {}
24+
25+
fun semigroupK(): SetKWHKMonoidKInstance = SetKW.monoidK()
26+
}
27+
}
28+
29+
fun <A> SetKW<A>.combineK(y: SetKWKind<A>): SetKW<A> = (this.set + y.ev().set).k()
30+
31+
fun <A> Set<A>.k(): SetKW<A> = SetKW(this)
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
package kategory
2+
3+
interface SetKWMonoid<A> : Monoid<SetKW<A>> {
4+
override fun combine(a: SetKW<A>, b: SetKW<A>): SetKW<A> = (a + b).k()
5+
6+
override fun empty(): SetKW<A> = emptySet<A>().k()
7+
}
8+
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
package kategory
2+
3+
import io.kotlintest.KTestJUnitRunner
4+
import org.junit.runner.RunWith
5+
6+
@RunWith(KTestJUnitRunner::class)
7+
class SetKWTest : UnitSpec() {
8+
9+
init {
10+
testLaws(SemigroupKLaws.laws(SetKW.semigroupK(), { SetKW.pure(it) }, Eq.any()))
11+
testLaws(MonoidKLaws.laws(SetKW.monoidK(), { SetKW.pure(it) }, Eq.any()))
12+
testLaws(FoldableLaws.laws(SetKW.foldable(), { SetKW.pure(it) }, Eq.any()))
13+
}
14+
}

0 commit comments

Comments
 (0)