add self_debug and provider_config

src/lib/dynamic_enricher.ml

@@ -16,8 +16,9 @@ let collect () : Key_value.t list =
       | kvs -> acc := List.rev_append kvs !acc
       | exception exn ->
         let bt = Printexc.get_raw_backtrace () in
-        Printf.eprintf "opentelemetry: dynamic_enricher raised %s\n%s%!"
+        Self_debug.log Warning (fun () ->
-          (Printexc.to_string exn)
+            Printf.sprintf "dynamic_enricher raised %s\n%s"
-          (Printexc.raw_backtrace_to_string bt))
+              (Printexc.to_string exn)
+              (Printexc.raw_backtrace_to_string bt)))
     (Alist.get enrichers_);
   !acc

src/lib/opentelemetry.ml

@@ -56,6 +56,8 @@ module Sdk = struct
       @since NEXT_RELEASE *)
   let get_logger ?name ?version ?attrs ?__MODULE__ () =
     Log_provider.get_logger ?name ?version ?attrs ?__MODULE__ ()
+
+  let self_debug_to_stderr = Sdk.self_debug_to_stderr
 end
 
 module Main_exporter = Sdk [@@deprecated "use Sdk instead"]
@@ -66,6 +68,8 @@ module Collector = struct
 end
 [@@deprecated "Use 'Exporter' instead"]
 
+module Provider_config = Provider_config
+module Self_debug = Self_debug
 module Dynamic_enricher = Dynamic_enricher
 module Trace_provider = Trace_provider
 module Meter_provider = Meter_provider

src/lib/provider_config.ml

@@ -0,0 +1,11 @@
+(** Per-provider batching configuration. *)
+
+type t = {
+  batch: int option;
+  timeout: Mtime.Span.t;
+}
+
+let make ?(batch : int option) ?(timeout = Mtime.Span.(2_000 * ms)) () : t =
+  { batch; timeout }
+
+let default : t = make ~batch:200 ()

src/lib/provider_config.mli

@@ -0,0 +1,16 @@
+(** Per-provider batching configuration. *)
+
+type t = {
+  batch: int option;
+      (** Batch size (number of items). [None] means unbatched (immediate emit).
+      *)
+  timeout: Mtime.Span.t;  (** Timeout between automatic batch flushes. *)
+}
+
+val make : ?batch:int -> ?timeout:Mtime.Span.t -> unit -> t
+(** Create a provider config.
+    @param batch batch size. Default: [Some 200].
+    @param timeout flush timeout. Default: [2000ms] *)
+
+val default : t
+(** Default provider config: [200] batch size, [2s] timeout. *)

src/lib/sdk.ml

@@ -10,10 +10,13 @@ open struct
   let exporter : Exporter.t option Atomic.t = Atomic.make None
 end
 
+let self_debug_to_stderr = Self_debug.to_stderr
+
 (** Remove current exporter, if any.
     @param on_done called once the exporter has fully shut down (queue drained).
 *)
 let remove ~on_done () : unit =
+  Self_debug.log Info (fun () -> "opentelemetry: SDK removed");
   (* flush+close provider emitters so buffered signals reach the queue *)
   Emitter.flush_and_close (Trace_provider.get ()).emit;
   Emitter.flush_and_close (Meter_provider.get ()).emit;
@@ -51,16 +54,17 @@ let run_tick_callbacks : unit -> unit = Globals.run_tick_callbacks
     from their ticker. *)
 let tick : unit -> unit = Globals.run_tick_callbacks
 
-let set ?batch_traces ?batch_metrics ?batch_logs
+let set ?(traces = Provider_config.default) ?(metrics = Provider_config.default)
-    ?(batch_timeout = Mtime.Span.(2_000 * ms)) (exp : Exporter.t) : unit =
+    ?(logs = Provider_config.default) (exp : Exporter.t) : unit =
+  Self_debug.log Info (fun () -> "opentelemetry: SDK set up");
   Atomic.set exporter (Some exp);
   let tracer : Tracer.t =
     let t = Tracer.of_exporter exp in
     {
       t with
       emit =
-        Emitter_batch.add_batching_opt ~timeout:batch_timeout
+        Emitter_batch.add_batching_opt ~timeout:traces.Provider_config.timeout
-          ~batch_size:batch_traces t.emit;
+          ~batch_size:traces.Provider_config.batch t.emit;
     }
   in
   let meter : Meter.t =
@@ -68,8 +72,8 @@ let set ?batch_traces ?batch_metrics ?batch_logs
     {
       m with
       emit =
-        Emitter_batch.add_batching_opt ~timeout:batch_timeout
+        Emitter_batch.add_batching_opt ~timeout:metrics.Provider_config.timeout
-          ~batch_size:batch_metrics m.emit;
+          ~batch_size:metrics.Provider_config.batch m.emit;
     }
   in
   let logger : Logger.t =
@@ -77,8 +81,8 @@ let set ?batch_traces ?batch_metrics ?batch_logs
     {
       l with
       emit =
-        Emitter_batch.add_batching_opt ~timeout:batch_timeout
+        Emitter_batch.add_batching_opt ~timeout:logs.Provider_config.timeout
-          ~batch_size:batch_logs l.emit;
+          ~batch_size:logs.Provider_config.batch l.emit;
     }
   in
   Trace_provider.set tracer;

src/lib/self_debug.ml

@@ -0,0 +1,32 @@
+type level =
+  | Debug
+  | Info
+  | Warning
+  | Error
+
+type logger = level -> (unit -> string) -> unit
+
+let logger : logger ref = ref (fun _ _ -> ())
+
+let[@inline] log level f = !logger level f
+
+let string_of_level = function
+  | Debug -> "debug"
+  | Info -> "info"
+  | Warning -> "warning"
+  | Error -> "error"
+
+let to_stderr ?(min_level = Warning) () : unit =
+  let[@inline] int_of_level_ = function
+    | Debug -> 0
+    | Info -> 1
+    | Warning -> 2
+    | Error -> 3
+  in
+  let threshold = int_of_level_ min_level in
+  logger :=
+    fun level mk_msg ->
+      if int_of_level_ level >= threshold then (
+        let msg = mk_msg () in
+        Printf.eprintf "[otel:%s] %s\n%!" (string_of_level level) msg
+      )

src/lib/self_debug.mli

@@ -0,0 +1,36 @@
+(** Emergency diagnostic logger for the OpenTelemetry SDK itself.
+
+    Bypasses the OTEL pipeline entirely. Defaults to silently discarding all
+    messages. Use {!to_stderr} or set {!logger} to enable output.
+
+    Usage:
+    {[
+      Self_debug.log Info (fun () -> Printf.sprintf "batch flushed %d items" n)
+    ]}.
+
+    @since NEXT_RELEASE *)
+
+type level =
+  | Debug
+  | Info
+  | Warning
+  | Error
+
+type logger = level -> (unit -> string) -> unit
+(** A logger, takes a level and a (lazy) message, and maybe emit the message *)
+
+val logger : logger ref
+(** The current log sink. Replace to redirect output. Default: no-op. *)
+
+val string_of_level : level -> string
+(** String representation of a level. *)
+
+val log : level -> (unit -> string) -> unit
+(** [log level mk_msg] emits a diagnostic message if the current logger is
+    active. [mk_msg] is called lazily — only if the message will be emitted. *)
+
+val to_stderr : ?min_level:level -> unit -> unit
+(** Install a stderr logger. Messages below [min_level] (default: [Warning]) are
+    suppressed. This is useful to help debug problems with this library itself
+    (e.g. when nothing is emitted but the user expects something to be emitted)
+*)