Merge pull request #137 from kategory/paco-function1

Add Function1

kategory/src/main/kotlin/kategory/arrow/Function0.kt

@@ -1,34 +1,34 @@
 package kategory
 
-fun <A> (() -> A).k(): HK<Function0.F, A> =
+fun <A> (() -> A).k(): Function0<A> =
         Function0(this)
 
 fun <A> HK<Function0.F, A>.ev(): () -> A =
         (this as Function0<A>).f
 
-// We don't we want an inherited class to avoid equivalence issues, so a simple HK wrapper will do
+// We don't want an inherited class to avoid equivalence issues, so a simple HK wrapper will do
 data class Function0<out A>(internal val f: () -> A) : HK<Function0.F, A> {
 
     class F private constructor()
 
     companion object : Bimonad<Function0.F>, GlobalInstance<Bimonad<Function0.F>>() {
 
-        override fun <A, B> flatMap(fa: HK<Function0.F, A>, f: (A) -> HK<Function0.F, B>): HK<Function0.F, B> =
-                f(fa.ev().invoke())
+        override fun <A, B> flatMap(fa: HK<Function0.F, A>, f: (A) -> HK<Function0.F, B>): Function0<B> =
+                f(fa.ev().invoke()).ev().k()
 
-        override fun <A, B> coflatMap(fa: HK<Function0.F, A>, f: (HK<Function0.F, A>) -> B): HK<Function0.F, B> =
+        override fun <A, B> coflatMap(fa: HK<Function0.F, A>, f: (HK<Function0.F, A>) -> B): Function0<B> =
                 { f(fa) }.k()
 
-        override fun <A> pure(a: A): HK<Function0.F, A> =
+        override fun <A> pure(a: A): Function0<A> =
                 { a }.k()
 
         override fun <A> extract(fa: HK<Function0.F, A>): A =
                 fa.ev().invoke()
 
-        override fun <A, B> map(fa: HK<F, A>, f: (A) -> B): HK<F, B> =
+        override fun <A, B> map(fa: HK<F, A>, f: (A) -> B): Function0<B> =
                 pure(f(fa.ev().invoke()))
 
-        override fun <A, B> tailRecM(a: A, f: (A) -> HK<F, Either<A, B>>): HK<F, B> =
+        override fun <A, B> tailRecM(a: A, f: (A) -> HK<F, Either<A, B>>): Function0<B> =
                 Function0 {
                     tailrec fun loop(thisA: A): B =
                             f(thisA).ev().invoke().fold({ loop(it) }, { it })

kategory/src/main/kotlin/kategory/arrow/Function1.kt

@@ -0,0 +1,32 @@
+package kategory
+
+typealias Function1F<R> = HK<Function1.F, R>
+
+fun <P, R> ((P) -> R).k(): Function1<P, R> =
+        Function1(this)
+
+@Suppress("UNCHECKED_CAST")
+fun <R> Function1F<R>.ev(): FunctionInject<R> =
+        this as FunctionInject<R>
+
+// We don't want an inherited class to avoid equivalence issues, so a simple HK wrapper will do
+data class Function1<in A, out R>(val f: (A) -> R) : FunctionInject<R>, Function1F<R> {
+    override fun <P> invokeInject(p: P): R =
+            f(p as A)
+
+    @Suppress("UNCHECKED_CAST")
+    operator fun invoke(a: A): R =
+            f(a)
+
+    class F private constructor()
+
+    companion object {
+        fun <P> functor() = object : Function1Instances<P> {}
+
+        fun <P> applicative() = object : Function1Instances<P> {}
+
+        fun <P> monad() = object : Function1Instances<P> {}
+
+        fun <P> monadReader() = object : Function1Instances<P> {}
+    }
+}

kategory/src/main/kotlin/kategory/arrow/FunctionBijections.kt

@@ -0,0 +1,9 @@
+package kategory
+
+interface FunctionInject<out R> {
+    fun <P> invokeInject(p: P): R
+}
+
+interface FunctionSurject<in P> {
+    fun <R> invokeSurject(p: P): R
+}

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

@@ -13,7 +13,7 @@ fun <F, G, A> HK<F, HK<G, A>>.lift(): HK<ComposedType<F, G>, A> =
 fun <F, G, A> HK<ComposedType<F, G>, A>.lower(): HK<F, HK<G, A>> =
         this as HK<F, HK<G, A>>
 
-data class ComposedFoldable<F, G>(val FF: Foldable<F>, val GF: Foldable<G>) : Foldable<ComposedType<F, G>> {
+data class ComposedFoldable<in F, in G>(val FF: Foldable<F>, val GF: Foldable<G>) : Foldable<ComposedType<F, G>> {
     override fun <A, B> foldL(fa: HK<ComposedType<F, G>, A>, b: B, f: (B, A) -> B): B =
             FF.foldL(fa.lower(), b, { bb, aa -> GF.foldL(aa, bb, f) })
 

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

@@ -0,0 +1,31 @@
+package kategory
+
+interface Function1Instances<P> :
+        Functor<Function1.F>,
+        Applicative<Function1.F>,
+        Monad<Function1.F>,
+        MonadReader<Function1.F, P> {
+
+    override fun ask(): HK<Function1.F, P> =
+            { a: P -> a }.k()
+
+    override fun <A> local(f: (P) -> P, fa: HK<Function1.F, A>): Function1<P, A> =
+            f.andThen { fa.ev().invokeInject(it) }.k()
+
+    override fun <A> pure(a: A): Function1<P, A> =
+            { _: P -> a }.k()
+
+    override fun <A, B> map(fa: HK<Function1.F, A>, f: (A) -> B): HK<Function1.F, B> =
+            f.compose { b: B -> fa.ev().invokeInject(b) }.k()
+
+    override fun <A, B> flatMap(fa: HK<Function1.F, A>, f: (A) -> HK<Function1.F, B>): Function1<P, B> =
+            Function1 { p -> f(fa.ev().invokeInject(p)).ev().invokeInject(p) }
+
+    override fun <A, B> tailRecM(a: A, f: (A) -> HK<Function1.F, Either<A, B>>): Function1<P, B> =
+            Function1 { p ->
+                tailrec fun loop(thisA: A): B =
+                        f(thisA).ev().invokeInject(p).fold({ loop(it) }, { it })
+
+                loop(a)
+            }
+}

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

@@ -19,7 +19,6 @@ interface TryInstances :
     override fun <A> handleErrorWith(fa: TryKind<A>, f: (Throwable) -> TryKind<A>): Try<A> =
             fa.ev().recoverWith { f(it).ev() }
 
-    @Suppress("UNCHECKED_CAST")
     override fun <A, B> tailRecM(a: A, f: (A) -> TryKind<Either<A, B>>): Try<B> =
             f(a).ev().fold({ Try.raiseError(it) }, { either -> either.fold({ tailRecM(it, f) }, { Try.Success(it) }) })
 

kategory/src/test/kotlin/kategory/data/Function1Test.kt

@@ -0,0 +1,29 @@
+package kategory
+
+import io.kotlintest.KTestJUnitRunner
+import io.kotlintest.matchers.shouldBe
+import org.junit.runner.RunWith
+
+@RunWith(KTestJUnitRunner::class)
+class Function1Test : UnitSpec() {
+    init {
+        testLaws(MonadLaws.laws(Function1.monad<Int>(), object : Eq<HK<Function1.F, Int>> {
+            override fun eqv(a: HK<Function1.F, Int>, b: HK<Function1.F, Int>): Boolean =
+                    a.ev().invokeInject(1) == b.ev().invokeInject(1)
+        }))
+
+        "bla" {
+           { a: Int -> a + 1 }.k().invoke(1)
+        }
+
+        "Function1Monad.binding should for comprehend over all values of multiple Function0" {
+            val M = Function1.monad<Int>()
+            M.binding {
+                val x = Function1 { _: Int -> 1 }.bind()
+                val y = !Function1 { _: Int -> 2 }
+                val z = bind { Function1 { _: Int -> 3 } }
+                yields(x + y + z)
+            }.ev().invokeInject(0) shouldBe 6
+        }
+    }
+}