@@ -2,9 +2,8 @@ package kategory
2
2
3
3
typealias KleisliTKind <F , A , B > = HK3 <Kleisli .F , F , A , B >
4
4
typealias KleisliF <F > = HK <Kleisli .F , F >
5
-
5
+ typealias KleisliFD < F , D > = HK2 < Kleisli . F , F , D >
6
6
typealias KleisliFun <F , D , A > = (D ) -> HK <F , A >
7
-
8
7
typealias ReaderT <F , D , A > = Kleisli <F , D , A >
9
8
10
9
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
54
53
55
54
inline fun <reified F , D , A > Kleisli <F , D , Kleisli <F , D , A >>.flatten (): Kleisli <F , D , A > =
56
55
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
+ }
0 commit comments