simon/ocaml-trace
1
0
Fork 0
mirror of https://github.com/ocaml-tracing/ocaml-trace.git synced 2026-03-07 18:37:56 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

refactor core library

Browse source 
much cleaner now, and simpler.

- `span` is an open sum type, so it can carry as much info as we want
from enter to exit. This means most collectors shouldn't even need a
global table for spans!
- merge manual spans and spans. It's just spans now. Keep old
Trace_core.xxx_manual_xxx functions but deprecate them
- add `extension_parameter` to carry additional info to collector (eg
OTEL span kind, TEF sync/async, maybe span links, etc)
- make the collector into a record of callbacks + a state, for
efficiency (but also to make it easier to extend in the future with
callbacks that have a default implementation
)
This commit is contained in:
Simon Cruanes 2026-01-14 20:29:33 -05:00
parent 1c9a869148
commit 5018a9ead7
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
5 changed files with 312 additions and 323 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

176
src/core/collector.ml
View file

@ -6,103 +6,93 @@
open Types open Types
let dummy_span : span = Int64.min_int type span += Span_dummy
let dummy_trace_id : trace_id = "<dummy>"
let dummy_explicit_span : explicit_span = (** A fake span that never emits data. All collectors should handle this span by
{ span = dummy_span; trace_id = dummy_trace_id; meta = Meta_map.empty } doing nothing. *)
let dummy_span : span = Span_dummy
let dummy_explicit_span_ctx : explicit_span_ctx = module Callbacks = struct
{ span = dummy_span; trace_id = dummy_trace_id } type 'st t = {
enter_span:
'st ->
__FUNCTION__:string option ->
__FILE__:string ->
__LINE__:int ->
params:extension_parameter list ->
data:(string * user_data) list ->
parent:parent ->
string ->
span;
(** Enter a span *)
exit_span: 'st -> span -> unit;
(** Exit a span. Must be called exactly once per span. Additional
constraints on nesting, threads, etc. vary per collector. *)
current_span: 'st -> span option;
(** Access the current span, if supported. Returns [None] if there is no
current span or if the current span isn't tracked by the collector.
*)
add_data_to_span: 'st -> span -> (string * user_data) list -> unit;
message:
'st ->
params:extension_parameter list ->
data:(string * user_data) list ->
span:span option ->
string ->
unit;
(** Emit a message or log *)
counter_int:
'st ->
params:extension_parameter list ->
data:(string * user_data) list ->
string ->
int ->
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 *)
shutdown: 'st -> unit;
(** Shutdown collector, possibly waiting for it to finish sending data.
*)
}
(** Callbacks taking a state ['st] *)
(** Signature for a collector. (** Helper to create backends in a future-proof way *)
let make ~enter_span ~exit_span ?(current_span = fun _ -> None)
~add_data_to_span ~message ~counter_int ~counter_float
?(extension = fun _ _ -> ()) ?(shutdown = ignore) () : _ t =
{
enter_span;
exit_span;
current_span;
add_data_to_span;
message;
counter_int;
counter_float;
extension;
shutdown;
}
end
(** Definition of a collector.
This is only relevant to implementors of tracing backends; to instrument This is only relevant to implementors of tracing backends; to instrument
your code you only need to look at the {!Trace} module. *) your code you only need to look at the {!Trace} module.
module type S = sig
val with_span :
__FUNCTION__:string option ->
__FILE__:string ->
__LINE__:int ->
data:(string * user_data) list ->
string ->
(span -> 'a) ->
'a
(** Run the function in a new span.
@since 0.3 *)
val enter_span : The definition changed since NEXT_RELEASE to a record of callbacks + a state
__FUNCTION__:string option -> *)
__FILE__:string -> type t =
__LINE__:int -> | C_none (** No collector. *)
data:(string * user_data) list -> | C_some : 'st * 'st Callbacks.t -> t
string -> (** Collector with a state and some callbacks. *)
span
(** Enter a new implicit span. For many uses cases, {!with_span} will be
easier to use.
@since 0.6 *)
val exit_span : span -> unit let[@inline] is_some = function
(** Exit span. This should be called on the same thread as the corresponding | C_none -> false
{!enter_span}, and nest properly with other calls to enter/exit_span and | C_some _ -> true
{!with_span}.
@since 0.6 *)
val enter_manual_span :
parent:explicit_span_ctx option ->
flavor:[ `Sync | `Async ] option ->
__FUNCTION__:string option ->
__FILE__:string ->
__LINE__:int ->
data:(string * user_data) list ->
string ->
explicit_span
(** Enter an explicit span. Surrounding scope, if any, is provided by
[parent], and this function can store as much metadata as it wants in the
hmap in the {!explicit_span}'s [meta] field.
{b NOTE} the [parent] argument is now an {!explicit_span_ctx} and not an
{!explicit_span} since 0.10.
This means that the collector doesn't need to implement contextual storage
mapping {!span} to scopes, metadata, etc. on its side; everything can be
transmitted in the {!explicit_span}.
@since 0.3 *)
val exit_manual_span : explicit_span -> unit
(** Exit an explicit span.
@since 0.3 *)
val add_data_to_span : span -> (string * user_data) list -> unit
(** @since Adds data to the current span.
0.4 *)
val add_data_to_manual_span :
explicit_span -> (string * user_data) list -> unit
(** Adds data to the given span.
@since 0.4 *)
val message : ?span:span -> data:(string * user_data) list -> string -> unit
(** Emit a message with associated metadata. *)
val name_thread : string -> unit
(** Give a name to the current thread. *)
val name_process : string -> unit
(** Give a name to the current process. *)
val counter_int : data:(string * user_data) list -> string -> int -> unit
(** Integer counter. *)
val counter_float : data:(string * user_data) list -> string -> float -> unit
(** Float counter. *)
val extension_event : extension_event -> unit
(** Handle an extension event. A collector {b MUST} simple ignore events it
doesn't know, and return [()] silently.
@since 0.8 *)
val shutdown : unit -> unit
(** Shutdown collector, possibly waiting for it to finish sending data. *)
end

15
src/core/core_ext.ml Normal file
View file

@ -0,0 +1,15 @@
(** A few core extensions.
@since NEXT_RELEASE *)
open Types
(** Additional extensions *)
type extension_event +=
| Extension_set_thread_name of string
| Extension_set_process_name of string
(** Specialized parameters *)
type extension_parameter +=
| Extension_span_flavor of [ `Sync | `Async ]
(** Tell the backend if this is a sync or async span *)

207
src/core/trace_core.ml
View file

@ -3,13 +3,14 @@ module A = Atomic_
module Collector = Collector module Collector = Collector
module Meta_map = Meta_map module Meta_map = Meta_map
module Level = Level module Level = Level
module Core_ext = Core_ext
type collector = (module Collector.S) type collector = Collector.t
(* ## globals ## *) (* ## globals ## *)
(** Global collector. *) (** Global collector. *)
let collector : collector option A.t = A.make None let collector : collector A.t = A.make Collector.C_none
(* default level for spans without a level *) (* default level for spans without a level *)
let default_level_ = A.make Level.Trace let default_level_ = A.make Level.Trace
@ -17,16 +18,8 @@ let current_level_ = A.make Level.Trace
(* ## implementation ## *) (* ## implementation ## *)
let[@inline] ctx_of_span (sp : explicit_span) : explicit_span_ctx =
{ span = sp.span; trace_id = sp.trace_id }
let data_empty_build_ () = [] let data_empty_build_ () = []
let[@inline] enabled () = Collector.is_some (A.get collector)
let[@inline] enabled () =
match A.get collector with
| None -> false
| Some _ -> true
let[@inline] get_default_level () = A.get default_level_ let[@inline] get_default_level () = A.get default_level_
let[@inline] set_default_level l = A.set default_level_ l let[@inline] set_default_level l = A.set default_level_ l
let[@inline] set_current_level l = A.set current_level_ l let[@inline] set_current_level l = A.set current_level_ l
@ -35,152 +28,154 @@ let[@inline] get_current_level () = A.get current_level_
let[@inline] check_level ?(level = A.get default_level_) () : bool = let[@inline] check_level ?(level = A.get default_level_) () : bool =
Level.leq level (A.get current_level_) Level.leq level (A.get current_level_)
let with_span_collector_ (module C : Collector.S) ?__FUNCTION__ ~__FILE__ let parent_of_span_opt_opt = function
~__LINE__ ?(data = data_empty_build_) name f = | None -> P_unknown
let data = data () in | Some None -> P_none
C.with_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name f | Some (Some p) -> P_some p
let[@inline] with_span ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name f = let enter_span_st st (cbs : _ Collector.Callbacks.t) ?__FUNCTION__ ~__FILE__
~__LINE__ ?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
let with_span_collector_ st (cbs : _ Collector.Callbacks.t) ?__FUNCTION__
~__FILE__ ~__LINE__ ?parent ?params ?data name f =
let sp : span =
enter_span_st st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent ?params ?data
name
in
match f sp with
| res ->
cbs.exit_span st sp;
res
| exception exn ->
let bt = Printexc.get_raw_backtrace () in
cbs.exit_span st sp;
Printexc.raise_with_backtrace exn bt
let[@inline] with_span ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent ?params
?data name f =
match A.get collector with match A.get collector with
| Some collector when check_level ?level () -> | C_some (st, cbs) when check_level ?level () ->
with_span_collector_ collector ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name with_span_collector_ st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent
f ?params ?data name f
| _ -> | _ ->
(* fast path: no collector, no span *) (* fast path: no collector, no span *)
f Collector.dummy_span f Collector.dummy_span
let[@inline] enter_span ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ let[@inline] enter_span ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent ?params
?(data = data_empty_build_) name : span = ?data name : span =
match A.get collector with match A.get collector with
| Some (module C) when check_level ?level () -> | C_some (st, cbs) when check_level ?level () ->
let data = data () in (enter_span_st [@inlined never]) st cbs ?__FUNCTION__ ~__FILE__ ~__LINE__
C.enter_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name ?parent ?params ?data name
| _ -> Collector.dummy_span | _ -> Collector.dummy_span
let[@inline] exit_span sp : unit = let[@inline] exit_span sp : unit =
match A.get collector with match A.get collector with
| None -> () | C_none -> ()
| Some (module C) -> C.exit_span sp | C_some (st, cbs) -> cbs.exit_span st sp
let enter_manual_span_collector_ (module C : Collector.S) ~parent ~flavor
?__FUNCTION__ ~__FILE__ ~__LINE__ ?(data = data_empty_build_) name :
explicit_span =
let data = data () in
C.enter_manual_span ~parent ~flavor ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data
name
let[@inline] enter_manual_span ~parent ?flavor ?level ?__FUNCTION__ ~__FILE__
~__LINE__ ?data name : explicit_span =
match A.get collector with
| Some coll when check_level ?level () ->
enter_manual_span_collector_ coll ~parent ~flavor ?__FUNCTION__ ~__FILE__
~__LINE__ ?data name
| _ -> Collector.dummy_explicit_span
let[@inline] enter_manual_toplevel_span ?flavor ?level ?__FUNCTION__ ~__FILE__
~__LINE__ ?data name : explicit_span =
enter_manual_span ~parent:None ?flavor ?level ?__FUNCTION__ ~__FILE__
~__LINE__ ?data name
let[@inline] enter_manual_sub_span ~parent ?flavor ?level ?__FUNCTION__
~__FILE__ ~__LINE__ ?data name : explicit_span =
enter_manual_span
~parent:(Some (ctx_of_span parent))
?flavor ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name
let[@inline] exit_manual_span espan : unit =
if espan != Collector.dummy_explicit_span then (
match A.get collector with
| None -> ()
| Some (module C) -> C.exit_manual_span espan
)
let[@inline] add_data_to_span sp data : unit = let[@inline] add_data_to_span sp data : unit =
if sp != Collector.dummy_span && data <> [] then ( if sp != Collector.dummy_span && data <> [] then (
match A.get collector with match A.get collector with
| None -> () | C_none -> ()
| Some (module C) -> C.add_data_to_span sp data | C_some (st, cbs) -> cbs.add_data_to_span st sp data
) )
let[@inline] add_data_to_manual_span esp data : unit = let message_collector_ st (cbs : _ Collector.Callbacks.t) ?span ?(params = [])
if esp != Collector.dummy_explicit_span && data <> [] then (
match A.get collector with
| None -> ()
| Some (module C) -> C.add_data_to_manual_span esp data
)
let message_collector_ (module C : Collector.S) ?span
?(data = data_empty_build_) msg : unit = ?(data = data_empty_build_) msg : unit =
let data = data () in let data = data () in
C.message ?span ~data msg cbs.message st ~span ~params ~data msg
let[@inline] message ?level ?span ?data msg : unit = let[@inline] message ?level ?span ?params ?data msg : unit =
match A.get collector with match A.get collector with
| Some coll when check_level ?level () -> | C_some (st, cbs) when check_level ?level () ->
message_collector_ coll ?span ?data msg (message_collector_ [@inlined never]) st cbs ?span ?params ?data msg
| _ -> () | _ -> ()
let messagef ?level ?span ?data k = let messagef ?level ?span ?params ?data k =
match A.get collector with match A.get collector with
| Some (module C) when check_level ?level () -> | C_some (st, cbs) when check_level ?level () ->
k (fun fmt -> k (fun fmt ->
Format.kasprintf Format.kasprintf
(fun str -> (fun str -> message_collector_ st cbs ?span ?params ?data str)
let data =
match data with
| None -> []
| Some f -> f ()
in
C.message ?span ~data str)
fmt) fmt)
| _ -> () | _ -> ()
let counter_int ?level ?(data = data_empty_build_) name n : unit = let counter_int ?level ?(params = []) ?(data = data_empty_build_) name n : unit
=
match A.get collector with match A.get collector with
| Some (module C) when check_level ?level () -> | C_some (st, cbs) when check_level ?level () ->
let data = data () in let data = data () in
C.counter_int ~data name n cbs.counter_int st ~params ~data name n
| _ -> () | _ -> ()
let counter_float ?level ?(data = data_empty_build_) name f : unit = let counter_float ?level ?(params = []) ?(data = data_empty_build_) name f :
unit =
match A.get collector with match A.get collector with
| Some (module C) when check_level ?level () -> | C_some (st, cbs) when check_level ?level () ->
let data = data () in let data = data () in
C.counter_float ~data name f cbs.counter_float st ~params ~data name f
| _ -> () | _ -> ()
let set_thread_name name : unit =
match A.get collector with
| None -> ()
| Some (module C) -> C.name_thread name
let set_process_name name : unit =
match A.get collector with
| None -> ()
| Some (module C) -> C.name_process name
let setup_collector c : unit = let setup_collector c : unit =
while while
let cur = A.get collector in let cur = A.get collector in
match cur with match cur with
| Some _ -> invalid_arg "trace: collector already present" | C_some _ -> invalid_arg "trace: collector already present"
| None -> not (A.compare_and_set collector cur (Some c)) | C_none -> not (A.compare_and_set collector cur c)
do do
() ()
done done
let shutdown () = let shutdown () =
match A.exchange collector None with match A.exchange collector C_none with
| None -> () | C_none -> ()
| Some (module C) -> C.shutdown () | C_some (st, cbs) -> cbs.shutdown st
type extension_event = Types.extension_event = .. type extension_event = Types.extension_event = ..
let[@inline] extension_event ev = let[@inline] extension_event ev : unit =
match A.get collector with match A.get collector with
| None -> () | C_none -> ()
| Some (module C) -> C.extension_event ev | C_some (st, cbs) -> cbs.extension st ev
let set_thread_name name : unit =
extension_event @@ Core_ext.Extension_set_thread_name name
let set_process_name name : unit =
extension_event @@ Core_ext.Extension_set_process_name name
module Internal_ = struct module Internal_ = struct
module Atomic_ = Atomic_ module Atomic_ = Atomic_
end end
(* ### deprecated *)
[@@@ocaml.alert "-deprecated"]
let enter_manual_span ~parent ?flavor ?level ?__FUNCTION__ ~__FILE__ ~__LINE__
?data name : explicit_span =
let params =
match flavor with
| None -> []
| Some f -> [ Core_ext.Extension_span_flavor f ]
in
enter_span ~parent ~params ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name
let enter_manual_toplevel_span ?flavor ?level ?__FUNCTION__ ~__FILE__ ~__LINE__
?data name : explicit_span =
enter_manual_span ~parent:None ?flavor ?level ?__FUNCTION__ ~__FILE__
~__LINE__ ?data name
let enter_manual_sub_span ~parent ?flavor ?level ?__FUNCTION__ ~__FILE__
~__LINE__ ?data name : explicit_span =
enter_manual_span ~parent:(Some parent) ?flavor ?level ?__FUNCTION__ ~__FILE__
~__LINE__ ?data name
let exit_manual_span = exit_span
let add_data_to_manual_span = add_data_to_span
[@@@ocaml.alert "+deprecated"]

187
src/core/trace_core.mli
View file

@ -31,15 +31,13 @@ val set_default_level : Level.t -> unit
is [Level.Trace]. is [Level.Trace].
@since 0.7 *) @since 0.7 *)
val ctx_of_span : explicit_span -> explicit_span_ctx
(** Turn a span into a span context.
@since 0.10 *)
val with_span : val with_span :
?level:Level.t -> ?level:Level.t ->
?__FUNCTION__:string -> ?__FUNCTION__:string ->
__FILE__:string -> __FILE__:string ->
__LINE__:int -> __LINE__:int ->
?parent:span option ->
?params:extension_parameter list ->
?data:(unit -> (string * user_data) list) -> ?data:(unit -> (string * user_data) list) ->
string -> string ->
(span -> 'a) -> (span -> 'a) ->
@ -53,106 +51,53 @@ val with_span :
@param level @param level
optional level for this span. since 0.7. Default is set via optional level for this span. since 0.7. Default is set via
{!set_default_level}. {!set_default_level}.
@param parent the span's parent, if any. since NEXT_RELEASE.
@param params
extension parameters, used to communicate additional information to the
collector. It might be collector-specific. since NEXT_RELEASE.
{b NOTE} an important restriction is that this is only supposed to work for Depending on the collector, this might clash with some forms of cooperative
synchronous, direct style code. Monadic concurrency, Effect-based fibers, concurrency in which [with_span (fun span -> …)] might contain a yield
etc. might not play well with this style of spans on some or all backends. point. Effect-based fibers, etc. might not play well with this style of
If you use cooperative concurrency, see {!enter_manual_span}. *) spans on some or all backends. If you use cooperative concurrency, a safer
alternative can be {!enter_span}. *)
val enter_span : val enter_span :
?level:Level.t -> ?level:Level.t ->
?__FUNCTION__:string -> ?__FUNCTION__:string ->
__FILE__:string -> __FILE__:string ->
__LINE__:int -> __LINE__:int ->
?parent:span option ->
?params:extension_parameter list ->
?data:(unit -> (string * user_data) list) -> ?data:(unit -> (string * user_data) list) ->
string -> string ->
span span
(** Enter a span manually. (** Enter a span manually. This means the caller is responsible for exiting the
span exactly once on every path that exits the current scope. The context
must be passed to the exit function as is.
@param level @param level
optional level for this span. since 0.7. Default is set via optional level for this span. since 0.7. Default is set via
{!set_default_level}. *) {!set_default_level}.
@param parent the span's parent, if any. since NEXT_RELEASE.
@param params see {!with_span}. *)
val exit_span : span -> unit val exit_span : span -> unit
(** Exit a span manually. This must run on the same thread as the corresponding (** Exit a span manually. Spans must be nested correctly (ie form a stack or
{!enter_span}, and spans must nest correctly. *) tree).
For some collectors, [enter_span] and [exit_span] must run on the same
thread (e.g. Tracy). For some others, it doesn't matter. *)
val add_data_to_span : span -> (string * user_data) list -> unit val add_data_to_span : span -> (string * user_data) list -> unit
(** Add structured data to the given active span (see {!with_span}). Behavior is (** Add structured data to the given active span (see {!with_span}). Behavior is
not specified if the span has been exited. not specified if the span has been exited.
@since 0.4 *) @since 0.4 *)
val enter_manual_span :
parent:explicit_span_ctx option ->
?flavor:span_flavor ->
?level:Level.t ->
?__FUNCTION__:string ->
__FILE__:string ->
__LINE__:int ->
?data:(unit -> (string * user_data) list) ->
string ->
explicit_span
(** Like {!with_span} but the caller is responsible for obtaining the [parent]
span from their {e own} caller, and carry the resulting {!explicit_span} to
the matching {!exit_manual_span}.
{b NOTE} this replaces [enter_manual_sub_span] and
[enter_manual_toplevel_span] by just making [parent] an explicit option. It
is breaking anyway because we now pass an {!explicit_span_ctx} instead of a
full {!explicit_span} (the reason being that we might receive this
explicit_span_ctx from another process or machine).
@param flavor
a description of the span that can be used by the {!Collector.S} to decide
how to represent the span. Typically, [`Sync] spans start and stop on one
thread, and are nested purely by their timestamp; and [`Async] spans can
overlap, migrate between threads, etc. (as happens in Lwt, Eio, Async,
etc.) which impacts how the collector might represent them.
@param level
optional level for this span. since 0.7. Default is set via
{!set_default_level}.
@since 0.10 *)
val enter_manual_sub_span :
parent:explicit_span ->
?flavor:[ `Sync | `Async ] ->
?level:Level.t ->
?__FUNCTION__:string ->
__FILE__:string ->
__LINE__:int ->
?data:(unit -> (string * user_data) list) ->
string ->
explicit_span
[@@deprecated "use enter_manual_span"]
(** @deprecated since 0.10, use {!enter_manual_span} *)
val enter_manual_toplevel_span :
?flavor:[ `Sync | `Async ] ->
?level:Level.t ->
?__FUNCTION__:string ->
__FILE__:string ->
__LINE__:int ->
?data:(unit -> (string * user_data) list) ->
string ->
explicit_span
[@@deprecated "use enter_manual_span"]
(** @deprecated since 0.10, use {!enter_manual_span} *)
val exit_manual_span : explicit_span -> unit
(** Exit an explicit span. This can be on another thread, in a fiber or
lightweight thread, etc. and will be supported by backends nonetheless. The
span can be obtained via {!enter_manual_sub_span} or
{!enter_manual_toplevel_span}.
@since 0.3 *)
val add_data_to_manual_span : explicit_span -> (string * user_data) list -> unit
(** [add_data_explicit esp data] adds [data] to the span [esp]. The behavior is
not specified is the span has been exited already.
@since 0.4 *)
val message : val message :
?level:Level.t -> ?level:Level.t ->
?span:span -> ?span:span ->
?params:extension_parameter list ->
?data:(unit -> (string * user_data) list) -> ?data:(unit -> (string * user_data) list) ->
string -> string ->
unit unit
@ -162,31 +107,39 @@ val message :
optional level for this span. since 0.7. Default is set via optional level for this span. since 0.7. Default is set via
{!set_default_level}. {!set_default_level}.
@param span @param span
the surrounding span, if any. This might be ignored by the collector. *) the surrounding span, if any. This might be ignored by the collector.
@param params
extension parameters, used to communicate additional information to the
collector. It might be collector-specific. since NEXT_RELEASE. *)
val messagef : val messagef :
?level:Level.t -> ?level:Level.t ->
?span:span -> ?span:span ->
?params:extension_parameter list ->
?data:(unit -> (string * user_data) list) -> ?data:(unit -> (string * user_data) list) ->
((('a, Format.formatter, unit, unit) format4 -> 'a) -> unit) -> ((('a, Format.formatter, unit, unit) format4 -> 'a) -> unit) ->
unit unit
(** [messagef (fun k->k"hello %s %d!" "world" 42)] is like (** [messagef (fun k->k"hello %s %d!" "world" 42)] is like
[message "hello world 42!"] but only computes the string formatting if a [message "hello world 42!"] but only computes the string formatting if a
collector is installed. collector is installed.
@param level
optional level for this span. since 0.7. Default is set via See {!message} for a description of the other arguments. *)
{!set_default_level}. *)
val set_thread_name : string -> unit val set_thread_name : string -> unit
(** Give a name to the current thread. This might be used by the collector to (** Give a name to the current thread. This might be used by the collector to
display traces in a more informative way. *) display traces in a more informative way.
Uses {!Core_ext.Extension_set_thread_name} since NEXT_RELEASE *)
val set_process_name : string -> unit val set_process_name : string -> unit
(** Give a name to the current process. This might be used by the collector to (** Give a name to the current process. This might be used by the collector to
display traces in a more informative way. *) display traces in a more informative way.
Uses {!Core_ext.Extension_set_process_name} since NEXT_RELEASE *)
val counter_int : val counter_int :
?level:Level.t -> ?level:Level.t ->
?params:extension_parameter list ->
?data:(unit -> (string * user_data) list) -> ?data:(unit -> (string * user_data) list) ->
string -> string ->
int -> int ->
@ -200,6 +153,7 @@ val counter_int :
val counter_float : val counter_float :
?level:Level.t -> ?level:Level.t ->
?params:extension_parameter list ->
?data:(unit -> (string * user_data) list) -> ?data:(unit -> (string * user_data) list) ->
string -> string ->
float -> float ->
@ -212,10 +166,8 @@ val counter_float :
(** {2 Collector} *) (** {2 Collector} *)
type collector = (module Collector.S) type collector = Collector.t
(** An event collector. (** An event collector. See {!Collector} for more details. *)
See {!Collector} for more details. *)
val setup_collector : collector -> unit val setup_collector : collector -> unit
(** [setup_collector c] installs [c] as the current collector. (** [setup_collector c] installs [c] as the current collector.
@ -246,3 +198,58 @@ val extension_event : extension_event -> unit
defines it. Some collectors will simply ignore it. This does nothing if no defines it. Some collectors will simply ignore it. This does nothing if no
collector is setup. collector is setup.
@since 0.8 *) @since 0.8 *)
(** {2 Core extensions} *)
module Core_ext = Core_ext
(** {2 Deprecated} *)
[@@@ocaml.alert "-deprecated"]
val enter_manual_span :
parent:explicit_span_ctx option ->
?flavor:[ `Sync | `Async ] ->
?level:Level.t ->
?__FUNCTION__:string ->
__FILE__:string ->
__LINE__:int ->
?data:(unit -> (string * user_data) list) ->
string ->
explicit_span
[@@deprecated "use enter_span"]
val enter_manual_sub_span :
parent:explicit_span ->
?flavor:[ `Sync | `Async ] ->
?level:Level.t ->
?__FUNCTION__:string ->
__FILE__:string ->
__LINE__:int ->
?data:(unit -> (string * user_data) list) ->
string ->
explicit_span
[@@deprecated "use enter_span"]
(** @deprecated since 0.10, use {!enter_span} *)
val enter_manual_toplevel_span :
?flavor:[ `Sync | `Async ] ->
?level:Level.t ->
?__FUNCTION__:string ->
__FILE__:string ->
__LINE__:int ->
?data:(unit -> (string * user_data) list) ->
string ->
explicit_span
[@@deprecated "use enter_span"]
(** @deprecated since 0.10 use {!enter_span} *)
val exit_manual_span : explicit_span -> unit
[@@deprecated "use exit_span"]
(** @deprecated since 0.10 use {!exit_span} *)
val add_data_to_manual_span : explicit_span -> (string * user_data) list -> unit
[@@deprecated "use add_data_to_span"]
(** @deprecated since 0.10 use {!add_data_to_span} *)
[@@@ocaml.alert "+deprecated"]

50
src/core/types.ml
View file

@ -1,12 +1,14 @@
type span = int64 (** Main type definitions *)
(** A span identifier.
The meaning of the identifier depends on the collector. *) type span = ..
(** A span. Its representation is defined by the current collector. *)
type trace_id = string (** Information about a span's parent span, if any.
(** A bytestring representing a (possibly distributed) trace made of async @since NEXT_RELEASE *)
spans. With opentelemetry this is 16 bytes. type parent =
@since 0.10 *) | P_unknown (** Parent is not specified at this point *)
| P_none (** We know the current span has no parent *)
| P_some of span (** We know the parent of the current span *)
type user_data = type user_data =
[ `Int of int [ `Int of int
@ -18,35 +20,15 @@ type user_data =
(** User defined data, generally passed as key/value pairs to whatever collector (** User defined data, generally passed as key/value pairs to whatever collector
is installed (if any). *) is installed (if any). *)
type span_flavor = type explicit_span = span [@@deprecated "use span"]
[ `Sync type explicit_span_ctx = span [@@deprecated "use span"]
| `Async
]
(** Some information about the span.
@since NEXT_RELEASE *)
type explicit_span_ctx = {
span: span; (** The current span *)
trace_id: trace_id; (** The trace this belongs to *)
}
(** A context, passed around for async traces.
@since 0.10 *)
type explicit_span = {
span: span;
(** Identifier for this span. Several explicit spans might share the same
identifier since we can differentiate between them via [meta]. *)
trace_id: trace_id; (** The trace this belongs to *)
mutable meta: Meta_map.t;
(** Metadata for this span (and its context). This can be used by
collectors to carry collector-specific information from the beginning
of the span, to the end of the span. *)
}
(** Explicit span, with collector-specific metadata. This is richer than
{!explicit_span_ctx} but not intended to be passed around (or sent across
the wire), unlike {!explicit_span_ctx}. *)
type extension_event = .. type extension_event = ..
(** An extension event, used to add features that are backend specific or simply (** An extension event, used to add features that are backend specific or simply
not envisioned by [trace]. not envisioned by [trace].
@since 0.8 *) @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 *)