diff --git a/src/event/dune b/src/event/dune new file mode 100644 index 0000000..051a6f0 --- /dev/null +++ b/src/event/dune @@ -0,0 +1,7 @@ + +(library + (name trace_event) + (public_name trace.event) + (synopsis "Turns subscriber callbacks into an event type") + (libraries + (re_export trace.core) (re_export trace.subscriber))) diff --git a/src/event/event.ml b/src/event/event.ml new file mode 100644 index 0000000..7ccb4d2 --- /dev/null +++ b/src/event/event.ml @@ -0,0 +1,63 @@ +open Trace_core +module Sub = Trace_subscriber + +(** An event with TEF/fuchsia semantics *) +type t = + | E_tick + | E_init of { time_ns: int64 } + | E_shutdown of { time_ns: int64 } + | E_message of { + tid: int; + msg: string; + time_ns: int64; + data: (string * Sub.user_data) list; + } + | E_define_span of { + tid: int; + name: string; + time_ns: int64; + id: span; + fun_name: string option; + data: (string * Sub.user_data) list; + } + | E_exit_span of { + id: span; + time_ns: int64; + } + | E_add_data of { + id: span; + data: (string * Sub.user_data) list; + } + | E_enter_manual_span of { + tid: int; + name: string; + time_ns: int64; + id: trace_id; + flavor: Sub.flavor option; + fun_name: string option; + data: (string * Sub.user_data) list; + } + | E_exit_manual_span of { + tid: int; + name: string; + time_ns: int64; + flavor: Sub.flavor option; + data: (string * Sub.user_data) list; + id: trace_id; + } + | E_counter of { + name: string; + tid: int; + time_ns: int64; + n: float; + } + | E_name_process of { name: string } + | E_name_thread of { + tid: int; + name: string; + } + | E_extension_event of { + tid: int; + time_ns: int64; + ext: Trace_core.extension_event; + } diff --git a/src/event/subscriber.ml b/src/event/subscriber.ml new file mode 100644 index 0000000..11edab7 --- /dev/null +++ b/src/event/subscriber.ml @@ -0,0 +1,53 @@ +open Trace_core +open Event + +type event_consumer = { on_event: Event.t -> unit } [@@unboxed] +(** Callback for events *) + +module Callbacks : Sub.Callbacks.S with type st = event_consumer = struct + type st = event_consumer + + let on_init (self : st) ~time_ns = self.on_event (E_init { time_ns }) + let on_shutdown (self : st) ~time_ns = self.on_event (E_shutdown { time_ns }) + + let on_name_process (self : st) ~time_ns:_ ~tid:_ ~name : unit = + self.on_event @@ E_name_process { name } + + let on_name_thread (self : st) ~time_ns:_ ~tid ~name : unit = + self.on_event @@ E_name_thread { tid; name } + + let[@inline] on_enter_span (self : st) ~__FUNCTION__:fun_name ~__FILE__:_ + ~__LINE__:_ ~time_ns ~tid ~data ~name span : unit = + self.on_event + @@ E_define_span { tid; name; time_ns; id = span; fun_name; data } + + let on_exit_span (self : st) ~time_ns ~tid:_ span : unit = + self.on_event @@ E_exit_span { id = span; time_ns } + + let on_add_data (self : st) ~data span = + if data <> [] then self.on_event @@ E_add_data { id = span; data } + + let on_message (self : st) ~time_ns ~tid ~span:_ ~data msg : unit = + self.on_event @@ E_message { tid; time_ns; msg; data } + + let on_counter (self : st) ~time_ns ~tid ~data:_ ~name f : unit = + self.on_event @@ E_counter { name; n = f; time_ns; tid } + + let on_enter_manual_span (self : st) ~__FUNCTION__:fun_name ~__FILE__:_ + ~__LINE__:_ ~time_ns ~tid ~parent:_ ~data ~name ~flavor ~trace_id _span : + unit = + self.on_event + @@ E_enter_manual_span + { id = trace_id; time_ns; tid; data; name; fun_name; flavor } + + let on_exit_manual_span (self : st) ~time_ns ~tid ~name ~data ~flavor + ~trace_id (_ : span) : unit = + self.on_event + @@ E_exit_manual_span { tid; id = trace_id; name; time_ns; data; flavor } + + let on_extension_event (self : st) ~time_ns ~tid ext : unit = + self.on_event @@ E_extension_event { tid; time_ns; ext } +end + +let subscriber (consumer : event_consumer) : Sub.t = + Sub.Subscriber.Sub { st = consumer; callbacks = (module Callbacks) }