Add Semigroupal type class

modules/core/arrow-core-data/src/test/kotlin/arrow/core/OptionTest.kt

@@ -1,13 +1,16 @@
 package arrow.core
 
+import arrow.Kind
 import arrow.core.extensions.eq
 import arrow.core.extensions.hash
 import arrow.core.extensions.monoid
 import arrow.core.extensions.option.applicative.applicative
 import arrow.core.extensions.option.eq.eq
 import arrow.core.extensions.option.hash.hash
 import arrow.core.extensions.option.monoid.monoid
+import arrow.core.extensions.option.semigroupal.semigroupal
 import arrow.core.extensions.option.show.show
+import arrow.core.extensions.tuple2.eq.eq
 import arrow.mtl.extensions.option.monadFilter.monadFilter
 import arrow.mtl.extensions.option.traverseFilter.traverseFilter
 import arrow.syntax.collections.firstOption
@@ -28,6 +31,14 @@ class OptionTest : UnitSpec() {
   val some: Option<String> = Some("kotlin")
   val none: Option<String> = Option.empty()
 
+  val associativeSemigroupalEq = object : Eq<Kind<ForOption, Tuple2<Int, Tuple2<Int, Int>>>> {
+    override fun Kind<ForOption, Tuple2<Int, Tuple2<Int, Int>>>.eqv(b: Kind<ForOption, Tuple2<Int, Tuple2<Int, Int>>>): Boolean {
+        return Option.eq(Tuple2.eq(Int.eq(), Tuple2.eq(Int.eq(), Int.eq()))).run {
+          this@eqv.fix().eqv(b.fix())
+        }
+      }
+  }
+
   init {
 
     testLaws(
@@ -37,7 +48,8 @@ class OptionTest : UnitSpec() {
       FunctorFilterLaws.laws(Option.traverseFilter(), { Option(it) }, Eq.any()),
       TraverseFilterLaws.laws(Option.traverseFilter(), Option.applicative(), ::Some, Eq.any()),
       MonadFilterLaws.laws(Option.monadFilter(), ::Some, Eq.any()),
-      HashLaws.laws(Option.hash(Int.hash()), Option.eq(Int.eq())) { it.some() }
+      HashLaws.laws(Option.hash(Int.hash()), Option.eq(Int.eq())) { it.some() },
+      SemigroupalLaws.laws(Option.semigroupal(), ::Some, ::bijection, associativeSemigroupalEq)
     )
 
     "fromNullable should work for both null and non-null values of nullable types" {
@@ -139,4 +151,9 @@ class OptionTest : UnitSpec() {
 
   }
 
+  private fun bijection(from: Kind<ForOption, Tuple2<Tuple2<Int, Int>, Int>>): Option<Tuple2<Int, Tuple2<Int, Int>>> {
+    val ot = (from as Some<Tuple2<Tuple2<Int, Int>, Int>>)
+    return Tuple2(ot.t.a.a, Tuple2(ot.t.a.b, ot.t.b)).toOption()
+  }
+
 }

modules/core/arrow-core-extensions/src/main/kotlin/arrow/core/extensions/option.kt

@@ -3,8 +3,8 @@ package arrow.core.extensions
 
 import arrow.Kind
 import arrow.core.*
+import arrow.core.extensions.option.monad.map
 import arrow.core.extensions.option.monad.monad
-import arrow.core.extensions.option.monadError.monadError
 import arrow.extension
 import arrow.typeclasses.*
 import arrow.typeclasses.suspended.monad.Fx
@@ -25,6 +25,12 @@ interface OptionSemigroup<A> : Semigroup<Option<A>> {
     }
 }
 
+@extension
+interface OptionSemigroupal : Semigroupal<ForOption> {
+  override fun <A, B> Kind<ForOption, A>.product(fb: Kind<ForOption, B>): Kind<ForOption, Tuple2<A, B>> =
+    fb.fix().ap(this.map { a:A -> { b: B -> Tuple2(a,b)} })
+}
+
 @extension
 interface OptionMonoid<A> : Monoid<Option<A>>, OptionSemigroup<A> {
   override fun SG(): Semigroup<A>

modules/core/arrow-extras-extensions/src/main/kotlin/arrow/data/extensions/listk.kt

@@ -6,6 +6,7 @@ import arrow.core.Eval
 import arrow.core.Tuple2
 import arrow.data.*
 import arrow.data.extensions.listk.foldable.foldLeft
+import arrow.data.extensions.listk.monad.map
 import arrow.data.extensions.listk.monad.monad
 import arrow.extension
 import arrow.typeclasses.*
@@ -125,6 +126,12 @@ interface ListKSemigroupK : SemigroupK<ForListK> {
     fix().listCombineK(y)
 }
 
+@extension
+interface ListKSemigroupal : Semigroupal<ForListK> {
+  override fun <A, B> Kind<ForListK, A>.product(fb: Kind<ForListK, B>): Kind<ForListK, Tuple2<A, B>> =
+    fb.fix().ap(this.map { a:A -> { b: B -> Tuple2(a,b)} })
+}
+
 @extension
 interface ListKMonoidK : MonoidK<ForListK> {
   override fun <A> empty(): ListK<A> =

modules/core/arrow-extras-extensions/src/main/kotlin/arrow/data/extensions/sequence.kt

@@ -5,7 +5,7 @@ import arrow.core.Either
 import arrow.core.Eval
 import arrow.core.Tuple2
 import arrow.data.*
-import arrow.data.extensions.optiont.monad.monad
+import arrow.data.extensions.sequencek.monad.map
 import arrow.data.extensions.sequencek.monad.monad
 import arrow.extension
 import arrow.typeclasses.*
@@ -17,6 +17,12 @@ interface SequenceKSemigroup<A> : Semigroup<SequenceK<A>> {
   override fun SequenceK<A>.combine(b: SequenceK<A>): SequenceK<A> = (this.sequence + b.sequence).k()
 }
 
+@extension
+interface SequenceKSemigroupal : Semigroupal<ForSequenceK> {
+  override fun <A, B> Kind<ForSequenceK, A>.product(fb: Kind<ForSequenceK, B>): Kind<ForSequenceK, Tuple2<A, B>> =
+    fb.fix().ap(this.map { a: A -> { b: B -> Tuple2(a, b)} })
+}
+
 @extension
 interface SequenceKMonoid<A> : Monoid<SequenceK<A>> {
   override fun SequenceK<A>.combine(b: SequenceK<A>): SequenceK<A> = (this.sequence + b.sequence).k()

modules/core/arrow-extras-extensions/src/main/kotlin/arrow/data/extensions/setk.kt

@@ -2,6 +2,7 @@ package arrow.data.extensions
 
 import arrow.Kind
 import arrow.core.Eval
+import arrow.core.Tuple2
 import arrow.data.*
 
 import arrow.extension
@@ -59,6 +60,12 @@ interface SetKSemigroupK : SemigroupK<ForSetK> {
     fix().setCombineK(y)
 }
 
+@extension
+interface SetKSemigroupal: Semigroupal<ForSetK> {
+  override fun <A, B> Kind<ForSetK, A>.product(fb: Kind<ForSetK, B>): Kind<ForSetK, Tuple2<A, B>> =
+    fb.fix().flatMap { b -> this.fix().map { a -> Tuple2(a,b) } }.toSet().k()
+}
+
 @extension
 interface SetKMonoidK : MonoidK<ForSetK> {
   override fun <A> empty(): SetK<A> =

modules/core/arrow-extras/src/test/kotlin/arrow/data/ListKTest.kt

@@ -1,15 +1,17 @@
 package arrow.data
 
+import arrow.Kind
+import arrow.core.*
 import arrow.core.extensions.eq
 import arrow.core.extensions.hash
-import arrow.core.identity
-import arrow.core.toT
+import arrow.core.extensions.tuple2.eq.eq
 import arrow.data.extensions.list.fx.fx
 import arrow.data.extensions.listk.applicative.applicative
 import arrow.data.extensions.listk.eq.eq
 import arrow.data.extensions.listk.hash.hash
 import arrow.data.extensions.listk.monoidK.monoidK
 import arrow.data.extensions.listk.semigroupK.semigroupK
+import arrow.data.extensions.listk.semigroupal.semigroupal
 import arrow.data.extensions.listk.show.show
 import arrow.data.extensions.listk.traverse.traverse
 import arrow.mtl.extensions.listk.monadCombine.monadCombine
@@ -26,17 +28,19 @@ class ListKTest : UnitSpec() {
 
   init {
 
-    val EQ: Eq<ListKOf<Int>> = ListK.eq(Eq.any())
+    val eq: Eq<ListKOf<Int>> = ListK.eq(Eq.any())
+    val associativeSemigroupalEq: Eq<ListKOf<Tuple2<Int, Tuple2<Int, Int>>>> = ListK.eq(Tuple2.eq(Int.eq(), Tuple2.eq(Int.eq(), Int.eq())))
 
     testLaws(
-      ShowLaws.laws(ListK.show(), EQ) { listOf(it).k() },
+      ShowLaws.laws(ListK.show(), eq) { listOf(it).k() },
       SemigroupKLaws.laws(ListK.semigroupK(), applicative, Eq.any()),
+      SemigroupalLaws.laws(ListK.semigroupal(), { ListK.just(it) }, this::bijection, associativeSemigroupalEq),
       MonoidKLaws.laws(ListK.monoidK(), applicative, Eq.any()),
       TraverseLaws.laws(ListK.traverse(), applicative, { n: Int -> ListK(listOf(n)) }, Eq.any()),
       MonadCombineLaws.laws(ListK.monadCombine(),
         { n -> ListK(listOf(n)) },
         { n -> ListK(listOf({ s: Int -> n * s })) },
-        EQ),
+        eq),
       HashLaws.laws(ListK.hash(Int.hash()), ListK.eq(Int.eq())) { listOf(it).k() }
     )
 
@@ -45,4 +49,8 @@ class ListKTest : UnitSpec() {
     }
 
   }
+
+  private fun bijection(from: Kind<ForListK, Tuple2<Tuple2<Int, Int>, Int>>): ListK<Tuple2<Int, Tuple2<Int, Int>>> =
+          from.fix().map { Tuple2(it.a.a, Tuple2(it.a.b, it.b)) }.k()
+
 }

modules/core/arrow-extras/src/test/kotlin/arrow/data/SequenceKTest.kt

@@ -1,6 +1,7 @@
 package arrow.data
 
 import arrow.Kind
+import arrow.core.Tuple2
 import arrow.core.extensions.eq
 import arrow.core.extensions.hash
 import arrow.data.extensions.sequencek.applicative.applicative
@@ -9,6 +10,7 @@ import arrow.data.extensions.sequencek.hash.hash
 import arrow.data.extensions.sequencek.monad.monad
 import arrow.data.extensions.sequencek.monoid.monoid
 import arrow.data.extensions.sequencek.monoidK.monoidK
+import arrow.data.extensions.sequencek.semigroupal.semigroupal
 import arrow.data.extensions.sequencek.traverse.traverse
 import arrow.test.UnitSpec
 import arrow.test.generators.sequenceK
@@ -29,6 +31,11 @@ class SequenceKTest : UnitSpec() {
         toList() == b.toList()
     }
 
+    val associativeSemigroupalEq: Eq<Kind<ForSequenceK, Tuple2<Int, Tuple2<Int, Int>>>> = object : Eq<Kind<ForSequenceK, Tuple2<Int, Tuple2<Int, Int>>>> {
+      override fun Kind<ForSequenceK, Tuple2<Int, Tuple2<Int, Int>>>.eqv(b: Kind<ForSequenceK, Tuple2<Int, Tuple2<Int, Int>>>): Boolean =
+        this.toList() == b.toList()
+    }
+
     val show: Show<Kind<ForSequenceK, Int>> = object : Show<Kind<ForSequenceK, Int>> {
       override fun Kind<ForSequenceK, Int>.show(): String =
         toList().toString()
@@ -39,8 +46,12 @@ class SequenceKTest : UnitSpec() {
       MonadLaws.laws(SequenceK.monad(), eq),
       MonoidKLaws.laws(SequenceK.monoidK(), SequenceK.applicative(), eq),
       MonoidLaws.laws(SequenceK.monoid(), Gen.sequenceK(Gen.int()), eq),
+      SemigroupalLaws.laws(SequenceK.semigroupal(), { SequenceK.just(it) }, this::bijection, associativeSemigroupalEq),
       TraverseLaws.laws(SequenceK.traverse(), SequenceK.applicative(), { n: Int -> SequenceK(sequenceOf(n)) }, eq),
       HashLaws.laws(SequenceK.hash(Int.hash()), SequenceK.eq(Int.eq())) { sequenceOf(it).k() }
     )
   }
+
+  private fun bijection(from: Kind<ForSequenceK, Tuple2<Tuple2<Int, Int>, Int>>): SequenceK<Tuple2<Int, Tuple2<Int, Int>>> =
+          from.fix().toList().map { Tuple2(it.a.a, Tuple2(it.a.b, it.b)) }.asSequence().k()
 }

modules/core/arrow-extras/src/test/kotlin/arrow/data/SetKTest.kt

@@ -1,12 +1,16 @@
 package arrow.data
 
+import arrow.Kind
+import arrow.core.Tuple2
 import arrow.core.extensions.eq
 import arrow.core.extensions.hash
+import arrow.core.extensions.tuple2.eq.eq
 import arrow.data.extensions.setk.eq.eq
 import arrow.data.extensions.setk.foldable.foldable
 import arrow.data.extensions.setk.hash.hash
 import arrow.data.extensions.setk.monoidK.monoidK
 import arrow.data.extensions.setk.semigroupK.semigroupK
+import arrow.data.extensions.setk.semigroupal.semigroupal
 import arrow.data.extensions.setk.show.show
 import arrow.test.UnitSpec
 import arrow.test.laws.*
@@ -17,16 +21,28 @@ import org.junit.runner.RunWith
 @RunWith(KotlinTestRunner::class)
 class SetKTest : UnitSpec() {
 
+  val associativeSemigroupalEq: Eq<SetKOf<Tuple2<Int, Tuple2<Int, Int>>>> = object : Eq<SetKOf<Tuple2<Int, Tuple2<Int, Int>>>> {
+    override fun SetKOf<Tuple2<Int, Tuple2<Int, Int>>>.eqv(b: SetKOf<Tuple2<Int, Tuple2<Int, Int>>>): Boolean {
+      return SetK.eq(Tuple2.eq(Int.eq(), Tuple2.eq(Int.eq(), Int.eq()))).run {
+        this@eqv.fix().eqv(b.fix())
+      }
+    }
+  }
+
   init {
 
     val EQ = SetK.eq(Int.eq())
 
     testLaws(
       ShowLaws.laws(SetK.show(), EQ) { SetK.just(it) },
       SemigroupKLaws.laws(SetK.semigroupK(), { SetK.just(it) }, Eq.any()),
+      SemigroupalLaws.laws(SetK.semigroupal(), { SetK.just(it) }, this::bijection, associativeSemigroupalEq),
       MonoidKLaws.laws(SetK.monoidK(), { SetK.just(it) }, Eq.any()),
       FoldableLaws.laws(SetK.foldable(), { SetK.just(it) }, Eq.any()),
       HashLaws.laws(SetK.hash(Int.hash()), SetK.eq(Int.eq())) { SetK.just(it) }
     )
   }
+
+  private fun bijection(from: Kind<ForSetK, Tuple2<Tuple2<Int, Int>, Int>>): SetK<Tuple2<Int, Tuple2<Int, Int>>> =
+          from.fix().map { Tuple2(it.a.a, Tuple2(it.a.b, it.b)) }.toSet().k()
 }

modules/core/arrow-test/src/main/kotlin/arrow/test/laws/Law.kt

@@ -5,9 +5,12 @@ import arrow.test.generators.tuple3
 import arrow.test.generators.tuple4
 import arrow.test.generators.tuple5
 import arrow.typeclasses.Eq
+import io.kotlintest.Matcher
+import io.kotlintest.Result
 import io.kotlintest.TestContext
 import io.kotlintest.properties.Gen
 import io.kotlintest.should
+import io.kotlintest.shouldBe
 
 fun throwableEq() = Eq { a: Throwable, b ->
   a::class == b::class && a.message == b.message
@@ -19,9 +22,11 @@ fun <A> A.equalUnderTheLaw(b: A, eq: Eq<A>): Boolean =
   eq.run { eqv(b) }
 
 fun <A> A.shouldBeEq(b: A, eq: Eq<A>): Unit = eq.run {
-  this.should {
-    io.kotlintest.Result(eqv(b), "Expected: $this but found: $b", "$this and $b should be equal")
-  }
+  this.should(object: Matcher<Eq<A>> {
+    override fun test(value: Eq<A>): Result {
+      return io.kotlintest.Result(eqv(b), "Expected: ${this@shouldBeEq} but found: $b", "$this and $b should be equal")
+    }
+  })
 }
 
 fun <A> forFew(amount: Int, gena: Gen<A>, fn: (a: A) -> Boolean): Unit {

modules/core/arrow-test/src/main/kotlin/arrow/test/laws/SemigroupalLaws.kt

@@ -0,0 +1,27 @@
+package arrow.test.laws
+
+import arrow.Kind
+import arrow.core.Tuple2
+import arrow.typeclasses.Eq
+import arrow.typeclasses.Semigroupal
+import io.kotlintest.properties.Gen
+import io.kotlintest.properties.forAll
+
+object SemigroupalLaws {
+
+    fun <F> laws(
+            SGAL: Semigroupal<F>,
+            f: (Int) -> Kind<F, Int>,
+            bijection: (Kind<F, Tuple2<Tuple2<Int, Int>, Int>>) -> (Kind<F, Tuple2<Int, Tuple2<Int, Int>>>),
+            EQ: Eq<Kind<F, Tuple2<Int, Tuple2<Int, Int>>>>
+    ): List<Law> = listOf(Law("Semigroupal: Bijective associativity") { SGAL.semigroupalAssociative(f, bijection, EQ) })
+
+    private fun <F> Semigroupal<F>.semigroupalAssociative(
+            f: (Int) -> Kind<F, Int>,
+            bijection: (Kind<F, Tuple2<Tuple2<Int, Int>, Int>>) -> (Kind<F, Tuple2<Int, Tuple2<Int, Int>>>),
+            EQ: Eq<Kind<F, Tuple2<Int, Tuple2<Int, Int>>>>
+    ) = forAll(Gen.int().map(f), Gen.int().map(f), Gen.int().map(f)) { a, b, c ->
+        a.product(b.product(c)).equalUnderTheLaw(bijection(a.product(b).product(c)), EQ)
+    }
+
+}