OCaml Claude SDK using Eio and Jsont
json: rename mem -> member / finish -> seal across the codec + value API
Object combinators: [Object.mem] -> [Object.member], [Object.opt_mem]
-> [Object.opt_member], [Object.case_mem] -> [Object.case_member]. The
sibling submodules [Object.Mem] / [Object.Mems] become
[Object.Member] / [Object.Members]. RFC 8259 §4 calls these
"name/value pairs, referred to as the members", so mirror the spec
name rather than the shortened [mem].
[Object.finish] -> [Object.seal]. "Seal" reads as "close the map, no
more members added", which is what the operation does.
Value constructors/queries: [Value.mem] (function) -> [Value.member];
[Value.mem_find] -> [Value.member_key]; [Value.mem_names] ->
[Value.member_names]; [Value.mem_keys] -> [Value.member_keys].
[type mem = ...] -> [type member = ...]; [type object'] still points
at [member list].
Downstream (~80 files across slack, sbom, stripe, sigstore, requests,
claude, irmin, freebox) updated via perl-pie. dune build clean,
dune test ocaml-json clean.
+542
-444
+1
-1
claude.opam
+1
-1
claude.opam
+2
-2
dune-project
+2
-2
dune-project
+2
-2
examples/json_utils.ml
+2
-2
examples/json_utils.ml
···
11
11
let field_codec =
12
12
let open Json.Codec in
13
13
Object.map ~kind:"field" (fun v -> v)
14
-
|> Object.opt_mem key codec ~enc:Fun.id
15
-
|> Object.finish
14
+
|> Object.opt_member key codec ~enc:Fun.id
15
+
|> Object.seal
16
16
in
17
17
match Json.decode field_codec json with Ok v -> v | Error _ -> None
18
18
+10
-3
examples/simulated_permissions.ml
+10
-3
examples/simulated_permissions.ml
···
107
107
List.iter
108
108
(fun tool_name ->
109
109
let input =
110
-
Json.object'
111
-
[ Json.mem (Json.name "file_path") (Json.string "/example/path.txt") ]
110
+
Json.Value.object'
111
+
[
112
+
Json.Value.member
113
+
(Json.Value.name "file_path")
114
+
(Json.Value.string "/example/path.txt");
115
+
]
112
116
in
113
117
let tool_input = Claude.Tool_input.of_json input in
114
118
let ctx =
···
141
145
let callback = Claude.Permissions.discovery discovered in
142
146
143
147
(* Simulate some tool requests *)
144
-
let obj k v = Json.object' [ Json.mem (Json.name k) (Json.string v) ] in
148
+
let obj k v =
149
+
Json.Value.object'
150
+
[ Json.Value.member (Json.Value.name k) (Json.Value.string v) ]
151
+
in
145
152
let requests =
146
153
[
147
154
("Read", obj "file_path" "test.ml");
+6
-4
examples/structured_error_demo.ml
+6
-4
examples/structured_error_demo.ml
···
139
139
Claude.Control.Response.error_detail ~code:`Invalid_params
140
140
~message:"Invalid params for permission request"
141
141
~data:
142
-
(Json.object'
142
+
(Json.Value.object'
143
143
[
144
-
Json.mem (Json.name "tool_name") (Json.string "Write");
145
-
Json.mem (Json.name "reason")
146
-
(Json.string "Missing required file_path parameter");
144
+
Json.Value.member
145
+
(Json.Value.name "tool_name")
146
+
(Json.Value.string "Write");
147
+
Json.Value.member (Json.Value.name "reason")
148
+
(Json.Value.string "Missing required file_path parameter");
147
149
])
148
150
()
149
151
in
+51
-34
examples/structured_output_demo.ml
+51
-34
examples/structured_output_demo.ml
···
14
14
Logs.Src.set_level C.Message.src (Some Logs.Debug)
15
15
16
16
let typed_prop typ desc =
17
-
Json.object'
17
+
Json.Value.object'
18
18
[
19
-
Json.mem (Json.name "type") (Json.string typ);
20
-
Json.mem (Json.name "description") (Json.string desc);
19
+
Json.Value.member (Json.Value.name "type") (Json.Value.string typ);
20
+
Json.Value.member (Json.Value.name "description") (Json.Value.string desc);
21
21
]
22
22
23
23
let complexity_rating_prop =
24
-
Json.object'
24
+
Json.Value.object'
25
25
[
26
-
Json.mem (Json.name "type") (Json.string "string");
27
-
Json.mem (Json.name "enum")
28
-
(Json.list
29
-
[ Json.string "low"; Json.string "medium"; Json.string "high" ]);
30
-
Json.mem (Json.name "description")
31
-
(Json.string "Overall complexity rating");
26
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "string");
27
+
Json.Value.member (Json.Value.name "enum")
28
+
(Json.Value.list
29
+
[
30
+
Json.Value.string "low";
31
+
Json.Value.string "medium";
32
+
Json.Value.string "high";
33
+
]);
34
+
Json.Value.member
35
+
(Json.Value.name "description")
36
+
(Json.Value.string "Overall complexity rating");
32
37
]
33
38
34
39
let key_findings_prop =
35
-
Json.object'
40
+
Json.Value.object'
36
41
[
37
-
Json.mem (Json.name "type") (Json.string "array");
38
-
Json.mem (Json.name "items")
39
-
(Json.object' [ Json.mem (Json.name "type") (Json.string "string") ]);
40
-
Json.mem (Json.name "description")
41
-
(Json.string "List of key findings from the analysis");
42
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "array");
43
+
Json.Value.member (Json.Value.name "items")
44
+
(Json.Value.object'
45
+
[
46
+
Json.Value.member (Json.Value.name "type")
47
+
(Json.Value.string "string");
48
+
]);
49
+
Json.Value.member
50
+
(Json.Value.name "description")
51
+
(Json.Value.string "List of key findings from the analysis");
42
52
]
43
53
44
54
let analysis_properties =
45
-
Json.object'
55
+
Json.Value.object'
46
56
[
47
-
Json.mem (Json.name "file_count")
57
+
Json.Value.member
58
+
(Json.Value.name "file_count")
48
59
(typed_prop "integer" "Total number of files analyzed");
49
-
Json.mem (Json.name "has_tests")
60
+
Json.Value.member
61
+
(Json.Value.name "has_tests")
50
62
(typed_prop "boolean" "Whether the codebase has test files");
51
-
Json.mem
52
-
(Json.name "primary_language")
63
+
Json.Value.member
64
+
(Json.Value.name "primary_language")
53
65
(typed_prop "string" "The primary programming language used");
54
-
Json.mem (Json.name "complexity_rating") complexity_rating_prop;
55
-
Json.mem (Json.name "key_findings") key_findings_prop;
66
+
Json.Value.member
67
+
(Json.Value.name "complexity_rating")
68
+
complexity_rating_prop;
69
+
Json.Value.member (Json.Value.name "key_findings") key_findings_prop;
56
70
]
57
71
58
72
let analysis_schema =
59
-
Json.object'
73
+
Json.Value.object'
60
74
[
61
-
Json.mem (Json.name "type") (Json.string "object");
62
-
Json.mem (Json.name "properties") analysis_properties;
63
-
Json.mem (Json.name "required")
64
-
(Json.list
75
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "object");
76
+
Json.Value.member (Json.Value.name "properties") analysis_properties;
77
+
Json.Value.member
78
+
(Json.Value.name "required")
79
+
(Json.Value.list
65
80
[
66
-
Json.string "file_count";
67
-
Json.string "has_tests";
68
-
Json.string "primary_language";
69
-
Json.string "complexity_rating";
70
-
Json.string "key_findings";
81
+
Json.Value.string "file_count";
82
+
Json.Value.string "has_tests";
83
+
Json.Value.string "primary_language";
84
+
Json.Value.string "complexity_rating";
85
+
Json.Value.string "key_findings";
71
86
]);
72
-
Json.mem (Json.name "additionalProperties") (Json.bool false);
87
+
Json.Value.member
88
+
(Json.Value.name "additionalProperties")
89
+
(Json.Value.bool false);
73
90
]
74
91
75
92
let display_parsed_analysis output =
+20
-11
examples/structured_output_simple.ml
+20
-11
examples/structured_output_simple.ml
···
12
12
Logs.set_level (Some Logs.Info)
13
13
14
14
let person_schema =
15
-
let typ t = Json.object' [ Json.mem (Json.name "type") (Json.string t) ] in
16
-
Json.object'
15
+
let typ t =
16
+
Json.Value.object'
17
+
[ Json.Value.member (Json.Value.name "type") (Json.Value.string t) ]
18
+
in
19
+
Json.Value.object'
17
20
[
18
-
Json.mem (Json.name "type") (Json.string "object");
19
-
Json.mem (Json.name "properties")
20
-
(Json.object'
21
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "object");
22
+
Json.Value.member
23
+
(Json.Value.name "properties")
24
+
(Json.Value.object'
25
+
[
26
+
Json.Value.member (Json.Value.name "name") (typ "string");
27
+
Json.Value.member (Json.Value.name "age") (typ "integer");
28
+
Json.Value.member (Json.Value.name "occupation") (typ "string");
29
+
]);
30
+
Json.Value.member
31
+
(Json.Value.name "required")
32
+
(Json.Value.list
21
33
[
22
-
Json.mem (Json.name "name") (typ "string");
23
-
Json.mem (Json.name "age") (typ "integer");
24
-
Json.mem (Json.name "occupation") (typ "string");
34
+
Json.Value.string "name";
35
+
Json.Value.string "age";
36
+
Json.Value.string "occupation";
25
37
]);
26
-
Json.mem (Json.name "required")
27
-
(Json.list
28
-
[ Json.string "name"; Json.string "age"; Json.string "occupation" ]);
29
38
]
30
39
31
40
let simple_example env =
+14
-14
lib/client.ml
+14
-14
lib/client.ml
···
34
34
let open Json.Codec in
35
35
let make matcher hook_callback_ids = { matcher; hook_callback_ids } in
36
36
Object.map ~kind:"HookMatcherWire" make
37
-
|> Object.opt_mem "matcher" string ~enc:(fun r -> r.matcher)
38
-
|> Object.mem "hookCallbackIds" (list string) ~enc:(fun r ->
37
+
|> Object.opt_member "matcher" string ~enc:(fun r -> r.matcher)
38
+
|> Object.member "hookCallbackIds" (list string) ~enc:(fun r ->
39
39
r.hook_callback_ids)
40
-
|> Object.finish
40
+
|> Object.seal
41
41
42
42
let encode matchers =
43
43
List.map
···
46
46
|> Result.map_error Json.Error.to_string
47
47
|> Error.ok ~msg:"Hook_matcher_wire.encode: ")
48
48
matchers
49
-
|> Json.list
49
+
|> Json.Value.list
50
50
end
51
51
52
52
type t = {
···
148
148
~message:error_msg ())
149
149
150
150
let handle_mcp_message t ~request_id (req : Control.Request.mcp_message) =
151
-
let module J = Json in
151
+
let module J = Json.Value in
152
152
let server_name = req.server_name in
153
153
let message = req.message in
154
154
Log.info (fun m -> m "MCP request for server '%s'" server_name);
···
161
161
let mcp_error =
162
162
J.object'
163
163
[
164
-
J.mem (J.name "jsonrpc") (J.string "2.0");
165
-
J.mem (J.name "id") (J.null ());
166
-
J.mem (J.name "error")
164
+
J.member (J.name "jsonrpc") (J.string "2.0");
165
+
J.member (J.name "id") (J.null ());
166
+
J.member (J.name "error")
167
167
(J.object'
168
168
[
169
-
J.mem (J.name "code") (J.number (-32601.0));
170
-
J.mem (J.name "message") (J.string error_msg);
169
+
J.member (J.name "code") (J.number (-32601.0));
170
+
J.member (J.name "message") (J.string error_msg);
171
171
]);
172
172
]
173
173
in
174
174
let response_data =
175
-
J.object' [ J.mem (J.name "mcp_response") mcp_error ]
175
+
J.object' [ J.member (J.name "mcp_response") mcp_error ]
176
176
in
177
177
let response =
178
178
Control_response.success ~request_id ~response:(Some response_data)
···
182
182
let mcp_response = Mcp_server.handle_json_message server message in
183
183
Log.debug (fun m -> m "MCP response: %s" (json_to_string mcp_response));
184
184
let response_data =
185
-
J.object' [ J.mem (J.name "mcp_response") mcp_response ]
185
+
J.object' [ J.member (J.name "mcp_response") mcp_response ]
186
186
in
187
187
let response =
188
188
Control_response.success ~request_id ~response:(Some response_data)
···
462
462
let response_field_codec =
463
463
let open Json.Codec in
464
464
Object.map ~kind:"ResponseField" Fun.id
465
-
|> Object.mem "response" Value.t ~enc:Fun.id
466
-
|> Object.finish
465
+
|> Object.member "response" Value.t ~enc:Fun.id
466
+
|> Object.seal
467
467
in
468
468
let response_data =
469
469
decode_or_raise ~msg:"Failed to extract response field: "
+2
-2
lib/client.mli
+2
-2
lib/client.mli
···
108
108
{[
109
109
Client.respond_to_tools client
110
110
[
111
-
("tool_use_123", Json.string "Success", None);
112
-
("tool_use_456", Json.string "Error occurred", Some true);
111
+
("tool_use_123", Json.Value.string "Success", None);
112
+
("tool_use_456", Json.Value.string "Error occurred", Some true);
113
113
]
114
114
]} *)
115
115
+15
-15
lib/content_block.ml
+15
-15
lib/content_block.ml
···
18
18
let json : t Json.codec =
19
19
let open Json.Codec in
20
20
Object.map ~kind:"Text" make
21
-
|> Object.mem "text" string ~enc:text
21
+
|> Object.member "text" string ~enc:text
22
22
|> Object.keep_unknown Unknown.mems ~enc:unknown
23
-
|> Object.finish
23
+
|> Object.seal
24
24
end
25
25
26
26
module Tool_use = struct
···
36
36
let json : t Json.codec =
37
37
let open Json.Codec in
38
38
Object.map ~kind:"Tool_use" make
39
-
|> Object.mem "id" string ~enc:id
40
-
|> Object.mem "name" string ~enc:name
41
-
|> Object.mem "input" Value.t ~enc:(fun t -> t.input)
39
+
|> Object.member "id" string ~enc:id
40
+
|> Object.member "name" string ~enc:name
41
+
|> Object.member "input" Value.t ~enc:(fun t -> t.input)
42
42
|> Object.keep_unknown Unknown.mems ~enc:unknown
43
-
|> Object.finish
43
+
|> Object.seal
44
44
end
45
45
46
46
module Tool_result = struct
···
65
65
let json : t Json.codec =
66
66
let open Json.Codec in
67
67
Object.map ~kind:"Tool_result" make
68
-
|> Object.mem "tool_use_id" string ~enc:tool_use_id
69
-
|> Object.opt_mem "content" Value.t ~enc:content
70
-
|> Object.opt_mem "is_error" bool ~enc:is_error
68
+
|> Object.member "tool_use_id" string ~enc:tool_use_id
69
+
|> Object.opt_member "content" Value.t ~enc:content
70
+
|> Object.opt_member "is_error" bool ~enc:is_error
71
71
|> Object.keep_unknown Unknown.mems ~enc:unknown
72
-
|> Object.finish
72
+
|> Object.seal
73
73
end
74
74
75
75
module Thinking = struct
···
86
86
let json : t Json.codec =
87
87
let open Json.Codec in
88
88
Object.map ~kind:"Thinking" make
89
-
|> Object.mem "thinking" string ~enc:thinking
90
-
|> Object.mem "signature" string ~enc:signature
89
+
|> Object.member "thinking" string ~enc:thinking
90
+
|> Object.member "signature" string ~enc:signature
91
91
|> Object.keep_unknown Unknown.mems ~enc:unknown
92
-
|> Object.finish
92
+
|> Object.seal
93
93
end
94
94
95
95
type t =
···
134
134
]
135
135
in
136
136
Object.map ~kind:"Content_block" Fun.id
137
-
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case cases
137
+
|> Object.case_member "type" string ~enc:Fun.id ~enc_case cases
138
138
~tag_to_string:Fun.id ~tag_compare:String.compare
139
-
|> Object.finish
139
+
|> Object.seal
140
140
141
141
let pp ppf t = Json.pp_value json () ppf t
142
142
let log_received t = Log.debug (fun m -> m "Received content block: %a" pp t)
+51
-46
lib/control.ml
+51
-46
lib/control.ml
···
108
108
in
109
109
Object.map ~kind:"Interrupt" make
110
110
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : interrupt) -> r.unknown)
111
-
|> Object.finish
111
+
|> Object.seal
112
112
113
113
let permission_jsont : permission Json.codec =
114
114
let make tool_name input permission_suggestions blocked_path
···
123
123
}
124
124
in
125
125
Object.map ~kind:"Permission" make
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)
126
+
|> Object.member "tool_name" string ~enc:(fun (r : permission) ->
127
+
r.tool_name)
128
+
|> Object.member "input" Value.t ~enc:(fun (r : permission) -> r.input)
129
+
|> Object.opt_member "permission_suggestions" (list Permissions.Update.json)
129
130
~enc:(fun (r : permission) -> r.permission_suggestions)
130
-
|> Object.opt_mem "blocked_path" string ~enc:(fun (r : permission) ->
131
+
|> Object.opt_member "blocked_path" string ~enc:(fun (r : permission) ->
131
132
r.blocked_path)
132
133
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : permission) -> r.unknown)
133
-
|> Object.finish
134
+
|> Object.seal
134
135
135
136
let initialize_jsont : initialize Json.codec =
136
137
(* The hooks field is an object with string keys and json values *)
···
146
147
{ subtype = `Initialize; hooks; unknown }
147
148
in
148
149
Object.map ~kind:"Initialize" make
149
-
|> Object.opt_mem "hooks" hooks_jsont ~enc:(fun (r : initialize) -> r.hooks)
150
+
|> Object.opt_member "hooks" hooks_jsont ~enc:(fun (r : initialize) ->
151
+
r.hooks)
150
152
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize) -> r.unknown)
151
-
|> Object.finish
153
+
|> Object.seal
152
154
153
155
let set_permission_mode_jsont : set_permission_mode Json.codec =
154
156
let make mode (unknown : Unknown.t) : set_permission_mode =
155
157
{ subtype = `Set_permission_mode; mode; unknown }
156
158
in
157
159
Object.map ~kind:"SetPermissionMode" make
158
-
|> Object.mem "mode" Permissions.Mode.json
160
+
|> Object.member "mode" Permissions.Mode.json
159
161
~enc:(fun (r : set_permission_mode) -> r.mode)
160
162
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : set_permission_mode) ->
161
163
r.unknown)
162
-
|> Object.finish
164
+
|> Object.seal
163
165
164
166
let hook_callback_jsont : hook_callback Json.codec =
165
167
let make callback_id input tool_use_id (unknown : Unknown.t) : hook_callback
···
167
169
{ subtype = `Hook_callback; callback_id; input; tool_use_id; unknown }
168
170
in
169
171
Object.map ~kind:"HookCallback" make
170
-
|> Object.mem "callback_id" string ~enc:(fun (r : hook_callback) ->
172
+
|> Object.member "callback_id" string ~enc:(fun (r : hook_callback) ->
171
173
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
+
|> Object.member "input" Value.t ~enc:(fun (r : hook_callback) -> r.input)
175
+
|> Object.opt_member "tool_use_id" string ~enc:(fun (r : hook_callback) ->
174
176
r.tool_use_id)
175
177
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : hook_callback) ->
176
178
r.unknown)
177
-
|> Object.finish
179
+
|> Object.seal
178
180
179
181
let mcp_message_jsont : mcp_message Json.codec =
180
182
let make server_name message (unknown : Unknown.t) : mcp_message =
181
183
{ subtype = `Mcp_message; server_name; message; unknown }
182
184
in
183
185
Object.map ~kind:"McpMessage" make
184
-
|> Object.mem "server_name" string ~enc:(fun (r : mcp_message) ->
186
+
|> Object.member "server_name" string ~enc:(fun (r : mcp_message) ->
185
187
r.server_name)
186
-
|> Object.mem "message" Value.t ~enc:(fun (r : mcp_message) -> r.message)
188
+
|> Object.member "message" Value.t ~enc:(fun (r : mcp_message) -> r.message)
187
189
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : mcp_message) ->
188
190
r.unknown)
189
-
|> Object.finish
191
+
|> Object.seal
190
192
191
193
let set_model_jsont : set_model Json.codec =
192
194
let make model (unknown : Unknown.t) : set_model =
193
195
{ subtype = `Set_model; model; unknown }
194
196
in
195
197
Object.map ~kind:"SetModel" make
196
-
|> Object.mem "model" string ~enc:(fun (r : set_model) -> r.model)
198
+
|> Object.member "model" string ~enc:(fun (r : set_model) -> r.model)
197
199
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model) -> r.unknown)
198
-
|> Object.finish
200
+
|> Object.seal
199
201
200
202
let get_server_info_jsont : get_server_info Json.codec =
201
203
let make (unknown : Unknown.t) : get_server_info =
···
204
206
Object.map ~kind:"GetServerInfo" make
205
207
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : get_server_info) ->
206
208
r.unknown)
207
-
|> Object.finish
209
+
|> Object.seal
208
210
209
211
(* Main variant codec using subtype discriminator *)
210
212
let json : t Json.codec =
···
264
266
in
265
267
266
268
Object.map ~kind:"Request" Fun.id
267
-
|> Object.case_mem "subtype" string ~enc:Fun.id ~enc_case cases
269
+
|> Object.case_member "subtype" string ~enc:Fun.id ~enc_case cases
268
270
~tag_to_string:Fun.id ~tag_compare:String.compare
269
-
|> Object.finish
271
+
|> Object.seal
270
272
end
271
273
272
274
module Response = struct
···
306
308
let error_detail_jsont : error_detail Json.codec =
307
309
let make code message data = { code; message; data } in
308
310
Object.map ~kind:"ErrorDetail" make
309
-
|> Object.mem "code" int ~enc:(fun e -> e.code)
310
-
|> Object.mem "message" string ~enc:(fun e -> e.message)
311
-
|> Object.opt_mem "data" Value.t ~enc:(fun e -> e.data)
312
-
|> Object.finish
311
+
|> Object.member "code" int ~enc:(fun e -> e.code)
312
+
|> Object.member "message" string ~enc:(fun e -> e.message)
313
+
|> Object.opt_member "data" Value.t ~enc:(fun e -> e.data)
314
+
|> Object.seal
313
315
314
316
type success = {
315
317
subtype : [ `Success ];
···
339
341
{ subtype = `Success; request_id; response; unknown }
340
342
in
341
343
Object.map ~kind:"Success" make
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.member "request_id" string ~enc:(fun (r : success) ->
345
+
r.request_id)
346
+
|> Object.opt_member "response" Value.t ~enc:(fun (r : success) ->
347
+
r.response)
344
348
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : success) -> r.unknown)
345
-
|> Object.finish
349
+
|> Object.seal
346
350
347
351
let error_jsont : error Json.codec =
348
352
let make request_id error (unknown : Unknown.t) : error =
349
353
{ subtype = `Error; request_id; error; unknown }
350
354
in
351
355
Object.map ~kind:"Error" make
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)
356
+
|> Object.member "request_id" string ~enc:(fun (r : error) -> r.request_id)
357
+
|> Object.member "error" error_detail_jsont ~enc:(fun (r : error) ->
358
+
r.error)
354
359
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : error) -> r.unknown)
355
-
|> Object.finish
360
+
|> Object.seal
356
361
357
362
(* Main variant codec using subtype discriminator *)
358
363
let json : t Json.codec =
···
371
376
let cases = Object.Case.[ make case_success; make case_error ] in
372
377
373
378
Object.map ~kind:"Response" Fun.id
374
-
|> Object.case_mem "subtype" string ~enc:Fun.id ~enc_case cases
379
+
|> Object.case_member "subtype" string ~enc:Fun.id ~enc_case cases
375
380
~tag_to_string:Fun.id ~tag_compare:String.compare
376
-
|> Object.finish
381
+
|> Object.seal
377
382
end
378
383
379
384
type control_request = {
···
403
408
{ type_ = `Control_request; request_id; request; unknown }
404
409
in
405
410
Object.map ~kind:"ControlRequest" make
406
-
|> Object.mem "request_id" string ~enc:(fun (r : control_request) ->
411
+
|> Object.member "request_id" string ~enc:(fun (r : control_request) ->
407
412
r.request_id)
408
-
|> Object.mem "request" Request.json ~enc:(fun (r : control_request) ->
413
+
|> Object.member "request" Request.json ~enc:(fun (r : control_request) ->
409
414
r.request)
410
415
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : control_request) ->
411
416
r.unknown)
412
-
|> Object.finish
417
+
|> Object.seal
413
418
414
419
let control_response_jsont : control_response Json.codec =
415
420
let make response (unknown : Unknown.t) : control_response =
416
421
{ type_ = `Control_response; response; unknown }
417
422
in
418
423
Object.map ~kind:"ControlResponse" make
419
-
|> Object.mem "response" Response.json ~enc:(fun (r : control_response) ->
424
+
|> Object.member "response" Response.json ~enc:(fun (r : control_response) ->
420
425
r.response)
421
426
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : control_response) ->
422
427
r.unknown)
423
-
|> Object.finish
428
+
|> Object.seal
424
429
425
430
(* Main variant codec using type discriminator *)
426
431
let json : t Json.codec =
···
441
446
let cases = Object.Case.[ make case_request; make case_response ] in
442
447
443
448
Object.map ~kind:"Control" Fun.id
444
-
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case cases
449
+
|> Object.case_member "type" string ~enc:Fun.id ~enc_case cases
445
450
~tag_to_string:Fun.id ~tag_compare:String.compare
446
-
|> Object.finish
451
+
|> Object.seal
447
452
448
453
let pp ppf t = Json.pp_value json () ppf t
449
454
···
481
486
{ version; capabilities; commands; output_styles; unknown }
482
487
in
483
488
Object.map ~kind:"ServerInfo" make
484
-
|> Object.mem "version" string ~enc:(fun (r : t) -> r.version)
485
-
|> Object.mem "capabilities" (list string)
489
+
|> Object.member "version" string ~enc:(fun (r : t) -> r.version)
490
+
|> Object.member "capabilities" (list string)
486
491
~enc:(fun (r : t) -> r.capabilities)
487
492
~dec_absent:[]
488
-
|> Object.mem "commands" (list string)
493
+
|> Object.member "commands" (list string)
489
494
~enc:(fun (r : t) -> r.commands)
490
495
~dec_absent:[]
491
-
|> Object.mem "outputStyles" (list string)
496
+
|> Object.member "outputStyles" (list string)
492
497
~enc:(fun (r : t) -> r.output_styles)
493
498
~dec_absent:[]
494
499
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : t) -> r.unknown)
495
-
|> Object.finish
500
+
|> Object.seal
496
501
end
+46
-45
lib/hooks.ml
+46
-45
lib/hooks.ml
···
74
74
}
75
75
in
76
76
Object.map ~kind:"PreToolUseInput" make
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)
80
-
|> Object.mem "tool_input" Value.t ~enc:(fun i ->
77
+
|> Object.member "session_id" string ~enc:(fun i -> i.session_id)
78
+
|> Object.member "transcript_path" string ~enc:(fun i -> i.transcript_path)
79
+
|> Object.member "tool_name" string ~enc:(fun i -> i.tool_name)
80
+
|> Object.member "tool_input" Value.t ~enc:(fun i ->
81
81
Tool_input.to_json i.tool_input)
82
82
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
83
-
|> Object.finish
83
+
|> Object.seal
84
84
85
85
type decision = Allow | Deny | Ask
86
86
···
109
109
}
110
110
in
111
111
Object.map ~kind:"PreToolUseOutput" make
112
-
|> Object.mem "hookEventName" string ~enc:(fun _ -> "PreToolUse")
113
-
|> Object.opt_mem "permissionDecision" decision_jsont ~enc:(fun o ->
112
+
|> Object.member "hookEventName" string ~enc:(fun _ -> "PreToolUse")
113
+
|> Object.opt_member "permissionDecision" decision_jsont ~enc:(fun o ->
114
114
o.decision)
115
-
|> Object.opt_mem "permissionDecisionReason" string ~enc:(fun o -> o.reason)
116
-
|> Object.opt_mem "updatedInput" Value.t ~enc:(fun o ->
115
+
|> Object.opt_member "permissionDecisionReason" string ~enc:(fun o ->
116
+
o.reason)
117
+
|> Object.opt_member "updatedInput" Value.t ~enc:(fun o ->
117
118
Option.map Tool_input.to_json o.updated_input)
118
119
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
119
-
|> Object.finish
120
+
|> Object.seal
120
121
121
122
type callback = input -> output
122
123
end
···
144
145
}
145
146
in
146
147
Object.map ~kind:"PostToolUseInput" make
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)
150
-
|> Object.mem "tool_input" Value.t ~enc:(fun i ->
148
+
|> Object.member "session_id" string ~enc:(fun i -> i.session_id)
149
+
|> Object.member "transcript_path" string ~enc:(fun i -> i.transcript_path)
150
+
|> Object.member "tool_name" string ~enc:(fun i -> i.tool_name)
151
+
|> Object.member "tool_input" Value.t ~enc:(fun i ->
151
152
Tool_input.to_json i.tool_input)
152
-
|> Object.mem "tool_response" Value.t ~enc:(fun i -> i.tool_response)
153
+
|> Object.member "tool_response" Value.t ~enc:(fun i -> i.tool_response)
153
154
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
154
-
|> Object.finish
155
+
|> Object.seal
155
156
156
157
type output = {
157
158
block : bool;
···
174
175
}
175
176
in
176
177
Object.map ~kind:"PostToolUseOutput" make
177
-
|> Object.mem "hookEventName" string ~enc:(fun _ -> "PostToolUse")
178
-
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
178
+
|> Object.member "hookEventName" string ~enc:(fun _ -> "PostToolUse")
179
+
|> Object.opt_member "decision" decision_jsont ~enc:(fun o ->
179
180
if o.block then Some Block else None)
180
-
|> Object.opt_mem "reason" string ~enc:(fun o -> o.reason)
181
-
|> Object.opt_mem "additionalContext" string ~enc:(fun o ->
181
+
|> Object.opt_member "reason" string ~enc:(fun o -> o.reason)
182
+
|> Object.opt_member "additionalContext" string ~enc:(fun o ->
182
183
o.additional_context)
183
184
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
184
-
|> Object.finish
185
+
|> Object.seal
185
186
186
187
type callback = input -> output
187
188
end
···
200
201
{ session_id; transcript_path; prompt }
201
202
in
202
203
Object.map ~kind:"UserPromptSubmitInput" make
203
-
|> Object.mem "session_id" string ~enc:(fun i -> i.session_id)
204
-
|> Object.mem "transcript_path" string ~enc:(fun i -> i.transcript_path)
205
-
|> Object.mem "prompt" string ~enc:(fun i -> i.prompt)
204
+
|> Object.member "session_id" string ~enc:(fun i -> i.session_id)
205
+
|> Object.member "transcript_path" string ~enc:(fun i -> i.transcript_path)
206
+
|> Object.member "prompt" string ~enc:(fun i -> i.prompt)
206
207
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
207
-
|> Object.finish
208
+
|> Object.seal
208
209
209
210
type output = {
210
211
block : bool;
···
226
227
}
227
228
in
228
229
Object.map ~kind:"UserPromptSubmitOutput" make
229
-
|> Object.mem "hookEventName" string ~enc:(fun _ -> "UserPromptSubmit")
230
-
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
230
+
|> Object.member "hookEventName" string ~enc:(fun _ -> "UserPromptSubmit")
231
+
|> Object.opt_member "decision" decision_jsont ~enc:(fun o ->
231
232
if o.block then Some Block else None)
232
-
|> Object.opt_mem "reason" string ~enc:(fun o -> o.reason)
233
-
|> Object.opt_mem "additionalContext" string ~enc:(fun o ->
233
+
|> Object.opt_member "reason" string ~enc:(fun o -> o.reason)
234
+
|> Object.opt_member "additionalContext" string ~enc:(fun o ->
234
235
o.additional_context)
235
236
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
236
-
|> Object.finish
237
+
|> Object.seal
237
238
238
239
type callback = input -> output
239
240
end
···
252
253
{ session_id; transcript_path; stop_hook_active }
253
254
in
254
255
Object.map ~kind:"StopInput" make
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)
256
+
|> Object.member "session_id" string ~enc:(fun i -> i.session_id)
257
+
|> Object.member "transcript_path" string ~enc:(fun i -> i.transcript_path)
258
+
|> Object.member "stop_hook_active" bool ~enc:(fun i -> i.stop_hook_active)
258
259
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
259
-
|> Object.finish
260
+
|> Object.seal
260
261
261
262
type output = { block : bool; reason : string option }
262
263
···
271
272
}
272
273
in
273
274
Object.map ~kind:(event_name ^ "Output") make
274
-
|> Object.mem "hookEventName" string ~enc:(fun _ -> event_name)
275
-
|> Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
275
+
|> Object.member "hookEventName" string ~enc:(fun _ -> event_name)
276
+
|> Object.opt_member "decision" decision_jsont ~enc:(fun o ->
276
277
if o.block then Some Block else None)
277
-
|> Object.opt_mem "reason" string ~enc:(fun o -> o.reason)
278
+
|> Object.opt_member "reason" string ~enc:(fun o -> o.reason)
278
279
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
279
-
|> Object.finish
280
+
|> Object.seal
280
281
281
282
let output_jsont = output_jsont_with_event_name "Stop"
282
283
···
307
308
{ session_id; transcript_path }
308
309
in
309
310
Object.map ~kind:"PreCompactInput" make
310
-
|> Object.mem "session_id" string ~enc:(fun i -> i.session_id)
311
-
|> Object.mem "transcript_path" string ~enc:(fun i -> i.transcript_path)
311
+
|> Object.member "session_id" string ~enc:(fun i -> i.session_id)
312
+
|> Object.member "transcript_path" string ~enc:(fun i -> i.transcript_path)
312
313
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
313
-
|> Object.finish
314
+
|> Object.seal
314
315
315
316
type callback = input -> unit
316
317
end
···
328
329
{ decision; system_message; hook_specific_output }
329
330
in
330
331
Object.map ~kind:"Result" make
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 ->
332
+
|> Object.opt_member "decision" decision_jsont ~enc:(fun r -> r.decision)
333
+
|> Object.opt_member "systemMessage" string ~enc:(fun r -> r.system_message)
334
+
|> Object.opt_member "hookSpecificOutput" Value.t ~enc:(fun r ->
334
335
r.hook_specific_output)
335
336
|> Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
336
-
|> Object.finish
337
+
|> Object.seal
337
338
338
339
let continue_result ?system_message ?hook_specific_output () =
339
340
{ decision = None; system_message; hook_specific_output }
+3
-3
lib/incoming.ml
+3
-3
lib/incoming.ml
···
53
53
(* rate_limit_event: CLI sends these periodically with usage info.
54
54
We decode the type field and discard the rest. *)
55
55
let rate_limit_jsont =
56
-
Object.map ~kind:"RateLimit" () |> Object.skip_unknown |> Object.finish
56
+
Object.map ~kind:"RateLimit" () |> Object.skip_unknown |> Object.seal
57
57
in
58
58
let case_rate_limit =
59
59
Object.Case.map "rate_limit_event" rate_limit_jsont ~dec:(fun () ->
···
83
83
]
84
84
in
85
85
Object.map ~kind:"Incoming" Fun.id
86
-
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case cases
86
+
|> Object.case_member "type" string ~enc:Fun.id ~enc_case cases
87
87
~tag_to_string:Fun.id ~tag_compare:String.compare
88
-
|> Object.finish
88
+
|> Object.seal
89
89
90
90
let pp ppf t = Json.pp_value json () ppf t
+70
-40
lib/mcp_server.ml
+70
-40
lib/mcp_server.ml
···
22
22
(* JSONRPC helpers using Json.Json builders *)
23
23
24
24
let jsonrpc_success ~id result =
25
-
Json.object'
25
+
Json.Value.object'
26
26
[
27
-
Json.mem (Json.name "jsonrpc") (Json.string "2.0");
28
-
Json.mem (Json.name "id") id;
29
-
Json.mem (Json.name "result") result;
27
+
Json.Value.member (Json.Value.name "jsonrpc") (Json.Value.string "2.0");
28
+
Json.Value.member (Json.Value.name "id") id;
29
+
Json.Value.member (Json.Value.name "result") result;
30
30
]
31
31
32
32
let jsonrpc_error ~id ~code ~message =
33
-
Json.object'
33
+
Json.Value.object'
34
34
[
35
-
Json.mem (Json.name "jsonrpc") (Json.string "2.0");
36
-
Json.mem (Json.name "id") id;
37
-
Json.mem (Json.name "error")
38
-
(Json.object'
35
+
Json.Value.member (Json.Value.name "jsonrpc") (Json.Value.string "2.0");
36
+
Json.Value.member (Json.Value.name "id") id;
37
+
Json.Value.member (Json.Value.name "error")
38
+
(Json.Value.object'
39
39
[
40
-
Json.mem (Json.name "code") (Json.number (Float.of_int code));
41
-
Json.mem (Json.name "message") (Json.string message);
40
+
Json.Value.member (Json.Value.name "code")
41
+
(Json.Value.number (Float.of_int code));
42
+
Json.Value.member
43
+
(Json.Value.name "message")
44
+
(Json.Value.string message);
42
45
]);
43
46
]
44
47
···
46
49
let string_of key (obj : Json.t) =
47
50
match obj with
48
51
| Json.Object (mems, _) -> (
49
-
match Json.find_mem key mems with
52
+
match Json.Value.member_key key mems with
50
53
| Some (_, Json.String (s, _)) -> Some s
51
54
| _ -> None)
52
55
| _ -> None
···
55
58
let object_of key (obj : Json.t) : Json.t option =
56
59
match obj with
57
60
| Json.Object (mems, _) -> (
58
-
match Json.find_mem key mems with
61
+
match Json.Value.member_key key mems with
59
62
| Some (_, (Json.Object _ as o)) -> Some o
60
63
| _ -> None)
61
64
| _ -> None
···
64
67
let msg_id (msg : Json.t) : Json.t =
65
68
match msg with
66
69
| Json.Object (mems, _) -> (
67
-
match Json.find_mem "id" mems with
70
+
match Json.Value.member_key "id" mems with
68
71
| Some (_, id) -> id
69
-
| None -> Json.null ())
70
-
| _ -> Json.null ()
72
+
| None -> Json.Value.null ())
73
+
| _ -> Json.Value.null ()
71
74
72
75
(* Handle initialize request *)
73
76
let handle_initialize t ~id =
74
77
jsonrpc_success ~id
75
-
(Json.object'
78
+
(Json.Value.object'
76
79
[
77
-
Json.mem (Json.name "protocolVersion") (Json.string "2024-11-05");
78
-
Json.mem (Json.name "capabilities")
79
-
(Json.object' [ Json.mem (Json.name "tools") (Json.object' []) ]);
80
-
Json.mem (Json.name "serverInfo")
81
-
(Json.object'
80
+
Json.Value.member
81
+
(Json.Value.name "protocolVersion")
82
+
(Json.Value.string "2024-11-05");
83
+
Json.Value.member
84
+
(Json.Value.name "capabilities")
85
+
(Json.Value.object'
82
86
[
83
-
Json.mem (Json.name "name") (Json.string t.name);
84
-
Json.mem (Json.name "version") (Json.string t.version);
87
+
Json.Value.member (Json.Value.name "tools")
88
+
(Json.Value.object' []);
89
+
]);
90
+
Json.Value.member
91
+
(Json.Value.name "serverInfo")
92
+
(Json.Value.object'
93
+
[
94
+
Json.Value.member (Json.Value.name "name")
95
+
(Json.Value.string t.name);
96
+
Json.Value.member
97
+
(Json.Value.name "version")
98
+
(Json.Value.string t.version);
85
99
]);
86
100
])
87
101
···
90
104
let tools_json =
91
105
List.map
92
106
(fun tool ->
93
-
Json.object'
107
+
Json.Value.object'
94
108
[
95
-
Json.mem (Json.name "name") (Json.string (Tool.name tool));
96
-
Json.mem (Json.name "description")
97
-
(Json.string (Tool.description tool));
98
-
Json.mem (Json.name "inputSchema") (Tool.input_schema tool);
109
+
Json.Value.member (Json.Value.name "name")
110
+
(Json.Value.string (Tool.name tool));
111
+
Json.Value.member
112
+
(Json.Value.name "description")
113
+
(Json.Value.string (Tool.description tool));
114
+
Json.Value.member
115
+
(Json.Value.name "inputSchema")
116
+
(Tool.input_schema tool);
99
117
])
100
118
t.tools
101
119
in
102
120
jsonrpc_success ~id
103
-
(Json.object' [ Json.mem (Json.name "tools") (Json.list tools_json) ])
121
+
(Json.Value.object'
122
+
[
123
+
Json.Value.member (Json.Value.name "tools")
124
+
(Json.Value.list tools_json);
125
+
])
104
126
105
127
(* Handle tools/call request *)
106
128
let handle_tools_call t ~id ~params =
···
115
137
let arguments =
116
138
match object_of "arguments" params with
117
139
| Some args -> args
118
-
| None -> Json.object' []
140
+
| None -> Json.Value.object' []
119
141
in
120
142
let input = Tool_input.of_json arguments in
121
143
match Tool.call tool input with
122
144
| Ok content ->
123
145
jsonrpc_success ~id
124
-
(Json.object' [ Json.mem (Json.name "content") content ])
146
+
(Json.Value.object'
147
+
[ Json.Value.member (Json.Value.name "content") content ])
125
148
| Error msg ->
126
149
(* Return error as content with is_error flag *)
127
150
jsonrpc_success ~id
128
-
(Json.object'
151
+
(Json.Value.object'
129
152
[
130
-
Json.mem (Json.name "content")
131
-
(Json.list
153
+
Json.Value.member
154
+
(Json.Value.name "content")
155
+
(Json.Value.list
132
156
[
133
-
Json.object'
157
+
Json.Value.object'
134
158
[
135
-
Json.mem (Json.name "type") (Json.string "text");
136
-
Json.mem (Json.name "text") (Json.string msg);
159
+
Json.Value.member (Json.Value.name "type")
160
+
(Json.Value.string "text");
161
+
Json.Value.member (Json.Value.name "text")
162
+
(Json.Value.string msg);
137
163
];
138
164
]);
139
-
Json.mem (Json.name "isError") (Json.bool true);
165
+
Json.Value.member
166
+
(Json.Value.name "isError")
167
+
(Json.Value.bool true);
140
168
])))
141
169
142
170
let handle_request t ~method_ ~params ~id =
···
151
179
let handle_json_message t (msg : Json.t) =
152
180
let method_ = match string_of "method" msg with Some m -> m | None -> "" in
153
181
let params =
154
-
match object_of "params" msg with Some p -> p | None -> Json.object' []
182
+
match object_of "params" msg with
183
+
| Some p -> p
184
+
| None -> Json.Value.object' []
155
185
in
156
186
let id = msg_id msg in
157
187
handle_request t ~method_ ~params ~id
+48
-44
lib/message.ml
+48
-44
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 -> encode_content (content t))
70
+
|> Object.member "content" Value.t ~enc:(fun t ->
71
+
encode_content (content t))
71
72
|> Object.keep_unknown Unknown.mems ~enc:unknown
72
-
|> Object.finish
73
+
|> Object.seal
73
74
74
75
let incoming_jsont : t Json.codec =
75
76
let message_jsont =
76
77
Object.map ~kind:"UserMessage" (fun json_content ->
77
78
let content = decode_content json_content in
78
79
{ content; unknown = Unknown.empty })
79
-
|> Object.mem "content" Value.t ~enc:(fun t -> encode_content (content t))
80
-
|> Object.finish
80
+
|> Object.member "content" Value.t ~enc:(fun t ->
81
+
encode_content (content t))
82
+
|> Object.seal
81
83
in
82
84
Object.map ~kind:"UserEnvelope" Fun.id
83
-
|> Object.mem "message" message_jsont ~enc:Fun.id
84
-
|> Object.finish
85
+
|> Object.member "message" message_jsont ~enc:Fun.id
86
+
|> Object.seal
85
87
86
88
let outgoing_jsont : t Json.codec =
87
89
let message_jsont =
88
90
Object.map ~kind:"UserOutgoingMessage" (fun _role json_content ->
89
91
let content = decode_content json_content in
90
92
{ content; unknown = Unknown.empty })
91
-
|> Object.mem "role" string ~enc:(fun _ -> "user")
92
-
|> Object.mem "content" Value.t ~enc:(fun t -> encode_content (content t))
93
-
|> Object.finish
93
+
|> Object.member "role" string ~enc:(fun _ -> "user")
94
+
|> Object.member "content" Value.t ~enc:(fun t ->
95
+
encode_content (content t))
96
+
|> Object.seal
94
97
in
95
98
Object.map ~kind:"UserOutgoingEnvelope" Fun.id
96
-
|> Object.mem "message" message_jsont ~enc:Fun.id
97
-
|> Object.finish
99
+
|> Object.member "message" message_jsont ~enc:Fun.id
100
+
|> Object.seal
98
101
99
102
let to_json t =
100
103
match Json.encode json t with
···
164
167
165
168
let json : t Json.codec =
166
169
Object.map ~kind:"Assistant" make
167
-
|> Object.mem "content" (list Content_block.json) ~enc:content
168
-
|> Object.mem "model" string ~enc:model
169
-
|> Object.opt_mem "error" error_jsont ~enc:error
170
+
|> Object.member "content" (list Content_block.json) ~enc:content
171
+
|> Object.member "model" string ~enc:model
172
+
|> Object.opt_member "error" error_jsont ~enc:error
170
173
|> Object.keep_unknown Unknown.mems ~enc:unknown
171
-
|> Object.finish
174
+
|> Object.seal
172
175
173
176
let incoming_jsont : t Json.codec =
174
177
Object.map ~kind:"AssistantEnvelope" Fun.id
175
-
|> Object.mem "message" json ~enc:Fun.id
176
-
|> Object.finish
178
+
|> Object.member "message" json ~enc:Fun.id
179
+
|> Object.seal
177
180
178
181
let to_json t =
179
182
match Json.encode json t with
···
211
214
{ session_id; model; cwd; unknown }
212
215
in
213
216
Object.map ~kind:"SystemInit" make
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.opt_member "session_id" string ~enc:(fun (r : init) ->
218
+
r.session_id)
219
+
|> Object.opt_member "model" string ~enc:(fun (r : init) -> r.model)
220
+
|> Object.opt_member "cwd" string ~enc:(fun (r : init) -> r.cwd)
217
221
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : init) -> r.unknown)
218
-
|> Object.finish
222
+
|> Object.seal
219
223
220
224
let error_jsont : error Json.codec =
221
225
let make err unknown : error = { error = err; unknown } in
222
226
Object.map ~kind:"SystemError" make
223
-
|> Object.mem "error" string ~enc:(fun (r : error) -> r.error)
227
+
|> Object.member "error" string ~enc:(fun (r : error) -> r.error)
224
228
|> Object.keep_unknown Unknown.mems ~enc:(fun (r : error) -> r.unknown)
225
-
|> Object.finish
229
+
|> Object.seal
226
230
227
231
let json : t Json.codec =
228
232
let case_init = Object.Case.map "init" init_jsont ~dec:(fun v -> Init v) in
···
235
239
in
236
240
let cases = Object.Case.[ make case_init; make case_error ] in
237
241
Object.map ~kind:"System" Fun.id
238
-
|> Object.case_mem "subtype" string ~enc:Fun.id ~enc_case cases
242
+
|> Object.case_member "subtype" string ~enc:Fun.id ~enc_case cases
239
243
~tag_to_string:Fun.id ~tag_compare:String.compare
240
-
|> Object.finish
244
+
|> Object.seal
241
245
242
246
let to_json t =
243
247
match Json.encode json t with
···
287
291
288
292
let json : t Json.codec =
289
293
Object.map ~kind:"Usage" make
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
293
-
|> Object.opt_mem "cache_creation_input_tokens" int
294
+
|> Object.opt_member "input_tokens" int ~enc:input_tokens
295
+
|> Object.opt_member "output_tokens" int ~enc:output_tokens
296
+
|> Object.opt_member "total_tokens" int ~enc:total_tokens
297
+
|> Object.opt_member "cache_creation_input_tokens" int
294
298
~enc:cache_creation_input_tokens
295
-
|> Object.opt_mem "cache_read_input_tokens" int
299
+
|> Object.opt_member "cache_read_input_tokens" int
296
300
~enc:cache_read_input_tokens
297
301
|> Object.keep_unknown Unknown.mems ~enc:unknown
298
-
|> Object.finish
302
+
|> Object.seal
299
303
end
300
304
301
305
type t = {
···
359
363
360
364
let json : t Json.codec =
361
365
Object.map ~kind:"Result" make
362
-
|> Object.mem "subtype" string ~enc:subtype
363
-
|> Object.mem "duration_ms" int ~enc:duration_ms
364
-
|> Object.mem "duration_api_ms" int ~enc:duration_api_ms
365
-
|> Object.mem "is_error" bool ~enc:is_error
366
-
|> Object.mem "num_turns" int ~enc:num_turns
367
-
|> Object.mem "session_id" string ~enc:session_id
368
-
|> Object.opt_mem "total_cost_usd" number ~enc:total_cost_usd
369
-
|> Object.opt_mem "usage" Usage.json ~enc:usage
370
-
|> Object.opt_mem "result" string ~enc:result
371
-
|> Object.opt_mem "structured_output" Value.t ~enc:structured_output
366
+
|> Object.member "subtype" string ~enc:subtype
367
+
|> Object.member "duration_ms" int ~enc:duration_ms
368
+
|> Object.member "duration_api_ms" int ~enc:duration_api_ms
369
+
|> Object.member "is_error" bool ~enc:is_error
370
+
|> Object.member "num_turns" int ~enc:num_turns
371
+
|> Object.member "session_id" string ~enc:session_id
372
+
|> Object.opt_member "total_cost_usd" number ~enc:total_cost_usd
373
+
|> Object.opt_member "usage" Usage.json ~enc:usage
374
+
|> Object.opt_member "result" string ~enc:result
375
+
|> Object.opt_member "structured_output" Value.t ~enc:structured_output
372
376
|> Object.keep_unknown Unknown.mems ~enc:unknown
373
-
|> Object.finish
377
+
|> Object.seal
374
378
375
379
let to_json t =
376
380
match Json.encode json t with
···
405
409
]
406
410
in
407
411
Object.map ~kind:"Message" Fun.id
408
-
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case cases
412
+
|> Object.case_member "type" string ~enc:Fun.id ~enc_case cases
409
413
~tag_to_string:Fun.id ~tag_compare:String.compare
410
-
|> Object.finish
414
+
|> Object.seal
411
415
412
416
let is_user = function User _ -> true | _ -> false
413
417
let is_assistant = function Assistant _ -> true | _ -> false
+22
-20
lib/options.ml
+22
-20
lib/options.ml
···
158
158
in
159
159
let open Json.Codec in
160
160
Object.map ~kind:"Options" make
161
-
|> Object.mem "allowedTools" (list string) ~enc:allowed_tools ~dec_absent:[]
162
-
|> Object.mem "disallowedTools" (list string) ~enc:disallowed_tools
161
+
|> Object.member "allowedTools" (list string) ~enc:allowed_tools
163
162
~dec_absent:[]
164
-
|> Object.opt_mem "maxThinkingTokens" int ~enc:max_thinking_tokens
165
-
|> Object.opt_mem "systemPrompt" string ~enc:system_prompt
166
-
|> Object.opt_mem "appendSystemPrompt" string ~enc:append_system_prompt
167
-
|> Object.opt_mem "permissionMode" Permissions.Mode.json
163
+
|> Object.member "disallowedTools" (list string) ~enc:disallowed_tools
164
+
~dec_absent:[]
165
+
|> Object.opt_member "maxThinkingTokens" int ~enc:max_thinking_tokens
166
+
|> Object.opt_member "systemPrompt" string ~enc:system_prompt
167
+
|> Object.opt_member "appendSystemPrompt" string ~enc:append_system_prompt
168
+
|> Object.opt_member "permissionMode" Permissions.Mode.json
168
169
~enc:permission_mode
169
-
|> Object.opt_mem "model" Model.json ~enc:model
170
-
|> Object.mem "continueConversation" bool ~enc:continue_conversation
170
+
|> Object.opt_member "model" Model.json ~enc:model
171
+
|> Object.member "continueConversation" bool ~enc:continue_conversation
171
172
~dec_absent:false
172
-
|> Object.opt_mem "resume" string ~enc:resume
173
-
|> Object.opt_mem "maxTurns" int ~enc:max_turns
174
-
|> Object.opt_mem "permissionPromptToolName" string
173
+
|> Object.opt_member "resume" string ~enc:resume
174
+
|> Object.opt_member "maxTurns" int ~enc:max_turns
175
+
|> Object.opt_member "permissionPromptToolName" string
175
176
~enc:permission_prompt_tool_name
176
-
|> Object.opt_mem "settings" string ~enc:settings
177
-
|> Object.mem "addDirs" (list string) ~enc:add_dirs ~dec_absent:[]
178
-
|> Object.opt_mem "maxBudgetUsd" number ~enc:max_budget_usd
179
-
|> Object.opt_mem "fallbackModel" Model.json ~enc:fallback_model
180
-
|> Object.opt_mem "settingSources"
177
+
|> Object.opt_member "settings" string ~enc:settings
178
+
|> Object.member "addDirs" (list string) ~enc:add_dirs ~dec_absent:[]
179
+
|> Object.opt_member "maxBudgetUsd" number ~enc:max_budget_usd
180
+
|> Object.opt_member "fallbackModel" Model.json ~enc:fallback_model
181
+
|> Object.opt_member "settingSources"
181
182
(list setting_source_jsont)
182
183
~enc:setting_sources
183
-
|> Object.opt_mem "maxBufferSize" int ~enc:max_buffer_size
184
-
|> Object.opt_mem "user" string ~enc:user
185
-
|> Object.opt_mem "outputFormat" Structured_output.json ~enc:output_format
184
+
|> Object.opt_member "maxBufferSize" int ~enc:max_buffer_size
185
+
|> Object.opt_member "user" string ~enc:user
186
+
|> Object.opt_member "outputFormat" Structured_output.json
187
+
~enc:output_format
186
188
|> Object.keep_unknown Unknown.mems ~enc:unknown
187
-
|> Object.finish
189
+
|> Object.seal
188
190
189
191
let pp ppf t = Json.pp_value json () ppf t
190
192
end
+2
-2
lib/outgoing.ml
+2
-2
lib/outgoing.ml
···
56
56
]
57
57
in
58
58
Object.map ~kind:"Outgoing" Fun.id
59
-
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case cases
59
+
|> Object.case_member "type" string ~enc:Fun.id ~enc_case cases
60
60
~tag_to_string:Fun.id ~tag_compare:String.compare
61
-
|> Object.finish
61
+
|> Object.seal
62
62
63
63
let pp ppf t = Json.pp_value json () ppf t
64
64
+23
-22
lib/permissions.ml
+23
-22
lib/permissions.ml
···
73
73
{ tool_name; rule_content; unknown }
74
74
in
75
75
Object.map ~kind:"Rule" make
76
-
|> Object.mem "toolName" string ~enc:tool_name
77
-
|> Object.opt_mem "ruleContent" string ~enc:rule_content
76
+
|> Object.member "toolName" string ~enc:tool_name
77
+
|> Object.opt_member "ruleContent" string ~enc:rule_content
78
78
|> Object.keep_unknown Unknown.mems ~enc:unknown
79
-
|> Object.finish
79
+
|> Object.seal
80
80
end
81
81
82
82
module Update = struct
···
141
141
{ update_type; rules; behavior; mode; directories; destination; unknown }
142
142
in
143
143
Object.map ~kind:"Update" make
144
-
|> Object.mem "type" update_type_jsont ~enc:update_type
145
-
|> Object.opt_mem "rules" (list Rule.json) ~enc:rules
146
-
|> Object.opt_mem "behavior" Behavior.json ~enc:behavior
147
-
|> Object.opt_mem "mode" Mode.json ~enc:mode
148
-
|> Object.opt_mem "directories" (list string) ~enc:directories
149
-
|> Object.opt_mem "destination" destination_jsont ~enc:destination
144
+
|> Object.member "type" update_type_jsont ~enc:update_type
145
+
|> Object.opt_member "rules" (list Rule.json) ~enc:rules
146
+
|> Object.opt_member "behavior" Behavior.json ~enc:behavior
147
+
|> Object.opt_member "mode" Mode.json ~enc:mode
148
+
|> Object.opt_member "directories" (list string) ~enc:directories
149
+
|> Object.opt_member "destination" destination_jsont ~enc:destination
150
150
|> Object.keep_unknown Unknown.mems ~enc:unknown
151
-
|> Object.finish
151
+
|> Object.seal
152
152
end
153
153
154
154
module Context = struct
···
163
163
let json : t Json.codec =
164
164
let make suggestions unknown = { suggestions; unknown } in
165
165
Object.map ~kind:"Context" make
166
-
|> Object.mem "suggestions" (list Update.json) ~enc:suggestions
166
+
|> Object.member "suggestions" (list Update.json) ~enc:suggestions
167
167
~dec_absent:[]
168
168
|> Object.keep_unknown Unknown.mems ~enc:unknown
169
-
|> Object.finish
169
+
|> Object.seal
170
170
end
171
171
172
172
module Result = struct
···
190
190
Allow { updated_input; updated_permissions; unknown }
191
191
in
192
192
Object.map ~kind:"AllowRecord" make
193
-
|> Object.mem "updatedInput" (option Value.t)
193
+
|> Object.member "updatedInput" (option Value.t)
194
194
~enc:(function
195
195
| Allow { updated_input; _ } -> updated_input | _ -> None)
196
196
~dec_absent:None
197
-
|> Object.opt_mem "updatedPermissions" (list Update.json) ~enc:(function
198
-
| Allow { updated_permissions; _ } -> updated_permissions
199
-
| _ -> None)
197
+
|> Object.opt_member "updatedPermissions" (list Update.json)
198
+
~enc:(function
199
+
| Allow { updated_permissions; _ } -> updated_permissions
200
+
| _ -> None)
200
201
|> Object.keep_unknown Unknown.mems ~enc:(function
201
202
| Allow { unknown; _ } -> unknown
202
203
| _ -> Unknown.empty)
203
-
|> Object.finish
204
+
|> Object.seal
204
205
in
205
206
let deny_record =
206
207
let make message interrupt unknown =
207
208
Deny { message; interrupt; unknown }
208
209
in
209
210
Object.map ~kind:"DenyRecord" make
210
-
|> Object.mem "message" string ~enc:(function
211
+
|> Object.member "message" string ~enc:(function
211
212
| Deny { message; _ } -> message
212
213
| _ -> "")
213
-
|> Object.mem "interrupt" bool ~enc:(function
214
+
|> Object.member "interrupt" bool ~enc:(function
214
215
| Deny { interrupt; _ } -> interrupt
215
216
| _ -> false)
216
217
|> Object.keep_unknown Unknown.mems ~enc:(function
217
218
| Deny { unknown; _ } -> unknown
218
219
| _ -> Unknown.empty)
219
-
|> Object.finish
220
+
|> Object.seal
220
221
in
221
222
let case_allow = Object.Case.map "allow" allow_record ~dec:(fun v -> v) in
222
223
let case_deny = Object.Case.map "deny" deny_record ~dec:(fun v -> v) in
···
226
227
in
227
228
let cases = Object.Case.[ make case_allow; make case_deny ] in
228
229
Object.map ~kind:"Result" Fun.id
229
-
|> Object.case_mem "behavior" string ~enc:Fun.id ~enc_case cases
230
+
|> Object.case_member "behavior" string ~enc:Fun.id ~enc_case cases
230
231
~tag_to_string:Fun.id ~tag_compare:String.compare
231
-
|> Object.finish
232
+
|> Object.seal
232
233
end
233
234
234
235
module Decision = struct
+3
-3
lib/structured_output.ml
+3
-3
lib/structured_output.ml
···
9
9
10
10
type t = { json_schema : Json.t }
11
11
12
-
let pp ppf t = Json.pp_json ppf t.json_schema
12
+
let pp ppf t = Json.pp ppf t.json_schema
13
13
let json_to_string json = Json.Value.to_string json
14
14
15
15
let of_json_schema schema =
···
23
23
let json : t Json.codec =
24
24
let open Json.Codec in
25
25
Object.map ~kind:"StructuredOutput" (fun json_schema -> { json_schema })
26
-
|> Object.mem "jsonSchema" Value.t ~enc:(fun t -> t.json_schema)
27
-
|> Object.finish
26
+
|> Object.member "jsonSchema" Value.t ~enc:(fun t -> t.json_schema)
27
+
|> Object.seal
28
28
29
29
let to_json t =
30
30
match Json.encode json t with
+35
-25
lib/tool.ml
+35
-25
lib/tool.ml
···
20
20
let call t input = t.handler input
21
21
22
22
let text_result s =
23
-
Json.list
23
+
Json.Value.list
24
24
[
25
-
Json.object'
25
+
Json.Value.object'
26
26
[
27
-
Json.mem (Json.name "type") (Json.string "text");
28
-
Json.mem (Json.name "text") (Json.string s);
27
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "text");
28
+
Json.Value.member (Json.Value.name "text") (Json.Value.string s);
29
29
];
30
30
]
31
31
32
32
let error_result s =
33
-
Json.list
33
+
Json.Value.list
34
34
[
35
-
Json.object'
35
+
Json.Value.object'
36
36
[
37
-
Json.mem (Json.name "type") (Json.string "text");
38
-
Json.mem (Json.name "text") (Json.string s);
39
-
Json.mem (Json.name "is_error") (Json.bool true);
37
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "text");
38
+
Json.Value.member (Json.Value.name "text") (Json.Value.string s);
39
+
Json.Value.member (Json.Value.name "is_error") (Json.Value.bool true);
40
40
];
41
41
]
42
42
43
43
let schema_string =
44
-
Json.object' [ Json.mem (Json.name "type") (Json.string "string") ]
44
+
Json.Value.object'
45
+
[ Json.Value.member (Json.Value.name "type") (Json.Value.string "string") ]
45
46
46
47
let schema_int =
47
-
Json.object' [ Json.mem (Json.name "type") (Json.string "integer") ]
48
+
Json.Value.object'
49
+
[ Json.Value.member (Json.Value.name "type") (Json.Value.string "integer") ]
48
50
49
51
let schema_number =
50
-
Json.object' [ Json.mem (Json.name "type") (Json.string "number") ]
52
+
Json.Value.object'
53
+
[ Json.Value.member (Json.Value.name "type") (Json.Value.string "number") ]
51
54
52
55
let schema_bool =
53
-
Json.object' [ Json.mem (Json.name "type") (Json.string "boolean") ]
56
+
Json.Value.object'
57
+
[ Json.Value.member (Json.Value.name "type") (Json.Value.string "boolean") ]
54
58
55
59
let schema_array item_schema =
56
-
Json.object'
60
+
Json.Value.object'
57
61
[
58
-
Json.mem (Json.name "type") (Json.string "array");
59
-
Json.mem (Json.name "items") item_schema;
62
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "array");
63
+
Json.Value.member (Json.Value.name "items") item_schema;
60
64
]
61
65
62
66
let schema_string_enum values =
63
-
Json.object'
67
+
Json.Value.object'
64
68
[
65
-
Json.mem (Json.name "type") (Json.string "string");
66
-
Json.mem (Json.name "enum") (Json.list (List.map Json.string values));
69
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "string");
70
+
Json.Value.member (Json.Value.name "enum")
71
+
(Json.Value.list (List.map Json.Value.string values));
67
72
]
68
73
69
74
let schema_object props ~required =
70
-
Json.object'
75
+
Json.Value.object'
71
76
[
72
-
Json.mem (Json.name "type") (Json.string "object");
73
-
Json.mem (Json.name "properties")
74
-
(Json.object' (List.map (fun (k, v) -> Json.mem (Json.name k) v) props));
75
-
Json.mem (Json.name "required")
76
-
(Json.list (List.map Json.string required));
77
+
Json.Value.member (Json.Value.name "type") (Json.Value.string "object");
78
+
Json.Value.member
79
+
(Json.Value.name "properties")
80
+
(Json.Value.object'
81
+
(List.map
82
+
(fun (k, v) -> Json.Value.member (Json.Value.name k) v)
83
+
props));
84
+
Json.Value.member
85
+
(Json.Value.name "required")
86
+
(Json.Value.list (List.map Json.Value.string required));
77
87
]
+8
-5
lib/tool_input.ml
+8
-5
lib/tool_input.ml
···
7
7
8
8
type t = Json.t
9
9
10
-
let pp = Json.pp_json
10
+
let pp = Json.pp
11
11
12
12
(** {1 Escape Hatch} *)
13
13
···
102
102
let filtered_members = List.filter (fun ((name, _), _) -> name <> key) mems in
103
103
Json.Object (new_member :: filtered_members, Json.Meta.none)
104
104
105
-
let add_string key value t = add_member key (Json.string value) t
106
-
let add_int key value t = add_member key (Json.number (Float.of_int value)) t
107
-
let add_bool key value t = add_member key (Json.bool value) t
108
-
let add_float key value t = add_member key (Json.number value) t
105
+
let add_string key value t = add_member key (Json.Value.string value) t
106
+
107
+
let add_int key value t =
108
+
add_member key (Json.Value.number (Float.of_int value)) t
109
+
110
+
let add_bool key value t = add_member key (Json.Value.bool value) t
111
+
let add_float key value t = add_member key (Json.Value.number value) t
109
112
110
113
let of_assoc assoc =
111
114
let members =
+5
-4
lib/unknown.ml
+5
-4
lib/unknown.ml
···
6
6
type t = (string * Json.t) list
7
7
8
8
let pp ppf t =
9
-
let pp_pair ppf (k, v) = Fmt.pf ppf "@[%s: %a@]" k Json.pp_json v in
9
+
let pp_pair ppf (k, v) = Fmt.pf ppf "@[%s: %a@]" k Json.pp v in
10
10
Fmt.pf ppf "@[{%a}@]"
11
11
(Fmt.list ~sep:(fun ppf () -> Fmt.pf ppf ",@ ") pp_pair)
12
12
t
···
32
32
in
33
33
map ~dec ~enc Value.t
34
34
35
-
let mems : (t, Json.t, Json.mem list) Json.Codec.Object.Mems.map =
35
+
let mems : (t, Json.t, Json.member list) Json.Codec.Object.Members.map =
36
36
let open Json.Codec in
37
37
let dec_empty () = [] in
38
38
let dec_add meta name json acc = ((name, meta), json) :: acc in
···
41
41
in
42
42
let enc =
43
43
{
44
-
Object.Mems.enc =
44
+
Object.Members.enc =
45
45
(fun k fields acc ->
46
46
List.fold_left
47
47
(fun acc (name, json) -> k Json.Meta.none name json acc)
48
48
acc fields);
49
49
}
50
50
in
51
-
Object.Mems.map ~kind:"Unknown" ~dec_empty ~dec_add ~dec_finish ~enc Value.t
51
+
Object.Members.map ~kind:"Unknown" ~dec_empty ~dec_add ~dec_finish ~enc
52
+
Value.t
+1
-1
lib/unknown.mli
+1
-1
lib/unknown.mli
···
32
32
val json : t Json.codec
33
33
(** [json] is a codec for encoding and decoding unknown fields to/from JSON. *)
34
34
35
-
val mems : (t, Json.t, Json.mem list) Json.Codec.Object.Mems.map
35
+
val mems : (t, Json.t, Json.member list) Json.Codec.Object.Members.map
36
36
(** [mems] is a mems codec for use with [Json.Codec.Object.keep_unknown]. *)
+55
-52
test/test_claude.ml
+55
-52
test/test_claude.ml
···
11
11
- Mcp_server module for in-process MCP servers
12
12
- Structured error handling *)
13
13
14
-
module J = Json
14
+
module J = Json.Value
15
15
16
16
(* ============================================
17
17
Protocol Tests - Incoming message codec
···
98
98
99
99
let test_tool_schema_string () =
100
100
let schema = Claude.Tool.schema_string in
101
-
let expected = J.object' [ J.mem (J.name "type") (J.string "string") ] in
101
+
let expected = J.object' [ J.member (J.name "type") (J.string "string") ] in
102
102
Alcotest.check json_testable "schema_string" expected schema
103
103
104
104
let test_tool_schema_int () =
105
105
let schema = Claude.Tool.schema_int in
106
-
let expected = J.object' [ J.mem (J.name "type") (J.string "integer") ] in
106
+
let expected = J.object' [ J.member (J.name "type") (J.string "integer") ] in
107
107
Alcotest.check json_testable "schema_int" expected schema
108
108
109
109
let test_tool_schema_number () =
110
110
let schema = Claude.Tool.schema_number in
111
-
let expected = J.object' [ J.mem (J.name "type") (J.string "number") ] in
111
+
let expected = J.object' [ J.member (J.name "type") (J.string "number") ] in
112
112
Alcotest.check json_testable "schema_number" expected schema
113
113
114
114
let test_tool_schema_bool () =
115
115
let schema = Claude.Tool.schema_bool in
116
-
let expected = J.object' [ J.mem (J.name "type") (J.string "boolean") ] in
116
+
let expected = J.object' [ J.member (J.name "type") (J.string "boolean") ] in
117
117
Alcotest.check json_testable "schema_bool" expected schema
118
118
119
119
let test_tool_schema_array () =
···
121
121
let expected =
122
122
J.object'
123
123
[
124
-
J.mem (J.name "type") (J.string "array");
125
-
J.mem (J.name "items")
126
-
(J.object' [ J.mem (J.name "type") (J.string "string") ]);
124
+
J.member (J.name "type") (J.string "array");
125
+
J.member (J.name "items")
126
+
(J.object' [ J.member (J.name "type") (J.string "string") ]);
127
127
]
128
128
in
129
129
Alcotest.check json_testable "schema_array" expected schema
···
133
133
let expected =
134
134
J.object'
135
135
[
136
-
J.mem (J.name "type") (J.string "string");
137
-
J.mem (J.name "enum")
136
+
J.member (J.name "type") (J.string "string");
137
+
J.member (J.name "enum")
138
138
(J.list [ J.string "foo"; J.string "bar"; J.string "baz" ]);
139
139
]
140
140
in
···
149
149
let expected =
150
150
J.object'
151
151
[
152
-
J.mem (J.name "type") (J.string "object");
153
-
J.mem (J.name "properties")
152
+
J.member (J.name "type") (J.string "object");
153
+
J.member (J.name "properties")
154
154
(J.object'
155
155
[
156
-
J.mem (J.name "name")
157
-
(J.object' [ J.mem (J.name "type") (J.string "string") ]);
158
-
J.mem (J.name "age")
159
-
(J.object' [ J.mem (J.name "type") (J.string "integer") ]);
156
+
J.member (J.name "name")
157
+
(J.object' [ J.member (J.name "type") (J.string "string") ]);
158
+
J.member (J.name "age")
159
+
(J.object' [ J.member (J.name "type") (J.string "integer") ]);
160
160
]);
161
-
J.mem (J.name "required") (J.list [ J.string "name" ]);
161
+
J.member (J.name "required") (J.list [ J.string "name" ]);
162
162
]
163
163
in
164
164
Alcotest.check json_testable "schema_object" expected schema
···
170
170
[
171
171
J.object'
172
172
[
173
-
J.mem (J.name "type") (J.string "text");
174
-
J.mem (J.name "text") (J.string "Hello, world!");
173
+
J.member (J.name "type") (J.string "text");
174
+
J.member (J.name "text") (J.string "Hello, world!");
175
175
];
176
176
]
177
177
in
···
184
184
[
185
185
J.object'
186
186
[
187
-
J.mem (J.name "type") (J.string "text");
188
-
J.mem (J.name "text") (J.string "Something went wrong");
189
-
J.mem (J.name "is_error") (J.bool true);
187
+
J.member (J.name "type") (J.string "text");
188
+
J.member (J.name "text") (J.string "Something went wrong");
189
+
J.member (J.name "is_error") (J.bool true);
190
190
];
191
191
]
192
192
in
···
210
210
(Claude.Tool.description greet);
211
211
212
212
(* Test successful call *)
213
-
let input_json = J.object' [ J.mem (J.name "name") (J.string "Alice") ] in
213
+
let input_json = J.object' [ J.member (J.name "name") (J.string "Alice") ] in
214
214
let input = Claude.Tool_input.of_json input_json in
215
215
match Claude.Tool.call greet input with
216
216
| Ok result ->
···
279
279
let request =
280
280
J.object'
281
281
[
282
-
J.mem (J.name "jsonrpc") (J.string "2.0");
283
-
J.mem (J.name "id") (J.number 1.0);
284
-
J.mem (J.name "method") (J.string "initialize");
285
-
J.mem (J.name "params") (J.object' []);
282
+
J.member (J.name "jsonrpc") (J.string "2.0");
283
+
J.member (J.name "id") (J.number 1.0);
284
+
J.member (J.name "method") (J.string "initialize");
285
+
J.member (J.name "params") (J.object' []);
286
286
]
287
287
in
288
288
let response = Claude.Mcp_server.handle_json_message server request in
···
303
303
let request =
304
304
J.object'
305
305
[
306
-
J.mem (J.name "jsonrpc") (J.string "2.0");
307
-
J.mem (J.name "id") (J.number 2.0);
308
-
J.mem (J.name "method") (J.string "tools/list");
309
-
J.mem (J.name "params") (J.object' []);
306
+
J.member (J.name "jsonrpc") (J.string "2.0");
307
+
J.member (J.name "id") (J.number 2.0);
308
+
J.member (J.name "method") (J.string "tools/list");
309
+
J.member (J.name "params") (J.object' []);
310
310
]
311
311
in
312
312
let response = Claude.Mcp_server.handle_json_message server request in
···
338
338
let request =
339
339
J.object'
340
340
[
341
-
J.mem (J.name "jsonrpc") (J.string "2.0");
342
-
J.mem (J.name "id") (J.number 3.0);
343
-
J.mem (J.name "method") (J.string "tools/call");
344
-
J.mem (J.name "params")
341
+
J.member (J.name "jsonrpc") (J.string "2.0");
342
+
J.member (J.name "id") (J.number 3.0);
343
+
J.member (J.name "method") (J.string "tools/call");
344
+
J.member (J.name "params")
345
345
(J.object'
346
346
[
347
-
J.mem (J.name "name") (J.string "uppercase");
348
-
J.mem (J.name "arguments")
349
-
(J.object' [ J.mem (J.name "text") (J.string "hello") ]);
347
+
J.member (J.name "name") (J.string "uppercase");
348
+
J.member (J.name "arguments")
349
+
(J.object' [ J.member (J.name "text") (J.string "hello") ]);
350
350
]);
351
351
]
352
352
in
···
369
369
let request =
370
370
J.object'
371
371
[
372
-
J.mem (J.name "jsonrpc") (J.string "2.0");
373
-
J.mem (J.name "id") (J.number 4.0);
374
-
J.mem (J.name "method") (J.string "tools/call");
375
-
J.mem (J.name "params")
376
-
(J.object' [ J.mem (J.name "name") (J.string "nonexistent") ]);
372
+
J.member (J.name "jsonrpc") (J.string "2.0");
373
+
J.member (J.name "id") (J.number 4.0);
374
+
J.member (J.name "method") (J.string "tools/call");
375
+
J.member (J.name "params")
376
+
(J.object' [ J.member (J.name "name") (J.string "nonexistent") ]);
377
377
]
378
378
in
379
379
let response = Claude.Mcp_server.handle_json_message server request in
···
389
389
let request =
390
390
J.object'
391
391
[
392
-
J.mem (J.name "jsonrpc") (J.string "2.0");
393
-
J.mem (J.name "id") (J.number 5.0);
394
-
J.mem (J.name "method") (J.string "unknown/method");
395
-
J.mem (J.name "params") (J.object' []);
392
+
J.member (J.name "jsonrpc") (J.string "2.0");
393
+
J.member (J.name "id") (J.number 5.0);
394
+
J.member (J.name "method") (J.string "unknown/method");
395
+
J.member (J.name "params") (J.object' []);
396
396
]
397
397
in
398
398
let response = Claude.Mcp_server.handle_json_message server request in
···
475
475
============================================ *)
476
476
477
477
let test_tool_input_string () =
478
-
let json = J.object' [ J.mem (J.name "foo") (J.string "bar") ] in
478
+
let json = J.object' [ J.member (J.name "foo") (J.string "bar") ] in
479
479
let input = Claude.Tool_input.of_json json in
480
480
Alcotest.(check (option string))
481
481
"string foo" (Some "bar")
···
485
485
(Claude.Tool_input.string input "missing")
486
486
487
487
let test_tool_input_int () =
488
-
let json = J.object' [ J.mem (J.name "count") (J.number 42.0) ] in
488
+
let json = J.object' [ J.member (J.name "count") (J.number 42.0) ] in
489
489
let input = Claude.Tool_input.of_json json in
490
490
Alcotest.(check (option int))
491
491
"int count" (Some 42)
492
492
(Claude.Tool_input.int input "count")
493
493
494
494
let test_tool_input_float () =
495
-
let json = J.object' [ J.mem (J.name "pi") (J.number 3.14159) ] in
495
+
let json = J.object' [ J.member (J.name "pi") (J.number 3.14159) ] in
496
496
let input = Claude.Tool_input.of_json json in
497
497
match Claude.Tool_input.float input "pi" with
498
498
| Some f ->
···
504
504
let test_tool_input_bool () =
505
505
let json =
506
506
J.object'
507
-
[ J.mem (J.name "yes") (J.bool true); J.mem (J.name "no") (J.bool false) ]
507
+
[
508
+
J.member (J.name "yes") (J.bool true);
509
+
J.member (J.name "no") (J.bool false);
510
+
]
508
511
in
509
512
let input = Claude.Tool_input.of_json json in
510
513
Alcotest.(check (option bool))
···
518
521
let json =
519
522
J.object'
520
523
[
521
-
J.mem (J.name "items")
524
+
J.member (J.name "items")
522
525
(J.list [ J.string "a"; J.string "b"; J.string "c" ]);
523
526
]
524
527
in
+1
-1
test/test_content_block.ml
+1
-1
test/test_content_block.ml
···
26
26
| _ -> Alcotest.fail "Expected Tool_use block"
27
27
28
28
let test_tool_result_block () =
29
-
let content = Json.string "success" in
29
+
let content = Json.Value.string "success" in
30
30
match CB.tool_result ~tool_use_id:"tu-1" ~content () with
31
31
| CB.Tool_result tr ->
32
32
Alcotest.(check string)
+8
-5
test/test_control.ml
+8
-5
test/test_control.ml
···
11
11
| _ -> Alcotest.fail "Expected Interrupt"
12
12
13
13
let test_permission_request () =
14
-
let input = Json.object' [] in
14
+
let input = Json.Value.object' [] in
15
15
match C.Request.permission ~tool_name:"Bash" ~input () with
16
16
| C.Request.Permission p ->
17
17
Alcotest.(check string) "tool_name" "Bash" p.tool_name
···
97
97
| Error e -> Alcotest.fail (Loc.Error.to_string e)
98
98
99
99
let test_request_jsont_permission () =
100
-
let input = Json.object' [ Json.mem (Json.name "cmd") (Json.string "ls") ] in
100
+
let input =
101
+
Json.Value.object'
102
+
[ Json.Value.member (Json.Value.name "cmd") (Json.Value.string "ls") ]
103
+
in
101
104
let req = C.Request.permission ~tool_name:"Bash" ~input () in
102
105
match Json.encode C.Request.json req with
103
106
| Ok json -> (
···
130
133
| Error e -> Alcotest.fail (Loc.Error.to_string e)
131
134
132
135
let test_request_jsont_hook_callback () =
133
-
let input = Json.object' [] in
136
+
let input = Json.Value.object' [] in
134
137
let req = C.Request.hook_callback ~callback_id:"cb-1" ~input () in
135
138
match Json.encode C.Request.json req with
136
139
| Ok json -> (
···
142
145
| Error e -> Alcotest.fail (Loc.Error.to_string e)
143
146
144
147
let test_request_jsont_mcp_message () =
145
-
let message = Json.object' [] in
148
+
let message = Json.Value.object' [] in
146
149
let req = C.Request.mcp_message ~server_name:"tools" ~message () in
147
150
match Json.encode C.Request.json req with
148
151
| Ok json -> (
···
165
168
| Error e -> Alcotest.fail (Loc.Error.to_string e)
166
169
167
170
let test_response_success_data () =
168
-
let data = Json.string "result_data" in
171
+
let data = Json.Value.string "result_data" in
169
172
let resp = C.Response.success ~request_id:"r2" ~response:data () in
170
173
match Json.encode C.Response.json resp with
171
174
| Ok json -> (
+21
-21
test/test_mcp_server.ml
+21
-21
test/test_mcp_server.ml
···
6
6
(** Tests for Mcp_server module: creation, accessors, request handling.
7
7
Complements the tests in test_claude.ml with additional edge cases. *)
8
8
9
-
module J = Json
9
+
module J = Json.Value
10
10
11
11
let mk_tool name =
12
12
Claude.Tool.v ~name ~description:("Tool: " ^ name)
···
42
42
let req =
43
43
J.object'
44
44
[
45
-
J.mem (J.name "jsonrpc") (J.string "2.0");
46
-
J.mem (J.name "id") (J.number 1.0);
47
-
J.mem (J.name "method") (J.string "initialize");
48
-
J.mem (J.name "params") (J.object' []);
45
+
J.member (J.name "jsonrpc") (J.string "2.0");
46
+
J.member (J.name "id") (J.number 1.0);
47
+
J.member (J.name "method") (J.string "initialize");
48
+
J.member (J.name "params") (J.object' []);
49
49
]
50
50
in
51
51
let resp = Claude.Mcp_server.handle_json_message server req in
···
61
61
let req =
62
62
J.object'
63
63
[
64
-
J.mem (J.name "jsonrpc") (J.string "2.0");
65
-
J.mem (J.name "id") (J.number 1.0);
66
-
J.mem (J.name "method") (J.string "tools/list");
67
-
J.mem (J.name "params") (J.object' []);
64
+
J.member (J.name "jsonrpc") (J.string "2.0");
65
+
J.member (J.name "id") (J.number 1.0);
66
+
J.member (J.name "method") (J.string "tools/list");
67
+
J.member (J.name "params") (J.object' []);
68
68
]
69
69
in
70
70
let resp = Claude.Mcp_server.handle_json_message server req in
···
97
97
let req =
98
98
J.object'
99
99
[
100
-
J.mem (J.name "jsonrpc") (J.string "2.0");
101
-
J.mem (J.name "id") (J.number 1.0);
102
-
J.mem (J.name "method") (J.string "tools/call");
103
-
J.mem (J.name "params")
100
+
J.member (J.name "jsonrpc") (J.string "2.0");
101
+
J.member (J.name "id") (J.number 1.0);
102
+
J.member (J.name "method") (J.string "tools/call");
103
+
J.member (J.name "params")
104
104
(J.object'
105
105
[
106
-
J.mem (J.name "name") (J.string "add");
107
-
J.mem (J.name "arguments")
106
+
J.member (J.name "name") (J.string "add");
107
+
J.member (J.name "arguments")
108
108
(J.object'
109
109
[
110
-
J.mem (J.name "a") (J.number 3.0);
111
-
J.mem (J.name "b") (J.number 7.0);
110
+
J.member (J.name "a") (J.number 3.0);
111
+
J.member (J.name "b") (J.number 7.0);
112
112
]);
113
113
]);
114
114
]
···
130
130
let req =
131
131
J.object'
132
132
[
133
-
J.mem (J.name "jsonrpc") (J.string "2.0");
134
-
J.mem (J.name "id") (J.number 1.0);
135
-
J.mem (J.name "method") (J.string "completely/unknown");
136
-
J.mem (J.name "params") (J.object' []);
133
+
J.member (J.name "jsonrpc") (J.string "2.0");
134
+
J.member (J.name "id") (J.number 1.0);
135
+
J.member (J.name "method") (J.string "completely/unknown");
136
+
J.member (J.name "params") (J.object' []);
137
137
]
138
138
in
139
139
let resp = Claude.Mcp_server.handle_json_message server req in
+1
-1
test/test_message.ml
+1
-1
test/test_message.ml
···
28
28
| _ -> Alcotest.fail "Expected Text block"
29
29
30
30
let test_user_with_tool_result () =
31
-
let content = Json.string "result data" in
31
+
let content = Json.Value.string "result data" in
32
32
let u =
33
33
M.User.with_tool_result ~tool_use_id:"tu-1" ~content ~is_error:false ()
34
34
in
+8
-8
test/test_structured_output.ml
+8
-8
test/test_structured_output.ml
···
6
6
(** Tests for Structured_output: creation, accessors, JSON roundtrip. *)
7
7
8
8
module SO = Claude.Structured_output
9
-
module J = Json
9
+
module J = Json.Value
10
10
11
11
let mk_schema () =
12
12
J.object'
13
13
[
14
-
J.mem (J.name "type") (J.string "object");
15
-
J.mem (J.name "properties")
14
+
J.member (J.name "type") (J.string "object");
15
+
J.member (J.name "properties")
16
16
(J.object'
17
17
[
18
-
J.mem (J.name "name")
19
-
(J.object' [ J.mem (J.name "type") (J.string "string") ]);
18
+
J.member (J.name "name")
19
+
(J.object' [ J.member (J.name "type") (J.string "string") ]);
20
20
]);
21
-
J.mem (J.name "required") (J.list [ J.string "name" ]);
21
+
J.member (J.name "required") (J.list [ J.string "name" ]);
22
22
]
23
23
24
24
let test_of_json_schema () =
···
39
39
| _ -> Alcotest.fail "Expected object schema after roundtrip"
40
40
41
41
let test_jsont_encode_decode () =
42
-
let schema = J.object' [ J.mem (J.name "type") (J.string "string") ] in
42
+
let schema = J.object' [ J.member (J.name "type") (J.string "string") ] in
43
43
let so = SO.of_json_schema schema in
44
44
match Json.encode SO.json so with
45
45
| Ok json -> (
···
52
52
| Error e -> Alcotest.fail (Loc.Error.to_string e)
53
53
54
54
let test_simple_string_schema () =
55
-
let schema = J.object' [ J.mem (J.name "type") (J.string "string") ] in
55
+
let schema = J.object' [ J.member (J.name "type") (J.string "string") ] in
56
56
let so = SO.of_json_schema schema in
57
57
match SO.json_schema so with
58
58
| Json.Object _ -> ()
+5
-5
test/test_tool.ml
+5
-5
test/test_tool.ml
···
6
6
(** Tests for Tool module: creation, accessors, call, schema helpers.
7
7
Complements the tests already in test_claude.ml with edge cases. *)
8
8
9
-
module J = Json
9
+
module J = Json.Value
10
10
11
11
let test_tool_accessors () =
12
12
let t =
···
79
79
[
80
80
J.object'
81
81
[
82
-
J.mem (J.name "type") (J.string "text");
83
-
J.mem (J.name "text") (J.string "line1");
82
+
J.member (J.name "type") (J.string "text");
83
+
J.member (J.name "text") (J.string "line1");
84
84
];
85
85
J.object'
86
86
[
87
-
J.mem (J.name "type") (J.string "text");
88
-
J.mem (J.name "text") (J.string "line2");
87
+
J.member (J.name "type") (J.string "text");
88
+
J.member (J.name "text") (J.string "line2");
89
89
];
90
90
]))
91
91
in
+3
-3
test/test_tool_input.ml
+3
-3
test/test_tool_input.ml
···
5
5
6
6
(** Tests for Tool_input: constructors, accessors, keys, is_empty. *)
7
7
8
-
module J = Json
8
+
module J = Json.Value
9
9
10
10
let test_empty () =
11
11
let t = Claude.Tool_input.empty in
···
70
70
(Claude.Tool_input.bool t "val")
71
71
72
72
let test_of_json_roundtrip () =
73
-
let json = J.object' [ J.mem (J.name "key") (J.string "value") ] in
73
+
let json = J.object' [ J.member (J.name "key") (J.string "value") ] in
74
74
let t = Claude.Tool_input.of_json json in
75
75
Alcotest.(check (option string))
76
76
"roundtrip" (Some "value")
···
114
114
let json =
115
115
J.object'
116
116
[
117
-
J.mem (J.name "tags")
117
+
J.member (J.name "tags")
118
118
(J.list [ J.string "a"; J.string "b"; J.string "c" ]);
119
119
]
120
120
in