client: add debug_exporter, stdout_exporter, resource helpers

src/client/common_.ml

@@ -0,0 +1,4 @@
+module OTEL = Opentelemetry
+module Proto = Opentelemetry_proto
+
+let ( let@ ) = ( @@ )

src/client/debug_exporter.ml

@@ -0,0 +1,36 @@
+open Common_
+
+(** [debug exporter] behaves like [exporter], but will print signals on [stderr]
+    before passing them to [exporter] *)
+class debug ?(out = Format.err_formatter) (exp : #OTEL.Exporter.t) :
+  OTEL.Exporter.t =
+  let open Proto in
+  object
+    method send_trace l =
+      Format.fprintf out "SPANS: %a@." (Format.pp_print_list Trace.pp_span) l;
+      exp#send_trace l
+
+    method send_metrics l =
+      Format.fprintf out "METRICS: %a@."
+        (Format.pp_print_list Metrics.pp_metric)
+        l;
+      exp#send_metrics l
+
+    method send_logs l =
+      Format.fprintf out "LOGS: %a@."
+        (Format.pp_print_list Logs.pp_log_record)
+        l;
+      exp#send_logs l
+
+    method tick () = exp#tick ()
+
+    method add_on_tick_callback cb = exp#add_on_tick_callback cb
+
+    method cleanup ~on_done () =
+      Format.fprintf out "CLEANUP@.";
+      exp#cleanup ~on_done ()
+  end
+
+(** Exporter that simply debugs on [stderr] *)
+let debug_only : OTEL.Exporter.t =
+  new debug ~out:Format.err_formatter OTEL.Exporter.dummy

src/client/dune

@@ -1,5 +1,6 @@
 (library
  (name opentelemetry_client)
  (public_name opentelemetry.client)
- (libraries opentelemetry pbrt mtime mtime.clock.os)
+ (libraries opentelemetry opentelemetry.proto pbrt mtime mtime.clock.os)
- (synopsis "Common types and logic shared between client implementations"))
+ (synopsis
+  "Basic exporters, as well as Common types and logic shared between exporters"))

src/client/signal_resource_builder.ml

@@ -0,0 +1,34 @@
+(** Group signals into [resource_xxx] objects *)
+
+open Common_
+
+let make_resource_logs (logs : Proto.Logs.log_record list) :
+    Proto.Logs.resource_logs =
+  let attributes = OTEL.Globals.mk_attributes () in
+  let resource = Proto.Resource.make_resource ~attributes () in
+  let ll =
+    Proto.Logs.make_scope_logs ~scope:OTEL.Globals.instrumentation_library
+      ~log_records:logs ()
+  in
+  Proto.Logs.make_resource_logs ~resource ~scope_logs:[ ll ] ()
+
+let make_resource_spans ?service_name ?attrs spans : Proto.Trace.resource_spans
+    =
+  let ils =
+    Proto.Trace.make_scope_spans ~scope:OTEL.Globals.instrumentation_library
+      ~spans ()
+  in
+  let attributes = OTEL.Globals.mk_attributes ?service_name ?attrs () in
+  let resource = Proto.Resource.make_resource ~attributes () in
+  Proto.Trace.make_resource_spans ~resource ~scope_spans:[ ils ] ()
+
+(** Aggregate metrics into a {!Proto.Metrics.resource_metrics} *)
+let make_resource_metrics ?service_name ?attrs (l : OTEL.Metrics.t list) :
+    Proto.Metrics.resource_metrics =
+  let open Proto.Metrics in
+  let lm =
+    make_scope_metrics ~scope:OTEL.Globals.instrumentation_library ~metrics:l ()
+  in
+  let attributes = OTEL.Globals.mk_attributes ?service_name ?attrs () in
+  let resource = Proto.Resource.make_resource ~attributes () in
+  Proto.Metrics.make_resource_metrics ~scope_metrics:[ lm ] ~resource ()

src/client/stdout_exporter.ml

@@ -0,0 +1,47 @@
+(** A simple exporter that prints on stdout *)
+
+open Common_
+open OTEL
+
+open struct
+  let pp_span out (sp : Span.t) =
+    Format.fprintf out
+      "@[<2>SPAN@ trace_id: %a@ span_id: %a@ name: %S@ start: %a@ end: %a@]@."
+      Trace_id.pp
+      (Trace_id.of_bytes sp.trace_id)
+      Span_id.pp
+      (Span_id.of_bytes sp.span_id)
+      sp.name Timestamp_ns.pp_debug sp.start_time_unix_nano
+      Timestamp_ns.pp_debug sp.end_time_unix_nano
+
+  let pp_vlist mutex pp out l =
+    if l != [] then (
+      let@ () = Util_mutex.protect mutex in
+      Format.fprintf out "@[<v>";
+      List.iteri
+        (fun i x ->
+          if i > 0 then Format.fprintf out "@,";
+          pp out x)
+        l;
+      Format.fprintf out "@]@."
+    )
+end
+
+class stdout : OTEL.Exporter.t =
+  let out = Format.std_formatter in
+  let mutex = Mutex.create () in
+
+  let ticker = Tick_callbacks.create () in
+  object
+    method send_trace l = pp_vlist mutex pp_span out l
+
+    method send_metrics l = pp_vlist mutex Proto.Metrics.pp_metric out l
+
+    method send_logs l = pp_vlist mutex Proto.Logs.pp_log_record out l
+
+    method tick () = Tick_callbacks.tick ticker
+
+    method add_on_tick_callback cb = Tick_callbacks.on_tick ticker cb
+
+    method cleanup ~on_done () = on_done ()
+  end