Add TraverseFilter

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

@@ -9,6 +9,8 @@ fun <A, T> ConstKind<A, T>.value(): A = this.ev().value
 
     fun <F, U> traverse(f: (T) -> HK<F, U>, FA: Applicative<F>): HK<F, Const<A, U>> = FA.pure(retag())
 
+    fun <F, U> traverseFilter(f: (T) -> HK<F, Option<U>>, FA: Applicative<F>): HK<F, Const<A, U>> = FA.pure(retag())
+
     companion object {
         fun <T, A> pure(a: A): Const<A, T> = Const(a)
 
@@ -18,6 +20,9 @@ fun <A, T> ConstKind<A, T>.value(): A = this.ev().value
         inline fun <reified A> traverse(MA: Monoid<A> = kategory.monoid<A>()): Traverse<ConstKindPartial<A>> =
                 ConstTraverseInstanceImplicits.instance()
 
+        inline fun <reified A> traverseFilter(MA: Monoid<A> = kategory.monoid<A>()): TraverseFilter<ConstKindPartial<A>> =
+                ConstTraverseFilterInstanceImplicits.instance()
+
         inline fun <reified A, T> semigroup(SA: Semigroup<A> = kategory.semigroup<A>()): Semigroup<ConstKind<A, T>> =
                 ConstSemigroupInstanceImplicits.instance(SA)
 

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

@@ -13,6 +13,7 @@ package kategory
         Monad::class,
         Foldable::class,
         Traverse::class,
+        TraverseFilter::class,
         MonadFilter::class)
 sealed class Option<out A> : OptionKind<A> {
 
@@ -124,6 +125,14 @@ sealed class Option<out A> : OptionKind<A> {
                 }
             }
 
