MonadError Laws

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

@@ -1,6 +1,6 @@
 package kategory
 
-class EitherMonad<L> : Monad<EitherF<L>> {
+open class EitherMonad<L> : Monad<EitherF<L>> {
 
     override fun <A> pure(a: A): Either<L, A> = Either.Right(a)
 
@@ -20,4 +20,18 @@ class EitherMonad<L> : Monad<EitherF<L>> {
             }
         }
     }
+}
+
+class EitherMonadError<L> : EitherMonad<L>(), MonadError<EitherF<L>, L> {
+
+    override fun <A> raiseError(e: L): Either<L, A> = Either.Left(e)
+
+    override fun <A> handleErrorWith(fa: HK<EitherF<L>, A>, f: (L) -> HK<EitherF<L>, A>): Either<L, A> {
+        val fea = fa.ev()
+        return when (fea) {
+            is Either.Left -> f(fea.a).ev()
+            is Either.Right -> fea
+        }
+    }
+
 }

kategory/src/main/kotlin/kategory/typeclasses/ApplicativeError.kt

@@ -15,5 +15,13 @@ interface ApplicativeError<F, E> : Applicative<F>, Typeclass {
             }
 }
 
+fun <F, A> ApplicativeError<F, Throwable>.catch(f: () -> A): HK<F, A> =
+        try {
+            pure(f())
+        }
+        catch (e: Throwable) {
+            raiseError(e)
+        }
+
 inline fun <reified F, reified E> applicativeError(): ApplicativeError<F, E> =
         instance(InstanceParametrizedType(Monad::class.java, listOf(F::class.java, E::class.java)))

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

@@ -11,7 +11,7 @@ import org.junit.runner.RunWith
 class EitherTest : UnitSpec() {
     init {
 
-        testLaws(MonadLaws.laws(EitherMonad<Int>(), Eq()))
+        testLaws(MonadErrorLaws.laws(EitherMonadError<Throwable>(), Eq()))
 
         "map should modify value" {
             forAll { a: Int, b: String ->

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

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

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

@@ -7,8 +7,13 @@ inline fun <reified F, A> genApplicative(valueGen: Gen<A>, AP: Applicative<F> =
 }
 
 fun <A, B> genFunctionAToB(genB: Gen<B>): Gen<(A) -> B> = object : Gen<(A) -> B> {
-    override fun generate(): (A) -> B  {
+    override fun generate(): (A) -> B {
         val v = genB.generate()
         return { a -> v }
     }
+}
+
+fun genThrowable(): Gen<Throwable> = object : Gen<Throwable> {
+    override fun generate(): Throwable =
+            Gen.oneOf(listOf(RuntimeException(), NoSuchElementException(), IllegalArgumentException())).generate()
 }

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

@@ -0,0 +1,24 @@
+package kategory
+
+import io.kotlintest.properties.Gen
+import io.kotlintest.properties.forAll
+
+object MonadErrorLaws {
+
+    inline fun <reified F> laws(M: MonadError<F, Throwable> = monadError<F, Throwable>(), EQ: Eq<HK<F, Int>>): List<Law> =
+            MonadLaws.laws(M, EQ) + listOf(
+                    Law("Monad Error Laws: left zero", { monadErrorLeftZero(M, EQ) }),
+                    Law("Monad Error Laws: ensure consistency", { monadErrorEnsureConsistency(M, EQ) })
+            )
+
+    inline fun <reified F> monadErrorLeftZero(M: MonadError<F, Throwable> = monadError<F, Throwable>(), EQ: Eq<HK<F, Int>>): Unit =
+            forAll(genFunctionAToB<Int, HK<F, Int>>(genApplicative(Gen.int(), M)), genThrowable(), { f: (Int) -> HK<F, Int>, e: Throwable ->
+                M.flatMap(M.raiseError<Int>(e), f).equalUnderTheLaw(M.raiseError<Int>(e), EQ)
+            })
+
+    inline fun <reified F> monadErrorEnsureConsistency(M: MonadError<F, Throwable> = monadError<F, Throwable>(), EQ: Eq<HK<F, Int>>): Unit =
+            forAll(genApplicative(Gen.int(), M), genThrowable(), genFunctionAToB<Int, Boolean>(Gen.bool()), { fa: HK<F, Int>, e: Throwable, p: (Int) -> Boolean ->
+                M.ensure(fa, { e }, p).equalUnderTheLaw(M.flatMap(fa, { a -> if (p(a)) M.pure(a) else M.raiseError(e) }), EQ)
+            })
+
+}