feat: add ?flavor argument to manual spans.

src/core/collector.ml

@@ -33,6 +33,7 @@ module type S = sig
 
   val enter_manual_span :
     parent:explicit_span option ->
+    flavor:[ `Sync | `Async ] option ->
     __FUNCTION__:string option ->
     __FILE__:string ->
     __LINE__:int ->

src/core/trace_core.ml

@@ -27,28 +27,29 @@ let[@inline] with_span ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name f =
     with_span_collector_ collector ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name
       f
 
-let enter_explicit_span_collector_ (module C : Collector.S) ~parent
+let enter_explicit_span_collector_ (module C : Collector.S) ~parent ~flavor
     ?__FUNCTION__ ~__FILE__ ~__LINE__ ?(data = fun () -> []) name :
     explicit_span =
   let data = data () in
-  C.enter_manual_span ~parent ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name
+  C.enter_manual_span ~parent ~flavor ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data
+    name
 
-let[@inline] enter_manual_sub_span ~parent ?__FUNCTION__ ~__FILE__ ~__LINE__
+let[@inline] enter_manual_sub_span ~parent ?flavor ?__FUNCTION__ ~__FILE__
-    ?data name : explicit_span =
+    ~__LINE__ ?data name : explicit_span =
   match A.get collector with
   | None -> Collector.dummy_explicit_span
   | Some coll ->
-    enter_explicit_span_collector_ coll ~parent:(Some parent) ?__FUNCTION__
+    enter_explicit_span_collector_ coll ~parent:(Some parent) ~flavor
+      ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name
+
+let[@inline] enter_manual_toplevel_span ?flavor ?__FUNCTION__ ~__FILE__
+    ~__LINE__ ?data name : explicit_span =
+  match A.get collector with
+  | None -> Collector.dummy_explicit_span
+  | Some coll ->
+    enter_explicit_span_collector_ coll ~parent:None ~flavor ?__FUNCTION__
       ~__FILE__ ~__LINE__ ?data name
 
-let[@inline] enter_manual_toplevel_span ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data
-    name : explicit_span =
-  match A.get collector with
-  | None -> Collector.dummy_explicit_span
-  | Some coll ->
-    enter_explicit_span_collector_ coll ~parent:None ?__FUNCTION__ ~__FILE__
-      ~__LINE__ ?data name
-
 let[@inline] exit_manual_span espan : unit =
   match A.get collector with
   | None -> ()

src/core/trace_core.mli

@@ -36,6 +36,7 @@ val with_span :
 
 val enter_manual_sub_span :
   parent:explicit_span ->
+  ?flavor:[ `Sync | `Async ] ->
   ?__FUNCTION__:string ->
   __FILE__:string ->
   __LINE__:int ->
@@ -45,9 +46,15 @@ val enter_manual_sub_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}. 
+    @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.
     @since NEXT_RELEASE *)
 
 val enter_manual_toplevel_span :
+  ?flavor:[ `Sync | `Async ] ->
   ?__FUNCTION__:string ->
   __FILE__:string ->
   __LINE__:int ->
@@ -57,6 +64,7 @@ val enter_manual_toplevel_span :
 (** Like {!with_span} but the caller is responsible for carrying this
     [explicit_span] around until it's exited with {!exit_manual_span}.
     The span can be used as a parent in {!enter_manual_sub_span}.
+    @param flavor see {!enter_manual_sub_span} for more details.
     @since NEXT_RELEASE *)
 
 val exit_manual_span : explicit_span -> unit

src/tef/trace_tef.ml

@@ -51,17 +51,19 @@ type event =
       id: span;
       time_us: float;
     }
