Merge pull request #52 from imandra-ai/wip-trace-0.6

support trace 0.6

.github/workflows/main.yml

@@ -49,6 +49,12 @@ jobs:
 
       - run: opam exec -- dune build @install -p opentelemetry,opentelemetry-lwt,opentelemetry-client-ocurl,opentelemetry-cohttp-lwt,opentelemetry-client-cohttp-lwt
 
+      - run: opam install trace.0.4
+      - run: opam exec -- dune build @install -p opentelemetry
+
+      - run: opam install trace.0.6
+      - run: opam exec -- dune build @install -p opentelemetry
+
       - run: opam install ocaml-protoc
       - run: opam exec -- dune build @lint
 

src/core/opentelemetry.ml

@@ -429,7 +429,8 @@ module Globals = struct
   let service_instance_id = ref None
 
   let instrumentation_library =
-    default_instrumentation_scope ~version:"0.2" ~name:"ocaml-otel" ()
+    default_instrumentation_scope ~version:"%%VERSION_NUM%%" ~name:"ocaml-otel"
+      ()
 
   (** Global attributes, initially set
       via OTEL_RESOURCE_ATTRIBUTES and modifiable
@@ -780,7 +781,13 @@ module Trace = struct
       let status =
         match res with
         | Ok () -> default_status ~code:Status_code_ok ()
-        | Error e -> default_status ~code:Status_code_error ~message:e ()
+        | Error (e, bt) ->
+          (* add backtrace *)
+          add_event scope (fun () ->
+              Event.make "error"
+                ~attrs:
+                  [ "backtrace", `String (Printexc.raw_backtrace_to_string bt) ]);
+          default_status ~code:Status_code_error ~message:e ()
       in
       let span, _ =
         (* TODO: should the attrs passed to with_ go on the Span
@@ -827,7 +834,8 @@ module Trace = struct
       finally (Ok ());
       rv
     with e ->
-      finally (Error (Printexc.to_string e));
+      let bt = Printexc.get_raw_backtrace () in
+      finally (Error (Printexc.to_string e, bt));
       raise e
 end
 

src/lwt/opentelemetry_lwt.ml

@@ -28,7 +28,8 @@ module Trace = struct
       let () = finally (Ok ()) in
       Lwt.return rv
     with e ->
-      let () = finally (Error (Printexc.to_string e)) in
+      let bt = Printexc.get_raw_backtrace () in
+      let () = finally (Error (Printexc.to_string e, bt)) in
       Lwt.fail e
 end
 

src/trace/opentelemetry_trace.ml

@@ -130,7 +130,7 @@ module Internal = struct
 
     otrace_id, sb
 
-  let exit_span' otrace_id
+  let exit_span_
       {
         id = otel_id;
         start_time;
@@ -145,11 +145,7 @@ module Internal = struct
         parent_scope = _;
       } =
     let open Otel in
-    let active_spans = Active_spans.get () in
-    Active_span_tbl.remove active_spans.tbl otrace_id;
-
     let end_time = Timestamp_ns.now_unix_ns () in
-
     let kind, attrs = otel_attrs_of_otrace_data data in
 
     let attrs =
@@ -176,6 +172,19 @@ module Internal = struct
       ~end_time ~attrs name
     |> fst
 
+  let exit_span' otrace_id otel_span_begin =
+    let active_spans = Active_spans.get () in
+    Active_span_tbl.remove active_spans.tbl otrace_id;
+    exit_span_ otel_span_begin
+
+  let exit_span_from_id otrace_id =
+    let active_spans = Active_spans.get () in
+    match Active_span_tbl.find_opt active_spans.tbl otrace_id with
+    | None -> None
+    | Some otel_span_begin ->
+      Active_span_tbl.remove active_spans.tbl otrace_id;
+      Some (exit_span_ otel_span_begin)
+
   module M = struct
     let with_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name cb =
       let otrace_id, sb =
@@ -187,9 +196,23 @@ module Internal = struct
 
       let otel_span = exit_span' otrace_id sb in
       Otel.Trace.emit [ otel_span ];
-
       rv
 
+    let enter_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name :
+        Trace_core.span =
+      let otrace_id, _sb =
+        enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name
+      in
+      (* NOTE: we cannot enter ambient scope in a disjoint way
+         with the exit, because we only have [Ambient_context.with_binding],
+         no [set_binding] *)
+      otrace_id
+
+    let exit_span otrace_id =
+      match exit_span_from_id otrace_id with
+      | None -> ()
+      | Some otel_span -> Otel.Trace.emit [ otel_span ]
+
     let enter_manual_span ~(parent : Otrace.explicit_span option) ~flavor:_
         ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : Otrace.explicit_span =
       let otrace_id, sb =