Merge pull request #261 from kategory/jorge-monadcombine

Add Alternative, Bifoldable, and MonadCombine

Author: raulraja

kategory-core/src/main/kotlin/kategory/data/ListKW.kt

@@ -8,7 +8,10 @@ package kategory
         Foldable::class,
         Traverse::class,
         SemigroupK::class,
-        MonoidK::class)
+        MonoidK::class,
+        MonadCombine::class,
+        FunctorFilter::class,
+        MonadFilter::class)
 data class ListKW<out A> constructor(val list: List<A>) : ListKWKind<A>, List<A> by list {
 
     fun <B> flatMap(f: (A) -> ListKWKind<B>): ListKW<B> = this.ev().list.flatMap { f(it).ev().list }.k()
@@ -39,6 +42,9 @@ data class ListKW<out A> constructor(val list: List<A>) : ListKWKind<A>, List<A>
                 }
             }.ev()
 
+    fun <B> mapFilter(f: (A) -> Option<B>): ListKW<B> =
+            flatMap({ a -> f(a).fold({ empty<B>() }, { pure(it) }) })
+
     companion object {
 
         fun <A> pure(a: A): ListKW<A> = listOf(a).k()

kategory-core/src/main/kotlin/kategory/data/StateT.kt

@@ -15,6 +15,8 @@ class StateT<F, S, A>(
 
         fun <F, S, A> invokeF(runF: StateTFunKind<F, S, A>): StateT<F, S, A> = StateT(runF)
 
+        fun <F, S, A> lift(fa: HK<F, A>, MF: Monad<F>): StateT<F, S, A> = StateT(MF.pure({ s -> MF.map(fa, { a -> Tuple2(s, a) }) }))
+
         inline fun <reified F, S> functor(FF: Functor<F> = functor<F>()): StateTFunctorInstance<F, S> =
                 StateTFunctorInstanceImplicits.instance(FF)
 
@@ -30,6 +32,12 @@ class StateT<F, S, A>(
         inline fun <reified F, S> semigroupK(MF: Monad<F> = monad<F>(), SF: SemigroupK<F> = semigroupK<F>()): StateTSemigroupKInstance<F, S> =
                 StateTSemigroupKInstanceImplicits.instance(MF, SF)
 
+        inline fun <reified F, S> monadCombine(MCF: MonadCombine<F> = monadCombine<F>()): StateTMonadCombineInstance<F, S> =
+                StateTMonadCombineInstanceImplicits.instance(MCF)
+
+        inline fun <reified F, S, reified E> monadError(ME: MonadError<F, E> = monadError<F, E>()) : StateTMonadErrorInstance<F, S, E> =
+                StateTMonadErrorImplicits.instance(ME)
+
         fun <F, S> get(AF: Applicative<F>): StateT<F, S, S> = StateT(AF.pure({ s: S -> AF.pure(Tuple2(s, s)) }))
 
         fun <F, S> set(s: S, AF: Applicative<F>): StateT<F, S, Unit> = StateT(AF.pure({ _: S -> AF.pure(Tuple2(s, Unit)) }))

kategory-core/src/main/kotlin/kategory/instances/OptionInstances.kt

@@ -1,16 +1,19 @@
 package kategory
 
+import kategory.Option.None
+import kategory.Option.Some
+
 interface OptionSemigroupInstance<A> : Semigroup<Option<A>> {
 
     fun SG(): Semigroup<A>
 
     override fun combine(a: Option<A>, b: Option<A>): Option<A> =
             when (a) {
-                is Option.Some<A> -> when (b) {
-                    is Option.Some<A> -> Option.Some(SG().combine(a.value, b.value))
-                    is Option.None -> b
+                is Some<A> -> when (b) {
+                    is Some<A> -> Some(SG().combine(a.value, b.value))
+                    is None -> b
                 }
-                is Option.None -> a
+                is None -> a
             }
 }
 

kategory-core/src/main/kotlin/kategory/instances/StateTInstances.kt

@@ -95,3 +95,39 @@ object StateTSemigroupKInstanceImplicits {
     }
 }
 
+interface StateTMonadCombineInstance<F, S> : MonadCombine<StateTKindPartial<F, S>>, StateTMonadInstance<F, S>, StateTSemigroupKInstance<F, S> {
+
+    override fun MF(): MonadCombine<F>
+    override fun SF(): SemigroupK<F> = MF()
+
+    override fun <A> empty(): HK<StateTKindPartial<F, S>, A> = liftT(MF().empty())
+
+    fun <A> liftT(ma: HK<F, A>): StateT<F, S, A> = StateT(MF().pure({ s: S -> MF().map(ma, { a: A -> s toT a }) }))
+}
+
+object StateTMonadCombineInstanceImplicits {
+    @JvmStatic
+    fun <F, S> instance(MCF: MonadCombine<F>): StateTMonadCombineInstance<F, S> = object : StateTMonadCombineInstance<F, S> {
+        override fun FF(): Functor<F> = MCF
+        override fun MF(): MonadCombine<F> = MCF
+
+    }
+}
+
+interface StateTMonadErrorInstance<F, S, E> : StateTMonadInstance<F, S>, MonadError<StateTKindPartial<F, S>, E> {
+    override fun MF(): MonadError<F, E>
+
+    override fun <A> raiseError(e: E): HK<StateTKindPartial<F, S>, A> = StateT.lift(MF().raiseError(e), MF())
+
+    override fun <A> handleErrorWith(fa: HK<StateTKindPartial<F, S>, A>, f: (E) -> HK<StateTKindPartial<F, S>, A>): StateT<F, S, A> =
+            StateT(MF().pure({ s -> MF().handleErrorWith(fa.runM(s, MF()), { e -> f(e).runM(s, MF()) }) }))
+}
+
+object StateTMonadErrorImplicits {
+    @JvmStatic
+    fun <F, S, E> instance(ME: MonadError<F, E>): StateTMonadErrorInstance<F, S, E> = object : StateTMonadErrorInstance<F, S, E> {
+        override fun FF(): Functor<F> = ME
+        override fun MF(): MonadError<F, E> = ME
+    }
+}
+

kategory-core/src/main/kotlin/kategory/typeclasses/Alternative.kt

@@ -1,7 +1,5 @@
-package kategory.typeclasses
-
-import kategory.Applicative
-import kategory.MonoidK
-import kategory.Typeclass
+package kategory
 
 interface Alternative<F> : Applicative<F>, MonoidK<F>, Typeclass
+
+inline fun <reified F> alternative(): Alternative<F> = instance(InstanceParametrizedType(Alternative::class.java, listOf(F::class.java)))

kategory-core/src/main/kotlin/kategory/typeclasses/Bifoldable.kt

@@ -0,0 +1,16 @@
+package kategory
+
+interface Bifoldable<F> : Typeclass {
+
+    fun <A, B, C> bifoldLeft(fab: HK2<F, A, B>, c: C, f: (C, A) -> C, g: (C, B) -> C): C
+
+    fun <A, B, C> bifoldRight(fab: HK2<F, A, B>, c: Eval<C>, f: (A, Eval<C>) -> Eval<C>, g: (B, Eval<C>) -> Eval<C>): Eval<C>
+
+    fun <A, B, C> bifoldMap(fab: HK2<F, A, B>, f: (A) -> C, g: (B) -> C, MC: Monoid<C>) =
+            bifoldLeft(fab, MC.empty(), { c, a -> MC.combine(c, f(a)) }, { c, b -> MC.combine(c, g(b)) })
+}
+
+inline fun <F, A, B, reified C> Bifoldable<in F>.bifoldMap(fab: HK2<F, A, B>, noinline f: (A) -> C, noinline g: (B) -> C, MC: Monoid<C> = monoid()) =
+        bifoldMap(fab, f, g, MC)
+
+inline fun <reified F> bifoldable(): Bifoldable<F> = instance(InstanceParametrizedType(Bifoldable::class.java, listOf(F::class.java)))

kategory-core/src/main/kotlin/kategory/typeclasses/Composed.kt

@@ -1,7 +1,5 @@
 package kategory
 
-import kategory.typeclasses.Alternative
-
 /**
  * https://www.youtube.com/watch?v=wvSP5qYiz4Y
  */
@@ -10,9 +8,15 @@ interface ComposedType<out F, out G>
 @Suppress("UNCHECKED_CAST")
 fun <F, G, A> HK<F, HK<G, A>>.lift(): HK<ComposedType<F, G>, A> = this as HK<ComposedType<F, G>, A>
 
+@Suppress("UNCHECKED_CAST")
+fun <F, G, A, B> HK2<F, HK2<G, A, B>, HK2<G, A, B>>.liftB(): HK2<ComposedType<F, G>, A, B> = this as HK2<ComposedType<F, G>, A, B>
+
 @Suppress("UNCHECKED_CAST")
 fun <F, G, A> HK<ComposedType<F, G>, A>.lower(): HK<F, HK<G, A>> = this as HK<F, HK<G, A>>
 
+@Suppress("UNCHECKED_CAST")
+fun <F, G, A, B> HK2<ComposedType<F, G>, A, B>.lowerB(): HK2<F, HK2<G, A, B>, HK2<G, A, B>> = this as HK2<F, HK2<G, A, B>, HK2<G, A, B>>
+
 interface ComposedFoldable<F, G> :
         Foldable<ComposedType<F, G>> {
 
@@ -219,3 +223,36 @@ interface ComposedFunctorFilter<F, G> : FunctorFilter<ComposedType<F, G>>, Compo
 
 inline fun <reified F, reified G> Functor<F>.composeFilter(FFG: FunctorFilter<G> = functorFilter()):
         FunctorFilter<ComposedType<F, G>> = ComposedFunctorFilter(this, FFG)
+
+interface ComposedBifoldable<F, G> : Bifoldable<ComposedType<F, G>> {
+    fun F(): Bifoldable<F>
+
+    fun G(): Bifoldable<G>
+
+    override fun <A, B, C> bifoldLeft(fab: HK2<ComposedType<F, G>, A, B>, c: C, f: (C, A) -> C, g: (C, B) -> C): C =
+            F().bifoldLeft(fab.lowerB(), c,
+                    { cc: C, gab: HK2<G, A, B> -> G().bifoldLeft(gab, cc, f, g) },
+                    { cc: C, gab: HK2<G, A, B> -> G().bifoldLeft(gab, cc, f, g) })
+
+    override fun <A, B, C> bifoldRight(fab: HK2<ComposedType<F, G>, A, B>, c: Eval<C>, f: (A, Eval<C>) -> Eval<C>, g: (B, Eval<C>) -> Eval<C>): Eval<C> =
+            F().bifoldRight(fab.lowerB(), c,
+                    { gab: HK2<G, A, B>, cc: Eval<C> -> G().bifoldRight(gab, cc, f, g) },
+                    { gab: HK2<G, A, B>, cc: Eval<C> -> G().bifoldRight(gab, cc, f, g) })
+
+    fun <A, B, C> bifoldLeftC(fab: HK2<F, HK2<G, A, B>, HK2<G, A, B>>, c: C, f: (C, A) -> C, g: (C, B) -> C): C =
+            bifoldLeft(fab.liftB(), c, f, g)
+
+    fun <A, B, C> bifoldRightC(fab: HK2<F, HK2<G, A, B>, HK2<G, A, B>>, c: Eval<C>, f: (A, Eval<C>) -> Eval<C>, g: (B, Eval<C>) -> Eval<C>): Eval<C> =
+            bifoldRight(fab.liftB(), c, f, g)
+
+    companion object {
+        operator fun <F, G> invoke(BF: Bifoldable<F>, BG: Bifoldable<G>): ComposedBifoldable<F, G> =
+                object : ComposedBifoldable<F, G> {
+                    override fun F(): Bifoldable<F> = BF
+
+                    override fun G(): Bifoldable<G> = BG
+                }
+    }
+}
+
+inline fun <reified F, reified G> Bifoldable<F>.compose(BG: Bifoldable<G> = bifoldable()): Bifoldable<ComposedType<F, G>> = ComposedBifoldable(this, BG)

kategory-core/src/main/kotlin/kategory/typeclasses/MonadCombine.kt

@@ -0,0 +1,22 @@
+package kategory
+
+/**
+ * The combination of a Monad with a MonoidK
+ */
+interface MonadCombine<F> : MonadFilter<F>, Alternative<F>, Typeclass {
+
+    fun <G, A> unite(fga: HK<F, HK<G, A>>, FG: Foldable<G>): HK<F, A> =
+            flatMap(fga, { ga -> FG.foldL(ga, empty<A>(), { acc, a -> combineK(acc, pure(a)) }) })
+
+    fun <G, A, B> separate(fgab: HK<F, HK2<G, A, B>>, BFG: Bifoldable<G>): Tuple2<HK<F, A>, HK<F, B>> {
+        val asep = flatMap(fgab, { gab -> BFG.bifoldMap(gab, { pure(it) }, { _ -> empty<A>() }, algebra<A>()) })
+        val bsep = flatMap(fgab, { gab -> BFG.bifoldMap(gab, { _ -> empty<B>() }, { pure(it) }, algebra<B>()) })
+        return Tuple2(asep, bsep)
+    }
+}
+
+inline fun <reified F> monadCombine(): MonadCombine<F> = instance(InstanceParametrizedType(MonadCombine::class.java, listOf(typeLiteral<F>())))
+
+inline fun <F, reified G, A> MonadCombine<F>.uniteF(fga: HK<F, HK<G, A>>, FG: Foldable<G> = foldable()) = unite(fga, FG)
+
+inline fun <F, reified G, A, B> MonadCombine<F>.separateF(fgab: HK<F, HK2<G, A, B>>, BFG: Bifoldable<G> = bifoldable()) = separate(fgab, BFG)

kategory-core/src/test/kotlin/kategory/data/BifoldableTests.kt

@@ -0,0 +1,28 @@
+package kategory
+
+import io.kotlintest.KTestJUnitRunner
+import org.junit.runner.RunWith
+
+@RunWith(KTestJUnitRunner::class)
+class BifoldableTests : UnitSpec() {
+    init {
+
+        val eitherBifoldable: Bifoldable<EitherHK> = object : Bifoldable<EitherHK> {
+            override fun <A, B, C> bifoldLeft(fab: HK2<EitherHK, A, B>, c: C, f: (C, A) -> C, g: (C, B) -> C): C =
+                    when (fab) {
+                        is Either.Left -> f(c, fab.a)
+                        else -> g(c, (fab as Either.Right).b)
+                    }
+
+            override fun <A, B, C> bifoldRight(fab: HK2<EitherHK, A, B>, c: Eval<C>, f: (A, Eval<C>) -> Eval<C>, g: (B, Eval<C>) -> Eval<C>): Eval<C> =
+                    when (fab) {
+                        is Either.Left -> f(fab.a, c)
+                        else -> g((fab as Either.Right).b, c)
+                    }
+        }
+
+        val eitherComposeEither = eitherBifoldable.compose(eitherBifoldable)
+
+        testLaws(BifoldableLaws.laws(eitherComposeEither, { cf: Int -> Either.Right(Either.Right(cf)).liftB() }, Eq.any()))
+    }
+}

kategory-core/src/test/kotlin/kategory/data/ListKWTest.kt

@@ -1,6 +1,7 @@
 package kategory
 
 import io.kotlintest.KTestJUnitRunner
+import io.kotlintest.matchers.shouldNot
 import io.kotlintest.matchers.shouldNotBe
 import org.junit.runner.RunWith
 
@@ -19,11 +20,15 @@ class ListKWTest : UnitSpec() {
             semigroupK<ListKWHK>() shouldNotBe null
             semigroup<ListKW<Int>>() shouldNotBe null
             monoid<ListKW<Int>>() shouldNotBe null
+            monoidK<ListKW<ListKWHK>>() shouldNotBe null
+            monadCombine<ListKW<ListKWHK>>() shouldNotBe null
+            functorFilter<ListKW<ListKWHK>>() shouldNotBe null
+            monadFilter<ListKW<ListKWHK>>() shouldNotBe null
         }
 
         testLaws(MonadLaws.laws(ListKW.monad(), Eq.any()))
         testLaws(SemigroupKLaws.laws(ListKW.semigroupK(), applicative, Eq.any()))
         testLaws(MonoidKLaws.laws(ListKW.monoidK(), applicative, Eq.any()))
         testLaws(TraverseLaws.laws(ListKW.traverse(), applicative, { n: Int -> ListKW(listOf(n)) }, Eq.any()))
     }
-}
+}

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

@@ -3,7 +3,6 @@ package kategory
 import io.kotlintest.KTestJUnitRunner
 import io.kotlintest.matchers.shouldNotBe
 import io.kotlintest.properties.forAll
-import kategory.laws.FunctorFilterLaws
 import org.junit.runner.RunWith
 
 @RunWith(KTestJUnitRunner::class)

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

@@ -6,7 +6,6 @@ import io.kotlintest.matchers.shouldNotBe
 import io.kotlintest.properties.forAll
 import kategory.Option.None
 import kategory.Option.Some
-import kategory.laws.MonadFilterLaws
 import org.junit.runner.RunWith
 
 @RunWith(KTestJUnitRunner::class)
@@ -39,7 +38,7 @@ class OptionTest : UnitSpec() {
                                         })
                             })
         }
