Skip to content

Commit 6bfa149

Browse files
authored
Merge pull request #112 from kategory/rr-discipline
Typeclasses laws
2 parents ac359f6 + b7108d7 commit 6bfa149

34 files changed

+355
-19
lines changed

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

+2
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,8 @@ fun <A, B> IorKind<A, B>.ev(): Ior<A, B> =
2626
* [Ior]<`A`,`B`> is isomorphic to [Either]<[Either]<`A`,`B`>, [Pair]<`A`,`B`>>, but provides methods biased toward `B`
2727
* values, regardless of whether the `B` values appear in a [Ior.Right] or a [Ior.Both].
2828
* The isomorphic Either form can be accessed via the [unwrap] method.
29+
*
30+
* El primogenito de @ffgiraldez
2931
*/
3032

3133
sealed class Ior<out A, out B> : IorKind<A, B> {

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

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

3-
typealias KleisiTKind<F, A, B> = HK3<Kleisli.F, F, A, B>
4-
typealias KleisiF<F> = HK<Kleisli.F, F>
3+
typealias KleisliTKind<F, A, B> = HK3<Kleisli.F, F, A, B>
4+
typealias KleisliF<F> = HK<Kleisli.F, F>
55

6-
typealias KleisiFun<F, D, A> = (D) -> HK<F, A>
6+
typealias KleisliFun<F, D, A> = (D) -> HK<F, A>
77

88
typealias ReaderT<F, D, A> = Kleisli<F, D, A>
99

10-
fun <F, D, A> KleisiTKind<F, D, A>.ev(): Kleisli<F, D, A> =
10+
fun <F, D, A> KleisliTKind<F, D, A>.ev(): Kleisli<F, D, A> =
1111
this as Kleisli<F, D, A>
1212

13-
class Kleisli<F, D, A>(val MF: Monad<F>, val run: KleisiFun<F, D, A>) : KleisiTKind<F, D, A> {
13+
class Kleisli<F, D, A>(val MF: Monad<F>, val run: KleisliFun<F, D, A>) : KleisliTKind<F, D, A> {
1414
class F private constructor()
1515

1616
fun <B> map(f: (A) -> B): Kleisli<F, D, B> =
@@ -29,15 +29,18 @@ class Kleisli<F, D, A>(val MF: Monad<F>, val run: KleisiFun<F, D, A>) : KleisiTK
2929
fun <DD> local(f: (DD) -> D): Kleisli<F, DD, A> =
3030
Kleisli(MF, { dd -> run(f(dd)) })
3131

32-
fun <B> andThen(f: (A) -> HK<F, B>): Kleisli<F, D, B> =
32+
infix fun <C> andThen(f: Kleisli<F, A, C>): Kleisli<F, D, C> =
33+
andThen(f.run)
34+
35+
infix fun <B> andThen(f: (A) -> HK<F, B>): Kleisli<F, D, B> =
3336
Kleisli(MF, { MF.flatMap(run(it), f) })
3437

35-
fun <B> andThen(a: HK<F, B>): Kleisli<F, D, B> =
38+
infix fun <B> andThen(a: HK<F, B>): Kleisli<F, D, B> =
3639
andThen({ a })
3740

3841
companion object {
3942

40-
inline operator fun <reified F, D, A> invoke(noinline run: KleisiFun<F, D, A>, MF: Monad<F> = monad<F>()): Kleisli<F, D, A> =
43+
inline operator fun <reified F, D, A> invoke(noinline run: KleisliFun<F, D, A>, MF: Monad<F> = monad<F>()): Kleisli<F, D, A> =
4144
Kleisli(MF, run)
4245

4346
@JvmStatic inline fun <reified F, D, A> pure(x: A, MF: Monad<F> = monad<F>()): Kleisli<F, D, A> =

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

+3
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,9 @@ class EitherMonad<L> : Monad<EitherF<L>> {
77
override fun <A, B> flatMap(fa: EitherKind<L, A>, f: (A) -> EitherKind<L, B>): Either<L, B> =
88
fa.ev().flatMap { f(it).ev() }
99

10+
override fun <A, B> map(fa: HK<EitherF<L>, A>, f: (A) -> B): Either<L, B> =
11+
fa.ev().map(f)
12+
1013
tailrec override fun <A, B> tailRecM(a: A, f: (A) -> HK<EitherF<L>, Either<A, B>>): Either<L, B> {
1114
val e = f(a).ev().ev()
1215
return when (e) {

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

+3
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,9 @@ data class Function0<out A>(internal val f: () -> A) : HK<Function0.F, A> {
2525
override fun <A> extract(fa: HK<Function0.F, A>): A =
2626
fa.ev().invoke()
2727

28+
override fun <A, B> map(fa: HK<F, A>, f: (A) -> B): HK<F, B> =
29+
pure(f(fa.ev().invoke()))
30+
2831
override fun <A, B> tailRecM(a: A, f: (A) -> HK<F, Either<A, B>>): HK<F, B> =
2932
f(a).ev().invoke().let { either ->
3033
when (either) {

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

+3
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,9 @@ class IorMonad<L>(val SL: Semigroup<L>) : Monad<HK<Ior.F, L>> {
66

77
override fun <A> pure(a: A): Ior<L, A> = Ior.Right(a)
88

9+
override fun <A, B> map(fa: IorKind<L, A>, f: (A) -> B): Ior<L, B> =
10+
fa.ev().map(f)
11+
912
private tailrec fun <A, B> loop(v: Ior<L, Either<A, B>>, f: (A) -> IorKind<L, Either<A, B>>): Ior<L, B> {
1013
return when (v) {
1114
is Ior.Left -> Ior.Left(v.value)
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,3 @@
11
package kategory
22

3-
interface NonEmptyListBimonad : Bimonad<NonEmptyList.F>, NonEmptyListMonad, NonEmptyListComonad {
4-
override fun <A, B> map(fa: NonEmptyListKind<A>, f: (A) -> B): NonEmptyList<B> =
5-
fa.ev().map(f)
6-
}
3+
interface NonEmptyListBimonad : Bimonad<NonEmptyList.F>, NonEmptyListMonad, NonEmptyListComonad

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

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

9+
override fun <A, B> map(fa: NonEmptyListKind<A>, f: (A) -> B): NonEmptyList<B> =
10+
fa.ev().map(f)
11+
912
@Suppress("UNCHECKED_CAST")
1013
private tailrec fun <A, B> go(buf: ArrayList<B>, f: (A) -> HK<NonEmptyList.F, Either<A, B>>, v: NonEmptyList<Either<A, B>>): Unit =
1114
when (v.head) {
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
package kategory
2+
3+
fun <A> identity(a: A): A = a

kategory/src/test/kotlin/kategory/UnitSpec.kt

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

3+
import io.kotlintest.TestCase
34
import io.kotlintest.specs.StringSpec
45

56

@@ -17,4 +18,12 @@ abstract class UnitSpec : StringSpec() {
1718
Eval
1819
}
1920
}
21+
22+
fun testLaws(laws: List<Law>): List<TestCase> =
23+
laws.map { law ->
24+
val tc = TestCase(suite = rootTestSuite, name = law.name, test = law.test, config = defaultTestCaseConfig)
25+
rootTestSuite.addTestCase(tc)
26+
tc
27+
}
28+
2029
}

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

+3
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,9 @@ import org.junit.runner.RunWith
99
@RunWith(KTestJUnitRunner::class)
1010
class EitherTTest : UnitSpec() {
1111
init {
12+
13+
testLaws(MonadLaws.laws(EitherTMonad<Id.F, Int>()))
14+
1215
"map should modify value" {
1316
forAll { a: String ->
1417
val right = EitherT(Id(Either.Right(a)))

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

+3
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,9 @@ import org.junit.runner.RunWith
1010
@RunWith(KTestJUnitRunner::class)
1111
class EitherTest : UnitSpec() {
1212
init {
13+
14+
testLaws(MonadLaws.laws(EitherMonad<Int>()))
15+
1316
"map should modify value" {
1417
forAll { a: Int, b: String ->
1518
Right(a).map { b } == Right(b)

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

+3
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,9 @@ import org.junit.runner.RunWith
77
@RunWith(KTestJUnitRunner::class)
88
class EvalTest : UnitSpec() {
99
init {
10+
11+
testLaws(MonadLaws.laws(Eval))
12+
1013
"should map wrapped value" {
1114
val sideEffect = SideEffect()
1215
val mapped = Eval.now(0)

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

+3
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,9 @@ import org.junit.runner.RunWith
77
@RunWith(KTestJUnitRunner::class)
88
class Function0Test : UnitSpec() {
99
init {
10+
11+
testLaws(MonadLaws.laws(Function0))
12+
1013
"Function0Monad.binding should for comprehend over all values of multiple Function0" {
1114
Function0.binding {
1215
val x = Function0 { 1 }.bind()

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

+3
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,9 @@ import org.junit.runner.RunWith
77
@RunWith(KTestJUnitRunner::class)
88
class IdTest : UnitSpec() {
99
init {
10+
11+
testLaws(MonadLaws.laws(Id))
12+
1013
"IdMonad.binding should for comprehend over all values of multiple Ids" {
1114
Id.binding {
1215
val x = Id(1).bind()

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

+6-2
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,13 @@ import org.junit.runner.RunWith
88

99
@RunWith(KTestJUnitRunner::class)
1010
class IorTest : UnitSpec() {
11+
1112
init {
13+
14+
val intIorMonad = IorMonad(IntMonoid)
15+
16+
testLaws(MonadLaws.laws(intIorMonad))
17+
1218
"flatMap() should modify entity" {
1319
forAll { a: Int, b: String ->
1420
{
@@ -131,8 +137,6 @@ class IorTest : UnitSpec() {
131137

132138
}
133139

134-
val intIorMonad = IorMonad(IntMonoid)
135-
136140
"Ior.monad.flatMap should combine left values" {
137141
val ior1 = Ior.Both(3, "Hello, world!")
138142
val iorResult = intIorMonad.flatMap(ior1, { Ior.Left(7) })

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

+3
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,9 @@ import org.junit.runner.RunWith
88
@RunWith(KTestJUnitRunner::class)
99
class NonEmptyListTest : UnitSpec() {
1010
init {
11+
12+
testLaws(MonadLaws.laws(NonEmptyList))
13+
1114
"map should modify values" {
1215
NonEmptyList.of(14).map { it * 3 } shouldBe NonEmptyList.of(42)
1316
}

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

+3
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,9 @@ import org.junit.runner.RunWith
88
@RunWith(KTestJUnitRunner::class)
99
class OptionTTest : UnitSpec() {
1010
init {
11+
12+
testLaws(MonadLaws.laws(OptionTMonad(NonEmptyList)))
13+
1114
"map should modify value" {
1215
forAll { a: String ->
1316
val ot = OptionT(Id(Option.Some(a)))

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

+5-1
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,12 @@ import kategory.Option.None
99
import org.junit.runner.RunWith
1010

1111
@RunWith(KTestJUnitRunner::class)
12-
class OptionTest : UnitSpec() {
12+
class OptionTest: UnitSpec() {
1313

1414
init {
15+
16+
testLaws(MonadLaws.laws(Option))
17+
1518
"map should modify value" {
1619
Some(12).map { "flower" } shouldBe Some("flower")
1720
None.map { "flower" } shouldBe None
@@ -102,4 +105,5 @@ class OptionTest : UnitSpec() {
102105
}
103106

104107
}
108+
105109
}

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

+2
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@ class TryTest : UnitSpec() {
1111

1212
init {
1313

14+
testLaws(MonadLaws.laws(Try))
15+
1416
"invoke of any should be success" {
1517
Try.invoke { 1 } shouldBe Success(1)
1618
}

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

+6-4
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,12 @@ class ValidatedTest : UnitSpec() {
1212

1313
init {
1414

15+
val concatStringSG: Semigroup<String> = object : Semigroup<String> {
16+
override fun combine(a: String, b: String): String = "$a $b"
17+
}
18+
19+
testLaws(ApplicativeLaws.laws(ValidatedApplicativeError(concatStringSG)))
20+
1521
"fold should call function on Invalid" {
1622
val exception = Exception("My Exception")
1723
val result: Validated<Throwable, String> = Invalid(exception)
@@ -154,10 +160,6 @@ class ValidatedTest : UnitSpec() {
154160
Invalid(10).withEither { it } shouldBe Invalid(10)
155161
}
156162

157-
val concatStringSG: Semigroup<String> = object : Semigroup<String> {
158-
override fun combine(a: String, b: String): String = "$a $b"
159-
}
160-
161163
"Cartesian builder should build products over homogeneous Validated" {
162164
ValidatedApplicativeError(concatStringSG).map(
163165
Valid("11th"),

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

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

12+
testLaws(MonadLaws.laws(WriterTMonad(NonEmptyList, IntMonoid)))
13+
1214
"tell should accumulate write" {
1315
forAll { a: Int ->
1416
val right = WriterT(Id(NonEmptyList.of(a) toT a))

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

+2
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,8 @@ class FreeTest : UnitSpec() {
3838

3939
init {
4040

41+
testLaws(MonadLaws.laws(Ops))
42+
4143
"Can interpret an ADT as Free operations" {
4244
program.foldMap(optionInterpreter, Option).ev() shouldBe Option.Some(-30)
4345
program.foldMap(idInterpreter, Id).ev() shouldBe Id(-30)
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
package kategory
2+
3+
import io.kotlintest.properties.Gen
4+
5+
inline fun <reified F, A> genApplicative(valueGen: Gen<A>, AP: Applicative<F> = applicative<F>()): Gen<HK<F, A>> = object : Gen<HK<F, A>> {
6+
override fun generate(): HK<F, A> = AP.pure(valueGen.generate())
7+
}
8+
9+
fun <A, B> genFunctionAToB(genB: Gen<B>): Gen<(A) -> B> = object : Gen<(A) -> B> {
10+
override fun generate(): (A) -> B {
11+
val v = genB.generate()
12+
return { a -> v }
13+
}
14+
}
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
package kategory
2+
3+
import io.kotlintest.properties.Gen
4+
import io.kotlintest.properties.forAll
5+
6+
object ApplicativeLaws {
7+
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) })
14+
)
15+
16+
inline fun <reified F> apIdentity(A: Applicative<F> = applicative<F>()): Unit =
17+
forAll(genApplicative(Gen.int(), A), { fa: HK<F, Int> ->
18+
A.ap(fa, A.pure({ n: Int -> n })) == fa
19+
})
20+
21+
inline fun <reified F> homomorphism(A: Applicative<F> = applicative<F>()): Unit =
22+
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))
24+
})
25+
26+
inline fun <reified F> interchange(A: Applicative<F> = applicative<F>()): Unit =
27+
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) }))
29+
})
30+
31+
inline fun <reified F> mapDerived(A: Applicative<F> = applicative<F>()): Unit =
32+
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))
34+
})
35+
36+
}
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
package kategory
2+
3+
import io.kotlintest.properties.Gen
4+
import io.kotlintest.properties.forAll
5+
6+
object FunctorLaws {
7+
8+
inline fun <reified F> laws(AP: Applicative<F> = applicative<F>()): List<Law> =
9+
listOf(
10+
Law("Functor Laws: Covariant Identity", { covariantIdentity(AP) }),
11+
Law("Functor: Covariant Composition", { covariantComposition(AP) })
12+
)
13+
14+
inline fun <reified F> covariantIdentity(AP: Applicative<F> = applicative<F>()): Unit =
15+
forAll(genApplicative(Gen.int(), AP), { fa: HK<F, Int> ->
16+
AP.map(fa, ::identity) == fa
17+
})
18+
19+
inline fun <reified F> covariantComposition(AP: Applicative<F> = applicative<F>()): Unit =
20+
forAll(
21+
genApplicative(Gen.int(), AP),
22+
genFunctionAToB<Int, Int>(Gen.int()),
23+
genFunctionAToB<Int, Int>(Gen.int()),
24+
{ fa: HK<F, Int>, f, g ->
25+
AP.map(AP.map(fa, f), g) == AP.map(fa, f andThen g)
26+
}
27+
)
28+
29+
}
30+
31+
32+
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
package kategory
2+
3+
data class Law(val name: String, val test: () -> Unit)
4+

0 commit comments

Comments
 (0)