-
Notifications
You must be signed in to change notification settings - Fork 204
/
instrument.clj
77 lines (67 loc) · 3.54 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
(ns malli.instrument
(:require [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] (::original-fn (meta v)))
(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] :or {mode :instrument, data (m/function-schemas)} :as options}]
(doseq [[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 [original-fn (or (-original v) (deref v))
dgen (as-> (merge (select-keys options [:scope :report :gen]) d) $
(cond (and gen (true? (:gen d))) (assoc $ :gen gen)
(true? (:gen d)) (dissoc $ :gen)
:else $))]
(alter-meta! v assoc ::original-fn original-fn)
(alter-var-root v (constantly (m/-instrument dgen original-fn)))
(println "..instrumented" v))
:unstrument (when-let [original-fn (-original v)]
(alter-meta! v dissoc ::original-fn)
(alter-var-root v (constantly original-fn))
(println "..unstrumented" v))
(mode v d)))))))
(defn -collect! [v]
(let [{:keys [ns name malli/schema] :as meta} (meta v)]
(when schema (m/-register-function-schema! (-> ns str symbol) name schema (m/-unlift-keys meta "malli")) v)))
;;
;; 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 (or (-original v) (deref v)))
(swap! res* assoc (symbol v))))))
(not-empty @res*))))
(defn 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 *ns*}))
([{:keys [ns]}]
(not-empty (reduce (fn [acc v] (let [v (-collect! v)] (cond-> acc v (conj v)))) #{} (vals (mapcat ns-publics (-sequential ns)))))))
(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))))