mirror of
https://github.com/taoensso/telemere.git
synced 2025-12-16 17:41:12 +00:00
[fix] More robust mechanism for retaining nested macro callsite info
This commit is contained in:
Peter Taoussanis
parent
0e4942e99c
commit
0f09b797ed
3 changed files with 70 additions and 67 deletions
|
|
@ -213,8 +213,10 @@
|
|||
{:doc (impl/signal-docstring :event!)
|
||||
:arglists (impl/signal-arglists :event!)}
|
||||
[& args]
|
||||
(let [opts (impl/signal-opts `event! {:kind :event, :level :info} :id :level :dsc args)]
|
||||
(enc/keep-callsite `(impl/signal! ~opts)))))
|
||||
(let [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)))
|
||||
|
||||
|
|
@ -224,8 +226,10 @@
|
|||
{:doc (impl/signal-docstring :log!)
|
||||
:arglists (impl/signal-arglists :log!)}
|
||||
[& args]
|
||||
(let [opts (impl/signal-opts `log! {:kind :log, :level :info} :msg :level :asc args)]
|
||||
(enc/keep-callsite `(impl/signal! ~opts)))))
|
||||
(let [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")))
|
||||
|
||||
|
|
@ -235,14 +239,15 @@
|
|||
{:doc (impl/signal-docstring :error!)
|
||||
:arglists (impl/signal-arglists :error!)}
|
||||
[& 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)]
|
||||
|
||||
(enc/keep-callsite
|
||||
`(let [~'__error ~error-form]
|
||||
(impl/signal! ~(assoc opts :error '__error))
|
||||
~'__error ; Unconditional!
|
||||
)))))
|
||||
`(let [~'__error ~error-form]
|
||||
(impl/signal! ~(assoc opts :error '__error))
|
||||
~'__error ; Unconditional!
|
||||
))))
|
||||
|
||||
(comment (with-signal (throw (error! ::my-id (ex-info "MyEx" {})))))
|
||||
|
||||
|
|
@ -252,18 +257,20 @@
|
|||
{:doc (impl/signal-docstring :catch-to-error!)
|
||||
:arglists (impl/signal-arglists :catch->error!)}
|
||||
[& 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))
|
||||
catch-val (get opts :catch-val)
|
||||
catch-sym (get opts :catch-sym '__caught-error) ; Undocumented
|
||||
form (get opts ::__form)
|
||||
opts (dissoc opts ::__form :catch-val :catch-sym :rethrow?)]
|
||||
|
||||
(enc/keep-callsite
|
||||
`(enc/try* ~form
|
||||
(catch :all ~catch-sym
|
||||
(impl/signal! ~(assoc opts :error catch-sym))
|
||||
(if ~rethrow? (throw ~catch-sym) ~catch-val)))))))
|
||||
`(enc/try* ~form
|
||||
(catch :all ~catch-sym
|
||||
(impl/signal! ~(assoc opts :error catch-sym))
|
||||
(if ~rethrow? (throw ~catch-sym) ~catch-val))))))
|
||||
|
||||
(comment
|
||||
(with-signal (catch->error! ::my-id (/ 1 0)))
|
||||
|
|
@ -277,17 +284,16 @@
|
|||
:arglists (impl/signal-arglists :trace!)}
|
||||
[& args]
|
||||
(let [opts
|
||||
(impl/signal-opts `trace!
|
||||
{:location (enc/get-source &form &env) ; For catch-opts
|
||||
:kind :trace, :level :info, :msg `impl/default-trace-msg}
|
||||
(impl/signal-opts `trace! (enc/get-source &form &env)
|
||||
{:kind :trace, :level :info, :msg `impl/default-trace-msg}
|
||||
:run :id :asc args)
|
||||
|
||||
;; :catch->error <id-or-opts> currently undocumented
|
||||
[opts catch-opts] (impl/signal-catch-opts opts)]
|
||||
|
||||
(if catch-opts
|
||||
(enc/keep-callsite `(catch->error! ~catch-opts (impl/signal! ~opts)))
|
||||
(enc/keep-callsite `(impl/signal! ~opts))))))
|
||||
`(catch->error! ~catch-opts (impl/signal! ~opts))
|
||||
(do `(impl/signal! ~opts))))))
|
||||
|
||||
(comment
|
||||
(with-signal (trace! ::my-id (+ 1 2)))
|
||||
|
|
@ -304,17 +310,16 @@
|
|||
:arglists (impl/signal-arglists :spy!)}
|
||||
[& args]
|
||||
(let [opts
|
||||
(impl/signal-opts `spy!
|
||||
{:location (enc/get-source &form &env) ; For catch-opts
|
||||
:kind :spy, :level :info, :msg `impl/default-trace-msg}
|
||||
(impl/signal-opts `spy! (enc/get-source &form &env)
|
||||
{:kind :spy, :level :info, :msg `impl/default-trace-msg}
|
||||
:run :level :asc args)
|
||||
|
||||
;; :catch->error <id-or-opts> currently undocumented
|
||||
[opts catch-opts] (impl/signal-catch-opts opts)]
|
||||
|
||||
(if catch-opts
|
||||
(enc/keep-callsite `(catch->error! ~catch-opts (impl/signal! ~opts)))
|
||||
(enc/keep-callsite `(impl/signal! ~opts))))))
|
||||
`(catch->error! ~catch-opts (impl/signal! ~opts))
|
||||
(do `(impl/signal! ~opts))))))
|
||||
|
||||
(comment (with-signal :force (spy! :info (+ 1 2))))
|
||||
|
||||
|
|
@ -328,14 +333,13 @@
|
|||
[& args]
|
||||
(let [msg-form ["Uncaught Throwable on thread: " `(.getName ~(with-meta '__thread {:tag 'java.lang.Thread}))]
|
||||
opts
|
||||
(impl/signal-opts `uncaught->error!
|
||||
(impl/signal-opts `uncaught->error! (enc/get-source &form &env)
|
||||
{:kind :error, :level :error, :msg msg-form}
|
||||
:error :id :dsc (into ['__throwable] args))]
|
||||
|
||||
(enc/keep-callsite
|
||||
`(uncaught->handler!
|
||||
(fn [~'__thread ~'__throwable]
|
||||
(impl/signal! ~opts)))))))
|
||||
`(uncaught->handler!
|
||||
(fn [~'__thread ~'__throwable]
|
||||
(impl/signal! ~opts))))))
|
||||
|
||||
(comment (macroexpand '(uncaught->error! ::my-id)))
|
||||
|
||||
|
|
|
|||
|
|
@ -372,7 +372,7 @@
|
|||
:signal! ; [opts] => allowed? / run result (value or throw)
|
||||
'([{:as opts :keys
|
||||
[#_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,
|
||||
ctx parent root trace?, do let data msg error run & kvs]}])
|
||||
|
||||
|
|
@ -382,7 +382,7 @@
|
|||
[id
|
||||
{:as opts :keys
|
||||
[#_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,
|
||||
ctx parent root trace?, do let data msg error #_run & kvs]}])
|
||||
|
||||
|
|
@ -391,7 +391,7 @@
|
|||
[level msg]
|
||||
[{:as opts :keys
|
||||
[#_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,
|
||||
ctx parent root trace?, do let data msg error #_run & kvs]}
|
||||
msg])
|
||||
|
|
@ -401,7 +401,7 @@
|
|||
[id error]
|
||||
[{:as opts :keys
|
||||
[#_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,
|
||||
ctx parent root trace?, do let data msg error #_run & kvs]}
|
||||
error])
|
||||
|
|
@ -411,7 +411,7 @@
|
|||
[id form]
|
||||
[{:as opts :keys
|
||||
[#_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,
|
||||
ctx parent root trace?, do let data msg error run & kvs]}
|
||||
form])
|
||||
|
|
@ -421,7 +421,7 @@
|
|||
[id form]
|
||||
[{:as opts :keys
|
||||
[#_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,
|
||||
ctx parent root trace?, do let data msg error #_run & kvs]}
|
||||
form])
|
||||
|
|
@ -431,7 +431,7 @@
|
|||
[id]
|
||||
[{:as opts :keys
|
||||
[#_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,
|
||||
ctx parent root trace?, do let data msg error #_run & kvs]}])
|
||||
|
||||
|
|
@ -440,8 +440,7 @@
|
|||
#?(:clj
|
||||
(defn signal-opts
|
||||
"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
|
||||
:let [context-name (str "`" (name context) "`")
|
||||
num-args (count args)
|
||||
|
|
@ -476,11 +475,12 @@
|
|||
(and extra-opts? (contains? extra-arg main-key))
|
||||
(bad-args! (str "given opts should not contain `" main-key "`.") {}))
|
||||
|
||||
extra-opts? (merge defaults {main-key main-arg} extra-arg)
|
||||
extra-arg? (merge defaults {main-key main-arg, extra-key extra-arg})
|
||||
:else (merge defaults {main-key main-arg}))))
|
||||
:let [base (merge defaults {:location* location*, main-key main-arg})]
|
||||
extra-opts? (merge base extra-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
|
||||
(defn signal-catch-opts
|
||||
|
|
@ -492,8 +492,8 @@
|
|||
(when catch-id-or-opts
|
||||
(let [base ; Inherit some opts from main
|
||||
(enc/assoc-some {}
|
||||
:location (get main-opts :location)
|
||||
:id (get main-opts :id))]
|
||||
:location* (get main-opts :location*)
|
||||
:id (get main-opts :id))]
|
||||
(cond
|
||||
(true? catch-id-or-opts) (do base)
|
||||
(map? catch-id-or-opts) (conj base catch-id-or-opts)
|
||||
|
|
@ -545,13 +545,13 @@
|
|||
|
||||
{:keys [#_expansion-id location elide? allow?]}
|
||||
(sigs/filterable-expansion
|
||||
{:macro-form &form
|
||||
:macro-env &env
|
||||
:sf-arity 4
|
||||
{:sf-arity 4
|
||||
:ct-sig-filter ct-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
|
||||
:ns '__ns
|
||||
:id '__id
|
||||
|
|
@ -603,9 +603,9 @@
|
|||
kvs-form
|
||||
(not-empty
|
||||
(dissoc opts
|
||||
:elidable? :location :inst :uid :middleware,
|
||||
:elidable? :location :location* :inst :uid :middleware,
|
||||
: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))
|
||||
|
||||
_ ; Compile-time validation
|
||||
|
|
@ -763,12 +763,11 @@
|
|||
[opts]
|
||||
(let [{:keys [#_expansion-id #_location elide? allow?]}
|
||||
(sigs/filterable-expansion
|
||||
{:macro-form &form
|
||||
:macro-env &env
|
||||
:sf-arity 4
|
||||
{:sf-arity 4
|
||||
:ct-sig-filter ct-sig-filter
|
||||
:*rt-sig-filter* `*rt-sig-filter*}
|
||||
opts)]
|
||||
(assoc opts :location*
|
||||
(get opts :location* (enc/get-source &form &env))))]
|
||||
|
||||
(and (not elide?) allow?))))
|
||||
|
||||
|
|
|
|||
|
|
@ -552,20 +552,20 @@
|
|||
(deftest _common-signals
|
||||
[#?(:clj
|
||||
(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! {:level :info} :id :level :dsc [::my-id :warn ]) {:level :warn, :id ::my-id}))
|
||||
(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 :info, :id ::my-id, :location* :loc*}))
|
||||
(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! :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! {:level :info} :id :level :asc [:warn ::my-id]) {:level :warn, :id ::my-id}))
|
||||
(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 [ ::my-id]) {:level :info, :id ::my-id, :location* :loc*}))
|
||||
(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! :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 :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 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 {: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: 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: 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! :loc* {:level :info} :id :level :dsc [:my-id1 {:id ::my-id2}])))]))
|
||||
|
||||
(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}))])
|
||||
|
|
|
|||
Loading…
Reference in a new issue