Reducible

detekt.yml

@@ -106,4 +106,4 @@ comments:
   UndocumentedPublicClass:
     active: false
   UndocumentedPublicFunction:
-    active: false
+    active: false

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

@@ -16,6 +16,14 @@ fun <A, B> genFunctionAToB(genB: Gen<B>): Gen<(A) -> B> =
             }
         }
 
+fun <A> genFunctionAAToA(genA: Gen<A>): Gen<(A, A) -> A> =
+        object : Gen<(A, A) -> A> {
+            override fun generate(): (A, A) -> A {
+                val v = genA.generate()
+                return { _, _ -> v }
+            }
+        }
+
 fun genThrowable(): Gen<Throwable> = object : Gen<Throwable> {
     override fun generate(): Throwable =
             Gen.oneOf(listOf(RuntimeException(), NoSuchElementException(), IllegalArgumentException())).generate()
@@ -30,7 +38,7 @@ inline fun <F, A> genConstructor(valueGen: Gen<A>, crossinline cf: (A) -> HK<F,
 fun genIntSmall(): Gen<Int> =
         Gen.oneOf(Gen.negativeIntegers(), Gen.choose(0, Int.MAX_VALUE / 10000))
 
-fun <A, B> genTuple(genA : Gen<A>, genB: Gen<B>): Gen<Tuple2<A, B>> =
+fun <A, B> genTuple(genA: Gen<A>, genB: Gen<B>): Gen<Tuple2<A, B>> =
         object : Gen<Tuple2<A, B>> {
             override fun generate(): Tuple2<A, B> = Tuple2(genA.generate(), genB.generate())
         }

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

@@ -0,0 +1,48 @@
+package kategory.laws
+
+import io.kotlintest.properties.forAll
+import kategory.*
+
+object ReducibleLaws {
+    inline fun <reified F> laws(RF: Reducible<F> = reducible(), crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<Int>, EQOptionInt: Eq<Option<Int>>, EQLong: Eq<Long>): List<Law> =
+            FoldableLaws.laws(RF, cf, EQ) + listOf(
+                    Law("Reducible Laws: reduceLeftTo consistent with reduceMap", { reduceLeftToConsistentWithReduceMap(RF, cf, EQ) }),
+                    Law("Reducible Laws: reduceRightTo consistent with reduceMap", { reduceRightToConsistentWithReduceMap(RF, cf, EQ) }),
+                    Law("Reducible Laws: reduceRightTo consistent with reduceRightToOption", { reduceRightToConsistentWithReduceRightToOption(RF, cf, EQOptionInt) }),
+                    Law("Reducible Laws: reduceRight consistent with reduceRightOption", { reduceRightConsistentWithReduceRightOption(RF, cf, EQOptionInt) }),
+                    Law("Reducible Laws: reduce reduce left consistent", { reduceReduceLeftConsistent(RF, cf, EQ) }),
+                    Law("Reducible Laws: size consistent", { sizeConsistent(RF, cf, EQLong) })
+            )
+
+    inline fun <reified F> reduceLeftToConsistentWithReduceMap(RF: Reducible<F>, crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<Int>) =
+            forAll(genFunctionAToB<Int, Int>(genIntSmall()), genConstructor(genIntSmall(), cf), { f: (Int) -> Int, fa: HK<F, Int> ->
+                RF.reduceMap(fa, f, IntMonoid).equalUnderTheLaw(RF.reduceLeftTo(fa, f, { b, a -> IntMonoid.combine(b, f(a)) }), EQ)
+            })
+
+    inline fun <reified F> reduceRightToConsistentWithReduceMap(RF: Reducible<F>, crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<Int>) =
+            forAll(genFunctionAToB<Int, Int>(genIntSmall()), genConstructor(genIntSmall(), cf), { f: (Int) -> Int, fa: HK<F, Int> ->
+                RF.reduceMap(fa, f, IntMonoid).equalUnderTheLaw(RF.reduceRightTo(fa, f, { a, eb -> eb.map({ IntMonoid.combine(f(a), it) }) }).value(), EQ)
+            })
+
+    inline fun <reified F> reduceRightToConsistentWithReduceRightToOption(RF: Reducible<F>, crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<Option<Int>>) =
+            forAll(genFunctionAToB<Int, Int>(genIntSmall()), genConstructor(genIntSmall(), cf), { f: (Int) -> Int, fa: HK<F, Int> ->
+                RF.reduceRightToOption(fa, f, { a, eb -> eb.map({ IntMonoid.combine(f(a), it) }) }).value()
+                        .equalUnderTheLaw(RF.reduceRightTo(fa, f, { a, eb -> eb.map({ IntMonoid.combine(f(a), it) }) }).map({ Option(it) }).value(), EQ)
+            })
+
+    inline fun <reified F> reduceRightConsistentWithReduceRightOption(RF: Reducible<F>, crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<Option<Int>>) =
+            forAll(genFunctionAAToA(genIntSmall()), genConstructor(genIntSmall(), cf), { f: (Int, Int) -> Int, fa: HK<F, Int> ->
+                RF.reduceRight(fa, { a1, e2 -> Eval.Now(f(a1, e2.value())) }).map({ Option(it) }).value()
+                        .equalUnderTheLaw(RF.reduceRightOption(fa, { a1, e2 -> Eval.Now(f(a1, e2.value())) }).value(), EQ)
+            })
+
+    inline fun <reified F> reduceReduceLeftConsistent(RF: Reducible<F>, crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<Int>) =
+            forAll(genConstructor(genIntSmall(), cf), { fa: HK<F, Int> ->
+                RF.reduce(fa, IntMonoid).equalUnderTheLaw(RF.reduceLeft(fa, { a1, a2 -> IntMonoid.combine(a1, a2) }), EQ)
+            })
+
+    inline fun <reified F> sizeConsistent(RF: Reducible<F>, crossinline cf: (Int) -> HK<F, Int>, EQ: Eq<Long>) =
+            forAll(genConstructor(genIntSmall(), cf), { fa: HK<F, Int> ->
+                RF.size(LongMonoid, fa).equalUnderTheLaw(RF.reduceMap(fa, { 1L }, LongMonoid), EQ)
+            })
+}

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

@@ -41,6 +41,23 @@ data class ComposedTraverse<F, G>(val FT: Traverse<F>, val GT: Traverse<G>, val
 
 inline fun <F, reified G> Traverse<F>.compose(GT: Traverse<G> = traverse<G>(), GA: Applicative<G> = applicative<G>()): Traverse<ComposedType<F, G>> = ComposedTraverse(this, GT, GA)
 
+data class ComposedReducible<F, G>(val RF: Reducible<F>, val RG: Reducible<G>, val FT: Traverse<F>, val GT: Traverse<G>, val CF: ComposedFoldable<F, G> = ComposedFoldable(FT, GT))
+    : Reducible<ComposedType<F, G>>, Foldable<ComposedType<F, G>> by CF {
+
+    override fun <A, B> reduceLeftTo(fa: HK<ComposedType<F, G>, A>, f: (A) -> B, g: (B, A) -> B): B =
+            RF.reduceLeftTo(fa.lower(), { ga: HK<G, A> -> RG.reduceLeftTo(ga, f, g) }) { b, ga ->
+                RG.foldL(ga, b, g)
+            }
+
+    override fun <A, B> reduceRightTo(fa: HK<ComposedType<F, G>, A>, f: (A) -> B, g: (A, Eval<B>) -> Eval<B>): Eval<B> =
+            RF.reduceRightTo(fa.lower(), { ga: HK<G, A> -> RG.reduceRightTo(ga, f, g).value() }) { ga, lb ->
+                RG.foldR(ga, lb, g)
+            }
+}
+
+inline fun <reified F, reified G> Reducible<F>.compose(RG: Reducible<G> = reducible<G>(), FT: Traverse<F> = traverse<F>(), GT: Traverse<G> = traverse<G>(), GA: Applicative<G> = applicative<G>())
+        : Reducible<ComposedType<F, G>> = ComposedReducible(this, RG, FT, GT)
+
 interface ComposedSemigroupK<F, G> : SemigroupK<ComposedType<F, G>> {
 
     fun F(): SemigroupK<F>
@@ -115,4 +132,4 @@ interface ComposedApplicative<F, G> : Applicative<ComposedType<F, G>>, ComposedF
     }
 }
 
-inline fun <reified F, reified G> Applicative<F>.compose(GA: Applicative<G> = applicative<G>()): Applicative<ComposedType<F, G>> = ComposedApplicative(this, GA)
+inline fun <reified F, reified G> Applicative<F>.compose(GA: Applicative<G> = applicative<G>()): Applicative<ComposedType<F, G>> = ComposedApplicative(this, GA)

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

@@ -20,6 +20,8 @@ package kategory
 
         fun traverse(): Traverse<ListKWHK> = this
 
+        fun foldable(): Foldable<ListKWHK> = this
+
     }
 
 }

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

