diff --git a/src/core/collector.ml b/src/core/collector.ml index 1e00319..f638222 100644 --- a/src/core/collector.ml +++ b/src/core/collector.ml @@ -19,6 +19,7 @@ module Callbacks = struct __FUNCTION__:string option -> __FILE__:string -> __LINE__:int -> + level:Level.t -> params:extension_parameter list -> data:(string * user_data) list -> parent:parent -> @@ -31,29 +32,24 @@ module Callbacks = struct add_data_to_span: 'st -> span -> (string * user_data) list -> unit; message: 'st -> + level:Level.t -> params:extension_parameter list -> data:(string * user_data) list -> span:span option -> string -> unit; (** Emit a message or log *) - counter_int: + metric: 'st -> + level:Level.t -> params:extension_parameter list -> data:(string * user_data) list -> string -> - int -> + metric -> unit; - (** Integer counter. *) - counter_float: - 'st -> - params:extension_parameter list -> - data:(string * user_data) list -> - string -> - float -> - unit; - extension: 'st -> extension_event -> unit; - (** Collector-specific extension *) + (** Metric . *) + extension: 'st -> level:Level.t -> extension_event -> unit; + (** Collector-specific extension. It now has a level as well. *) init: 'st -> unit; (** Called on initialization *) shutdown: 'st -> unit; (** Shutdown collector, possibly waiting for it to finish sending data. @@ -62,16 +58,15 @@ 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 ~counter_int - ~counter_float ?(extension = fun _ _ -> ()) ?(init = ignore) + let make ~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; message; - counter_int; - counter_float; + metric; extension; init; shutdown; diff --git a/src/core/core_ext.ml b/src/core/core_ext.ml index 1f88305..7491b7a 100644 --- a/src/core/core_ext.ml +++ b/src/core/core_ext.ml @@ -13,3 +13,8 @@ type extension_event += type extension_parameter += | Extension_span_flavor of [ `Sync | `Async ] (** Tell the backend if this is a sync or async span *) + +type metric += + | Metric_int of int (** Int counter or gauge, supported by tracy, TEF, etc *) + | Metric_float of float + (** Float counter or gauge, supported by tracy, TEF, etc *) diff --git a/src/core/trace_core.ml b/src/core/trace_core.ml index 14ee550..8cb62bd 100644 --- a/src/core/trace_core.ml +++ b/src/core/trace_core.ml @@ -24,7 +24,7 @@ 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 = A.get default_level_) () : bool = +let[@inline] check_level_ ~level () : bool = Level.leq level (A.get current_level_) let parent_of_span_opt_opt = function @@ -33,16 +33,18 @@ let parent_of_span_opt_opt = function | Some (Some p) -> P_some p let enter_span_st st (cbs : _ Collector.Callbacks.t) ?__FUNCTION__ ~__FILE__ - ~__LINE__ ?parent ?(params = []) ?(data = data_empty_build_) name : span = + ~__LINE__ ~level ?parent ?(params = []) ?(data = data_empty_build_) name : + span = let parent = parent_of_span_opt_opt parent in let data = data () in - cbs.enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~parent ~params ~data name + cbs.enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~level ~parent ~params + ~data name let with_span_collector_ st (cbs : _ Collector.Callbacks.t) ?__FUNCTION__ - ~__FILE__ ~__LINE__ ?parent ?params ?data name f = + ~__FILE__ ~__LINE__ ~level ?parent ?params ?data name f = let sp : span = - enter_span_st st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent ?params ?data - name + enter_span_st st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__ ~level ?parent + ?params ?data name in match f sp with | res -> @@ -53,27 +55,27 @@ let with_span_collector_ st (cbs : _ Collector.Callbacks.t) ?__FUNCTION__ cbs.exit_span st sp; Printexc.raise_with_backtrace exn bt -let[@inline] with_span ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent ?params - ?data name f = +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 () -> - with_span_collector_ st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent + | C_some (st, cbs) when check_level_ ~level () -> + with_span_collector_ st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__ ~level ?parent ?params ?data name f | _ -> (* fast path: no collector, no span *) f Collector.dummy_span -let[@inline] enter_span ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?flavor ?parent - ?(params = []) ?data name : span = +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 () -> let params = match flavor with | None -> params | Some f -> Core_ext.Extension_span_flavor f :: params in (enter_span_st [@inlined never]) st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__ - ?parent ~params ?data name + ~level ?parent ~params ?data name | _ -> Collector.dummy_span let[@inline] exit_span sp : unit = @@ -88,41 +90,40 @@ let[@inline] add_data_to_span sp data : unit = | C_some (st, cbs) -> cbs.add_data_to_span st sp data ) -let message_collector_ st (cbs : _ Collector.Callbacks.t) ?span ?(params = []) - ?(data = data_empty_build_) msg : unit = +let message_collector_ st (cbs : _ Collector.Callbacks.t) ~level ?span + ?(params = []) ?(data = data_empty_build_) msg : unit = let data = data () in - cbs.message st ~span ~params ~data msg + cbs.message st ~level ~span ~params ~data msg -let[@inline] message ?level ?span ?params ?data msg : unit = +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 () -> - (message_collector_ [@inlined never]) st cbs ?span ?params ?data msg + | C_some (st, cbs) when check_level_ ~level () -> + (message_collector_ [@inlined never]) st cbs ~level ?span ?params ?data msg | _ -> () -let messagef ?level ?span ?params ?data k = +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 () -> k (fun fmt -> Format.kasprintf - (fun str -> message_collector_ st cbs ?span ?params ?data str) + (fun str -> message_collector_ st cbs ~level ?span ?params ?data str) fmt) | _ -> () -let counter_int ?level ?(params = []) ?(data = data_empty_build_) name n : unit - = +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 () -> let data = data () in - cbs.counter_int st ~params ~data name n + cbs.metric st ~level ~params ~data name m | _ -> () -let counter_float ?level ?(params = []) ?(data = data_empty_build_) name f : - unit = - match A.get collector with - | C_some (st, cbs) when check_level ?level () -> - let data = data () in - cbs.counter_float st ~params ~data name f - | _ -> () +let counter_int ?level ?params ?data name n : unit = + metric ?level ?params ?data name (Core_ext.Metric_int n) + +let counter_float ?level ?params ?data name n : unit = + metric ?level ?params ?data name (Core_ext.Metric_float n) let setup_collector c : unit = while @@ -150,10 +151,10 @@ let with_setup_collector c f = type extension_event = Types.extension_event = .. -let[@inline] extension_event ev : unit = +let[@inline] extension_event ?(level = A.get default_level_) ev : unit = match A.get collector with - | C_none -> () - | C_some (st, cbs) -> cbs.extension st ev + | C_some (st, cbs) when check_level_ ~level () -> cbs.extension st ~level ev + | _ -> () let set_thread_name name : unit = extension_event @@ Core_ext.Extension_set_thread_name name diff --git a/src/core/trace_core.mli b/src/core/trace_core.mli index 3c936fd..4588b6d 100644 --- a/src/core/trace_core.mli +++ b/src/core/trace_core.mli @@ -141,6 +141,17 @@ val set_process_name : string -> unit Uses {!Core_ext.Extension_set_process_name} since NEXT_RELEASE *) +val metric : + ?level:Level.t -> + ?params:extension_parameter list -> + ?data:(unit -> (string * user_data) list) -> + string -> + metric -> + unit +(** Emit a metric. Metrics are an extensible type, each collector might support + a different subset. + @since NEXT_RELEASE *) + val counter_int : ?level:Level.t -> ?params:extension_parameter list -> @@ -148,8 +159,8 @@ val counter_int : string -> int -> unit -(** Emit a counter of type [int]. Counters represent the evolution of some - quantity over time. +(** Emit a counter of type [int] via {!metric}. Counters represent the evolution + of some quantity over time. @param level optional level for this span. since 0.7. Default is set via {!set_default_level}. @@ -162,7 +173,8 @@ val counter_float : string -> float -> unit -(** Emit a counter of type [float]. See {!counter_int} for more details. +(** Emit a counter of type [float] via {!metric}. See {!counter_int} for more + details. @param level optional level for this span. since 0.7. Default is set via {!set_default_level}. @@ -202,10 +214,11 @@ type extension_event = Types.extension_event = .. (** Extension event @since 0.8 *) -val extension_event : extension_event -> unit +val extension_event : ?level:Level.t -> extension_event -> unit (** Trigger an extension event, whose meaning depends on the library that defines it. Some collectors will simply ignore it. This does nothing if no collector is setup. + @param level filtering level, since NEXT_RELEASE @since 0.8 *) (** {2 Core extensions} *) diff --git a/src/core/types.ml b/src/core/types.ml index ea51685..c5ded9c 100644 --- a/src/core/types.ml +++ b/src/core/types.ml @@ -25,10 +25,15 @@ type explicit_span_ctx = span [@@deprecated "use span"] type extension_event = .. (** An extension event, used to add features that are backend specific or simply - not envisioned by [trace]. + not envisioned by [trace]. See {!Core_ext} for some builtin extension + events. @since 0.8 *) type extension_parameter = .. (** An extension parameter, used to carry information for spans/messages/metrics that can be backend-specific or just not envisioned by [trace]. @since NEXT_RELEASE *) + +type metric = .. +(** A metric, can be of many types. See {!Core_ext} for some builtin metrics. + @since NEXT_RELEASE *) diff --git a/src/debug/track_spans.ml b/src/debug/track_spans.ml index ad0372b..cb64cff 100644 --- a/src/debug/track_spans.ml +++ b/src/debug/track_spans.ml @@ -46,11 +46,11 @@ open struct Mutex.lock mut; Fun.protect f ~finally:(fun () -> Mutex.unlock mut) - let enter_span (self : _ st) ~__FUNCTION__ ~__FILE__ ~__LINE__ ~params ~data - ~parent name : span = + let enter_span (self : _ st) ~__FUNCTION__ ~__FILE__ ~__LINE__ ~level ~params + ~data ~parent name : span = let span = - self.cbs.enter_span self.state ~__FUNCTION__ ~__FILE__ ~__LINE__ ~params - ~data ~parent name + self.cbs.enter_span self.state ~__FUNCTION__ ~__FILE__ ~__LINE__ ~level + ~params ~data ~parent name in let id = A.fetch_and_add self.gen_id 1 in (let@ () = with_mutex self.mutex in @@ -108,19 +108,16 @@ open struct emit self unclosed_spans ) - let message self ~params ~data ~span msg = + let message self ~level ~params ~data ~span msg = let span = match span with | Some (Span_tracked (_, sp)) -> Some sp | _ -> span in - self.cbs.message self.state ~params ~data ~span msg + self.cbs.message self.state ~level ~params ~data ~span msg - let counter_int self ~params ~data name v = - self.cbs.counter_int self.state ~params ~data name v - - let counter_float self ~params ~data name v = - self.cbs.counter_float self.state ~params ~data name v + let metric self ~level ~params ~data name v = + self.cbs.metric self.state ~level ~params ~data name v let init (self : _ st) = self.cbs.init self.state @@ -128,7 +125,7 @@ open struct print_non_closed_spans_warning self; self.cbs.shutdown self.state - let extension self ev = self.cbs.extension self.state ev + let extension self ~level ev = self.cbs.extension self.state ~level ev let track_callbacks : _ st Collector.Callbacks.t = { @@ -136,8 +133,7 @@ open struct exit_span; add_data_to_span; message; - counter_int; - counter_float; + metric; init; shutdown; extension; diff --git a/src/fuchsia/collector_fuchsia.ml b/src/fuchsia/collector_fuchsia.ml index 54710b5..8b13547 100644 --- a/src/fuchsia/collector_fuchsia.ml +++ b/src/fuchsia/collector_fuchsia.ml @@ -89,8 +89,8 @@ open struct | Core_ext.Extension_span_flavor f :: _ -> f | _ :: tl -> flavor_of_params tl - let enter_span (self : t) ~__FUNCTION__ ~__FILE__ ~__LINE__ ~params ~data - ~parent name : span = + let enter_span (self : t) ~__FUNCTION__ ~__FILE__ ~__LINE__ ~level:_ ~params + ~data ~parent name : span = let flavor = flavor_of_params params in let time_ns = Trace_util.Mock_.now_ns () in let tid = Trace_util.Mock_.get_tid () in @@ -150,7 +150,7 @@ open struct | Span_fuchsia_async sp -> sp.args <- List.rev_append data sp.args | _ -> () - let message (self : t) ~params:_ ~data ~span:_ msg : unit = + let message (self : t) ~level:_ ~params:_ ~data ~span:_ msg : unit = let time_ns = Trace_util.Mock_.now_ns () in let tid = Trace_util.Mock_.get_tid () in Writer.( @@ -159,7 +159,7 @@ open struct ~name:msg ~time_ns ~args:(args_of_user_data data) ()); write_ready_ self - let counter_float (self : t) ~params:_ ~data name n : unit = + let counter_float_ (self : t) ~data name n : unit = let tid = Trace_util.Mock_.get_tid () in let time_ns = Trace_util.Mock_.now_ns () in Writer.( @@ -170,7 +170,7 @@ open struct ()); write_ready_ self - let counter_int self ~params:_ ~data name n = + let counter_int_ self ~data name n = let tid = Trace_util.Mock_.get_tid () in let time_ns = Trace_util.Mock_.now_ns () in Writer.( @@ -181,6 +181,12 @@ open struct ()); write_ready_ self + let metric self ~level:_ ~params:_ ~data name m = + match m with + | Core_ext.Metric_int i -> counter_int_ self ~data name i + | Core_ext.Metric_float n -> counter_float_ self ~data name n + | _ -> () + let name_process_ (self : t) name : unit = Writer.Kernel_object.( encode self.buf_chain ~name ~ty:ty_process ~kid:self.pid ~args:[] ()); @@ -193,7 +199,7 @@ open struct ()); write_ready_ self - let extension (self : t) ev = + let extension (self : t) ~level:_ ev = match ev with | Core_ext.Extension_set_thread_name name -> let tid = Trace_util.Mock_.get_tid () in @@ -204,6 +210,6 @@ end let callbacks : t Collector.Callbacks.t = Collector.Callbacks.make ~init ~shutdown ~enter_span ~exit_span - ~add_data_to_span ~message ~counter_int ~counter_float ~extension () + ~add_data_to_span ~message ~metric ~extension () let collector (self : t) : Collector.t = Collector.C_some (self, callbacks) diff --git a/src/tef/collector_tef.ml b/src/tef/collector_tef.ml index 5a61774..8660a70 100644 --- a/src/tef/collector_tef.ml +++ b/src/tef/collector_tef.ml @@ -60,8 +60,8 @@ open struct | None -> data | Some f -> ("function", `String f) :: data - let enter_span (self : st) ~__FUNCTION__ ~__FILE__ ~__LINE__ ~params ~data - ~parent name : span = + let enter_span (self : st) ~__FUNCTION__ ~__FILE__ ~__LINE__ ~level:_ ~params + ~data ~parent name : span = let start_us = time_us_of_time_ns @@ Trace_util.Mock_.now_ns () in let flavor = flavor_of_params params in @@ -104,7 +104,7 @@ open struct if did_write then self.exporter.on_json buf - let message (self : st) ~params:_ ~data ~span:_ msg : unit = + let message (self : st) ~level:_ ~params:_ ~data ~span:_ msg : unit = let tid = Trace_util.Mock_.get_tid () in let time_us = time_us_of_time_ns @@ Trace_util.Mock_.now_ns () in let@ buf = Trace_util.Rpool.with_ self.buf_pool in @@ -119,8 +119,12 @@ open struct Writer.emit_counter buf ~pid:self.pid ~name ~tid ~ts:time_us n; self.exporter.on_json buf - let counter_int (self : st) ~params ~data name n : unit = - counter_float self ~params ~data name (float_of_int n) + let metric (self : st) ~level:_ ~params ~data name m : unit = + match m with + | Core_ext.Metric_float n -> counter_float self ~params ~data name n + | Core_ext.Metric_int i -> + counter_float self ~params ~data name (float_of_int i) + | _ -> () let add_data_to_span _st sp data = match sp with @@ -138,7 +142,7 @@ open struct Writer.emit_name_process ~pid:self.pid ~name buf; self.exporter.on_json buf - let extension (self : st) ev = + let extension (self : st) ~level:_ ev = match ev with | Core_ext.Extension_set_thread_name name -> let tid = Trace_util.Mock_.get_tid () in @@ -149,7 +153,7 @@ end let callbacks_collector : _ Collector.Callbacks.t = Collector.Callbacks.make ~init ~shutdown ~enter_span ~exit_span ~message - ~add_data_to_span ~counter_int ~counter_float ~extension () + ~add_data_to_span ~metric ~extension () let collector (self : t) : Collector.t = Collector.C_some (self, callbacks_collector) diff --git a/src/util/multi_collector.ml b/src/util/multi_collector.ml index a455a38..71da788 100644 --- a/src/util/multi_collector.ml +++ b/src/util/multi_collector.ml @@ -18,14 +18,14 @@ open struct done [@ocaml.warning "-8"] - let enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~params ~data ~parent name - : span = + let enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~level ~params ~data + ~parent name : span = let spans = Array.map (fun [@ocaml.warning "-8"] coll -> let (Collector.C_some (st, cb)) = coll in - cb.enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~params ~data - ~parent name) + cb.enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~level ~params + ~data ~parent name) st in Span_combine spans @@ -52,31 +52,24 @@ open struct [@ocaml.warning "-8"] | _ -> () - let message st ~params ~data ~span msg = + let message st ~level ~params ~data ~span msg = for i = 0 to Array.length st - 1 do let (Collector.C_some (st, cb)) = Array.get st i in - cb.message st ~span ~params ~data msg + cb.message st ~level ~span ~params ~data msg done [@ocaml.warning "-8"] - let counter_int st ~params ~data name n = + let metric st ~level ~params ~data name m = for i = 0 to Array.length st - 1 do let (Collector.C_some (st, cb)) = Array.get st i in - cb.counter_int st ~params ~data name n + cb.metric st ~level ~params ~data name m done [@ocaml.warning "-8"] - let counter_float st ~params ~data name n = + let extension st ~level ev : unit = for i = 0 to Array.length st - 1 do let (Collector.C_some (st, cb)) = Array.get st i in - cb.counter_float st ~params ~data name n - done - [@ocaml.warning "-8"] - - let extension st ev : unit = - for i = 0 to Array.length st - 1 do - let (Collector.C_some (st, cb)) = Array.get st i in - cb.extension st ev + cb.extension st ~level ev done [@ocaml.warning "-8"] @@ -87,8 +80,7 @@ open struct exit_span; message; add_data_to_span; - counter_int; - counter_float; + metric; extension; shutdown; }