+    fun <G, B> traverseFilter(f: (A) -> HK<G, Option<B>>, GA: Applicative<G>): HK<G, Option<B>> =
+            this.ev().let { option ->
+                when (option) {
+                    is Option.Some -> f(option.value)
+                    is Option.None -> GA.pure(Option.None)
+                }
+            }
+
     /**
      * Returns this $option if it is nonempty '''and''' applying the predicate $p to
      * this $option's value returns true. Otherwise, return $none.

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

@@ -44,6 +44,9 @@ package kategory
         inline fun <reified F> foldable(FFF: Foldable<F> = kategory.foldable<F>()): OptionTFoldableInstance<F> =
                 OptionTFoldableInstanceImplicits.instance(FFF)
 
+        inline fun <reified F> traverseFilter(TF: TraverseFilter<F> = kategory.traverseFilter<F>()): OptionTTraverseFilterInstance<F> =
+                OptionTTraverseFilterInstanceImplicits.instance(TF)
+
         inline fun <reified F> traverse(TF: Traverse<F> = kategory.traverse<F>()): OptionTTraverseInstance<F> =
                 OptionTTraverseInstanceImplicits.instance(TF)
 
@@ -62,7 +65,7 @@ package kategory
 
     inline fun <B> cata(crossinline default: () -> B, crossinline f: (A) -> B, FF: Functor<F>): HK<F, B> = fold(default, f, FF)
 
-    fun <B> ap(ff: OptionTKind<F, (A) -> B>, MF: Monad<F>): OptionT<F, B> = ff.ev().flatMap ({ f -> map(f, MF) }, MF)
+    fun <B> ap(ff: OptionTKind<F, (A) -> B>, MF: Monad<F>): OptionT<F, B> = ff.ev().flatMap({ f -> map(f, MF) }, MF)
 
     inline fun <B> flatMap(crossinline f: (A) -> OptionT<F, B>, MF: Monad<F>): OptionT<F, B> = flatMapF({ it -> f(it).value }, MF)
 
@@ -105,6 +108,11 @@ package kategory
 
     fun <B> foldR(lb: Eval<B>, f: (A, Eval<B>) -> Eval<B>, FF: Foldable<F>): Eval<B> = FF.compose(Option.foldable()).foldRC(value, lb, f)
 
+    fun <G, B> traverseFilter(f: (A) -> HK<G, Option<B>>, GA: Applicative<G>, FF: Traverse<F>): HK<G, OptionT<F, B>> {
+        val fa = ComposedTraverseFilter(FF, Option.traverseFilter(), Option.applicative()).traverseFilterC(value, f, GA)
+        return GA.map(fa, { OptionT(FF.map(it.unnest(), { it.ev() })) })
+    }
+
     fun <G, B> traverse(f: (A) -> HK<G, B>, GA: Applicative<G>, FF: Traverse<F>): HK<G, OptionT<F, B>> {
         val fa = ComposedTraverse(FF, Option.traverse(), Option.applicative()).traverseC(value, f, GA)
         return GA.map(fa, { OptionT(FF.map(it.unnest(), { it.ev() })) })

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

@@ -55,6 +55,16 @@ object ConstTraverseInstanceImplicits {
     @JvmStatic fun <A> instance(): ConstTraverseInstance<A> = object : ConstTraverseInstance<A> {}
 }
 
+interface ConstTraverseFilterInstance<X> : ConstTraverseInstance<X>, TraverseFilter<ConstKindPartial<X>> {
+
+    override fun <G, A, B> traverseFilter(fa: ConstKind<X, A>, f: (A) -> HK<G, Option<B>>, GA: Applicative<G>): HK<G, ConstKind<X, B>> =
+            fa.ev().traverseFilter(f, GA)
+}
+
+object ConstTraverseFilterInstanceImplicits {
+    @JvmStatic fun <A> instance(): ConstTraverseFilterInstance<A> = object : ConstTraverseFilterInstance<A> {}
+}
+
 interface ConstSemigroup<A, T> : Semigroup<ConstKind<A, T>> {
 
     fun SA(): Semigroup<A>

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

@@ -88,6 +88,28 @@ object OptionTFoldableInstanceImplicits {
     }
 }
 
+interface OptionTTraverseFilterInstance<F> :
+        OptionTTraverseInstance<F>,
+        TraverseFilter<OptionTKindPartial<F>> {
+
+    fun TFF(): TraverseFilter<F>
+
+    override fun <G, A, B> traverseFilter(fa: OptionTKind<F, A>, f: (A) -> HK<G, Option<B>>, GA: Applicative<G>): HK<G, OptionT<F, B>> =
+            fa.ev().traverseFilter(f, GA, TF())
+
+}
+
+object OptionTTraverseFilterInstanceImplicits {
+    @JvmStatic
+    fun <F> instance(TF: TraverseFilter<F>): OptionTTraverseFilterInstance<F> = object : OptionTTraverseFilterInstance<F> {
+        override fun FFF(): Foldable<F> = TF
+
+        override fun TF(): Traverse<F> = TF
+
+        override fun TFF(): TraverseFilter<F> = TF
+    }
+}
+
 interface OptionTTraverseInstance<F> : OptionTFoldableInstance<F>, Traverse<OptionTKindPartial<F>> {
 
     fun TF(): Traverse<F>

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

@@ -55,6 +55,46 @@ inline fun <F, reified G> Foldable<F>.compose(GT: Foldable<G> = foldable<G>()):
     override fun GF(): Foldable<G> = GT
 }
 
+interface ComposedTraverseFilter<F, G> :
+        TraverseFilter<Nested<F, G>>,
+        ComposedTraverse<F, G> {
+
+    override fun FT(): Traverse<F>
+
+    override fun GT(): TraverseFilter<G>
+
+    override fun GA(): Applicative<G>
+
+    override fun <H, A, B> traverseFilter(fa: HK<Nested<F, G>, A>, f: (A) -> HK<H, Option<B>>, HA: Applicative<H>): HK<H, HK<Nested<F, G>, B>> =
+            HA.map(FT().traverse(fa.unnest(), { ga -> GT().traverseFilter(ga, f, HA) }, HA), { it.nest() })
+
+    fun <H, A, B> traverseFilterC(fa: HK<F, HK<G, A>>, f: (A) -> HK<H, Option<B>>, HA: Applicative<H>): HK<H, HK<Nested<F, G>, B>> =
+            traverseFilter(fa.nest(), f, HA)
+
+    companion object {
+        operator fun <F, G> invoke(
+                FF: Traverse<F>,
+                GF: TraverseFilter<G>,
+                GA: Applicative<G>): ComposedTraverseFilter<F, G> =
+                object : ComposedTraverseFilter<F, G> {
+                    override fun FT(): Traverse<F> = FF
+
+                    override fun GT(): TraverseFilter<G> = GF
+
+                    override fun GA(): Applicative<G> = GA
+                }
+    }
+}
+
+inline fun <reified F, reified G> TraverseFilter<F>.compose(GT: TraverseFilter<G> = traverseFilter<G>(), GA: Applicative<G> = applicative<G>()):
+        TraverseFilter<Nested<F, G>> = object : ComposedTraverseFilter<F, G> {
+    override fun FT(): Traverse<F> = this@compose
+
+    override fun GT(): TraverseFilter<G> = GT
+
+    override fun GA(): Applicative<G> = GA
+}
+
 interface ComposedTraverse<F, G> :
         Traverse<Nested<F, G>>,
         ComposedFoldable<F, G> {

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

@@ -0,0 +1,26 @@
+package kategory
+
+import kategory.Option.Some
+import kategory.Option.None
+
+interface TraverseFilter<F> : Traverse<F>, FunctorFilter<F>, Typeclass {
+
+    fun <G, A, B> traverseFilter(fa: HK<F, A>, f: (A) -> HK<G, Option<B>>, GA: Applicative<G>): HK<G, HK<F, B>>
+
+    override fun <A, B> mapFilter(fa: HK<F, A>, f: (A) -> Option<B>): HK<F, B> =
+            traverseFilter(fa, { Id(f(it)) }, Id.applicative()).value()
+
+    fun <G, A> filterA(fa: HK<F, A>, f: (A) -> HK<G, Boolean>, GA: Applicative<G>): HK<G, HK<F, A>> =
+            traverseFilter(fa, { a -> GA.map(f(a), { b -> if (b) Some(a) else None }) }, GA)
+
+    override fun <A> filter(fa: HK<F, A>, f: (A) -> Boolean): HK<F, A> =
+            filterA(fa, { Id(f(it)) }, Id.applicative()).value()
+
+}
+
+inline fun <reified F, reified G, A, B> HK<F, A>.traverseFilter(
+        FT: TraverseFilter<F> = traverseFilter<F>(),
+        GA: Applicative<G> = applicative<G>(),
+        noinline f: (A) -> HK<G, Option<B>>): HK<G, HK<F, B>> = FT.traverseFilter(this, f, GA)
+
+inline fun <reified F> traverseFilter(): TraverseFilter<F> = instance(InstanceParametrizedType(TraverseFilter::class.java, listOf(typeLiteral<F>())))

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

@@ -13,27 +13,12 @@ class ConstTest : UnitSpec() {
             applicative<ConstKindPartial<Int>>() shouldNotBe null
             foldable<ConstKindPartial<Int>>() shouldNotBe null
             traverse<ConstKindPartial<Int>>() shouldNotBe null
+            traverseFilter<ConstKindPartial<Int>>() shouldNotBe null
             semigroup<ConstKind<Int, Int>>() shouldNotBe null
             monoid<ConstKind<Int, Int>>() shouldNotBe null
         }
 
-        testLaws(TraverseLaws.laws(Const.traverse(IntMonoid), Const.applicative(IntMonoid), { Const(it) }, Eq.any()))
+        testLaws(TraverseFilterLaws.laws(Const.traverseFilter(IntMonoid), Const.applicative(IntMonoid), { Const(it) }, Eq.any()))
         testLaws(ApplicativeLaws.laws(Const.applicative(IntMonoid), Eq.any()))
     }
 }
-
-fun <A> List<A>?.isNotEmpty(): Boolean =
-        this != null && this.size > 0
-
-object test {
-    val x : List<Int>? = null
-    val xIsNotEmpty: Boolean = x.isNotEmpty()
-    //false
-    val y : List<Int>? = emptyList<Int>()
-    val yIsNotEmpty: Boolean = y.isNotEmpty()
-    //false
-    val z : List<Int>? = listOf(1)
-    val zIsNotEmpty: Boolean = y.isNotEmpty()
-    //true
-}
-

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

@@ -1,13 +1,18 @@
 package kategory
 
 import io.kotlintest.KTestJUnitRunner
-import io.kotlintest.matchers.shouldNotBe
 import io.kotlintest.properties.forAll
+import io.kotlintest.matchers.shouldNotBe
 import org.junit.runner.RunWith
 
 @RunWith(KTestJUnitRunner::class)
 class OptionTTest : UnitSpec() {
-    val EQ_ID: Eq<HK<OptionTKindPartial<IdHK>, Int>> = Eq { a, b ->
+
+    fun <A> EQ(): Eq<HK<OptionTKindPartial<A>, Int>> = Eq { a, b ->
+        a.value() == b.value()
+    }
+
+    fun <A> EQ_NESTED(): Eq<HK<OptionTKindPartial<A>, HK<OptionTKindPartial<A>, Int>>> = Eq { a, b ->
         a.value() == b.value()
     }
 
@@ -24,24 +29,31 @@ class OptionTTest : UnitSpec() {
             semigroupK<OptionTKindPartial<ListKWHK>>() shouldNotBe null
             monoidK<OptionTKindPartial<ListKWHK>>() shouldNotBe null
             functorFilter<OptionTKindPartial<ListKWHK>>() shouldNotBe null
+            traverseFilter<OptionTKindPartial<OptionHK>>() shouldNotBe null
         }
 
         testLaws(MonadLaws.laws(OptionT.monad(NonEmptyList.monad()), Eq.any()))
-        testLaws(TraverseLaws.laws(OptionT.traverse(), OptionT.applicative(Id.monad()), { OptionT(Id(it.some())) }, Eq.any()))
         testLaws(SemigroupKLaws.laws(
                 OptionT.semigroupK(Id.monad()),
                 OptionT.applicative(Id.monad()),
-                EQ_ID))
+                EQ()))
 
         testLaws(MonoidKLaws.laws(
                 OptionT.monoidK(Id.monad()),
                 OptionT.applicative(Id.monad()),
-                EQ_ID))
+                EQ()))
 
         testLaws(FunctorFilterLaws.laws(
                 OptionT.functorFilter(),
                 { OptionT(Id(it.some())) },
-                EQ_ID))
+                EQ()))
+
+        testLaws(TraverseFilterLaws.laws(
+                OptionT.traverseFilter(),
+                OptionT.applicative(Option.monad()),
+                { OptionT(Option(it.some())) },
+                EQ(),
+                EQ_NESTED()))
 
         "toLeft for Some should build a correct EitherT" {
             forAll { a: Int, b: String ->

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

@@ -19,6 +19,7 @@ class OptionTest : UnitSpec() {
             monad<OptionHK>() shouldNotBe null
             foldable<OptionHK>() shouldNotBe null
             traverse<OptionHK>() shouldNotBe null
+            traverseFilter<OptionHK>() shouldNotBe null
             semigroup<Option<Int>>() shouldNotBe null
             monoid<Option<Int>>() shouldNotBe null
             monadError<OptionHK, Unit>() shouldNotBe null
@@ -39,7 +40,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(TraverseFilterLaws.laws(Option.traverseFilter(), Option.monad(), ::Some, Eq.any()))
         testLaws(MonadFilterLaws.laws(Option.monadFilter(), ::Some, Eq.any()))
 
         "fromNullable should work for both null and non-null values of nullable types" {

kategory-test/src/main/kotlin/kategory/laws/TraverseFilterLaws.kt

@@ -0,0 +1,26 @@
+package kategory
+
+import io.kotlintest.properties.Gen
+import io.kotlintest.properties.forAll
+import kategory.Option.Some
+import kategory.Option.None
+
+object TraverseFilterLaws {
+
+    //FIXME(paco): TraverseLaws cannot receive AP::pure due to a crash caused by the inliner. Check in TraverseLaws why.
+    inline fun <reified F> laws(TF: TraverseFilter<F> = traverseFilter<F>(), GA: Applicative<F> = applicative<F>(), crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<HK<F, Int>>, EQ_NESTED: Eq<HK<F, HK<F, Int>>> = Eq.any()): List<Law> =
+            TraverseLaws.laws(TF, GA, cf, EQ) + listOf(
+                    Law("TraverseFilter Laws: Identity", { identityTraverseFilter(TF, GA, EQ_NESTED) }),
+                    Law("TraverseFilter Laws: filterA consistent with TraverseFilter", { filterAconsistentWithTraverseFilter(TF, GA, EQ_NESTED) })
+            )
+
+    inline fun <reified F> identityTraverseFilter(FT: TraverseFilter<F>, GA: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, HK<F, Int>>> = Eq.any()) =
+            forAll(genApplicative(genIntSmall(), GA), { fa: HK<F, Int> ->
+                FT.traverseFilter(fa, { it.some().pure(GA) }, GA).equalUnderTheLaw(GA.pure(fa), EQ)
+            })
+
+    inline fun <reified F> filterAconsistentWithTraverseFilter(FT: TraverseFilter<F>, GA: Applicative<F> = applicative<F>(), EQ: Eq<HK<F, HK<F, Int>>> = Eq.any()) =
+            forAll(genApplicative(genIntSmall(), GA), genFunctionAToB(genApplicative(Gen.bool(), GA)), { fa: HK<F, Int>, f: (Int) -> HK<F, Boolean> ->
+                FT.filterA(fa, f, GA).equalUnderTheLaw(fa.traverseFilter(FT, GA) { a -> f(a).map(FT) { b: Boolean -> if (b) Some(a) else None } }, EQ)
+            })
+}