feat: add an extensible sum type for extending the library

libraries and collectors can now define their own "events" that
collectors will handle (or not), without having to contribute them to
ocaml-trace at all.

src/core/collector.ml

@@ -94,6 +94,12 @@ module type S = sig
   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 NEXT_RELEASE *)
+
   val shutdown : unit -> unit
   (** Shutdown collector, possibly waiting for it to finish sending data. *)
 end

src/core/trace_core.ml

@@ -168,6 +168,13 @@ let shutdown () =
   | None -> ()
   | Some (module C) -> C.shutdown ()
 
+type extension_event = Types.extension_event = ..
+
+let[@inline] extension_event ev =
+  match A.get collector with
+  | None -> ()
+  | Some (module C) -> C.extension_event ev
+
 module Internal_ = struct
   module Atomic_ = Atomic_
 end

src/core/trace_core.mli

@@ -214,3 +214,16 @@ val set_current_level : Level.t -> unit
 val shutdown : unit -> unit
 (** [shutdown ()] shutdowns the current collector, if one was installed,
     and waits for it to terminate before returning. *)
+
+(** {2 Extensions} *)
+
+type extension_event = Types.extension_event = ..
+(** Extension event
+  @since NEXT_RELEASE *)
+
+val extension_event : 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.
+    @since NEXT_RELEASE *)

src/core/types.ml

@@ -23,3 +23,8 @@ type explicit_span = {
         of the span, to the end of the span. *)
 }
 (** Explicit span, with collector-specific metadata *)
+
+type extension_event = ..
+(** An extension event, used to add features that are backend specific
+    or simply not envisioned by [trace].
+  @since NEXT_RELEASE *)

src/fuchsia/fcollector.ml

@@ -363,6 +363,8 @@ struct
       encode out ~name ~ty:ty_thread ~kid:tls.tid
         ~args:[ "process", `Kid pid ]
         ())
+
+  let extension_event _ = ()
 end
 
 let create ~out () : collector =

src/subscriber/callbacks.ml

@@ -104,6 +104,11 @@ module type S = sig
     span ->
     unit
   (** Exit a manual span *)
+
+  val on_extension_event :
+    st -> time_ns:float -> tid:int -> extension_event -> unit
+  (** Extension event
+      @since NEXT_RELEASE *)
 end
 
 type 'st t = (module S with type st = 'st)
@@ -137,6 +142,8 @@ module Dummy = struct
   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. *)

src/subscriber/subscriber.ml

@@ -96,6 +96,12 @@ open struct
         span;
       CB2.on_exit_manual_span s2 ~time_ns ~tid ~name ~data ~flavor ~trace_id
         span
+
+    let on_extension_event
+        ( Sub { st = s1; callbacks = (module CB1) },
+          Sub { st = s2; callbacks = (module CB2) } ) ~time_ns ~tid ev : unit =
+      CB1.on_extension_event s1 ~time_ns ~tid ev;
+      CB2.on_extension_event s2 ~time_ns ~tid ev
   end
 end
 

src/subscriber/trace_subscriber.ml

@@ -177,6 +177,11 @@ let collector (Sub { st; callbacks = (module CB) } : Subscriber.t) : collector =
       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

src/tef/trace_tef.ml

@@ -354,6 +354,8 @@ let subscriber_ ~finally ~out ~(mode : [ `Single | `Jsonl ]) () : Sub.t =
       let time_us = time_ns *. 1e-3 in
       B_queue.push self.events
       @@ E_exit_manual_span { tid; id = trace_id; name; time_us; data; flavor }
+
+    let on_extension_event _ ~time_ns:_ ~tid:_ _ev = ()
   end in
   let events = B_queue.create () in
   let t_write =