diff --git a/dune-project b/dune-project index b66d80f..68b862c 100644 --- a/dune-project +++ b/dune-project @@ -22,13 +22,14 @@ (synopsis "A lightweight stub for tracing/observability, agnostic in how data is collected") (description - "ocaml-trace can be used to instrument libraries and programs with low overhead.\n\n It doesn't do any IO unless a collector is plugged in, which only\n the final executable should do.") + "ocaml-trace can be used to instrument libraries and programs with low overhead. It doesn't do any IO unless a collector is plugged in, which only the final executable should do.") (depends (ocaml (>= 4.08)) dune) (depopts unix + lwt (thread-local-storage (>= 0.2)) (mtime (>= 2.0))) diff --git a/src/lwt/dune b/src/lwt/dune new file mode 100644 index 0000000..b69ba38 --- /dev/null +++ b/src/lwt/dune @@ -0,0 +1,6 @@ +(library + (name trace_lwt) + (public_name trace.lwt) + (optional) ; lwt + (libraries trace.core lwt) + (synopsis "Interface with lwt")) diff --git a/src/lwt/trace_lwt.ml b/src/lwt/trace_lwt.ml new file mode 100644 index 0000000..8d0ed00 --- /dev/null +++ b/src/lwt/trace_lwt.ml @@ -0,0 +1,30 @@ +(** Optional interface with lwt. + + @since NEXT_RELEASE *) + +open Trace_core + +let k_ambient_span : span Lwt.key = Lwt.new_key () + +let ambient_span_provider : Trace_core.Ambient_span_provider.t = + ASP_some + ( (), + { + get_current_span = (fun () -> Lwt.get k_ambient_span); + with_current_span_set_to = + (fun () span f -> + Lwt.with_value k_ambient_span (Some span) (fun () -> f span)); + } ) + +let with_span ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent ?params ?data + name (f : span -> 'a Lwt.t) : 'a Lwt.t = + if Trace_core.enabled () then ( + let span = + Trace_core.enter_span ?level ?__FUNCTION__ ~__FILE__ ~__LINE__ ?parent + ?params ?data name + in + let fut = Trace_core.with_current_span_set_to span f in + Lwt.on_termination fut (fun () -> Trace_core.exit_span span); + fut + ) else + f Trace_core.Collector.dummy_span