-
Notifications
You must be signed in to change notification settings - Fork 4
/
flow.cljc
243 lines (211 loc) · 8.73 KB
/
flow.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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
(ns fmnoise.flow
#?(:clj (:import [fmnoise.flow Fail]))
#?(:clj (:require [net.cgrand.macrovich :as m])
:cljs (:require-macros [net.cgrand.macrovich :as m]
[fmnoise.flow :refer [flet]])))
(defprotocol Flow
(?ok [this f] "if value is not an error, apply f to it, otherwise return value")
(?err [this f] "if value is an error, apply f to it, otherwise return value")
(?throw [this] "if value is an error, throw it, otherwise return value"))
#?(:clj
(extend-protocol Flow
java.lang.Object
(?ok [this f] (f this))
(?err [this f] this)
(?throw [this] this)
nil
(?ok [this f] (f this))
(?err [this f] this)
(?throw [this] this)
java.lang.Throwable
(?ok [this f] this)
(?err [this f] (f this))
(?throw [this] (throw this)))
:cljs
(extend-protocol Flow
object
(?ok [this f] (f this))
(?err [this f] this)
(?throw [this] this)
nil
(?ok [this f] (f this))
(?err [this f] this)
(?throw [this] this)
js/Error
(?ok [this f] this)
(?err [this f] (f this))
(?throw [this] (throw this))))
(defprotocol Catch
(caught [t] "defines how to process caught exception"))
#?(:clj
(extend-protocol Catch
java.lang.Throwable
(caught [t] t))
:cljs
(extend-protocol Catch
js/Error
(caught [t] t)))
#?(:clj
(defn ^Fail fail-with
"Constructs `Fail` with given options. Stacktrace is disabled by default"
{:added "2.0"}
[{:keys [msg data cause suppress? trace?] :or {data {} suppress? false trace? false} :as options}]
{:pre [(or (nil? options) (map? options))]}
(Fail. msg data cause suppress? trace?))
:cljs
(defn fail-with
"Constructs `ex-info` with given options"
{:added "2.0"}
[{:keys [msg data cause] :or {data {}} :as options}]
{:pre [(or (nil? options) (map? options))]}
(ex-info msg data cause)))
(defn fail-with!
#?(:clj "Constructs `Fail` with given options and throws it. Stacktrace is enabled by default."
:cljs "Constructs ex-info with given options and throws it. Stacktrace is enabled by default.")
{:added "2.0"}
[{:keys [trace?] :or {trace? true} :as options}]
(throw (fail-with (assoc options :trace? trace?))))
(defn fail?
"Checks if given value is considered as failure"
[t]
#?(:clj
(or (instance? java.lang.Throwable t)
(instance? Fail (?err t (constantly (fail-with {})))))
:cljs
(or (instance? js/Error t)
(instance? js/Error (?err t (constantly (js/Error.)))))))
(defn chain
"Passes given value through chain of functions. If value is an error or any function in chain returns error, it's returned and rest of chain is skipped"
{:added "4.0"}
[v f & fs]
(loop [res (?ok v f)
chain fs]
(if (seq chain)
(recur (?ok res (first chain))
(rest chain))
res)))
(defn select
"Processes given collection with given function and returns first non-failure result. If all results are failures, returns nil. Accepts optional 2nd argument with function which will be called on processed collection when no non-failure result was returned. Always returns nil when collection is empty."
{:added "4.2"}
([f coll] (select f (constantly nil) coll))
([f fallback-f coll]
(when (seq coll)
(loop [res (f (first coll))
chain (rest coll)
results []]
(cond
(not (fail? res))
res
(seq chain)
(recur (f (first chain))
(rest chain)
(conj results res))
:else
(fallback-f (conj results res)))))))
(defn call
"Calls given function with supplied args in `try/catch` block, then calls `Catch.caught` on caught exception. If no exception has caught during function call returns its result"
[f & args]
(try
(apply f args)
(catch #?(:clj java.lang.Throwable :cljs :default) t
(caught t))))
(defn call-with
"Calls given function with supplied args in `try/catch` block, then calls catch-handler on caught exception. If no exception has caught during function call returns its result"
{:added "2.0"}
[catch-handler f & args]
(try
(apply f args)
(catch #?(:clj java.lang.Throwable :cljs :default) t
(catch-handler t))))
;; functor
(defn then
"If value is not an error, applies f to it, otherwise returns value"
([f] (partial then f))
([f value] (?ok value f)))
(defn then-call
"If value is not an error, applies f to it wrapped to `call`, otherwise returns value"
{:added "2.0"}
([f] (partial then-call f))
([f value] (?ok value (partial call f))))
(defn else
"If value is an error, applies f to it, otherwise returns value"
([f] (partial else f))
([f value] (?err value f)))
(defn else-call
"If value is an error, applies f to it wrapped to `call`, otherwise returns value"
{:added "2.0"}
([f] (partial else-call f))
([f value] (?err value (partial call f))))
(defn thru
"Applies f to value (for side effects). Returns value. Works similar to `doto`, but accepts function as first arg"
([f] (partial thru f))
([f value] (f value) value))
(defn thru-call
"Applies f to value wrapped to `call` (for side effects). Returns value. Works similar to `doto`, but accepts function as first arg. Please not that exception thrown inside of function will be silently ignored by default"
([f] (partial thru-call f))
([f value] (call f value) value))
#?(:clj
(defn else-if
"If value is an error of err-class (or any of its parents), applies f to it, otherwise returns value"
([err-class f] (partial else-if err-class f))
([err-class f value] (if (isa? (class value) err-class) (?err value f) value))))
(defn handle
"Accepts map with :ok, :err keys and a value. If value is an error, runs :err on it, else runs :ok. Both keys default to `identity`"
([opts] (partial handle opts))
([{:keys [ok err] :or {ok identity err identity}} value]
(if (fail? value) (err value) (ok value))))
(defn ex-info!
"Functional wrapper for creating and throwing ex-info"
{:added "4.0"}
[& args]
(throw (apply ex-info args)))
;; flet
(m/deftime
(defmacro flet
"Flow adaptation of Clojure `let`. Wraps evaluation of each binding to `call-with` with default handler (defined with `Catch.caught`). If value returned from binding evaluation is failure, it's returned immediately and all other bindings and body are skipped."
{:style/indent 1}
[bindings & body]
(when-not (even? (count bindings))
(throw (m/case :clj (IllegalArgumentException. "flet requires an even number of forms in binding vector")
:cljs "flet requires an even number of forms in binding vector")))
(m/case
:clj
`(try
(let ~(loop [bound []
tail (partition 2 bindings)]
(if-let [[bind-name expression] (first tail)]
(recur (into bound `[~(symbol (name bind-name)) (?err
(try ~expression
(catch Throwable ~'t
(fail-with! {:data {:thrown ~'t} :trace? false})))
(fn [~'err] (fail-with! {:data {:returned ~'err} :trace? false})))])
(rest tail))
bound))
(try ~@body
(catch Throwable ~'t
(fail-with! {:data {:thrown ~'t} :trace? false}))))
(catch Fail ~'failure
(let [{:keys [~'thrown ~'returned ~'scope]} (ex-data ~'failure)]
(if ~'thrown
(caught ~'thrown)
~'returned))))
:cljs
`(try
(let ~(loop [bound []
tail (partition 2 bindings)]
(if-let [[bind-name expression] (first tail)]
(recur (into bound `[~(symbol (name bind-name)) (?err
(try ~expression
(catch :default ~'t
(fail-with! {:data {:thrown ~'t} :trace? false})))
(fn [~'err] (fail-with! {:data {:thrown ~'t} :trace? false})))])
(rest tail))
bound))
(try ~@body
(catch :default ~'t
(fail-with! {:data {:thrown ~'t} :trace? false}))))
(catch :default ~'failure
(let [{:keys [~'thrown ~'returned ~'scope]} (ex-data ~'failure)]
(if ~'thrown
(caught ~'thrown)
~'returned)))))))