feat: lwt backend

dune-project

@@ -29,20 +29,26 @@
   ptime
   hmap
   atomic
-  (thread-local-storage (and (>= 0.2) (< 0.3)))
+  (thread-local-storage
+   (and
+    (>= 0.2)
+    (< 0.3)))
   (odoc :with-doc)
   (alcotest :with-test)
   (pbrt
-   (and (>= 3.0) (< 4.0)))
+   (and
+    (>= 3.0)
+    (< 4.0)))
   (ocaml-lsp-server :with-dev-setup)
   (ocamlformat
    (and
     :with-dev-setup
     (>= 0.24)
     (< 0.25))))
- (depopts trace)
+ (depopts trace lwt eio)
  (conflicts
-  (trace (< 0.7)))
+  (trace
+   (< 0.7)))
  (tags
   (instrumentation tracing opentelemetry datadog jaeger)))
 

opentelemetry.opam

@@ -17,14 +17,15 @@ depends: [
   "ocaml" {>= "4.08"}
   "ptime"
   "hmap"
-  "ambient-context"
+  "atomic"
+  "thread-local-storage" {>= "0.2" & < "0.3"}
   "odoc" {with-doc}
   "alcotest" {with-test}
   "pbrt" {>= "3.0" & < "4.0"}
   "ocaml-lsp-server" {with-dev-setup}
   "ocamlformat" {with-dev-setup & >= "0.24" & < "0.25"}
 ]
-depopts: ["trace"]
+depopts: ["trace" "lwt" "eio"]
 conflicts: [
   "trace" {< "0.7"}
 ]

src/ambient-context/lwt/dune

@@ -0,0 +1,7 @@
+(library
+ (name opentelemetry_ambient_context_lwt)
+ (public_name opentelemetry.ambient-context.lwt)
+ (optional) ; lwt
+ (synopsis
+  "Storage backend for ambient-context using Lwt's sequence-associated storage")
+ (libraries lwt opentelemetry.ambient-context thread-local-storage))

src/ambient-context/lwt/opentelemetry_ambient_context_lwt.ml

@@ -0,0 +1,37 @@
+open struct
+  let _internal_key : Hmap.t Lwt.key = Lwt.new_key ()
+
+  let ( let* ) = Option.bind
+end
+
+module M = struct
+  let name = "Storage_lwt"
+
+  let[@inline] get_map () = Lwt.get _internal_key
+
+  let[@inline] with_map m cb = Lwt.with_value _internal_key (Some m) cb
+
+  let create_key = Hmap.Key.create
+
+  let get k =
+    let* context = get_map () in
+    Hmap.find k context
+
+  let with_binding k v cb =
+    let new_context =
+      match get_map () with
+      | None -> Hmap.singleton k v
+      | Some old_context -> Hmap.add k v old_context
+    in
+    with_map new_context cb
+
+  let without_binding k cb =
+    let new_context =
+      match get_map () with
+      | None -> Hmap.empty
+      | Some old_context -> Hmap.rem k old_context
+    in
+    with_map new_context cb
+end
+
+let storage () : Opentelemetry_ambient_context.storage = (module M)

src/ambient-context/lwt/opentelemetry_ambient_context_lwt.mli

@@ -0,0 +1,2 @@
+val storage : unit -> Opentelemetry_ambient_context.storage
+(** Storage using Lwt keys *)