Skip to content

Commit b8e962f

Browse files
raulrajaraulraja
authored
Merge pull request #127 from kategory/rr-kleisli-instances
Kleisli and EitherT extra instances and tests + some fixes
2 parents 01bdd2a + d4ef37d commit b8e962f

File tree

9 files changed

+143
-78
lines changed

9 files changed

+143
-78
lines changed

‎kategory/src/main/kotlin/kategory/data/EitherT.kt

+48
Original file line numberDiff line numberDiff line change
@@ -78,3 +78,51 @@ data class EitherT<F, A, B>(val MF: Monad<F>, val value: HK<F, Either<A, B>>) :
7878
return GA.map(fa, { EitherT(MF, MF.map(it.lower(), { it.ev() })) })
7979
}
8080
}
81+
82+
class EitherTInstances<F, L>(val MF : Monad<F>) : EitherTMonadError<F, L> {
83+
override fun MF(): Monad<F> = MF
84+
}
85+
86+
interface EitherTMonad<F, L> : Monad<EitherTF<F, L>> {
87+
88+
fun MF() : Monad<F>
89+
90+
override fun <A> pure(a: A): EitherT<F, L, A> =
91+
EitherT(MF(), MF().pure(Either.Right(a)))
92+
93+
override fun <A, B> map(fa: EitherTKind<F, L, A>, f: (A) -> B): EitherT<F, L, B> =
94+
fa.ev().map { f(it) }
95+
96+
override fun <A, B> flatMap(fa: EitherTKind<F, L, A>, f: (A) -> EitherTKind<F, L, B>): EitherT<F, L, B> =
97+
fa.ev().flatMap { f(it).ev() }
98+
99+
override fun <A, B> tailRecM(a: A, f: (A) -> HK<EitherTF<F, L>, Either<A, B>>): EitherT<F, L, B> =
100+
EitherT(MF(), MF().tailRecM(a, {
101+
MF().map(f(it).ev().value) { recursionControl ->
102+
when (recursionControl) {
103+
is Either.Left<L> -> Either.Right(Either.Left(recursionControl.a))
104+
is Either.Right<Either<A, B>> ->
105+
when (recursionControl.b) {
106+
is Either.Left<A> -> Either.Left(recursionControl.b.a)
107+
is Either.Right<B> -> Either.Right(Either.Right(recursionControl.b.b))
108+
}
109+
}
110+
}
111+
}))
112+
113+
}
114+
115+
interface EitherTMonadError<F, E> : EitherTMonad<F, E>, MonadError<EitherTF<F, E>, E> {
116+
117+
override fun <A> handleErrorWith(fa: EitherTKind<F, E, A>, f: (E) -> EitherTKind<F, E, A>): EitherT<F, E, A> =
118+
EitherT(MF(), MF().flatMap(fa.ev().value, {
119+
when (it) {
120+
is Either.Left -> f(it.a).ev().value
121+
is Either.Right -> MF().pure(it)
122+
}
123+
}))
124+
125+
override fun <A> raiseError(e: E): EitherT<F, E, A> =
126+
EitherT(MF(), MF().pure(Either.Left(e)))
127+
128+
}

‎kategory/src/main/kotlin/kategory/data/Kleisli.kt

+52-2
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,8 @@ package kategory
22

33
typealias KleisliTKind<F, A, B> = HK3<Kleisli.F, F, A, B>
44
typealias KleisliF<F> = HK<Kleisli.F, F>
5-
5+
typealias KleisliFD<F, D> = HK2<Kleisli.F, F, D>
66
typealias KleisliFun<F, D, A> = (D) -> HK<F, A>
7-
87
typealias ReaderT<F, D, A> = Kleisli<F, D, A>
98

109
fun <F, D, A> KleisliTKind<F, D, A>.ev(): Kleisli<F, D, A> =
@@ -54,3 +53,54 @@ class Kleisli<F, D, A>(val MF: Monad<F>, val run: KleisliFun<F, D, A>) : Kleisli
5453

