[WIP] selective functor

modules/core/arrow-core-data/src/main/kotlin/arrow/core/Function0.kt

@@ -1,6 +1,7 @@
 package arrow.core
 
 import arrow.Kind
+import arrow.core.Function0.Companion.just
 import arrow.higherkind
 
 fun <A> (() -> A).k(): Function0<A> = Function0(this)
@@ -35,4 +36,7 @@ data class Function0<out A>(internal val f: () -> A) : Function0Of<A> {
     fun <A, B> tailRecM(a: A, f: (A) -> Kind<ForFunction0, Either<A, B>>): Function0<B> = { loop(a, f) }.k()
 
   }
-}
+}
+
+fun <A, B> Function0<Either<A, B>>.select(f: Function0Of<(A) -> B>): Function0<B> =
+  flatMap  { it.fold({l -> just(l).ap(f)}, {r -> just(identity(r))})}

modules/core/arrow-core-data/src/main/kotlin/arrow/core/Id.kt

@@ -1,5 +1,6 @@
 package arrow.core
 
+import arrow.core.Id.Companion.just
 import arrow.higherkind
 
 fun <A> IdOf<A>.value(): A = this.fix().extract()
@@ -43,3 +44,6 @@ data class Id<out A>(private val value: A) : IdOf<A> {
   override fun hashCode(): Int = value.hashCode()
 
 }
+
+fun <A, B> Id<Either<A, B>>.select(f: IdOf<(A) -> B>): Id<B> =
+  flatMap { it.fold({ l -> just(l).ap(f) }, { r -> just(identity(r)) }) }

modules/core/arrow-core-data/src/main/kotlin/arrow/core/Option.kt

@@ -231,4 +231,7 @@ fun <T> Iterable<T>.lastOrNone(): Option<T> = this.lastOrNull().toOption()
 
 fun <T> Iterable<T>.lastOrNone(predicate: (T) -> Boolean): Option<T> = this.lastOrNull(predicate).toOption()
 
-fun <T> Iterable<T>.elementAtOrNone(index: Int): Option<T> = this.elementAtOrNull(index).toOption()
+fun <T> Iterable<T>.elementAtOrNone(index: Int): Option<T> = this.elementAtOrNull(index).toOption()
+
+fun <A, B> Option<Either<A, B>>.select(f: OptionOf<(A) -> B>): Option<B> =
+  flatMap { it.fold({ l -> Option.just(l).ap(f) }, { r -> Option.just(identity(r)) }) }

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

@@ -1,6 +1,8 @@
 package arrow.core.extensions
 
+import arrow.Kind
 import arrow.core.*
+import arrow.core.select as fun0Select
 import arrow.core.extensions.function0.monad.monad
 import arrow.extension
 import arrow.typeclasses.*
@@ -42,6 +44,12 @@ interface Function0Applicative : Applicative<ForFunction0> {
     Function0.just(a)
 }
 
