OCaml client library for Claude Code
claude: fix test fallout from Json.of_string's structured error
[Json.of_string] returns [(_, Json.Error.t) result]; [Alcotest.fail]
takes a [string], so pipe through [Json.Error.to_string] at the call
site. Also fix a stray typo in [test/dune] that put [loc] outside the
[(libraries ...)] list, and let [dune fmt] reflow the codec blocks in
[control] / [hooks] / [message] / [permissions] now that they sit
inside [let open Json.Codec in].
+158
-245
+72
-104
lib/control.ml
+72
-104
lib/control.ml
···
107
107
{ subtype = `Interrupt; unknown }
108
108
in
109
109
Object.map ~kind:"Interrupt" make
110
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : interrupt) ->
111
-
r.unknown)
110
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : interrupt) -> r.unknown)
112
111
|> Object.finish
113
112
114
113
let permission_jsont : permission Json.codec =
···
124
123
}
125
124
in
126
125
Object.map ~kind:"Permission" make
127
-
|> Object.mem "tool_name" string
128
-
~enc:(fun (r : permission) -> r.tool_name)
129
-
|> Object.mem "input" Value.t
130
-
~enc:(fun (r : permission) -> r.input)
131
-
|> Object.opt_mem "permission_suggestions"
132
-
(list Permissions.Update.json) ~enc:(fun (r : permission) ->
133
-
r.permission_suggestions)
134
-
|> Object.opt_mem "blocked_path" string
135
-
~enc:(fun (r : permission) -> r.blocked_path)
136
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : permission) ->
137
-
r.unknown)
126
+
|> Object.mem "tool_name" string ~enc:(fun (r : permission) -> r.tool_name)
127
+
|> Object.mem "input" Value.t ~enc:(fun (r : permission) -> r.input)
128
+
|> Object.opt_mem "permission_suggestions" (list Permissions.Update.json)
129
+
~enc:(fun (r : permission) -> r.permission_suggestions)
130
+
|> Object.opt_mem "blocked_path" string ~enc:(fun (r : permission) ->
131
+
r.blocked_path)
132
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : permission) -> r.unknown)
138
133
|> Object.finish
139
134
140
135
let initialize_jsont : initialize Json.codec =
···
151
146
{ subtype = `Initialize; hooks; unknown }
152
147
in
153
148
Object.map ~kind:"Initialize" make
154
-
|> Object.opt_mem "hooks" hooks_jsont
155
-
~enc:(fun (r : initialize) -> r.hooks)
156
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize) ->
157
-
r.unknown)
149
+
|> Object.opt_mem "hooks" hooks_jsont ~enc:(fun (r : initialize) -> r.hooks)
150
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize) -> r.unknown)
158
151
|> Object.finish
159
152
160
153
let set_permission_mode_jsont : set_permission_mode Json.codec =
···
164
157
Object.map ~kind:"SetPermissionMode" make
165
158
|> Object.mem "mode" Permissions.Mode.json
166
159
~enc:(fun (r : set_permission_mode) -> r.mode)
167
-
|> Object.keep_unknown Unknown.mems
168
-
~enc:(fun (r : set_permission_mode) -> r.unknown)
160
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : set_permission_mode) ->
161
+
r.unknown)
169
162
|> Object.finish
170
163
171
164
let hook_callback_jsont : hook_callback Json.codec =
···
174
167
{ subtype = `Hook_callback; callback_id; input; tool_use_id; unknown }
175
168
in
176
169
Object.map ~kind:"HookCallback" make
177
-
|> Object.mem "callback_id" string
178
-
~enc:(fun (r : hook_callback) -> r.callback_id)
179
-
|> Object.mem "input" Value.t
180
-
~enc:(fun (r : hook_callback) -> r.input)
181
-
|> Object.opt_mem "tool_use_id" string
182
-
~enc:(fun (r : hook_callback) -> r.tool_use_id)
183
-
|> Object.keep_unknown Unknown.mems
184
-
~enc:(fun (r : hook_callback) -> r.unknown)
170
+
|> Object.mem "callback_id" string ~enc:(fun (r : hook_callback) ->
171
+
r.callback_id)
172
+
|> Object.mem "input" Value.t ~enc:(fun (r : hook_callback) -> r.input)
173
+
|> Object.opt_mem "tool_use_id" string ~enc:(fun (r : hook_callback) ->
174
+
r.tool_use_id)
175
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : hook_callback) ->
176
+
r.unknown)
185
177
|> Object.finish
186
178
187
179
let mcp_message_jsont : mcp_message Json.codec =
···
189
181
{ subtype = `Mcp_message; server_name; message; unknown }
190
182
in
191
183
Object.map ~kind:"McpMessage" make
192
-
|> Object.mem "server_name" string
193
-
~enc:(fun (r : mcp_message) -> r.server_name)
194
-
|> Object.mem "message" Value.t
195
-
~enc:(fun (r : mcp_message) -> r.message)
196
-
|> Object.keep_unknown Unknown.mems
197
-
~enc:(fun (r : mcp_message) -> r.unknown)
184
+
|> Object.mem "server_name" string ~enc:(fun (r : mcp_message) ->
185
+
r.server_name)
186
+
|> Object.mem "message" Value.t ~enc:(fun (r : mcp_message) -> r.message)
187
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : mcp_message) ->
188
+
r.unknown)
198
189
|> Object.finish
199
190
200
191
let set_model_jsont : set_model Json.codec =
···
202
193
{ subtype = `Set_model; model; unknown }
203
194
in
204
195
Object.map ~kind:"SetModel" make
205
-
|> Object.mem "model" string
206
-
~enc:(fun (r : set_model) -> r.model)
207
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model) ->
208
-
r.unknown)
196
+
|> Object.mem "model" string ~enc:(fun (r : set_model) -> r.model)
197
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model) -> r.unknown)
209
198
|> Object.finish
210
199
211
200
let get_server_info_jsont : get_server_info Json.codec =
···
213
202
{ subtype = `Get_server_info; unknown }
214
203
in
215
204
Object.map ~kind:"GetServerInfo" make
216
-
|> Object.keep_unknown Unknown.mems
217
-
~enc:(fun (r : get_server_info) -> r.unknown)
205
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : get_server_info) ->
206
+
r.unknown)
218
207
|> Object.finish
219
208
220
209
(* Main variant codec using subtype discriminator *)
221
210
let json : t Json.codec =
222
211
let case_interrupt =
223
-
Object.Case.map "interrupt" interrupt_jsont ~dec:(fun v ->
224
-
Interrupt v)
212
+
Object.Case.map "interrupt" interrupt_jsont ~dec:(fun v -> Interrupt v)
225
213
in
226
214
let case_permission =
227
215
Object.Case.map "can_use_tool" permission_jsont ~dec:(fun v ->
228
216
Permission v)
229
217
in
230
218
let case_initialize =
231
-
Object.Case.map "initialize" initialize_jsont ~dec:(fun v ->
232
-
Initialize v)
219
+
Object.Case.map "initialize" initialize_jsont ~dec:(fun v -> Initialize v)
233
220
in
234
221
let case_set_permission_mode =
235
222
Object.Case.map "set_permission_mode" set_permission_mode_jsont
236
223
~dec:(fun v -> Set_permission_mode v)
237
224
in
238
225
let case_hook_callback =
239
-
Object.Case.map "hook_callback" hook_callback_jsont
240
-
~dec:(fun v -> Hook_callback v)
226
+
Object.Case.map "hook_callback" hook_callback_jsont ~dec:(fun v ->
227
+
Hook_callback v)
241
228
in
242
229
let case_mcp_message =
243
230
Object.Case.map "mcp_message" mcp_message_jsont ~dec:(fun v ->
244
231
Mcp_message v)
245
232
in
246
233
let case_set_model =
247
-
Object.Case.map "set_model" set_model_jsont ~dec:(fun v ->
248
-
Set_model v)
234
+
Object.Case.map "set_model" set_model_jsont ~dec:(fun v -> Set_model v)
249
235
in
250
236
let case_get_server_info =
251
-
Object.Case.map "get_server_info" get_server_info_jsont
252
-
~dec:(fun v -> Get_server_info v)
237
+
Object.Case.map "get_server_info" get_server_info_jsont ~dec:(fun v ->
238
+
Get_server_info v)
253
239
in
254
240
255
241
let enc_case = function
256
242
| Interrupt v -> Object.Case.value case_interrupt v
257
243
| Permission v -> Object.Case.value case_permission v
258
244
| Initialize v -> Object.Case.value case_initialize v
259
-
| Set_permission_mode v ->
260
-
Object.Case.value case_set_permission_mode v
245
+
| Set_permission_mode v -> Object.Case.value case_set_permission_mode v
261
246
| Hook_callback v -> Object.Case.value case_hook_callback v
262
247
| Mcp_message v -> Object.Case.value case_mcp_message v
263
248
| Set_model v -> Object.Case.value case_set_model v
···
279
264
in
280
265
281
266
Object.map ~kind:"Request" Fun.id
282
-
|> Object.case_mem "subtype" string ~enc:Fun.id
283
-
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
267
+
|> Object.case_mem "subtype" string ~enc:Fun.id ~enc_case cases
268
+
~tag_to_string:Fun.id ~tag_compare:String.compare
284
269
|> Object.finish
285
270
end
286
271
···
310
295
| -32603 -> `Internal_error
311
296
| n -> `Custom n
312
297
313
-
let json : t Json.codec =
314
-
map ~kind:"ErrorCode" ~dec:of_int ~enc:to_int int
298
+
let json : t Json.codec = map ~kind:"ErrorCode" ~dec:of_int ~enc:to_int int
315
299
end
316
300
317
301
type error_detail = { code : int; message : string; data : Json.t option }
···
323
307
let make code message data = { code; message; data } in
324
308
Object.map ~kind:"ErrorDetail" make
325
309
|> Object.mem "code" int ~enc:(fun e -> e.code)
326
-
|> Object.mem "message" string ~enc:(fun e ->
327
-
e.message)
328
-
|> Object.opt_mem "data" Value.t ~enc:(fun e ->
329
-
e.data)
310
+
|> Object.mem "message" string ~enc:(fun e -> e.message)
311
+
|> Object.opt_mem "data" Value.t ~enc:(fun e -> e.data)
330
312
|> Object.finish
331
313
332
314
type success = {
···
357
339
{ subtype = `Success; request_id; response; unknown }
358
340
in
359
341
Object.map ~kind:"Success" make
360
-
|> Object.mem "request_id" string
361
-
~enc:(fun (r : success) -> r.request_id)
362
-
|> Object.opt_mem "response" Value.t
363
-
~enc:(fun (r : success) -> r.response)
364
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : success) ->
365
-
r.unknown)
342
+
|> Object.mem "request_id" string ~enc:(fun (r : success) -> r.request_id)
343
+
|> Object.opt_mem "response" Value.t ~enc:(fun (r : success) -> r.response)
344
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : success) -> r.unknown)
366
345
|> Object.finish
367
346
368
347
let error_jsont : error Json.codec =
···
370
349
{ subtype = `Error; request_id; error; unknown }
371
350
in
372
351
Object.map ~kind:"Error" make
373
-
|> Object.mem "request_id" string
374
-
~enc:(fun (r : error) -> r.request_id)
375
-
|> Object.mem "error" error_detail_jsont ~enc:(fun (r : error) ->
376
-
r.error)
377
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
378
-
r.unknown)
352
+
|> Object.mem "request_id" string ~enc:(fun (r : error) -> r.request_id)
353
+
|> Object.mem "error" error_detail_jsont ~enc:(fun (r : error) -> r.error)
354
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : error) -> r.unknown)
379
355
|> Object.finish
380
356
381
357
(* Main variant codec using subtype discriminator *)
382
358
let json : t Json.codec =
383
359
let case_success =
384
-
Object.Case.map "success" success_jsont ~dec:(fun v ->
385
-
Success v)
360
+
Object.Case.map "success" success_jsont ~dec:(fun v -> Success v)
386
361
in
387
362
let case_error =
388
363
Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
···
396
371
let cases = Object.Case.[ make case_success; make case_error ] in
397
372
398
373
Object.map ~kind:"Response" Fun.id
399
-
|> Object.case_mem "subtype" string ~enc:Fun.id
400
-
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
374
+
|> Object.case_mem "subtype" string ~enc:Fun.id ~enc_case cases
375
+
~tag_to_string:Fun.id ~tag_compare:String.compare
401
376
|> Object.finish
402
377
end
403
378
···
428
403
{ type_ = `Control_request; request_id; request; unknown }
429
404
in
430
405
Object.map ~kind:"ControlRequest" make
431
-
|> Object.mem "request_id" string
432
-
~enc:(fun (r : control_request) -> r.request_id)
433
-
|> Object.mem "request" Request.json
434
-
~enc:(fun (r : control_request) -> r.request)
435
-
|> Object.keep_unknown Unknown.mems
436
-
~enc:(fun (r : control_request) -> r.unknown)
406
+
|> Object.mem "request_id" string ~enc:(fun (r : control_request) ->
407
+
r.request_id)
408
+
|> Object.mem "request" Request.json ~enc:(fun (r : control_request) ->
409
+
r.request)
410
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : control_request) ->
411
+
r.unknown)
437
412
|> Object.finish
438
413
439
414
let control_response_jsont : control_response Json.codec =
···
441
416
{ type_ = `Control_response; response; unknown }
442
417
in
443
418
Object.map ~kind:"ControlResponse" make
444
-
|> Object.mem "response" Response.json
445
-
~enc:(fun (r : control_response) -> r.response)
446
-
|> Object.keep_unknown Unknown.mems
447
-
~enc:(fun (r : control_response) -> r.unknown)
419
+
|> Object.mem "response" Response.json ~enc:(fun (r : control_response) ->
420
+
r.response)
421
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : control_response) ->
422
+
r.unknown)
448
423
|> Object.finish
449
424
450
425
(* Main variant codec using type discriminator *)
451
426
let json : t Json.codec =
452
427
let case_request =
453
-
Object.Case.map "control_request" control_request_jsont
454
-
~dec:(fun v -> Request v)
428
+
Object.Case.map "control_request" control_request_jsont ~dec:(fun v ->
429
+
Request v)
455
430
in
456
431
let case_response =
457
-
Object.Case.map "control_response" control_response_jsont
458
-
~dec:(fun v -> Response v)
432
+
Object.Case.map "control_response" control_response_jsont ~dec:(fun v ->
433
+
Response v)
459
434
in
460
435
461
436
let enc_case = function
···
463
438
| Response v -> Object.Case.value case_response v
464
439
in
465
440
466
-
let cases =
467
-
Object.Case.[ make case_request; make case_response ]
468
-
in
441
+
let cases = Object.Case.[ make case_request; make case_response ] in
469
442
470
443
Object.map ~kind:"Control" Fun.id
471
-
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case
472
-
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
444
+
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case cases
445
+
~tag_to_string:Fun.id ~tag_compare:String.compare
473
446
|> Object.finish
474
447
475
448
let pp ppf t = Json.pp_value json () ppf t
···
508
481
{ version; capabilities; commands; output_styles; unknown }
509
482
in
510
483
Object.map ~kind:"ServerInfo" make
511
-
|> Object.mem "version" string ~enc:(fun (r : t) ->
512
-
r.version)
513
-
|> Object.mem "capabilities"
514
-
(list string)
484
+
|> Object.mem "version" string ~enc:(fun (r : t) -> r.version)
485
+
|> Object.mem "capabilities" (list string)
515
486
~enc:(fun (r : t) -> r.capabilities)
516
487
~dec_absent:[]
517
-
|> Object.mem "commands"
518
-
(list string)
488
+
|> Object.mem "commands" (list string)
519
489
~enc:(fun (r : t) -> r.commands)
520
490
~dec_absent:[]
521
-
|> Object.mem "outputStyles"
522
-
(list string)
491
+
|> Object.mem "outputStyles" (list string)
523
492
~enc:(fun (r : t) -> r.output_styles)
524
493
~dec_absent:[]
525
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : t) ->
526
-
r.unknown)
494
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : t) -> r.unknown)
527
495
|> Object.finish
528
496
end
+34
-58
lib/hooks.ml
+34
-58
lib/hooks.ml
···
74
74
}
75
75
in
76
76
Object.map ~kind:"PreToolUseInput" make
77
-
|> Object.mem "session_id" string ~enc:(fun i ->
78
-
i.session_id)
79
-
|> Object.mem "transcript_path" string ~enc:(fun i ->
80
-
i.transcript_path)
81
-
|> Object.mem "tool_name" string ~enc:(fun i ->
82
-
i.tool_name)
77
+
|> Object.mem "session_id" string ~enc:(fun i -> i.session_id)
78
+
|> Object.mem "transcript_path" string ~enc:(fun i -> i.transcript_path)
79
+
|> Object.mem "tool_name" string ~enc:(fun i -> i.tool_name)
83
80
|> Object.mem "tool_input" Value.t ~enc:(fun i ->
84
81
Tool_input.to_json i.tool_input)
85
82
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
···
112
109
}
113
110
in
114
111
Object.map ~kind:"PreToolUseOutput" make
115
-
|> Object.mem "hookEventName" string ~enc:(fun _ ->
116
-
"PreToolUse")
117
-
|> Object.opt_mem "permissionDecision" decision_jsont
118
-
~enc:(fun o -> o.decision)
119
-
|> Object.opt_mem "permissionDecisionReason" string
120
-
~enc:(fun o -> o.reason)
121
-
|> Object.opt_mem "updatedInput" Value.t
122
-
~enc:(fun o -> Option.map Tool_input.to_json o.updated_input)
112
+
|> Object.mem "hookEventName" string ~enc:(fun _ -> "PreToolUse")
113
+
|> Object.opt_mem "permissionDecision" decision_jsont ~enc:(fun o ->
114
+
o.decision)
115
+
|> Object.opt_mem "permissionDecisionReason" string ~enc:(fun o -> o.reason)
116
+
|> Object.opt_mem "updatedInput" Value.t ~enc:(fun o ->
117
+
Option.map Tool_input.to_json o.updated_input)
123
118
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
124
119
|> Object.finish
125
120
···
149
144
}
150
145
in
151
146
Object.map ~kind:"PostToolUseInput" make
152
-
|> Object.mem "session_id" string ~enc:(fun i ->
153
-
i.session_id)
154
-
|> Object.mem "transcript_path" string ~enc:(fun i ->
155
-
i.transcript_path)
156
-
|> Object.mem "tool_name" string ~enc:(fun i ->
157
-
i.tool_name)
147
+
|> Object.mem "session_id" string ~enc:(fun i -> i.session_id)
148
+
|> Object.mem "transcript_path" string ~enc:(fun i -> i.transcript_path)
149
+
|> Object.mem "tool_name" string ~enc:(fun i -> i.tool_name)
158
150
|> Object.mem "tool_input" Value.t ~enc:(fun i ->
159
151
Tool_input.to_json i.tool_input)
160
-
|> Object.mem "tool_response" Value.t ~enc:(fun i ->
161
-
i.tool_response)
152
+
|> Object.mem "tool_response" Value.t ~enc:(fun i -> i.tool_response)
162
153
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
163
154
|> Object.finish
164
155
···
183
174
}
184
175
in
185
176
Object.map ~kind:"PostToolUseOutput" make
186
-
|> Object.mem "hookEventName" string ~enc:(fun _ ->
187
-
"PostToolUse")
177
+
|> Object.mem "hookEventName" string ~enc:(fun _ -> "PostToolUse")
188
178
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
189
179
if o.block then Some Block else None)
190
-
|> Object.opt_mem "reason" string ~enc:(fun o ->
191
-
o.reason)
192
-
|> Object.opt_mem "additionalContext" string
193
-
~enc:(fun o -> o.additional_context)
180
+
|> Object.opt_mem "reason" string ~enc:(fun o -> o.reason)
181
+
|> Object.opt_mem "additionalContext" string ~enc:(fun o ->
182
+
o.additional_context)
194
183
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
195
184
|> Object.finish
196
185
···
211
200
{ session_id; transcript_path; prompt }
212
201
in
213
202
Object.map ~kind:"UserPromptSubmitInput" make
214
-
|> Object.mem "session_id" string ~enc:(fun i ->
215
-
i.session_id)
216
-
|> Object.mem "transcript_path" string ~enc:(fun i ->
217
-
i.transcript_path)
203
+
|> Object.mem "session_id" string ~enc:(fun i -> i.session_id)
204
+
|> Object.mem "transcript_path" string ~enc:(fun i -> i.transcript_path)
218
205
|> Object.mem "prompt" string ~enc:(fun i -> i.prompt)
219
206
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
220
207
|> Object.finish
···
239
226
}
240
227
in
241
228
Object.map ~kind:"UserPromptSubmitOutput" make
242
-
|> Object.mem "hookEventName" string ~enc:(fun _ ->
243
-
"UserPromptSubmit")
229
+
|> Object.mem "hookEventName" string ~enc:(fun _ -> "UserPromptSubmit")
244
230
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
245
231
if o.block then Some Block else None)
246
-
|> Object.opt_mem "reason" string ~enc:(fun o ->
247
-
o.reason)
248
-
|> Object.opt_mem "additionalContext" string
249
-
~enc:(fun o -> o.additional_context)
232
+
|> Object.opt_mem "reason" string ~enc:(fun o -> o.reason)
233
+
|> Object.opt_mem "additionalContext" string ~enc:(fun o ->
234
+
o.additional_context)
250
235
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
251
236
|> Object.finish
252
237
···
267
252
{ session_id; transcript_path; stop_hook_active }
268
253
in
269
254
Object.map ~kind:"StopInput" make
270
-
|> Object.mem "session_id" string ~enc:(fun i ->
271
-
i.session_id)
272
-
|> Object.mem "transcript_path" string ~enc:(fun i ->
273
-
i.transcript_path)
274
-
|> Object.mem "stop_hook_active" bool ~enc:(fun i ->
275
-
i.stop_hook_active)
255
+
|> Object.mem "session_id" string ~enc:(fun i -> i.session_id)
256
+
|> Object.mem "transcript_path" string ~enc:(fun i -> i.transcript_path)
257
+
|> Object.mem "stop_hook_active" bool ~enc:(fun i -> i.stop_hook_active)
276
258
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
277
259
|> Object.finish
278
260
···
289
271
}
290
272
in
291
273
Object.map ~kind:(event_name ^ "Output") make
292
-
|> Object.mem "hookEventName" string ~enc:(fun _ ->
293
-
event_name)
274
+
|> Object.mem "hookEventName" string ~enc:(fun _ -> event_name)
294
275
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
295
276
if o.block then Some Block else None)
296
-
|> Object.opt_mem "reason" string ~enc:(fun o ->
297
-
o.reason)
277
+
|> Object.opt_mem "reason" string ~enc:(fun o -> o.reason)
298
278
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
299
279
|> Object.finish
300
280
···
327
307
{ session_id; transcript_path }
328
308
in
329
309
Object.map ~kind:"PreCompactInput" make
330
-
|> Object.mem "session_id" string ~enc:(fun i ->
331
-
i.session_id)
332
-
|> Object.mem "transcript_path" string ~enc:(fun i ->
333
-
i.transcript_path)
310
+
|> Object.mem "session_id" string ~enc:(fun i -> i.session_id)
311
+
|> Object.mem "transcript_path" string ~enc:(fun i -> i.transcript_path)
334
312
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
335
313
|> Object.finish
336
314
···
350
328
{ decision; system_message; hook_specific_output }
351
329
in
352
330
Object.map ~kind:"Result" make
353
-
|> Object.opt_mem "decision" decision_jsont ~enc:(fun r ->
354
-
r.decision)
355
-
|> Object.opt_mem "systemMessage" string ~enc:(fun r ->
356
-
r.system_message)
357
-
|> Object.opt_mem "hookSpecificOutput" Value.t
358
-
~enc:(fun r -> r.hook_specific_output)
331
+
|> Object.opt_mem "decision" decision_jsont ~enc:(fun r -> r.decision)
332
+
|> Object.opt_mem "systemMessage" string ~enc:(fun r -> r.system_message)
333
+
|> Object.opt_mem "hookSpecificOutput" Value.t ~enc:(fun r ->
334
+
r.hook_specific_output)
359
335
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
360
336
|> Object.finish
361
337
+22
-42
lib/message.ml
+22
-42
lib/message.ml
···
67
67
Object.map ~kind:"User" (fun json_content unknown ->
68
68
let content = decode_content json_content in
69
69
make content unknown)
70
-
|> Object.mem "content" Value.t ~enc:(fun t ->
71
-
encode_content (content t))
70
+
|> Object.mem "content" Value.t ~enc:(fun t -> encode_content (content t))
72
71
|> Object.keep_unknown Unknown.mems ~enc:unknown
73
72
|> Object.finish
74
73
···
77
76
Object.map ~kind:"UserMessage" (fun json_content ->
78
77
let content = decode_content json_content in
79
78
{ content; unknown = Unknown.empty })
80
-
|> Object.mem "content" Value.t ~enc:(fun t ->
81
-
encode_content (content t))
79
+
|> Object.mem "content" Value.t ~enc:(fun t -> encode_content (content t))
82
80
|> Object.finish
83
81
in
84
82
Object.map ~kind:"UserEnvelope" Fun.id
···
87
85
88
86
let outgoing_jsont : t Json.codec =
89
87
let message_jsont =
90
-
Object.map ~kind:"UserOutgoingMessage"
91
-
(fun _role json_content ->
88
+
Object.map ~kind:"UserOutgoingMessage" (fun _role json_content ->
92
89
let content = decode_content json_content in
93
90
{ content; unknown = Unknown.empty })
94
91
|> Object.mem "role" string ~enc:(fun _ -> "user")
95
-
|> Object.mem "content" Value.t ~enc:(fun t ->
96
-
encode_content (content t))
92
+
|> Object.mem "content" Value.t ~enc:(fun t -> encode_content (content t))
97
93
|> Object.finish
98
94
in
99
95
Object.map ~kind:"UserOutgoingEnvelope" Fun.id
···
168
164
169
165
let json : t Json.codec =
170
166
Object.map ~kind:"Assistant" make
171
-
|> Object.mem "content"
172
-
(list Content_block.json)
173
-
~enc:content
167
+
|> Object.mem "content" (list Content_block.json) ~enc:content
174
168
|> Object.mem "model" string ~enc:model
175
169
|> Object.opt_mem "error" error_jsont ~enc:error
176
170
|> Object.keep_unknown Unknown.mems ~enc:unknown
···
217
211
{ session_id; model; cwd; unknown }
218
212
in
219
213
Object.map ~kind:"SystemInit" make
220
-
|> Object.opt_mem "session_id" string
221
-
~enc:(fun (r : init) -> r.session_id)
222
-
|> Object.opt_mem "model" string
223
-
~enc:(fun (r : init) -> r.model)
224
-
|> Object.opt_mem "cwd" string ~enc:(fun (r : init) ->
225
-
r.cwd)
226
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : init) ->
227
-
r.unknown)
214
+
|> Object.opt_mem "session_id" string ~enc:(fun (r : init) -> r.session_id)
215
+
|> Object.opt_mem "model" string ~enc:(fun (r : init) -> r.model)
216
+
|> Object.opt_mem "cwd" string ~enc:(fun (r : init) -> r.cwd)
217
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : init) -> r.unknown)
228
218
|> Object.finish
229
219
230
220
let error_jsont : error Json.codec =
231
221
let make err unknown : error = { error = err; unknown } in
232
222
Object.map ~kind:"SystemError" make
233
-
|> Object.mem "error" string ~enc:(fun (r : error) ->
234
-
r.error)
235
-
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
236
-
r.unknown)
223
+
|> Object.mem "error" string ~enc:(fun (r : error) -> r.error)
224
+
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : error) -> r.unknown)
237
225
|> Object.finish
238
226
239
227
let json : t Json.codec =
240
-
let case_init =
241
-
Object.Case.map "init" init_jsont ~dec:(fun v -> Init v)
242
-
in
228
+
let case_init = Object.Case.map "init" init_jsont ~dec:(fun v -> Init v) in
243
229
let case_error =
244
230
Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
245
231
in
···
249
235
in
250
236
let cases = Object.Case.[ make case_init; make case_error ] in
251
237
Object.map ~kind:"System" Fun.id
252
-
|> Object.case_mem "subtype" string ~enc:Fun.id
253
-
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
238
+
|> Object.case_mem "subtype" string ~enc:Fun.id ~enc_case cases
239
+
~tag_to_string:Fun.id ~tag_compare:String.compare
254
240
|> Object.finish
255
241
256
242
let to_json t =
···
301
287
302
288
let json : t Json.codec =
303
289
Object.map ~kind:"Usage" make
304
-
|> Object.opt_mem "input_tokens" int
305
-
~enc:input_tokens
306
-
|> Object.opt_mem "output_tokens" int
307
-
~enc:output_tokens
308
-
|> Object.opt_mem "total_tokens" int
309
-
~enc:total_tokens
290
+
|> Object.opt_mem "input_tokens" int ~enc:input_tokens
291
+
|> Object.opt_mem "output_tokens" int ~enc:output_tokens
292
+
|> Object.opt_mem "total_tokens" int ~enc:total_tokens
310
293
|> Object.opt_mem "cache_creation_input_tokens" int
311
294
~enc:cache_creation_input_tokens
312
295
|> Object.opt_mem "cache_read_input_tokens" int
···
378
361
Object.map ~kind:"Result" make
379
362
|> Object.mem "subtype" string ~enc:subtype
380
363
|> Object.mem "duration_ms" int ~enc:duration_ms
381
-
|> Object.mem "duration_api_ms" int
382
-
~enc:duration_api_ms
364
+
|> Object.mem "duration_api_ms" int ~enc:duration_api_ms
383
365
|> Object.mem "is_error" bool ~enc:is_error
384
366
|> Object.mem "num_turns" int ~enc:num_turns
385
367
|> Object.mem "session_id" string ~enc:session_id
386
-
|> Object.opt_mem "total_cost_usd" number
387
-
~enc:total_cost_usd
368
+
|> Object.opt_mem "total_cost_usd" number ~enc:total_cost_usd
388
369
|> Object.opt_mem "usage" Usage.json ~enc:usage
389
370
|> Object.opt_mem "result" string ~enc:result
390
-
|> Object.opt_mem "structured_output" Value.t
391
-
~enc:structured_output
371
+
|> Object.opt_mem "structured_output" Value.t ~enc:structured_output
392
372
|> Object.keep_unknown Unknown.mems ~enc:unknown
393
373
|> Object.finish
394
374
···
425
405
]
426
406
in
427
407
Object.map ~kind:"Message" Fun.id
428
-
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case
429
-
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
408
+
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case cases
409
+
~tag_to_string:Fun.id ~tag_compare:String.compare
430
410
|> Object.finish
431
411
432
412
let is_user = function User _ -> true | _ -> false
+13
-24
lib/permissions.ml
+13
-24
lib/permissions.ml
···
74
74
in
75
75
Object.map ~kind:"Rule" make
76
76
|> Object.mem "toolName" string ~enc:tool_name
77
-
|> Object.opt_mem "ruleContent" string
78
-
~enc:rule_content
77
+
|> Object.opt_mem "ruleContent" string ~enc:rule_content
79
78
|> Object.keep_unknown Unknown.mems ~enc:unknown
80
79
|> Object.finish
81
80
end
···
146
145
|> Object.opt_mem "rules" (list Rule.json) ~enc:rules
147
146
|> Object.opt_mem "behavior" Behavior.json ~enc:behavior
148
147
|> Object.opt_mem "mode" Mode.json ~enc:mode
149
-
|> Object.opt_mem "directories"
150
-
(list string)
151
-
~enc:directories
152
-
|> Object.opt_mem "destination" destination_jsont
153
-
~enc:destination
148
+
|> Object.opt_mem "directories" (list string) ~enc:directories
149
+
|> Object.opt_mem "destination" destination_jsont ~enc:destination
154
150
|> Object.keep_unknown Unknown.mems ~enc:unknown
155
151
|> Object.finish
156
152
end
···
167
163
let json : t Json.codec =
168
164
let make suggestions unknown = { suggestions; unknown } in
169
165
Object.map ~kind:"Context" make
170
-
|> Object.mem "suggestions"
171
-
(list Update.json)
172
-
~enc:suggestions ~dec_absent:[]
166
+
|> Object.mem "suggestions" (list Update.json) ~enc:suggestions
167
+
~dec_absent:[]
173
168
|> Object.keep_unknown Unknown.mems ~enc:unknown
174
169
|> Object.finish
175
170
end
···
195
190
Allow { updated_input; updated_permissions; unknown }
196
191
in
197
192
Object.map ~kind:"AllowRecord" make
198
-
|> Object.mem "updatedInput"
199
-
(option Value.t)
193
+
|> Object.mem "updatedInput" (option Value.t)
200
194
~enc:(function
201
195
| Allow { updated_input; _ } -> updated_input | _ -> None)
202
196
~dec_absent:None
203
-
|> Object.opt_mem "updatedPermissions"
204
-
(list Update.json) ~enc:(function
205
-
| Allow { updated_permissions; _ } -> updated_permissions
206
-
| _ -> None)
197
+
|> Object.opt_mem "updatedPermissions" (list Update.json) ~enc:(function
198
+
| Allow { updated_permissions; _ } -> updated_permissions
199
+
| _ -> None)
207
200
|> Object.keep_unknown Unknown.mems ~enc:(function
208
201
| Allow { unknown; _ } -> unknown
209
202
| _ -> Unknown.empty)
···
225
218
| _ -> Unknown.empty)
226
219
|> Object.finish
227
220
in
228
-
let case_allow =
229
-
Object.Case.map "allow" allow_record ~dec:(fun v -> v)
230
-
in
231
-
let case_deny =
232
-
Object.Case.map "deny" deny_record ~dec:(fun v -> v)
233
-
in
221
+
let case_allow = Object.Case.map "allow" allow_record ~dec:(fun v -> v) in
222
+
let case_deny = Object.Case.map "deny" deny_record ~dec:(fun v -> v) in
234
223
let enc_case = function
235
224
| Allow _ as v -> Object.Case.value case_allow v
236
225
| Deny _ as v -> Object.Case.value case_deny v
237
226
in
238
227
let cases = Object.Case.[ make case_allow; make case_deny ] in
239
228
Object.map ~kind:"Result" Fun.id
240
-
|> Object.case_mem "behavior" string ~enc:Fun.id
241
-
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
229
+
|> Object.case_mem "behavior" string ~enc:Fun.id ~enc_case cases
230
+
~tag_to_string:Fun.id ~tag_compare:String.compare
242
231
|> Object.finish
243
232
end
244
233
+1
-1
test/dune
+1
-1
test/dune
+1
-1
test/test_content_block.ml
+1
-1
test/test_content_block.ml
···
67
67
match Json.decode CB.json json with
68
68
| Ok back -> back
69
69
| Error e -> Alcotest.fail (Json.Error.to_string e))
70
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
70
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
71
71
72
72
let test_jsont_roundtrip_text () =
73
73
let block = CB.text "roundtrip test" in
+12
-12
test/test_control.ml
+12
-12
test/test_control.ml
···
94
94
| Ok (C.Request.Interrupt _) -> ()
95
95
| Ok _ -> Alcotest.fail "Wrong variant"
96
96
| Error e -> Alcotest.fail (Json.Error.to_string e))
97
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
97
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
98
98
99
99
let test_request_jsont_permission () =
100
100
let input = Json.object' [ Json.mem (Json.name "cmd") (Json.string "ls") ] in
···
106
106
Alcotest.(check string) "tool_name" "Bash" p.tool_name
107
107
| Ok _ -> Alcotest.fail "Wrong variant"
108
108
| Error e -> Alcotest.fail (Json.Error.to_string e))
109
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
109
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
110
110
111
111
let test_request_jsont_set_model () =
112
112
let req = C.Request.set_model ~model:"claude-haiku-4" () in
···
117
117
Alcotest.(check string) "model" "claude-haiku-4" sm.model
118
118
| Ok _ -> Alcotest.fail "Wrong variant"
119
119
| Error e -> Alcotest.fail (Json.Error.to_string e))
120
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
120
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
121
121
122
122
let test_request_jsont_get_server_info () =
123
123
let req = C.Request.get_server_info () in
···
127
127
| Ok (C.Request.Get_server_info _) -> ()
128
128
| Ok _ -> Alcotest.fail "Wrong variant"
129
129
| Error e -> Alcotest.fail (Json.Error.to_string e))
130
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
130
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
131
131
132
132
let test_request_jsont_hook_callback () =
133
133
let input = Json.object' [] in
···
139
139
Alcotest.(check string) "callback_id" "cb-1" hc.callback_id
140
140
| Ok _ -> Alcotest.fail "Wrong variant"
141
141
| Error e -> Alcotest.fail (Json.Error.to_string e))
142
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
142
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
143
143
144
144
let test_request_jsont_mcp_message () =
145
145
let message = Json.object' [] in
···
151
151
Alcotest.(check string) "server_name" "tools" mm.server_name
152
152
| Ok _ -> Alcotest.fail "Wrong variant"
153
153
| Error e -> Alcotest.fail (Json.Error.to_string e))
154
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
154
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
155
155
156
156
let test_response_jsont_success () =
157
157
let resp = C.Response.success ~request_id:"r1" () in
···
162
162
Alcotest.(check string) "request_id" "r1" s.request_id
163
163
| Ok _ -> Alcotest.fail "Wrong variant"
164
164
| Error e -> Alcotest.fail (Json.Error.to_string e))
165
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
165
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
166
166
167
167
let test_response_success_data () =
168
168
let data = Json.string "result_data" in
···
174
174
Alcotest.(check bool) "has response" true (Option.is_some s.response)
175
175
| Ok _ -> Alcotest.fail "Wrong variant"
176
176
| Error e -> Alcotest.fail (Json.Error.to_string e))
177
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
177
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
178
178
179
179
let test_response_jsont_error () =
180
180
let detail =
···
190
190
Alcotest.(check string) "message" "oops" e.error.message
191
191
| Ok _ -> Alcotest.fail "Wrong variant"
192
192
| Error e -> Alcotest.fail (Json.Error.to_string e))
193
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
193
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
194
194
195
195
let test_server_info () =
196
196
let info =
···
215
215
| Ok back ->
216
216
Alcotest.(check string) "version" "1.0.0" (C.Server_info.version back)
217
217
| Error e -> Alcotest.fail (Json.Error.to_string e))
218
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
218
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
219
219
220
220
let test_request_envelope () =
221
221
let req = C.Request.interrupt () in
···
247
247
match Json.decode C.control_request_jsont json with
248
248
| Ok back -> Alcotest.(check string) "request_id" "env-1" back.request_id
249
249
| Error e -> Alcotest.fail (Json.Error.to_string e))
250
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
250
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
251
251
252
252
let test_response_envelope_jsont () =
253
253
let resp = C.Response.success ~request_id:"x" () in
···
266
266
| C.Response.Success _ -> ()
267
267
| _ -> Alcotest.fail "Wrong variant")
268
268
| Error e -> Alcotest.fail (Json.Error.to_string e))
269
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
269
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
270
270
271
271
let suite =
272
272
( "control",
+2
-2
test/test_outgoing.ml
+2
-2
test/test_outgoing.ml
···
47
47
| Ok (O.Message (M.User _)) -> ()
48
48
| Ok _ -> Alcotest.fail "Wrong variant after decode"
49
49
| Error e -> Alcotest.fail (Json.Error.to_string e))
50
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
50
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
51
51
52
52
let test_jsont_roundtrip_control_response () =
53
53
let resp = C.Response.success ~request_id:"r2" () in
···
59
59
| Ok (O.Control_response _) -> ()
60
60
| Ok _ -> Alcotest.fail "Wrong variant after decode"
61
61
| Error e -> Alcotest.fail (Json.Error.to_string e))
62
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
62
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
63
63
64
64
let test_pp_does_not_crash () =
65
65
let user = M.User.of_string "pp test" in
+1
-1
test/test_structured_output.ml
+1
-1
test/test_structured_output.ml
···
49
49
| Json.Object _ -> ()
50
50
| _ -> Alcotest.fail "Expected object after decode")
51
51
| Error e -> Alcotest.fail (Json.Error.to_string e))
52
-
| Error e -> Alcotest.fail (Json.Error.to_string e)
52
+
| Error e -> Alcotest.fail (Loc.Error.to_string e)
53
53
54
54
let test_simple_string_schema () =
55
55
let schema = J.object' [ J.mem (J.name "type") (J.string "string") ] in