Skip to content

Commit 1d1d2e1

Browse files
pakoitopakoito
authored
Merge branch 'master' into pt/sequence
2 parents bd00fb8 + 128f330 commit 1d1d2e1

File tree

7 files changed

+138
-49
lines changed

7 files changed

+138
-49
lines changed

‎kategory-test/src/main/kotlin/kategory/laws/MonadFilterLaws.kt

+29
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
package kategory.laws
2+
3+
import io.kotlintest.properties.Gen
4+
import io.kotlintest.properties.forAll
5+
import kategory.*
6+
7+
object MonadFilterLaws {
8+
9+
inline fun <reified F> laws(MF: MonadFilter<F> = monadFilter<F>(), crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): List<Law> =
10+
MonadLaws.laws(MF, EQ) + FunctorFilterLaws.laws(MF, cf, EQ) + listOf(
11+
Law("MonadFilter Laws: Left Empty", { monadFilterLeftEmpty(MF, EQ) }),
12+
Law("MonadFilter Laws: Right Empty", { monadFilterRightEmpty(MF, cf, EQ) }),
13+
Law("MonadFilter Laws: Consistency", { monadFilterConsistency(MF, cf, EQ) }))
14+
15+
inline fun <reified F> monadFilterLeftEmpty(MF: MonadFilter<F> = monadFilter<F>(), EQ: Eq<HK<F, Int>>): Unit =
16+
forAll(genFunctionAToB(genApplicative(Gen.int(), MF)), { f: (Int) -> HK<F, Int> ->
17+
MF.empty<Int>().flatMap(MF, f).equalUnderTheLaw(MF.empty(), EQ)
18+
})
19+
20+
inline fun <reified F> monadFilterRightEmpty(MF: MonadFilter<F> = monadFilter<F>(), crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): Unit =
21+
forAll(genFunctionAToB(genApplicative(Gen.int(), MF)), genConstructor(Gen.int(), cf), { f: (Int) -> HK<F, Int>, fa: HK<F, Int> ->
22+
MF.flatMap(fa, { MF.empty<Int>() }).equalUnderTheLaw(MF.empty(), EQ)
23+
})
24+
25+
inline fun <reified F> monadFilterConsistency(MF: MonadFilter<F> = monadFilter<F>(), crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>): Unit =
26+
forAll(genFunctionAToB(Gen.bool()), genConstructor(Gen.int(), cf), { f: (Int) -> Boolean, fa: HK<F, Int> ->
27+
MF.filter(fa, f).equalUnderTheLaw(fa.flatMap(MF, { a -> if (f(a)) MF.pure(a) else MF.empty() }), EQ)
28+
})
29+
}

‎kategory/src/main/kotlin/kategory/data/Option.kt

