diff --git a/src/lwt/trace_lwt.ml b/src/lwt/trace_lwt.ml index 00aee11..3962e0a 100644 --- a/src/lwt/trace_lwt.ml +++ b/src/lwt/trace_lwt.ml @@ -33,3 +33,34 @@ let[@inline] with_span_lwt ?parent ?force_toplevel ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name f else f 0L + +let[@inline never] with_span_real_ ?parent ?(force_toplevel = false) + ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name f = + let parent = + match parent with + | Some _ as p -> p + | None -> Lwt.get k_parent + in + + let espan = + match parent, force_toplevel with + | _, true | None, _ -> + enter_manual_toplevel_span ~flavor:`Sync ?__FUNCTION__ ~__FILE__ ~__LINE__ + ?data name + | Some parent, _ -> + enter_manual_sub_span ~parent ~flavor:`Sync ?__FUNCTION__ ~__FILE__ + ~__LINE__ ?data name + in + + Lwt.with_value k_parent (Some espan) (fun () -> + Fun.protect + (fun () -> f espan.span) + ~finally:(fun () -> exit_manual_span espan)) + +let[@inline] with_span ?parent ?force_toplevel ?__FUNCTION__ ~__FILE__ ~__LINE__ + ?data name f = + if enabled () then + with_span_real_ ?parent ?force_toplevel ?__FUNCTION__ ~__FILE__ ~__LINE__ + ?data name f + else + f 0L diff --git a/src/lwt/trace_lwt.mli b/src/lwt/trace_lwt.mli index 611256e..f41a660 100644 --- a/src/lwt/trace_lwt.mli +++ b/src/lwt/trace_lwt.mli @@ -25,3 +25,26 @@ val with_span_lwt : @param parent an explicit parent, which bypasses the implicit context. @since NEXT_RELEASE *) + +val with_span : + ?parent:explicit_span -> + ?force_toplevel:bool -> + ?__FUNCTION__:string -> + __FILE__:string -> + __LINE__:int -> + ?data:(unit -> (string * user_data) list) -> + string -> + (span -> 'a) -> + 'a +(** [with_span ~__FILE__ ~__LINE__ name f] calls [f span] + where [span] is a new span named with [name]. The span is + traced as being synchronous. + + If [f] returns an ['a Lwt.t] future, use [with_span_lwt] instead. + + @param force_toplevel if true, this span will not have a parent even if + there is one in the implicit context; ie it create a new + {!Trace_core.enter_manual_toplevel_span} in any case. + @param parent an explicit parent, which bypasses the implicit context. + + @since NEXT_RELEASE *)