/
common.clj
53 lines (47 loc) · 1.85 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
(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]
(partial primary-method next-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]
(partial around-method combined-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]
(if (vector? (first fn-tail))
(apply f fn-tail)
(map f 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)))