status-im
/
timbre
mirror of https://github.com/status-im/timbre.git
2
0
Fork 0
Code Issues Projects Releases Wiki Activity

Add `profiling/fnp` macro

This commit is contained in:
Peter Taoussanis 2015-07-03 17:31:12 +07:00
parent 28ccfc1565
commit a64fb0f1d5
1 changed files with 44 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
src/taoensso/timbre/profiling.clj
View File

@ -207,28 +207,55 @@
;;;;
(defmacro fnp "Like `fn` but wraps fn bodies with `p` macro."
{:arglists '([name? [params*] prepost-map? body]
[name? ([params*] prepost-map? body)+])}
[& sigs]
(let [[?fn-name sigs]
(if (symbol? (first sigs)) [(first sigs) (next sigs)] ['anonymous-fn sigs])
single-arity? (vector? (first sigs))
[sigs get-pid]
(if single-arity?
[(list sigs) (fn [?fn-name _params] (name ?fn-name))]
[sigs (fn [?fn-name params] (str (name ?fn-name) \_ (count params)))])
new-sigs
(map
(fn [[params & others]]
(let [has-prepost-map? (and (map? (first others)) (next others))
[prepost-map & body] (if has-prepost-map? others (cons {} others))]
`(~params ~prepost-map (pspy ~(get-pid ?fn-name params) ~@body))))
sigs)]
(if ?fn-name
`(fn ~?fn-name ~@new-sigs)
`(fn ~@new-sigs))))
(comment
(macroexpand '(fnp [x] {:pre [x]} (* x x)))
(macroexpand '(fn [x] {:pre [x]} (* x x))))
(defmacro defnp "Like `defn` but wraps fn bodies with `p` macro."
{:arglists
'([name doc-string? attr-map? [params*] prepost-map? body]
[name doc-string? attr-map? ([params*] prepost-map? body)+ attr-map?])}
[name' & sigs]
(let [[name' sigs] (enc/name-with-attrs name' sigs)
[& sigs]
(let [[fn-name sigs] (enc/name-with-attrs (first sigs) (next sigs))
single-arity? (vector? (first sigs))
[sigs func->str]
[sigs get-pid]
(if single-arity?
[(list sigs) (fn [name' _params] (name name'))]
[sigs (fn [name' params] (str (name name') \_ (count params)))])
[(list sigs) (fn [fn-name _params] (name fn-name))]
[sigs (fn [fn-name params] (str (name fn-name) \_ (count params)))])
new-sigs
(map (fn [[params & others]]
(map
(fn [[params & others]]
(let [has-prepost-map? (and (map? (first others)) (next others))
[prepost-map & body]
(if has-prepost-map?
others
(cons {} others))]
`(~params ~prepost-map (pspy ~(func->str name' params) ~@body))))
[prepost-map & body] (if has-prepost-map? others (cons {} others))]
`(~params ~prepost-map (pspy ~(get-pid fn-name params) ~@body))))
sigs)]
`(defn ~name' ~@new-sigs)))
`(defn ~fn-name ~@new-sigs)))
(comment
(defnp foo "Docstring "[x] "boo" (* x x))