+@extension
+interface Function0Selective : Selective<ForFunction0>, Function0Applicative {
+  override fun <A, B> Function0Of<Either<A, B>>.select(f: Kind<ForFunction0, (A) -> B>): Kind<ForFunction0, B> =
+    fix().fun0Select(f)
+}
+
 @extension
 interface Function0Monad : Monad<ForFunction0> {
   override fun <A, B> Function0Of<A>.ap(ff: Function0Of<(A) -> B>): Function0<B> =
@@ -58,6 +66,9 @@ interface Function0Monad : Monad<ForFunction0> {
 
   override fun <A> just(a: A): Function0<A> =
     Function0.just(a)
+
+  override fun <A, B> Function0Of<Either<A, B>>.select(f: Kind<ForFunction0, (A) -> B>): Kind<ForFunction0, B> =
+    fix().fun0Select(f)
 }
 
 @extension

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

@@ -1,9 +1,10 @@
 @file:Suppress("UnusedImports")
+
 package arrow.core.extensions
 
 import arrow.Kind
 import arrow.core.*
-import arrow.core.extensions.function1.monad.monad
+import arrow.core.select as idSelect
 import arrow.core.extensions.id.monad.monad
 import arrow.extension
 import arrow.typeclasses.*
@@ -58,6 +59,12 @@ interface IdApplicative : Applicative<ForId> {
     Id.just(a)
 }
 
+@extension
+interface IdSelective : Selective<ForId>, IdApplicative {
+  override fun <A, B> IdOf<Either<A, B>>.select(f: Kind<ForId, (A) -> B>): Kind<ForId, B> =
+    fix().idSelect(f)
+}
+
 @extension
 interface IdMonad : Monad<ForId> {
   override fun <A, B> IdOf<A>.ap(ff: IdOf<(A) -> B>): Id<B> =
@@ -74,6 +81,9 @@ interface IdMonad : Monad<ForId> {
 
   override fun <A> just(a: A): Id<A> =
     Id.just(a)
+
+  override fun <A, B> IdOf<Either<A, B>>.select(f: Kind<ForId, (A) -> B>): Kind<ForId, B> =
+    fix().idSelect(f)
 }
 
 @extension

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

@@ -3,6 +3,7 @@ package arrow.core.extensions
 
 import arrow.Kind
 import arrow.core.*
+import arrow.core.select as optionSelect
 import arrow.core.extensions.option.monad.map
 import arrow.core.extensions.option.monad.monad
 import arrow.extension
@@ -123,6 +124,12 @@ interface OptionApplicative : Applicative<ForOption> {
     Option.just(a)
 }
 
+@extension
+interface OptionSelective : Selective<ForOption>, OptionApplicative {
+  override fun <A, B> OptionOf<Either<A, B>>.select(f: OptionOf<(A) -> B>): Option<B> =
+    fix().optionSelect(f)
+}
+
 @extension
 interface OptionMonad : Monad<ForOption> {
   override fun <A, B> OptionOf<A>.ap(ff: OptionOf<(A) -> B>): Option<B> =
@@ -139,6 +146,9 @@ interface OptionMonad : Monad<ForOption> {
 
   override fun <A> just(a: A): Option<A> =
     Option.just(a)
+
+  override fun <A, B> OptionOf<Either<A, B>>.select(f: OptionOf<(A) -> B>): OptionOf<B> =
+    fix().optionSelect(f)
 }
 
 @extension

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

@@ -3,6 +3,7 @@ package arrow.test.laws
 import arrow.Kind
 import arrow.core.Left
 import arrow.core.Right
+import arrow.core.identity
 import arrow.data.Kleisli
 import arrow.free.Free
 import arrow.free.bindingStackSafe
@@ -17,7 +18,8 @@ import kotlinx.coroutines.newSingleThreadContext
 object MonadLaws {
 
   fun <F> laws(M: Monad<F>, EQ: Eq<Kind<F, Int>>): List<Law> =
-    ApplicativeLaws.laws(M, EQ) + listOf(
+    SelectiveLaws.laws(M, EQ) +
+      listOf(
       Law("Monad Laws: left identity") { M.leftIdentity(EQ) },
       Law("Monad Laws: right identity") { M.rightIdentity(EQ) },
       Law("Monad Laws: kleisli left identity") { M.kleisliLeftIdentity(EQ) },
@@ -27,7 +29,8 @@ object MonadLaws {
       Law("Monad Laws: monad comprehensions binding in other threads") { M.monadComprehensionsBindInContext(EQ) },
       Law("Monad Laws: stack-safe//unsafe monad comprehensions equivalence") { M.equivalentComprehensions(EQ) },
       Law("Monad Laws: stack safe") { M.stackSafety(5000, EQ) },
-      Law("Monad Laws: stack safe comprehensions") { M.stackSafetyComprehensions(5000, EQ) }
+      Law("Monad Laws: stack safe comprehensions") { M.stackSafetyComprehensions(5000, EQ) },
+      Law("Monad Laws: selectM == select when Selective has a monad instance") { M.selectEQSelectM(EQ) }
     )
 
   fun <F> Monad<F>.leftIdentity(EQ: Eq<Kind<F, Int>>): Unit =
@@ -101,6 +104,12 @@ object MonadLaws {
       }.equalUnderTheLaw(just(num + 2), EQ)
     }
 
+  fun <F> Monad<F>.selectEQSelectM(EQ: Eq<Kind<F, Int>>): Unit =
+    forAll(Gen.either(Gen.int(), Gen.int())) { either ->
+      val f = just<(Int) -> Int>(::identity)
+      just(either).select(f).equalUnderTheLaw(just(either).selectM(f), EQ)
+    }
+
   fun <F> Monad<F>.monadComprehensionsBindInContext(EQ: Eq<Kind<F, Int>>): Unit =
     forFew(5, Gen.intSmall()) { num: Int ->
       binding {

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

@@ -0,0 +1,44 @@
+package arrow.test.laws
+
+import arrow.Kind
+import arrow.core.*
+import arrow.test.generators.either
+import arrow.typeclasses.Eq
+import arrow.typeclasses.Selective
+import io.kotlintest.properties.Gen
+import io.kotlintest.properties.forAll
+
+object SelectiveLaws {
+
+  fun <F> laws(A: Selective<F>, EQ: Eq<Kind<F, Int>>): List<Law> =
+    ApplicativeLaws.laws(A, EQ) + listOf(
+      Law("Selective Laws: identity") { A.identityLaw(EQ) },
+      Law("Selective Laws: branch") { A.branchLaw(EQ) },
+      Law("Selective Laws: ifS") { A.ifSLaw(EQ) }
+    )
+
+  fun <F> Selective<F>.identityLaw(EQ: Eq<Kind<F, Int>>): Unit =
+    forAll(Gen.either(Gen.int(), Gen.int())) { either ->
+      either.fold(
+        { l -> just(either).select(just(::identity)).equalUnderTheLaw(just(l), EQ) },
+        { r -> just(either).select(just(::identity)).equalUnderTheLaw(just(r), EQ) }
+      )
+    }
+
+  fun <F> Selective<F>.branchLaw(EQ: Eq<Kind<F, Int>>): Unit =
+    forAll(Gen.either(Gen.double(), Gen.float())) { either ->
+      val fl = just(Double::toInt)
+      val fr = just(Float::toInt)
+      either.fold(
+        { l -> just(either).branch(fl, fr).equalUnderTheLaw(fl.map { ff -> ff(l) }, EQ) },
+        { r -> just(either).branch(fl, fr).equalUnderTheLaw(fr.map { ff -> ff(r) }, EQ) }
+      )
+    }
+
+  fun <F> Selective<F>.ifSLaw(EQ: Eq<Kind<F, Int>>): Unit =
+    forAll(Gen.bool(), Gen.int(), Gen.int()) { bool, lInt, rInt ->
+      if (bool) just(bool).ifS(just(lInt), just(rInt)).equalUnderTheLaw(just(lInt), EQ)
+      else just(bool).ifS(just(lInt), just(rInt)).equalUnderTheLaw(just(rInt), EQ)
+    }
+
+}

modules/core/arrow-typeclasses/src/main/kotlin/arrow/typeclasses/Monad.kt

@@ -24,7 +24,7 @@ import kotlin.coroutines.startCoroutine
  *
  */
 @documented
-interface Monad<F> : Applicative<F> {
+interface Monad<F> : Selective<F> {
 
   fun <A, B> Kind<F, A>.flatMap(f: (A) -> Kind<F, B>): Kind<F, B>
 
@@ -63,6 +63,11 @@ interface Monad<F> : Applicative<F> {
   fun <B> Kind<F, Boolean>.ifM(ifTrue: () -> Kind<F, B>, ifFalse: () -> Kind<F, B>): Kind<F, B> =
     flatMap { if (it) ifTrue() else ifFalse() }
 
+  fun <A, B> Kind<F, Either<A, B>>.selectM(f: Kind<F, (A) -> B>): Kind<F, B> =
+    flatMap { it.fold({ a -> f.map { ff -> ff(a) } }, { b -> just(b) }) }
+
+  override fun <A, B> Kind<F, Either<A, B>>.select(f: Kind<F, (A) -> B>): Kind<F, B> = selectM(f)
+
   /**
    * Entry point for monad bindings which enables for comprehension. The underlying implementation is based on coroutines.
    * A coroutine is initiated and suspended inside [MonadErrorContinuation] yielding to [Monad.flatMap]. Once all the flatMap binds are completed

modules/core/arrow-typeclasses/src/main/kotlin/arrow/typeclasses/Selective.kt

@@ -0,0 +1,33 @@
+package arrow.typeclasses
+
+import arrow.Kind
+import arrow.core.*
+
+/**
+ * ank_macro_hierarchy(arrow.typeclasses.Selective)
+ */
+interface Selective<F> : Applicative<F> {
+  fun <A, B> Kind<F, Either<A, B>>.select(f: Kind<F, (A) -> B>): Kind<F, B>
+
+  private fun Kind<F, Boolean>.selector(): Kind<F, Either<Unit, Unit>> =
+    map { bool -> if (bool) Unit.left() else Unit.right() }
+
+  fun <A, B, C> Kind<F, Either<A, B>>.branch(fl: Kind<F, (A) -> C>, fr: Kind<F, (B) -> C>): Kind<F, C> {
+    val nested: Kind<F, Either<A, Either<B, Nothing>>> = map { it.map(::Left) }
+    val ffl: Kind<F, (A) -> Either<Nothing, C>> = fl.map { it.andThen(::Right) }
+    return nested.select(ffl).select(fr)
+  }
+
+  fun <A> Kind<F, Boolean>.whenS(x: Kind<F, () -> Unit>): Kind<F, Unit> =
+    selector().select(x.map { f -> { _: Unit -> f() } })
+
+  fun <A> Kind<F, Boolean>.ifS(fl: Kind<F, A>, fr: Kind<F, A>): Kind<F, A> =
+    selector().branch( fl.map {{ _: Unit -> it }} , fr.map {{ _: Unit -> it }} )
+
+  fun <A> Kind<F, Boolean>.orS(f: Kind<F, Boolean>): Kind<F, Boolean> =
+    ifS(just(true), f)
+
+  fun <A> Kind<F, Boolean>.andS(f: Kind<F, Boolean>): Kind<F, Boolean> =
+    ifS(f, just(false))
+
+}