-  | E_enter_async_span of {
+  | E_enter_manual_span of {
       tid: int;
       name: string;
       time_us: float;
       id: int;
+      flavor: [ `Sync | `Async ] option;
       data: (string * user_data) list;
     }
-  | E_exit_async_span of {
+  | E_exit_manual_span of {
       tid: int;
       name: string;
       time_us: float;
+      flavor: [ `Sync | `Async ] option;
       id: int;
     }
   | E_counter of {
@@ -92,7 +94,8 @@ type span_info = {
 (** key used to carry a unique "id" for all spans in an async context *)
 let key_async_id : int Meta_map.Key.t = Meta_map.Key.create ()
 
-let key_async_name : string Meta_map.Key.t = Meta_map.Key.create ()
+let key_async_data : (string * [ `Sync | `Async ] option) Meta_map.Key.t =
+  Meta_map.Key.create ()
 
 module Writer = struct
   type t = {
@@ -182,20 +185,27 @@ module Writer = struct
       args;
     ()
 
-  let emit_async_begin ~tid ~name ~id ~ts ~args (self : t) : unit =
+  let emit_manual_begin ~tid ~name ~id ~ts ~args ~flavor (self : t) : unit =
     emit_sep_ self;
     Printf.fprintf self.oc
-      {json|{"pid":%d,"cat":"trace","id":%d,"tid": %d,"ts": %.2f,"name":%a,"ph":"b"%a}|json}
+      {json|{"pid":%d,"cat":"trace","id":%d,"tid": %d,"ts": %.2f,"name":%a,"ph":"%c"%a}|json}
       self.pid id tid ts str_val name
+      (match flavor with
+      | None | Some `Async -> 'b'
+      | Some `Sync -> 'B')
       (emit_args_o_ pp_user_data_)
       args;
     ()
 
-  let emit_async_end ~tid ~name ~id ~ts (self : t) : unit =
+  let emit_manual_end ~tid ~name ~id ~ts ~flavor (self : t) : unit =
     emit_sep_ self;
     Printf.fprintf self.oc
-      {json|{"pid":%d,"cat":"trace","id":%d,"tid": %d,"ts": %.2f,"name":%a,"ph":"e"}|json}
+      {json|{"pid":%d,"cat":"trace","id":%d,"tid": %d,"ts": %.2f,"name":%a,"ph":"%c"}|json}
-      self.pid id tid ts str_val name;
+      self.pid id tid ts str_val name
+      (match flavor with
+      | None | Some `Async -> 'e'
+      | Some `Sync -> 'E');
+
     ()
 
   let emit_instant_event ~tid ~name ~ts ~args (self : t) : unit =
@@ -256,10 +266,11 @@ let bg_thread ~out (events : event B_queue.t) : unit =
         Span_tbl.remove spans id;
         Writer.emit_duration_event ~tid ~name ~start:start_us ~end_:stop_us
           ~args:data writer)
-    | E_enter_async_span { tid; time_us; name; id; data } ->
+    | E_enter_manual_span { tid; time_us; name; id; data; flavor } ->
-      Writer.emit_async_begin ~tid ~name ~id ~ts:time_us ~args:data writer
+      Writer.emit_manual_begin ~tid ~name ~id ~ts:time_us ~args:data ~flavor
-    | E_exit_async_span { tid; time_us; name; id } ->
+        writer
-      Writer.emit_async_end ~tid ~name ~id ~ts:time_us writer
+    | E_exit_manual_span { tid; time_us; name; id; flavor } ->
+      Writer.emit_manual_end ~tid ~name ~id ~ts:time_us ~flavor writer
     | E_counter { tid; name; time_us; n } ->
       Writer.emit_counter ~name ~tid ~ts:time_us writer n
     | E_name_process { name } -> Writer.emit_name_process ~name writer
@@ -342,8 +353,8 @@ let collector ~out () : collector =
 
       Fun.protect ~finally (fun () -> f span)
 
-    let enter_manual_span ~(parent : explicit_span option) ~__FUNCTION__:_
+    let enter_manual_span ~(parent : explicit_span option) ~flavor
-        ~__FILE__:_ ~__LINE__:_ ~data name : explicit_span =
+        ~__FUNCTION__:_ ~__FILE__:_ ~__LINE__:_ ~data name : explicit_span =
       (* get the id, or make a new one *)
       let id =
         match parent with
@@ -352,19 +363,22 @@ let collector ~out () : collector =
       in
       let time_us = now_us () in
       B_queue.push events
-        (E_enter_async_span { id; time_us; tid = get_tid_ (); data; name });
+        (E_enter_manual_span
+           { id; time_us; tid = get_tid_ (); data; name; flavor });
       {
         span = 0L;
         meta =
-          Meta_map.(empty |> add key_async_id id |> add key_async_name name);
+          Meta_map.(
+            empty |> add key_async_id id |> add key_async_data (name, flavor));
       }
 
     let exit_manual_span (es : explicit_span) : unit =
       let id = Meta_map.find_exn key_async_id es.meta in
-      let name = Meta_map.find_exn key_async_name es.meta in
+      let name, flavor = Meta_map.find_exn key_async_data es.meta in
       let time_us = now_us () in
       let tid = get_tid_ () in
-      B_queue.push events (E_exit_async_span { tid; id; name; time_us })
+      B_queue.push events
+        (E_exit_manual_span { tid; id; name; time_us; flavor })
 
     let message ?span:_ ~data msg : unit =
       let time_us = now_us () in