-        
+
         //testLaws(MonadErrorLaws.laws(monadError<OptionHK, Unit>(), Eq.any(), EQ_EITHER)) TODO reenable once the MonadErrorLaws are parametric to `E`
         testLaws(TraverseLaws.laws(Option.traverse(), Option.monad(), ::Some, Eq.any()))
         testLaws(MonadFilterLaws.laws(Option.monadFilter(), ::Some, Eq.any()))

kategory-core/src/test/kotlin/kategory/data/StateTTests.kt

@@ -38,5 +38,14 @@ class StateTTests : UnitSpec() {
                     override fun eqv(a: HK<StateTKindPartial<ListKWHK, Int>, Int>, b: HK<StateTKindPartial<ListKWHK, Int>, Int>): Boolean =
                             a.runM(1, ListKW.monad()) == b.runM(1, ListKW.monad())
                 }))
+
+        testLaws(MonadCombineLaws.laws(StateT.monadCombine<ListKWHK, Int>(ListKW.monadCombine()),
+                { StateT.lift(ListKW.pure(it), ListKW.monad()) },
+                { StateT.lift(ListKW.pure({ s: Int -> s * 2 }), ListKW.monad()) },
+                object : Eq<HK<StateTKindPartial<ListKWHK, Int>, Int>> {
+                    override fun eqv(a: HK<StateTKindPartial<ListKWHK, Int>, Int>, b: HK<StateTKindPartial<ListKWHK, Int>, Int>): Boolean =
+                            a.runM(1, ListKW.monad()) == b.runM(1, ListKW.monad())
+                }))
+
     }
 }

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

