mirror of
https://github.com/ocaml-tracing/ocaml-trace.git
synced 2026-03-09 12:23:32 -04:00
95 lines
3 KiB
OCaml
95 lines
3 KiB
OCaml
let char = Buffer.add_char
|
|
let raw_string = Buffer.add_string
|
|
|
|
let str_val (buf : Buffer.t) (s : string) =
|
|
char buf '"';
|
|
let encode_char c =
|
|
match c with
|
|
| '"' -> raw_string buf {|\"|}
|
|
| '\\' -> raw_string buf {|\\|}
|
|
| '\n' -> raw_string buf {|\n|}
|
|
| '\b' -> raw_string buf {|\b|}
|
|
| '\r' -> raw_string buf {|\r|}
|
|
| '\t' -> raw_string buf {|\t|}
|
|
| _ when Char.code c <= 0x1f ->
|
|
raw_string buf {|\u00|};
|
|
Printf.bprintf buf "%02x" (Char.code c)
|
|
| c -> char buf c
|
|
in
|
|
String.iter encode_char s;
|
|
char buf '"'
|
|
|
|
let pp_user_data_ (out : Buffer.t) : Trace_core.user_data -> unit = function
|
|
| `None -> raw_string out "null"
|
|
| `Int i -> Printf.bprintf out "%d" i
|
|
| `Bool b -> Printf.bprintf out "%b" b
|
|
| `String s -> str_val out s
|
|
| `Float f -> Printf.bprintf out "%g" f
|
|
|
|
(* emit args, if not empty. [ppv] is used to print values. *)
|
|
let emit_args_o_ ppv (out : Buffer.t) args : unit =
|
|
if args <> [] then (
|
|
Printf.bprintf out {json|,"args": {|json};
|
|
List.iteri
|
|
(fun i (n, value) ->
|
|
if i > 0 then raw_string out ",";
|
|
Printf.bprintf out {json|"%s":%a|json} n ppv value)
|
|
args;
|
|
char out '}'
|
|
)
|
|
|
|
let emit_duration_event ~pid ~tid ~name ~start ~end_ ~args buf : unit =
|
|
let dur = end_ -. start in
|
|
let ts = start in
|
|
|
|
Printf.bprintf buf
|
|
{json|{"pid":%d,"cat":"","tid": %d,"dur": %.2f,"ts": %.2f,"name":%a,"ph":"X"%a}|json}
|
|
pid tid dur ts str_val name
|
|
(emit_args_o_ pp_user_data_)
|
|
args
|
|
|
|
let emit_manual_begin ~pid ~tid ~name ~(id : int64) ~ts ~args
|
|
~(flavor : Trace_core.span_flavor option) buf : unit =
|
|
Printf.bprintf buf
|
|
{json|{"pid":%d,"cat":"trace","id":%Ld,"tid": %d,"ts": %.2f,"name":%a,"ph":"%c"%a}|json}
|
|
pid id tid ts str_val name
|
|
(match flavor with
|
|
| None | Some `Async -> 'b'
|
|
| Some `Sync -> 'B')
|
|
(emit_args_o_ pp_user_data_)
|
|
args
|
|
|
|
let emit_manual_end ~pid ~tid ~name ~(id : int64) ~ts
|
|
~(flavor : Trace_core.span_flavor option) ~args buf : unit =
|
|
Printf.bprintf buf
|
|
{json|{"pid":%d,"cat":"trace","id":%Ld,"tid": %d,"ts": %.2f,"name":%a,"ph":"%c"%a}|json}
|
|
pid id tid ts str_val name
|
|
(match flavor with
|
|
| None | Some `Async -> 'e'
|
|
| Some `Sync -> 'E')
|
|
(emit_args_o_ pp_user_data_)
|
|
args
|
|
|
|
let emit_instant_event ~pid ~tid ~name ~ts ~args buf : unit =
|
|
Printf.bprintf buf
|
|
{json|{"pid":%d,"cat":"","tid": %d,"ts": %.2f,"name":%a,"ph":"I"%a}|json}
|
|
pid tid ts str_val name
|
|
(emit_args_o_ pp_user_data_)
|
|
args
|
|
|
|
let emit_name_thread ~pid ~tid ~name buf : unit =
|
|
Printf.bprintf buf
|
|
{json|{"pid":%d,"tid": %d,"name":"thread_name","ph":"M"%a}|json} pid tid
|
|
(emit_args_o_ pp_user_data_)
|
|
[ "name", `String name ]
|
|
|
|
let emit_name_process ~pid ~name buf : unit =
|
|
Printf.bprintf buf {json|{"pid":%d,"name":"process_name","ph":"M"%a}|json} pid
|
|
(emit_args_o_ pp_user_data_)
|
|
[ "name", `String name ]
|
|
|
|
let emit_counter ~pid ~tid ~name ~ts buf f : unit =
|
|
Printf.bprintf buf
|
|
{json|{"pid":%d,"tid":%d,"ts":%.2f,"name":"c","ph":"C"%a}|json} pid tid ts
|
|
(emit_args_o_ pp_user_data_)
|
|
[ name, `Float f ]
|