@@ -13,6 +13,8 @@ package kategory
 
         operator fun <A> invoke(a: A): Option<A> = Option.Some(a)
 
+        fun <A> empty() : Option<A> = None
+
         fun functor(): Functor<OptionHK> = this
 
         fun applicative(): Applicative<OptionHK> = this
@@ -147,4 +149,4 @@ fun <A, B : A> Option<B>.orElse(alternative: () -> Option<B>): Option<B> = if (i
 
 fun <A> A.some(): Option<A> = Option.Some(this)
 
-fun <A> none(): Option<A> = Option.None
+fun <A> none(): Option<A> = Option.None

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

@@ -4,7 +4,8 @@ interface ListKWInstances :
         Functor<ListKWHK>,
         Applicative<ListKWHK>,
         Monad<ListKWHK>,
-        Traverse<ListKWHK> {
+        Traverse<ListKWHK>,
+        Foldable<ListKWHK> {
 
     override fun <A> pure(a: A): ListKW<A> = listOf(a).k()
 
@@ -13,11 +14,11 @@ interface ListKWInstances :
     override fun <A, B> map(fa: HK<ListKWHK, A>, f: (A) -> B): ListKW<B> = fa.ev().map(f).k()
 
     override fun <A, B, Z> map2(fa: HK<ListKWHK, A>, fb: HK<ListKWHK, B>, f: (Tuple2<A, B>) -> Z): ListKW<Z> =
-        fa.ev().flatMap { a ->
-            fb.ev().map { b ->
-                f(Tuple2(a, b))
-            }
-        }.ev()
+            fa.ev().flatMap { a ->
+                fb.ev().map { b ->
+                    f(Tuple2(a, b))
+                }
+            }.ev()
 
     override fun <A, B> foldL(fa: HK<ListKWHK, A>, b: B, f: (B, A) -> B): B = fa.ev().fold(b, f)
 
@@ -68,4 +69,4 @@ interface ListKWMonoidK : MonoidK<ListKWHK> {
     override fun <A> combineK(x: HK<ListKWHK, A>, y: HK<ListKWHK, A>): ListKW<A> = (x.ev() + y.ev()).k()
 
     override fun <A> empty(): ListKW<A> = emptyList<A>().k()
-}
+}

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

@@ -18,6 +18,6 @@ interface Eq<in F> : Typeclass {
 
 inline fun <reified F> eq(): Eq<F> = instance(InstanceParametrizedType(Eq::class.java, listOf(F::class.java)))
 
-inline fun <reified F> F.eqv(EQ: Eq<F> = eq(), b: F) : Boolean = EQ.eqv(this, b)
+inline fun <reified F> F.eqv(EQ: Eq<F> = eq(), b: F): Boolean = EQ.eqv(this, b)
 
-inline fun <reified F> F.neqv(EQ: Eq<F> = eq(), b: F) : Boolean = EQ.neqv(this, b)
+inline fun <reified F> F.neqv(EQ: Eq<F> = eq(), b: F): Boolean = EQ.neqv(this, b)

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

@@ -35,6 +35,42 @@ interface Foldable<in F> : Typeclass {
      */
     fun <A> fold(ma: Monoid<A>, fa: HK<F, A>): A = foldL(fa, ma.empty(), { acc, a -> ma.combine(acc, a) })
 
+    fun <A, B> reduceLeftToOption(fa: HK<F, A>, f: (A) -> B, g: (B, A) -> B): Option<B> =
+            foldL(fa, Option.empty()) { option, a ->
+                when (option) {
+                    is Option.Some<B> -> Option.Some(g(option.value, a))
+                    is Option.None -> Option.Some(f(a))
+                }
+            }
+
+    fun <A, B> reduceRightToOption(fa: HK<F, A>, f: (A) -> B, g: (A, Eval<B>) -> Eval<B>): Eval<Option<B>> =
+            foldR(fa, Eval.Now(Option.empty())) { a, lb ->
+                lb.flatMap { option ->
+                    when (option) {
+                        is Option.Some<B> -> g(a, Eval.Now(option.value)).map({ Option.Some(it) })
+                        is Option.None -> Eval.Later({ Option.Some(f(a)) })
+                    }
+                }
+            }
+
+    /**
+     * Reduce the elements of this structure down to a single value by applying the provided aggregation function in
+     * a left-associative manner.
+     *
+     * @return None if the structure is empty, otherwise the result of combining the cumulative left-associative result
+     * of the f operation over all of the elements.
+     */
+    fun <A> reduceLeftOption(fa: HK<F, A>, f: (A, A) -> A): Option<A> = reduceLeftToOption(fa, { a -> a }, f)
+
+    /**
+     * Reduce the elements of this structure down to a single value by applying the provided aggregation function in
+     * a right-associative manner.
+     *
+     * @return None if the structure is empty, otherwise the result of combining the cumulative right-associative
+     * result of the f operation over the A elements.
+     */
+    fun <A> reduceRightOption(fa: HK<F, A>, f: (A, Eval<A>) -> Eval<A>): Eval<Option<A>> = reduceRightToOption(fa, { a -> a }, f)
+
     /**
      * Alias for fold.
      */
@@ -92,8 +128,7 @@ interface Foldable<in F> : Typeclass {
     fun <A> nonEmpty(fa: HK<F, A>): Boolean = !isEmpty(fa)
 
     companion object {
-        fun <A, B> iterateRight(it: Iterator<A>, lb: Eval<B>): (f: (A, Eval<B>) -> Eval<B>) -> Eval<B> = {
-            f: (A, Eval<B>) -> Eval<B> ->
+        fun <A, B> iterateRight(it: Iterator<A>, lb: Eval<B>): (f: (A, Eval<B>) -> Eval<B>) -> Eval<B> = { f: (A, Eval<B>) -> Eval<B> ->
             fun loop(): Eval<B> =
                     Eval.defer { if (it.hasNext()) f(it.next(), loop()) else lb }
             loop()
@@ -108,6 +143,23 @@ interface Foldable<in F> : Typeclass {
  */
 inline fun <F, reified G, A, reified B> Foldable<F>.foldMapM(fa: HK<F, A>, noinline f: (A) -> HK<G, B>, MG: Monad<G> = monad(), bb: Monoid<B> = monoid()): HK<G, B> = foldM(fa, bb.empty(), { b, a -> MG.map(f(a)) { bb.combine(b, it) } }, MG)
 
+/**
+ * Get the element at the index of the Foldable.
+ */
+inline fun <F, A> Foldable<F>.get(fa: HK<F, A>, idx: Long): Option<A> {
+    if (idx < 0L) return Option.None
+    else {
+        foldM(fa, 0L, { i, a ->
+            if (i == idx) Either.Left(a) else Either.Right(i + 1L)
+        }).let {
+            return when (it) {
+                is Either.Left -> Option.Some(it.a)
+                else -> Option.None
+            }
+        }
+    }
+}
+
 /**
  * Left associative monadic folding on F.
  *
@@ -119,6 +171,16 @@ inline fun <F, reified G, A, B> Foldable<F>.foldM(fa: HK<F, A>, z: B, crossinlin
 
 inline fun <reified F> foldable(): Foldable<F> = instance(InstanceParametrizedType(Foldable::class.java, listOf(F::class.java)))
 
+/**
+ * The size of this Foldable.
+ *
+ * This is overriden in structures that have more efficient size implementations
+ * (e.g. Vector, Set, Map).
+ *
+ * Note: will not terminate for infinite-sized collections.
+ */
+inline fun <reified F, A> Foldable<F>.size(MB: Monoid<Long> = monoid(), fa: HK<F, A>): Long = foldMap(MB, fa, { 1 })
+
 inline fun <reified F, A, B> HK<F, A>.foldL(FT: Foldable<F> = foldable(), b: B, noinline f: (B, A) -> B): B = FT.foldL(this, b, f)
 
 inline fun <reified F, A, B> HK<F, A>.foldR(FT: Foldable<F> = foldable(), b: Eval<B>, noinline f: (A, Eval<B>) -> Eval<B>): Eval<B> = FT.foldR(this, b, f)