@@ -2,8 +2,6 @@ package kategory
 
 import io.kotlintest.KTestJUnitRunner
 import io.kotlintest.matchers.shouldNotBe
-import kategory.laws.FunctorFilterLaws
-import kategory.laws.MonadFilterLaws
 import org.junit.runner.RunWith
 
 @RunWith(KTestJUnitRunner::class)

kategory-core/src/test/kotlin/kategory/instances/ComposedInstancesTest.kt

@@ -2,7 +2,6 @@ package kategory.instances
 
 import io.kotlintest.KTestJUnitRunner
 import kategory.*
-import kategory.laws.FunctorFilterLaws
 import org.junit.runner.RunWith
 
 typealias OptionTNel = HK<OptionTKindPartial<NonEmptyListHK>, Int>
@@ -42,4 +41,4 @@ class ComposedInstancesTest : UnitSpec() {
         testLaws(SemigroupKLaws.laws(ComposedSemigroupK<ListKWHK, OptionHK>(ListKW.semigroupK()), ComposedApplicative(ListKW.applicative(), Option.applicative()), EQ_LKW_OPTION))
         testLaws(MonoidKLaws.laws(ComposedMonoidK<ListKWHK, OptionHK>(ListKW.monoidK()), ComposedApplicative(ListKW.applicative(), Option.applicative()), EQ_LKW_OPTION))
     }
