simon/ocaml-trace
1
0
Fork 0
mirror of https://github.com/ocaml-tracing/ocaml-trace.git synced 2026-03-08 03:47:57 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

extensible metric; pass level around in collector

Browse source
This commit is contained in:
Simon Cruanes 2026-01-21 21:04:53 -05:00
parent f1633fdcff
commit a4144ff3d1
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
9 changed files with 122 additions and 105 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/core/collector.ml
View file

@ -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;

5
src/core/core_ext.ml
View file

@ -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 *)

75
src/core/trace_core.ml
View file

@ -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

21
src/core/trace_core.mli
View file

@ -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} *)

7
src/core/types.ml
View file

@ -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 *)

24
src/debug/track_spans.ml
View file

@ -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;

20
src/fuchsia/collector_fuchsia.ml
View file

@ -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)

18
src/tef/collector_tef.ml
View file

@ -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)

30
src/util/multi_collector.ml
View file

@ -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;
}