[new] Add & opts support to signal!, signal-allowed?

This commit is contained in:
Peter Taoussanis 2024-12-24 10:18:48 +01:00
parent 8cd4ca97e6
commit a04f255146

View file

@ -384,14 +384,16 @@
(case macro-id (case macro-id
:signal! ; opts => allowed? / unconditional run result (value or throw) :signal! ; opts => allowed? / unconditional run result (value or throw)
'([{:as opts-map :keys '( [& opts-kvs]
[{:as opts-map :keys
[#_defaults #_elide? #_allow? #_expansion-id, ; Undocumented [#_defaults #_elide? #_allow? #_expansion-id, ; Undocumented
elidable? location #_location* inst uid middleware middleware+, elidable? location #_location* inst uid middleware middleware+,
sample-rate kind ns id level when rate-limit rate-limit-by, sample-rate kind ns id level when rate-limit rate-limit-by,
ctx ctx+ parent root trace?, do let data msg error run & kvs]}]) ctx ctx+ parent root trace?, do let data msg error run & kvs]}])
:signal-allowed? ; opts => allowed? :signal-allowed? ; opts => allowed?
'([{:as opts-map :keys '( [& opts-kvs]
[{:as opts-map :keys
[#_defaults #_elide? #_allow? #_expansion-id, ; Undocumented [#_defaults #_elide? #_allow? #_expansion-id, ; Undocumented
elidable? location #_location* #_inst #_uid #_middleware #_middleware+, elidable? location #_location* #_inst #_uid #_middleware #_middleware+,
sample-rate kind ns id level when rate-limit rate-limit-by, sample-rate kind ns id level when rate-limit rate-limit-by,
@ -493,7 +495,8 @@
#?(:clj #?(:clj
(defn- valid-opts! [x] (defn- valid-opts! [x]
(when-not (map? x) (if (map? x)
(do x)
(throw (throw
;; We require const map keys, but vals may require eval ;; We require const map keys, but vals may require eval
(ex-info "Telemere signal opts must be a map with const (compile-time) keys." (ex-info "Telemere signal opts must be a map with const (compile-time) keys."
@ -505,242 +508,238 @@
"Generic low-level signal call, also aliased in Encore." "Generic low-level signal call, also aliased in Encore."
{:doc (signal-docstring :signal!) {:doc (signal-docstring :signal!)
:arglists (signal-arglists :signal!)} :arglists (signal-arglists :signal!)}
[arg1 & more]
(let [opts (valid-opts! (if more (apply hash-map arg1 more) arg1))
defaults (enc/merge {:kind :generic, :level :info} (get opts :defaults))
opts (enc/merge defaults (dissoc opts :defaults))
cljs? (boolean (:ns &env))
clj? (not cljs?)
{run-form :run} opts
;; TODO Maybe later, once we're sure we don't want additional arities? show-run-val (get opts :run-val '_run-val)
;; Remember to also update signal-arglists, etc. show-run-form
;; ([arg1 & more] (enc/keep-callsite `(signal! ~(apply hash-map arg1 more)))) (when run-form
([opts] (get opts :run-form
(valid-opts! opts) (if (and
(let [defaults (enc/merge {:kind :generic, :level :info} (get opts :defaults)) (enc/list-form? run-form)
opts (enc/merge defaults (dissoc opts :defaults)) (> (count run-form) 1)
cljs? (boolean (:ns &env)) (> (count (str run-form)) 32))
clj? (not cljs?) (list (first run-form) '...)
{run-form :run} opts (do run-form))))
show-run-val (get opts :run-val '_run-val) {:keys [#_expansion-id location elide? allow?]}
show-run-form (sigs/filterable-expansion
(when run-form {:sf-arity 4
(get opts :run-form :ct-sig-filter ct-sig-filter
(if (and :*rt-sig-filter* `*rt-sig-filter*}
(enc/list-form? run-form)
(> (count run-form) 1)
(> (count (str run-form)) 32))
(list (first run-form) '...)
(do run-form))))
{:keys [#_expansion-id location elide? allow?]} (assoc opts
(sigs/filterable-expansion :location* (get opts :location* (enc/get-source &form &env))
{:sf-arity 4 :bound-forms
:ct-sig-filter ct-sig-filter {:kind '__kind
:*rt-sig-filter* `*rt-sig-filter*} :ns '__ns
:id '__id
:level '__level}))]
(assoc opts (if elide?
:location* (get opts :location* (enc/get-source &form &env)) run-form
:bound-forms (let [{ns-form :ns
{:kind '__kind line-form :line
:ns '__ns column-form :column
:id '__id file-form :file} location
:level '__level}))]
(if elide? {inst-form :inst
run-form level-form :level
(let [{ns-form :ns kind-form :kind
line-form :line id-form :id} opts
column-form :column
file-form :file} location
{inst-form :inst trace? (get opts :trace? (boolean run-form))
level-form :level _
kind-form :kind (when-not (contains? #{true false nil} trace?)
id-form :id} opts (enc/unexpected-arg! trace?
{:msg "Expected constant (compile-time) `:trace?` boolean"
:context `signal!}))
trace? (get opts :trace? (boolean run-form)) thread-form (when clj? `(enc/thread-info))
_
(when-not (contains? #{true false nil} trace?)
(enc/unexpected-arg! trace?
{:msg "Expected constant (compile-time) `:trace?` boolean"
:context `signal!}))
thread-form (when clj? `(enc/thread-info)) inst-form (get opts :inst :auto)
inst-form (auto-> inst-form `(enc/now-inst*))
inst-form (get opts :inst :auto) parent-form (get opts :parent `*trace-parent*)
inst-form (auto-> inst-form `(enc/now-inst*)) root-form0 (get opts :root `*trace-root*)
parent-form (get opts :parent `*trace-parent*) uid-form (get opts :uid (when trace? :auto))
root-form0 (get opts :root `*trace-root*)
uid-form (get opts :uid (when trace? :auto)) signal-delay-form
(let [{do-form :do
let-form :let
msg-form :msg
data-form :data
error-form :error
sample-rate-form :sample-rate} opts
signal-delay-form let-form (or let-form '[])
(let [{do-form :do msg-form (parse-msg-form msg-form)
let-form :let
msg-form :msg
data-form :data
error-form :error
sample-rate-form :sample-rate} opts
let-form (or let-form '[]) ctx-form
msg-form (parse-msg-form msg-form) (if-let [ctx+ (get opts :ctx+)]
`(taoensso.encore.signals/update-ctx taoensso.telemere/*ctx* ~ctx+)
(get opts :ctx `taoensso.telemere/*ctx*))
ctx-form middleware-form
(if-let [ctx+ (get opts :ctx+)] (if-let [middleware+ (get opts :middleware+)]
`(taoensso.encore.signals/update-ctx taoensso.telemere/*ctx* ~ctx+) `(taoensso.encore/comp-middleware taoensso.telemere/*middleware* ~middleware+)
(get opts :ctx `taoensso.telemere/*ctx*)) (get opts :middleware `taoensso.telemere/*middleware*))
middleware-form kvs-form
(if-let [middleware+ (get opts :middleware+)] (not-empty
`(taoensso.encore/comp-middleware taoensso.telemere/*middleware* ~middleware+) (dissoc opts
(get opts :middleware `taoensso.telemere/*middleware*)) :elidable? :location :location* :inst :uid :middleware :middleware+,
:sample-rate :ns :kind :id :level :filter :when #_:rate-limit #_:rate-limit-by,
:ctx :ctx+ :parent #_:trace?, :do :let :data :msg :error,
:run :run-form :run-val, :elide? :allow? #_:expansion-id :otel/context))
kvs-form _ ; Compile-time validation
(not-empty (do
(dissoc opts (when (and run-form error-form) ; Ambiguous source of error
:elidable? :location :location* :inst :uid :middleware :middleware+, (throw
:sample-rate :ns :kind :id :level :filter :when #_:rate-limit #_:rate-limit-by, (ex-info "Signals cannot have both `:run` and `:error` opts at the same time"
:ctx :ctx+ :parent #_:trace?, :do :let :data :msg :error, {:run-form run-form
:run :run-form :run-val, :elide? :allow? #_:expansion-id :otel/context)) :error-form error-form
:location location
:other-opts (dissoc opts :run :error)})))
_ ; Compile-time validation (when-let [e (find opts :msg_)] ; Common typo/confusion
(do (throw
(when (and run-form error-form) ; Ambiguous source of error (ex-info "Signals cannot have `:msg_` opt (did you mean `:msg`?))"
(throw {:msg_ (enc/typed-val (val e))}))))
(ex-info "Signals cannot have both `:run` and `:error` opts at the same time"
{:run-form run-form
:error-form error-form
:location location
:other-opts (dissoc opts :run :error)})))
(when-let [e (find opts :msg_)] ; Common typo/confusion signal-form
(throw (let [record-form
(ex-info "Signals cannot have `:msg_` opt (did you mean `:msg`?))" (let [clause [(if run-form :run :no-run) (if clj? :clj :cljs)]]
{:msg_ (enc/typed-val (val e))})))) (case clause
[:run :clj ] `(Signal. 1 ~'__inst ~'__uid, ~location ~'__ns ~line-form ~column-form ~file-form, (enc/host-info) ~'__thread ~'__otel-context1, ~sample-rate-form, ~'__kind ~'__id ~'__level, ~ctx-form ~parent-form ~'__root1, ~data-form ~kvs-form ~'_msg_, ~'_run-err '~show-run-form ~show-run-val ~'_end-inst ~'_run-nsecs)
[:run :cljs] `(Signal. 1 ~'__inst ~'__uid, ~location ~'__ns ~line-form ~column-form ~file-form, ~sample-rate-form, ~'__kind ~'__id ~'__level, ~ctx-form ~parent-form ~'__root1, ~data-form ~kvs-form ~'_msg_, ~'_run-err '~show-run-form ~show-run-val ~'_end-inst ~'_run-nsecs)
[:no-run :clj ] `(Signal. 1 ~'__inst ~'__uid, ~location ~'__ns ~line-form ~column-form ~file-form, (enc/host-info) ~'__thread ~'__otel-context1, ~sample-rate-form, ~'__kind ~'__id ~'__level, ~ctx-form ~parent-form ~'__root1, ~data-form ~kvs-form ~msg-form, ~error-form nil nil nil nil)
[:no-run :cljs] `(Signal. 1 ~'__inst ~'__uid, ~location ~'__ns ~line-form ~column-form ~file-form, ~sample-rate-form, ~'__kind ~'__id ~'__level, ~ctx-form ~parent-form ~'__root1, ~data-form ~kvs-form ~msg-form, ~error-form nil nil nil nil)
(enc/unexpected-arg! clause {:context :signal-constructor-args})))
signal-form record-form
(let [record-form (if-not run-form
(let [clause [(if run-form :run :no-run) (if clj? :clj :cljs)]] record-form
(case clause `(let [~(with-meta '_run-result {:tag `RunResult}) ~'__run-result
[:run :clj ] `(Signal. 1 ~'__inst ~'__uid, ~location ~'__ns ~line-form ~column-form ~file-form, (enc/host-info) ~'__thread ~'__otel-context1, ~sample-rate-form, ~'__kind ~'__id ~'__level, ~ctx-form ~parent-form ~'__root1, ~data-form ~kvs-form ~'_msg_, ~'_run-err '~show-run-form ~show-run-val ~'_end-inst ~'_run-nsecs) ~'_run-nsecs (.-run-nsecs ~'_run-result)
[:run :cljs] `(Signal. 1 ~'__inst ~'__uid, ~location ~'__ns ~line-form ~column-form ~file-form, ~sample-rate-form, ~'__kind ~'__id ~'__level, ~ctx-form ~parent-form ~'__root1, ~data-form ~kvs-form ~'_msg_, ~'_run-err '~show-run-form ~show-run-val ~'_end-inst ~'_run-nsecs) ~'_run-val (.-value ~'_run-result)
[:no-run :clj ] `(Signal. 1 ~'__inst ~'__uid, ~location ~'__ns ~line-form ~column-form ~file-form, (enc/host-info) ~'__thread ~'__otel-context1, ~sample-rate-form, ~'__kind ~'__id ~'__level, ~ctx-form ~parent-form ~'__root1, ~data-form ~kvs-form ~msg-form, ~error-form nil nil nil nil) ~'_run-err (.-error ~'_run-result)
[:no-run :cljs] `(Signal. 1 ~'__inst ~'__uid, ~location ~'__ns ~line-form ~column-form ~file-form, ~sample-rate-form, ~'__kind ~'__id ~'__level, ~ctx-form ~parent-form ~'__root1, ~data-form ~kvs-form ~msg-form, ~error-form nil nil nil nil) ~'_end-inst (inst+nsecs ~'__inst ~'_run-nsecs)
(enc/unexpected-arg! clause {:context :signal-constructor-args}))) ~'_msg_
(let [mf# ~msg-form]
(if (fn? mf#) ; Undocumented, handy for `trace!`/`spy!`, etc.
(delay (mf# '~show-run-form ~show-run-val ~'_run-err ~'_run-nsecs))
mf#))]
~record-form))]
record-form (if-not kvs-form
(if-not run-form record-form
record-form `(let [signal# ~record-form]
`(let [~(with-meta '_run-result {:tag `RunResult}) ~'__run-result (reduce-kv assoc signal# (.-kvs signal#)))))]
~'_run-nsecs (.-run-nsecs ~'_run-result)
~'_run-val (.-value ~'_run-result)
~'_run-err (.-error ~'_run-result)
~'_end-inst (inst+nsecs ~'__inst ~'_run-nsecs)
~'_msg_
(let [mf# ~msg-form]
(if (fn? mf#) ; Undocumented, handy for `trace!`/`spy!`, etc.
(delay (mf# '~show-run-form ~show-run-val ~'_run-err ~'_run-nsecs))
mf#))]
~record-form))]
(if-not kvs-form `(enc/bound-delay
record-form ;; Delay (cache) shared by all handlers, incl. `:let` eval,
`(let [signal# ~record-form] ;; signal construction, middleware, etc. Throws caught by handler.
(reduce-kv assoc signal# (.-kvs signal#)))))] ~do-form
(let [~@let-form ; Allow to throw, eval BEFORE data, msg, etc.
signal# ~signal-form]
`(enc/bound-delay ;; Final unwrapped signal value visible to users/handler-fns, allow to throw
;; Delay (cache) shared by all handlers, incl. `:let` eval, (if-let [sig-middleware# ~middleware-form]
;; signal construction, middleware, etc. Throws caught by handler. (sig-middleware# signal#) ; Apply signal middleware, can throw
~do-form (do signal#)))))
(let [~@let-form ; Allow to throw, eval BEFORE data, msg, etc.
signal# ~signal-form]
;; Final unwrapped signal value visible to users/handler-fns, allow to throw ;; Trade-off: avoid double `run-form` expansion
(if-let [sig-middleware# ~middleware-form] run-fn-form (when run-form `(fn [] ~run-form))
(sig-middleware# signal#) ; Apply signal middleware, can throw run-form* (when run-form `(~'__run-fn-form))
(do signal#)))))
;; Trade-off: avoid double `run-form` expansion into-let-form
run-fn-form (when run-form `(fn [] ~run-form)) (enc/cond!
run-form* (when run-form `(~'__run-fn-form)) (not trace?) ; Don't trace
`[~'__otel-context1 nil
~'__uid ~(auto-> uid-form `(taoensso.telemere/*uid-fn* (if ~'__root0 false true)))
~'__root1 ~'__root0 ; Retain, but don't establish
~'__run-result
~(when run-form
`(let [t0# (enc/now-nano*)]
(enc/try*
(do (RunResult. ~run-form* nil (- (enc/now-nano*) t0#)))
(catch :all t# (RunResult. nil t# (- (enc/now-nano*) t0#))))))]
into-let-form ;; Trace without OpenTelemetry
(enc/cond! (or cljs? (not enabled:otel-tracing?))
(not trace?) ; Don't trace `[~'__otel-context1 nil
`[~'__otel-context1 nil ~'__uid ~(auto-> uid-form `(taoensso.telemere/*uid-fn* (if ~'__root0 false true)))
~'__uid ~(auto-> uid-form `(taoensso.telemere/*uid-fn* (if ~'__root0 false true))) ~'__root1 (or ~'__root0 ~(when trace? `{:id ~'__id, :uid ~'__uid}))
~'__root1 ~'__root0 ; Retain, but don't establish ~'__run-result
~'__run-result ~(when run-form
~(when run-form `(binding [*trace-root* ~'__root1
`(let [t0# (enc/now-nano*)] *trace-parent* {:id ~'__id, :uid ~'__uid}]
(enc/try* (let [t0# (enc/now-nano*)]
(do (RunResult. ~run-form* nil (- (enc/now-nano*) t0#))) (enc/try*
(catch :all t# (RunResult. nil t# (- (enc/now-nano*) t0#))))))] (do (RunResult. ~run-form* nil (- (enc/now-nano*) t0#)))
(catch :all t# (RunResult. nil t# (- (enc/now-nano*) t0#)))))))]
;; Trace without OpenTelemetry ;; Trace with OpenTelemetry
(or cljs? (not enabled:otel-tracing?)) (and clj? enabled:otel-tracing?)
`[~'__otel-context1 nil `[~'__otel-context0 ~(get opts :otel/context `(otel-context)) ; Context
~'__uid ~(auto-> uid-form `(taoensso.telemere/*uid-fn* (if ~'__root0 false true))) ~'__otel-context1 ~(if run-form `(otel-context+span ~'__id ~'__inst ~'__otel-context0) ~'__otel-context0)
~'__root1 (or ~'__root0 ~(when trace? `{:id ~'__id, :uid ~'__uid})) ~'__uid ~(auto-> uid-form `(or (otel-span-id ~'__otel-context1) (com.taoensso.encore.Ids/genHexId16)))
~'__run-result ~'__root1
~(when run-form (or ~'__root0
`(binding [*trace-root* ~'__root1 ~(when trace?
*trace-parent* {:id ~'__id, :uid ~'__uid}] `{:id ~'__id, :uid (or (otel-trace-id ~'__otel-context1) (com.taoensso.encore.Ids/genHexId32))}))
(let [t0# (enc/now-nano*)]
(enc/try*
(do (RunResult. ~run-form* nil (- (enc/now-nano*) t0#)))
(catch :all t# (RunResult. nil t# (- (enc/now-nano*) t0#)))))))]
;; Trace with OpenTelemetry ~'__run-result
(and clj? enabled:otel-tracing?) ~(when run-form
`[~'__otel-context0 ~(get opts :otel/context `(otel-context)) ; Context `(binding [*otel-context* ~'__otel-context1
~'__otel-context1 ~(if run-form `(otel-context+span ~'__id ~'__inst ~'__otel-context0) ~'__otel-context0) *trace-root* ~'__root1
~'__uid ~(auto-> uid-form `(or (otel-span-id ~'__otel-context1) (com.taoensso.encore.Ids/genHexId16))) *trace-parent* {:id ~'__id, :uid ~'__uid}]
~'__root1 (let [otel-scope# (.makeCurrent ~'__otel-context1)
(or ~'__root0 t0# (enc/now-nano*)]
~(when trace? (enc/try*
`{:id ~'__id, :uid (or (otel-trace-id ~'__otel-context1) (com.taoensso.encore.Ids/genHexId32))})) (do (RunResult. ~run-form* nil (- (enc/now-nano*) t0#)))
(catch :all t# (RunResult. nil t# (- (enc/now-nano*) t0#)))
(finally (.close otel-scope#))))))])
~'__run-result final-form
~(when run-form ;; Unless otherwise specified, allow errors to throw on call
`(binding [*otel-context* ~'__otel-context1 `(let [~'__run-fn-form ~run-fn-form
*trace-root* ~'__root1 ~'__kind ~kind-form
*trace-parent* {:id ~'__id, :uid ~'__uid}] ~'__ns ~ns-form
(let [otel-scope# (.makeCurrent ~'__otel-context1) ~'__id ~id-form
t0# (enc/now-nano*)] ~'__level ~level-form]
(enc/try*
(do (RunResult. ~run-form* nil (- (enc/now-nano*) t0#)))
(catch :all t# (RunResult. nil t# (- (enc/now-nano*) t0#)))
(finally (.close otel-scope#))))))])
final-form (enc/if-not ~allow?
;; Unless otherwise specified, allow errors to throw on call ~run-form*
`(let [~'__run-fn-form ~run-fn-form (let [~'__inst ~inst-form
~'__kind ~kind-form ~'__thread ~thread-form
~'__ns ~ns-form ~'__root0 ~root-form0 ; ?{:keys [id uid]}
~'__id ~id-form
~'__level ~level-form]
(enc/if-not ~allow? ~@into-let-form ; Inject conditional bindings
~run-form* signal# ~signal-delay-form]
(let [~'__inst ~inst-form
~'__thread ~thread-form
~'__root0 ~root-form0 ; ?{:keys [id uid]}
~@into-let-form ; Inject conditional bindings (dispatch-signal!
signal# ~signal-delay-form] ;; Unconditionally send same wrapped signal to all handlers.
;; Each handler will use wrapper for handler filtering,
;; unwrapping (realizing) only allowed signals.
(WrappedSignal. ~'__kind ~'__ns ~'__id ~'__level signal#))
(dispatch-signal! (if ~'__run-result
;; Unconditionally send same wrapped signal to all handlers. ( ~'__run-result signal#)
;; Each handler will use wrapper for handler filtering, true))))]
;; unwrapping (realizing) only allowed signals.
(WrappedSignal. ~'__kind ~'__ns ~'__id ~'__level signal#))
(if ~'__run-result (if-let [iife-wrap? true #_cljs?]
( ~'__run-result signal#) ;; Small perf hit to improve compatibility within `go` and other IOC-style bodies
true))))] `((fn [] ~final-form))
(do final-form)))))))
(if-let [iife-wrap? true #_cljs?]
;; Small perf hit to improve compatibility within `go` and other IOC-style bodies
`((fn [] ~final-form))
(do final-form))))))))
(comment (comment
(with-signal (signal! {:level :warn :let [x :x] :msg ["Test" "message" x] :data {:a :A :x x} :run (+ 1 2)})) (with-signal (signal! {:level :warn :let [x :x] :msg ["Test" "message" x] :data {:a :A :x x} :run (+ 1 2)}))
@ -768,9 +767,10 @@
;; Used also for interop (tools.logging, SLF4J), etc. ;; Used also for interop (tools.logging, SLF4J), etc.
{:arglists (signal-arglists :signal-allowed?)} {:arglists (signal-arglists :signal-allowed?)}
[opts] [arg1 & more]
(valid-opts! opts) (let [opts (valid-opts! (if more (apply hash-map arg1 more) arg1))
(let [defaults (get opts :defaults)
defaults (get opts :defaults)
opts (merge defaults (dissoc opts :defaults)) opts (merge defaults (dissoc opts :defaults))
{:keys [#_expansion-id #_location elide? allow?]} {:keys [#_expansion-id #_location elide? allow?]}