5554
inline fun <reified F, D, A> Kleisli<F, D, Kleisli<F, D, A>>.flatten(): Kleisli<F, D, A> =
5655
flatMap({ it })
56+
57+
class KleisliInstances<F, D, E>(val FME: MonadError<F, E>) : KleisliMonadReader<F, D>, KleisliMonadError<F, D, E> {
58+
override fun FM(): Monad<F> = FME
59+
60+
override fun FME(): MonadError<F, E> = FME
61+
}
62+
63+
interface KleisliMonadReader<F, D> : MonadReader<KleisliFD<F, D>, D>, KleisliMonad<F, D> {
64+
65+
override fun FM(): Monad<F>
66+
67+
override fun ask(): Kleisli<F, D, D> =
68+
Kleisli(FM(), { FM().pure(it) })
69+
70+
override fun <A> local(f: (D) -> D, fa: HK<KleisliFD<F, D>, A>): Kleisli<F, D, A> =
71+
fa.ev().local(f)
72+
}
73+
74+
interface KleisliMonad<F, D> : Monad<KleisliFD<F, D>> {
75+
76+
fun FM(): Monad<F>
77+
78+
override fun <A, B> flatMap(fa: HK<KleisliFD<F, D>, A>, f: (A) -> HK<KleisliFD<F, D>, B>): Kleisli<F, D, B> =
79+
fa.ev().flatMap(f.andThen { it.ev() })
80+
81+
override fun <A, B> map(fa: HK<KleisliFD<F, D>, A>, f: (A) -> B): Kleisli<F, D, B> =
82+
fa.ev().map(f)
83+
84+
override fun <A, B> product(fa: HK<KleisliFD<F, D>, A>, fb: HK<KleisliFD<F, D>, B>): Kleisli<F, D, Tuple2<A, B>> =
85+
Kleisli(FM(), { FM().product(fa.ev().run(it), fb.ev().run(it)) })
86+
87+
override fun <A, B> tailRecM(a: A, f: (A) -> HK<KleisliFD<F, D>, Either<A, B>>): Kleisli<F, D, B> =
88+
Kleisli(FM(), { b -> FM().tailRecM(a, { f(it).ev().run(b) }) })
89+
90+
override fun <A> pure(a: A): Kleisli<F, D, A> =
91+
Kleisli(FM(), { FM().pure(a) })
92+
}
93+
94+
interface KleisliMonadError<F, D, E> : MonadError<KleisliFD<F, D>, E>, KleisliMonad<F, D> {
95+
96+
fun FME(): MonadError<F, E>
97+
98+
override fun <A> handleErrorWith(fa: HK<KleisliFD<F, D>, A>, f: (E) -> HK<KleisliFD<F, D>, A>): Kleisli<F, D, A> =
99+
Kleisli(FME(), {
100+
FME().handleErrorWith(fa.ev().run(it), { e: E -> f(e).ev().run(it) })
101+
})
102+
103+
override fun <A> raiseError(e: E): Kleisli<F, D, A> =
104+
Kleisli(FME(), { FME().raiseError(e) })
105+
106+
}

‎kategory/src/main/kotlin/kategory/instances/EitherTMonad.kt

-31
This file was deleted.

‎kategory/src/main/kotlin/kategory/typeclasses/ApplicativeError.kt

+11-1
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,16 @@ interface ApplicativeError<F, E> : Applicative<F>, Typeclass {
1313
handleErrorWith(map(fa) { Either.Right(it) }) {
1414
pure(Either.Left(it))
1515
}
16+
17+
fun <A> fromEither(fab: Either<E, A>): HK<F, A> =
18+
fab.fold({ raiseError<A>(it) }, { pure(it) })
19+
20+
fun <A> catch(f: () -> A, recover: (Throwable) -> E): HK<F, A> =
21+
try {
22+
pure(f())
23+
} catch (t: Throwable) {
24+
raiseError<A>(recover(t))
25+
}
1626
}
1727

