add enabled to the collector

this way we can have collectors that only accept some levels

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;

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 =

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;

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;