diff --git a/src/core/collector.ml b/src/core/collector.ml index f638222..f4a9975 100644 --- a/src/core/collector.ml +++ b/src/core/collector.ml @@ -30,6 +30,9 @@ module Callbacks = struct (** Exit a span. Must be called exactly once per span. Additional constraints on nesting, threads, etc. vary per collector. *) add_data_to_span: 'st -> span -> (string * user_data) list -> unit; + enabled: 'st -> Level.t -> bool; + (** Is the collector accepting spans/messages/metrics with this level? + *) message: 'st -> level:Level.t -> @@ -58,13 +61,14 @@ module Callbacks = struct (** Callbacks taking a state ['st] *) (** Helper to create backends in a future-proof way *) - let make ~enter_span ~exit_span ~add_data_to_span ~message ~metric - ?(extension = fun _ ~level:_ _ -> ()) ?(init = ignore) + let make ?(enabled = fun _ _ -> true) ~enter_span ~exit_span ~add_data_to_span + ~message ~metric ?(extension = fun _ ~level:_ _ -> ()) ?(init = ignore) ?(shutdown = ignore) () : _ t = { enter_span; exit_span; add_data_to_span; + enabled; message; metric; extension; diff --git a/src/core/trace_core.ml b/src/core/trace_core.ml index 8cb62bd..1fb581d 100644 --- a/src/core/trace_core.ml +++ b/src/core/trace_core.ml @@ -24,8 +24,8 @@ let[@inline] set_default_level l = A.set default_level_ l let[@inline] set_current_level l = A.set current_level_ l let[@inline] get_current_level () = A.get current_level_ -let[@inline] check_level_ ~level () : bool = - Level.leq level (A.get current_level_) +let[@inline] check_level_ ~level st (cbs : _ Collector.Callbacks.t) : bool = + Level.leq level (A.get current_level_) && cbs.enabled st level let parent_of_span_opt_opt = function | None -> P_unknown @@ -58,7 +58,7 @@ let with_span_collector_ st (cbs : _ Collector.Callbacks.t) ?__FUNCTION__ let[@inline] with_span ?(level = A.get default_level_) ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent ?params ?data name f = match A.get collector with - | C_some (st, cbs) when check_level_ ~level () -> + | C_some (st, cbs) when check_level_ ~level st cbs -> with_span_collector_ st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__ ~level ?parent ?params ?data name f | _ -> @@ -68,7 +68,7 @@ let[@inline] with_span ?(level = A.get default_level_) ?__FUNCTION__ ~__FILE__ let[@inline] enter_span ?(level = A.get default_level_) ?__FUNCTION__ ~__FILE__ ~__LINE__ ?flavor ?parent ?(params = []) ?data name : span = match A.get collector with - | C_some (st, cbs) when check_level_ ~level () -> + | C_some (st, cbs) when check_level_ ~level st cbs -> let params = match flavor with | None -> params @@ -98,13 +98,13 @@ let message_collector_ st (cbs : _ Collector.Callbacks.t) ~level ?span let[@inline] message ?(level = A.get default_level_) ?span ?params ?data msg : unit = match A.get collector with - | C_some (st, cbs) when check_level_ ~level () -> + | C_some (st, cbs) when check_level_ ~level st cbs -> (message_collector_ [@inlined never]) st cbs ~level ?span ?params ?data msg | _ -> () let messagef ?(level = A.get default_level_) ?span ?params ?data k = match A.get collector with - | C_some (st, cbs) when check_level_ ~level () -> + | C_some (st, cbs) when check_level_ ~level st cbs -> k (fun fmt -> Format.kasprintf (fun str -> message_collector_ st cbs ~level ?span ?params ?data str) @@ -114,7 +114,7 @@ let messagef ?(level = A.get default_level_) ?span ?params ?data k = let metric ?(level = A.get default_level_) ?(params = []) ?(data = data_empty_build_) name m : unit = match A.get collector with - | C_some (st, cbs) when check_level_ ~level () -> + | C_some (st, cbs) when check_level_ ~level st cbs -> let data = data () in cbs.metric st ~level ~params ~data name m | _ -> () @@ -153,7 +153,8 @@ type extension_event = Types.extension_event = .. let[@inline] extension_event ?(level = A.get default_level_) ev : unit = match A.get collector with - | C_some (st, cbs) when check_level_ ~level () -> cbs.extension st ~level ev + | C_some (st, cbs) when check_level_ ~level st cbs -> + cbs.extension st ~level ev | _ -> () let set_thread_name name : unit = diff --git a/src/debug/track_spans.ml b/src/debug/track_spans.ml index cb64cff..b7b488e 100644 --- a/src/debug/track_spans.ml +++ b/src/debug/track_spans.ml @@ -119,6 +119,7 @@ open struct let metric self ~level ~params ~data name v = self.cbs.metric self.state ~level ~params ~data name v + let enabled _ _ = true let init (self : _ st) = self.cbs.init self.state let shutdown (self : _ st) : unit = @@ -132,6 +133,7 @@ open struct enter_span; exit_span; add_data_to_span; + enabled; message; metric; init; diff --git a/src/util/multi_collector.ml b/src/util/multi_collector.ml index 71da788..47dc5d2 100644 --- a/src/util/multi_collector.ml +++ b/src/util/multi_collector.ml @@ -73,11 +73,17 @@ open struct done [@ocaml.warning "-8"] + let enabled st level : bool = + Array.exists + (fun (Collector.C_some (st, cb)) -> cb.enabled st level) + st [@ocaml.warning "-8"] + let combine_cb : st Collector.Callbacks.t = { Collector.Callbacks.init; enter_span; exit_span; + enabled; message; add_data_to_span; metric;