1828
fun <F, A> ApplicativeError<F, Throwable>.catch(f: () -> A): HK<F, A> =
@@ -24,4 +34,4 @@ fun <F, A> ApplicativeError<F, Throwable>.catch(f: () -> A): HK<F, A> =
2434
}
2535

2636
inline fun <reified F, reified E> applicativeError(): ApplicativeError<F, E> =
27-
instance(InstanceParametrizedType(Monad::class.java, listOf(F::class.java, E::class.java)))
37+
instance(InstanceParametrizedType(ApplicativeError::class.java, listOf(F::class.java, E::class.java)))

‎kategory/src/main/kotlin/kategory/typeclasses/MonadError.kt

+1-1
Original file line numberDiff line numberDiff line change
@@ -38,4 +38,4 @@ fun <F, B> MonadError<F, Throwable>.bindingE(c: suspend MonadErrorContinuation<F
3838
}
3939

4040
inline fun <reified F, reified E> monadError(): MonadError<F, E> =
41-
instance(InstanceParametrizedType(Functor::class.java, listOf(F::class.java, E::class.java)))
41+
instance(InstanceParametrizedType(MonadError::class.java, listOf(F::class.java, E::class.java)))

‎kategory/src/main/kotlin/kategory/typeclasses/MonadReader.kt

+15
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
package kategory
2+
3+
interface MonadReader<F, D> : Monad<F> {
4+
/** Get the environment */
5+
fun ask(): HK<F, D>
6+
7+
/** Modify the environment */
8+
fun <A> local(f: (D) -> D, fa: HK<F, A>): HK<F, A>
9+
10+
/** Retrieves a function of the environment */
11+
fun <A> reader(f: (D) -> A): HK<F, A> = map(ask(), f)
12+
}
13+
14+
inline fun <reified F, reified D> monadReader(): MonadReader<F, D> =
15+
instance(InstanceParametrizedType(MonadReader::class.java, listOf(F::class.java, D::class.java)))

‎kategory/src/main/kotlin/kategory/typeclasses/Typeclass.kt

-36
Original file line numberDiff line numberDiff line change
@@ -65,42 +65,6 @@ class InstanceParametrizedType(val raw: Type, val typeArgs: List<Type>) : Parame
6565
hashCode(rawType)
6666
}
6767

68-
override fun toString(): String {
69-
val sb = StringBuilder()
70-
71-
if (ownerType != null) {
72-
if (ownerType is Class<*>)
73-
sb.append((ownerType as Class<*>).name)
74-
else
75-
sb.append(ownerType.toString())
76-
77-
sb.append(".")
78-
79-
if (ownerType is ParameterizedType) {
80-
// Find simple name of nested type by removing the
81-
// shared prefix with owner.
82-
sb.append(rawType.typeName.replace((ownerType as ParameterizedType).rawType.typeName + "$",
83-
""))
84-
} else
85-
sb.append(rawType.typeName)
86-
} else
87-
sb.append(rawType.typeName)
88-
89-
if (actualTypeArguments.isNotEmpty()) {
90-
sb.append("<")
91-
var first = true
92-
for (t in actualTypeArguments) {
93-
if (!first)
94-
sb.append(", ")
95-
sb.append(t.typeName)
96-
first = false
97-
}
98-
sb.append(">")
99-
}
100-
101-
return sb.toString()
102-
}
103-
10468
fun hashCode(o: Any?): Int {
10569
return o?.hashCode() ?: 0
10670
}

‎kategory/src/test/kotlin/kategory/data/EitherTTest.kt

