gazagnaire.org
Trace Event Format summary CLI
4.8 kB
148 lines
1(*---------------------------------------------------------------------------
2 Copyright (c) 2026 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6module C = Json.Codec
7
8module Frame = struct
9 type t = {
10 category : string option;
11 name : string option;
12 parent : string option;
13 }
14
15 let v ?category ?name ?parent () = { category; name; parent }
16
17 let codec =
18 C.Object.map ~kind:"stack frame" (fun category name parent ->
19 { category; name; parent })
20 |> C.Object.opt_member "category" C.string ~enc:(fun f -> f.category)
21 |> C.Object.opt_member "name" C.string ~enc:(fun f -> f.name)
22 |> C.Object.opt_member "parent" C.string ~enc:(fun f -> f.parent)
23 |> C.Object.seal
24
25 let equal a b = Json.Value.equal (Json.encode codec a) (Json.encode codec b)
26 let pp = Json.pp_value codec
27end
28
29module Sample = struct
30 type t = {
31 cpu : int option;
32 tid : int option;
33 ts : float;
34 name : string option;
35 sf : Event.id option;
36 weight : int option;
37 }
38
39 let v ?cpu ?tid ?name ?sf ?weight ~ts () = { cpu; tid; ts; name; sf; weight }
40
41 let codec =
42 C.Object.map ~kind:"sample" (fun cpu tid ts name sf weight ->
43 { cpu; tid; ts; name; sf; weight })
44 |> C.Object.opt_member "cpu" C.int ~enc:(fun s -> s.cpu)
45 |> C.Object.opt_member "tid" C.int ~enc:(fun s -> s.tid)
46 |> C.Object.member "ts" C.number ~dec_absent:0. ~enc:(fun s -> s.ts)
47 |> C.Object.opt_member "name" C.string ~enc:(fun s -> s.name)
48 |> C.Object.opt_member "sf" Event.id_codec ~enc:(fun s -> s.sf)
49 |> C.Object.opt_member "weight" C.int ~enc:(fun s -> s.weight)
50 |> C.Object.seal
51
52 let equal a b = Json.Value.equal (Json.encode codec a) (Json.encode codec b)
53 let pp = Json.pp_value codec
54end
55
56type time_unit = [ `Ms | `Ns ]
57
58type t = {
59 events : Event.t list;
60 display_time_unit : time_unit option;
61 system_trace_events : string option;
62 power_trace_as_string : string option;
63 controller_trace_data_key : string option;
64 stack_frames : (string * Frame.t) list;
65 samples : Sample.t list;
66 metadata : (string * Json.t) list;
67}
68
69let v ?display_time_unit ?system_trace_events ?power_trace_as_string
70 ?controller_trace_data_key ?(stack_frames = []) ?(samples = [])
71 ?(metadata = []) events =
72 {
73 events;
74 display_time_unit;
75 system_trace_events;
76 power_trace_as_string;
77 controller_trace_data_key;
78 stack_frames;
79 samples;
80 metadata;
81 }
82
83let is_empty = function [] -> true | _ :: _ -> false
84
85let events_only t =
86 t.display_time_unit = None
87 && t.system_trace_events = None
88 && t.power_trace_as_string = None
89 && t.controller_trace_data_key = None
90 && is_empty t.stack_frames && is_empty t.samples && is_empty t.metadata
91
92let time_unit_codec =
93 C.enum ~kind:"displayTimeUnit" [ ("ms", `Ms); ("ns", `Ns) ]
94
95let object_codec =
96 let make events display_time_unit system_trace_events power_trace_as_string
97 controller_trace_data_key stack_frames samples metadata =
98 {
99 events;
100 display_time_unit;
101 system_trace_events;
102 power_trace_as_string;
103 controller_trace_data_key;
104 stack_frames;
105 samples;
106 metadata;
107 }
108 in
109 C.Object.map ~kind:"trace" make
110 |> C.Object.member "traceEvents" (C.list Event.codec) ~dec_absent:[]
111 ~enc:(fun t -> t.events)
112 |> C.Object.opt_member "displayTimeUnit" time_unit_codec ~enc:(fun t ->
113 t.display_time_unit)
114 |> C.Object.opt_member "systemTraceEvents" C.string ~enc:(fun t ->
115 t.system_trace_events)
116 |> C.Object.opt_member "powerTraceAsString" C.string ~enc:(fun t ->
117 t.power_trace_as_string)
118 |> C.Object.opt_member "controllerTraceDataKey" C.string ~enc:(fun t ->
119 t.controller_trace_data_key)
120 |> C.Object.member "stackFrames"
121 (C.Object.as_assoc Frame.codec)
122 ~dec_absent:[]
123 ~enc:(fun t -> t.stack_frames)
124 ~enc_omit:is_empty
125 |> C.Object.member "samples" (C.list Sample.codec) ~dec_absent:[]
126 ~enc:(fun t -> t.samples)
127 ~enc_omit:is_empty
128 |> C.Object.keep_unknown (C.Object.Members.assoc C.Value.t) ~enc:(fun t ->
129 t.metadata)
130 |> C.Object.seal
131
132let array_codec =
133 C.map ~kind:"trace" (C.list Event.codec)
134 ~dec:(fun events -> v events)
135 ~enc:(fun t ->
136 if events_only t then t.events
137 else
138 invalid_arg
139 "Catapult: the array format cannot carry non-event trace data; use \
140 the object format")
141
142let codec =
143 C.any ~kind:"trace" ~dec_array:array_codec ~dec_object:object_codec
144 ~enc:(fun t -> if events_only t then array_codec else object_codec)
145 ()
146
147let equal a b = Json.Value.equal (Json.encode codec a) (Json.encode codec b)
148let pp = Json.pp_value codec