diff --git a/dune-project b/dune-project index 65fef54e..a2153000 100644 --- a/dune-project +++ b/dune-project @@ -28,7 +28,8 @@ (>= "4.08")) ptime hmap - ambient-context + atomic + (thread-local-storage (and (>= 0.2) (< 0.3))) (odoc :with-doc) (alcotest :with-test) (pbrt diff --git a/src/ambient-context/eio/ambient_context_eio.ml b/src/ambient-context/eio/ambient_context_eio.ml new file mode 100644 index 00000000..642be8c8 --- /dev/null +++ b/src/ambient-context/eio/ambient_context_eio.ml @@ -0,0 +1,37 @@ +module TLS = Ambient_context_thread_local.Thread_local +module Hmap = Ambient_context.Hmap +module Fiber = Eio.Fiber + +let _internal_key : Hmap.t Fiber.key = Fiber.create_key () +let ( let* ) = Option.bind + +module M = struct + let name = "Storage_eio" + let[@inline] get_map () = Fiber.get _internal_key + let[@inline] with_map m cb = Fiber.with_binding _internal_key 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 () : Ambient_context.storage = (module M) diff --git a/src/ambient-context/eio/dune.tmp b/src/ambient-context/eio/dune.tmp new file mode 100644 index 00000000..cb379f9a --- /dev/null +++ b/src/ambient-context/eio/dune.tmp @@ -0,0 +1,6 @@ +(library + (name ambient_context_eio) + (synopsis + "Storage backend for ambient-context using Eio's fibre-local storage") + (public_name ambient-context-eio) + (libraries eio ambient-context ambient-context.thread_local)) diff --git a/src/ambient-context/lwt/ambient_context_lwt.ml b/src/ambient-context/lwt/ambient_context_lwt.ml new file mode 100644 index 00000000..6010d02a --- /dev/null +++ b/src/ambient-context/lwt/ambient_context_lwt.ml @@ -0,0 +1,35 @@ +module Hmap = Ambient_context.Hmap + +let _internal_key : Hmap.t Lwt.key = Lwt.new_key () +let ( let* ) = Option.bind + +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 () : Ambient_context.storage = (module M) diff --git a/src/ambient-context/lwt/dune.tmp b/src/ambient-context/lwt/dune.tmp new file mode 100644 index 00000000..5dae2dd9 --- /dev/null +++ b/src/ambient-context/lwt/dune.tmp @@ -0,0 +1,6 @@ +(library + (name ambient_context_lwt) + (synopsis + "Storage backend for ambient-context using Lwt's sequence-associated storage") + (public_name ambient-context-lwt) + (libraries lwt ambient-context ambient-context.tls)) diff --git a/src/core/dune b/src/core/dune index f442b5ac..235f8ad9 100644 --- a/src/core/dune +++ b/src/core/dune @@ -2,6 +2,6 @@ (name opentelemetry) (synopsis "API for opentelemetry instrumentation") (flags :standard -warn-error -a+8) - (libraries opentelemetry.proto ambient-context ptime ptime.clock.os pbrt threads + (libraries opentelemetry.proto opentelemetry.ambient-context ptime ptime.clock.os pbrt threads opentelemetry.atomic hmap) (public_name opentelemetry)) diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index 7cf2e2c7..be4135f0 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -2,6 +2,8 @@ open struct let spf = Printf.sprintf + + module Ambient_context = Opentelemetry_ambient_context end module Lock = Lock