+1-1
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ package kategory
77
* are either an instance of $some or the object $none.
88
*/
99
@higherkind
10-
@deriving(Functor::class, Applicative::class, Monad::class, Foldable::class, Traverse::class)
10+
@deriving(Functor::class, Applicative::class, Monad::class, Foldable::class, Traverse::class, MonadFilter::class)
1111
sealed class Option<out A> : OptionKind<A> {
1212

1313
companion object {

‎kategory/src/main/kotlin/kategory/data/WriterT.kt

+39-30
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ package kategory
55
@higherkind data class WriterT<F, W, A>(val MF: Monad<F>, val value: HK<F, Tuple2<W, A>>) : WriterTKind<F, W, A> {
66

77
companion object {
8+
89
inline fun <reified F, reified W, A> pure(a: A, MM: Monoid<W> = monoid(), MF: Monad<F> = kategory.monad()) = WriterT(MF.pure(MM.empty() toT a), MF)
910

1011
inline fun <reified F, W, A> both(w: W, a: A, MF: Monad<F> = kategory.monad()) = WriterT(MF.pure(w toT a), MF)
@@ -13,58 +14,66 @@ package kategory
1314

1415
inline operator fun <reified F, W, A> invoke(value: HK<F, Tuple2<W, A>>, MF: Monad<F> = kategory.monad()) = WriterT(MF, value)
1516

16-
inline fun <reified F, reified W> instances(MM: Monad<F> = kategory.monad(), SG: Monoid<W> = kategory.monoid<W>()): WriterTInstances<F, W> =
17-
object : WriterTInstances<F, W> {
18-
19-
override fun <A> writer(aw: Tuple2<W, A>): WriterT<F, W, A> = WriterT.put(aw.b, aw.a)
20-
21-
override fun <A> listen(fa: HK<WriterTKindPartial<F, W>, A>): HK<WriterTKindPartial<F, W>, Tuple2<W, A>> =
22-
WriterT(MM, MM.flatMap(fa.ev().content(), { a -> MM.map(fa.ev().write(), { l -> Tuple2(l, Tuple2(l, a)) }) }))
23-
24-
override fun <A> pass(fa: HK<WriterTKindPartial<F, W>, Tuple2<(W) -> W, A>>): HK<WriterTKindPartial<F, W>, A> =
25-
WriterT(MM, MM.flatMap(fa.ev().content(), { tuple2FA -> MM.map(fa.ev().write(), { l -> Tuple2(tuple2FA.a(l), tuple2FA.b) }) }))
26-
27-
override fun tell(w: W): HK<WriterTKindPartial<F, W>, Unit> = WriterT.tell(w)
28-
29-
override fun MM(): Monad<F> = MM
30-
31-
override fun SG(): Monoid<W> = SG
17+
inline fun <reified F, reified W> functor(FF: Functor<F> = kategory.functor<F>()): WriterTFunctor<F, W> =
18+
object : WriterTFunctor<F, W> {
19+
override fun F0(): Functor<F> = FF
3220
}
3321

34-
inline fun <reified F, reified W> functor(MM: Monad<F> = kategory.monad<F>(), SG: Monoid<W> = kategory.monoid<W>()): Functor<WriterTKindPartial<F, W>> =
35-
instances(MM, SG)
36-
37-
inline fun <reified F, reified W> applicative(MM: Monad<F> = kategory.monad<F>(), SG: Monoid<W> = kategory.monoid<W>()):
38-
Applicative<WriterTKindPartial<F, W>> = instances(MM, SG)
22+
inline fun <reified F, reified W> applicative(MF: Monad<F> = kategory.monad<F>(),
23+
MW: Monoid<W> = kategory.monoid<W>()): WriterTApplicative<F, W> =
24+
object : WriterTApplicative<F, W> {
25+
override fun F0(): Monad<F> = MF
26+
override fun L0(): Monoid<W> = MW
27+
}
3928

40-
inline fun <reified F, reified W> monad(MM: Monad<F> = kategory.monad<F>(), SG: Monoid<W> = kategory.monoid<W>()): Monad<WriterTKindPartial<F, W>> =
41-
instances(MM, SG)
29+
inline fun <reified F, reified W> monad(MF: Monad<F> = kategory.monad<F>(), MW: Monoid<W> = kategory.monoid<W>()): WriterTMonad<F, W> =
30+
object : WriterTMonadWriter<F, W> {
31+
override fun F0(): Monad<F> = MF
32+
override fun L0(): Monoid<W> = MW
33+
}
4234

43-
inline fun <reified F, reified W> semigroupK(MF: Monad<F> = monad<F>(), SGK: SemigroupK<F> = semigroupK<F>()): SemigroupK<WriterTKindPartial<F, W>> =
35+
inline fun <reified F, reified W> semigroupK(MF: Monad<F> = monad<F>(), MKF: SemigroupK<F> = semigroupK<F>()): WriterTSemigroupK<F, W> =
4436
object : WriterTSemigroupK<F, W> {
4537
override fun MF(): Monad<F> = MF
46-
47-
override fun GF(): SemigroupK<F> = SGK
38+
override fun F0(): SemigroupK<F> = MKF
4839
}
4940

50-
inline fun <reified F, reified W> monoidK(MF: Monad<F> = monad<F>(), MKF: MonoidK<F> = monoidK<F>()): MonoidK<WriterTKindPartial<F, W>> =
41+
inline fun <reified F, reified W> monoidK(MF: Monad<F> = monad<F>(), MKF: MonoidK<F> = monoidK<F>()): WriterTMonoidK<F, W> =
5142
object : WriterTMonoidK<F, W> {
5243
override fun MF(): Monad<F> = MF
44+
override fun F0(): MonoidK<F> = MKF
45+
}
5346

54-
override fun GF(): MonoidK<F> = MKF
47+
inline fun <reified F, reified W> monadWriter(MF: Monad<F> = kategory.monad(),
48+
MW: Monoid<W> = kategory.monoid()): WriterTMonadWriter<F, W> =
49+
object : WriterTMonadWriter<F, W> {
50+
override fun F0(): Monad<F> = MF
51+
override fun L0(): Monoid<W> = MW
5552
}
5653

57-
inline fun <reified F, reified W> monadWriter(MM: Monad<F> = kategory.monad(), SG: Monoid<W> = kategory.monoid()):
58-
MonadWriter<WriterTKindPartial<F, W>, W> = instances(MM, SG)
54+
inline fun <reified F, reified W> monadFilter(MF: MonadFilter<F> = kategory.monadFilter(),
55+
MW: Monoid<W> = kategory.monoid()): WriterTMonadFilter<F, W> =
56+
object : WriterTMonadFilter<F, W> {
57+
override fun F0(): MonadFilter<F> = MF
58+
override fun L0(): Monoid<W> = MW
59+
}
5960

6061
inline fun <reified F, W, A> putT(vf: HK<F, A>, w: W, MF: Monad<F> = kategory.monad()): WriterT<F, W, A> =
6162
WriterT(MF, MF.map(vf, { v -> Tuple2(w, v) }))
6263

6364
inline fun <reified F, W, A> put(a: A, w: W, applicativeF: Applicative<F> = kategory.applicative()): WriterT<F, W, A> =
6465
WriterT.putT(applicativeF.pure(a), w)
6566

67+
fun <F, W, A> putT2(vf: HK<F, A>, w: W, MF: Monad<F>): WriterT<F, W, A> =
68+
WriterT(MF, MF.map(vf, { v -> Tuple2(w, v) }))
69+
70+
fun <F, W, A> put2(a: A, w: W, MF: Monad<F>): WriterT<F, W, A> =
71+
WriterT.putT2(MF.pure(a), w, MF)
72+
6673
inline fun <reified F, W> tell(l: W, applicativeF: Applicative<F> = kategory.applicative()): WriterT<F, W, Unit> = WriterT.put(Unit, l)
6774

75+
fun <F, W> tell2(l: W, MF: Monad<F>): WriterT<F, W, Unit> = WriterT.put2(Unit, l, MF)
76+
6877
inline fun <reified F, reified W, A> value(v: A, applicativeF: Applicative<F> = kategory.applicative(), monoidW: Monoid<W> = monoid()):
6978
WriterT<F, W, A> = WriterT.put(v, monoidW.empty())
7079

‎kategory/src/main/kotlin/kategory/instances/WriterTInstances.kt

+43-16
Original file line numberDiff line numberDiff line change
@@ -1,46 +1,73 @@
11
package kategory
22

3-
interface WriterTInstances<F, W> :
4-
Functor<WriterTKindPartial<F, W>>,
5-
Applicative<WriterTKindPartial<F, W>>,
6-
Monad<WriterTKindPartial<F, W>>,
7-
MonadWriter<WriterTKindPartial<F, W>, W> {
3+
interface WriterTApplicative<F, W> : Applicative<WriterTKindPartial<F, W>>, WriterTFunctor<F, W> {
84

9-
fun MM(): Monad<F>
5+
override fun F0(): Monad<F>
6+
fun L0(): Monoid<W>
107

11-
fun SG(): Monoid<W>
8+
override fun <A> pure(a: A): HK<WriterTKindPartial<F, W>, A> = WriterT(F0(), F0().pure(L0().empty() toT a))
129

13-
override fun <A> pure(a: A): HK<WriterTKindPartial<F, W>, A> = WriterT(MM(), MM().pure(SG().empty() toT a))
10+
override fun <A, B> ap(fa: HK<WriterTKindPartial<F, W>, A>, ff: HK<WriterTKindPartial<F, W>, (A) -> B>): HK<WriterTKindPartial<F, W>, B> =
11+
ap(fa, ff)
1412

15-
override fun <A, B> map(fa: HK<WriterTKindPartial<F, W>, A>, f: (A) -> B): HK<WriterTKindPartial<F, W>, B> = fa.ev().map { f(it) }
13+
override fun <A, B> map(fa: HK<WriterTKindPartial<F, W>, A>, f: (A) -> B): HK<WriterTKindPartial<F, W>, B> = super<WriterTFunctor>.map(fa, f)
14+
}
1615

17-
override fun <A, B> flatMap(fa: WriterTKind<F, W, A>, f: (A) -> HK<WriterTKindPartial<F, W>, B>): WriterT<F, W, B> = fa.ev().flatMap({ f(it).ev() }, SG())
16+
interface WriterTMonad<F, W> : WriterTApplicative<F, W>, Monad<WriterTKindPartial<F, W>> {
17+
override fun <A, B> flatMap(fa: WriterTKind<F, W, A>, f: (A) -> HK<WriterTKindPartial<F, W>, B>): WriterT<F, W, B> = fa.ev().flatMap({ f(it).ev() }, L0())
1818

1919
override fun <A, B> tailRecM(a: A, f: (A) -> HK<WriterTKindPartial<F, W>, Either<A, B>>): WriterT<F, W, B> =
20-
WriterT(MM(), MM().tailRecM(a, {
21-
MM().map(f(it).ev().value) {
20+
WriterT(F0(), F0().tailRecM(a, {
21+
F0().map(f(it).ev().value) {
2222
when (it.b) {
2323
is Either.Left<A, B> -> Either.Left(it.b.a)
2424
is Either.Right<A, B> -> Either.Right(it.a toT it.b.b)
2525
}
2626
}
2727
}))
2828

29+
override fun <A, B> ap(fa: HK<WriterTKindPartial<F, W>, A>, ff: HK<WriterTKindPartial<F, W>, (A) -> B>): HK<WriterTKindPartial<F, W>, B> =
30+
super<Monad>.ap(fa, ff)
31+
}
32+
33+
interface WriterTFunctor<F, W> : Functor<WriterTKindPartial<F, W>> {
34+
fun F0(): Functor<F>
35+
36+
override fun <A, B> map(fa: HK<WriterTKindPartial<F, W>, A>, f: (A) -> B): HK<WriterTKindPartial<F, W>, B> = fa.ev().map { f(it) }
37+
}
38+
39+
interface WriterTMonadFilter<F, W> : WriterTMonad<F, W>, MonadFilter<WriterTKindPartial<F, W>> {
40+
override fun F0(): MonadFilter<F>
41+
42+
override fun <A> empty(): HK<WriterTKindPartial<F, W>, A> = WriterT(F0(), F0().empty())
2943
}
3044

3145
interface WriterTSemigroupK<F, W> : SemigroupK<WriterTKindPartial<F, W>> {
3246

3347
fun MF(): Monad<F>
3448

35-
fun GF(): SemigroupK<F>
49+
fun F0(): SemigroupK<F>
3650

3751
override fun <A> combineK(x: HK<WriterTKindPartial<F, W>, A>, y: HK<WriterTKindPartial<F, W>, A>):
38-
WriterT<F, W, A> = WriterT(MF(), GF().combineK(x.ev().value, y.ev().value))
52+
WriterT<F, W, A> = WriterT(MF(), F0().combineK(x.ev().value, y.ev().value))
3953
}
4054

4155
interface WriterTMonoidK<F, W> : MonoidK<WriterTKindPartial<F, W>>, WriterTSemigroupK<F, W> {
4256

43-
override fun GF(): MonoidK<F>
57+
override fun F0(): MonoidK<F>
58+
59+
override fun <A> empty(): HK<WriterTKindPartial<F, W>, A> = WriterT(MF(), F0().empty())
60+
}
61+
62+
interface WriterTMonadWriter<F, W> : MonadWriter<WriterTKindPartial<F, W>, W>, WriterTMonad<F, W> {
63+
64+
override fun <A> listen(fa: HK<WriterTKindPartial<F, W>, A>): HK<WriterTKindPartial<F, W>, Tuple2<W, A>> =
65+
WriterT(F0(), F0().flatMap(fa.ev().content(), { a -> F0().map(fa.ev().write(), { l -> Tuple2(l, Tuple2(l, a)) }) }))
66+
67+
override fun <A> pass(fa: HK<WriterTKindPartial<F, W>, Tuple2<(W) -> W, A>>): HK<WriterTKindPartial<F, W>, A> =
68+
WriterT(F0(), F0().flatMap(fa.ev().content(), { tuple2FA -> F0().map(fa.ev().write(), { l -> Tuple2(tuple2FA.a(l), tuple2FA.b) }) }))
69+
70+
override fun <A> writer(aw: Tuple2<W, A>): HK<WriterTKindPartial<F, W>, A> = WriterT.put2(aw.b, aw.a, F0())
4471

45-
override fun <A> empty(): HK<WriterTKindPartial<F, W>, A> = WriterT(MF(), GF().empty())
72+
override fun tell(w: W): HK<WriterTKindPartial<F, W>, Unit> = WriterT.tell2(w, F0())
4673
}

‎kategory/src/main/kotlin/kategory/typeclasses/MonadFilter.kt

+11
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
package kategory
2+
3+
interface MonadFilter<F> : Monad<F>, FunctorFilter<F>, Typeclass {
4+
5+
fun <A> empty(): HK<F, A>
6+
7+
override fun <A, B> mapFilter(fa: HK<F, A>, f: (A) -> Option<B>): HK<F, B> =
8+
flatMap(fa, { a -> f(a).fold({ empty<B>() }, { pure(it) }) })
9+
}
10+
11+
inline fun <reified F> monadFilter(): MonadFilter<F> = instance(InstanceParametrizedType(MonadFilter::class.java, listOf(F::class.java)))

‎kategory/src/test/kotlin/kategory/data/OptionTest.kt

+3-2
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ import io.kotlintest.matchers.shouldBe
55
import io.kotlintest.properties.forAll
66
import kategory.Option.None
77
import kategory.Option.Some
8+
import kategory.laws.MonadFilterLaws
89
import org.junit.runner.RunWith
910

1011
@RunWith(KTestJUnitRunner::class)
@@ -27,10 +28,10 @@ class OptionTest : UnitSpec() {
2728
})
2829
})
2930
}
30-
31-
31+
3232
testLaws(MonadErrorLaws.laws(Option.monadError<Throwable>(OptionError), Eq.any(), EQ_EITHER))
3333
testLaws(TraverseLaws.laws(Option.traverse(), Option.monad(), ::Some, Eq.any()))
34+
testLaws(MonadFilterLaws.laws(Option.monadFilter(), ::Some, Eq.any()))
3435

3536
"fromNullable should work for both null and non-null values of nullable types" {
3637
forAll { a: Int? ->

‎kategory/src/test/kotlin/kategory/data/WriterTTest.kt

+12
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
package kategory
22

33
import io.kotlintest.KTestJUnitRunner
4+
import kategory.laws.FunctorFilterLaws
5+
import kategory.laws.MonadFilterLaws
46
import org.junit.runner.RunWith
57

68
@RunWith(KTestJUnitRunner::class)
@@ -35,5 +37,15 @@ class WriterTTest : UnitSpec() {
3537
}
3638
}
3739
))
40+
41+
testLaws(MonadFilterLaws.laws(WriterT.monadFilter(Option.monadFilter(), IntMonoid),
42+
{ WriterT(Option.monad(), Option(Tuple2(it, it))) },
43+
object : Eq<HK<WriterTKindPartial<OptionHK, Int>, Int>> {
44+
override fun eqv(a: HK<WriterTKindPartial<OptionHK, Int>, Int>, b: HK<WriterTKindPartial<OptionHK, Int>, Int>): Boolean =
45+
a.ev().value.ev().let { optionA: Option<Tuple2<Int, Int>> ->
46+
val optionB = a.ev().value.ev()
47+
optionA.fold({ optionB.fold({ true }, { false }) }, { value: Tuple2<Int, Int> -> optionB.fold({ false }, { value == it }) })
48+
}
49+
}))
3850
}
3951
}

0 commit comments

Comments
 (0)