+7-7
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ import org.junit.runner.RunWith
1010
class EitherTTest : UnitSpec() {
1111
init {
1212

13-
testLaws(MonadLaws.laws(EitherTMonad<Id.F, Int>(), Eq.any()))
13+
testLaws(MonadErrorLaws.laws(EitherTInstances<Id.F, Throwable>(Id), Eq.any()))
1414

1515
"map should modify value" {
1616
forAll { a: String ->
@@ -165,13 +165,13 @@ class EitherTTest : UnitSpec() {
165165
forAll { a: Int ->
166166
val x = { b: Int -> EitherT.pure<Id.F, Int, Int>(b * a) }
167167
val option = EitherT.pure<Id.F, Int, Int>(a)
168-
option.flatMap(x) == EitherTMonad<Id.F, Int>(Id).flatMap(option, x)
168+
option.flatMap(x) == EitherTInstances<Id.F, Int>(Id).flatMap(option, x)
169169
}
170170
}
171171

172172
"EitherTMonad#tailRecM should execute and terminate without blowing up the stack" {
173173
forAll { a: Int ->
174-
val value: EitherT<Id.F, Int, Int> = EitherTMonad<Id.F, Int>(Id).tailRecM(a) { b ->
174+
val value: EitherT<Id.F, Int, Int> = EitherTInstances<Id.F, Int>(Id).tailRecM(a) { b ->
175175
EitherT.pure<Id.F, Int, Either<Int, Int>>(Either.Right(b * a))
176176
}
177177
val expected = EitherT.pure<Id.F, Int, Int>(a * a)
@@ -180,7 +180,7 @@ class EitherTTest : UnitSpec() {
180180
}
181181

182182
forAll(Gen.oneOf(listOf(10000))) { limit: Int ->
183-
val value: EitherT<Id.F, Int, Int> = EitherTMonad<Id.F, Int>(Id).tailRecM(0) { current ->
183+
val value: EitherT<Id.F, Int, Int> = EitherTInstances<Id.F, Int>(Id).tailRecM(0) { current ->
184184
if (current == limit)
185185
EitherT.left(current)
186186
else
@@ -226,7 +226,7 @@ class EitherTTest : UnitSpec() {
226226
}
227227

228228
"EitherTMonad#binding should for comprehend over option" {
229-
val M = EitherTMonad<NonEmptyList.F, Int>(NonEmptyList)
229+
val M = EitherTInstances<NonEmptyList.F, Int>(NonEmptyList)
230230
val result = M.binding {
231231
val x = !M.pure(1)
232232
val y = M.pure(1).bind()
@@ -237,13 +237,13 @@ class EitherTTest : UnitSpec() {
237237
}
238238

239239
"Cartesian builder should build products over option" {
240-
EitherTMonad<Id.F, Int>(Id).map(EitherT.pure(1), EitherT.pure("a"), EitherT.pure(true), { (a, b, c) ->
240+
EitherTInstances<Id.F, Int>(Id).map(EitherT.pure(1), EitherT.pure("a"), EitherT.pure(true), { (a, b, c) ->
241241
"$a $b $c"
242242
}) shouldBe EitherT.pure<Id.F, Int, String>("1 a true")
243243
}
244244

245245
"Cartesian builder works inside for comprehensions" {
246-
val M = EitherTMonad<NonEmptyList.F, Int>(NonEmptyList)
246+
val M = EitherTInstances<NonEmptyList.F, Int>(NonEmptyList)
247247
val result = M.binding {
248248
val (x, y, z) = !M.tupled(M.pure(1), M.pure(1), M.pure(1))
249249
val a = M.pure(1).bind()

‎kategory/src/test/kotlin/kategory/data/KleisliTest.kt

+9
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,15 @@ import org.junit.runner.RunWith
77
@RunWith(KTestJUnitRunner::class)
88
class KleisliTest : UnitSpec() {
99
init {
10+
11+
val instances = KleisliInstances<Try.F, Int, Throwable>(Try)
12+
13+
testLaws(MonadErrorLaws.laws(instances, object : Eq<KleisliTKind<Try.F, Int, Int>> {
14+
override fun eqv(a: KleisliTKind<Try.F, Int, Int>, b: KleisliTKind<Try.F, Int, Int>): Boolean =
15+
a.ev().run(1) == b.ev().run(1)
16+
17+
}))
18+
1019
"andThen should continue sequence" {
1120
val kleisli: Kleisli<Id.F, Int, Int> = Kleisli({ a: Int -> Id(a) })
1221

0 commit comments

Comments
 (0)