luciano/telemere
1
0
Fork 0
mirror of https://github.com/taoensso/telemere.git synced 2025-12-17 09:51:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 6

[fix] More robust mechanism for retaining nested macro callsite info

Browse source
This commit is contained in:
Peter Taoussanis 2024-08-27 16:54:03 +02:00
parent 0e4942e99c
commit 0f09b797ed
3 changed files with 70 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
projects/main/src/taoensso/telemere.cljc
View file

@ -213,8 +213,10 @@
{:doc (impl/signal-docstring :event!) {:doc (impl/signal-docstring :event!)
:arglists (impl/signal-arglists :event!)} :arglists (impl/signal-arglists :event!)}
[& args] [& args]
(let [opts (impl/signal-opts `event! {:kind :event, :level :info} :id :level :dsc args)] (let [opts
(enc/keep-callsite `(impl/signal! ~opts))))) (impl/signal-opts `event! (enc/get-source &form &env)
{:kind :event, :level :info} :id :level :dsc args)]
`(impl/signal! ~opts))))
(comment (with-signal (event! ::my-id :info))) (comment (with-signal (event! ::my-id :info)))
@ -224,8 +226,10 @@
{:doc (impl/signal-docstring :log!) {:doc (impl/signal-docstring :log!)
:arglists (impl/signal-arglists :log!)} :arglists (impl/signal-arglists :log!)}
[& args] [& args]
(let [opts (impl/signal-opts `log! {:kind :log, :level :info} :msg :level :asc args)] (let [opts
(enc/keep-callsite `(impl/signal! ~opts))))) (impl/signal-opts `log! (enc/get-source &form &env)
{:kind :log, :level :info} :msg :level :asc args)]
`(impl/signal! ~opts))))
(comment (with-signal (log! :info "My msg"))) (comment (with-signal (log! :info "My msg")))
@ -235,14 +239,15 @@
{:doc (impl/signal-docstring :error!) {:doc (impl/signal-docstring :error!)
:arglists (impl/signal-arglists :error!)} :arglists (impl/signal-arglists :error!)}
[& args] [& args]
(let [opts (impl/signal-opts `error! {:kind :error, :level :error} :error :id :asc args) (let [opts
(impl/signal-opts `error! (enc/get-source &form &env)
{:kind :error, :level :error} :error :id :asc args)
error-form (get opts :error)] error-form (get opts :error)]
(enc/keep-callsite `(let [~'__error ~error-form]
`(let [~'__error ~error-form] (impl/signal! ~(assoc opts :error '__error))
(impl/signal! ~(assoc opts :error '__error)) ~'__error ; Unconditional!
~'__error ; Unconditional! ))))
)))))
(comment (with-signal (throw (error! ::my-id (ex-info "MyEx" {}))))) (comment (with-signal (throw (error! ::my-id (ex-info "MyEx" {})))))
@ -252,18 +257,20 @@
{:doc (impl/signal-docstring :catch-to-error!) {:doc (impl/signal-docstring :catch-to-error!)
:arglists (impl/signal-arglists :catch->error!)} :arglists (impl/signal-arglists :catch->error!)}
[& args] [& args]
(let [opts (impl/signal-opts `catch->error! {:kind :error, :level :error} ::__form :id :asc args) (let [opts
(impl/signal-opts `catch->error! (enc/get-source &form &env)
{:kind :error, :level :error} ::__form :id :asc args)
rethrow? (if (contains? opts :catch-val) false (get opts :rethrow? true)) rethrow? (if (contains? opts :catch-val) false (get opts :rethrow? true))
catch-val (get opts :catch-val) catch-val (get opts :catch-val)
catch-sym (get opts :catch-sym '__caught-error) ; Undocumented catch-sym (get opts :catch-sym '__caught-error) ; Undocumented
form (get opts ::__form) form (get opts ::__form)
opts (dissoc opts ::__form :catch-val :catch-sym :rethrow?)] opts (dissoc opts ::__form :catch-val :catch-sym :rethrow?)]
(enc/keep-callsite `(enc/try* ~form
`(enc/try* ~form (catch :all ~catch-sym
(catch :all ~catch-sym (impl/signal! ~(assoc opts :error catch-sym))
(impl/signal! ~(assoc opts :error catch-sym)) (if ~rethrow? (throw ~catch-sym) ~catch-val))))))
(if ~rethrow? (throw ~catch-sym) ~catch-val)))))))
(comment (comment
(with-signal (catch->error! ::my-id (/ 1 0))) (with-signal (catch->error! ::my-id (/ 1 0)))
@ -277,17 +284,16 @@
:arglists (impl/signal-arglists :trace!)} :arglists (impl/signal-arglists :trace!)}
[& args] [& args]
(let [opts (let [opts
(impl/signal-opts `trace! (impl/signal-opts `trace! (enc/get-source &form &env)
{:location (enc/get-source &form &env) ; For catch-opts {:kind :trace, :level :info, :msg `impl/default-trace-msg}
:kind :trace, :level :info, :msg `impl/default-trace-msg}
:run :id :asc args) :run :id :asc args)
;; :catch->error <id-or-opts> currently undocumented ;; :catch->error <id-or-opts> currently undocumented
[opts catch-opts] (impl/signal-catch-opts opts)] [opts catch-opts] (impl/signal-catch-opts opts)]
(if catch-opts (if catch-opts
(enc/keep-callsite `(catch->error! ~catch-opts (impl/signal! ~opts))) `(catch->error! ~catch-opts (impl/signal! ~opts))
(enc/keep-callsite `(impl/signal! ~opts)))))) (do `(impl/signal! ~opts))))))
(comment (comment
(with-signal (trace! ::my-id (+ 1 2))) (with-signal (trace! ::my-id (+ 1 2)))
@ -304,17 +310,16 @@
:arglists (impl/signal-arglists :spy!)} :arglists (impl/signal-arglists :spy!)}
[& args] [& args]
(let [opts (let [opts
(impl/signal-opts `spy! (impl/signal-opts `spy! (enc/get-source &form &env)
{:location (enc/get-source &form &env) ; For catch-opts {:kind :spy, :level :info, :msg `impl/default-trace-msg}
:kind :spy, :level :info, :msg `impl/default-trace-msg}
:run :level :asc args) :run :level :asc args)
;; :catch->error <id-or-opts> currently undocumented ;; :catch->error <id-or-opts> currently undocumented
[opts catch-opts] (impl/signal-catch-opts opts)] [opts catch-opts] (impl/signal-catch-opts opts)]
(if catch-opts (if catch-opts
(enc/keep-callsite `(catch->error! ~catch-opts (impl/signal! ~opts))) `(catch->error! ~catch-opts (impl/signal! ~opts))
(enc/keep-callsite `(impl/signal! ~opts)))))) (do `(impl/signal! ~opts))))))
(comment (with-signal :force (spy! :info (+ 1 2)))) (comment (with-signal :force (spy! :info (+ 1 2))))
@ -328,14 +333,13 @@
[& args] [& args]
(let [msg-form ["Uncaught Throwable on thread: " `(.getName ~(with-meta '__thread {:tag 'java.lang.Thread}))] (let [msg-form ["Uncaught Throwable on thread: " `(.getName ~(with-meta '__thread {:tag 'java.lang.Thread}))]
opts opts
(impl/signal-opts `uncaught->error! (impl/signal-opts `uncaught->error! (enc/get-source &form &env)
{:kind :error, :level :error, :msg msg-form} {:kind :error, :level :error, :msg msg-form}
:error :id :dsc (into ['__throwable] args))] :error :id :dsc (into ['__throwable] args))]
(enc/keep-callsite `(uncaught->handler!
`(uncaught->handler! (fn [~'__thread ~'__throwable]
(fn [~'__thread ~'__throwable] (impl/signal! ~opts))))))
(impl/signal! ~opts)))))))
(comment (macroexpand '(uncaught->error! ::my-id))) (comment (macroexpand '(uncaught->error! ::my-id)))

