-
Notifications
You must be signed in to change notification settings - Fork 0
/
dot_slash_2.clj
125 lines (113 loc) · 4.26 KB
/
dot_slash_2.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
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
(ns com.gfredericks.dot-slash-2)
(try
(require '[clojure.spec.alpha :as s])
(require 'com.gfredericks.dot-slash-2.specs)
(eval
'(do
(defn valid? [spec] (s/valid? ::spec spec))
(defn explain [spec] (s/explain ::spec spec))))
(catch Exception e
(eval
'(do
(defn valid? [spec] true)
(defn explain [spec]
(assert false "unreachable"))))))
(defn ^:private normalize
[sym-or-map]
(if (symbol? sym-or-map)
{:var sym-or-map}
sym-or-map))
(defn ^:private require-and-resolve
[sym]
(let [ns-sym (symbol (namespace sym))]
(try
(require ns-sym)
(catch Exception e
(throw (Exception. (format "dot-slash-2 failed to require %s"
ns-sym)
e))))
(or (resolve sym)
(throw (Exception. (format "dot-slash-2 failed to resolve %s"
sym))))))
(defn ^:private sync-changes
[proxy-var underlying-var]
(add-watch underlying-var (gensym "dot-slash-2")
(fn [_ _ _ new]
(alter-var-root proxy-var (constantly new))
(alter-meta! proxy-var merge (meta underlying-var)))))
(defn ^:private set-dynamic-docstring
[proxy-var underlying-var]
(alter-meta! proxy-var assoc :doc
(format "Proxy to %s\n\nOriginal docs:\n\n%s\n%s"
underlying-var
(pr-str (:arglists (meta underlying-var)))
(:doc (meta underlying-var)))))
(defn ^:private setup-var
[underlying-symbol new-var dynamic? lazy? macro?]
(if lazy?
(let [root-value
(if dynamic?
(let [d (delay (set-dynamic-docstring
new-var
(require-and-resolve underlying-symbol)))]
(fn dynamic-var-proxy [& args]
(force d)
(apply (require-and-resolve underlying-symbol) args)))
(fn one-time-lazy-stub [& args]
(let [underlying-var (require-and-resolve underlying-symbol)]
(alter-var-root new-var (constantly @underlying-var))
(sync-changes new-var underlying-var)
(apply @new-var args))))]
(doto new-var
(alter-var-root (constantly root-value))
(cond-> macro? .setMacro)))
(let [underlying-var (delay (require-and-resolve underlying-symbol))]
(and
(try
(deref underlying-var)
(catch Exception e
(binding [*out* *err*]
(printf "WARNING: %s\n(calls to %s will fail)\n"
(.getMessage e)
new-var))
(alter-var-root new-var
(constantly
(fn ex-rethrower [& args] (deref underlying-var))))
false))
(let [underlying-var @underlying-var
root-value (if dynamic?
(fn [& args]
(apply (require-and-resolve underlying-symbol) args))
@underlying-var)]
(doto new-var
(alter-var-root (constantly root-value))
(alter-meta! merge (meta underlying-var))
(cond-> (.isMacro underlying-var) .setMacro)
(cond-> dynamic? (set-dynamic-docstring underlying-var))
(cond-> (not dynamic?) (sync-changes underlying-var))))))))
(defn !
"Defines namespaces and proxy vars based on the given spec.
E.g.:
'{. [clojure.test/run-tests
clojure.repl/doc]}
will create (if necessary) a namespace called ., containing
a function called run-tests and a macro called doc."
;; TODO:
;; - renaming
;; - laziness
[spec]
(if (valid? spec)
(doseq [[ns-name vars-and-things] spec]
(create-ns ns-name)
(doseq [sym-or-map vars-and-things
:let [{sym :var
proxy-name :name
:keys [dynamic? lazy? macro?]}
(normalize sym-or-map)
its-ns (symbol (namespace sym))
proxy-name (or proxy-name (symbol (name sym)))
new-var (intern ns-name proxy-name)]]
(setup-var sym new-var dynamic? lazy? macro?)))
(binding [*out* *err*]
(println "Bad arg to dot-slash-2/!:")
(explain spec))))