-
-
Notifications
You must be signed in to change notification settings - Fork 57
/
monad.cljc
74 lines (53 loc) · 1.31 KB
/
monad.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
(ns promesa.monad
"An optional cats integration."
(:require [cats.core :as m]
[cats.context :as mc]
[cats.protocols :as mp]
[promesa.core :as p])
#?(:clj
(:import java.util.concurrent.CompletionStage)))
(declare promise-context)
#?(:cljs
(extend-type p/Promise
mp/Contextual
(-get-context [_] promise-context)
mp/Extract
(-extract [it]
(p/-extract it)))
:clj
(extend-type CompletionStage
mp/Contextual
(-get-context [_] promise-context)
mp/Extract
(-extract [it]
(p/-extract it))))
(def ^:no-doc promise-context
(reify
mp/Context
(-get-level [_] mc/+level-default+)
mp/Functor
(-fmap [mn f mv]
(p/-map mv f))
mp/Bifunctor
(-bimap [_ err succ mv]
(-> mv
(p/-map succ)
(p/-catch err)))
mp/Monad
(-mreturn [_ v]
(p/-promise v))
(-mbind [mn mv f]
(p/-bind mv f))
mp/Applicative
(-pure [_ v]
(p/-promise v))
(-fapply [_ pf pv]
(p/-map (p/all [pf pv])
(fn [[f v]]
(f v))))
mp/Semigroup
(-mappend [_ mv mv']
(p/-map (m/sequence [mv mv'])
(fn [[mvv mvv']]
(let [ctx (mp/-get-context mvv)]
(mp/-mappend ctx mvv mvv')))))))