Skip to content

Commit 51426be

Browse files
raulrajaraulraja
authored
Merge pull request #120 from kategory/paco-lawfixes
Add fixes to Monads found by new Law checks
2 parents 970bacf + f4fa45c commit 51426be

24 files changed

+98
-73
lines changed

‎gradle/wrapper/gradle-wrapper.jar

0 Bytes
Binary file not shown.

‎gradle/wrapper/gradle-wrapper.properties

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
#Fri Jun 09 20:51:23 CEST 2017
1+
#Sun Jun 25 18:21:54 BST 2017
22
distributionBase=GRADLE_USER_HOME
33
distributionPath=wrapper/dists
44
zipStoreBase=GRADLE_USER_HOME

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

+5-5
Original file line numberDiff line numberDiff line change
@@ -29,11 +29,11 @@ data class Function0<out A>(internal val f: () -> A) : HK<Function0.F, A> {
2929
pure(f(fa.ev().invoke()))
3030

3131
override fun <A, B> tailRecM(a: A, f: (A) -> HK<F, Either<A, B>>): HK<F, B> =
32-
f(a).ev().invoke().let { either ->
33-
when (either) {
34-
is Either.Left -> tailRecM(either.a, f)
35-
is Either.Right -> ({ either.b }).k()
36-
}
32+
Function0 {
33+
tailrec fun loop(thisA: A): B =
34+
f(thisA).ev().invoke().fold({ loop(it) }, { it })
35+
36+
loop(a)
3737
}
3838
}
3939
}

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

