/
instrument.clj
151 lines (134 loc) · 7.09 KB
/
instrument.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
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
(ns malli.instrument
(:require [clojure.walk :as walk]
[malli.core :as m]
[malli.generator :as mg]))
(defn -find-var [n s] (find-var (symbol (str n "/" s))))
(defn -sequential [x] (cond (set? x) x (sequential? x) x :else [x]))
(defn -original [v] (let [f (deref v)] (-> f meta ::original (or f))))
(defn -filter-ns [& ns] (fn [n _ _] ((set ns) n)))
(defn -filter-var [f] (fn [n s _] (f (-find-var n s))))
(defn -filter-schema [f] (fn [_ _ {:keys [schema]}] (f schema)))
(defn -strument!
([] (-strument! nil))
([{:keys [mode data filters gen report] :or {mode :instrument, data (m/function-schemas)} :as options}]
(doall
(for [[n d] data, [s d] d]
(when (or (not filters) (some #(% n s d) filters))
(when-let [v (-find-var n s)]
(case mode
:instrument (let [dgen (as-> (merge (select-keys options [:scope :report :gen]) d) $
(cond-> $ report (update :report (fn [r] (fn [t data] (r t (assoc data :fn-name (symbol (name n) (name s))))))))
(cond (and gen (true? (:gen d))) (assoc $ :gen gen)
(true? (:gen d)) (dissoc $ :gen)
:else $))]
(alter-var-root v (fn [f] (-> (m/-instrument dgen f) (with-meta {::original f})))))
:unstrument (alter-var-root v (fn [f] (-> f meta ::original (or f))))
(mode v d))
v))))))
(defn -schema [v]
(let [{:keys [malli/schema arglists]} (meta v)]
(or schema (as-> (seq (keep (comp :malli/schema meta) arglists)) $
(when (= (count arglists) (count $)) (cond->> $ (next $) (into [:function])))))))
(defn -collect! [v]
(let [{:keys [ns name] :as m} (meta v)]
(when-let [s (-schema v)] (m/-register-function-schema! (-> ns str symbol) name s (m/-unlift-keys m "malli")))))
(defn clj-collect!
([] (clj-collect! {:ns *ns*}))
([{:keys [ns]}]
(not-empty (reduce (fn [acc v] (let [v (-collect! v)] (cond-> acc v (conj v)))) #{} (vals (mapcat ns-publics (-sequential ns)))))))
;;
;; CLJS macro for collecting function schemas
;;
(let [cljs-find-ns (fn [env] (when (:ns env) (ns-resolve 'cljs.analyzer.api 'find-ns)))
cljs-ns-interns (fn [env] (when (:ns env) (ns-resolve 'cljs.analyzer.api 'ns-interns)))]
(defn -cljs-collect!* [env simple-name {:keys [meta] :as var-map}]
;; when collecting google closure or other js code symbols will not have namespaces
(when (namespace (:name var-map))
(let [ns (symbol (namespace (:name var-map)))
find-ns' (cljs-find-ns env)
ns-interns' (cljs-ns-interns env)
schema (:malli/schema meta)]
(when schema
(let [-qualify-sym (fn [form]
(if (symbol? form)
(if (simple-symbol? form)
(let [ns-data (find-ns' ns)
intern-keys (set (keys (ns-interns' ns)))]
(cond
;; a referred symbol
(get-in ns-data [:uses form])
(let [form-ns (str (get-in ns-data [:uses form]))]
(symbol form-ns (str form)))
;; interned var
(contains? intern-keys form)
(symbol (str ns) (str form))
:else
;; a cljs.core var, do not qualify it
form))
(let [ns-part (symbol (namespace form))
name-part (name form)
full-ns (get-in (find-ns' ns) [:requires ns-part])]
(symbol (str full-ns) name-part)))
form))
schema* (walk/postwalk -qualify-sym schema)
metadata (assoc
(walk/postwalk -qualify-sym (m/-unlift-keys meta "malli"))
:metadata-schema? true)]
`(do
(m/-register-function-schema! '~ns '~simple-name ~schema* ~metadata :cljs identity)
'~(:name var-map))))))))
(defmacro cljs-collect!
([] `(cljs-collect! ~{:ns (symbol (str *ns*))}))
([opts]
(let [ns-publics' (when (:ns &env) (ns-resolve 'cljs.analyzer.api 'ns-publics))]
(reduce (fn [acc [var-name var-map]] (let [v (-cljs-collect!* &env var-name var-map)] (cond-> acc v (conj v))))
#{}
(mapcat (fn [n]
(let [ns-sym (cond (symbol? n) n
;; handles (quote ns-name) - quoted symbols passed to cljs macros show up this way.
(list? n) (second n)
:else (symbol (str n)))]
(ns-publics' ns-sym)))
;; support quoted vectors of ns symbols in cljs
(let [nses (:ns opts)
nses (if (and (= 'quote (first nses)) (coll? (second nses)))
(second nses)
nses)]
(-sequential nses)))))))
;;
;; public api
;;
(defn check
"Checks all registered function schemas using generative testing.
Returns nil or a map of symbol -> explanation in case of errors."
([] (check nil))
([options]
(let [res* (atom {})]
(-strument! (assoc options :mode (fn [v {:keys [schema]}]
(some->> (mg/check schema (-original v))
(swap! res* assoc (symbol v))))))
(not-empty @res*))))
(defmacro collect!
"Reads all public Vars from a given namespace(s) and registers a function (var) schema if `:malli/schema`
metadata is present. The following metadata key can be used:
| key | description |
| ----------------|-------------|
| `:malli/schema` | function schema
| `:malli/scope` | optional set of scope definitions, defaults to `#{:input :output}`
| `:malli/report` | optional side-effecting function of `key data -> any` to report problems, defaults to `m/-fail!`
| `:malli/gen` | optional value `true` or function of `schema -> schema -> value` to be invoked on the args to get the return value"
([] `(collect! {:ns (symbol (str ~'*ns*))}))
([opts]
(if (:ns &env)
`(cljs-collect! ~opts)
`(clj-collect! ~opts))))
(defn instrument!
"Applies instrumentation for a filtered set of function Vars (e.g. `defn`s).
See [[malli.core/-instrument]] for possible options."
([] (instrument! nil))
([options] (-strument! (assoc options :mode :instrument))))
(defn unstrument!
"Removes instrumentation from a filtered set of function Vars (e.g. `defn`s).
See [[malli.core/-instrument]] for possible options."
([] (unstrument! nil))
([options] (-strument! (assoc options :mode :unstrument))))