-
-
Notifications
You must be signed in to change notification settings - Fork 16
/
common.clj
62 lines (54 loc) · 2.21 KB
/
common.clj
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
(ns methodical.impl.combo.common
"Utility functions for implementing method combinations.")
(defn combine-primary-methods
"Combine all `primary-methods` into a single combined method. Each method is partially bound with a `next-method`
arg."
[primary-methods]
(when (seq primary-methods)
(reduce
(fn [next-method primary-method]
(with-meta (partial primary-method next-method) (meta primary-method)))
nil
(reverse primary-methods))))
(defn apply-around-methods
"Combine `around-methods` into `combined-method`, returning a new even-more-combined method. Each around method is
partially bound with a `next-method` arg. Normally, this applies around methods least-specific-first (e.g. Person
before Child)."
[combined-method around-methods]
(reduce
(fn [combined-method around-method]
(with-meta (partial around-method combined-method) (meta around-method)))
combined-method
around-methods))
;;;; #### Helpers for implementing `transform-fn-tail`
(defn transform-fn-tail
"Transform `fn-tail` using f, a function that operates on a single `([params*] expr*)` form. For single-arity
functions, this applies `f` directly to `fn-tail`; for functions overloaded with multiple arities, this maps `f`
across all arities."
[f fn-tail]
{:pre [(sequential? fn-tail)]}
(cond
(vector? (first fn-tail))
(apply f fn-tail)
(vector? (ffirst fn-tail))
(map (partial transform-fn-tail f) fn-tail)
:else
(throw (ex-info (format "Invalid fn tail: %s. Expected ([arg*] & body) or (([arg*] & body)+)"
(pr-str fn-tail))
{:f f, :fn-tail fn-tail}))))
(defn add-implicit-arg
"Add an implicit `arg` to the beginning of the arglists for every arity of `fn-tail`."
[arg fn-tail]
(transform-fn-tail
(fn [bindings & body]
(cons (into [arg] bindings) body))
fn-tail))
(defn add-implicit-next-method-args
"Add an implicit `next-method` arg to the beginning of primary and `:around` fn tails; `:before` and `:after` tails
are left as-is."
[qualifier fn-tail]
(case qualifier
nil (add-implicit-arg 'next-method fn-tail)
:before fn-tail
:after fn-tail
:around (add-implicit-arg 'next-method fn-tail)))