Add custom events callback for json

bin/olly.ml

@@ -169,12 +169,14 @@ let trace format trace_filename exec_args =
           (ts_to_us ts) ring_id ring_id;
         flush trace_file
       in
+      let extra = Olly_custom_events.v_json trace_file in
       let init () =
         (* emit prefix in the tracefile *)
         Printf.fprintf trace_file "["
       in
       let cleanup () = close_out trace_file in
-      olly ~runtime_begin ~runtime_end ~init ~lifecycle ~cleanup exec_args
+      olly ~extra ~runtime_begin ~runtime_end ~init ~lifecycle ~cleanup
+        exec_args
   | Fuchsia ->
       let open Tracing in
       let trace_file =

bin/olly_custom_events.no.ml

@@ -1 +1,2 @@
 let v _trace_file _doms cb = cb
+let v_json _trace_file cb = cb

bin/olly_custom_events.yes.ml

@@ -29,9 +29,27 @@ let unit trace_file doms ring_id ts ev () =
     ~name
     ~time:(ts |> ts_to_int |> int_to_span)
 
+let span_json trace_file ring_id ts ev value =
+  let ts_to_us ts = Int64.(div (Ts.to_int64 ts) (of_int 1000)) in
+  let name = Runtime_events.User.name ev in
+  if value = Runtime_events.Type.Begin then
+    Printf.fprintf trace_file
+      "{\"name\": \"%s\", \"cat\": \"PERF\", \"ph\":\"B\", \"ts\":%Ld, \
+       \"pid\": %d, \"tid\": %d},\n"
+      name (ts_to_us ts) ring_id ring_id
+  else
+    Printf.fprintf trace_file
+      "{\"name\": \"%s\", \"cat\": \"PERF\", \"ph\":\"E\", \"ts\":%Ld, \
+       \"pid\": %d, \"tid\": %d},\n"
+      name (ts_to_us ts) ring_id ring_id
+
 let v trace_file doms cb =
   let open Runtime_events in
   cb
   |> Callbacks.add_user_event Type.span (span trace_file doms)
   |> Callbacks.add_user_event Type.int (int trace_file doms)
   |> Callbacks.add_user_event Type.unit (unit trace_file doms)
+
+let v_json trace_file cb =
+  let open Runtime_events in
+  cb |> Callbacks.add_user_event Type.span (span_json trace_file)

test/dune

@@ -40,6 +40,18 @@
   (progn
    (run olly trace test.trace ./test.exe))))
 
+(rule
+ (alias trace_json)
+ (enabled_if
+  (>= %{ocaml_version} 5.1.0))
+ (target test-json.trace)
+ (deps
+  (alias olly)
+  test.exe)
+ (action
+  (progn
+   (run olly trace --format=json test-json.trace ./test.exe))))
+
 (executable
  (name test)
  (modules test)