OCaml client library for Claude Code
stix, claude: open Json.Codec for codec-heavy files
Add [open Json.Codec] at the top of files where codec combinators
dominate (stix.ml has 114 refs, claude/control/message/hooks/permissions
40-110 each). Strips the [Json.Codec.] prefix from [Object.map], [string],
[int], [bool], [list], [option], etc. — matching the spec skill's
[let open Foo.Codec in ...] recommendation applied at file scope.
Also: Json.to_string now returns plain string (not result), so collapse
the stale [match Json.to_string with | Ok s -> ... | Error _ -> ...]
patterns to direct [let s = Json.to_string ... in] use.
+306
-298
+112
-110
lib/control.ml
+112
-110
lib/control.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
+
open Json.Codec
7
+
6
8
let src = Logs.Src.create "claude.control" ~doc:"Claude control protocol"
7
9
8
10
module Log = (val Logs.src_log src : Logs.LOG)
···
104
106
let make (unknown : Unknown.t) : interrupt =
105
107
{ subtype = `Interrupt; unknown }
106
108
in
107
-
Json.Codec.Object.map ~kind:"Interrupt" make
108
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : interrupt) ->
109
+
Object.map ~kind:"Interrupt" make
110
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : interrupt) ->
109
111
r.unknown)
110
-
|> Json.Codec.Object.finish
112
+
|> Object.finish
111
113
112
114
let permission_jsont : permission Json.codec =
113
115
let make tool_name input permission_suggestions blocked_path
···
121
123
unknown;
122
124
}
123
125
in
124
-
Json.Codec.Object.map ~kind:"Permission" make
125
-
|> Json.Codec.Object.mem "tool_name" Json.Codec.string
126
+
Object.map ~kind:"Permission" make
127
+
|> Object.mem "tool_name" string
126
128
~enc:(fun (r : permission) -> r.tool_name)
127
-
|> Json.Codec.Object.mem "input" Json.Codec.Value.t
129
+
|> Object.mem "input" Value.t
128
130
~enc:(fun (r : permission) -> r.input)
129
-
|> Json.Codec.Object.opt_mem "permission_suggestions"
130
-
(Json.Codec.list Permissions.Update.json) ~enc:(fun (r : permission) ->
131
+
|> Object.opt_mem "permission_suggestions"
132
+
(list Permissions.Update.json) ~enc:(fun (r : permission) ->
131
133
r.permission_suggestions)
132
-
|> Json.Codec.Object.opt_mem "blocked_path" Json.Codec.string
134
+
|> Object.opt_mem "blocked_path" string
133
135
~enc:(fun (r : permission) -> r.blocked_path)
134
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : permission) ->
136
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : permission) ->
135
137
r.unknown)
136
-
|> Json.Codec.Object.finish
138
+
|> Object.finish
137
139
138
140
let initialize_jsont : initialize Json.codec =
139
141
(* The hooks field is an object with string keys and json values *)
140
-
let hooks_map_jsont = Json.Codec.Object.as_string_map Json.Codec.Value.t in
142
+
let hooks_map_jsont = Object.as_string_map Value.t in
141
143
let module StringMap = Map.Make (String) in
142
144
let hooks_jsont =
143
-
Json.Codec.map
145
+
map
144
146
~dec:(fun m -> StringMap.bindings m)
145
147
~enc:(fun l -> StringMap.of_seq (List.to_seq l))
146
148
hooks_map_jsont
···
148
150
let make hooks (unknown : Unknown.t) : initialize =
149
151
{ subtype = `Initialize; hooks; unknown }
150
152
in
151
-
Json.Codec.Object.map ~kind:"Initialize" make
152
-
|> Json.Codec.Object.opt_mem "hooks" hooks_jsont
153
+
Object.map ~kind:"Initialize" make
154
+
|> Object.opt_mem "hooks" hooks_jsont
153
155
~enc:(fun (r : initialize) -> r.hooks)
154
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize) ->
156
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize) ->
155
157
r.unknown)
156
-
|> Json.Codec.Object.finish
158
+
|> Object.finish
157
159
158
160
let set_permission_mode_jsont : set_permission_mode Json.codec =
159
161
let make mode (unknown : Unknown.t) : set_permission_mode =
160
162
{ subtype = `Set_permission_mode; mode; unknown }
161
163
in
162
-
Json.Codec.Object.map ~kind:"SetPermissionMode" make
163
-
|> Json.Codec.Object.mem "mode" Permissions.Mode.json
164
+
Object.map ~kind:"SetPermissionMode" make
165
+
|> Object.mem "mode" Permissions.Mode.json
164
166
~enc:(fun (r : set_permission_mode) -> r.mode)
165
-
|> Json.Codec.Object.keep_unknown Unknown.mems
167
+
|> Object.keep_unknown Unknown.mems
166
168
~enc:(fun (r : set_permission_mode) -> r.unknown)
167
-
|> Json.Codec.Object.finish
169
+
|> Object.finish
168
170
169
171
let hook_callback_jsont : hook_callback Json.codec =
170
172
let make callback_id input tool_use_id (unknown : Unknown.t) : hook_callback
171
173
=
172
174
{ subtype = `Hook_callback; callback_id; input; tool_use_id; unknown }
173
175
in
174
-
Json.Codec.Object.map ~kind:"HookCallback" make
175
-
|> Json.Codec.Object.mem "callback_id" Json.Codec.string
176
+
Object.map ~kind:"HookCallback" make
177
+
|> Object.mem "callback_id" string
176
178
~enc:(fun (r : hook_callback) -> r.callback_id)
177
-
|> Json.Codec.Object.mem "input" Json.Codec.Value.t
179
+
|> Object.mem "input" Value.t
178
180
~enc:(fun (r : hook_callback) -> r.input)
179
-
|> Json.Codec.Object.opt_mem "tool_use_id" Json.Codec.string
181
+
|> Object.opt_mem "tool_use_id" string
180
182
~enc:(fun (r : hook_callback) -> r.tool_use_id)
181
-
|> Json.Codec.Object.keep_unknown Unknown.mems
183
+
|> Object.keep_unknown Unknown.mems
182
184
~enc:(fun (r : hook_callback) -> r.unknown)
183
-
|> Json.Codec.Object.finish
185
+
|> Object.finish
184
186
185
187
let mcp_message_jsont : mcp_message Json.codec =
186
188
let make server_name message (unknown : Unknown.t) : mcp_message =
187
189
{ subtype = `Mcp_message; server_name; message; unknown }
188
190
in
189
-
Json.Codec.Object.map ~kind:"McpMessage" make
190
-
|> Json.Codec.Object.mem "server_name" Json.Codec.string
191
+
Object.map ~kind:"McpMessage" make
192
+
|> Object.mem "server_name" string
191
193
~enc:(fun (r : mcp_message) -> r.server_name)
192
-
|> Json.Codec.Object.mem "message" Json.Codec.Value.t
194
+
|> Object.mem "message" Value.t
193
195
~enc:(fun (r : mcp_message) -> r.message)
194
-
|> Json.Codec.Object.keep_unknown Unknown.mems
196
+
|> Object.keep_unknown Unknown.mems
195
197
~enc:(fun (r : mcp_message) -> r.unknown)
196
-
|> Json.Codec.Object.finish
198
+
|> Object.finish
197
199
198
200
let set_model_jsont : set_model Json.codec =
199
201
let make model (unknown : Unknown.t) : set_model =
200
202
{ subtype = `Set_model; model; unknown }
201
203
in
202
-
Json.Codec.Object.map ~kind:"SetModel" make
203
-
|> Json.Codec.Object.mem "model" Json.Codec.string
204
+
Object.map ~kind:"SetModel" make
205
+
|> Object.mem "model" string
204
206
~enc:(fun (r : set_model) -> r.model)
205
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model) ->
207
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model) ->
206
208
r.unknown)
207
-
|> Json.Codec.Object.finish
209
+
|> Object.finish
208
210
209
211
let get_server_info_jsont : get_server_info Json.codec =
210
212
let make (unknown : Unknown.t) : get_server_info =
211
213
{ subtype = `Get_server_info; unknown }
212
214
in
213
-
Json.Codec.Object.map ~kind:"GetServerInfo" make
214
-
|> Json.Codec.Object.keep_unknown Unknown.mems
215
+
Object.map ~kind:"GetServerInfo" make
216
+
|> Object.keep_unknown Unknown.mems
215
217
~enc:(fun (r : get_server_info) -> r.unknown)
216
-
|> Json.Codec.Object.finish
218
+
|> Object.finish
217
219
218
220
(* Main variant codec using subtype discriminator *)
219
221
let json : t Json.codec =
220
222
let case_interrupt =
221
-
Json.Codec.Object.Case.map "interrupt" interrupt_jsont ~dec:(fun v ->
223
+
Object.Case.map "interrupt" interrupt_jsont ~dec:(fun v ->
222
224
Interrupt v)
223
225
in
224
226
let case_permission =
225
-
Json.Codec.Object.Case.map "can_use_tool" permission_jsont ~dec:(fun v ->
227
+
Object.Case.map "can_use_tool" permission_jsont ~dec:(fun v ->
226
228
Permission v)
227
229
in
228
230
let case_initialize =
229
-
Json.Codec.Object.Case.map "initialize" initialize_jsont ~dec:(fun v ->
231
+
Object.Case.map "initialize" initialize_jsont ~dec:(fun v ->
230
232
Initialize v)
231
233
in
232
234
let case_set_permission_mode =
233
-
Json.Codec.Object.Case.map "set_permission_mode" set_permission_mode_jsont
235
+
Object.Case.map "set_permission_mode" set_permission_mode_jsont
234
236
~dec:(fun v -> Set_permission_mode v)
235
237
in
236
238
let case_hook_callback =
237
-
Json.Codec.Object.Case.map "hook_callback" hook_callback_jsont
239
+
Object.Case.map "hook_callback" hook_callback_jsont
238
240
~dec:(fun v -> Hook_callback v)
239
241
in
240
242
let case_mcp_message =
241
-
Json.Codec.Object.Case.map "mcp_message" mcp_message_jsont ~dec:(fun v ->
243
+
Object.Case.map "mcp_message" mcp_message_jsont ~dec:(fun v ->
242
244
Mcp_message v)
243
245
in
244
246
let case_set_model =
245
-
Json.Codec.Object.Case.map "set_model" set_model_jsont ~dec:(fun v ->
247
+
Object.Case.map "set_model" set_model_jsont ~dec:(fun v ->
246
248
Set_model v)
247
249
in
248
250
let case_get_server_info =
249
-
Json.Codec.Object.Case.map "get_server_info" get_server_info_jsont
251
+
Object.Case.map "get_server_info" get_server_info_jsont
250
252
~dec:(fun v -> Get_server_info v)
251
253
in
252
254
253
255
let enc_case = function
254
-
| Interrupt v -> Json.Codec.Object.Case.value case_interrupt v
255
-
| Permission v -> Json.Codec.Object.Case.value case_permission v
256
-
| Initialize v -> Json.Codec.Object.Case.value case_initialize v
256
+
| Interrupt v -> Object.Case.value case_interrupt v
257
+
| Permission v -> Object.Case.value case_permission v
258
+
| Initialize v -> Object.Case.value case_initialize v
257
259
| Set_permission_mode v ->
258
-
Json.Codec.Object.Case.value case_set_permission_mode v
259
-
| Hook_callback v -> Json.Codec.Object.Case.value case_hook_callback v
260
-
| Mcp_message v -> Json.Codec.Object.Case.value case_mcp_message v
261
-
| Set_model v -> Json.Codec.Object.Case.value case_set_model v
262
-
| Get_server_info v -> Json.Codec.Object.Case.value case_get_server_info v
260
+
Object.Case.value case_set_permission_mode v
261
+
| Hook_callback v -> Object.Case.value case_hook_callback v
262
+
| Mcp_message v -> Object.Case.value case_mcp_message v
263
+
| Set_model v -> Object.Case.value case_set_model v
264
+
| Get_server_info v -> Object.Case.value case_get_server_info v
263
265
in
264
266
265
267
let cases =
266
-
Json.Codec.Object.Case.
268
+
Object.Case.
267
269
[
268
270
make case_interrupt;
269
271
make case_permission;
···
276
278
]
277
279
in
278
280
279
-
Json.Codec.Object.map ~kind:"Request" Fun.id
280
-
|> Json.Codec.Object.case_mem "subtype" Json.Codec.string ~enc:Fun.id
281
+
Object.map ~kind:"Request" Fun.id
282
+
|> Object.case_mem "subtype" string ~enc:Fun.id
281
283
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
282
-
|> Json.Codec.Object.finish
284
+
|> Object.finish
283
285
end
284
286
285
287
module Response = struct
···
309
311
| n -> `Custom n
310
312
311
313
let json : t Json.codec =
312
-
Json.Codec.map ~kind:"ErrorCode" ~dec:of_int ~enc:to_int Json.Codec.int
314
+
map ~kind:"ErrorCode" ~dec:of_int ~enc:to_int int
313
315
end
314
316
315
317
type error_detail = { code : int; message : string; data : Json.t option }
···
319
321
320
322
let error_detail_jsont : error_detail Json.codec =
321
323
let make code message data = { code; message; data } in
322
-
Json.Codec.Object.map ~kind:"ErrorDetail" make
323
-
|> Json.Codec.Object.mem "code" Json.Codec.int ~enc:(fun e -> e.code)
324
-
|> Json.Codec.Object.mem "message" Json.Codec.string ~enc:(fun e ->
324
+
Object.map ~kind:"ErrorDetail" make
325
+
|> Object.mem "code" int ~enc:(fun e -> e.code)
326
+
|> Object.mem "message" string ~enc:(fun e ->
325
327
e.message)
326
-
|> Json.Codec.Object.opt_mem "data" Json.Codec.Value.t ~enc:(fun e ->
328
+
|> Object.opt_mem "data" Value.t ~enc:(fun e ->
327
329
e.data)
328
-
|> Json.Codec.Object.finish
330
+
|> Object.finish
329
331
330
332
type success = {
331
333
subtype : [ `Success ];
···
354
356
let make request_id response (unknown : Unknown.t) : success =
355
357
{ subtype = `Success; request_id; response; unknown }
356
358
in
357
-
Json.Codec.Object.map ~kind:"Success" make
358
-
|> Json.Codec.Object.mem "request_id" Json.Codec.string
359
+
Object.map ~kind:"Success" make
360
+
|> Object.mem "request_id" string
359
361
~enc:(fun (r : success) -> r.request_id)
360
-
|> Json.Codec.Object.opt_mem "response" Json.Codec.Value.t
362
+
|> Object.opt_mem "response" Value.t
361
363
~enc:(fun (r : success) -> r.response)
362
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : success) ->
364
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : success) ->
363
365
r.unknown)
364
-
|> Json.Codec.Object.finish
366
+
|> Object.finish
365
367
366
368
let error_jsont : error Json.codec =
367
369
let make request_id error (unknown : Unknown.t) : error =
368
370
{ subtype = `Error; request_id; error; unknown }
369
371
in
370
-
Json.Codec.Object.map ~kind:"Error" make
371
-
|> Json.Codec.Object.mem "request_id" Json.Codec.string
372
+
Object.map ~kind:"Error" make
373
+
|> Object.mem "request_id" string
372
374
~enc:(fun (r : error) -> r.request_id)
373
-
|> Json.Codec.Object.mem "error" error_detail_jsont ~enc:(fun (r : error) ->
375
+
|> Object.mem "error" error_detail_jsont ~enc:(fun (r : error) ->
374
376
r.error)
375
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
377
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
376
378
r.unknown)
377
-
|> Json.Codec.Object.finish
379
+
|> Object.finish
378
380
379
381
(* Main variant codec using subtype discriminator *)
380
382
let json : t Json.codec =
381
383
let case_success =
382
-
Json.Codec.Object.Case.map "success" success_jsont ~dec:(fun v ->
384
+
Object.Case.map "success" success_jsont ~dec:(fun v ->
383
385
Success v)
384
386
in
385
387
let case_error =
386
-
Json.Codec.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
388
+
Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
387
389
in
388
390
389
391
let enc_case = function
390
-
| Success v -> Json.Codec.Object.Case.value case_success v
391
-
| Error v -> Json.Codec.Object.Case.value case_error v
392
+
| Success v -> Object.Case.value case_success v
393
+
| Error v -> Object.Case.value case_error v
392
394
in
393
395
394
-
let cases = Json.Codec.Object.Case.[ make case_success; make case_error ] in
396
+
let cases = Object.Case.[ make case_success; make case_error ] in
395
397
396
-
Json.Codec.Object.map ~kind:"Response" Fun.id
397
-
|> Json.Codec.Object.case_mem "subtype" Json.Codec.string ~enc:Fun.id
398
+
Object.map ~kind:"Response" Fun.id
399
+
|> Object.case_mem "subtype" string ~enc:Fun.id
398
400
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
399
-
|> Json.Codec.Object.finish
401
+
|> Object.finish
400
402
end
401
403
402
404
type control_request = {
···
425
427
let make request_id request (unknown : Unknown.t) : control_request =
426
428
{ type_ = `Control_request; request_id; request; unknown }
427
429
in
428
-
Json.Codec.Object.map ~kind:"ControlRequest" make
429
-
|> Json.Codec.Object.mem "request_id" Json.Codec.string
430
+
Object.map ~kind:"ControlRequest" make
431
+
|> Object.mem "request_id" string
430
432
~enc:(fun (r : control_request) -> r.request_id)
431
-
|> Json.Codec.Object.mem "request" Request.json
433
+
|> Object.mem "request" Request.json
432
434
~enc:(fun (r : control_request) -> r.request)
433
-
|> Json.Codec.Object.keep_unknown Unknown.mems
435
+
|> Object.keep_unknown Unknown.mems
434
436
~enc:(fun (r : control_request) -> r.unknown)
435
-
|> Json.Codec.Object.finish
437
+
|> Object.finish
436
438
437
439
let control_response_jsont : control_response Json.codec =
438
440
let make response (unknown : Unknown.t) : control_response =
439
441
{ type_ = `Control_response; response; unknown }
440
442
in
441
-
Json.Codec.Object.map ~kind:"ControlResponse" make
442
-
|> Json.Codec.Object.mem "response" Response.json
443
+
Object.map ~kind:"ControlResponse" make
444
+
|> Object.mem "response" Response.json
443
445
~enc:(fun (r : control_response) -> r.response)
444
-
|> Json.Codec.Object.keep_unknown Unknown.mems
446
+
|> Object.keep_unknown Unknown.mems
445
447
~enc:(fun (r : control_response) -> r.unknown)
446
-
|> Json.Codec.Object.finish
448
+
|> Object.finish
447
449
448
450
(* Main variant codec using type discriminator *)
449
451
let json : t Json.codec =
450
452
let case_request =
451
-
Json.Codec.Object.Case.map "control_request" control_request_jsont
453
+
Object.Case.map "control_request" control_request_jsont
452
454
~dec:(fun v -> Request v)
453
455
in
454
456
let case_response =
455
-
Json.Codec.Object.Case.map "control_response" control_response_jsont
457
+
Object.Case.map "control_response" control_response_jsont
456
458
~dec:(fun v -> Response v)
457
459
in
458
460
459
461
let enc_case = function
460
-
| Request v -> Json.Codec.Object.Case.value case_request v
461
-
| Response v -> Json.Codec.Object.Case.value case_response v
462
+
| Request v -> Object.Case.value case_request v
463
+
| Response v -> Object.Case.value case_response v
462
464
in
463
465
464
466
let cases =
465
-
Json.Codec.Object.Case.[ make case_request; make case_response ]
467
+
Object.Case.[ make case_request; make case_response ]
466
468
in
467
469
468
-
Json.Codec.Object.map ~kind:"Control" Fun.id
469
-
|> Json.Codec.Object.case_mem "type" Json.Codec.string ~enc:Fun.id ~enc_case
470
+
Object.map ~kind:"Control" Fun.id
471
+
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case
470
472
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
471
-
|> Json.Codec.Object.finish
473
+
|> Object.finish
472
474
473
475
let pp ppf t = Json.pp_value json () ppf t
474
476
···
505
507
t =
506
508
{ version; capabilities; commands; output_styles; unknown }
507
509
in
508
-
Json.Codec.Object.map ~kind:"ServerInfo" make
509
-
|> Json.Codec.Object.mem "version" Json.Codec.string ~enc:(fun (r : t) ->
510
+
Object.map ~kind:"ServerInfo" make
511
+
|> Object.mem "version" string ~enc:(fun (r : t) ->
510
512
r.version)
511
-
|> Json.Codec.Object.mem "capabilities"
512
-
(Json.Codec.list Json.Codec.string)
513
+
|> Object.mem "capabilities"
514
+
(list string)
513
515
~enc:(fun (r : t) -> r.capabilities)
514
516
~dec_absent:[]
515
-
|> Json.Codec.Object.mem "commands"
516
-
(Json.Codec.list Json.Codec.string)
517
+
|> Object.mem "commands"
518
+
(list string)
517
519
~enc:(fun (r : t) -> r.commands)
518
520
~dec_absent:[]
519
-
|> Json.Codec.Object.mem "outputStyles"
520
-
(Json.Codec.list Json.Codec.string)
521
+
|> Object.mem "outputStyles"
522
+
(list string)
521
523
~enc:(fun (r : t) -> r.output_styles)
522
524
~dec_absent:[]
523
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : t) ->
525
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : t) ->
524
526
r.unknown)
525
-
|> Json.Codec.Object.finish
527
+
|> Object.finish
526
528
end
+70
-68
lib/hooks.ml
+70
-68
lib/hooks.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
+
open Json.Codec
7
+
6
8
let src = Logs.Src.create "claude.hooks" ~doc:"Claude hooks system"
7
9
8
10
module Log = (val Logs.src_log src : Logs.LOG)
···
35
37
| s -> raise (Invalid_argument (Fmt.str "Unknown hook event: %s" s))
36
38
37
39
let event_jsont : event Json.codec =
38
-
Json.Codec.enum
40
+
enum
39
41
[
40
42
("PreToolUse", Pre_tool_use);
41
43
("PostToolUse", Post_tool_use);
···
50
52
type decision = Continue | Block
51
53
52
54
let decision_jsont : decision Json.codec =
53
-
Json.Codec.enum [ ("continue", Continue); ("block", Block) ]
55
+
enum [ ("continue", Continue); ("block", Block) ]
54
56
55
57
(** {1 Pre_tool_use Hook} *)
56
58
···
71
73
tool_input = Tool_input.of_json tool_input;
72
74
}
73
75
in
74
-
Json.Codec.Object.map ~kind:"PreToolUseInput" make
75
-
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
76
+
Object.map ~kind:"PreToolUseInput" make
77
+
|> Object.mem "session_id" string ~enc:(fun i ->
76
78
i.session_id)
77
-
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
79
+
|> Object.mem "transcript_path" string ~enc:(fun i ->
78
80
i.transcript_path)
79
-
|> Json.Codec.Object.mem "tool_name" Json.Codec.string ~enc:(fun i ->
81
+
|> Object.mem "tool_name" string ~enc:(fun i ->
80
82
i.tool_name)
81
-
|> Json.Codec.Object.mem "tool_input" Json.Codec.Value.t ~enc:(fun i ->
83
+
|> Object.mem "tool_input" Value.t ~enc:(fun i ->
82
84
Tool_input.to_json i.tool_input)
83
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
84
-
|> Json.Codec.Object.finish
85
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
86
+
|> Object.finish
85
87
86
88
type decision = Allow | Deny | Ask
87
89
88
90
let decision_jsont : decision Json.codec =
89
-
Json.Codec.enum [ ("allow", Allow); ("deny", Deny); ("ask", Ask) ]
91
+
enum [ ("allow", Allow); ("deny", Deny); ("ask", Ask) ]
90
92
91
93
type output = {
92
94
decision : decision option;
···
109
111
updated_input = Option.map Tool_input.of_json updated_input;
110
112
}
111
113
in
112
-
Json.Codec.Object.map ~kind:"PreToolUseOutput" make
113
-
|> Json.Codec.Object.mem "hookEventName" Json.Codec.string ~enc:(fun _ ->
114
+
Object.map ~kind:"PreToolUseOutput" make
115
+
|> Object.mem "hookEventName" string ~enc:(fun _ ->
114
116
"PreToolUse")
115
-
|> Json.Codec.Object.opt_mem "permissionDecision" decision_jsont
117
+
|> Object.opt_mem "permissionDecision" decision_jsont
116
118
~enc:(fun o -> o.decision)
117
-
|> Json.Codec.Object.opt_mem "permissionDecisionReason" Json.Codec.string
119
+
|> Object.opt_mem "permissionDecisionReason" string
118
120
~enc:(fun o -> o.reason)
119
-
|> Json.Codec.Object.opt_mem "updatedInput" Json.Codec.Value.t
121
+
|> Object.opt_mem "updatedInput" Value.t
120
122
~enc:(fun o -> Option.map Tool_input.to_json o.updated_input)
121
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
122
-
|> Json.Codec.Object.finish
123
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
124
+
|> Object.finish
123
125
124
126
type callback = input -> output
125
127
end
···
146
148
tool_response;
147
149
}
148
150
in
149
-
Json.Codec.Object.map ~kind:"PostToolUseInput" make
150
-
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
151
+
Object.map ~kind:"PostToolUseInput" make
152
+
|> Object.mem "session_id" string ~enc:(fun i ->
151
153
i.session_id)
152
-
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
154
+
|> Object.mem "transcript_path" string ~enc:(fun i ->
153
155
i.transcript_path)
154
-
|> Json.Codec.Object.mem "tool_name" Json.Codec.string ~enc:(fun i ->
156
+
|> Object.mem "tool_name" string ~enc:(fun i ->
155
157
i.tool_name)
156
-
|> Json.Codec.Object.mem "tool_input" Json.Codec.Value.t ~enc:(fun i ->
158
+
|> Object.mem "tool_input" Value.t ~enc:(fun i ->
157
159
Tool_input.to_json i.tool_input)
158
-
|> Json.Codec.Object.mem "tool_response" Json.Codec.Value.t ~enc:(fun i ->
160
+
|> Object.mem "tool_response" Value.t ~enc:(fun i ->
159
161
i.tool_response)
160
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
161
-
|> Json.Codec.Object.finish
162
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
163
+
|> Object.finish
162
164
163
165
type output = {
164
166
block : bool;
···
180
182
additional_context;
181
183
}
182
184
in
183
-
Json.Codec.Object.map ~kind:"PostToolUseOutput" make
184
-
|> Json.Codec.Object.mem "hookEventName" Json.Codec.string ~enc:(fun _ ->
185
+
Object.map ~kind:"PostToolUseOutput" make
186
+
|> Object.mem "hookEventName" string ~enc:(fun _ ->
185
187
"PostToolUse")
186
-
|> Json.Codec.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
188
+
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
187
189
if o.block then Some Block else None)
188
-
|> Json.Codec.Object.opt_mem "reason" Json.Codec.string ~enc:(fun o ->
190
+
|> Object.opt_mem "reason" string ~enc:(fun o ->
189
191
o.reason)
190
-
|> Json.Codec.Object.opt_mem "additionalContext" Json.Codec.string
192
+
|> Object.opt_mem "additionalContext" string
191
193
~enc:(fun o -> o.additional_context)
192
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
193
-
|> Json.Codec.Object.finish
194
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
195
+
|> Object.finish
194
196
195
197
type callback = input -> output
196
198
end
···
208
210
let make session_id transcript_path prompt _unknown =
209
211
{ session_id; transcript_path; prompt }
210
212
in
211
-
Json.Codec.Object.map ~kind:"UserPromptSubmitInput" make
212
-
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
213
+
Object.map ~kind:"UserPromptSubmitInput" make
214
+
|> Object.mem "session_id" string ~enc:(fun i ->
213
215
i.session_id)
214
-
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
216
+
|> Object.mem "transcript_path" string ~enc:(fun i ->
215
217
i.transcript_path)
216
-
|> Json.Codec.Object.mem "prompt" Json.Codec.string ~enc:(fun i -> i.prompt)
217
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
218
-
|> Json.Codec.Object.finish
218
+
|> Object.mem "prompt" string ~enc:(fun i -> i.prompt)
219
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
220
+
|> Object.finish
219
221
220
222
type output = {
221
223
block : bool;
···
236
238
additional_context;
237
239
}
238
240
in
239
-
Json.Codec.Object.map ~kind:"UserPromptSubmitOutput" make
240
-
|> Json.Codec.Object.mem "hookEventName" Json.Codec.string ~enc:(fun _ ->
241
+
Object.map ~kind:"UserPromptSubmitOutput" make
242
+
|> Object.mem "hookEventName" string ~enc:(fun _ ->
241
243
"UserPromptSubmit")
242
-
|> Json.Codec.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
244
+
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
243
245
if o.block then Some Block else None)
244
-
|> Json.Codec.Object.opt_mem "reason" Json.Codec.string ~enc:(fun o ->
246
+
|> Object.opt_mem "reason" string ~enc:(fun o ->
245
247
o.reason)
246
-
|> Json.Codec.Object.opt_mem "additionalContext" Json.Codec.string
248
+
|> Object.opt_mem "additionalContext" string
247
249
~enc:(fun o -> o.additional_context)
248
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
249
-
|> Json.Codec.Object.finish
250
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
251
+
|> Object.finish
250
252
251
253
type callback = input -> output
252
254
end
···
264
266
let make session_id transcript_path stop_hook_active _unknown =
265
267
{ session_id; transcript_path; stop_hook_active }
266
268
in
267
-
Json.Codec.Object.map ~kind:"StopInput" make
268
-
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
269
+
Object.map ~kind:"StopInput" make
270
+
|> Object.mem "session_id" string ~enc:(fun i ->
269
271
i.session_id)
270
-
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
272
+
|> Object.mem "transcript_path" string ~enc:(fun i ->
271
273
i.transcript_path)
272
-
|> Json.Codec.Object.mem "stop_hook_active" Json.Codec.bool ~enc:(fun i ->
274
+
|> Object.mem "stop_hook_active" bool ~enc:(fun i ->
273
275
i.stop_hook_active)
274
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
275
-
|> Json.Codec.Object.finish
276
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
277
+
|> Object.finish
276
278
277
279
type output = { block : bool; reason : string option }
278
280
···
286
288
reason;
287
289
}
288
290
in
289
-
Json.Codec.Object.map ~kind:(event_name ^ "Output") make
290
-
|> Json.Codec.Object.mem "hookEventName" Json.Codec.string ~enc:(fun _ ->
291
+
Object.map ~kind:(event_name ^ "Output") make
292
+
|> Object.mem "hookEventName" string ~enc:(fun _ ->
291
293
event_name)
292
-
|> Json.Codec.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
294
+
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
293
295
if o.block then Some Block else None)
294
-
|> Json.Codec.Object.opt_mem "reason" Json.Codec.string ~enc:(fun o ->
296
+
|> Object.opt_mem "reason" string ~enc:(fun o ->
295
297
o.reason)
296
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
297
-
|> Json.Codec.Object.finish
298
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
299
+
|> Object.finish
298
300
299
301
let output_jsont = output_jsont_with_event_name "Stop"
300
302
···
324
326
let make session_id transcript_path _unknown =
325
327
{ session_id; transcript_path }
326
328
in
327
-
Json.Codec.Object.map ~kind:"PreCompactInput" make
328
-
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
329
+
Object.map ~kind:"PreCompactInput" make
330
+
|> Object.mem "session_id" string ~enc:(fun i ->
329
331
i.session_id)
330
-
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
332
+
|> Object.mem "transcript_path" string ~enc:(fun i ->
331
333
i.transcript_path)
332
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
333
-
|> Json.Codec.Object.finish
334
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
335
+
|> Object.finish
334
336
335
337
type callback = input -> unit
336
338
end
···
347
349
let make decision system_message hook_specific_output _unknown =
348
350
{ decision; system_message; hook_specific_output }
349
351
in
350
-
Json.Codec.Object.map ~kind:"Result" make
351
-
|> Json.Codec.Object.opt_mem "decision" decision_jsont ~enc:(fun r ->
352
+
Object.map ~kind:"Result" make
353
+
|> Object.opt_mem "decision" decision_jsont ~enc:(fun r ->
352
354
r.decision)
353
-
|> Json.Codec.Object.opt_mem "systemMessage" Json.Codec.string ~enc:(fun r ->
355
+
|> Object.opt_mem "systemMessage" string ~enc:(fun r ->
354
356
r.system_message)
355
-
|> Json.Codec.Object.opt_mem "hookSpecificOutput" Json.Codec.Value.t
357
+
|> Object.opt_mem "hookSpecificOutput" Value.t
356
358
~enc:(fun r -> r.hook_specific_output)
357
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
358
-
|> Json.Codec.Object.finish
359
+
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
360
+
|> Object.finish
359
361
360
362
let continue_result ?system_message ?hook_specific_output () =
361
363
{ decision = None; system_message; hook_specific_output }
+78
-76
lib/message.ml
+78
-76
lib/message.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
+
open Json.Codec
7
+
6
8
let src = Logs.Src.create "claude.message" ~doc:"Claude messages"
7
9
8
10
module Log = (val Logs.src_log src : Logs.LOG)
···
62
64
Json.Array (jsons, Json.Meta.none)
63
65
64
66
let json : t Json.codec =
65
-
Json.Codec.Object.map ~kind:"User" (fun json_content unknown ->
67
+
Object.map ~kind:"User" (fun json_content unknown ->
66
68
let content = decode_content json_content in
67
69
make content unknown)
68
-
|> Json.Codec.Object.mem "content" Json.Codec.Value.t ~enc:(fun t ->
70
+
|> Object.mem "content" Value.t ~enc:(fun t ->
69
71
encode_content (content t))
70
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
71
-
|> Json.Codec.Object.finish
72
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
73
+
|> Object.finish
72
74
73
75
let incoming_jsont : t Json.codec =
74
76
let message_jsont =
75
-
Json.Codec.Object.map ~kind:"UserMessage" (fun json_content ->
77
+
Object.map ~kind:"UserMessage" (fun json_content ->
76
78
let content = decode_content json_content in
77
79
{ content; unknown = Unknown.empty })
78
-
|> Json.Codec.Object.mem "content" Json.Codec.Value.t ~enc:(fun t ->
80
+
|> Object.mem "content" Value.t ~enc:(fun t ->
79
81
encode_content (content t))
80
-
|> Json.Codec.Object.finish
82
+
|> Object.finish
81
83
in
82
-
Json.Codec.Object.map ~kind:"UserEnvelope" Fun.id
83
-
|> Json.Codec.Object.mem "message" message_jsont ~enc:Fun.id
84
-
|> Json.Codec.Object.finish
84
+
Object.map ~kind:"UserEnvelope" Fun.id
85
+
|> Object.mem "message" message_jsont ~enc:Fun.id
86
+
|> Object.finish
85
87
86
88
let outgoing_jsont : t Json.codec =
87
89
let message_jsont =
88
-
Json.Codec.Object.map ~kind:"UserOutgoingMessage"
90
+
Object.map ~kind:"UserOutgoingMessage"
89
91
(fun _role json_content ->
90
92
let content = decode_content json_content in
91
93
{ content; unknown = Unknown.empty })
92
-
|> Json.Codec.Object.mem "role" Json.Codec.string ~enc:(fun _ -> "user")
93
-
|> Json.Codec.Object.mem "content" Json.Codec.Value.t ~enc:(fun t ->
94
+
|> Object.mem "role" string ~enc:(fun _ -> "user")
95
+
|> Object.mem "content" Value.t ~enc:(fun t ->
94
96
encode_content (content t))
95
-
|> Json.Codec.Object.finish
97
+
|> Object.finish
96
98
in
97
-
Json.Codec.Object.map ~kind:"UserOutgoingEnvelope" Fun.id
98
-
|> Json.Codec.Object.mem "message" message_jsont ~enc:Fun.id
99
-
|> Json.Codec.Object.finish
99
+
Object.map ~kind:"UserOutgoingEnvelope" Fun.id
100
+
|> Object.mem "message" message_jsont ~enc:Fun.id
101
+
|> Object.finish
100
102
101
103
let to_json t =
102
104
match Json.encode json t with
···
114
116
| `Unknown ]
115
117
116
118
let error_jsont : error Json.codec =
117
-
Json.Codec.enum
119
+
enum
118
120
[
119
121
("authentication_failed", `Authentication_failed);
120
122
("billing_error", `Billing_error);
···
165
167
let combined_text t = String.concat "\n" (text_blocks t)
166
168
167
169
let json : t Json.codec =
168
-
Json.Codec.Object.map ~kind:"Assistant" make
169
-
|> Json.Codec.Object.mem "content"
170
-
(Json.Codec.list Content_block.json)
170
+
Object.map ~kind:"Assistant" make
171
+
|> Object.mem "content"
172
+
(list Content_block.json)
171
173
~enc:content
172
-
|> Json.Codec.Object.mem "model" Json.Codec.string ~enc:model
173
-
|> Json.Codec.Object.opt_mem "error" error_jsont ~enc:error
174
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
175
-
|> Json.Codec.Object.finish
174
+
|> Object.mem "model" string ~enc:model
175
+
|> Object.opt_mem "error" error_jsont ~enc:error
176
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
177
+
|> Object.finish
176
178
177
179
let incoming_jsont : t Json.codec =
178
-
Json.Codec.Object.map ~kind:"AssistantEnvelope" Fun.id
179
-
|> Json.Codec.Object.mem "message" json ~enc:Fun.id
180
-
|> Json.Codec.Object.finish
180
+
Object.map ~kind:"AssistantEnvelope" Fun.id
181
+
|> Object.mem "message" json ~enc:Fun.id
182
+
|> Object.finish
181
183
182
184
let to_json t =
183
185
match Json.encode json t with
···
214
216
let make session_id model cwd unknown : init =
215
217
{ session_id; model; cwd; unknown }
216
218
in
217
-
Json.Codec.Object.map ~kind:"SystemInit" make
218
-
|> Json.Codec.Object.opt_mem "session_id" Json.Codec.string
219
+
Object.map ~kind:"SystemInit" make
220
+
|> Object.opt_mem "session_id" string
219
221
~enc:(fun (r : init) -> r.session_id)
220
-
|> Json.Codec.Object.opt_mem "model" Json.Codec.string
222
+
|> Object.opt_mem "model" string
221
223
~enc:(fun (r : init) -> r.model)
222
-
|> Json.Codec.Object.opt_mem "cwd" Json.Codec.string ~enc:(fun (r : init) ->
224
+
|> Object.opt_mem "cwd" string ~enc:(fun (r : init) ->
223
225
r.cwd)
224
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : init) ->
226
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : init) ->
225
227
r.unknown)
226
-
|> Json.Codec.Object.finish
228
+
|> Object.finish
227
229
228
230
let error_jsont : error Json.codec =
229
231
let make err unknown : error = { error = err; unknown } in
230
-
Json.Codec.Object.map ~kind:"SystemError" make
231
-
|> Json.Codec.Object.mem "error" Json.Codec.string ~enc:(fun (r : error) ->
232
+
Object.map ~kind:"SystemError" make
233
+
|> Object.mem "error" string ~enc:(fun (r : error) ->
232
234
r.error)
233
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
235
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
234
236
r.unknown)
235
-
|> Json.Codec.Object.finish
237
+
|> Object.finish
236
238
237
239
let json : t Json.codec =
238
240
let case_init =
239
-
Json.Codec.Object.Case.map "init" init_jsont ~dec:(fun v -> Init v)
241
+
Object.Case.map "init" init_jsont ~dec:(fun v -> Init v)
240
242
in
241
243
let case_error =
242
-
Json.Codec.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
244
+
Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
243
245
in
244
246
let enc_case = function
245
-
| Init v -> Json.Codec.Object.Case.value case_init v
246
-
| Error v -> Json.Codec.Object.Case.value case_error v
247
+
| Init v -> Object.Case.value case_init v
248
+
| Error v -> Object.Case.value case_error v
247
249
in
248
-
let cases = Json.Codec.Object.Case.[ make case_init; make case_error ] in
249
-
Json.Codec.Object.map ~kind:"System" Fun.id
250
-
|> Json.Codec.Object.case_mem "subtype" Json.Codec.string ~enc:Fun.id
250
+
let cases = Object.Case.[ make case_init; make case_error ] in
251
+
Object.map ~kind:"System" Fun.id
252
+
|> Object.case_mem "subtype" string ~enc:Fun.id
251
253
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
252
-
|> Json.Codec.Object.finish
254
+
|> Object.finish
253
255
254
256
let to_json t =
255
257
match Json.encode json t with
···
298
300
let unknown t = t.unknown
299
301
300
302
let json : t Json.codec =
301
-
Json.Codec.Object.map ~kind:"Usage" make
302
-
|> Json.Codec.Object.opt_mem "input_tokens" Json.Codec.int
303
+
Object.map ~kind:"Usage" make
304
+
|> Object.opt_mem "input_tokens" int
303
305
~enc:input_tokens
304
-
|> Json.Codec.Object.opt_mem "output_tokens" Json.Codec.int
306
+
|> Object.opt_mem "output_tokens" int
305
307
~enc:output_tokens
306
-
|> Json.Codec.Object.opt_mem "total_tokens" Json.Codec.int
308
+
|> Object.opt_mem "total_tokens" int
307
309
~enc:total_tokens
308
-
|> Json.Codec.Object.opt_mem "cache_creation_input_tokens" Json.Codec.int
310
+
|> Object.opt_mem "cache_creation_input_tokens" int
309
311
~enc:cache_creation_input_tokens
310
-
|> Json.Codec.Object.opt_mem "cache_read_input_tokens" Json.Codec.int
312
+
|> Object.opt_mem "cache_read_input_tokens" int
311
313
~enc:cache_read_input_tokens
312
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
313
-
|> Json.Codec.Object.finish
314
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
315
+
|> Object.finish
314
316
end
315
317
316
318
type t = {
···
373
375
let unknown t = t.unknown
374
376
375
377
let json : t Json.codec =
376
-
Json.Codec.Object.map ~kind:"Result" make
377
-
|> Json.Codec.Object.mem "subtype" Json.Codec.string ~enc:subtype
378
-
|> Json.Codec.Object.mem "duration_ms" Json.Codec.int ~enc:duration_ms
379
-
|> Json.Codec.Object.mem "duration_api_ms" Json.Codec.int
378
+
Object.map ~kind:"Result" make
379
+
|> Object.mem "subtype" string ~enc:subtype
380
+
|> Object.mem "duration_ms" int ~enc:duration_ms
381
+
|> Object.mem "duration_api_ms" int
380
382
~enc:duration_api_ms
381
-
|> Json.Codec.Object.mem "is_error" Json.Codec.bool ~enc:is_error
382
-
|> Json.Codec.Object.mem "num_turns" Json.Codec.int ~enc:num_turns
383
-
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:session_id
384
-
|> Json.Codec.Object.opt_mem "total_cost_usd" Json.Codec.number
383
+
|> Object.mem "is_error" bool ~enc:is_error
384
+
|> Object.mem "num_turns" int ~enc:num_turns
385
+
|> Object.mem "session_id" string ~enc:session_id
386
+
|> Object.opt_mem "total_cost_usd" number
385
387
~enc:total_cost_usd
386
-
|> Json.Codec.Object.opt_mem "usage" Usage.json ~enc:usage
387
-
|> Json.Codec.Object.opt_mem "result" Json.Codec.string ~enc:result
388
-
|> Json.Codec.Object.opt_mem "structured_output" Json.Codec.Value.t
388
+
|> Object.opt_mem "usage" Usage.json ~enc:usage
389
+
|> Object.opt_mem "result" string ~enc:result
390
+
|> Object.opt_mem "structured_output" Value.t
389
391
~enc:structured_output
390
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
391
-
|> Json.Codec.Object.finish
392
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
393
+
|> Object.finish
392
394
393
395
let to_json t =
394
396
match Json.encode json t with
···
403
405
| Result of Result.t
404
406
405
407
let json : t Json.codec =
406
-
let case_map kind obj dec = Json.Codec.Object.Case.map kind obj ~dec in
408
+
let case_map kind obj dec = Object.Case.map kind obj ~dec in
407
409
let case_user = case_map "user" User.incoming_jsont (fun v -> User v) in
408
410
let case_assistant =
409
411
case_map "assistant" Assistant.incoming_jsont (fun v -> Assistant v)
···
411
413
let case_system = case_map "system" System.json (fun v -> System v) in
412
414
let case_result = case_map "result" Result.json (fun v -> Result v) in
413
415
let enc_case = function
414
-
| User v -> Json.Codec.Object.Case.value case_user v
415
-
| Assistant v -> Json.Codec.Object.Case.value case_assistant v
416
-
| System v -> Json.Codec.Object.Case.value case_system v
417
-
| Result v -> Json.Codec.Object.Case.value case_result v
416
+
| User v -> Object.Case.value case_user v
417
+
| Assistant v -> Object.Case.value case_assistant v
418
+
| System v -> Object.Case.value case_system v
419
+
| Result v -> Object.Case.value case_result v
418
420
in
419
421
let cases =
420
-
Json.Codec.Object.Case.
422
+
Object.Case.
421
423
[
422
424
make case_user; make case_assistant; make case_system; make case_result;
423
425
]
424
426
in
425
-
Json.Codec.Object.map ~kind:"Message" Fun.id
426
-
|> Json.Codec.Object.case_mem "type" Json.Codec.string ~enc:Fun.id ~enc_case
427
+
Object.map ~kind:"Message" Fun.id
428
+
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case
427
429
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
428
-
|> Json.Codec.Object.finish
430
+
|> Object.finish
429
431
430
432
let is_user = function User _ -> true | _ -> false
431
433
let is_assistant = function Assistant _ -> true | _ -> false
+46
-44
lib/permissions.ml
+46
-44
lib/permissions.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
+
open Json.Codec
7
+
6
8
let src = Logs.Src.create "claude.permission" ~doc:"Claude permission system"
7
9
8
10
module Log = (val Logs.src_log src : Logs.LOG)
···
25
27
raise (Invalid_argument (Fmt.str "Mode.of_string: unknown mode %s" s))
26
28
27
29
let json : t Json.codec =
28
-
Json.Codec.enum
30
+
enum
29
31
[
30
32
("default", Default);
31
33
("acceptEdits", Accept_edits);
···
49
51
(Fmt.str "Behavior.of_string: unknown behavior %s" s))
50
52
51
53
let json : t Json.codec =
52
-
Json.Codec.enum [ ("allow", Allow); ("deny", Deny); ("ask", Ask) ]
54
+
enum [ ("allow", Allow); ("deny", Deny); ("ask", Ask) ]
53
55
end
54
56
55
57
module Rule = struct
···
70
72
let make tool_name rule_content unknown =
71
73
{ tool_name; rule_content; unknown }
72
74
in
73
-
Json.Codec.Object.map ~kind:"Rule" make
74
-
|> Json.Codec.Object.mem "toolName" Json.Codec.string ~enc:tool_name
75
-
|> Json.Codec.Object.opt_mem "ruleContent" Json.Codec.string
75
+
Object.map ~kind:"Rule" make
76
+
|> Object.mem "toolName" string ~enc:tool_name
77
+
|> Object.opt_mem "ruleContent" string
76
78
~enc:rule_content
77
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
78
-
|> Json.Codec.Object.finish
79
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
80
+
|> Object.finish
79
81
end
80
82
81
83
module Update = struct
···
86
88
| Session
87
89
88
90
let destination_jsont : destination Json.codec =
89
-
Json.Codec.enum
91
+
enum
90
92
[
91
93
("userSettings", User_settings);
92
94
("projectSettings", Project_settings);
···
103
105
| Remove_directories
104
106
105
107
let update_type_jsont : update_type Json.codec =
106
-
Json.Codec.enum
108
+
enum
107
109
[
108
110
("addRules", Add_rules);
109
111
("replaceRules", Replace_rules);
···
139
141
let make update_type rules behavior mode directories destination unknown =
140
142
{ update_type; rules; behavior; mode; directories; destination; unknown }
141
143
in
142
-
Json.Codec.Object.map ~kind:"Update" make
143
-
|> Json.Codec.Object.mem "type" update_type_jsont ~enc:update_type
144
-
|> Json.Codec.Object.opt_mem "rules" (Json.Codec.list Rule.json) ~enc:rules
145
-
|> Json.Codec.Object.opt_mem "behavior" Behavior.json ~enc:behavior
146
-
|> Json.Codec.Object.opt_mem "mode" Mode.json ~enc:mode
147
-
|> Json.Codec.Object.opt_mem "directories"
148
-
(Json.Codec.list Json.Codec.string)
144
+
Object.map ~kind:"Update" make
145
+
|> Object.mem "type" update_type_jsont ~enc:update_type
146
+
|> Object.opt_mem "rules" (list Rule.json) ~enc:rules
147
+
|> Object.opt_mem "behavior" Behavior.json ~enc:behavior
148
+
|> Object.opt_mem "mode" Mode.json ~enc:mode
149
+
|> Object.opt_mem "directories"
150
+
(list string)
149
151
~enc:directories
150
-
|> Json.Codec.Object.opt_mem "destination" destination_jsont
152
+
|> Object.opt_mem "destination" destination_jsont
151
153
~enc:destination
152
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
153
-
|> Json.Codec.Object.finish
154
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
155
+
|> Object.finish
154
156
end
155
157
156
158
module Context = struct
···
164
166
165
167
let json : t Json.codec =
166
168
let make suggestions unknown = { suggestions; unknown } in
167
-
Json.Codec.Object.map ~kind:"Context" make
168
-
|> Json.Codec.Object.mem "suggestions"
169
-
(Json.Codec.list Update.json)
169
+
Object.map ~kind:"Context" make
170
+
|> Object.mem "suggestions"
171
+
(list Update.json)
170
172
~enc:suggestions ~dec_absent:[]
171
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
172
-
|> Json.Codec.Object.finish
173
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
174
+
|> Object.finish
173
175
end
174
176
175
177
module Result = struct
···
192
194
let make updated_input updated_permissions unknown =
193
195
Allow { updated_input; updated_permissions; unknown }
194
196
in
195
-
Json.Codec.Object.map ~kind:"AllowRecord" make
196
-
|> Json.Codec.Object.mem "updatedInput"
197
-
(Json.Codec.option Json.Codec.Value.t)
197
+
Object.map ~kind:"AllowRecord" make
198
+
|> Object.mem "updatedInput"
199
+
(option Value.t)
198
200
~enc:(function
199
201
| Allow { updated_input; _ } -> updated_input | _ -> None)
200
202
~dec_absent:None
201
-
|> Json.Codec.Object.opt_mem "updatedPermissions"
202
-
(Json.Codec.list Update.json) ~enc:(function
203
+
|> Object.opt_mem "updatedPermissions"
204
+
(list Update.json) ~enc:(function
203
205
| Allow { updated_permissions; _ } -> updated_permissions
204
206
| _ -> None)
205
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(function
207
+
|> Object.keep_unknown Unknown.mems ~enc:(function
206
208
| Allow { unknown; _ } -> unknown
207
209
| _ -> Unknown.empty)
208
-
|> Json.Codec.Object.finish
210
+
|> Object.finish
209
211
in
210
212
let deny_record =
211
213
let make message interrupt unknown =
212
214
Deny { message; interrupt; unknown }
213
215
in
214
-
Json.Codec.Object.map ~kind:"DenyRecord" make
215
-
|> Json.Codec.Object.mem "message" Json.Codec.string ~enc:(function
216
+
Object.map ~kind:"DenyRecord" make
217
+
|> Object.mem "message" string ~enc:(function
216
218
| Deny { message; _ } -> message
217
219
| _ -> "")
218
-
|> Json.Codec.Object.mem "interrupt" Json.Codec.bool ~enc:(function
220
+
|> Object.mem "interrupt" bool ~enc:(function
219
221
| Deny { interrupt; _ } -> interrupt
220
222
| _ -> false)
221
-
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(function
223
+
|> Object.keep_unknown Unknown.mems ~enc:(function
222
224
| Deny { unknown; _ } -> unknown
223
225
| _ -> Unknown.empty)
224
-
|> Json.Codec.Object.finish
226
+
|> Object.finish
225
227
in
226
228
let case_allow =
227
-
Json.Codec.Object.Case.map "allow" allow_record ~dec:(fun v -> v)
229
+
Object.Case.map "allow" allow_record ~dec:(fun v -> v)
228
230
in
229
231
let case_deny =
230
-
Json.Codec.Object.Case.map "deny" deny_record ~dec:(fun v -> v)
232
+
Object.Case.map "deny" deny_record ~dec:(fun v -> v)
231
233
in
232
234
let enc_case = function
233
-
| Allow _ as v -> Json.Codec.Object.Case.value case_allow v
234
-
| Deny _ as v -> Json.Codec.Object.Case.value case_deny v
235
+
| Allow _ as v -> Object.Case.value case_allow v
236
+
| Deny _ as v -> Object.Case.value case_deny v
235
237
in
236
-
let cases = Json.Codec.Object.Case.[ make case_allow; make case_deny ] in
237
-
Json.Codec.Object.map ~kind:"Result" Fun.id
238
-
|> Json.Codec.Object.case_mem "behavior" Json.Codec.string ~enc:Fun.id
238
+
let cases = Object.Case.[ make case_allow; make case_deny ] in
239
+
Object.map ~kind:"Result" Fun.id
240
+
|> Object.case_mem "behavior" string ~enc:Fun.id
239
241
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
240
-
|> Json.Codec.Object.finish
242
+
|> Object.finish
241
243
end
242
244
243
245
module Decision = struct