From c76fc129b3ba986e3a61ea2e227a0836368b7da1 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 13 Sep 2023 14:28:55 -0400
Subject: [PATCH] add `trace-lwt` library

---
 dune-project          |  8 ++++++++
 src/lwt/dune          |  7 +++++++
 src/lwt/trace_lwt.ml  | 30 ++++++++++++++++++++++++++++++
 src/lwt/trace_lwt.mli | 26 ++++++++++++++++++++++++++
 trace-lwt.opam        | 33 +++++++++++++++++++++++++++++++++
 5 files changed, 104 insertions(+)
 create mode 100644 src/lwt/dune
 create mode 100644 src/lwt/trace_lwt.ml
 create mode 100644 src/lwt/trace_lwt.mli
 create mode 100644 trace-lwt.opam

diff --git a/dune-project b/dune-project
index 5d4bce1..d13a66d 100644
--- a/dune-project
+++ b/dune-project
@@ -33,4 +33,12 @@
  (tags
   (trace tracing catapult)))
 
+(package
+  (name trace-lwt)
+  (synopsis "Helpers to use Trace from Lwt")
+  (depends
+    (trace (= :version))
+    lwt)
+  (tags (trace lwt asynchronous)))
+
 ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project
diff --git a/src/lwt/dune b/src/lwt/dune
new file mode 100644
index 0000000..c72685c
--- /dev/null
+++ b/src/lwt/dune
@@ -0,0 +1,7 @@
+
+
+(library
+  (name trace_lwt)
+  (public_name trace-lwt)
+  (synopsis "Helpers to use Trace from Lwt")
+  (libraries trace.core lwt))
diff --git a/src/lwt/trace_lwt.ml b/src/lwt/trace_lwt.ml
new file mode 100644
index 0000000..a349635
--- /dev/null
+++ b/src/lwt/trace_lwt.ml
@@ -0,0 +1,30 @@
+include Trace_core
+
+let k_parent : explicit_span Lwt.key = Lwt.new_key ()
+
+let[@inline never] with_span_lwt_real_ ?(force_toplevel = false) ?__FUNCTION__
+    ~__FILE__ ~__LINE__ ?data name f =
+  let parent = Lwt.get k_parent in
+  let espan =
+    match parent, force_toplevel with
+    | _, true | None, _ ->
+      enter_manual_toplevel_span ~flavor:`Async ?__FUNCTION__ ~__FILE__
+        ~__LINE__ ?data name
+    | Some parent, _ ->
+      enter_manual_sub_span ~parent ~flavor:`Async ?__FUNCTION__ ~__FILE__
+        ~__LINE__ ?data name
+  in
+
+  Lwt.with_value k_parent (Some espan) (fun () ->
+      let fut = f espan.span in
+      Lwt.on_termination fut (fun () -> exit_manual_span espan);
+
+      fut)
+
+let[@inline] with_span_lwt ?force_toplevel ?__FUNCTION__ ~__FILE__ ~__LINE__
+    ?data name f : _ Lwt.t =
+  if enabled () then
+    with_span_lwt_real_ ?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
new file mode 100644
index 0000000..1c8d606
--- /dev/null
+++ b/src/lwt/trace_lwt.mli
@@ -0,0 +1,26 @@
+
+(** Wrapper for tracing with Lwt.
+
+    @since NEXT_RELEASE. *)
+
+include module type of Trace_core
+
+val with_span_lwt :
+  ?force_toplevel:bool ->
+  ?__FUNCTION__:string ->
+  __FILE__:string ->
+  __LINE__:int ->
+  ?data:(unit -> (string * user_data) list) ->
+  string ->
+  (span -> 'a Lwt.t) ->
+  'a Lwt.t
+(** [with_span_lwt ~__FILE__ ~__LINE__ name f] calls [f span]
+    where [span] is a new span named with [name]. The span is
+    traced as being asynchronous, so each collector might represent
+    it differently.
+
+    @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.
+
+    @since NEXT_RELEASE *)
diff --git a/trace-lwt.opam b/trace-lwt.opam
new file mode 100644
index 0000000..fb8e72b
--- /dev/null
+++ b/trace-lwt.opam
@@ -0,0 +1,33 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "0.3"
+synopsis: "Helpers to use Trace from Lwt"
+maintainer: ["Simon Cruanes"]
+authors: ["Simon Cruanes"]
+license: "MIT"
+tags: ["trace" "lwt" "asynchronous"]
+homepage: "https://github.com/c-cube/ocaml-trace"
+bug-reports: "https://github.com/c-cube/ocaml-trace/issues"
+depends: [
+  "dune" {>= "2.9"}
+  "trace" {= version}
+  "lwt"
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "--promote-install-files=false"
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+  ["dune" "install" "-p" name "--create-install-files" name]
+]
+dev-repo: "git+https://github.com/c-cube/ocaml-trace.git"