+3
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,9 @@ interface IdMonad : Monad<Id.F> {
66
override fun <A, B> flatMap(fa: IdKind<A>, f: (A) -> IdKind<B>): Id<B> =
77
fa.ev().flatMap { f(it).ev() }
88

9+
override fun <A, B> map(fa: HK<Id.F, A>, f: (A) -> B): Id<B> =
10+
fa.ev().map(f)
11+
912
@Suppress("UNCHECKED_CAST")
1013
tailrec override fun <A, B> tailRecM(a: A, f: (A) -> IdKind<Either<A, B>>): Id<B> {
1114
val x = f(a).ev().value

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

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

33
interface OptionMonad : Monad<Option.F> {
4-
54
override fun <A, B> map(fa: OptionKind<A>, f: (A) -> B): Option<B> =
65
fa.ev().map(f)
76

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

+2-6
Original file line numberDiff line numberDiff line change
@@ -14,10 +14,6 @@ interface TryMonadError : MonadError<Try.F, Throwable> {
1414
fa.ev().recoverWith { f(it).ev() }
1515

1616
@Suppress("UNCHECKED_CAST")
17-
override fun <A, B> tailRecM(a: A, f: (A) -> TryKind<Either<A, B>>): Try<B> {
18-
val x = f(a).ev()
19-
return if (x is Try.Success && x.value is Either.Left<A>) tailRecM(x.value.a, f)
20-
else if (x is Try.Success && x.value is Either.Right<B>) Try.Success(x.value.b)
21-
else x as Try.Failure<B>
22-
}
17+
override fun <A, B> tailRecM(a: A, f: (A) -> TryKind<Either<A, B>>): Try<B> =
18+
f(a).ev().fold({ Try.raiseError(it) }, { either -> either.fold({ tailRecM(it, f) }, { Try.Success(it) }) })
2319
}

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

+18
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
package kategory
2+
3+
interface Eq<in F> : Typeclass {
4+
fun eqv(a: F, b: F): Boolean
5+
6+
fun neqv(a: F, b: F): Boolean =
7+
!eqv(a, b)
8+
9+
companion object {
10+
operator fun <F> invoke() = object : Eq<F> {
11+
override fun eqv(a: F, b: F): Boolean =
12+
a == b
13+
14+
override fun neqv(a: F, b: F): Boolean =
15+
a != b
16+
}
17+
}
18+
}

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ import org.junit.runner.RunWith
1010
class EitherTTest : UnitSpec() {
1111
init {
1212

13-
testLaws(MonadLaws.laws(EitherTMonad<Id.F, Int>()))
13+
testLaws(MonadLaws.laws(EitherTMonad<Id.F, Int>(), Eq()))
1414

1515
"map should modify value" {
1616
forAll { a: String ->

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ import org.junit.runner.RunWith
1111
class EitherTest : UnitSpec() {
1212
init {
1313

14-
testLaws(MonadLaws.laws(EitherMonad<Int>()))
14+
testLaws(MonadLaws.laws(EitherMonad<Int>(), Eq()))
1515

1616
"map should modify value" {
1717
forAll { a: Int, b: String ->

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

+4-1
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,10 @@ import org.junit.runner.RunWith
88
class EvalTest : UnitSpec() {
99
init {
1010

11-
testLaws(MonadLaws.laws(Eval))
11+
testLaws(MonadLaws.laws(Eval, object : Eq<HK<Eval.F, Int>> {
12+
override fun eqv(a: HK<Eval.F, Int>, b: HK<Eval.F, Int>): Boolean =
13+
a.ev().value() == b.ev().value()
14+
}))
1215

1316
"should map wrapped value" {
1417
val sideEffect = SideEffect()

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

+4-1
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,10 @@ import org.junit.runner.RunWith
88
class Function0Test : UnitSpec() {
99
init {
1010

11-
testLaws(MonadLaws.laws(Function0))
11+
testLaws(MonadLaws.laws(Function0, object : Eq<HK<Function0.F, Int>> {
12+
override fun eqv(a: HK<Function0.F, Int>, b: HK<Function0.F, Int>): Boolean =
13+
a.ev()() == b.ev()()
14+
}))
1215

1316
"Function0Monad.binding should for comprehend over all values of multiple Function0" {
1417
Function0.binding {

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ import org.junit.runner.RunWith
88
class IdTest : UnitSpec() {
99
init {
1010

11-
testLaws(MonadLaws.laws(Id))
11+
testLaws(MonadLaws.laws(Id, Eq()))
1212

1313
"IdMonad.binding should for comprehend over all values of multiple Ids" {
1414
Id.binding {

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ class IorTest : UnitSpec() {
1313

1414
val intIorMonad = IorMonad(IntMonoid)
1515

16-
testLaws(MonadLaws.laws(intIorMonad))
16+
testLaws(MonadLaws.laws(intIorMonad, Eq()))
1717

1818
"flatMap() should modify entity" {
1919
forAll { a: Int, b: String ->

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import org.junit.runner.RunWith
99
class NonEmptyListTest : UnitSpec() {
1010
init {
1111

12-
testLaws(MonadLaws.laws(NonEmptyList))
12+
testLaws(MonadLaws.laws(NonEmptyList, Eq()))
1313

1414
"map should modify values" {
1515
NonEmptyList.of(14).map { it * 3 } shouldBe NonEmptyList.of(42)

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import org.junit.runner.RunWith
99
class OptionTTest : UnitSpec() {
1010
init {
1111

12-
testLaws(MonadLaws.laws(OptionTMonad(NonEmptyList)))
12+
testLaws(MonadLaws.laws(OptionTMonad(NonEmptyList), Eq()))
1313

1414
"map should modify value" {
1515
forAll { a: String ->

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

+2-2
Original file line numberDiff line numberDiff line change
@@ -4,16 +4,16 @@ import io.kotlintest.KTestJUnitRunner
44
import io.kotlintest.matchers.fail
55
import io.kotlintest.matchers.shouldBe
66
import io.kotlintest.properties.forAll
7-
import kategory.Option.Some
87
import kategory.Option.None
8+
import kategory.Option.Some
99
import org.junit.runner.RunWith
1010

1111
@RunWith(KTestJUnitRunner::class)
1212
class OptionTest: UnitSpec() {
1313

1414
init {
1515

16-
testLaws(MonadLaws.laws(Option))
16+
testLaws(MonadLaws.laws(Option, Eq()))
1717

1818
"map should modify value" {
1919
Some(12).map { "flower" } shouldBe Some("flower")

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ class TryTest : UnitSpec() {
1111

1212
init {
1313

14-
testLaws(MonadLaws.laws(Try))
14+
testLaws(MonadLaws.laws(Try, Eq()))
1515

1616
"invoke of any should be success" {
1717
Try.invoke { 1 } shouldBe Success(1)

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ class ValidatedTest : UnitSpec() {
1616
override fun combine(a: String, b: String): String = "$a $b"
1717
}
1818

19-
testLaws(ApplicativeLaws.laws(ValidatedApplicativeError(concatStringSG)))
19+
testLaws(ApplicativeLaws.laws(ValidatedApplicativeError(concatStringSG), Eq()))
2020

2121
"fold should call function on Invalid" {
2222
val exception = Exception("My Exception")

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import org.junit.runner.RunWith
99
class WriterTTest : UnitSpec() {
1010
init {
1111

12-
testLaws(MonadLaws.laws(WriterTMonad(NonEmptyList, IntMonoid)))
12+
testLaws(MonadLaws.laws(WriterTMonad(NonEmptyList, IntMonoid), Eq()))
1313

1414
"tell should accumulate write" {
1515
forAll { a: Int ->

‎kategory/src/test/kotlin/kategory/free/FreeTest.kt

+6-3
Original file line numberDiff line numberDiff line change
@@ -26,8 +26,8 @@ class FreeTest : UnitSpec() {
2626

2727
val program = Ops.binding {
2828
val added = !Ops.add(10, 10)
29-
val substracted = !Ops.subtract(added, 50)
30-
yields(substracted)
29+
val subtracted = !Ops.subtract(added, 50)
30+
yields(subtracted)
3131
}.ev()
3232

3333
fun stackSafeTestProgram(n: Int, stopAt: Int): Free<Ops.F, Int> = Ops.binding {
@@ -38,7 +38,10 @@ class FreeTest : UnitSpec() {
3838

3939
init {
4040

41-
testLaws(MonadLaws.laws(Ops))
41+
testLaws(MonadLaws.laws(Ops, object : Eq<HK<FreeF<Ops.F>, Int>> {
42+
override fun eqv(a: HK<FreeF<Ops.F>, Int>, b: HK<FreeF<Ops.F>, Int>): Boolean =
43+
a.ev().foldMap(idInterpreter, Id) == b.ev().foldMap(idInterpreter, Id)
44+
}))
4245

4346
"Can interpret an ADT as Free operations" {
4447
program.foldMap(optionInterpreter, Option).ev() shouldBe Option.Some(-30)

‎kategory/src/test/kotlin/kategory/laws/ApplicativeLaws.kt

+14-14
Original file line numberDiff line numberDiff line change
@@ -5,32 +5,32 @@ import io.kotlintest.properties.forAll
55

66
object ApplicativeLaws {
77

8-
inline fun <reified F> laws(A: Applicative<F> = applicative<F>()): List<Law> =
9-
FunctorLaws.laws(A) + listOf(
10-
Law("Applicative Laws: ap identity", { apIdentity(A) }),
11-
Law("Applicative Laws: homomorphism", { homomorphism(A) }),
12-
Law("Applicative Laws: interchange", { interchange(A) }),
13-
Law("Applicative Laws: map derived", { mapDerived(A) })
8+
inline fun <reified F> laws(A: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, Int>>): List<Law> =
9+
FunctorLaws.laws(A, EQ) + listOf(
10+
Law("Applicative Laws: ap identity", { apIdentity(A, EQ) }),
11+
Law("Applicative Laws: homomorphism", { homomorphism(A, EQ) }),
12+
Law("Applicative Laws: interchange", { interchange(A, EQ) }),
13+
Law("Applicative Laws: map derived", { mapDerived(A, EQ) })
1414
)
1515

16-
inline fun <reified F> apIdentity(A: Applicative<F> = applicative<F>()): Unit =
16+
inline fun <reified F> apIdentity(A: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, Int>>): Unit =
1717
forAll(genApplicative(Gen.int(), A), { fa: HK<F, Int> ->
18-
A.ap(fa, A.pure({ n: Int -> n })) == fa
18+
A.ap(fa, A.pure({ n: Int -> n })).equalUnderTheLaw(fa, EQ)
1919
})
2020

21-
inline fun <reified F> homomorphism(A: Applicative<F> = applicative<F>()): Unit =
21+
inline fun <reified F> homomorphism(A: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, Int>>): Unit =
2222
forAll(genFunctionAToB<Int, Int>(Gen.int()), Gen.int(), { ab: (Int) -> Int, a: Int ->
23-
A.ap(A.pure(a), A.pure(ab)) == A.pure(ab(a))
23+
A.ap(A.pure(a), A.pure(ab)).equalUnderTheLaw(A.pure(ab(a)), EQ)
2424
})
2525

26-
inline fun <reified F> interchange(A: Applicative<F> = applicative<F>()): Unit =
26+
inline fun <reified F> interchange(A: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, Int>>): Unit =
2727
forAll(genApplicative(genFunctionAToB<Int, Int>(Gen.int()), A), Gen.int(), { fa: HK<F, (Int) -> Int>, a: Int ->
28-
A.ap(A.pure(a), fa) == A.ap(fa, A.pure({ x: (Int) -> Int -> x(a) }))
28+
A.ap(A.pure(a), fa).equalUnderTheLaw(A.ap(fa, A.pure({ x: (Int) -> Int -> x(a) })), EQ)
2929
})
3030

31-
inline fun <reified F> mapDerived(A: Applicative<F> = applicative<F>()): Unit =
31+
inline fun <reified F> mapDerived(A: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, Int>>): Unit =
3232
forAll(genApplicative(Gen.int(), A), genFunctionAToB<Int, Int>(Gen.int()), { fa: HK<F, Int>, f: (Int) -> Int ->
33-
A.map(fa, f) == A.ap(fa, A.pure(f))
33+
A.map(fa, f).equalUnderTheLaw(A.ap(fa, A.pure(f)), EQ)
3434
})
3535

3636
}

‎kategory/src/test/kotlin/kategory/laws/FunctorLaws.kt

+7-7
Original file line numberDiff line numberDiff line change
@@ -5,24 +5,24 @@ import io.kotlintest.properties.forAll
55

66
object FunctorLaws {
77

8-
inline fun <reified F> laws(AP: Applicative<F> = applicative<F>()): List<Law> =
8+
inline fun <reified F> laws(AP: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, Int>>): List<Law> =
99
listOf(
10-
Law("Functor Laws: Covariant Identity", { covariantIdentity(AP) }),
11-
Law("Functor: Covariant Composition", { covariantComposition(AP) })
10+
Law("Functor Laws: Covariant Identity", { covariantIdentity(AP, EQ) }),
11+
Law("Functor: Covariant Composition", { covariantComposition(AP, EQ) })
1212
)
1313

14-
inline fun <reified F> covariantIdentity(AP: Applicative<F> = applicative<F>()): Unit =
14+
inline fun <reified F> covariantIdentity(AP: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, Int>> = Eq()): Unit =
1515
forAll(genApplicative(Gen.int(), AP), { fa: HK<F, Int> ->
16-
AP.map(fa, ::identity) == fa
16+
AP.map(fa, ::identity).equalUnderTheLaw(fa, EQ)
1717
})
1818

19-
inline fun <reified F> covariantComposition(AP: Applicative<F> = applicative<F>()): Unit =
19+
inline fun <reified F> covariantComposition(AP: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, Int>> = Eq()): Unit =
2020
forAll(
2121
genApplicative(Gen.int(), AP),
2222
genFunctionAToB<Int, Int>(Gen.int()),
2323
genFunctionAToB<Int, Int>(Gen.int()),
2424
{ fa: HK<F, Int>, f, g ->
25-
AP.map(AP.map(fa, f), g) == AP.map(fa, f andThen g)
25+
AP.map(AP.map(fa, f), g).equalUnderTheLaw(AP.map(fa, f andThen g), EQ)
2626
}
2727
)
2828

‎kategory/src/test/kotlin/kategory/laws/Law.kt

+2
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,5 @@ package kategory
22

33
data class Law(val name: String, val test: () -> Unit)
44

5+
inline fun <reified A> A.equalUnderTheLaw(b: A, eq: Eq<A> = Eq()): Boolean =
6+
eq.eqv(this, b)

‎kategory/src/test/kotlin/kategory/laws/MonadLaws.kt

+21-23
Original file line numberDiff line numberDiff line change
@@ -1,49 +1,47 @@
11
package kategory
22

3-
import io.kotlintest.matchers.shouldBe
43
import io.kotlintest.properties.Gen
54
import io.kotlintest.properties.forAll
65

76
object MonadLaws {
87

9-
inline fun <reified F> laws(M: Monad<F> = monad<F>()): List<Law> =
10-
ApplicativeLaws.laws(M) + listOf(
11-
Law("Monad Laws: left identity", { leftIdentity(M) }),
12-
Law("Monad Laws: right identity", { rightIdentity(M) }),
13-
Law("Monad Laws: kleisli left identity", { kleisliLeftIdentity(M) }),
14-
Law("Monad Laws: kleisli right identity", { kleisliRightIdentity(M) }),
15-
Law("Monad Laws: map / flatMap coherence", { mapFlatMapCoherence(M) }),
16-
Law("Monad / JVM: stack safe", { mapFlatMapCoherence(M) })
8+
inline fun <reified F> laws(M: Monad<F> = monad<F>(), EQ: Eq<HK<F, Int>>): List<Law> =
9+
ApplicativeLaws.laws(M, EQ) + listOf(
10+
Law("Monad Laws: left identity", { leftIdentity(M, EQ) }),
11+
Law("Monad Laws: right identity", { rightIdentity(M, EQ) }),
12+
Law("Monad Laws: kleisli left identity", { kleisliLeftIdentity(M, EQ) }),
13+
Law("Monad Laws: kleisli right identity", { kleisliRightIdentity(M, EQ) }),
14+
Law("Monad Laws: map / flatMap coherence", { mapFlatMapCoherence(M, EQ) }),
15+
Law("Monad / JVM: stack safe", { stackSafety(5000, M) })
1716
)
1817

19-
inline fun <reified F> leftIdentity(M: Monad<F> = monad<F>()): Unit =
18+
inline fun <reified F> leftIdentity(M: Monad<F> = monad<F>(), EQ: Eq<HK<F, Int>>): Unit =
2019
forAll(genFunctionAToB<Int, HK<F, Int>>(genApplicative(Gen.int(), M)), Gen.int(), { f: (Int) -> HK<F, Int>, a: Int ->
21-
M.flatMap(M.pure(a), f) == f(a)
20+
M.flatMap(M.pure(a), f).equalUnderTheLaw(f(a), EQ)
2221
})
2322

24-
inline fun <reified F> rightIdentity(M: Monad<F> = monad<F>()): Unit =
23+
inline fun <reified F> rightIdentity(M: Monad<F> = monad<F>(), EQ: Eq<HK<F, Int>>): Unit =
2524
forAll(genApplicative(Gen.int(), M), { fa: HK<F, Int> ->
26-
M.flatMap(fa, { M.pure(it) }) == fa
25+
M.flatMap(fa, { M.pure(it) }).equalUnderTheLaw(fa, EQ)
2726
})
2827

29-
inline fun <reified F> kleisliLeftIdentity(M: Monad<F> = monad<F>()): Unit =
28+
inline fun <reified F> kleisliLeftIdentity(M: Monad<F> = monad<F>(), EQ: Eq<HK<F, Int>>): Unit =
3029
forAll(genFunctionAToB<Int, HK<F, Int>>(genApplicative(Gen.int(), M)), Gen.int(), { f: (Int) -> HK<F, Int>, a: Int ->
31-
(Kleisli({ n : Int -> M.pure(n)}, M) andThen Kleisli(f, M)).run(a) == f(a)
30+
(Kleisli({ n: Int -> M.pure(n) }, M) andThen Kleisli(f, M)).run(a).equalUnderTheLaw(f(a), EQ)
3231
})
3332

34-
inline fun <reified F> kleisliRightIdentity(M: Monad<F> = monad<F>()): Unit =
33+
inline fun <reified F> kleisliRightIdentity(M: Monad<F> = monad<F>(), EQ: Eq<HK<F, Int>>): Unit =
3534
forAll(genFunctionAToB<Int, HK<F, Int>>(genApplicative(Gen.int(), M)), Gen.int(), { f: (Int) -> HK<F, Int>, a: Int ->
36-
(Kleisli(f, M) andThen Kleisli({ n : Int -> M.pure(n)}, M)).run(a) == f(a)
35+
(Kleisli(f, M) andThen Kleisli({ n: Int -> M.pure(n) }, M)).run(a).equalUnderTheLaw(f(a), EQ)
3736
})
3837

39-
inline fun <reified F> mapFlatMapCoherence(M: Monad<F> = monad<F>()): Unit =
38+
inline fun <reified F> mapFlatMapCoherence(M: Monad<F> = monad<F>(), EQ: Eq<HK<F, Int>>): Unit =
4039
forAll(genFunctionAToB<Int, Int>(Gen.int()), genApplicative(Gen.int(), M), { f: (Int) -> Int, fa: HK<F, Int> ->
41-
M.flatMap(fa, { M.pure(f(it))}) == M.map(fa, f)
40+
M.flatMap(fa, { M.pure(f(it)) }).equalUnderTheLaw(M.map(fa, f), EQ)
4241
})
4342

44-
inline fun <reified F> stackSafety(iterations : Int = 5000, M: Monad<F> = monad<F>()): Unit {
45-
val res = M.tailRecM(0, { i -> M.pure(if (i < iterations) Either.Left(i + 1) else Either.Right(i))})
46-
res shouldBe iterations
43+
inline fun <reified F> stackSafety(iterations: Int = 5000, M: Monad<F> = monad<F>()): Unit {
44+
val res = M.tailRecM(0, { i -> M.pure(if (i < iterations) Either.Left(i + 1) else Either.Right(i)) })
45+
res.equalUnderTheLaw(iterations)
4746
}
48-
4947
}

0 commit comments

Comments
 (0)