Merge pull request #112 from kategory/rr-discipline

Typeclasses laws

Author: raulraja

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

@@ -26,6 +26,8 @@ fun <A, B> IorKind<A, B>.ev(): Ior<A, B> =
  * [Ior]<`A`,`B`> is isomorphic to [Either]<[Either]<`A`,`B`>, [Pair]<`A`,`B`>>, but provides methods biased toward `B`
  * values, regardless of whether the `B` values appear in a [Ior.Right] or a [Ior.Both].
  * The isomorphic Either form can be accessed via the [unwrap] method.
+ *
+ * El primogenito de @ffgiraldez
  */
 
 sealed class Ior<out A, out B> : IorKind<A, B> {

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

@@ -1,16 +1,16 @@
 package kategory
 
-typealias KleisiTKind<F, A, B> = HK3<Kleisli.F, F, A, B>
-typealias KleisiF<F> = HK<Kleisli.F, F>
+typealias KleisliTKind<F, A, B> = HK3<Kleisli.F, F, A, B>
+typealias KleisliF<F> = HK<Kleisli.F, F>
 
-typealias KleisiFun<F, D, A> = (D) -> HK<F, A>
+typealias KleisliFun<F, D, A> = (D) -> HK<F, A>
 
 typealias ReaderT<F, D, A> = Kleisli<F, D, A>
 
-fun <F, D, A> KleisiTKind<F, D, A>.ev(): Kleisli<F, D, A> =
+fun <F, D, A> KleisliTKind<F, D, A>.ev(): Kleisli<F, D, A> =
         this as Kleisli<F, D, A>
 
-class Kleisli<F, D, A>(val MF: Monad<F>, val run: KleisiFun<F, D, A>) : KleisiTKind<F, D, A> {
+class Kleisli<F, D, A>(val MF: Monad<F>, val run: KleisliFun<F, D, A>) : KleisliTKind<F, D, A> {
     class F private constructor()
 
     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
     fun <DD> local(f: (DD) -> D): Kleisli<F, DD, A> =
             Kleisli(MF, { dd -> run(f(dd)) })
 
-    fun <B> andThen(f: (A) -> HK<F, B>): Kleisli<F, D, B> =
+    infix fun <C> andThen(f: Kleisli<F, A, C>): Kleisli<F, D, C> =
+            andThen(f.run)
+
+    infix fun <B> andThen(f: (A) -> HK<F, B>): Kleisli<F, D, B> =
             Kleisli(MF, { MF.flatMap(run(it), f) })
 
-    fun <B> andThen(a: HK<F, B>): Kleisli<F, D, B> =
+    infix fun <B> andThen(a: HK<F, B>): Kleisli<F, D, B> =
             andThen({ a })
 
     companion object {
 
-        inline operator fun <reified F, D, A> invoke(noinline run: KleisiFun<F, D, A>, MF: Monad<F> = monad<F>()): Kleisli<F, D, A> =
+        inline operator fun <reified F, D, A> invoke(noinline run: KleisliFun<F, D, A>, MF: Monad<F> = monad<F>()): Kleisli<F, D, A> =
                 Kleisli(MF, run)
 
         @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

@@ -7,6 +7,9 @@ class EitherMonad<L> : Monad<EitherF<L>> {
     override fun <A, B> flatMap(fa: EitherKind<L, A>, f: (A) -> EitherKind<L, B>): Either<L, B> =
             fa.ev().flatMap { f(it).ev() }
 
+    override fun <A, B> map(fa: HK<EitherF<L>, A>, f: (A) -> B): Either<L, B> =
+            fa.ev().map(f)
+
     tailrec override fun <A, B> tailRecM(a: A, f: (A) -> HK<EitherF<L>, Either<A, B>>): Either<L, B> {
         val e = f(a).ev().ev()
         return when (e) {

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

@@ -25,6 +25,9 @@ data class Function0<out A>(internal val f: () -> A) : HK<Function0.F, A> {
         override fun <A> extract(fa: HK<Function0.F, A>): A =
                 fa.ev().invoke()
 
+        override fun <A, B> map(fa: HK<F, A>, f: (A) -> B): HK<F, B> =
+                pure(f(fa.ev().invoke()))
+
         override fun <A, B> tailRecM(a: A, f: (A) -> HK<F, Either<A, B>>): HK<F, B> =
                 f(a).ev().invoke().let { either ->
                     when (either) {

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

@@ -6,6 +6,9 @@ class IorMonad<L>(val SL: Semigroup<L>) : Monad<HK<Ior.F, L>> {
 
     override fun <A> pure(a: A): Ior<L, A> = Ior.Right(a)
 
+    override fun <A, B> map(fa: IorKind<L, A>, f: (A) -> B): Ior<L, B> =
+        fa.ev().map(f)
+
     private tailrec fun <A, B> loop(v: Ior<L, Either<A, B>>, f: (A) -> IorKind<L, Either<A, B>>): Ior<L, B> {
         return when (v) {
             is Ior.Left -> Ior.Left(v.value)

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

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

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

@@ -6,6 +6,9 @@ interface NonEmptyListMonad : Monad<NonEmptyList.F> {
     override fun <A, B> flatMap(fa: NonEmptyListKind<A>, f: (A) -> NonEmptyListKind<B>): NonEmptyList<B> =
             fa.ev().flatMap { f(it).ev() }
 
+    override fun <A, B> map(fa: NonEmptyListKind<A>, f: (A) -> B): NonEmptyList<B> =
+            fa.ev().map(f)
+
     @Suppress("UNCHECKED_CAST")
     private tailrec fun <A, B> go(buf: ArrayList<B>, f: (A) -> HK<NonEmptyList.F, Either<A, B>>, v: NonEmptyList<Either<A, B>>): Unit =
             when (v.head) {

kategory/src/main/kotlin/kategory/predef.kt

@@ -0,0 +1,3 @@
+package kategory
+
+fun <A> identity(a: A): A = a

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

@@ -1,5 +1,6 @@
 package kategory
 
+import io.kotlintest.TestCase
 import io.kotlintest.specs.StringSpec
 
 
@@ -17,4 +18,12 @@ abstract class UnitSpec : StringSpec() {
             Eval
         }
     }
+
+    fun testLaws(laws: List<Law>): List<TestCase> =
+        laws.map { law ->
+            val tc = TestCase(suite = rootTestSuite, name = law.name, test = law.test, config = defaultTestCaseConfig)
+            rootTestSuite.addTestCase(tc)
+            tc
+        }
+
 }

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

@@ -9,6 +9,9 @@ import org.junit.runner.RunWith
 @RunWith(KTestJUnitRunner::class)
 class EitherTTest : UnitSpec() {
     init {
+
+        testLaws(MonadLaws.laws(EitherTMonad<Id.F, Int>()))
+
         "map should modify value" {
             forAll { a: String ->
                 val right = EitherT(Id(Either.Right(a)))

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

@@ -10,6 +10,9 @@ import org.junit.runner.RunWith
 @RunWith(KTestJUnitRunner::class)
 class EitherTest : UnitSpec() {
     init {
+
+        testLaws(MonadLaws.laws(EitherMonad<Int>()))
+
         "map should modify value" {
             forAll { a: Int, b: String ->
                 Right(a).map { b } == Right(b)

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

@@ -7,6 +7,9 @@ import org.junit.runner.RunWith
 @RunWith(KTestJUnitRunner::class)
 class EvalTest : UnitSpec() {
     init {
+
+        testLaws(MonadLaws.laws(Eval))
+
         "should map wrapped value" {
             val sideEffect = SideEffect()
             val mapped = Eval.now(0)

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

@@ -7,6 +7,9 @@ import org.junit.runner.RunWith
 @RunWith(KTestJUnitRunner::class)
 class Function0Test : UnitSpec() {
     init {
+
+        testLaws(MonadLaws.laws(Function0))
+
         "Function0Monad.binding should for comprehend over all values of multiple Function0" {
             Function0.binding {
                 val x = Function0 { 1 }.bind()

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

@@ -7,6 +7,9 @@ import org.junit.runner.RunWith
 @RunWith(KTestJUnitRunner::class)
 class IdTest : UnitSpec() {
     init {
+
+        testLaws(MonadLaws.laws(Id))
+
         "IdMonad.binding should for comprehend over all values of multiple Ids" {
             Id.binding {
                 val x = Id(1).bind()

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

@@ -8,7 +8,13 @@ import org.junit.runner.RunWith
 
 @RunWith(KTestJUnitRunner::class)
 class IorTest : UnitSpec() {
+
     init {
+
+        val intIorMonad = IorMonad(IntMonoid)
+
+        testLaws(MonadLaws.laws(intIorMonad))
+
         "flatMap() should modify entity" {
             forAll { a: Int, b: String ->
                 {
@@ -131,8 +137,6 @@ class IorTest : UnitSpec() {
 
         }
 
-        val intIorMonad = IorMonad(IntMonoid)
-
         "Ior.monad.flatMap should combine left values" {
             val ior1 = Ior.Both(3, "Hello, world!")
             val iorResult = intIorMonad.flatMap(ior1, { Ior.Left(7) })

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

@@ -8,6 +8,9 @@ import org.junit.runner.RunWith
 @RunWith(KTestJUnitRunner::class)
 class NonEmptyListTest : UnitSpec() {
     init {
+
+        testLaws(MonadLaws.laws(NonEmptyList))
+
         "map should modify values" {
             NonEmptyList.of(14).map { it * 3 } shouldBe NonEmptyList.of(42)
         }

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

@@ -8,6 +8,9 @@ import org.junit.runner.RunWith
 @RunWith(KTestJUnitRunner::class)
 class OptionTTest : UnitSpec() {
     init {
+
+        testLaws(MonadLaws.laws(OptionTMonad(NonEmptyList)))
+
         "map should modify value" {
             forAll { a: String ->
                 val ot = OptionT(Id(Option.Some(a)))

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

@@ -9,9 +9,12 @@ import kategory.Option.None
 import org.junit.runner.RunWith
 
 @RunWith(KTestJUnitRunner::class)
-class OptionTest : UnitSpec() {
+class OptionTest: UnitSpec() {
 
     init {
+
+        testLaws(MonadLaws.laws(Option))
+
         "map should modify value" {
             Some(12).map { "flower" } shouldBe Some("flower")
             None.map { "flower" } shouldBe None
@@ -102,4 +105,5 @@ class OptionTest : UnitSpec() {
         }
 
     }
+
 }

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

@@ -11,6 +11,8 @@ class TryTest : UnitSpec() {
 
     init {
 
+        testLaws(MonadLaws.laws(Try))
+
         "invoke of any should be success" {
             Try.invoke { 1 } shouldBe Success(1)
         }

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

@@ -12,6 +12,12 @@ class ValidatedTest : UnitSpec() {
 
     init {
 
+        val concatStringSG: Semigroup<String> = object : Semigroup<String> {
+            override fun combine(a: String, b: String): String = "$a $b"
+        }
+
+        testLaws(ApplicativeLaws.laws(ValidatedApplicativeError(concatStringSG)))
+
         "fold should call function on Invalid" {
             val exception = Exception("My Exception")
             val result: Validated<Throwable, String> = Invalid(exception)
@@ -154,10 +160,6 @@ class ValidatedTest : UnitSpec() {
             Invalid(10).withEither { it } shouldBe Invalid(10)
         }
 
-        val concatStringSG: Semigroup<String> = object : Semigroup<String> {
-            override fun combine(a: String, b: String): String = "$a $b"
-        }
-
         "Cartesian builder should build products over homogeneous Validated" {
             ValidatedApplicativeError(concatStringSG).map(
                     Valid("11th"),

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

@@ -9,6 +9,8 @@ import org.junit.runner.RunWith
 class WriterTTest : UnitSpec() {
     init {
 
+        testLaws(MonadLaws.laws(WriterTMonad(NonEmptyList, IntMonoid)))
+
         "tell should accumulate write" {
             forAll { a: Int ->
                 val right = WriterT(Id(NonEmptyList.of(a) toT a))

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

@@ -38,6 +38,8 @@ class FreeTest : UnitSpec() {
 
     init {
 
+        testLaws(MonadLaws.laws(Ops))
+
         "Can interpret an ADT as Free operations" {
             program.foldMap(optionInterpreter, Option).ev() shouldBe Option.Some(-30)
             program.foldMap(idInterpreter, Id).ev() shouldBe Id(-30)

kategory/src/test/kotlin/kategory/generators/Generators.kt

@@ -0,0 +1,14 @@
+package kategory
+
+import io.kotlintest.properties.Gen
+
+inline fun <reified F, A> genApplicative(valueGen: Gen<A>, AP: Applicative<F> = applicative<F>()): Gen<HK<F, A>> = object : Gen<HK<F, A>> {
+    override fun generate(): HK<F, A> = AP.pure(valueGen.generate())
+}
+
+fun <A, B> genFunctionAToB(genB: Gen<B>): Gen<(A) -> B> = object : Gen<(A) -> B> {
+    override fun generate(): (A) -> B  {
+        val v = genB.generate()
+        return { a -> v }
+    }
+}

kategory/src/test/kotlin/instances/GlobalInstancesTest.kt kategory/src/test/kotlin/kategory/instances/GlobalInstancesTest.kt

@@ -0,0 +1,36 @@
+package kategory
+
+import io.kotlintest.properties.Gen
+import io.kotlintest.properties.forAll
+
+object ApplicativeLaws {
+
+    inline fun <reified F> laws(A: Applicative<F> = applicative<F>()): List<Law> =
+            FunctorLaws.laws(A) + listOf(
+                    Law("Applicative Laws: ap identity", { apIdentity(A) }),
+                    Law("Applicative Laws: homomorphism", { homomorphism(A) }),
+                    Law("Applicative Laws: interchange", { interchange(A) }),
+                    Law("Applicative Laws: map derived", { mapDerived(A) })
+            )
+
+    inline fun <reified F> apIdentity(A: Applicative<F> = applicative<F>()): Unit =
+            forAll(genApplicative(Gen.int(), A), { fa: HK<F, Int> ->
+                A.ap(fa, A.pure({ n: Int -> n })) == fa
+            })
+
+    inline fun <reified F> homomorphism(A: Applicative<F> = applicative<F>()): Unit =
+            forAll(genFunctionAToB<Int, Int>(Gen.int()), Gen.int(), { ab: (Int) -> Int, a: Int ->
+                A.ap(A.pure(a), A.pure(ab)) == A.pure(ab(a))
+            })
+
+    inline fun <reified F> interchange(A: Applicative<F> = applicative<F>()): Unit =
+            forAll(genApplicative(genFunctionAToB<Int, Int>(Gen.int()), A), Gen.int(), { fa: HK<F, (Int) -> Int>, a: Int ->
+                A.ap(A.pure(a), fa) == A.ap(fa, A.pure({ x: (Int) -> Int -> x(a) }))
+            })
+
+    inline fun <reified F> mapDerived(A: Applicative<F> = applicative<F>()): Unit =
+            forAll(genApplicative(Gen.int(), A), genFunctionAToB<Int, Int>(Gen.int()), { fa: HK<F, Int>, f: (Int) -> Int ->
+                A.map(fa, f) == A.ap(fa, A.pure(f))
+            })
+
+}

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

@@ -0,0 +1,32 @@
+package kategory
+
+import io.kotlintest.properties.Gen
+import io.kotlintest.properties.forAll
+
+object FunctorLaws {
+
+    inline fun <reified F> laws(AP: Applicative<F> = applicative<F>()): List<Law> =
+            listOf(
+                    Law("Functor Laws: Covariant Identity", { covariantIdentity(AP) }),
+                    Law("Functor: Covariant Composition", { covariantComposition(AP) })
+            )
+
+    inline fun <reified F> covariantIdentity(AP: Applicative<F> = applicative<F>()): Unit =
+            forAll(genApplicative(Gen.int(), AP), { fa: HK<F, Int> ->
+                AP.map(fa, ::identity) == fa
+            })
+
+    inline fun <reified F> covariantComposition(AP: Applicative<F> = applicative<F>()): Unit =
+            forAll(
+                    genApplicative(Gen.int(), AP),
+                    genFunctionAToB<Int, Int>(Gen.int()),
+                    genFunctionAToB<Int, Int>(Gen.int()),
+                    { fa: HK<F, Int>, f, g ->
+                        AP.map(AP.map(fa, f), g) == AP.map(fa, f andThen g)
+                    }
+            )
+
+}
+
+
+

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

@@ -0,0 +1,4 @@
+package kategory
+
+data class Law(val name: String, val test: () -> Unit)
+