-}
+}

kategory-core/src/test/kotlin/kategory/instances/StringInstancesTest.kt

@@ -3,7 +3,6 @@ package kategory.instances
 import io.kotlintest.KTestJUnitRunner
 import io.kotlintest.matchers.shouldNotBe
 import kategory.*
-import kategory.laws.FunctorFilterLaws
 import org.junit.runner.RunWith
 
 @RunWith(KTestJUnitRunner::class)
@@ -14,4 +13,4 @@ class StringInstancesTest : UnitSpec() {
             monoid<String>() shouldNotBe null
         }
     }
-}
+}

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

@@ -47,6 +47,12 @@ inline fun <F, A> genConstructor(valueGen: Gen<A>, crossinline cf: (A) -> HK<F,
                     cf(valueGen.generate())
         }
 
+inline fun <F, A, B> genConstructor2(valueGen: Gen<A>, crossinline ff: (A) -> HK<F, (A) -> B>): Gen<HK<F, (A) -> B>> =
+        object : Gen<HK<F, (A) -> B>> {
+            override fun generate(): HK<F, (A) -> B> =
+                    ff(valueGen.generate())
+        }
+
 fun genIntSmall(): Gen<Int> =
         Gen.oneOf(Gen.negativeIntegers(), Gen.choose(0, Int.MAX_VALUE / 10000))