49
projects/main/src/taoensso/telemere/impl.cljc
View file

@ -372,7 +372,7 @@
:signal! ; [opts] => allowed? / run result (value or throw) :signal! ; [opts] => allowed? / run result (value or throw)
'([{:as opts :keys '([{:as opts :keys
[#_defaults #_elide? #_allow? #_expansion-id, ; Undocumented [#_defaults #_elide? #_allow? #_expansion-id, ; Undocumented
elidable? location inst uid middleware, elidable? location #_location* inst uid middleware,
sample-rate kind ns id level when rate-limit, sample-rate kind ns id level when rate-limit,
ctx parent root trace?, do let data msg error run & kvs]}]) ctx parent root trace?, do let data msg error run & kvs]}])
@ -382,7 +382,7 @@
[id [id
{:as opts :keys {:as opts :keys
[#_defaults #_elide? #_allow? #_expansion-id, [#_defaults #_elide? #_allow? #_expansion-id,
elidable? location inst uid middleware, elidable? location #_location* inst uid middleware,
sample-rate kind ns id level when rate-limit, sample-rate kind ns id level when rate-limit,
ctx parent root trace?, do let data msg error #_run & kvs]}]) ctx parent root trace?, do let data msg error #_run & kvs]}])
@ -391,7 +391,7 @@
[level msg] [level msg]
[{:as opts :keys [{:as opts :keys
[#_defaults #_elide? #_allow? #_expansion-id, [#_defaults #_elide? #_allow? #_expansion-id,
elidable? location inst uid middleware, elidable? location #_location* inst uid middleware,
sample-rate kind ns id level when rate-limit, sample-rate kind ns id level when rate-limit,
ctx parent root trace?, do let data msg error #_run & kvs]} ctx parent root trace?, do let data msg error #_run & kvs]}
msg]) msg])
@ -401,7 +401,7 @@
[id error] [id error]
[{:as opts :keys [{:as opts :keys
[#_defaults #_elide? #_allow? #_expansion-id, [#_defaults #_elide? #_allow? #_expansion-id,
elidable? location inst uid middleware, elidable? location #_location* inst uid middleware,
sample-rate kind ns id level when rate-limit, sample-rate kind ns id level when rate-limit,
ctx parent root trace?, do let data msg error #_run & kvs]} ctx parent root trace?, do let data msg error #_run & kvs]}
error]) error])
@ -411,7 +411,7 @@
[id form] [id form]
[{:as opts :keys [{:as opts :keys
[#_defaults #_elide? #_allow? #_expansion-id, [#_defaults #_elide? #_allow? #_expansion-id,
elidable? location inst uid middleware, elidable? location #_location* inst uid middleware,
sample-rate kind ns id level when rate-limit, sample-rate kind ns id level when rate-limit,
ctx parent root trace?, do let data msg error run & kvs]} ctx parent root trace?, do let data msg error run & kvs]}
form]) form])
@ -421,7 +421,7 @@
[id form] [id form]
[{:as opts :keys [{:as opts :keys
[#_defaults #_elide? #_allow? #_expansion-id, rethrow? catch-val, [#_defaults #_elide? #_allow? #_expansion-id, rethrow? catch-val,
elidable? location inst uid middleware, elidable? location #_location* inst uid middleware,
sample-rate kind ns id level when rate-limit, sample-rate kind ns id level when rate-limit,
ctx parent root trace?, do let data msg error #_run & kvs]} ctx parent root trace?, do let data msg error #_run & kvs]}
form]) form])
@ -431,7 +431,7 @@
[id] [id]
[{:as opts :keys [{:as opts :keys
[#_defaults #_elide? #_allow? #_expansion-id, [#_defaults #_elide? #_allow? #_expansion-id,
elidable? location inst uid middleware, elidable? location #_location* inst uid middleware,
sample-rate kind ns id level when rate-limit, sample-rate kind ns id level when rate-limit,
ctx parent root trace?, do let data msg error #_run & kvs]}]) ctx parent root trace?, do let data msg error #_run & kvs]}])
@ -440,8 +440,7 @@
#?(:clj #?(:clj
(defn signal-opts (defn signal-opts
"Util to help write common signal wrapper macros." "Util to help write common signal wrapper macros."
[context defaults main-key extra-key arg-order args] [context location* defaults main-key extra-key arg-order args]
(enc/cond (enc/cond
:let [context-name (str "`" (name context) "`") :let [context-name (str "`" (name context) "`")
num-args (count args) num-args (count args)
@ -476,11 +475,12 @@
(and extra-opts? (contains? extra-arg main-key)) (and extra-opts? (contains? extra-arg main-key))
(bad-args! (str "given opts should not contain `" main-key "`.") {})) (bad-args! (str "given opts should not contain `" main-key "`.") {}))
extra-opts? (merge defaults {main-key main-arg} extra-arg) :let [base (merge defaults {:location* location*, main-key main-arg})]
extra-arg? (merge defaults {main-key main-arg, extra-key extra-arg}) extra-opts? (merge base extra-arg)
:else (merge defaults {main-key main-arg})))) extra-arg? (merge base {extra-key extra-arg})
:else base)))
(comment (signal-opts `foo! {:level :info} :id :level :dsc [::my-id {:level :warn}])) (comment (signal-opts `foo! :loc* {:level :info} :id :level :dsc [::my-id {:level :warn}]))
#?(:clj #?(:clj
(defn signal-catch-opts (defn signal-catch-opts
@ -492,8 +492,8 @@
(when catch-id-or-opts (when catch-id-or-opts
(let [base ; Inherit some opts from main (let [base ; Inherit some opts from main
(enc/assoc-some {} (enc/assoc-some {}
:location (get main-opts :location) :location* (get main-opts :location*)
:id (get main-opts :id))] :id (get main-opts :id))]
(cond (cond
(true? catch-id-or-opts) (do base) (true? catch-id-or-opts) (do base)
(map? catch-id-or-opts) (conj base catch-id-or-opts) (map? catch-id-or-opts) (conj base catch-id-or-opts)
@ -545,13 +545,13 @@
{:keys [#_expansion-id location elide? allow?]} {:keys [#_expansion-id location elide? allow?]}
(sigs/filterable-expansion (sigs/filterable-expansion
{:macro-form &form {:sf-arity 4
:macro-env &env
:sf-arity 4
:ct-sig-filter ct-sig-filter :ct-sig-filter ct-sig-filter
:*rt-sig-filter* `*rt-sig-filter*} :*rt-sig-filter* `*rt-sig-filter*}
(assoc opts :bound-forms (assoc opts
:location* (get opts :location* (enc/get-source &form &env))
:bound-forms
{:kind '__kind {:kind '__kind
:ns '__ns :ns '__ns
:id '__id :id '__id
@ -603,9 +603,9 @@
kvs-form kvs-form
(not-empty (not-empty
(dissoc opts (dissoc opts
:elidable? :location :inst :uid :middleware, :elidable? :location :location* :inst :uid :middleware,
:sample-rate :ns :kind :id :level :filter :when #_:rate-limit, :sample-rate :ns :kind :id :level :filter :when #_:rate-limit,
:ctx :parent #_:trace?, :do :let :data :msg :error :run :ctx :parent #_:trace?, :do :let :data :msg :error :run,
:elide? :allow? #_:expansion-id :otel/context)) :elide? :allow? #_:expansion-id :otel/context))
_ ; Compile-time validation _ ; Compile-time validation
@ -763,12 +763,11 @@
[opts] [opts]
(let [{:keys [#_expansion-id #_location elide? allow?]} (let [{:keys [#_expansion-id #_location elide? allow?]}
(sigs/filterable-expansion (sigs/filterable-expansion
{:macro-form &form {:sf-arity 4
:macro-env &env
:sf-arity 4
:ct-sig-filter ct-sig-filter :ct-sig-filter ct-sig-filter
:*rt-sig-filter* `*rt-sig-filter*} :*rt-sig-filter* `*rt-sig-filter*}
opts)] (assoc opts :location*
(get opts :location* (enc/get-source &form &env))))]
(and (not elide?) allow?)))) (and (not elide?) allow?))))

22
projects/main/test/taoensso/telemere_tests.cljc
View file

@ -552,20 +552,20 @@
(deftest _common-signals (deftest _common-signals
[#?(:clj [#?(:clj
(testing "signal-opts" (testing "signal-opts"
[(is (= (impl/signal-opts `foo! {:level :info} :id :level :dsc [::my-id ]) {:level :info, :id ::my-id})) [(is (= (impl/signal-opts `foo! :loc* {:level :info} :id :level :dsc [::my-id ]) {:level :info, :id ::my-id, :location* :loc*}))
(is (= (impl/signal-opts `foo! {:level :info} :id :level :dsc [::my-id :warn ]) {:level :warn, :id ::my-id})) (is (= (impl/signal-opts `foo! :loc* {:level :info} :id :level :dsc [::my-id :warn ]) {:level :warn, :id ::my-id, :location* :loc*}))
(is (= (impl/signal-opts `foo! {:level :info} :id :level :dsc [::my-id {:level :warn}]) {:level :warn, :id ::my-id})) (is (= (impl/signal-opts `foo! :loc* {:level :info} :id :level :dsc [::my-id {:level :warn}]) {:level :warn, :id ::my-id, :location* :loc*}))
(is (= (impl/signal-opts `foo! {:level :info} :id :level :asc [ ::my-id]) {:level :info, :id ::my-id})) (is (= (impl/signal-opts `foo! :loc* {:level :info} :id :level :asc [ ::my-id]) {:level :info, :id ::my-id, :location* :loc*}))
(is (= (impl/signal-opts `foo! {:level :info} :id :level :asc [:warn ::my-id]) {:level :warn, :id ::my-id})) (is (= (impl/signal-opts `foo! :loc* {:level :info} :id :level :asc [:warn ::my-id]) {:level :warn, :id ::my-id, :location* :loc*}))
(is (= (impl/signal-opts `foo! {:level :info} :id :level :asc [{:level :warn} ::my-id]) {:level :warn, :id ::my-id})) (is (= (impl/signal-opts `foo! :loc* {:level :info} :id :level :asc [{:level :warn} ::my-id]) {:level :warn, :id ::my-id, :location* :loc*}))
(is (= (impl/signal-catch-opts {:id :main-id, :location {:ns "ns"}, :catch->error true}) [{:id :main-id, :location {:ns "ns"}} {:location {:ns "ns"}, :id :main-id}])) (is (= (impl/signal-catch-opts {:id :main-id, :location* {:ns "ns"}, :catch->error true}) [{:id :main-id, :location* {:ns "ns"}} {:location* {:ns "ns"}, :id :main-id}]))
(is (= (impl/signal-catch-opts {:id :main-id, :location {:ns "ns"}, :catch->error :error-id}) [{:id :main-id, :location {:ns "ns"}} {:location {:ns "ns"}, :id :error-id}])) (is (= (impl/signal-catch-opts {:id :main-id, :location* {:ns "ns"}, :catch->error :error-id}) [{:id :main-id, :location* {:ns "ns"}} {:location* {:ns "ns"}, :id :error-id}]))
(is (= (impl/signal-catch-opts {:id :main-id, :location {:ns "ns"}, :catch->error {:id :error-id}}) [{:id :main-id, :location {:ns "ns"}} {:location {:ns "ns"}, :id :error-id}])) (is (= (impl/signal-catch-opts {:id :main-id, :location* {:ns "ns"}, :catch->error {:id :error-id}}) [{:id :main-id, :location* {:ns "ns"}} {:location* {:ns "ns"}, :id :error-id}]))
(is (throws? :ex-info "Invalid `foo!` args: single map arg is USUALLY a mistake" (impl/signal-opts `foo! {:level :info} :id :level :dsc [{:msg "msg"}]))) (is (throws? :ex-info "Invalid `foo!` args: single map arg is USUALLY a mistake" (impl/signal-opts `foo! :loc* {:level :info} :id :level :dsc [{:msg "msg"}])))
(is (throws? :ex-info "Invalid `foo!` args: given opts should not contain `:id`" (impl/signal-opts `foo! {:level :info} :id :level :dsc [:my-id1 {:id ::my-id2}])))])) (is (throws? :ex-info "Invalid `foo!` args: given opts should not contain `:id`" (impl/signal-opts `foo! :loc* {:level :info} :id :level :dsc [:my-id1 {:id ::my-id2}])))]))
(testing "event!" ; id + ?level => allowed? (testing "event!" ; id + ?level => allowed?
[(let [[[rv] [sv]] (with-sigs (tel/event! :id1 ))] [(is (= rv true)) (is (sm? sv {:kind :event, :line :submap/some, :level :info, :id :id1}))]) [(let [[[rv] [sv]] (with-sigs (tel/event! :id1 ))] [(is (= rv true)) (is (sm? sv {:kind :event, :line :submap/some, :level :info, :id :id1}))])