mirror of
https://github.com/ocaml-tracing/ocaml-trace.git
synced 2026-03-08 03:47:57 -04:00
trace.subscriber: define custom span, simplify subscriber callbacks
- custom span carries around all the required data, including mutable args - no more manual enter/exit callbacks - use record for callbacks - no more big Span_tbl
This commit is contained in:
Simon Cruanes
parent
40b44349e7
commit
a1837e402e
14 changed files with 234 additions and 451 deletions
|
|
@ -23,107 +23,43 @@
|
|||
|
||||
open Trace_core
|
||||
|
||||
(** First class module signature for callbacks *)
|
||||
module type S = sig
|
||||
type st
|
||||
(** Type of the state passed to every callback. *)
|
||||
|
||||
val on_init : st -> time_ns:int64 -> unit
|
||||
(** Called when the subscriber is initialized in a collector *)
|
||||
|
||||
val new_span : st -> span
|
||||
(** How to generate a new span?
|
||||
@since NEXT_RELEASE *)
|
||||
|
||||
val new_trace_id : st -> trace_id
|
||||
(** How to generate a new trace ID?
|
||||
@since NEXT_RELEASE *)
|
||||
|
||||
val on_shutdown : st -> time_ns:int64 -> unit
|
||||
(** Called when the collector is shutdown *)
|
||||
|
||||
val on_name_thread : st -> time_ns:int64 -> tid:int -> name:string -> unit
|
||||
(** Current thread is being named *)
|
||||
|
||||
val on_name_process : st -> time_ns:int64 -> tid:int -> name:string -> unit
|
||||
(** Current process is being named *)
|
||||
|
||||
val on_enter_span :
|
||||
st ->
|
||||
__FUNCTION__:string option ->
|
||||
__FILE__:string ->
|
||||
__LINE__:int ->
|
||||
type 'st t = {
|
||||
on_init: 'st -> time_ns:int64 -> unit;
|
||||
(** Called when the subscriber is initialized in a collector *)
|
||||
new_span_id: 'st -> Span_sub.span_id;
|
||||
(** How to generate a new span ID?
|
||||
@since NEXT_RELEASE *)
|
||||
on_shutdown: 'st -> time_ns:int64 -> unit;
|
||||
(** Called when the collector is shutdown *)
|
||||
on_enter_span: 'st -> Span_sub.t -> unit; (** Enter a span *)
|
||||
on_exit_span: 'st -> time_ns:int64 -> tid:int -> Span_sub.t -> unit;
|
||||
(** Exit a span. This and [on_enter_span] must follow strict stack
|
||||
discipline.
|
||||
@param tid the id of the thread on which the span was exited. *)
|
||||
on_message:
|
||||
'st ->
|
||||
time_ns:int64 ->
|
||||
tid:int ->
|
||||
data:(string * Trace_core.user_data) list ->
|
||||
name:string ->
|
||||
span ->
|
||||
unit
|
||||
(** Enter a regular (sync) span *)
|
||||
|
||||
val on_exit_span : st -> time_ns:int64 -> tid:int -> span -> unit
|
||||
(** Exit a span. This and [on_enter_span] must follow strict stack discipline
|
||||
*)
|
||||
|
||||
val on_add_data :
|
||||
st -> data:(string * Trace_core.user_data) list -> span -> unit
|
||||
(** Add data to a regular span (which must be active) *)
|
||||
|
||||
val on_message :
|
||||
st ->
|
||||
time_ns:int64 ->
|
||||
tid:int ->
|
||||
span:span option ->
|
||||
span:Span_sub.t option ->
|
||||
params:extension_parameter list ->
|
||||
data:(string * Trace_core.user_data) list ->
|
||||
string ->
|
||||
unit
|
||||
(** Emit a log message *)
|
||||
|
||||
val on_counter :
|
||||
st ->
|
||||
unit;
|
||||
(** Emit a log message *)
|
||||
on_counter:
|
||||
'st ->
|
||||
time_ns:int64 ->
|
||||
tid:int ->
|
||||
params:extension_parameter list ->
|
||||
data:(string * Trace_core.user_data) list ->
|
||||
name:string ->
|
||||
float ->
|
||||
unit
|
||||
(** Emit the current value of a counter *)
|
||||
|
||||
val on_enter_manual_span :
|
||||
st ->
|
||||
__FUNCTION__:string option ->
|
||||
__FILE__:string ->
|
||||
__LINE__:int ->
|
||||
time_ns:int64 ->
|
||||
tid:int ->
|
||||
parent:span option ->
|
||||
data:(string * Trace_core.user_data) list ->
|
||||
name:string ->
|
||||
flavor:Trace_core.span_flavor option ->
|
||||
trace_id:trace_id ->
|
||||
span ->
|
||||
unit
|
||||
(** Enter a manual (possibly async) span *)
|
||||
|
||||
val on_exit_manual_span :
|
||||
st ->
|
||||
time_ns:int64 ->
|
||||
tid:int ->
|
||||
name:string ->
|
||||
data:(string * Trace_core.user_data) list ->
|
||||
flavor:Trace_core.span_flavor option ->
|
||||
trace_id:trace_id ->
|
||||
span ->
|
||||
unit
|
||||
(** Exit a manual span *)
|
||||
|
||||
val on_extension_event :
|
||||
st -> time_ns:int64 -> tid:int -> extension_event -> unit
|
||||
(** Extension event
|
||||
@since 0.8 *)
|
||||
end
|
||||
|
||||
type 'st t = (module S with type st = 'st)
|
||||
unit;
|
||||
(** Emit the current value of a counter *)
|
||||
on_extension_event: 'st -> time_ns:int64 -> tid:int -> extension_event -> unit;
|
||||
(** Extension event
|
||||
@since 0.8 *)
|
||||
}
|
||||
(** Callbacks for a subscriber. There is one callback per event in {!Trace}. The
|
||||
type ['st] is the state that is passed to every single callback. *)
|
||||
|
||||
|
|
@ -141,37 +77,32 @@ type 'st t = (module S with type st = 'st)
|
|||
]} *)
|
||||
module Dummy = struct
|
||||
let on_init _ ~time_ns:_ = ()
|
||||
let new_span _ = Collector.dummy_span
|
||||
let new_trace_id _ = Collector.dummy_trace_id
|
||||
let new_span_id _ = Int64.min_int
|
||||
let on_shutdown _ ~time_ns:_ = ()
|
||||
let on_name_thread _ ~time_ns:_ ~tid:_ ~name:_ = ()
|
||||
let on_name_process _ ~time_ns:_ ~tid:_ ~name:_ = ()
|
||||
let on_message _ ~time_ns:_ ~tid:_ ~span:_ ~data:_ _msg = ()
|
||||
let on_counter _ ~time_ns:_ ~tid:_ ~data:_ ~name:_ _v = ()
|
||||
|
||||
let on_enter_span _ ~__FUNCTION__:_ ~__FILE__:_ ~__LINE__:_ ~time_ns:_ ~tid:_
|
||||
~data:_ ~name:_ _sp =
|
||||
()
|
||||
|
||||
let on_message _ ~time_ns:_ ~tid:_ ~span:_ ~params:_ ~data:_ _msg = ()
|
||||
let on_counter _ ~time_ns:_ ~tid:_ ~params:_ ~data:_ ~name:_ _v = ()
|
||||
let on_enter_span _ _sp = ()
|
||||
let on_exit_span _ ~time_ns:_ ~tid:_ _ = ()
|
||||
let on_add_data _ ~data:_ _sp = ()
|
||||
|
||||
let on_enter_manual_span _ ~__FUNCTION__:_ ~__FILE__:_ ~__LINE__:_ ~time_ns:_
|
||||
~tid:_ ~parent:_ ~data:_ ~name:_ ~flavor:_ ~trace_id:_ _sp =
|
||||
()
|
||||
|
||||
let on_exit_manual_span _ ~time_ns:_ ~tid:_ ~name:_ ~data:_ ~flavor:_
|
||||
~trace_id:_ _ =
|
||||
()
|
||||
|
||||
let on_extension_event _ ~time_ns:_ ~tid:_ _ = ()
|
||||
end
|
||||
|
||||
(** Dummy callbacks, ignores all events. *)
|
||||
let dummy (type st) () : st t =
|
||||
let module M = struct
|
||||
type nonrec st = st
|
||||
(** Build a set of callbacks.
|
||||
@since NEXT_RELEASE *)
|
||||
let make ?(on_init = Dummy.on_init) ?(new_span_id = Dummy.new_span_id)
|
||||
?(on_enter_span = Dummy.on_enter_span) ?(on_exit_span = Dummy.on_exit_span)
|
||||
?(on_message = Dummy.on_message) ?(on_counter = Dummy.on_counter)
|
||||
?(on_extension_event = Dummy.on_extension_event)
|
||||
?(on_shutdown = Dummy.on_shutdown) () : _ t =
|
||||
{
|
||||
on_init;
|
||||
new_span_id;
|
||||
on_enter_span;
|
||||
on_exit_span;
|
||||
on_message;
|
||||
on_counter;
|
||||
on_extension_event;
|
||||
on_shutdown;
|
||||
}
|
||||
|
||||
include Dummy
|
||||
end in
|
||||
(module M)
|
||||
(** Dummy callbacks, ignores all events. *)
|
||||
let dummy () : _ t = make ()
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
(library
|
||||
(name trace_subscriber)
|
||||
(public_name trace.subscriber)
|
||||
(private_modules time_ thread_ tbl_)
|
||||
(private_modules time_ thread_)
|
||||
(libraries
|
||||
(re_export trace.core)
|
||||
(select
|
||||
|
|
@ -9,12 +9,6 @@
|
|||
from
|
||||
(threads -> thread_.real.ml)
|
||||
(-> thread_.dummy.ml))
|
||||
(select
|
||||
tbl_.ml
|
||||
from
|
||||
(picos_aux.htbl -> tbl_.picos.ml)
|
||||
(threads -> tbl_.thread.ml)
|
||||
(-> tbl_.basic.ml))
|
||||
(select
|
||||
time_.ml
|
||||
from
|
||||
|
|
|
|||
33
src/subscriber/span_sub.ml
Normal file
33
src/subscriber/span_sub.ml
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
(** Subscriber span.
|
||||
|
||||
This is the concrete representation of spans used in [Trace_subscriber].
|
||||
|
||||
@since NEXT_RELEASE *)
|
||||
|
||||
open Trace_core
|
||||
|
||||
type span_id = int64
|
||||
(** Unique ID *)
|
||||
|
||||
type span_flavor =
|
||||
[ `Sync
|
||||
| `Async
|
||||
]
|
||||
|
||||
type t = {
|
||||
id: span_id;
|
||||
name: string;
|
||||
__FUNCTION__: string option;
|
||||
__FILE__: string;
|
||||
__LINE__: int;
|
||||
time_ns: int64; (** Time the span was entered. *)
|
||||
mutable time_exit_ns: int64;
|
||||
(** Time the span was exited. Set at exit, [Int64.max_int] otherwise *)
|
||||
tid: int; (** Thread in which span was created *)
|
||||
parent: parent;
|
||||
flavor: span_flavor;
|
||||
params: extension_parameter list;
|
||||
mutable data: (string * Trace_core.user_data) list;
|
||||
(** Modified by [add_data_to_span] *)
|
||||
}
|
||||
(** The type of spans used by all subscribers. *)
|
||||
|
|
@ -1 +0,0 @@
|
|||
include Tbl_
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
(** A table that can be used to remember information about spans.
|
||||
|
||||
This is convenient when we want to rememner information from a span begin,
|
||||
when dealing with the corresponding span end.
|
||||
|
||||
{b NOTE}: this is thread safe when threads are enabled. *)
|
||||
|
||||
open Trace_core
|
||||
|
||||
type 'v t
|
||||
|
||||
val create : unit -> 'v t
|
||||
val add : 'v t -> span -> 'v -> unit
|
||||
|
||||
val find_exn : 'v t -> span -> 'v
|
||||
(** @raise Not_found if information isn't found *)
|
||||
|
||||
val remove : _ t -> span -> unit
|
||||
(** Remove the span if present *)
|
||||
|
||||
val to_list : 'v t -> (span * 'v) list
|
||||
|
|
@ -17,95 +17,65 @@ type t =
|
|||
let dummy : t = Sub { st = (); callbacks = Callbacks.dummy () }
|
||||
|
||||
open struct
|
||||
module Tee_cb : Callbacks.S with type st = t array = struct
|
||||
type nonrec st = t array
|
||||
type st = t array
|
||||
|
||||
let new_span st =
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st 0 in
|
||||
CB.new_span s
|
||||
let new_span_id (st : st) =
|
||||
let (Sub { st; callbacks = cb }) = Array.get st 0 in
|
||||
cb.new_span_id st
|
||||
|
||||
let new_trace_id st =
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st 0 in
|
||||
CB.new_trace_id s
|
||||
let on_init st ~time_ns =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st; callbacks = cb }) = Array.get st i in
|
||||
cb.on_init st ~time_ns
|
||||
done
|
||||
|
||||
let on_init st ~time_ns =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_init s ~time_ns
|
||||
done
|
||||
let on_shutdown st ~time_ns =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st; callbacks = cb }) = Array.get st i in
|
||||
cb.on_shutdown st ~time_ns
|
||||
done
|
||||
|
||||
let on_shutdown st ~time_ns =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_shutdown s ~time_ns
|
||||
done
|
||||
let on_enter_span st span =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st; callbacks = cb }) = Array.get st i in
|
||||
cb.on_enter_span st span
|
||||
done
|
||||
|
||||
let on_name_thread st ~time_ns ~tid ~name =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_name_thread s ~time_ns ~tid ~name
|
||||
done
|
||||
let on_exit_span st ~time_ns ~tid span =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st; callbacks = cb }) = Array.get st i in
|
||||
cb.on_exit_span st ~time_ns ~tid span
|
||||
done
|
||||
|
||||
let on_name_process st ~time_ns ~tid ~name =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_name_process s ~time_ns ~tid ~name
|
||||
done
|
||||
let on_message st ~time_ns ~tid ~span ~params ~data msg =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st; callbacks = cb }) = Array.get st i in
|
||||
cb.on_message st ~time_ns ~tid ~span ~params ~data msg
|
||||
done
|
||||
|
||||
let on_enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data
|
||||
~name span =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_enter_span s ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data
|
||||
~name span
|
||||
done
|
||||
let on_counter st ~time_ns ~tid ~params ~data ~name n =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st; callbacks = cb }) = Array.get st i in
|
||||
cb.on_counter st ~time_ns ~tid ~params ~data ~name n
|
||||
done
|
||||
|
||||
let on_exit_span st ~time_ns ~tid span =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_exit_span s ~time_ns ~tid span
|
||||
done
|
||||
let on_extension_event st ~time_ns ~tid ev : unit =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st; callbacks = cb }) = Array.get st i in
|
||||
cb.on_extension_event st ~time_ns ~tid ev
|
||||
done
|
||||
|
||||
let on_add_data st ~data span =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_add_data s ~data span
|
||||
done
|
||||
|
||||
let on_message st ~time_ns ~tid ~span ~data msg =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_message s ~time_ns ~tid ~span ~data msg
|
||||
done
|
||||
|
||||
let on_counter st ~time_ns ~tid ~data ~name n =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_counter s ~time_ns ~tid ~data ~name n
|
||||
done
|
||||
|
||||
let on_enter_manual_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid
|
||||
~parent ~data ~name ~flavor ~trace_id span =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_enter_manual_span s ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns
|
||||
~tid ~parent ~data ~name ~flavor ~trace_id span
|
||||
done
|
||||
|
||||
let on_exit_manual_span st ~time_ns ~tid ~name ~data ~flavor ~trace_id span
|
||||
=
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_exit_manual_span s ~time_ns ~tid ~name ~data ~flavor ~trace_id
|
||||
span
|
||||
done
|
||||
|
||||
let on_extension_event st ~time_ns ~tid ev : unit =
|
||||
for i = 0 to Array.length st - 1 do
|
||||
let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
|
||||
CB.on_extension_event s ~time_ns ~tid ev
|
||||
done
|
||||
end
|
||||
let tee_cb : t array Callbacks.t =
|
||||
{
|
||||
Callbacks.on_init;
|
||||
new_span_id;
|
||||
on_enter_span;
|
||||
on_exit_span;
|
||||
on_message;
|
||||
on_counter;
|
||||
on_extension_event;
|
||||
on_shutdown;
|
||||
}
|
||||
end
|
||||
|
||||
(** Tee multiple subscribers, ie return a subscriber that forwards to every
|
||||
|
|
@ -117,7 +87,7 @@ let tee_l (subs : t list) : t =
|
|||
match subs with
|
||||
| [] -> dummy
|
||||
| [ s ] -> s
|
||||
| l -> Sub { st = Array.of_list l; callbacks = (module Tee_cb) }
|
||||
| l -> Sub { st = Array.of_list l; callbacks = tee_cb }
|
||||
|
||||
(** [tee s1 s2] is a subscriber that forwards every call to [s1] and [s2] both.
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -1,13 +0,0 @@
|
|||
module T = Hashtbl.Make (struct
|
||||
include Int64
|
||||
|
||||
let hash = Hashtbl.hash
|
||||
end)
|
||||
|
||||
type 'v t = 'v T.t
|
||||
|
||||
let create () : _ t = T.create 32
|
||||
let find_exn = T.find
|
||||
let remove = T.remove
|
||||
let add = T.replace
|
||||
let to_list self : _ list = T.fold (fun k v l -> (k, v) :: l) self []
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
type 'v t
|
||||
|
||||
val create : unit -> 'v t
|
||||
val add : 'v t -> int64 -> 'v -> unit
|
||||
val find_exn : 'v t -> int64 -> 'v
|
||||
val remove : _ t -> int64 -> unit
|
||||
val to_list : 'v t -> (int64 * 'v) list
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
module H = Picos_aux_htbl
|
||||
|
||||
module Key = struct
|
||||
include Int64
|
||||
|
||||
let hash = Hashtbl.hash
|
||||
end
|
||||
|
||||
type 'v t = (int64, 'v) H.t
|
||||
|
||||
let create () : _ t = H.create ~hashed_type:(module Key) ()
|
||||
let find_exn = H.find_exn
|
||||
let[@inline] remove self k = ignore (H.try_remove self k : bool)
|
||||
|
||||
let[@inline] add self k v =
|
||||
if not (H.try_add self k v) then ignore (H.try_set self k v)
|
||||
|
||||
let[@inline] to_list self = H.to_seq self |> List.of_seq
|
||||
|
|
@ -1,38 +0,0 @@
|
|||
module T = Hashtbl.Make (struct
|
||||
include Int64
|
||||
|
||||
let hash = Hashtbl.hash
|
||||
end)
|
||||
|
||||
type 'v t = {
|
||||
tbl: 'v T.t;
|
||||
lock: Mutex.t;
|
||||
}
|
||||
|
||||
let create () : _ t = { tbl = T.create 32; lock = Mutex.create () }
|
||||
|
||||
let find_exn self k =
|
||||
Mutex.lock self.lock;
|
||||
try
|
||||
let v = T.find self.tbl k in
|
||||
Mutex.unlock self.lock;
|
||||
v
|
||||
with e ->
|
||||
Mutex.unlock self.lock;
|
||||
raise e
|
||||
|
||||
let remove self k =
|
||||
Mutex.lock self.lock;
|
||||
T.remove self.tbl k;
|
||||
Mutex.unlock self.lock
|
||||
|
||||
let add self k v =
|
||||
Mutex.lock self.lock;
|
||||
T.replace self.tbl k v;
|
||||
Mutex.unlock self.lock
|
||||
|
||||
let to_list self : _ list =
|
||||
Mutex.lock self.lock;
|
||||
let l = T.fold (fun k v l -> (k, v) :: l) self.tbl [] in
|
||||
Mutex.unlock self.lock;
|
||||
l
|
||||
|
|
@ -1 +0,0 @@
|
|||
let[@inline] get_time_ns () : int64 = 0L
|
||||
|
|
@ -1 +0,0 @@
|
|||
val get_time_ns : unit -> int64
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
open Trace_core
|
||||
module Callbacks = Callbacks
|
||||
module Subscriber = Subscriber
|
||||
module Span_tbl = Span_tbl
|
||||
module Span_sub = Span_sub
|
||||
|
||||
type t = Subscriber.t
|
||||
|
||||
|
|
@ -26,127 +26,104 @@ end
|
|||
|
||||
open struct
|
||||
module A = Trace_core.Internal_.Atomic_
|
||||
open Private_
|
||||
|
||||
type manual_span_info = {
|
||||
name: string;
|
||||
flavor: Trace_core.span_flavor option;
|
||||
mutable data: (string * Trace_core.user_data) list;
|
||||
}
|
||||
type Trace_core.span += Span_sub of Span_sub.t
|
||||
|
||||
(** Key used to carry some information between begin and end of manual spans,
|
||||
by way of the meta map *)
|
||||
let key_manual_info : manual_span_info Meta_map.key = Meta_map.Key.create ()
|
||||
let enter_span (Subscriber.Sub { st; callbacks = cb }) ~__FUNCTION__ ~__FILE__
|
||||
~__LINE__ ~params ~data ~parent name : span =
|
||||
let id = cb.new_span_id st in
|
||||
let tid = tid_ () in
|
||||
let time_ns = now_ns () in
|
||||
|
||||
let flavor = ref `Sync in
|
||||
List.iter
|
||||
(function
|
||||
| Core_ext.Extension_span_flavor f -> flavor := f
|
||||
| _ -> ())
|
||||
params;
|
||||
|
||||
let span : Span_sub.t =
|
||||
{
|
||||
name;
|
||||
id;
|
||||
tid;
|
||||
__FUNCTION__;
|
||||
__FILE__;
|
||||
__LINE__;
|
||||
data;
|
||||
parent;
|
||||
flavor = !flavor;
|
||||
params;
|
||||
time_ns;
|
||||
time_exit_ns = Int64.max_int;
|
||||
}
|
||||
in
|
||||
|
||||
cb.on_enter_span st span;
|
||||
|
||||
Span_sub span
|
||||
|
||||
let exit_span (Subscriber.Sub { st; callbacks = cb }) span : unit =
|
||||
match span with
|
||||
| Span_sub span ->
|
||||
let time_ns = now_ns () in
|
||||
span.time_exit_ns <- time_ns;
|
||||
let tid = tid_ () in
|
||||
cb.on_exit_span st ~time_ns ~tid span
|
||||
| _ -> ()
|
||||
|
||||
let add_data_to_span _sub span data =
|
||||
match span with
|
||||
| Span_sub span -> span.data <- List.rev_append data span.data
|
||||
| _ -> ()
|
||||
|
||||
let message (Subscriber.Sub { st; callbacks = cb }) ~params ~data ~span msg :
|
||||
unit =
|
||||
let time_ns = now_ns () in
|
||||
let tid = tid_ () in
|
||||
let span =
|
||||
match span with
|
||||
| Some (Span_sub s) -> Some s
|
||||
| _ -> None
|
||||
in
|
||||
cb.on_message st ~time_ns ~tid ~span ~params ~data msg
|
||||
|
||||
let counter_float (Subscriber.Sub { st; callbacks = cb }) ~params ~data name f
|
||||
: unit =
|
||||
let time_ns = now_ns () in
|
||||
let tid = tid_ () in
|
||||
cb.on_counter st ~tid ~time_ns ~params ~data ~name f
|
||||
|
||||
let[@inline] counter_int sub ~params ~data name i =
|
||||
counter_float sub ~params ~data name (float_of_int i)
|
||||
|
||||
let init (Subscriber.Sub { st; callbacks = cb }) =
|
||||
(* init code *)
|
||||
let time_ns = now_ns () in
|
||||
cb.on_init st ~time_ns
|
||||
|
||||
let shutdown (Subscriber.Sub { st; callbacks = cb }) =
|
||||
let time_ns = now_ns () in
|
||||
cb.on_shutdown st ~time_ns
|
||||
|
||||
let extension_event (Subscriber.Sub { st; callbacks = cb }) ev =
|
||||
let tid = tid_ () in
|
||||
let time_ns = now_ns () in
|
||||
cb.on_extension_event st ~time_ns ~tid ev
|
||||
|
||||
(* TODO: do we want to track this? *)
|
||||
let current_span _ = None
|
||||
|
||||
let coll_cbs : t Collector.Callbacks.t =
|
||||
Collector.Callbacks.make ~enter_span ~exit_span ~current_span ~message
|
||||
~add_data_to_span ~counter_int ~counter_float ~extension:extension_event
|
||||
~init ~shutdown ()
|
||||
end
|
||||
|
||||
(** A collector that calls the callbacks of subscriber *)
|
||||
let collector (Sub { st; callbacks = (module CB) } : Subscriber.t) : collector =
|
||||
let open Private_ in
|
||||
let module M = struct
|
||||
let enter_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : span =
|
||||
let span = CB.new_span st in
|
||||
let tid = tid_ () in
|
||||
let time_ns = now_ns () in
|
||||
CB.on_enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data
|
||||
~name span;
|
||||
span
|
||||
|
||||
let exit_span span : unit =
|
||||
let time_ns = now_ns () in
|
||||
let tid = tid_ () in
|
||||
CB.on_exit_span st ~time_ns ~tid span
|
||||
|
||||
let with_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name f =
|
||||
let span = enter_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name in
|
||||
try
|
||||
let x = f span in
|
||||
exit_span span;
|
||||
x
|
||||
with exn ->
|
||||
let bt = Printexc.get_raw_backtrace () in
|
||||
exit_span span;
|
||||
Printexc.raise_with_backtrace exn bt
|
||||
|
||||
let add_data_to_span span data =
|
||||
if data <> [] then CB.on_add_data st ~data span
|
||||
|
||||
let enter_manual_span ~(parent : explicit_span_ctx option) ~flavor
|
||||
~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : explicit_span =
|
||||
let span = CB.new_span st in
|
||||
let tid = tid_ () in
|
||||
let time_ns = now_ns () in
|
||||
|
||||
(* get the common trace id, or make a new one *)
|
||||
let trace_id, parent =
|
||||
match parent with
|
||||
| Some m -> m.trace_id, Some m.span
|
||||
| None -> CB.new_trace_id st, None
|
||||
in
|
||||
|
||||
CB.on_enter_manual_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~parent ~data
|
||||
~time_ns ~tid ~name ~flavor ~trace_id span;
|
||||
let meta =
|
||||
Meta_map.empty
|
||||
|> Meta_map.add key_manual_info { name; flavor; data = [] }
|
||||
in
|
||||
{ span; trace_id; meta }
|
||||
|
||||
let exit_manual_span (es : explicit_span) : unit =
|
||||
let time_ns = now_ns () in
|
||||
let tid = tid_ () in
|
||||
let trace_id = es.trace_id in
|
||||
let minfo =
|
||||
match Meta_map.find key_manual_info es.meta with
|
||||
| None -> assert false
|
||||
| Some m -> m
|
||||
in
|
||||
CB.on_exit_manual_span st ~tid ~time_ns ~data:minfo.data ~name:minfo.name
|
||||
~flavor:minfo.flavor ~trace_id es.span
|
||||
|
||||
let add_data_to_manual_span (es : explicit_span) data =
|
||||
if data <> [] then (
|
||||
match Meta_map.find key_manual_info es.meta with
|
||||
| None -> assert false
|
||||
| Some m -> m.data <- List.rev_append data m.data
|
||||
)
|
||||
|
||||
let message ?span ~data msg : unit =
|
||||
let time_ns = now_ns () in
|
||||
let tid = tid_ () in
|
||||
CB.on_message st ~time_ns ~tid ~span ~data msg
|
||||
|
||||
let counter_float ~data name f : unit =
|
||||
let time_ns = now_ns () in
|
||||
let tid = tid_ () in
|
||||
CB.on_counter st ~tid ~time_ns ~data ~name f
|
||||
|
||||
let[@inline] counter_int ~data name i =
|
||||
counter_float ~data name (float_of_int i)
|
||||
|
||||
let name_process name : unit =
|
||||
let tid = tid_ () in
|
||||
let time_ns = now_ns () in
|
||||
CB.on_name_process st ~time_ns ~tid ~name
|
||||
|
||||
let name_thread name : unit =
|
||||
let tid = tid_ () in
|
||||
let time_ns = now_ns () in
|
||||
CB.on_name_thread st ~time_ns ~tid ~name
|
||||
|
||||
let shutdown () =
|
||||
let time_ns = now_ns () in
|
||||
CB.on_shutdown st ~time_ns
|
||||
|
||||
let extension_event ev =
|
||||
let tid = tid_ () in
|
||||
let time_ns = now_ns () in
|
||||
CB.on_extension_event st ~time_ns ~tid ev
|
||||
|
||||
let () =
|
||||
(* init code *)
|
||||
let time_ns = now_ns () in
|
||||
CB.on_init st ~time_ns
|
||||
end in
|
||||
(module M)
|
||||
let collector (self : Subscriber.t) : collector =
|
||||
Collector.C_some (self, coll_cbs)
|
||||
|
||||
module Span_generator = struct
|
||||
type t = int A.t
|
||||
|
|
@ -154,15 +131,3 @@ module Span_generator = struct
|
|||
let create () = A.make 0
|
||||
let[@inline] mk_span self = A.fetch_and_add self 1 |> Int64.of_int
|
||||
end
|
||||
|
||||
module Trace_id_8B_generator = struct
|
||||
type t = int A.t
|
||||
|
||||
let create () = A.make 0
|
||||
|
||||
let[@inline] mk_trace_id (self : t) : trace_id =
|
||||
let n = A.fetch_and_add self 1 in
|
||||
let b = Bytes.create 8 in
|
||||
Bytes.set_int64_le b 0 (Int64.of_int n);
|
||||
Bytes.unsafe_to_string b
|
||||
end
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
|
||||
module Callbacks = Callbacks
|
||||
module Subscriber = Subscriber
|
||||
module Span_tbl = Span_tbl
|
||||
module Span_sub = Span_sub
|
||||
|
||||
(** {2 Main API} *)
|
||||
|
||||
|
|
@ -24,9 +24,8 @@ type t = Subscriber.t
|
|||
whenever the trace collector invokes the callbacks. *)
|
||||
|
||||
val collector : t -> Trace_core.collector
|
||||
(** A collector that calls the subscriber's callbacks.
|
||||
|
||||
It uses [mtime] (if available) to obtain timestamps. *)
|
||||
(** A collector that calls the subscriber's callbacks. It uses [mtime] (if
|
||||
available) to obtain timestamps. *)
|
||||
|
||||
(** A counter-based span generator.
|
||||
@since NEXT_RELEASE *)
|
||||
|
|
@ -34,16 +33,7 @@ module Span_generator : sig
|
|||
type t
|
||||
|
||||
val create : unit -> t
|
||||
val mk_span : t -> Trace_core.span
|
||||
end
|
||||
|
||||
(** A counter-based trace ID generator, producing 8-byte trace IDs.
|
||||
@since NEXT_RELEASE *)
|
||||
module Trace_id_8B_generator : sig
|
||||
type t
|
||||
|
||||
val create : unit -> t
|
||||
val mk_trace_id : t -> Trace_core.trace_id
|
||||
val mk_span : t -> Span_sub.span_id
|
||||
end
|
||||
|
||||
(**/**)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue