OCaml client library for Claude Code
claude: migrate to new Json API
- Rename [let jsont] bindings to [let json] across lib/tests/examples,
since the library is now called json (not jsont).
- Drop the [module J = Json.Json] aliases — the AST builders and meta
module sit at the top level of [Json] now.
- Replace [Json.t] used as a codec with [Json.Codec.Value.t]; Json.t is
just the AST type.
- Use [let open Json.Codec in ...] inside schema definitions so the
resulting code reads closer to the spec it encodes.
- Swap [Jsont] references for [Json.Codec] (codec combinators) or plain
[Json] (AST builders) depending on what the call site actually builds.
- Hand-build JSON Schema examples with Json.object' / Json.list / Json.mem
rather than the half-decoded GADT form that used to sit under
Json.Codec.Object.
- Codec callers now see [(_, Json.Error.t) result]; surface the structured
error via [Json.Error.to_string] at process boundaries, and introduce
[encode_or_raise] / [decode_or_raise] helpers in [client.ml] so the
only [Err.ok] call sites carry a meaningful ~msg tag.
- [Json.to_string_exn]/[of_string_exn] round-trips where the caller was
pattern-matching Ok/Error collapse to the plain form that raises (the
exn is the callers' intent; returning the error and then pattern
matching was just dead code).
+1197
-1287
+1
-1
claude.opam
+1
-1
claude.opam
+1
-1
dune-project
+1
-1
dune-project
+3
-3
examples/dune
+3
-3
examples/dune
···
1
1
(library
2
2
(name json_utils)
3
3
(modules json_utils)
4
-
(libraries jsont jsont.bytesrw))
4
+
(libraries json))
5
5
6
6
(executable
7
7
(name camel_jokes)
···
92
92
(executable
93
93
(name incoming_demo)
94
94
(modules incoming_demo)
95
-
(libraries claude jsont.bytesrw fmt))
95
+
(libraries claude fmt))
96
96
97
97
(executable
98
98
(name structured_error_demo)
99
99
(modules structured_error_demo)
100
-
(libraries claude eio_main jsont.bytesrw fmt))
100
+
(libraries claude eio_main fmt))
+10
-10
examples/incoming_demo.ml
+10
-10
examples/incoming_demo.ml
···
7
7
8
8
let test_decode_user_message () =
9
9
let json_str = {|{"type":"user","content":"Hello"}|} in
10
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
10
+
match Json.of_string Claude.Incoming.json json_str with
11
11
| Ok (Claude.Incoming.Message (Claude.Message.User _)) ->
12
12
print_endline "✓ Decoded user message successfully"
13
13
| Ok _ -> print_endline "✗ Wrong message type decoded"
14
14
| Error err ->
15
-
Fmt.pr "✗ Failed to decode user message: %s\n" (Jsont.Error.to_string err)
15
+
Fmt.pr "✗ Failed to decode user message: %s\n" (Json.Error.to_string err)
16
16
17
17
let test_decode_assistant_message () =
18
18
let json_str =
19
19
{|{"type":"assistant","model":"claude-sonnet-4","content":[{"type":"text","text":"Hi"}]}|}
20
20
in
21
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
21
+
match Json.of_string Claude.Incoming.json json_str with
22
22
| Ok (Claude.Incoming.Message (Claude.Message.Assistant _)) ->
23
23
print_endline "✓ Decoded assistant message successfully"
24
24
| Ok _ -> print_endline "✗ Wrong message type decoded"
25
25
| Error err ->
26
26
Fmt.pr "✗ Failed to decode assistant message: %s\n"
27
-
(Jsont.Error.to_string err)
27
+
(Json.Error.to_string err)
28
28
29
29
let test_decode_system_message () =
30
30
let json_str =
31
31
{|{"type":"system","subtype":"init","data":{"session_id":"test-123"}}|}
32
32
in
33
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
33
+
match Json.of_string Claude.Incoming.json json_str with
34
34
| Ok (Claude.Incoming.Message (Claude.Message.System _)) ->
35
35
print_endline "✓ Decoded system message successfully"
36
36
| Ok _ -> print_endline "✗ Wrong message type decoded"
37
37
| Error err ->
38
38
Fmt.pr "✗ Failed to decode system message: %s\n"
39
-
(Jsont.Error.to_string err)
39
+
(Json.Error.to_string err)
40
40
41
41
let test_decode_control_response () =
42
42
let json_str =
43
43
{|{"type":"control_response","response":{"subtype":"success","request_id":"test-req-1"}}|}
44
44
in
45
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
45
+
match Json.of_string Claude.Incoming.json json_str with
46
46
| Ok (Claude.Incoming.Control_response resp) -> (
47
47
match resp.response with
48
48
| Claude.Control.Response.Success s ->
···
54
54
| Ok _ -> print_endline "✗ Wrong message type decoded"
55
55
| Error err ->
56
56
Fmt.pr "✗ Failed to decode control response: %s\n"
57
-
(Jsont.Error.to_string err)
57
+
(Json.Error.to_string err)
58
58
59
59
let test_decode_control_response_error () =
60
60
let json_str =
61
61
{|{"type":"control_response","response":{"subtype":"error","request_id":"test-req-2","error":{"code":-32603,"message":"Something went wrong"}}}|}
62
62
in
63
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
63
+
match Json.of_string Claude.Incoming.json json_str with
64
64
| Ok (Claude.Incoming.Control_response resp) -> (
65
65
match resp.response with
66
66
| Claude.Control.Response.Error e ->
···
75
75
| Ok _ -> print_endline "✗ Wrong message type decoded"
76
76
| Error err ->
77
77
Fmt.pr "✗ Failed to decode control error response: %s\n"
78
-
(Jsont.Error.to_string err)
78
+
(Json.Error.to_string err)
79
79
80
80
let () =
81
81
print_endline "Testing Incoming message codec...";
+13
-17
examples/json_utils.ml
+13
-17
examples/json_utils.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(* Helper functions for JSON operations in tests using jsont codecs *)
7
-
8
6
let to_string ?(minify = false) json =
9
-
let format = if minify then Jsont.Minify else Jsont.Indent in
10
-
match Jsont_bytesrw.encode_string' ~format Jsont.json json with
11
-
| Ok s -> s
12
-
| Error err -> Jsont.Error.to_string err
7
+
let format = if minify then Json.Minify else Json.Indent in
8
+
Json.Value.to_string ~format json
13
9
14
-
(* Helper to decode an optional field with a given codec *)
15
-
let find (type a) (codec : a Jsont.t) json key : a option =
10
+
let find (type a) (codec : a Json.codec) json key : a option =
16
11
let field_codec =
17
-
Jsont.Object.map ~kind:"field" (fun v -> v)
18
-
|> Jsont.Object.opt_mem key codec ~enc:Fun.id
19
-
|> Jsont.Object.finish
12
+
let open Json.Codec in
13
+
Object.map ~kind:"field" (fun v -> v)
14
+
|> Object.opt_mem key codec ~enc:Fun.id
15
+
|> Object.finish
20
16
in
21
-
match Jsont.Json.decode field_codec json with Ok v -> v | Error _ -> None
17
+
match Json.decode field_codec json with Ok v -> v | Error _ -> None
22
18
23
-
let string json key = find Jsont.string json key
24
-
let int json key = find Jsont.int json key
25
-
let bool json key = find Jsont.bool json key
26
-
let array json key = find (Jsont.list Jsont.json) json key
19
+
let string json key = find Json.Codec.string json key
20
+
let int json key = find Json.Codec.int json key
21
+
let bool json key = find Json.Codec.bool json key
22
+
let array json key = find (Json.Codec.list Json.Codec.Value.t) json key
27
23
28
24
let as_string json =
29
-
match Jsont.Json.decode Jsont.string json with
25
+
match Json.decode Json.Codec.string json with
30
26
| Ok s -> Some s
31
27
| Error _ -> None
+7
-7
examples/json_utils.mli
+7
-7
examples/json_utils.mli
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(** Helper functions for JSON operations in examples using jsont codecs. *)
6
+
(** Helper functions for JSON operations in examples using json codecs. *)
7
7
8
-
val to_string : ?minify:bool -> Jsont.json -> string
8
+
val to_string : ?minify:bool -> Json.t -> string
9
9
(** Encode JSON to string. *)
10
10
11
-
val string : Jsont.json -> string -> string option
11
+
val string : Json.t -> string -> string option
12
12
(** [string json key] extracts a string field. *)
13
13
14
-
val int : Jsont.json -> string -> int option
14
+
val int : Json.t -> string -> int option
15
15
(** [int json key] extracts an integer field. *)
16
16
17
-
val bool : Jsont.json -> string -> bool option
17
+
val bool : Json.t -> string -> bool option
18
18
(** [bool json key] extracts a boolean field. *)
19
19
20
-
val array : Jsont.json -> string -> Jsont.json list option
20
+
val array : Json.t -> string -> Json.t list option
21
21
(** [array json key] extracts an array field. *)
22
22
23
-
val as_string : Jsont.json -> string option
23
+
val as_string : Json.t -> string option
24
24
(** [as_string json] decodes JSON as a string value. *)
+1
-6
examples/simple_permission_test.ml
+1
-6
examples/simple_permission_test.ml
···
46
46
Log.app (fun m -> m "\n⚠️ Tool result error for %s:" tool_use_id);
47
47
match Claude.Content_block.Tool_result.content r with
48
48
| Some json ->
49
-
let s =
50
-
match Jsont_bytesrw.encode_string' Jsont.json json with
51
-
| Ok str -> str
52
-
| Error _ -> "<encoding error>"
53
-
in
54
-
Log.app (fun m -> m " %s" s)
49
+
Log.app (fun m -> m " %s" (Json.Value.to_string json))
55
50
| None -> ()
56
51
end
57
52
| Claude.Response.Complete result ->
+6
-19
examples/simulated_permissions.ml
+6
-19
examples/simulated_permissions.ml
···
107
107
List.iter
108
108
(fun tool_name ->
109
109
let input =
110
-
let open Jsont in
111
-
Object
112
-
( [
113
-
(("file_path", Meta.none), String ("/example/path.txt", Meta.none));
114
-
],
115
-
Meta.none )
110
+
Json.object'
111
+
[ Json.mem (Json.name "file_path") (Json.string "/example/path.txt") ]
116
112
in
117
113
let tool_input = Claude.Tool_input.of_json input in
118
114
let ctx =
···
145
141
let callback = Claude.Permissions.discovery discovered in
146
142
147
143
(* Simulate some tool requests *)
144
+
let obj k v = Json.object' [ Json.mem (Json.name k) (Json.string v) ] in
148
145
let requests =
149
-
let open Jsont in
150
146
[
151
-
( "Read",
152
-
Object
153
-
( [ (("file_path", Meta.none), String ("test.ml", Meta.none)) ],
154
-
Meta.none ) );
155
-
( "Bash",
156
-
Object
157
-
([ (("command", Meta.none), String ("ls -la", Meta.none)) ], Meta.none)
158
-
);
159
-
( "Write",
160
-
Object
161
-
( [ (("file_path", Meta.none), String ("output.txt", Meta.none)) ],
162
-
Meta.none ) );
147
+
("Read", obj "file_path" "test.ml");
148
+
("Bash", obj "command" "ls -la");
149
+
("Write", obj "file_path" "output.txt");
163
150
]
164
151
in
165
152
+17
-34
examples/structured_error_demo.ml
+17
-34
examples/structured_error_demo.ml
···
29
29
Claude.Control.Response.error ~request_id:"test-123" ~error:error2 ()
30
30
in
31
31
32
-
match Jsont.Json.encode Claude.Control.Response.jsont error_resp with
32
+
match Json.encode Claude.Control.Response.json error_resp with
33
33
| Ok json -> (
34
-
let json_str =
35
-
match Jsont_bytesrw.encode_string' Jsont.json json with
36
-
| Ok s -> s
37
-
| Error e -> Jsont.Error.to_string e
38
-
in
34
+
let json_str = Json.Value.to_string json in
39
35
Fmt.pr "✓ Encoded error response: %s\n" json_str;
40
36
41
37
(* Decode it back *)
42
-
match Jsont.Json.decode Claude.Control.Response.jsont json with
38
+
match Json.decode Claude.Control.Response.json json with
43
39
| Ok (Claude.Control.Response.Error decoded) ->
44
40
Fmt.pr "✓ Decoded error: [%d] %s\n" decoded.error.code
45
41
decoded.error.message
46
42
| Ok _ -> print_endline "✗ Wrong response type"
47
-
| Error e -> Fmt.pr "✗ Decode failed: %s\n" e)
48
-
| Error e -> Fmt.pr "✗ Encode failed: %s\n" e
43
+
| Error e -> Fmt.pr "✗ Decode failed: %s\n" (Json.Error.to_string e))
44
+
| Error e -> Fmt.pr "✗ Encode failed: %s\n" (Json.Error.to_string e)
49
45
50
46
let test_error_code_conventions () =
51
47
print_endline "\nTesting JSON-RPC error code conventions...";
···
143
139
Claude.Control.Response.error_detail ~code:`Invalid_params
144
140
~message:"Invalid params for permission request"
145
141
~data:
146
-
(Jsont.Object
147
-
( [
148
-
( ("tool_name", Jsont.Meta.none),
149
-
Jsont.String ("Write", Jsont.Meta.none) );
150
-
( ("reason", Jsont.Meta.none),
151
-
Jsont.String
152
-
("Missing required file_path parameter", Jsont.Meta.none) );
153
-
],
154
-
Jsont.Meta.none ))
142
+
(Json.object'
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");
147
+
])
155
148
()
156
149
in
157
150
···
160
153
()
161
154
in
162
155
163
-
match Jsont.Json.encode Claude.Control.Response.jsont error_response with
156
+
match Json.encode Claude.Control.Response.json error_response with
164
157
| Ok json -> (
165
-
let json_str =
166
-
match Jsont_bytesrw.encode_string' Jsont.json json with
167
-
| Ok s -> s
168
-
| Error e -> Jsont.Error.to_string e
169
-
in
158
+
let json_str = Json.Value.to_string json in
170
159
Fmt.pr "✓ Encoded control error with data:\n %s\n" json_str;
171
160
172
161
(* Verify we can decode it back *)
173
-
match Jsont.Json.decode Claude.Control.Response.jsont json with
162
+
match Json.decode Claude.Control.Response.json json with
174
163
| Ok (Claude.Control.Response.Error decoded) -> (
175
164
Fmt.pr "✓ Decoded control error:\n";
176
165
Fmt.pr " Code: %d\n" decoded.error.code;
177
166
Fmt.pr " Message: %s\n" decoded.error.message;
178
167
Fmt.pr " Has data: %b\n" (Option.is_some decoded.error.data);
179
168
match decoded.error.data with
180
-
| Some data ->
181
-
let data_str =
182
-
match Jsont_bytesrw.encode_string' Jsont.json data with
183
-
| Ok s -> s
184
-
| Error e -> Jsont.Error.to_string e
185
-
in
186
-
Fmt.pr " Data: %s\n" data_str
169
+
| Some data -> Fmt.pr " Data: %s\n" (Json.Value.to_string data)
187
170
| None -> ())
188
171
| Ok _ -> print_endline "✗ Wrong response type"
189
-
| Error e -> Fmt.pr "✗ Decode failed: %s\n" e)
190
-
| Error e -> Fmt.pr "✗ Encode failed: %s\n" e
172
+
| Error e -> Fmt.pr "✗ Decode failed: %s\n" (Json.Error.to_string e))
173
+
| Error e -> Fmt.pr "✗ Encode failed: %s\n" (Json.Error.to_string e)
191
174
192
175
let process_hook_responses messages =
193
176
let hook_called = ref false in
+49
-66
examples/structured_output_demo.ml
+49
-66
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
-
let open Jsont in
18
-
Object
19
-
( [
20
-
(("type", Meta.none), String (typ, Meta.none));
21
-
(("description", Meta.none), String (desc, Meta.none));
22
-
],
23
-
Meta.none )
17
+
Json.object'
18
+
[
19
+
Json.mem (Json.name "type") (Json.string typ);
20
+
Json.mem (Json.name "description") (Json.string desc);
21
+
]
24
22
25
23
let complexity_rating_prop =
26
-
let open Jsont in
27
-
Object
28
-
( [
29
-
(("type", Meta.none), String ("string", Meta.none));
30
-
( ("enum", Meta.none),
31
-
Array
32
-
( [
33
-
String ("low", Meta.none);
34
-
String ("medium", Meta.none);
35
-
String ("high", Meta.none);
36
-
],
37
-
Meta.none ) );
38
-
( ("description", Meta.none),
39
-
String ("Overall complexity rating", Meta.none) );
40
-
],
41
-
Meta.none )
24
+
Json.object'
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");
32
+
]
42
33
43
34
let key_findings_prop =
44
-
let open Jsont in
45
-
Object
46
-
( [
47
-
(("type", Meta.none), String ("array", Meta.none));
48
-
( ("items", Meta.none),
49
-
Object
50
-
([ (("type", Meta.none), String ("string", Meta.none)) ], Meta.none)
51
-
);
52
-
( ("description", Meta.none),
53
-
String ("List of key findings from the analysis", Meta.none) );
54
-
],
55
-
Meta.none )
35
+
Json.object'
36
+
[
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
+
]
56
43
57
44
let analysis_properties =
58
-
let open Jsont in
59
-
Object
60
-
( [
61
-
( ("file_count", Meta.none),
62
-
typed_prop "integer" "Total number of files analyzed" );
63
-
( ("has_tests", Meta.none),
64
-
typed_prop "boolean" "Whether the codebase has test files" );
65
-
( ("primary_language", Meta.none),
66
-
typed_prop "string" "The primary programming language used" );
67
-
(("complexity_rating", Meta.none), complexity_rating_prop);
68
-
(("key_findings", Meta.none), key_findings_prop);
69
-
],
70
-
Meta.none )
45
+
Json.object'
46
+
[
47
+
Json.mem (Json.name "file_count")
48
+
(typed_prop "integer" "Total number of files analyzed");
49
+
Json.mem (Json.name "has_tests")
50
+
(typed_prop "boolean" "Whether the codebase has test files");
51
+
Json.mem
52
+
(Json.name "primary_language")
53
+
(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;
56
+
]
71
57
72
58
let analysis_schema =
73
-
let open Jsont in
74
-
Object
75
-
( [
76
-
(("type", Meta.none), String ("object", Meta.none));
77
-
(("properties", Meta.none), analysis_properties);
78
-
( ("required", Meta.none),
79
-
Array
80
-
( [
81
-
String ("file_count", Meta.none);
82
-
String ("has_tests", Meta.none);
83
-
String ("primary_language", Meta.none);
84
-
String ("complexity_rating", Meta.none);
85
-
String ("key_findings", Meta.none);
86
-
],
87
-
Meta.none ) );
88
-
(("additionalProperties", Meta.none), Bool (false, Meta.none));
89
-
],
90
-
Meta.none )
59
+
Json.object'
60
+
[
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
65
+
[
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";
71
+
]);
72
+
Json.mem (Json.name "additionalProperties") (Json.bool false);
73
+
]
91
74
92
75
let display_parsed_analysis output =
93
76
Fmt.pr "\n=== Structured Output ===\n";
+15
-31
examples/structured_output_simple.ml
+15
-31
examples/structured_output_simple.ml
···
12
12
Logs.set_level (Some Logs.Info)
13
13
14
14
let person_schema =
15
-
let open Jsont in
16
-
Object
17
-
( [
18
-
(("type", Meta.none), String ("object", Meta.none));
19
-
( ("properties", Meta.none),
20
-
Object
21
-
( [
22
-
( ("name", Meta.none),
23
-
Object
24
-
( [ (("type", Meta.none), String ("string", Meta.none)) ],
25
-
Meta.none ) );
26
-
( ("age", Meta.none),
27
-
Object
28
-
( [ (("type", Meta.none), String ("integer", Meta.none)) ],
29
-
Meta.none ) );
30
-
( ("occupation", Meta.none),
31
-
Object
32
-
( [ (("type", Meta.none), String ("string", Meta.none)) ],
33
-
Meta.none ) );
34
-
],
35
-
Meta.none ) );
36
-
( ("required", Meta.none),
37
-
Array
38
-
( [
39
-
String ("name", Meta.none);
40
-
String ("age", Meta.none);
41
-
String ("occupation", Meta.none);
42
-
],
43
-
Meta.none ) );
44
-
],
45
-
Meta.none )
15
+
let typ t = Json.object' [ Json.mem (Json.name "type") (Json.string t) ] in
16
+
Json.object'
17
+
[
18
+
Json.mem (Json.name "type") (Json.string "object");
19
+
Json.mem (Json.name "properties")
20
+
(Json.object'
21
+
[
22
+
Json.mem (Json.name "name") (typ "string");
23
+
Json.mem (Json.name "age") (typ "integer");
24
+
Json.mem (Json.name "occupation") (typ "string");
25
+
]);
26
+
Json.mem (Json.name "required")
27
+
(Json.list
28
+
[ Json.string "name"; Json.string "age"; Json.string "occupation" ]);
29
+
]
46
30
47
31
let simple_example env =
48
32
Fmt.pr "\n=== Simple Structured Output Example ===\n\n";
+50
-48
lib/client.ml
+50
-48
lib/client.ml
···
7
7
8
8
module Log = (val Logs.src_log src : Logs.LOG)
9
9
10
+
let encode_or_raise ~msg codec v =
11
+
Json.encode codec v |> Result.map_error Json.Error.to_string |> Err.ok ~msg
12
+
10
13
(** Control response builders using Control codecs *)
11
14
module Control_response = struct
12
15
let success ~request_id ~response =
13
16
let resp = Control.Response.success ~request_id ?response () in
14
17
let ctrl = Control.response ~response:resp () in
15
-
Jsont.Json.encode Control.jsont ctrl
16
-
|> Err.ok ~msg:"Control_response.success: "
18
+
encode_or_raise ~msg:"Control_response.success: " Control.json ctrl
17
19
18
20
let error ~request_id ~code ~message ?data () =
19
21
let error_detail = Control.Response.error_detail ~code ~message ?data () in
20
22
let resp = Control.Response.error ~request_id ~error:error_detail () in
21
23
let ctrl = Control.response ~response:resp () in
22
-
Jsont.Json.encode Control.jsont ctrl
23
-
|> Err.ok ~msg:"Control_response.error: "
24
+
encode_or_raise ~msg:"Control_response.error: " Control.json ctrl
24
25
end
25
26
26
-
(* Helper functions for JSON manipulation using jsont *)
27
-
let json_to_string json =
28
-
Jsont_bytesrw.encode_string' Jsont.json json
29
-
|> Result.map_error Jsont.Error.to_string
30
-
|> Err.ok ~msg:""
27
+
let json_to_string json = Json.Value.to_string json
31
28
32
29
(** Wire-level codec for hook matcher configuration sent to CLI. *)
33
30
module Hook_matcher_wire = struct
34
31
type t = { matcher : string option; hook_callback_ids : string list }
35
32
36
-
let jsont : t Jsont.t =
33
+
let json : t Json.codec =
37
34
let make matcher hook_callback_ids = { matcher; hook_callback_ids } in
38
-
Jsont.Object.map ~kind:"HookMatcherWire" make
39
-
|> Jsont.Object.opt_mem "matcher" Jsont.string ~enc:(fun r -> r.matcher)
40
-
|> Jsont.Object.mem "hookCallbackIds" (Jsont.list Jsont.string)
41
-
~enc:(fun r -> r.hook_callback_ids)
42
-
|> Jsont.Object.finish
35
+
Json.Codec.Object.map ~kind:"HookMatcherWire" make
36
+
|> Json.Codec.Object.opt_mem "matcher" Json.Codec.string ~enc:(fun r ->
37
+
r.matcher)
38
+
|> Json.Codec.Object.mem "hookCallbackIds"
39
+
(Json.Codec.list Json.Codec.string) ~enc:(fun r -> r.hook_callback_ids)
40
+
|> Json.Codec.Object.finish
43
41
44
42
let encode matchers =
45
43
List.map
46
44
(fun m ->
47
-
Jsont.Json.encode jsont m |> Err.ok ~msg:"Hook_matcher_wire.encode: ")
45
+
Json.encode json m
46
+
|> Result.map_error Json.Error.to_string
47
+
|> Err.ok ~msg:"Hook_matcher_wire.encode: ")
48
48
matchers
49
-
|> Jsont.Json.list
49
+
|> Json.list
50
50
end
51
51
52
52
type t = {
53
53
transport : Transport.t;
54
54
mutable permission_callback : Permissions.callback option;
55
55
mutable permission_log : Permissions.Rule.t list ref option;
56
-
hook_callbacks : (string, Jsont.json -> Hooks.result) Hashtbl.t;
56
+
hook_callbacks : (string, Json.t -> Hooks.result) Hashtbl.t;
57
57
mutable session_id : string option;
58
-
control_responses : (string, Jsont.json) Hashtbl.t;
58
+
control_responses : (string, Json.t) Hashtbl.t;
59
59
control_mutex : Eio.Mutex.t;
60
60
control_condition : Eio.Condition.t;
61
61
clock : float Eio.Time.clock_ty Eio.Resource.t;
···
97
97
Permissions.Decision.to_proto_result ~original_input:input decision
98
98
in
99
99
let response_data =
100
-
match Jsont.Json.encode Permissions.Result.jsont lib_result with
100
+
match Json.encode Permissions.Result.json lib_result with
101
101
| Ok json -> json
102
102
| Error err ->
103
-
Log.err (fun m -> m "Failed to encode permission result: %s" err);
103
+
Log.err (fun m ->
104
+
m "Failed to encode permission result: %s"
105
+
(Json.Error.to_string err));
104
106
failwith "Permission result encoding failed"
105
107
in
106
108
let response =
···
120
122
let result = callback input in
121
123
122
124
let result_json =
123
-
Jsont.Json.encode Hooks.result_jsont result
124
-
|> Err.ok ~msg:"Failed to encode hook result: "
125
+
encode_or_raise ~msg:"Failed to encode hook result: " Hooks.result_jsont
126
+
result
125
127
in
126
128
Log.debug (fun m -> m "Hook result JSON: %s" (json_to_string result_json));
127
129
let response =
···
146
148
~message:error_msg ())
147
149
148
150
let handle_mcp_message t ~request_id (req : Control.Request.mcp_message) =
149
-
let module J = Jsont.Json in
151
+
let module J = Json in
150
152
let server_name = req.server_name in
151
153
let message = req.message in
152
154
Log.info (fun m -> m "MCP request for server '%s'" server_name);
···
214
216
215
217
(* Store the response as JSON and signal waiting threads *)
216
218
let json =
217
-
Jsont.Json.encode Control.control_response_jsont control_resp
218
-
|> Err.ok ~msg:"Failed to encode control response: "
219
+
encode_or_raise ~msg:"Failed to encode control response: "
220
+
Control.control_response_jsont control_resp
219
221
in
220
222
Eio.Mutex.use_rw ~protect:false t.control_mutex (fun () ->
221
223
Hashtbl.replace t.control_responses request_id json;
···
229
231
Log.debug (fun m -> m "Handle messages: EOF received");
230
232
Seq.Nil
231
233
| Some line -> (
232
-
(* Use unified Incoming codec for all message types *)
233
-
match Jsont_bytesrw.decode_string' Incoming.jsont line with
234
+
match Json.of_string Incoming.json line with
234
235
| Ok incoming -> Seq.Cons (incoming, loop)
235
236
| Error err ->
236
237
Log.err (fun m ->
237
238
m "Failed to decode incoming message: %s\nLine: %s"
238
-
(Jsont.Error.to_string err)
239
-
line);
239
+
(Json.Error.to_string err) line);
240
240
loop ())
241
241
in
242
242
Log.debug (fun m -> m "Starting message handler");
···
309
309
let request = Control.Request.initialize ~hooks:hooks_list () in
310
310
let ctrl_req = Control.request ~request_id:"init_hooks" ~request () in
311
311
let initialize_msg =
312
-
Jsont.Json.encode Control.jsont ctrl_req
313
-
|> Err.ok ~msg:"Failed to encode initialize request: "
312
+
encode_or_raise ~msg:"Failed to encode initialize request: "
313
+
Control.json ctrl_req
314
314
in
315
315
Log.info (fun m -> m "Sending hooks initialize request");
316
316
Transport.send t.transport initialize_msg)
···
455
455
let discovered_permissions t =
456
456
t.permission_log |> Option.map ( ! ) |> Option.value ~default:[]
457
457
458
+
let decode_or_raise ~msg codec v =
459
+
Json.decode codec v |> Result.map_error Json.Error.to_string |> Err.ok' ~msg
460
+
458
461
let decode_control_response response_json =
459
-
(* Parse the response - extract the "response" field using jsont codec *)
460
462
let response_field_codec =
461
-
Jsont.Object.map ~kind:"ResponseField" Fun.id
462
-
|> Jsont.Object.mem "response" Jsont.json ~enc:Fun.id
463
-
|> Jsont.Object.finish
463
+
let open Json.Codec in
464
+
Object.map ~kind:"ResponseField" Fun.id
465
+
|> Object.mem "response" Value.t ~enc:Fun.id
466
+
|> Object.finish
464
467
in
465
468
let response_data =
466
-
Jsont.Json.decode response_field_codec response_json
467
-
|> Err.ok' ~msg:"Failed to extract response field: "
469
+
decode_or_raise ~msg:"Failed to extract response field: "
470
+
response_field_codec response_json
468
471
in
469
472
let response =
470
-
Jsont.Json.decode Control.Response.jsont response_data
471
-
|> Err.ok' ~msg:"Failed to decode response: "
473
+
decode_or_raise ~msg:"Failed to decode response: " Control.Response.json
474
+
response_data
472
475
in
473
476
match response with
474
477
| Control.Response.Success s -> s.response
···
480
483
481
484
(* Helper to send a control request and wait for response *)
482
485
let send_control_request t ~request_id request =
483
-
(* Send the control request *)
484
486
let control_msg = Control.request ~request_id ~request () in
485
487
let json =
486
-
Jsont.Json.encode Control.jsont control_msg
487
-
|> Err.ok ~msg:"Failed to encode control request: "
488
+
encode_or_raise ~msg:"Failed to encode control request: " Control.json
489
+
control_msg
488
490
in
489
491
Log.info (fun m -> m "Sending control request: %s" (json_to_string json));
490
492
Transport.send t.transport json;
···
542
544
|> Err.ok ~msg:""
543
545
in
544
546
let server_info =
545
-
Jsont.Json.decode Control.Server_info.jsont response_data
546
-
|> Err.ok' ~msg:"Failed to decode server info: "
547
+
decode_or_raise ~msg:"Failed to decode server info: "
548
+
Control.Server_info.json response_data
547
549
in
548
550
Log.info (fun m ->
549
551
m "Retrieved server info: %a"
550
-
(Jsont.pp_value Control.Server_info.jsont ())
552
+
(Json.pp_value Control.Server_info.json ())
551
553
server_info);
552
554
Server_info.of_control server_info
553
555
···
560
562
561
563
let send_raw t control =
562
564
let json =
563
-
Jsont.Json.encode Control.jsont control
564
-
|> Err.ok ~msg:"Failed to encode control message: "
565
+
encode_or_raise ~msg:"Failed to encode control message: " Control.json
566
+
control
565
567
in
566
568
Log.info (fun m -> m "→ Raw control: %s" (json_to_string json));
567
569
Transport.send t.transport json
+5
-10
lib/client.mli
+5
-10
lib/client.mli
···
81
81
{!Advanced.send_message} instead. *)
82
82
83
83
val respond_to_tool :
84
-
t ->
85
-
tool_use_id:string ->
86
-
content:Jsont.json ->
87
-
?is_error:bool ->
88
-
unit ->
89
-
unit
84
+
t -> tool_use_id:string -> content:Json.t -> ?is_error:bool -> unit -> unit
90
85
(** [respond_to_tool t ~tool_use_id ~content ?is_error ()] responds to a tool
91
86
use request.
92
87
···
99
94
The result content (can be a string or array of content blocks)
100
95
@param is_error Whether this is an error response (default: false). *)
101
96
102
-
val respond_to_tools : t -> (string * Jsont.json * bool option) list -> unit
97
+
val respond_to_tools : t -> (string * Json.t * bool option) list -> unit
103
98
(** [respond_to_tools t responses] responds to multiple tool use requests at
104
99
once.
105
100
···
113
108
{[
114
109
Client.respond_to_tools client
115
110
[
116
-
("tool_use_123", Jsont.string "Success", None);
117
-
("tool_use_456", Jsont.string "Error occurred", Some true);
111
+
("tool_use_123", Json.string "Success", None);
112
+
("tool_use_456", Json.string "Error occurred", Some true);
118
113
]
119
114
]} *)
120
115
···
304
299
This is for advanced use cases that need direct control protocol access.
305
300
*)
306
301
307
-
val send_json : t -> Jsont.json -> unit
302
+
val send_json : t -> Json.t -> unit
308
303
(** [send_json t json] sends raw JSON to Claude.
309
304
310
305
This is the lowest-level send operation. Use with caution. *)
+46
-51
lib/content_block.ml
+46
-51
lib/content_block.ml
···
15
15
let text t = t.text
16
16
let unknown t = t.unknown
17
17
18
-
let jsont : t Jsont.t =
19
-
Jsont.Object.map ~kind:"Text" make
20
-
|> Jsont.Object.mem "text" Jsont.string ~enc:text
21
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
22
-
|> Jsont.Object.finish
18
+
let json : t Json.codec =
19
+
let open Json.Codec in
20
+
Object.map ~kind:"Text" make
21
+
|> Object.mem "text" string ~enc:text
22
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
23
+
|> Object.finish
23
24
end
24
25
25
26
module Tool_use = struct
26
-
type t = {
27
-
id : string;
28
-
name : string;
29
-
input : Jsont.json;
30
-
unknown : Unknown.t;
31
-
}
27
+
type t = { id : string; name : string; input : Json.t; unknown : Unknown.t }
32
28
33
29
let create ~id ~name ~input = { id; name; input; unknown = Unknown.empty }
34
30
let make id name input unknown = { id; name; input; unknown }
···
37
33
let input t = Tool_input.of_json t.input
38
34
let unknown t = t.unknown
39
35
40
-
let jsont : t Jsont.t =
41
-
Jsont.Object.map ~kind:"Tool_use" make
42
-
|> Jsont.Object.mem "id" Jsont.string ~enc:id
43
-
|> Jsont.Object.mem "name" Jsont.string ~enc:name
44
-
|> Jsont.Object.mem "input" Jsont.json ~enc:(fun t -> t.input)
45
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
46
-
|> Jsont.Object.finish
36
+
let json : t Json.codec =
37
+
let open Json.Codec in
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)
42
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
43
+
|> Object.finish
47
44
end
48
45
49
46
module Tool_result = struct
50
47
type t = {
51
48
tool_use_id : string;
52
-
content : Jsont.json option;
49
+
content : Json.t option;
53
50
is_error : bool option;
54
51
unknown : Unknown.t;
55
52
}
···
65
62
let is_error t = t.is_error
66
63
let unknown t = t.unknown
67
64
68
-
let jsont : t Jsont.t =
69
-
Jsont.Object.map ~kind:"Tool_result" make
70
-
|> Jsont.Object.mem "tool_use_id" Jsont.string ~enc:tool_use_id
71
-
|> Jsont.Object.opt_mem "content" Jsont.json ~enc:content
72
-
|> Jsont.Object.opt_mem "is_error" Jsont.bool ~enc:is_error
73
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
74
-
|> Jsont.Object.finish
65
+
let json : t Json.codec =
66
+
let open Json.Codec in
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
71
+
|> Object.keep_unknown Unknown.mems ~enc:unknown
72
+
|> Object.finish
75
73
end
76
74
77
75
module Thinking = struct
···
85
83
let signature t = t.signature
86
84
let unknown t = t.unknown
87
85
88
-
let jsont : t Jsont.t =
89
-
Jsont.Object.map ~kind:"Thinking" make
90
-
|> Jsont.Object.mem "thinking" Jsont.string ~enc:thinking
91
-
|> Jsont.Object.mem "signature" Jsont.string ~enc:signature
92
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
93
-
|> Jsont.Object.finish
86
+
let json : t Json.codec =
87
+
Json.Codec.Object.map ~kind:"Thinking" make
88
+
|> Json.Codec.Object.mem "thinking" Json.Codec.string ~enc:thinking
89
+
|> Json.Codec.Object.mem "signature" Json.Codec.string ~enc:signature
90
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
91
+
|> Json.Codec.Object.finish
94
92
end
95
93
96
94
type t =
···
110
108
let thinking ~thinking ~signature =
111
109
Thinking (Thinking.create ~thinking ~signature)
112
110
113
-
let jsont : t Jsont.t =
114
-
let case_map kind obj dec = Jsont.Object.Case.map kind obj ~dec in
115
-
let case_text = case_map "text" Text.jsont (fun v -> Text v) in
116
-
let case_tool_use =
117
-
case_map "tool_use" Tool_use.jsont (fun v -> Tool_use v)
118
-
in
111
+
let json : t Json.codec =
112
+
let open Json.Codec in
113
+
let case_map kind obj dec = Object.Case.map kind obj ~dec in
114
+
let case_text = case_map "text" Text.json (fun v -> Text v) in
115
+
let case_tool_use = case_map "tool_use" Tool_use.json (fun v -> Tool_use v) in
119
116
let case_tool_result =
120
-
case_map "tool_result" Tool_result.jsont (fun v -> Tool_result v)
121
-
in
122
-
let case_thinking =
123
-
case_map "thinking" Thinking.jsont (fun v -> Thinking v)
117
+
case_map "tool_result" Tool_result.json (fun v -> Tool_result v)
124
118
in
119
+
let case_thinking = case_map "thinking" Thinking.json (fun v -> Thinking v) in
125
120
let enc_case = function
126
-
| Text v -> Jsont.Object.Case.value case_text v
127
-
| Tool_use v -> Jsont.Object.Case.value case_tool_use v
128
-
| Tool_result v -> Jsont.Object.Case.value case_tool_result v
129
-
| Thinking v -> Jsont.Object.Case.value case_thinking v
121
+
| Text v -> Object.Case.value case_text v
122
+
| Tool_use v -> Object.Case.value case_tool_use v
123
+
| Tool_result v -> Object.Case.value case_tool_result v
124
+
| Thinking v -> Object.Case.value case_thinking v
130
125
in
131
126
let cases =
132
-
Jsont.Object.Case.
127
+
Object.Case.
133
128
[
134
129
make case_text;
135
130
make case_tool_use;
···
137
132
make case_thinking;
138
133
]
139
134
in
140
-
Jsont.Object.map ~kind:"Content_block" Fun.id
141
-
|> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
135
+
Object.map ~kind:"Content_block" Fun.id
136
+
|> Object.case_mem "type" string ~enc:Fun.id ~enc_case cases
142
137
~tag_to_string:Fun.id ~tag_compare:String.compare
143
-
|> Jsont.Object.finish
138
+
|> Object.finish
144
139
145
-
let pp ppf t = Jsont.pp_value jsont () ppf t
140
+
let pp ppf t = Json.pp_value json () ppf t
146
141
let log_received t = Log.debug (fun m -> m "Received content block: %a" pp t)
147
142
let log_sending t = Log.debug (fun m -> m "Sending content block: %a" pp t)
+9
-9
lib/content_block.mli
+9
-9
lib/content_block.mli
···
16
16
val create : string -> t
17
17
val text : t -> string
18
18
val unknown : t -> Unknown.t
19
-
val jsont : t Jsont.t
19
+
val json : t Json.codec
20
20
end
21
21
22
22
(** {1 Tool Use Blocks} *)
···
24
24
module Tool_use : sig
25
25
type t
26
26
27
-
val create : id:string -> name:string -> input:Jsont.json -> t
27
+
val create : id:string -> name:string -> input:Json.t -> t
28
28
val id : t -> string
29
29
val name : t -> string
30
30
···
32
32
(** [input t] returns the tool input as a typed {!Tool_input.t}. *)
33
33
34
34
val unknown : t -> Unknown.t
35
-
val jsont : t Jsont.t
35
+
val json : t Json.codec
36
36
end
37
37
38
38
(** {1 Tool Result Blocks} *)
···
41
41
type t
42
42
43
43
val create :
44
-
tool_use_id:string -> ?content:Jsont.json -> ?is_error:bool -> unit -> t
44
+
tool_use_id:string -> ?content:Json.t -> ?is_error:bool -> unit -> t
45
45
46
46
val tool_use_id : t -> string
47
-
val content : t -> Jsont.json option
47
+
val content : t -> Json.t option
48
48
val is_error : t -> bool option
49
49
val unknown : t -> Unknown.t
50
-
val jsont : t Jsont.t
50
+
val json : t Json.codec
51
51
end
52
52
53
53
(** {1 Thinking Blocks} *)
···
59
59
val thinking : t -> string
60
60
val signature : t -> string
61
61
val unknown : t -> Unknown.t
62
-
val jsont : t Jsont.t
62
+
val json : t Json.codec
63
63
end
64
64
65
65
(** {1 Content Block Union Type} *)
···
78
78
val tool_use : id:string -> name:string -> input:Tool_input.t -> t
79
79
80
80
val tool_result :
81
-
tool_use_id:string -> ?content:Jsont.json -> ?is_error:bool -> unit -> t
81
+
tool_use_id:string -> ?content:Json.t -> ?is_error:bool -> unit -> t
82
82
83
83
val thinking : thinking:string -> signature:string -> t
84
-
val jsont : t Jsont.t
84
+
val json : t Json.codec
85
85
86
86
(** {1 Logging} *)
87
87
+164
-154
lib/control.ml
+164
-154
lib/control.ml
···
13
13
type permission = {
14
14
subtype : [ `Can_use_tool ];
15
15
tool_name : string;
16
-
input : Jsont.json;
16
+
input : Json.t;
17
17
permission_suggestions : Permissions.Update.t list option;
18
18
blocked_path : string option;
19
19
unknown : Unknown.t;
···
21
21
22
22
type initialize = {
23
23
subtype : [ `Initialize ];
24
-
hooks : (string * Jsont.json) list option;
24
+
hooks : (string * Json.t) list option;
25
25
unknown : Unknown.t;
26
26
}
27
27
···
34
34
type hook_callback = {
35
35
subtype : [ `Hook_callback ];
36
36
callback_id : string;
37
-
input : Jsont.json;
37
+
input : Json.t;
38
38
tool_use_id : string option;
39
39
unknown : Unknown.t;
40
40
}
···
42
42
type mcp_message = {
43
43
subtype : [ `Mcp_message ];
44
44
server_name : string;
45
-
message : Jsont.json;
45
+
message : Json.t;
46
46
unknown : Unknown.t;
47
47
}
48
48
···
100
100
Get_server_info { subtype = `Get_server_info; unknown }
101
101
102
102
(* Individual record codecs *)
103
-
let interrupt_jsont : interrupt Jsont.t =
103
+
let interrupt_jsont : interrupt Json.codec =
104
104
let make (unknown : Unknown.t) : interrupt =
105
105
{ subtype = `Interrupt; unknown }
106
106
in
107
-
Jsont.Object.map ~kind:"Interrupt" make
108
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : interrupt) ->
107
+
Json.Codec.Object.map ~kind:"Interrupt" make
108
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : interrupt) ->
109
109
r.unknown)
110
-
|> Jsont.Object.finish
110
+
|> Json.Codec.Object.finish
111
111
112
-
let permission_jsont : permission Jsont.t =
112
+
let permission_jsont : permission Json.codec =
113
113
let make tool_name input permission_suggestions blocked_path
114
114
(unknown : Unknown.t) : permission =
115
115
{
···
121
121
unknown;
122
122
}
123
123
in
124
-
Jsont.Object.map ~kind:"Permission" make
125
-
|> Jsont.Object.mem "tool_name" Jsont.string ~enc:(fun (r : permission) ->
126
-
r.tool_name)
127
-
|> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : permission) ->
128
-
r.input)
129
-
|> Jsont.Object.opt_mem "permission_suggestions"
130
-
(Jsont.list Permissions.Update.jsont) ~enc:(fun (r : permission) ->
124
+
Json.Codec.Object.map ~kind:"Permission" make
125
+
|> Json.Codec.Object.mem "tool_name" Json.Codec.string
126
+
~enc:(fun (r : permission) -> r.tool_name)
127
+
|> Json.Codec.Object.mem "input" Json.Codec.Value.t
128
+
~enc:(fun (r : permission) -> r.input)
129
+
|> Json.Codec.Object.opt_mem "permission_suggestions"
130
+
(Json.Codec.list Permissions.Update.json) ~enc:(fun (r : permission) ->
131
131
r.permission_suggestions)
132
-
|> Jsont.Object.opt_mem "blocked_path" Jsont.string
132
+
|> Json.Codec.Object.opt_mem "blocked_path" Json.Codec.string
133
133
~enc:(fun (r : permission) -> r.blocked_path)
134
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : permission) ->
134
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : permission) ->
135
135
r.unknown)
136
-
|> Jsont.Object.finish
136
+
|> Json.Codec.Object.finish
137
137
138
-
let initialize_jsont : initialize Jsont.t =
138
+
let initialize_jsont : initialize Json.codec =
139
139
(* The hooks field is an object with string keys and json values *)
140
-
let hooks_map_jsont = Jsont.Object.as_string_map Jsont.json in
140
+
let hooks_map_jsont = Json.Codec.Object.as_string_map Json.Codec.Value.t in
141
141
let module StringMap = Map.Make (String) in
142
142
let hooks_jsont =
143
-
Jsont.map
143
+
Json.Codec.map
144
144
~dec:(fun m -> StringMap.bindings m)
145
145
~enc:(fun l -> StringMap.of_seq (List.to_seq l))
146
146
hooks_map_jsont
···
148
148
let make hooks (unknown : Unknown.t) : initialize =
149
149
{ subtype = `Initialize; hooks; unknown }
150
150
in
151
-
Jsont.Object.map ~kind:"Initialize" make
152
-
|> Jsont.Object.opt_mem "hooks" hooks_jsont ~enc:(fun (r : initialize) ->
153
-
r.hooks)
154
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize) ->
151
+
Json.Codec.Object.map ~kind:"Initialize" make
152
+
|> Json.Codec.Object.opt_mem "hooks" hooks_jsont
153
+
~enc:(fun (r : initialize) -> r.hooks)
154
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize) ->
155
155
r.unknown)
156
-
|> Jsont.Object.finish
156
+
|> Json.Codec.Object.finish
157
157
158
-
let set_permission_mode_jsont : set_permission_mode Jsont.t =
158
+
let set_permission_mode_jsont : set_permission_mode Json.codec =
159
159
let make mode (unknown : Unknown.t) : set_permission_mode =
160
160
{ subtype = `Set_permission_mode; mode; unknown }
161
161
in
162
-
Jsont.Object.map ~kind:"SetPermissionMode" make
163
-
|> Jsont.Object.mem "mode" Permissions.Mode.jsont
162
+
Json.Codec.Object.map ~kind:"SetPermissionMode" make
163
+
|> Json.Codec.Object.mem "mode" Permissions.Mode.json
164
164
~enc:(fun (r : set_permission_mode) -> r.mode)
165
-
|> Jsont.Object.keep_unknown Unknown.mems
165
+
|> Json.Codec.Object.keep_unknown Unknown.mems
166
166
~enc:(fun (r : set_permission_mode) -> r.unknown)
167
-
|> Jsont.Object.finish
167
+
|> Json.Codec.Object.finish
168
168
169
-
let hook_callback_jsont : hook_callback Jsont.t =
169
+
let hook_callback_jsont : hook_callback Json.codec =
170
170
let make callback_id input tool_use_id (unknown : Unknown.t) : hook_callback
171
171
=
172
172
{ subtype = `Hook_callback; callback_id; input; tool_use_id; unknown }
173
173
in
174
-
Jsont.Object.map ~kind:"HookCallback" make
175
-
|> Jsont.Object.mem "callback_id" Jsont.string
174
+
Json.Codec.Object.map ~kind:"HookCallback" make
175
+
|> Json.Codec.Object.mem "callback_id" Json.Codec.string
176
176
~enc:(fun (r : hook_callback) -> r.callback_id)
177
-
|> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : hook_callback) ->
178
-
r.input)
179
-
|> Jsont.Object.opt_mem "tool_use_id" Jsont.string
177
+
|> Json.Codec.Object.mem "input" Json.Codec.Value.t
178
+
~enc:(fun (r : hook_callback) -> r.input)
179
+
|> Json.Codec.Object.opt_mem "tool_use_id" Json.Codec.string
180
180
~enc:(fun (r : hook_callback) -> r.tool_use_id)
181
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : hook_callback) ->
182
-
r.unknown)
183
-
|> Jsont.Object.finish
181
+
|> Json.Codec.Object.keep_unknown Unknown.mems
182
+
~enc:(fun (r : hook_callback) -> r.unknown)
183
+
|> Json.Codec.Object.finish
184
184
185
-
let mcp_message_jsont : mcp_message Jsont.t =
185
+
let mcp_message_jsont : mcp_message Json.codec =
186
186
let make server_name message (unknown : Unknown.t) : mcp_message =
187
187
{ subtype = `Mcp_message; server_name; message; unknown }
188
188
in
189
-
Jsont.Object.map ~kind:"McpMessage" make
190
-
|> Jsont.Object.mem "server_name" Jsont.string
189
+
Json.Codec.Object.map ~kind:"McpMessage" make
190
+
|> Json.Codec.Object.mem "server_name" Json.Codec.string
191
191
~enc:(fun (r : mcp_message) -> r.server_name)
192
-
|> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : mcp_message) ->
193
-
r.message)
194
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : mcp_message) ->
195
-
r.unknown)
196
-
|> Jsont.Object.finish
192
+
|> Json.Codec.Object.mem "message" Json.Codec.Value.t
193
+
~enc:(fun (r : mcp_message) -> r.message)
194
+
|> Json.Codec.Object.keep_unknown Unknown.mems
195
+
~enc:(fun (r : mcp_message) -> r.unknown)
196
+
|> Json.Codec.Object.finish
197
197
198
-
let set_model_jsont : set_model Jsont.t =
198
+
let set_model_jsont : set_model Json.codec =
199
199
let make model (unknown : Unknown.t) : set_model =
200
200
{ subtype = `Set_model; model; unknown }
201
201
in
202
-
Jsont.Object.map ~kind:"SetModel" make
203
-
|> Jsont.Object.mem "model" Jsont.string ~enc:(fun (r : set_model) ->
204
-
r.model)
205
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model) ->
202
+
Json.Codec.Object.map ~kind:"SetModel" make
203
+
|> Json.Codec.Object.mem "model" Json.Codec.string
204
+
~enc:(fun (r : set_model) -> r.model)
205
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model) ->
206
206
r.unknown)
207
-
|> Jsont.Object.finish
207
+
|> Json.Codec.Object.finish
208
208
209
-
let get_server_info_jsont : get_server_info Jsont.t =
209
+
let get_server_info_jsont : get_server_info Json.codec =
210
210
let make (unknown : Unknown.t) : get_server_info =
211
211
{ subtype = `Get_server_info; unknown }
212
212
in
213
-
Jsont.Object.map ~kind:"GetServerInfo" make
214
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : get_server_info) ->
215
-
r.unknown)
216
-
|> Jsont.Object.finish
213
+
Json.Codec.Object.map ~kind:"GetServerInfo" make
214
+
|> Json.Codec.Object.keep_unknown Unknown.mems
215
+
~enc:(fun (r : get_server_info) -> r.unknown)
216
+
|> Json.Codec.Object.finish
217
217
218
218
(* Main variant codec using subtype discriminator *)
219
-
let jsont : t Jsont.t =
219
+
let json : t Json.codec =
220
220
let case_interrupt =
221
-
Jsont.Object.Case.map "interrupt" interrupt_jsont ~dec:(fun v ->
221
+
Json.Codec.Object.Case.map "interrupt" interrupt_jsont ~dec:(fun v ->
222
222
Interrupt v)
223
223
in
224
224
let case_permission =
225
-
Jsont.Object.Case.map "can_use_tool" permission_jsont ~dec:(fun v ->
225
+
Json.Codec.Object.Case.map "can_use_tool" permission_jsont ~dec:(fun v ->
226
226
Permission v)
227
227
in
228
228
let case_initialize =
229
-
Jsont.Object.Case.map "initialize" initialize_jsont ~dec:(fun v ->
229
+
Json.Codec.Object.Case.map "initialize" initialize_jsont ~dec:(fun v ->
230
230
Initialize v)
231
231
in
232
232
let case_set_permission_mode =
233
-
Jsont.Object.Case.map "set_permission_mode" set_permission_mode_jsont
233
+
Json.Codec.Object.Case.map "set_permission_mode" set_permission_mode_jsont
234
234
~dec:(fun v -> Set_permission_mode v)
235
235
in
236
236
let case_hook_callback =
237
-
Jsont.Object.Case.map "hook_callback" hook_callback_jsont ~dec:(fun v ->
238
-
Hook_callback v)
237
+
Json.Codec.Object.Case.map "hook_callback" hook_callback_jsont
238
+
~dec:(fun v -> Hook_callback v)
239
239
in
240
240
let case_mcp_message =
241
-
Jsont.Object.Case.map "mcp_message" mcp_message_jsont ~dec:(fun v ->
241
+
Json.Codec.Object.Case.map "mcp_message" mcp_message_jsont ~dec:(fun v ->
242
242
Mcp_message v)
243
243
in
244
244
let case_set_model =
245
-
Jsont.Object.Case.map "set_model" set_model_jsont ~dec:(fun v ->
245
+
Json.Codec.Object.Case.map "set_model" set_model_jsont ~dec:(fun v ->
246
246
Set_model v)
247
247
in
248
248
let case_get_server_info =
249
-
Jsont.Object.Case.map "get_server_info" get_server_info_jsont
249
+
Json.Codec.Object.Case.map "get_server_info" get_server_info_jsont
250
250
~dec:(fun v -> Get_server_info v)
251
251
in
252
252
253
253
let enc_case = function
254
-
| Interrupt v -> Jsont.Object.Case.value case_interrupt v
255
-
| Permission v -> Jsont.Object.Case.value case_permission v
256
-
| Initialize v -> Jsont.Object.Case.value case_initialize v
254
+
| Interrupt v -> Json.Codec.Object.Case.value case_interrupt v
255
+
| Permission v -> Json.Codec.Object.Case.value case_permission v
256
+
| Initialize v -> Json.Codec.Object.Case.value case_initialize v
257
257
| Set_permission_mode v ->
258
-
Jsont.Object.Case.value case_set_permission_mode v
259
-
| Hook_callback v -> Jsont.Object.Case.value case_hook_callback v
260
-
| Mcp_message v -> Jsont.Object.Case.value case_mcp_message v
261
-
| Set_model v -> Jsont.Object.Case.value case_set_model v
262
-
| Get_server_info v -> Jsont.Object.Case.value case_get_server_info v
258
+
Json.Codec.Object.Case.value case_set_permission_mode v
259
+
| Hook_callback v -> Json.Codec.Object.Case.value case_hook_callback v
260
+
| Mcp_message v -> Json.Codec.Object.Case.value case_mcp_message v
261
+
| Set_model v -> Json.Codec.Object.Case.value case_set_model v
262
+
| Get_server_info v -> Json.Codec.Object.Case.value case_get_server_info v
263
263
in
264
264
265
265
let cases =
266
-
Jsont.Object.Case.
266
+
Json.Codec.Object.Case.
267
267
[
268
268
make case_interrupt;
269
269
make case_permission;
···
276
276
]
277
277
in
278
278
279
-
Jsont.Object.map ~kind:"Request" Fun.id
280
-
|> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases
281
-
~tag_to_string:Fun.id ~tag_compare:String.compare
282
-
|> Jsont.Object.finish
279
+
Json.Codec.Object.map ~kind:"Request" Fun.id
280
+
|> Json.Codec.Object.case_mem "subtype" Json.Codec.string ~enc:Fun.id
281
+
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
282
+
|> Json.Codec.Object.finish
283
283
end
284
284
285
285
module Response = struct
···
308
308
| -32603 -> `Internal_error
309
309
| n -> `Custom n
310
310
311
-
let jsont : t Jsont.t =
312
-
Jsont.map ~kind:"ErrorCode" ~dec:of_int ~enc:to_int Jsont.int
311
+
let json : t Json.codec =
312
+
Json.Codec.map ~kind:"ErrorCode" ~dec:of_int ~enc:to_int Json.Codec.int
313
313
end
314
314
315
-
type error_detail = { code : int; message : string; data : Jsont.json option }
315
+
type error_detail = { code : int; message : string; data : Json.t option }
316
316
317
317
let error_detail ~code ~message ?data () =
318
318
{ code = Error_code.to_int code; message; data }
319
319
320
-
let error_detail_jsont : error_detail Jsont.t =
320
+
let error_detail_jsont : error_detail Json.codec =
321
321
let make code message data = { code; message; data } in
322
-
Jsont.Object.map ~kind:"ErrorDetail" make
323
-
|> Jsont.Object.mem "code" Jsont.int ~enc:(fun e -> e.code)
324
-
|> Jsont.Object.mem "message" Jsont.string ~enc:(fun e -> e.message)
325
-
|> Jsont.Object.opt_mem "data" Jsont.json ~enc:(fun e -> e.data)
326
-
|> Jsont.Object.finish
322
+
Json.Codec.Object.map ~kind:"ErrorDetail" make
323
+
|> Json.Codec.Object.mem "code" Json.Codec.int ~enc:(fun e -> e.code)
324
+
|> Json.Codec.Object.mem "message" Json.Codec.string ~enc:(fun e ->
325
+
e.message)
326
+
|> Json.Codec.Object.opt_mem "data" Json.Codec.Value.t ~enc:(fun e ->
327
+
e.data)
328
+
|> Json.Codec.Object.finish
327
329
328
330
type success = {
329
331
subtype : [ `Success ];
330
332
request_id : string;
331
-
response : Jsont.json option;
333
+
response : Json.t option;
332
334
unknown : Unknown.t;
333
335
}
334
336
···
348
350
Error { subtype = `Error; request_id; error; unknown }
349
351
350
352
(* Individual record codecs *)
351
-
let success_jsont : success Jsont.t =
353
+
let success_jsont : success Json.codec =
352
354
let make request_id response (unknown : Unknown.t) : success =
353
355
{ subtype = `Success; request_id; response; unknown }
354
356
in
355
-
Jsont.Object.map ~kind:"Success" make
356
-
|> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun (r : success) ->
357
-
r.request_id)
358
-
|> Jsont.Object.opt_mem "response" Jsont.json ~enc:(fun (r : success) ->
359
-
r.response)
360
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : success) ->
357
+
Json.Codec.Object.map ~kind:"Success" make
358
+
|> Json.Codec.Object.mem "request_id" Json.Codec.string
359
+
~enc:(fun (r : success) -> r.request_id)
360
+
|> Json.Codec.Object.opt_mem "response" Json.Codec.Value.t
361
+
~enc:(fun (r : success) -> r.response)
362
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : success) ->
361
363
r.unknown)
362
-
|> Jsont.Object.finish
364
+
|> Json.Codec.Object.finish
363
365
364
-
let error_jsont : error Jsont.t =
366
+
let error_jsont : error Json.codec =
365
367
let make request_id error (unknown : Unknown.t) : error =
366
368
{ subtype = `Error; request_id; error; unknown }
367
369
in
368
-
Jsont.Object.map ~kind:"Error" make
369
-
|> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun (r : error) ->
370
-
r.request_id)
371
-
|> Jsont.Object.mem "error" error_detail_jsont ~enc:(fun (r : error) ->
370
+
Json.Codec.Object.map ~kind:"Error" make
371
+
|> Json.Codec.Object.mem "request_id" Json.Codec.string
372
+
~enc:(fun (r : error) -> r.request_id)
373
+
|> Json.Codec.Object.mem "error" error_detail_jsont ~enc:(fun (r : error) ->
372
374
r.error)
373
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
375
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
374
376
r.unknown)
375
-
|> Jsont.Object.finish
377
+
|> Json.Codec.Object.finish
376
378
377
379
(* Main variant codec using subtype discriminator *)
378
-
let jsont : t Jsont.t =
380
+
let json : t Json.codec =
379
381
let case_success =
380
-
Jsont.Object.Case.map "success" success_jsont ~dec:(fun v -> Success v)
382
+
Json.Codec.Object.Case.map "success" success_jsont ~dec:(fun v ->
383
+
Success v)
381
384
in
382
385
let case_error =
383
-
Jsont.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
386
+
Json.Codec.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
384
387
in
385
388
386
389
let enc_case = function
387
-
| Success v -> Jsont.Object.Case.value case_success v
388
-
| Error v -> Jsont.Object.Case.value case_error v
390
+
| Success v -> Json.Codec.Object.Case.value case_success v
391
+
| Error v -> Json.Codec.Object.Case.value case_error v
389
392
in
390
393
391
-
let cases = Jsont.Object.Case.[ make case_success; make case_error ] in
394
+
let cases = Json.Codec.Object.Case.[ make case_success; make case_error ] in
392
395
393
-
Jsont.Object.map ~kind:"Response" Fun.id
394
-
|> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases
395
-
~tag_to_string:Fun.id ~tag_compare:String.compare
396
-
|> Jsont.Object.finish
396
+
Json.Codec.Object.map ~kind:"Response" Fun.id
397
+
|> Json.Codec.Object.case_mem "subtype" Json.Codec.string ~enc:Fun.id
398
+
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
399
+
|> Json.Codec.Object.finish
397
400
end
398
401
399
402
type control_request = {
···
418
421
Response { type_ = `Control_response; response; unknown }
419
422
420
423
(* Individual record codecs *)
421
-
let control_request_jsont : control_request Jsont.t =
424
+
let control_request_jsont : control_request Json.codec =
422
425
let make request_id request (unknown : Unknown.t) : control_request =
423
426
{ type_ = `Control_request; request_id; request; unknown }
424
427
in
425
-
Jsont.Object.map ~kind:"ControlRequest" make
426
-
|> Jsont.Object.mem "request_id" Jsont.string
428
+
Json.Codec.Object.map ~kind:"ControlRequest" make
429
+
|> Json.Codec.Object.mem "request_id" Json.Codec.string
427
430
~enc:(fun (r : control_request) -> r.request_id)
428
-
|> Jsont.Object.mem "request" Request.jsont ~enc:(fun (r : control_request) ->
429
-
r.request)
430
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : control_request) ->
431
-
r.unknown)
432
-
|> Jsont.Object.finish
431
+
|> Json.Codec.Object.mem "request" Request.json
432
+
~enc:(fun (r : control_request) -> r.request)
433
+
|> Json.Codec.Object.keep_unknown Unknown.mems
434
+
~enc:(fun (r : control_request) -> r.unknown)
435
+
|> Json.Codec.Object.finish
433
436
434
-
let control_response_jsont : control_response Jsont.t =
437
+
let control_response_jsont : control_response Json.codec =
435
438
let make response (unknown : Unknown.t) : control_response =
436
439
{ type_ = `Control_response; response; unknown }
437
440
in
438
-
Jsont.Object.map ~kind:"ControlResponse" make
439
-
|> Jsont.Object.mem "response" Response.jsont
441
+
Json.Codec.Object.map ~kind:"ControlResponse" make
442
+
|> Json.Codec.Object.mem "response" Response.json
440
443
~enc:(fun (r : control_response) -> r.response)
441
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : control_response) ->
442
-
r.unknown)
443
-
|> Jsont.Object.finish
444
+
|> Json.Codec.Object.keep_unknown Unknown.mems
445
+
~enc:(fun (r : control_response) -> r.unknown)
446
+
|> Json.Codec.Object.finish
444
447
445
448
(* Main variant codec using type discriminator *)
446
-
let jsont : t Jsont.t =
449
+
let json : t Json.codec =
447
450
let case_request =
448
-
Jsont.Object.Case.map "control_request" control_request_jsont ~dec:(fun v ->
449
-
Request v)
451
+
Json.Codec.Object.Case.map "control_request" control_request_jsont
452
+
~dec:(fun v -> Request v)
450
453
in
451
454
let case_response =
452
-
Jsont.Object.Case.map "control_response" control_response_jsont
455
+
Json.Codec.Object.Case.map "control_response" control_response_jsont
453
456
~dec:(fun v -> Response v)
454
457
in
455
458
456
459
let enc_case = function
457
-
| Request v -> Jsont.Object.Case.value case_request v
458
-
| Response v -> Jsont.Object.Case.value case_response v
460
+
| Request v -> Json.Codec.Object.Case.value case_request v
461
+
| Response v -> Json.Codec.Object.Case.value case_response v
459
462
in
460
463
461
-
let cases = Jsont.Object.Case.[ make case_request; make case_response ] in
464
+
let cases =
465
+
Json.Codec.Object.Case.[ make case_request; make case_response ]
466
+
in
462
467
463
-
Jsont.Object.map ~kind:"Control" Fun.id
464
-
|> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
465
-
~tag_to_string:Fun.id ~tag_compare:String.compare
466
-
|> Jsont.Object.finish
468
+
Json.Codec.Object.map ~kind:"Control" Fun.id
469
+
|> Json.Codec.Object.case_mem "type" Json.Codec.string ~enc:Fun.id ~enc_case
470
+
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
471
+
|> Json.Codec.Object.finish
467
472
468
-
let pp ppf t = Jsont.pp_value jsont () ppf t
473
+
let pp ppf t = Json.pp_value json () ppf t
469
474
470
475
let log_request req =
471
476
Log.debug (fun m ->
472
-
m "control request: %a" (Jsont.pp_value Request.jsont ()) req)
477
+
m "control request: %a" (Json.pp_value Request.json ()) req)
473
478
474
479
let log_response resp =
475
480
Log.debug (fun m ->
476
-
m "control response: %a" (Jsont.pp_value Response.jsont ()) resp)
481
+
m "control response: %a" (Json.pp_value Response.json ()) resp)
477
482
478
483
(** Server information *)
479
484
module Server_info = struct
···
495
500
let output_styles t = t.output_styles
496
501
let unknown t = t.unknown
497
502
498
-
let jsont : t Jsont.t =
503
+
let json : t Json.codec =
499
504
let make version capabilities commands output_styles (unknown : Unknown.t) :
500
505
t =
501
506
{ version; capabilities; commands; output_styles; unknown }
502
507
in
503
-
Jsont.Object.map ~kind:"ServerInfo" make
504
-
|> Jsont.Object.mem "version" Jsont.string ~enc:(fun (r : t) -> r.version)
505
-
|> Jsont.Object.mem "capabilities" (Jsont.list Jsont.string)
508
+
Json.Codec.Object.map ~kind:"ServerInfo" make
509
+
|> Json.Codec.Object.mem "version" Json.Codec.string ~enc:(fun (r : t) ->
510
+
r.version)
511
+
|> Json.Codec.Object.mem "capabilities"
512
+
(Json.Codec.list Json.Codec.string)
506
513
~enc:(fun (r : t) -> r.capabilities)
507
514
~dec_absent:[]
508
-
|> Jsont.Object.mem "commands" (Jsont.list Jsont.string)
515
+
|> Json.Codec.Object.mem "commands"
516
+
(Json.Codec.list Json.Codec.string)
509
517
~enc:(fun (r : t) -> r.commands)
510
518
~dec_absent:[]
511
-
|> Jsont.Object.mem "outputStyles" (Jsont.list Jsont.string)
519
+
|> Json.Codec.Object.mem "outputStyles"
520
+
(Json.Codec.list Json.Codec.string)
512
521
~enc:(fun (r : t) -> r.output_styles)
513
522
~dec_absent:[]
514
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : t) -> r.unknown)
515
-
|> Jsont.Object.finish
523
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : t) ->
524
+
r.unknown)
525
+
|> Json.Codec.Object.finish
516
526
end
+30
-31
lib/control.mli
+30
-31
lib/control.mli
···
70
70
type permission = {
71
71
subtype : [ `Can_use_tool ];
72
72
tool_name : string;
73
-
input : Jsont.json;
73
+
input : Json.t;
74
74
permission_suggestions : Permissions.Update.t list option;
75
75
blocked_path : string option;
76
76
unknown : Unknown.t;
···
79
79
80
80
type initialize = {
81
81
subtype : [ `Initialize ];
82
-
hooks : (string * Jsont.json) list option; (* Hook event to configuration *)
82
+
hooks : (string * Json.t) list option; (* Hook event to configuration *)
83
83
unknown : Unknown.t;
84
84
}
85
85
(** Initialize request with optional hook configuration. *)
···
94
94
type hook_callback = {
95
95
subtype : [ `Hook_callback ];
96
96
callback_id : string;
97
-
input : Jsont.json;
97
+
input : Json.t;
98
98
tool_use_id : string option;
99
99
unknown : Unknown.t;
100
100
}
···
103
103
type mcp_message = {
104
104
subtype : [ `Mcp_message ];
105
105
server_name : string;
106
-
message : Jsont.json;
106
+
message : Json.t;
107
107
unknown : Unknown.t;
108
108
}
109
109
(** MCP server message request. *)
···
134
134
135
135
val permission :
136
136
tool_name:string ->
137
-
input:Jsont.json ->
137
+
input:Json.t ->
138
138
?permission_suggestions:Permissions.Update.t list ->
139
139
?blocked_path:string ->
140
140
?unknown:Unknown.t ->
···
144
144
?unknown ()] creates a permission request. *)
145
145
146
146
val initialize :
147
-
?hooks:(string * Jsont.json) list -> ?unknown:Unknown.t -> unit -> t
147
+
?hooks:(string * Json.t) list -> ?unknown:Unknown.t -> unit -> t
148
148
(** [initialize ?hooks ?unknown ()] creates an initialize request. *)
149
149
150
150
val set_permission_mode :
···
154
154
155
155
val hook_callback :
156
156
callback_id:string ->
157
-
input:Jsont.json ->
157
+
input:Json.t ->
158
158
?tool_use_id:string ->
159
159
?unknown:Unknown.t ->
160
160
unit ->
···
163
163
hook callback request. *)
164
164
165
165
val mcp_message :
166
-
server_name:string -> message:Jsont.json -> ?unknown:Unknown.t -> unit -> t
166
+
server_name:string -> message:Json.t -> ?unknown:Unknown.t -> unit -> t
167
167
(** [mcp_message ~server_name ~message ?unknown] creates an MCP message
168
168
request. *)
169
169
···
173
173
val get_server_info : ?unknown:Unknown.t -> unit -> t
174
174
(** [get_server_info ?unknown ()] creates a server info request. *)
175
175
176
-
val jsont : t Jsont.t
177
-
(** [jsont] is the jsont codec for requests. Use [Jsont.pp_value jsont ()] for
176
+
val json : t Json.codec
177
+
(** [json] is the json codec for requests. Use [Json.pp_value json ()] for
178
178
pretty-printing. *)
179
179
end
180
180
···
199
199
(** [of_int n] converts an integer to a variant. Unknown codes become
200
200
[`Custom n]. *)
201
201
202
-
val jsont : t Jsont.t
203
-
(** [jsont] encodes an error code as a JSON integer. *)
202
+
val json : t Json.codec
203
+
(** [json] encodes an error code as a JSON integer. *)
204
204
end
205
205
206
206
type error_detail = {
207
207
code : int; (** Error code for programmatic handling *)
208
208
message : string; (** Human-readable error message *)
209
-
data : Jsont.json option; (** Optional additional error data *)
209
+
data : Json.t option; (** Optional additional error data *)
210
210
}
211
211
(** Structured error detail similar to JSON-RPC.
212
212
···
216
216
val error_detail :
217
217
code:[< Error_code.t ] ->
218
218
message:string ->
219
-
?data:Jsont.json ->
219
+
?data:Json.t ->
220
220
unit ->
221
221
error_detail
222
222
(** [error_detail ~code ~message ?data ()] creates a structured error detail
···
227
227
error_detail ~code:`Method_not_found ~message:"Hook callback not found" ()
228
228
]} *)
229
229
230
-
val error_detail_jsont : error_detail Jsont.t
230
+
val error_detail_jsont : error_detail Json.codec
231
231
(** [error_detail_jsont] is the Jsont codec for error details. *)
232
232
233
233
type success = {
234
234
subtype : [ `Success ];
235
235
request_id : string;
236
-
response : Jsont.json option;
236
+
response : Json.t option;
237
237
unknown : Unknown.t;
238
238
}
239
239
(** Successful response. *)
···
251
251
| Error of error (** The type of SDK control responses. *)
252
252
253
253
val success :
254
-
request_id:string -> ?response:Jsont.json -> ?unknown:Unknown.t -> unit -> t
254
+
request_id:string -> ?response:Json.t -> ?unknown:Unknown.t -> unit -> t
255
255
(** [success ~request_id ?response ?unknown ()] creates a success response. *)
256
256
257
257
val error :
···
259
259
(** [error ~request_id ~error ?unknown] creates an error response with
260
260
structured error detail. *)
261
261
262
-
val jsont : t Jsont.t
263
-
(** [jsont] is the jsont codec for responses. Use [Jsont.pp_value jsont ()]
264
-
for pretty-printing. *)
262
+
val json : t Json.codec
263
+
(** [json] is the json codec for responses. Use [Json.pp_value json ()] for
264
+
pretty-printing. *)
265
265
end
266
266
267
267
(** {1 Control Messages} *)
···
281
281
}
282
282
(** Control response message. *)
283
283
284
-
val control_request_jsont : control_request Jsont.t
285
-
(** [control_request_jsont] is the jsont codec for control request messages. *)
284
+
val control_request_jsont : control_request Json.codec
285
+
(** [control_request_jsont] is the json codec for control request messages. *)
286
286
287
-
val control_response_jsont : control_response Jsont.t
288
-
(** [control_response_jsont] is the jsont codec for control response messages.
289
-
*)
287
+
val control_response_jsont : control_response Json.codec
288
+
(** [control_response_jsont] is the json codec for control response messages. *)
290
289
291
290
type t =
292
291
| Request of control_request
···
300
299
val response : response:Response.t -> ?unknown:Unknown.t -> unit -> t
301
300
(** [response ~response ?unknown ()] creates a control response message. *)
302
301
303
-
val jsont : t Jsont.t
304
-
(** [jsont] is the jsont codec for control messages. Use
305
-
[Jsont.pp_value jsont ()] for pretty-printing. *)
302
+
val json : t Json.codec
303
+
(** [json] is the json codec for control messages. Use [Json.pp_value json ()]
304
+
for pretty-printing. *)
306
305
307
306
val pp : Format.formatter -> t -> unit
308
307
(** [pp ppf t] pretty-prints the SDK control message. *)
···
381
380
val unknown : t -> Unknown.t
382
381
(** [unknown t] returns the unknown fields. *)
383
382
384
-
val jsont : t Jsont.t
385
-
(** [jsont] is the jsont codec for server info. Use [Jsont.pp_value jsont ()]
386
-
for pretty-printing. *)
383
+
val json : t Json.codec
384
+
(** [json] is the json codec for server info. Use [Json.pp_value json ()] for
385
+
pretty-printing. *)
387
386
end
+1
-1
lib/dune
+1
-1
lib/dune
+109
-95
lib/hooks.ml
+109
-95
lib/hooks.ml
···
34
34
| "PreCompact" -> Pre_compact
35
35
| s -> raise (Invalid_argument (Fmt.str "Unknown hook event: %s" s))
36
36
37
-
let event_jsont : event Jsont.t =
38
-
Jsont.enum
37
+
let event_jsont : event Json.codec =
38
+
Json.Codec.enum
39
39
[
40
40
("PreToolUse", Pre_tool_use);
41
41
("PostToolUse", Post_tool_use);
···
49
49
50
50
type decision = Continue | Block
51
51
52
-
let decision_jsont : decision Jsont.t =
53
-
Jsont.enum [ ("continue", Continue); ("block", Block) ]
52
+
let decision_jsont : decision Json.codec =
53
+
Json.Codec.enum [ ("continue", Continue); ("block", Block) ]
54
54
55
55
(** {1 Pre_tool_use Hook} *)
56
56
···
62
62
tool_input : Tool_input.t;
63
63
}
64
64
65
-
let input_jsont : input Jsont.t =
65
+
let input_jsont : input Json.codec =
66
66
let make session_id transcript_path tool_name tool_input _unknown =
67
67
{
68
68
session_id;
···
71
71
tool_input = Tool_input.of_json tool_input;
72
72
}
73
73
in
74
-
Jsont.Object.map ~kind:"PreToolUseInput" make
75
-
|> Jsont.Object.mem "session_id" Jsont.string ~enc:(fun i -> i.session_id)
76
-
|> Jsont.Object.mem "transcript_path" Jsont.string ~enc:(fun i ->
74
+
Json.Codec.Object.map ~kind:"PreToolUseInput" make
75
+
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
76
+
i.session_id)
77
+
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
77
78
i.transcript_path)
78
-
|> Jsont.Object.mem "tool_name" Jsont.string ~enc:(fun i -> i.tool_name)
79
-
|> Jsont.Object.mem "tool_input" Jsont.json ~enc:(fun i ->
79
+
|> Json.Codec.Object.mem "tool_name" Json.Codec.string ~enc:(fun i ->
80
+
i.tool_name)
81
+
|> Json.Codec.Object.mem "tool_input" Json.Codec.Value.t ~enc:(fun i ->
80
82
Tool_input.to_json i.tool_input)
81
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
82
-
|> Jsont.Object.finish
83
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
84
+
|> Json.Codec.Object.finish
83
85
84
86
type decision = Allow | Deny | Ask
85
87
86
-
let decision_jsont : decision Jsont.t =
87
-
Jsont.enum [ ("allow", Allow); ("deny", Deny); ("ask", Ask) ]
88
+
let decision_jsont : decision Json.codec =
89
+
Json.Codec.enum [ ("allow", Allow); ("deny", Deny); ("ask", Ask) ]
88
90
89
91
type output = {
90
92
decision : decision option;
···
99
101
let ask ?reason () = { decision = Some Ask; reason; updated_input = None }
100
102
let continue () = { decision = None; reason = None; updated_input = None }
101
103
102
-
let output_jsont : output Jsont.t =
104
+
let output_jsont : output Json.codec =
103
105
let make _hook_event_name decision reason updated_input _unknown =
104
106
{
105
107
decision;
···
107
109
updated_input = Option.map Tool_input.of_json updated_input;
108
110
}
109
111
in
110
-
Jsont.Object.map ~kind:"PreToolUseOutput" make
111
-
|> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ ->
112
+
Json.Codec.Object.map ~kind:"PreToolUseOutput" make
113
+
|> Json.Codec.Object.mem "hookEventName" Json.Codec.string ~enc:(fun _ ->
112
114
"PreToolUse")
113
-
|> Jsont.Object.opt_mem "permissionDecision" decision_jsont ~enc:(fun o ->
114
-
o.decision)
115
-
|> Jsont.Object.opt_mem "permissionDecisionReason" Jsont.string
115
+
|> Json.Codec.Object.opt_mem "permissionDecision" decision_jsont
116
+
~enc:(fun o -> o.decision)
117
+
|> Json.Codec.Object.opt_mem "permissionDecisionReason" Json.Codec.string
116
118
~enc:(fun o -> o.reason)
117
-
|> Jsont.Object.opt_mem "updatedInput" Jsont.json ~enc:(fun o ->
118
-
Option.map Tool_input.to_json o.updated_input)
119
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
120
-
|> Jsont.Object.finish
119
+
|> Json.Codec.Object.opt_mem "updatedInput" Json.Codec.Value.t
120
+
~enc:(fun o -> Option.map Tool_input.to_json o.updated_input)
121
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
122
+
|> Json.Codec.Object.finish
121
123
122
124
type callback = input -> output
123
125
end
···
130
132
transcript_path : string;
131
133
tool_name : string;
132
134
tool_input : Tool_input.t;
133
-
tool_response : Jsont.json;
135
+
tool_response : Json.t;
134
136
}
135
137
136
-
let input_jsont : input Jsont.t =
138
+
let input_jsont : input Json.codec =
137
139
let make session_id transcript_path tool_name tool_input tool_response
138
140
_unknown =
139
141
{
···
144
146
tool_response;
145
147
}
146
148
in
147
-
Jsont.Object.map ~kind:"PostToolUseInput" make
148
-
|> Jsont.Object.mem "session_id" Jsont.string ~enc:(fun i -> i.session_id)
149
-
|> Jsont.Object.mem "transcript_path" Jsont.string ~enc:(fun i ->
149
+
Json.Codec.Object.map ~kind:"PostToolUseInput" make
150
+
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
151
+
i.session_id)
152
+
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
150
153
i.transcript_path)
151
-
|> Jsont.Object.mem "tool_name" Jsont.string ~enc:(fun i -> i.tool_name)
152
-
|> Jsont.Object.mem "tool_input" Jsont.json ~enc:(fun i ->
154
+
|> Json.Codec.Object.mem "tool_name" Json.Codec.string ~enc:(fun i ->
155
+
i.tool_name)
156
+
|> Json.Codec.Object.mem "tool_input" Json.Codec.Value.t ~enc:(fun i ->
153
157
Tool_input.to_json i.tool_input)
154
-
|> Jsont.Object.mem "tool_response" Jsont.json ~enc:(fun i ->
158
+
|> Json.Codec.Object.mem "tool_response" Json.Codec.Value.t ~enc:(fun i ->
155
159
i.tool_response)
156
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
157
-
|> Jsont.Object.finish
160
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
161
+
|> Json.Codec.Object.finish
158
162
159
163
type output = {
160
164
block : bool;
···
168
172
let block ?reason ?additional_context () =
169
173
{ block = true; reason; additional_context }
170
174
171
-
let output_jsont : output Jsont.t =
175
+
let output_jsont : output Json.codec =
172
176
let make _hook_event_name decision reason additional_context _unknown =
173
177
{
174
178
block = (match decision with Some Block -> true | _ -> false);
···
176
180
additional_context;
177
181
}
178
182
in
179
-
Jsont.Object.map ~kind:"PostToolUseOutput" make
180
-
|> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ ->
183
+
Json.Codec.Object.map ~kind:"PostToolUseOutput" make
184
+
|> Json.Codec.Object.mem "hookEventName" Json.Codec.string ~enc:(fun _ ->
181
185
"PostToolUse")
182
-
|> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
186
+
|> Json.Codec.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
183
187
if o.block then Some Block else None)
184
-
|> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason)
185
-
|> Jsont.Object.opt_mem "additionalContext" Jsont.string ~enc:(fun o ->
186
-
o.additional_context)
187
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
188
-
|> Jsont.Object.finish
188
+
|> Json.Codec.Object.opt_mem "reason" Json.Codec.string ~enc:(fun o ->
189
+
o.reason)
190
+
|> Json.Codec.Object.opt_mem "additionalContext" Json.Codec.string
191
+
~enc:(fun o -> o.additional_context)
192
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
193
+
|> Json.Codec.Object.finish
189
194
190
195
type callback = input -> output
191
196
end
···
199
204
prompt : string;
200
205
}
201
206
202
-
let input_jsont : input Jsont.t =
207
+
let input_jsont : input Json.codec =
203
208
let make session_id transcript_path prompt _unknown =
204
209
{ session_id; transcript_path; prompt }
205
210
in
206
-
Jsont.Object.map ~kind:"UserPromptSubmitInput" make
207
-
|> Jsont.Object.mem "session_id" Jsont.string ~enc:(fun i -> i.session_id)
208
-
|> Jsont.Object.mem "transcript_path" Jsont.string ~enc:(fun i ->
211
+
Json.Codec.Object.map ~kind:"UserPromptSubmitInput" make
212
+
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
213
+
i.session_id)
214
+
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
209
215
i.transcript_path)
210
-
|> Jsont.Object.mem "prompt" Jsont.string ~enc:(fun i -> i.prompt)
211
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
212
-
|> Jsont.Object.finish
216
+
|> Json.Codec.Object.mem "prompt" Json.Codec.string ~enc:(fun i -> i.prompt)
217
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
218
+
|> Json.Codec.Object.finish
213
219
214
220
type output = {
215
221
block : bool;
···
222
228
223
229
let block ?reason () = { block = true; reason; additional_context = None }
224
230
225
-
let output_jsont : output Jsont.t =
231
+
let output_jsont : output Json.codec =
226
232
let make _hook_event_name decision reason additional_context _unknown =
227
233
{
228
234
block = (match decision with Some Block -> true | _ -> false);
···
230
236
additional_context;
231
237
}
232
238
in
233
-
Jsont.Object.map ~kind:"UserPromptSubmitOutput" make
234
-
|> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ ->
239
+
Json.Codec.Object.map ~kind:"UserPromptSubmitOutput" make
240
+
|> Json.Codec.Object.mem "hookEventName" Json.Codec.string ~enc:(fun _ ->
235
241
"UserPromptSubmit")
236
-
|> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
242
+
|> Json.Codec.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
237
243
if o.block then Some Block else None)
238
-
|> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason)
239
-
|> Jsont.Object.opt_mem "additionalContext" Jsont.string ~enc:(fun o ->
240
-
o.additional_context)
241
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
242
-
|> Jsont.Object.finish
244
+
|> Json.Codec.Object.opt_mem "reason" Json.Codec.string ~enc:(fun o ->
245
+
o.reason)
246
+
|> Json.Codec.Object.opt_mem "additionalContext" Json.Codec.string
247
+
~enc:(fun o -> o.additional_context)
248
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
249
+
|> Json.Codec.Object.finish
243
250
244
251
type callback = input -> output
245
252
end
···
253
260
stop_hook_active : bool;
254
261
}
255
262
256
-
let input_jsont : input Jsont.t =
263
+
let input_jsont : input Json.codec =
257
264
let make session_id transcript_path stop_hook_active _unknown =
258
265
{ session_id; transcript_path; stop_hook_active }
259
266
in
260
-
Jsont.Object.map ~kind:"StopInput" make
261
-
|> Jsont.Object.mem "session_id" Jsont.string ~enc:(fun i -> i.session_id)
262
-
|> Jsont.Object.mem "transcript_path" Jsont.string ~enc:(fun i ->
267
+
Json.Codec.Object.map ~kind:"StopInput" make
268
+
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
269
+
i.session_id)
270
+
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
263
271
i.transcript_path)
264
-
|> Jsont.Object.mem "stop_hook_active" Jsont.bool ~enc:(fun i ->
272
+
|> Json.Codec.Object.mem "stop_hook_active" Json.Codec.bool ~enc:(fun i ->
265
273
i.stop_hook_active)
266
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
267
-
|> Jsont.Object.finish
274
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
275
+
|> Json.Codec.Object.finish
268
276
269
277
type output = { block : bool; reason : string option }
270
278
271
279
let continue () = { block = false; reason = None }
272
280
let block ?reason () = { block = true; reason }
273
281
274
-
let output_jsont_with_event_name event_name : output Jsont.t =
282
+
let output_jsont_with_event_name event_name : output Json.codec =
275
283
let make _hook_event_name decision reason _unknown =
276
284
{
277
285
block = (match decision with Some Block -> true | _ -> false);
278
286
reason;
279
287
}
280
288
in
281
-
Jsont.Object.map ~kind:(event_name ^ "Output") make
282
-
|> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ -> event_name)
283
-
|> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
289
+
Json.Codec.Object.map ~kind:(event_name ^ "Output") make
290
+
|> Json.Codec.Object.mem "hookEventName" Json.Codec.string ~enc:(fun _ ->
291
+
event_name)
292
+
|> Json.Codec.Object.opt_mem "decision" decision_jsont ~enc:(fun o ->
284
293
if o.block then Some Block else None)
285
-
|> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason)
286
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
287
-
|> Jsont.Object.finish
294
+
|> Json.Codec.Object.opt_mem "reason" Json.Codec.string ~enc:(fun o ->
295
+
o.reason)
296
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
297
+
|> Json.Codec.Object.finish
288
298
289
299
let output_jsont = output_jsont_with_event_name "Stop"
290
300
···
310
320
module Pre_compact = struct
311
321
type input = { session_id : string; transcript_path : string }
312
322
313
-
let input_jsont : input Jsont.t =
323
+
let input_jsont : input Json.codec =
314
324
let make session_id transcript_path _unknown =
315
325
{ session_id; transcript_path }
316
326
in
317
-
Jsont.Object.map ~kind:"PreCompactInput" make
318
-
|> Jsont.Object.mem "session_id" Jsont.string ~enc:(fun i -> i.session_id)
319
-
|> Jsont.Object.mem "transcript_path" Jsont.string ~enc:(fun i ->
327
+
Json.Codec.Object.map ~kind:"PreCompactInput" make
328
+
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:(fun i ->
329
+
i.session_id)
330
+
|> Json.Codec.Object.mem "transcript_path" Json.Codec.string ~enc:(fun i ->
320
331
i.transcript_path)
321
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
322
-
|> Jsont.Object.finish
332
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
333
+
|> Json.Codec.Object.finish
323
334
324
335
type callback = input -> unit
325
336
end
···
329
340
type result = {
330
341
decision : decision option;
331
342
system_message : string option;
332
-
hook_specific_output : Jsont.json option;
343
+
hook_specific_output : Json.t option;
333
344
}
334
345
335
-
let result_jsont : result Jsont.t =
346
+
let result_jsont : result Json.codec =
336
347
let make decision system_message hook_specific_output _unknown =
337
348
{ decision; system_message; hook_specific_output }
338
349
in
339
-
Jsont.Object.map ~kind:"Result" make
340
-
|> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun r -> r.decision)
341
-
|> Jsont.Object.opt_mem "systemMessage" Jsont.string ~enc:(fun r ->
350
+
Json.Codec.Object.map ~kind:"Result" make
351
+
|> Json.Codec.Object.opt_mem "decision" decision_jsont ~enc:(fun r ->
352
+
r.decision)
353
+
|> Json.Codec.Object.opt_mem "systemMessage" Json.Codec.string ~enc:(fun r ->
342
354
r.system_message)
343
-
|> Jsont.Object.opt_mem "hookSpecificOutput" Jsont.json ~enc:(fun r ->
344
-
r.hook_specific_output)
345
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
346
-
|> Jsont.Object.finish
355
+
|> Json.Codec.Object.opt_mem "hookSpecificOutput" Json.Codec.Value.t
356
+
~enc:(fun r -> r.hook_specific_output)
357
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun _ -> Unknown.empty)
358
+
|> Json.Codec.Object.finish
347
359
348
360
let continue_result ?system_message ?hook_specific_output () =
349
361
{ decision = None; system_message; hook_specific_output }
···
381
393
382
394
(** {1 Internal - Conversion to Wire Format} *)
383
395
384
-
let decode_input name jsont json =
385
-
match Jsont.Json.decode jsont json with
396
+
let decode_input name codec v =
397
+
match Json.decode codec v with
386
398
| Ok input -> input
387
-
| Error msg ->
399
+
| Error err ->
400
+
let msg = Json.Error.to_string err in
388
401
Log.err (fun m -> m "%s: failed to decode input: %s" name msg);
389
402
raise (Invalid_argument (name ^ " input: " ^ msg))
390
403
391
-
let encode_output name jsont output =
392
-
match Jsont.Json.encode jsont output with
393
-
| Ok json -> json
394
-
| Error msg -> failwith (name ^ " output encoding: " ^ msg)
404
+
let encode_output name codec output =
405
+
match Json.encode codec output with
406
+
| Ok v -> v
407
+
| Error err ->
408
+
failwith (name ^ " output encoding: " ^ Json.Error.to_string err)
395
409
396
410
let wire_callback ~name ~input_jsont ~output_jsont ~should_block callback json =
397
411
let typed_input = decode_input name input_jsont json in
+20
-21
lib/hooks.mli
+20
-21
lib/hooks.mli
···
50
50
val event_of_string : string -> event
51
51
(** @raise Invalid_argument if the string is not a known event. *)
52
52
53
-
val event_jsont : event Jsont.t
53
+
val event_jsont : event Json.codec
54
54
55
55
(** {1 Decision} *)
56
56
57
57
type decision = Continue | Block
58
58
59
-
val decision_jsont : decision Jsont.t
59
+
val decision_jsont : decision Json.codec
60
60
61
61
(** {1 Hook Types} *)
62
62
···
69
69
tool_input : Tool_input.t;
70
70
}
71
71
72
-
val input_jsont : input Jsont.t
72
+
val input_jsont : input Json.codec
73
73
74
74
type decision = Allow | Deny | Ask
75
75
76
-
val decision_jsont : decision Jsont.t
76
+
val decision_jsont : decision Json.codec
77
77
78
78
type output = {
79
79
decision : decision option;
···
81
81
updated_input : Tool_input.t option;
82
82
}
83
83
84
-
val output_jsont : output Jsont.t
84
+
val output_jsont : output Json.codec
85
85
val allow : ?reason:string -> ?updated_input:Tool_input.t -> unit -> output
86
86
val deny : ?reason:string -> unit -> output
87
87
val ask : ?reason:string -> unit -> output
···
97
97
transcript_path : string;
98
98
tool_name : string;
99
99
tool_input : Tool_input.t;
100
-
tool_response : Jsont.json;
100
+
tool_response : Json.t;
101
101
}
102
102
103
-
val input_jsont : input Jsont.t
103
+
val input_jsont : input Json.codec
104
104
105
105
type output = {
106
106
block : bool;
···
108
108
additional_context : string option;
109
109
}
110
110
111
-
val output_jsont : output Jsont.t
111
+
val output_jsont : output Json.codec
112
112
val continue : ?additional_context:string -> unit -> output
113
113
val block : ?reason:string -> ?additional_context:string -> unit -> output
114
114
···
123
123
prompt : string;
124
124
}
125
125
126
-
val input_jsont : input Jsont.t
126
+
val input_jsont : input Json.codec
127
127
128
128
type output = {
129
129
block : bool;
···
131
131
additional_context : string option;
132
132
}
133
133
134
-
val output_jsont : output Jsont.t
134
+
val output_jsont : output Json.codec
135
135
val continue : ?additional_context:string -> unit -> output
136
136
val block : ?reason:string -> unit -> output
137
137
···
146
146
stop_hook_active : bool;
147
147
}
148
148
149
-
val input_jsont : input Jsont.t
149
+
val input_jsont : input Json.codec
150
150
151
151
type output = { block : bool; reason : string option }
152
152
153
-
val output_jsont : output Jsont.t
153
+
val output_jsont : output Json.codec
154
154
val continue : unit -> output
155
155
val block : ?reason:string -> unit -> output
156
156
···
162
162
type input = Stop.input
163
163
type output = Stop.output
164
164
165
-
val input_jsont : input Jsont.t
166
-
val output_jsont : output Jsont.t
165
+
val input_jsont : input Json.codec
166
+
val output_jsont : output Json.codec
167
167
val continue : unit -> output
168
168
val block : ?reason:string -> unit -> output
169
169
···
174
174
module Pre_compact : sig
175
175
type input = { session_id : string; transcript_path : string }
176
176
177
-
val input_jsont : input Jsont.t
177
+
val input_jsont : input Json.codec
178
178
179
179
type callback = input -> unit
180
180
(** Pre_compact hooks have no output - they are notification-only. *)
···
185
185
type result = {
186
186
decision : decision option;
187
187
system_message : string option;
188
-
hook_specific_output : Jsont.json option;
188
+
hook_specific_output : Json.t option;
189
189
}
190
190
191
-
val result_jsont : result Jsont.t
191
+
val result_jsont : result Json.codec
192
192
193
193
val continue_result :
194
-
?system_message:string -> ?hook_specific_output:Jsont.json -> unit -> result
194
+
?system_message:string -> ?hook_specific_output:Json.t -> unit -> result
195
195
196
196
val block_result :
197
-
?system_message:string -> ?hook_specific_output:Jsont.json -> unit -> result
197
+
?system_message:string -> ?hook_specific_output:Json.t -> unit -> result
198
198
199
199
(** {1 Hook Configuration} *)
200
200
···
219
219
220
220
(** {1 Internal - for client use} *)
221
221
222
-
val callbacks :
223
-
t -> (event * (string option * (Jsont.json -> result)) list) list
222
+
val callbacks : t -> (event * (string option * (Json.t -> result)) list) list
224
223
(** [callbacks config] returns hook configuration in format suitable for
225
224
registration with the CLI.
226
225
+25
-25
lib/incoming.ml
+25
-25
lib/incoming.ml
···
18
18
| Control_request of Control.control_request
19
19
| Rate_limit_event
20
20
21
-
let jsont : t Jsont.t =
21
+
let json : t Json.codec =
22
22
(* Message types use "user", "assistant", "system", "result" as type values.
23
23
Control uses "control_request" and "control_response".
24
24
25
25
We use case_mem for all types. Note: we use the inner message codecs
26
-
(User.incoming_jsont, etc.) rather than Message.jsont to avoid nesting
26
+
(User.incoming_jsont, etc.) rather than Message.json to avoid nesting
27
27
case_mem on the same "type" field. *)
28
28
let case_control_request =
29
-
Jsont.Object.Case.map "control_request" Control.control_request_jsont
29
+
Json.Codec.Object.Case.map "control_request" Control.control_request_jsont
30
30
~dec:(fun v -> Control_request v)
31
31
in
32
32
let case_control_response =
33
-
Jsont.Object.Case.map "control_response" Control.control_response_jsont
33
+
Json.Codec.Object.Case.map "control_response" Control.control_response_jsont
34
34
~dec:(fun v -> Control_response v)
35
35
in
36
36
let case_user =
37
-
Jsont.Object.Case.map "user" Message.User.incoming_jsont ~dec:(fun v ->
37
+
Json.Codec.Object.Case.map "user" Message.User.incoming_jsont ~dec:(fun v ->
38
38
Message (Message.User v))
39
39
in
40
40
let case_assistant =
41
-
Jsont.Object.Case.map "assistant" Message.Assistant.incoming_jsont
41
+
Json.Codec.Object.Case.map "assistant" Message.Assistant.incoming_jsont
42
42
~dec:(fun v -> Message (Message.Assistant v))
43
43
in
44
44
let case_system =
45
-
Jsont.Object.Case.map "system" Message.System.jsont ~dec:(fun v ->
45
+
Json.Codec.Object.Case.map "system" Message.System.json ~dec:(fun v ->
46
46
Message (Message.System v))
47
47
in
48
48
let case_result =
49
-
Jsont.Object.Case.map "result" Message.Result.jsont ~dec:(fun v ->
49
+
Json.Codec.Object.Case.map "result" Message.Result.json ~dec:(fun v ->
50
50
Message (Message.Result v))
51
51
in
52
52
(* rate_limit_event: CLI sends these periodically with usage info.
53
53
We decode the type field and discard the rest. *)
54
54
let rate_limit_jsont =
55
-
Jsont.Object.map ~kind:"RateLimit" ()
56
-
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
55
+
Json.Codec.Object.map ~kind:"RateLimit" ()
56
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
57
57
in
58
58
let case_rate_limit =
59
-
Jsont.Object.Case.map "rate_limit_event" rate_limit_jsont ~dec:(fun () ->
60
-
Rate_limit_event)
59
+
Json.Codec.Object.Case.map "rate_limit_event" rate_limit_jsont
60
+
~dec:(fun () -> Rate_limit_event)
61
61
in
62
62
let enc_case = function
63
-
| Control_request v -> Jsont.Object.Case.value case_control_request v
64
-
| Control_response v -> Jsont.Object.Case.value case_control_response v
65
-
| Rate_limit_event -> Jsont.Object.Case.value case_rate_limit ()
63
+
| Control_request v -> Json.Codec.Object.Case.value case_control_request v
64
+
| Control_response v -> Json.Codec.Object.Case.value case_control_response v
65
+
| Rate_limit_event -> Json.Codec.Object.Case.value case_rate_limit ()
66
66
| Message msg -> (
67
67
match msg with
68
-
| Message.User u -> Jsont.Object.Case.value case_user u
69
-
| Message.Assistant a -> Jsont.Object.Case.value case_assistant a
70
-
| Message.System s -> Jsont.Object.Case.value case_system s
71
-
| Message.Result r -> Jsont.Object.Case.value case_result r)
68
+
| Message.User u -> Json.Codec.Object.Case.value case_user u
69
+
| Message.Assistant a -> Json.Codec.Object.Case.value case_assistant a
70
+
| Message.System s -> Json.Codec.Object.Case.value case_system s
71
+
| Message.Result r -> Json.Codec.Object.Case.value case_result r)
72
72
in
73
73
let cases =
74
-
Jsont.Object.Case.
74
+
Json.Codec.Object.Case.
75
75
[
76
76
make case_control_request;
77
77
make case_control_response;
···
82
82
make case_rate_limit;
83
83
]
84
84
in
85
-
Jsont.Object.map ~kind:"Incoming" Fun.id
86
-
|> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
87
-
~tag_to_string:Fun.id ~tag_compare:String.compare
88
-
|> Jsont.Object.finish
85
+
Json.Codec.Object.map ~kind:"Incoming" Fun.id
86
+
|> Json.Codec.Object.case_mem "type" Json.Codec.string ~enc:Fun.id ~enc_case
87
+
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
88
+
|> Json.Codec.Object.finish
89
89
90
-
let pp ppf t = Jsont.pp_value jsont () ppf t
90
+
let pp ppf t = Json.pp_value json () ppf t
+3
-3
lib/incoming.mli
+3
-3
lib/incoming.mli
···
6
6
(** Incoming messages from the Claude CLI.
7
7
8
8
This module defines a discriminated union of all possible message types that
9
-
can be received from the Claude CLI, with a single jsont codec.
9
+
can be received from the Claude CLI, with a single json codec.
10
10
11
11
The codec uses the "type" field to discriminate between message types:
12
12
- "user", "assistant", "system", "result" -> Message variant
···
22
22
| Control_request of Control.control_request
23
23
| Rate_limit_event (** Rate limit usage info from the CLI. *)
24
24
25
-
val jsont : t Jsont.t
25
+
val json : t Json.codec
26
26
(** Codec for incoming messages. Uses the "type" field to discriminate. Use
27
-
[Jsont.pp_value jsont ()] for pretty-printing. *)
27
+
[Json.pp_value json ()] for pretty-printing. *)
28
28
29
29
val pp : Format.formatter -> t -> unit
30
30
(** [pp ppf t] pretty-prints the incoming message. *)
+52
-50
lib/mcp_server.ml
+52
-50
lib/mcp_server.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
module J = Jsont.Json
7
-
8
6
type t = {
9
7
name : string;
10
8
version : string;
···
21
19
let version t = t.version
22
20
let tools t = t.tools
23
21
24
-
(* JSONRPC helpers using Jsont.Json builders *)
22
+
(* JSONRPC helpers using Json.Json builders *)
25
23
26
24
let jsonrpc_success ~id result =
27
-
J.object'
25
+
Json.object'
28
26
[
29
-
J.mem (J.name "jsonrpc") (J.string "2.0");
30
-
J.mem (J.name "id") id;
31
-
J.mem (J.name "result") result;
27
+
Json.mem (Json.name "jsonrpc") (Json.string "2.0");
28
+
Json.mem (Json.name "id") id;
29
+
Json.mem (Json.name "result") result;
32
30
]
33
31
34
32
let jsonrpc_error ~id ~code ~message =
35
-
J.object'
33
+
Json.object'
36
34
[
37
-
J.mem (J.name "jsonrpc") (J.string "2.0");
38
-
J.mem (J.name "id") id;
39
-
J.mem (J.name "error")
40
-
(J.object'
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'
41
39
[
42
-
J.mem (J.name "code") (J.number (Float.of_int code));
43
-
J.mem (J.name "message") (J.string message);
40
+
Json.mem (Json.name "code") (Json.number (Float.of_int code));
41
+
Json.mem (Json.name "message") (Json.string message);
44
42
]);
45
43
]
46
44
47
45
(* Extract string from JSON *)
48
-
let string_of key (obj : Jsont.json) =
46
+
let string_of key (obj : Json.t) =
49
47
match obj with
50
-
| Jsont.Object (mems, _) -> (
51
-
match J.find_mem key mems with
52
-
| Some (_, Jsont.String (s, _)) -> Some s
48
+
| Json.Object (mems, _) -> (
49
+
match Json.find_mem key mems with
50
+
| Some (_, Json.String (s, _)) -> Some s
53
51
| _ -> None)
54
52
| _ -> None
55
53
56
54
(* Extract object from JSON *)
57
-
let object_of key (obj : Jsont.json) : Jsont.json option =
55
+
let object_of key (obj : Json.t) : Json.t option =
58
56
match obj with
59
-
| Jsont.Object (mems, _) -> (
60
-
match J.find_mem key mems with
61
-
| Some (_, (Jsont.Object _ as o)) -> Some o
57
+
| Json.Object (mems, _) -> (
58
+
match Json.find_mem key mems with
59
+
| Some (_, (Json.Object _ as o)) -> Some o
62
60
| _ -> None)
63
61
| _ -> None
64
62
65
63
(* Get ID from JSON message *)
66
-
let msg_id (msg : Jsont.json) : Jsont.json =
64
+
let msg_id (msg : Json.t) : Json.t =
67
65
match msg with
68
-
| Jsont.Object (mems, _) -> (
69
-
match J.find_mem "id" mems with Some (_, id) -> id | None -> J.null ())
70
-
| _ -> J.null ()
66
+
| Json.Object (mems, _) -> (
67
+
match Json.find_mem "id" mems with
68
+
| Some (_, id) -> id
69
+
| None -> Json.null ())
70
+
| _ -> Json.null ()
71
71
72
72
(* Handle initialize request *)
73
73
let handle_initialize t ~id =
74
74
jsonrpc_success ~id
75
-
(J.object'
75
+
(Json.object'
76
76
[
77
-
J.mem (J.name "protocolVersion") (J.string "2024-11-05");
78
-
J.mem (J.name "capabilities")
79
-
(J.object' [ J.mem (J.name "tools") (J.object' []) ]);
80
-
J.mem (J.name "serverInfo")
81
-
(J.object'
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'
82
82
[
83
-
J.mem (J.name "name") (J.string t.name);
84
-
J.mem (J.name "version") (J.string t.version);
83
+
Json.mem (Json.name "name") (Json.string t.name);
84
+
Json.mem (Json.name "version") (Json.string t.version);
85
85
]);
86
86
])
87
87
···
90
90
let tools_json =
91
91
List.map
92
92
(fun tool ->
93
-
J.object'
93
+
Json.object'
94
94
[
95
-
J.mem (J.name "name") (J.string (Tool.name tool));
96
-
J.mem (J.name "description") (J.string (Tool.description tool));
97
-
J.mem (J.name "inputSchema") (Tool.input_schema tool);
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);
98
99
])
99
100
t.tools
100
101
in
101
-
jsonrpc_success ~id (J.object' [ J.mem (J.name "tools") (J.list tools_json) ])
102
+
jsonrpc_success ~id
103
+
(Json.object' [ Json.mem (Json.name "tools") (Json.list tools_json) ])
102
104
103
105
(* Handle tools/call request *)
104
106
let handle_tools_call t ~id ~params =
···
113
115
let arguments =
114
116
match object_of "arguments" params with
115
117
| Some args -> args
116
-
| None -> J.object' []
118
+
| None -> Json.object' []
117
119
in
118
120
let input = Tool_input.of_json arguments in
119
121
match Tool.call tool input with
120
122
| Ok content ->
121
123
jsonrpc_success ~id
122
-
(J.object' [ J.mem (J.name "content") content ])
124
+
(Json.object' [ Json.mem (Json.name "content") content ])
123
125
| Error msg ->
124
126
(* Return error as content with is_error flag *)
125
127
jsonrpc_success ~id
126
-
(J.object'
128
+
(Json.object'
127
129
[
128
-
J.mem (J.name "content")
129
-
(J.list
130
+
Json.mem (Json.name "content")
131
+
(Json.list
130
132
[
131
-
J.object'
133
+
Json.object'
132
134
[
133
-
J.mem (J.name "type") (J.string "text");
134
-
J.mem (J.name "text") (J.string msg);
135
+
Json.mem (Json.name "type") (Json.string "text");
136
+
Json.mem (Json.name "text") (Json.string msg);
135
137
];
136
138
]);
137
-
J.mem (J.name "isError") (J.bool true);
139
+
Json.mem (Json.name "isError") (Json.bool true);
138
140
])))
139
141
140
142
let handle_request t ~method_ ~params ~id =
···
146
148
jsonrpc_error ~id ~code:(-32601)
147
149
~message:(Fmt.str "Method '%s' not found" method_)
148
150
149
-
let handle_json_message t (msg : Jsont.json) =
151
+
let handle_json_message t (msg : Json.t) =
150
152
let method_ = match string_of "method" msg with Some m -> m | None -> "" in
151
153
let params =
152
-
match object_of "params" msg with Some p -> p | None -> J.object' []
154
+
match object_of "params" msg with Some p -> p | None -> Json.object' []
153
155
in
154
156
let id = msg_id msg in
155
157
handle_request t ~method_ ~params ~id
+2
-3
lib/mcp_server.mli
+2
-3
lib/mcp_server.mli
···
66
66
67
67
(** {1 MCP Protocol Handling} *)
68
68
69
-
val handle_request :
70
-
t -> method_:string -> params:Jsont.json -> id:Jsont.json -> Jsont.json
69
+
val handle_request : t -> method_:string -> params:Json.t -> id:Json.t -> Json.t
71
70
(** [handle_request t ~method_ ~params ~id] handles an MCP JSONRPC request.
72
71
73
72
Returns a JSONRPC response object with the given [id].
···
79
78
80
79
Unknown methods return a JSONRPC error response. *)
81
80
82
-
val handle_json_message : t -> Jsont.json -> Jsont.json
81
+
val handle_json_message : t -> Json.t -> Json.t
83
82
(** [handle_json_message t msg] handles a complete JSONRPC message.
84
83
85
84
Extracts method, params, and id from the message and delegates to
+125
-111
lib/message.ml
+125
-111
lib/message.ml
···
32
32
33
33
let decode_content json =
34
34
match json with
35
-
| Jsont.String (s, _) -> String s
36
-
| Jsont.Array (items, _) ->
35
+
| Json.String (s, _) -> String s
36
+
| Json.Array (items, _) ->
37
37
let blocks =
38
38
List.map
39
39
(fun j ->
40
-
match Jsont.Json.decode Content_block.jsont j with
40
+
match Json.decode Content_block.json j with
41
41
| Ok v -> v
42
-
| Error e -> invalid_arg ("Invalid content block: " ^ e))
42
+
| Error e ->
43
+
invalid_arg
44
+
("Invalid content block: " ^ Json.Error.to_string e))
43
45
items
44
46
in
45
47
Blocks blocks
46
48
| _ -> failwith "Content must be string or array"
47
49
48
50
let encode_content = function
49
-
| String s -> Jsont.String (s, Jsont.Meta.none)
51
+
| String s -> Json.String (s, Json.Meta.none)
50
52
| Blocks blocks ->
51
53
let jsons =
52
54
List.map
53
55
(fun b ->
54
-
match Jsont.Json.encode Content_block.jsont b with
56
+
match Json.encode Content_block.json b with
55
57
| Ok json -> json
56
-
| Error e -> invalid_arg ("encode_content: " ^ e))
58
+
| Error e ->
59
+
invalid_arg ("encode_content: " ^ Json.Error.to_string e))
57
60
blocks
58
61
in
59
-
Jsont.Array (jsons, Jsont.Meta.none)
62
+
Json.Array (jsons, Json.Meta.none)
60
63
61
-
let jsont : t Jsont.t =
62
-
Jsont.Object.map ~kind:"User" (fun json_content unknown ->
64
+
let json : t Json.codec =
65
+
Json.Codec.Object.map ~kind:"User" (fun json_content unknown ->
63
66
let content = decode_content json_content in
64
67
make content unknown)
65
-
|> Jsont.Object.mem "content" Jsont.json ~enc:(fun t ->
68
+
|> Json.Codec.Object.mem "content" Json.Codec.Value.t ~enc:(fun t ->
66
69
encode_content (content t))
67
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
68
-
|> Jsont.Object.finish
70
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
71
+
|> Json.Codec.Object.finish
69
72
70
-
let incoming_jsont : t Jsont.t =
73
+
let incoming_jsont : t Json.codec =
71
74
let message_jsont =
72
-
Jsont.Object.map ~kind:"UserMessage" (fun json_content ->
75
+
Json.Codec.Object.map ~kind:"UserMessage" (fun json_content ->
73
76
let content = decode_content json_content in
74
77
{ content; unknown = Unknown.empty })
75
-
|> Jsont.Object.mem "content" Jsont.json ~enc:(fun t ->
78
+
|> Json.Codec.Object.mem "content" Json.Codec.Value.t ~enc:(fun t ->
76
79
encode_content (content t))
77
-
|> Jsont.Object.finish
80
+
|> Json.Codec.Object.finish
78
81
in
79
-
Jsont.Object.map ~kind:"UserEnvelope" Fun.id
80
-
|> Jsont.Object.mem "message" message_jsont ~enc:Fun.id
81
-
|> Jsont.Object.finish
82
+
Json.Codec.Object.map ~kind:"UserEnvelope" Fun.id
83
+
|> Json.Codec.Object.mem "message" message_jsont ~enc:Fun.id
84
+
|> Json.Codec.Object.finish
82
85
83
-
let outgoing_jsont : t Jsont.t =
86
+
let outgoing_jsont : t Json.codec =
84
87
let message_jsont =
85
-
Jsont.Object.map ~kind:"UserOutgoingMessage" (fun _role json_content ->
88
+
Json.Codec.Object.map ~kind:"UserOutgoingMessage"
89
+
(fun _role json_content ->
86
90
let content = decode_content json_content in
87
91
{ content; unknown = Unknown.empty })
88
-
|> Jsont.Object.mem "role" Jsont.string ~enc:(fun _ -> "user")
89
-
|> Jsont.Object.mem "content" Jsont.json ~enc:(fun t ->
92
+
|> Json.Codec.Object.mem "role" Json.Codec.string ~enc:(fun _ -> "user")
93
+
|> Json.Codec.Object.mem "content" Json.Codec.Value.t ~enc:(fun t ->
90
94
encode_content (content t))
91
-
|> Jsont.Object.finish
95
+
|> Json.Codec.Object.finish
92
96
in
93
-
Jsont.Object.map ~kind:"UserOutgoingEnvelope" Fun.id
94
-
|> Jsont.Object.mem "message" message_jsont ~enc:Fun.id
95
-
|> Jsont.Object.finish
97
+
Json.Codec.Object.map ~kind:"UserOutgoingEnvelope" Fun.id
98
+
|> Json.Codec.Object.mem "message" message_jsont ~enc:Fun.id
99
+
|> Json.Codec.Object.finish
96
100
97
101
let to_json t =
98
-
match Jsont.Json.encode jsont t with
102
+
match Json.encode json t with
99
103
| Ok json -> json
100
-
| Error e -> invalid_arg ("User.to_json: " ^ e)
104
+
| Error e -> invalid_arg ("User.to_json: " ^ Json.Error.to_string e)
101
105
end
102
106
103
107
module Assistant = struct
···
109
113
| `Server_error
110
114
| `Unknown ]
111
115
112
-
let error_jsont : error Jsont.t =
113
-
Jsont.enum
116
+
let error_jsont : error Json.codec =
117
+
Json.Codec.enum
114
118
[
115
119
("authentication_failed", `Authentication_failed);
116
120
("billing_error", `Billing_error);
···
160
164
161
165
let combined_text t = String.concat "\n" (text_blocks t)
162
166
163
-
let jsont : t Jsont.t =
164
-
Jsont.Object.map ~kind:"Assistant" make
165
-
|> Jsont.Object.mem "content" (Jsont.list Content_block.jsont) ~enc:content
166
-
|> Jsont.Object.mem "model" Jsont.string ~enc:model
167
-
|> Jsont.Object.opt_mem "error" error_jsont ~enc:error
168
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
169
-
|> Jsont.Object.finish
167
+
let json : t Json.codec =
168
+
Json.Codec.Object.map ~kind:"Assistant" make
169
+
|> Json.Codec.Object.mem "content"
170
+
(Json.Codec.list Content_block.json)
171
+
~enc:content
172
+
|> Json.Codec.Object.mem "model" Json.Codec.string ~enc:model
173
+
|> Json.Codec.Object.opt_mem "error" error_jsont ~enc:error
174
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
175
+
|> Json.Codec.Object.finish
170
176
171
-
let incoming_jsont : t Jsont.t =
172
-
Jsont.Object.map ~kind:"AssistantEnvelope" Fun.id
173
-
|> Jsont.Object.mem "message" jsont ~enc:Fun.id
174
-
|> Jsont.Object.finish
177
+
let incoming_jsont : t Json.codec =
178
+
Json.Codec.Object.map ~kind:"AssistantEnvelope" Fun.id
179
+
|> Json.Codec.Object.mem "message" json ~enc:Fun.id
180
+
|> Json.Codec.Object.finish
175
181
176
182
let to_json t =
177
-
match Jsont.Json.encode jsont t with
183
+
match Json.encode json t with
178
184
| Ok json -> json
179
-
| Error e -> invalid_arg ("Assistant.to_json: " ^ e)
185
+
| Error e -> invalid_arg ("Assistant.to_json: " ^ Json.Error.to_string e)
180
186
end
181
187
182
188
module System = struct
···
204
210
205
211
let error ~error = Error { error; unknown = Unknown.empty }
206
212
207
-
let init_jsont : init Jsont.t =
213
+
let init_jsont : init Json.codec =
208
214
let make session_id model cwd unknown : init =
209
215
{ session_id; model; cwd; unknown }
210
216
in
211
-
Jsont.Object.map ~kind:"SystemInit" make
212
-
|> Jsont.Object.opt_mem "session_id" Jsont.string ~enc:(fun (r : init) ->
213
-
r.session_id)
214
-
|> Jsont.Object.opt_mem "model" Jsont.string ~enc:(fun (r : init) ->
215
-
r.model)
216
-
|> Jsont.Object.opt_mem "cwd" Jsont.string ~enc:(fun (r : init) -> r.cwd)
217
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : init) -> r.unknown)
218
-
|> Jsont.Object.finish
217
+
Json.Codec.Object.map ~kind:"SystemInit" make
218
+
|> Json.Codec.Object.opt_mem "session_id" Json.Codec.string
219
+
~enc:(fun (r : init) -> r.session_id)
220
+
|> Json.Codec.Object.opt_mem "model" Json.Codec.string
221
+
~enc:(fun (r : init) -> r.model)
222
+
|> Json.Codec.Object.opt_mem "cwd" Json.Codec.string ~enc:(fun (r : init) ->
223
+
r.cwd)
224
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : init) ->
225
+
r.unknown)
226
+
|> Json.Codec.Object.finish
219
227
220
-
let error_jsont : error Jsont.t =
228
+
let error_jsont : error Json.codec =
221
229
let make err unknown : error = { error = err; unknown } in
222
-
Jsont.Object.map ~kind:"SystemError" make
223
-
|> Jsont.Object.mem "error" Jsont.string ~enc:(fun (r : error) -> r.error)
224
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
230
+
Json.Codec.Object.map ~kind:"SystemError" make
231
+
|> Json.Codec.Object.mem "error" Json.Codec.string ~enc:(fun (r : error) ->
232
+
r.error)
233
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(fun (r : error) ->
225
234
r.unknown)
226
-
|> Jsont.Object.finish
235
+
|> Json.Codec.Object.finish
227
236
228
-
let jsont : t Jsont.t =
237
+
let json : t Json.codec =
229
238
let case_init =
230
-
Jsont.Object.Case.map "init" init_jsont ~dec:(fun v -> Init v)
239
+
Json.Codec.Object.Case.map "init" init_jsont ~dec:(fun v -> Init v)
231
240
in
232
241
let case_error =
233
-
Jsont.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
242
+
Json.Codec.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
234
243
in
235
244
let enc_case = function
236
-
| Init v -> Jsont.Object.Case.value case_init v
237
-
| Error v -> Jsont.Object.Case.value case_error v
245
+
| Init v -> Json.Codec.Object.Case.value case_init v
246
+
| Error v -> Json.Codec.Object.Case.value case_error v
238
247
in
239
-
let cases = Jsont.Object.Case.[ make case_init; make case_error ] in
240
-
Jsont.Object.map ~kind:"System" Fun.id
241
-
|> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases
242
-
~tag_to_string:Fun.id ~tag_compare:String.compare
243
-
|> Jsont.Object.finish
248
+
let cases = Json.Codec.Object.Case.[ make case_init; make case_error ] in
249
+
Json.Codec.Object.map ~kind:"System" Fun.id
250
+
|> Json.Codec.Object.case_mem "subtype" Json.Codec.string ~enc:Fun.id
251
+
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
252
+
|> Json.Codec.Object.finish
244
253
245
254
let to_json t =
246
-
match Jsont.Json.encode jsont t with
255
+
match Json.encode json t with
247
256
| Ok json -> json
248
-
| Error e -> invalid_arg ("System.to_json: " ^ e)
257
+
| Error e -> invalid_arg ("System.to_json: " ^ Json.Error.to_string e)
249
258
end
250
259
251
260
module Result = struct
···
288
297
let cache_read_input_tokens t = t.cache_read_input_tokens
289
298
let unknown t = t.unknown
290
299
291
-
let jsont : t Jsont.t =
292
-
Jsont.Object.map ~kind:"Usage" make
293
-
|> Jsont.Object.opt_mem "input_tokens" Jsont.int ~enc:input_tokens
294
-
|> Jsont.Object.opt_mem "output_tokens" Jsont.int ~enc:output_tokens
295
-
|> Jsont.Object.opt_mem "total_tokens" Jsont.int ~enc:total_tokens
296
-
|> Jsont.Object.opt_mem "cache_creation_input_tokens" Jsont.int
300
+
let json : t Json.codec =
301
+
Json.Codec.Object.map ~kind:"Usage" make
302
+
|> Json.Codec.Object.opt_mem "input_tokens" Json.Codec.int
303
+
~enc:input_tokens
304
+
|> Json.Codec.Object.opt_mem "output_tokens" Json.Codec.int
305
+
~enc:output_tokens
306
+
|> Json.Codec.Object.opt_mem "total_tokens" Json.Codec.int
307
+
~enc:total_tokens
308
+
|> Json.Codec.Object.opt_mem "cache_creation_input_tokens" Json.Codec.int
297
309
~enc:cache_creation_input_tokens
298
-
|> Jsont.Object.opt_mem "cache_read_input_tokens" Jsont.int
310
+
|> Json.Codec.Object.opt_mem "cache_read_input_tokens" Json.Codec.int
299
311
~enc:cache_read_input_tokens
300
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
301
-
|> Jsont.Object.finish
312
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
313
+
|> Json.Codec.Object.finish
302
314
end
303
315
304
316
type t = {
···
311
323
total_cost_usd : float option;
312
324
usage : Usage.t option;
313
325
result : string option;
314
-
structured_output : Jsont.json option;
326
+
structured_output : Json.t option;
315
327
unknown : Unknown.t;
316
328
}
317
329
···
360
372
let structured_output t = t.structured_output
361
373
let unknown t = t.unknown
362
374
363
-
let jsont : t Jsont.t =
364
-
Jsont.Object.map ~kind:"Result" make
365
-
|> Jsont.Object.mem "subtype" Jsont.string ~enc:subtype
366
-
|> Jsont.Object.mem "duration_ms" Jsont.int ~enc:duration_ms
367
-
|> Jsont.Object.mem "duration_api_ms" Jsont.int ~enc:duration_api_ms
368
-
|> Jsont.Object.mem "is_error" Jsont.bool ~enc:is_error
369
-
|> Jsont.Object.mem "num_turns" Jsont.int ~enc:num_turns
370
-
|> Jsont.Object.mem "session_id" Jsont.string ~enc:session_id
371
-
|> Jsont.Object.opt_mem "total_cost_usd" Jsont.number ~enc:total_cost_usd
372
-
|> Jsont.Object.opt_mem "usage" Usage.jsont ~enc:usage
373
-
|> Jsont.Object.opt_mem "result" Jsont.string ~enc:result
374
-
|> Jsont.Object.opt_mem "structured_output" Jsont.json
375
+
let json : t Json.codec =
376
+
Json.Codec.Object.map ~kind:"Result" make
377
+
|> Json.Codec.Object.mem "subtype" Json.Codec.string ~enc:subtype
378
+
|> Json.Codec.Object.mem "duration_ms" Json.Codec.int ~enc:duration_ms
379
+
|> Json.Codec.Object.mem "duration_api_ms" Json.Codec.int
380
+
~enc:duration_api_ms
381
+
|> Json.Codec.Object.mem "is_error" Json.Codec.bool ~enc:is_error
382
+
|> Json.Codec.Object.mem "num_turns" Json.Codec.int ~enc:num_turns
383
+
|> Json.Codec.Object.mem "session_id" Json.Codec.string ~enc:session_id
384
+
|> Json.Codec.Object.opt_mem "total_cost_usd" Json.Codec.number
385
+
~enc:total_cost_usd
386
+
|> Json.Codec.Object.opt_mem "usage" Usage.json ~enc:usage
387
+
|> Json.Codec.Object.opt_mem "result" Json.Codec.string ~enc:result
388
+
|> Json.Codec.Object.opt_mem "structured_output" Json.Codec.Value.t
375
389
~enc:structured_output
376
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
377
-
|> Jsont.Object.finish
390
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
391
+
|> Json.Codec.Object.finish
378
392
379
393
let to_json t =
380
-
match Jsont.Json.encode jsont t with
394
+
match Json.encode json t with
381
395
| Ok json -> json
382
-
| Error e -> invalid_arg ("Result.to_json: " ^ e)
396
+
| Error e -> invalid_arg ("Result.to_json: " ^ Json.Error.to_string e)
383
397
end
384
398
385
399
type t =
···
388
402
| System of System.t
389
403
| Result of Result.t
390
404
391
-
let jsont : t Jsont.t =
392
-
let case_map kind obj dec = Jsont.Object.Case.map kind obj ~dec in
405
+
let json : t Json.codec =
406
+
let case_map kind obj dec = Json.Codec.Object.Case.map kind obj ~dec in
393
407
let case_user = case_map "user" User.incoming_jsont (fun v -> User v) in
394
408
let case_assistant =
395
409
case_map "assistant" Assistant.incoming_jsont (fun v -> Assistant v)
396
410
in
397
-
let case_system = case_map "system" System.jsont (fun v -> System v) in
398
-
let case_result = case_map "result" Result.jsont (fun v -> Result v) in
411
+
let case_system = case_map "system" System.json (fun v -> System v) in
412
+
let case_result = case_map "result" Result.json (fun v -> Result v) in
399
413
let enc_case = function
400
-
| User v -> Jsont.Object.Case.value case_user v
401
-
| Assistant v -> Jsont.Object.Case.value case_assistant v
402
-
| System v -> Jsont.Object.Case.value case_system v
403
-
| Result v -> Jsont.Object.Case.value case_result v
414
+
| User v -> Json.Codec.Object.Case.value case_user v
415
+
| Assistant v -> Json.Codec.Object.Case.value case_assistant v
416
+
| System v -> Json.Codec.Object.Case.value case_system v
417
+
| Result v -> Json.Codec.Object.Case.value case_result v
404
418
in
405
419
let cases =
406
-
Jsont.Object.Case.
420
+
Json.Codec.Object.Case.
407
421
[
408
422
make case_user; make case_assistant; make case_system; make case_result;
409
423
]
410
424
in
411
-
Jsont.Object.map ~kind:"Message" Fun.id
412
-
|> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
413
-
~tag_to_string:Fun.id ~tag_compare:String.compare
414
-
|> Jsont.Object.finish
425
+
Json.Codec.Object.map ~kind:"Message" Fun.id
426
+
|> Json.Codec.Object.case_mem "type" Json.Codec.string ~enc:Fun.id ~enc_case
427
+
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
428
+
|> Json.Codec.Object.finish
415
429
416
430
let is_user = function User _ -> true | _ -> false
417
431
let is_assistant = function Assistant _ -> true | _ -> false
···
447
461
448
462
let user_string s = User (User.of_string s)
449
463
let user_blocks blocks = User (User.of_blocks blocks)
450
-
let pp ppf t = Jsont.pp_value jsont () ppf t
464
+
let pp ppf t = Json.pp_value json () ppf t
451
465
let log_received t = Log.info (fun m -> m "<- %a" pp t)
452
466
let log_sending t = Log.info (fun m -> m "-> %a" pp t)
+17
-17
lib/message.mli
+17
-17
lib/message.mli
···
21
21
(** [of_blocks blocks] creates a user message with content blocks. *)
22
22
23
23
val with_tool_result :
24
-
tool_use_id:string -> content:Jsont.json -> ?is_error:bool -> unit -> t
24
+
tool_use_id:string -> content:Json.t -> ?is_error:bool -> unit -> t
25
25
(** [with_tool_result ~tool_use_id ~content ?is_error ()] creates a user
26
26
message containing a tool result. Content can be a string or array. *)
27
27
···
36
36
(** [blocks t] returns the content blocks, or a single text block if it's a
37
37
string message. *)
38
38
39
-
val jsont : t Jsont.t
40
-
val incoming_jsont : t Jsont.t
41
-
val outgoing_jsont : t Jsont.t
42
-
val to_json : t -> Jsont.json
39
+
val json : t Json.codec
40
+
val incoming_jsont : t Json.codec
41
+
val outgoing_jsont : t Json.codec
42
+
val to_json : t -> Json.t
43
43
end
44
44
45
45
(** {1 Assistant Messages} *)
···
67
67
val thinking_blocks : t -> Content_block.Thinking.t list
68
68
val combined_text : t -> string
69
69
val has_tool_use : t -> bool
70
-
val jsont : t Jsont.t
71
-
val incoming_jsont : t Jsont.t
72
-
val to_json : t -> Jsont.json
70
+
val json : t Json.codec
71
+
val incoming_jsont : t Json.codec
72
+
val to_json : t -> Json.t
73
73
end
74
74
75
75
(** {1 System Messages} *)
···
95
95
val unknown : t -> Unknown.t
96
96
val init : ?session_id:string -> ?model:string -> ?cwd:string -> unit -> t
97
97
val error : error:string -> t
98
-
val jsont : t Jsont.t
99
-
val to_json : t -> Jsont.json
98
+
val json : t Json.codec
99
+
val to_json : t -> Json.t
100
100
end
101
101
102
102
(** {1 Result Messages} *)
···
120
120
val cache_creation_input_tokens : t -> int option
121
121
val cache_read_input_tokens : t -> int option
122
122
val unknown : t -> Unknown.t
123
-
val jsont : t Jsont.t
123
+
val json : t Json.codec
124
124
end
125
125
126
126
type t
···
135
135
?total_cost_usd:float ->
136
136
?usage:Usage.t ->
137
137
?result:string ->
138
-
?structured_output:Jsont.json ->
138
+
?structured_output:Json.t ->
139
139
unit ->
140
140
t
141
141
···
149
149
val usage : t -> Usage.t option
150
150
val result : t -> string option
151
151
val result_text : t -> string option
152
-
val structured_output : t -> Jsont.json option
152
+
val structured_output : t -> Json.t option
153
153
val unknown : t -> Unknown.t
154
-
val jsont : t Jsont.t
155
-
val to_json : t -> Jsont.json
154
+
val json : t Json.codec
155
+
val to_json : t -> Json.t
156
156
end
157
157
158
158
(** {1 Message Union Type} *)
···
163
163
| System of System.t
164
164
| Result of Result.t
165
165
166
-
val jsont : t Jsont.t
166
+
val json : t Json.codec
167
167
168
168
(** {1 Internal - wire format conversion} *)
169
169
170
-
val to_json : t -> Jsont.json
170
+
val to_json : t -> Json.t
171
171
172
172
(** {1 Convenience Constructors} *)
173
173
+2
-2
lib/model.ml
+2
-2
lib/model.ml
+2
-2
lib/model.mli
+2
-2
lib/model.mli
···
46
46
- "claude-opus-4-6" or "opus" becomes [`Opus_4_6].
47
47
- "future-model" becomes [`Custom "future-model"]. *)
48
48
49
-
val jsont : t Jsont.t
50
-
(** [jsont] is the Jsont codec for model identifiers. *)
49
+
val json : t Json.codec
50
+
(** [json] is the Jsont codec for model identifiers. *)
+32
-27
lib/options.ml
+32
-27
lib/options.ml
···
10
10
module Wire = struct
11
11
type setting_source = User | Project | Local
12
12
13
-
let setting_source_jsont : setting_source Jsont.t =
14
-
Jsont.enum [ ("user", User); ("project", Project); ("local", Local) ]
13
+
let setting_source_jsont : setting_source Json.codec =
14
+
Json.Codec.enum [ ("user", User); ("project", Project); ("local", Local) ]
15
15
16
16
type t = {
17
17
allowed_tools : string list;
···
126
126
let with_output_format output_format t =
127
127
{ t with output_format = Some output_format }
128
128
129
-
let jsont : t Jsont.t =
129
+
let json : t Json.codec =
130
130
let make allowed_tools disallowed_tools max_thinking_tokens system_prompt
131
131
append_system_prompt permission_mode model continue_conversation resume
132
132
max_turns permission_prompt_tool_name settings add_dirs max_budget_usd
···
155
155
unknown;
156
156
}
157
157
in
158
-
Jsont.Object.(
158
+
Json.Codec.Object.(
159
159
map ~kind:"Options" make
160
-
|> mem "allowedTools" (Jsont.list Jsont.string) ~enc:allowed_tools
161
-
~dec_absent:[]
162
-
|> mem "disallowedTools" (Jsont.list Jsont.string) ~enc:disallowed_tools
163
-
~dec_absent:[]
164
-
|> opt_mem "maxThinkingTokens" Jsont.int ~enc:max_thinking_tokens
165
-
|> opt_mem "systemPrompt" Jsont.string ~enc:system_prompt
166
-
|> opt_mem "appendSystemPrompt" Jsont.string ~enc:append_system_prompt
167
-
|> opt_mem "permissionMode" Permissions.Mode.jsont ~enc:permission_mode
168
-
|> opt_mem "model" Model.jsont ~enc:model
169
-
|> mem "continueConversation" Jsont.bool ~enc:continue_conversation
160
+
|> mem "allowedTools"
161
+
(Json.Codec.list Json.Codec.string)
162
+
~enc:allowed_tools ~dec_absent:[]
163
+
|> mem "disallowedTools"
164
+
(Json.Codec.list Json.Codec.string)
165
+
~enc:disallowed_tools ~dec_absent:[]
166
+
|> opt_mem "maxThinkingTokens" Json.Codec.int ~enc:max_thinking_tokens
167
+
|> opt_mem "systemPrompt" Json.Codec.string ~enc:system_prompt
168
+
|> opt_mem "appendSystemPrompt" Json.Codec.string
169
+
~enc:append_system_prompt
170
+
|> opt_mem "permissionMode" Permissions.Mode.json ~enc:permission_mode
171
+
|> opt_mem "model" Model.json ~enc:model
172
+
|> mem "continueConversation" Json.Codec.bool ~enc:continue_conversation
170
173
~dec_absent:false
171
-
|> opt_mem "resume" Jsont.string ~enc:resume
172
-
|> opt_mem "maxTurns" Jsont.int ~enc:max_turns
173
-
|> opt_mem "permissionPromptToolName" Jsont.string
174
+
|> opt_mem "resume" Json.Codec.string ~enc:resume
175
+
|> opt_mem "maxTurns" Json.Codec.int ~enc:max_turns
176
+
|> opt_mem "permissionPromptToolName" Json.Codec.string
174
177
~enc:permission_prompt_tool_name
175
-
|> opt_mem "settings" Jsont.string ~enc:settings
176
-
|> mem "addDirs" (Jsont.list Jsont.string) ~enc:add_dirs ~dec_absent:[]
177
-
|> opt_mem "maxBudgetUsd" Jsont.number ~enc:max_budget_usd
178
-
|> opt_mem "fallbackModel" Model.jsont ~enc:fallback_model
178
+
|> opt_mem "settings" Json.Codec.string ~enc:settings
179
+
|> mem "addDirs"
180
+
(Json.Codec.list Json.Codec.string)
181
+
~enc:add_dirs ~dec_absent:[]
182
+
|> opt_mem "maxBudgetUsd" Json.Codec.number ~enc:max_budget_usd
183
+
|> opt_mem "fallbackModel" Model.json ~enc:fallback_model
179
184
|> opt_mem "settingSources"
180
-
(Jsont.list setting_source_jsont)
185
+
(Json.Codec.list setting_source_jsont)
181
186
~enc:setting_sources
182
-
|> opt_mem "maxBufferSize" Jsont.int ~enc:max_buffer_size
183
-
|> opt_mem "user" Jsont.string ~enc:user
184
-
|> opt_mem "outputFormat" Structured_output.jsont ~enc:output_format
187
+
|> opt_mem "maxBufferSize" Json.Codec.int ~enc:max_buffer_size
188
+
|> opt_mem "user" Json.Codec.string ~enc:user
189
+
|> opt_mem "outputFormat" Structured_output.json ~enc:output_format
185
190
|> keep_unknown Unknown.mems ~enc:unknown
186
191
|> finish)
187
192
188
-
let pp ppf t = Jsont.pp_value jsont () ppf t
193
+
let pp ppf t = Json.pp_value json () ppf t
189
194
end
190
195
191
196
type t = {
···
359
364
|> apply_opt t.output_format Wire.with_output_format
360
365
end
361
366
362
-
let pp ppf t = Jsont.pp_value Wire.jsont () ppf (Advanced.to_wire t)
367
+
let pp ppf t = Json.pp_value Wire.json () ppf (Advanced.to_wire t)
+2
-2
lib/options.mli
+2
-2
lib/options.mli
···
94
94
module Wire : sig
95
95
type setting_source = User | Project | Local
96
96
97
-
val setting_source_jsont : setting_source Jsont.t
97
+
val setting_source_jsont : setting_source Json.codec
98
98
99
99
type t
100
100
101
101
val empty : t
102
102
val pp : Format.formatter -> t -> unit
103
-
val jsont : t Jsont.t
103
+
val json : t Json.codec
104
104
val allowed_tools : t -> string list
105
105
val disallowed_tools : t -> string list
106
106
val max_thinking_tokens : t -> int option
+24
-24
lib/outgoing.ml
+24
-24
lib/outgoing.ml
···
8
8
| Control_request of Control.control_request
9
9
| Control_response of Control.control_response
10
10
11
-
let jsont : t Jsont.t =
11
+
let json : t Json.codec =
12
12
let case_control_request =
13
-
Jsont.Object.Case.map "control_request" Control.control_request_jsont
13
+
Json.Codec.Object.Case.map "control_request" Control.control_request_jsont
14
14
~dec:(fun v -> Control_request v)
15
15
in
16
16
let case_control_response =
17
-
Jsont.Object.Case.map "control_response" Control.control_response_jsont
17
+
Json.Codec.Object.Case.map "control_response" Control.control_response_jsont
18
18
~dec:(fun v -> Control_response v)
19
19
in
20
20
let case_user =
21
-
Jsont.Object.Case.map "user" Message.User.outgoing_jsont ~dec:(fun v ->
21
+
Json.Codec.Object.Case.map "user" Message.User.outgoing_jsont ~dec:(fun v ->
22
22
Message (Message.User v))
23
23
in
24
24
let case_assistant =
25
-
Jsont.Object.Case.map "assistant" Message.Assistant.jsont ~dec:(fun v ->
25
+
Json.Codec.Object.Case.map "assistant" Message.Assistant.json ~dec:(fun v ->
26
26
Message (Message.Assistant v))
27
27
in
28
28
let case_system =
29
-
Jsont.Object.Case.map "system" Message.System.jsont ~dec:(fun v ->
29
+
Json.Codec.Object.Case.map "system" Message.System.json ~dec:(fun v ->
30
30
Message (Message.System v))
31
31
in
32
32
let case_result =
33
-
Jsont.Object.Case.map "result" Message.Result.jsont ~dec:(fun v ->
33
+
Json.Codec.Object.Case.map "result" Message.Result.json ~dec:(fun v ->
34
34
Message (Message.Result v))
35
35
in
36
36
let enc_case = function
37
-
| Control_request v -> Jsont.Object.Case.value case_control_request v
38
-
| Control_response v -> Jsont.Object.Case.value case_control_response v
37
+
| Control_request v -> Json.Codec.Object.Case.value case_control_request v
38
+
| Control_response v -> Json.Codec.Object.Case.value case_control_response v
39
39
| Message msg -> (
40
40
match msg with
41
-
| Message.User u -> Jsont.Object.Case.value case_user u
42
-
| Message.Assistant a -> Jsont.Object.Case.value case_assistant a
43
-
| Message.System s -> Jsont.Object.Case.value case_system s
44
-
| Message.Result r -> Jsont.Object.Case.value case_result r)
41
+
| Message.User u -> Json.Codec.Object.Case.value case_user u
42
+
| Message.Assistant a -> Json.Codec.Object.Case.value case_assistant a
43
+
| Message.System s -> Json.Codec.Object.Case.value case_system s
44
+
| Message.Result r -> Json.Codec.Object.Case.value case_result r)
45
45
in
46
46
let cases =
47
-
Jsont.Object.Case.
47
+
Json.Codec.Object.Case.
48
48
[
49
49
make case_control_request;
50
50
make case_control_response;
···
54
54
make case_result;
55
55
]
56
56
in
57
-
Jsont.Object.map ~kind:"Outgoing" Fun.id
58
-
|> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
59
-
~tag_to_string:Fun.id ~tag_compare:String.compare
60
-
|> Jsont.Object.finish
57
+
Json.Codec.Object.map ~kind:"Outgoing" Fun.id
58
+
|> Json.Codec.Object.case_mem "type" Json.Codec.string ~enc:Fun.id ~enc_case
59
+
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
60
+
|> Json.Codec.Object.finish
61
61
62
-
let pp ppf t = Jsont.pp_value jsont () ppf t
62
+
let pp ppf t = Json.pp_value json () ppf t
63
63
64
64
let to_json t =
65
-
match Jsont.Json.encode jsont t with
65
+
match Json.encode json t with
66
66
| Ok json -> json
67
-
| Error e -> invalid_arg ("to_json: " ^ e)
67
+
| Error e -> invalid_arg ("to_json: " ^ Json.Error.to_string e)
68
68
69
-
let of_json json =
70
-
match Jsont.Json.decode jsont json with
69
+
let of_json v =
70
+
match Json.decode json v with
71
71
| Ok v -> v
72
-
| Error e -> invalid_arg ("of_json: " ^ e)
72
+
| Error e -> invalid_arg ("of_json: " ^ Json.Error.to_string e)
+3
-3
lib/outgoing.mli
+3
-3
lib/outgoing.mli
···
10
10
| Control_request of Control.control_request
11
11
| Control_response of Control.control_response
12
12
13
-
val jsont : t Jsont.t
13
+
val json : t Json.codec
14
14
(** Codec for outgoing messages. *)
15
15
16
16
val pp : Format.formatter -> t -> unit
17
17
(** [pp ppf t] pretty-prints the outgoing message. *)
18
18
19
-
val to_json : t -> Jsont.json
19
+
val to_json : t -> Json.t
20
20
(** [to_json t] converts an outgoing message to JSON. *)
21
21
22
-
val of_json : Jsont.json -> t
22
+
val of_json : Json.t -> t
23
23
(** [of_json json] parses an outgoing message from JSON.
24
24
@raise Invalid_argument if parsing fails. *)
+57
-52
lib/permissions.ml
+57
-52
lib/permissions.ml
···
24
24
| s ->
25
25
raise (Invalid_argument (Fmt.str "Mode.of_string: unknown mode %s" s))
26
26
27
-
let jsont : t Jsont.t =
28
-
Jsont.enum
27
+
let json : t Json.codec =
28
+
Json.Codec.enum
29
29
[
30
30
("default", Default);
31
31
("acceptEdits", Accept_edits);
···
48
48
(Invalid_argument
49
49
(Fmt.str "Behavior.of_string: unknown behavior %s" s))
50
50
51
-
let jsont : t Jsont.t =
52
-
Jsont.enum [ ("allow", Allow); ("deny", Deny); ("ask", Ask) ]
51
+
let json : t Json.codec =
52
+
Json.Codec.enum [ ("allow", Allow); ("deny", Deny); ("ask", Ask) ]
53
53
end
54
54
55
55
module Rule = struct
···
66
66
let rule_content t = t.rule_content
67
67
let unknown t = t.unknown
68
68
69
-
let jsont : t Jsont.t =
69
+
let json : t Json.codec =
70
70
let make tool_name rule_content unknown =
71
71
{ tool_name; rule_content; unknown }
72
72
in
73
-
Jsont.Object.map ~kind:"Rule" make
74
-
|> Jsont.Object.mem "toolName" Jsont.string ~enc:tool_name
75
-
|> Jsont.Object.opt_mem "ruleContent" Jsont.string ~enc:rule_content
76
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
77
-
|> Jsont.Object.finish
73
+
Json.Codec.Object.map ~kind:"Rule" make
74
+
|> Json.Codec.Object.mem "toolName" Json.Codec.string ~enc:tool_name
75
+
|> Json.Codec.Object.opt_mem "ruleContent" Json.Codec.string
76
+
~enc:rule_content
77
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
78
+
|> Json.Codec.Object.finish
78
79
end
79
80
80
81
module Update = struct
···
84
85
| Local_settings
85
86
| Session
86
87
87
-
let destination_jsont : destination Jsont.t =
88
-
Jsont.enum
88
+
let destination_jsont : destination Json.codec =
89
+
Json.Codec.enum
89
90
[
90
91
("userSettings", User_settings);
91
92
("projectSettings", Project_settings);
···
101
102
| Add_directories
102
103
| Remove_directories
103
104
104
-
let update_type_jsont : update_type Jsont.t =
105
-
Jsont.enum
105
+
let update_type_jsont : update_type Json.codec =
106
+
Json.Codec.enum
106
107
[
107
108
("addRules", Add_rules);
108
109
("replaceRules", Replace_rules);
···
134
135
let destination t = t.destination
135
136
let unknown t = t.unknown
136
137
137
-
let jsont : t Jsont.t =
138
+
let json : t Json.codec =
138
139
let make update_type rules behavior mode directories destination unknown =
139
140
{ update_type; rules; behavior; mode; directories; destination; unknown }
140
141
in
141
-
Jsont.Object.map ~kind:"Update" make
142
-
|> Jsont.Object.mem "type" update_type_jsont ~enc:update_type
143
-
|> Jsont.Object.opt_mem "rules" (Jsont.list Rule.jsont) ~enc:rules
144
-
|> Jsont.Object.opt_mem "behavior" Behavior.jsont ~enc:behavior
145
-
|> Jsont.Object.opt_mem "mode" Mode.jsont ~enc:mode
146
-
|> Jsont.Object.opt_mem "directories" (Jsont.list Jsont.string)
142
+
Json.Codec.Object.map ~kind:"Update" make
143
+
|> Json.Codec.Object.mem "type" update_type_jsont ~enc:update_type
144
+
|> Json.Codec.Object.opt_mem "rules" (Json.Codec.list Rule.json) ~enc:rules
145
+
|> Json.Codec.Object.opt_mem "behavior" Behavior.json ~enc:behavior
146
+
|> Json.Codec.Object.opt_mem "mode" Mode.json ~enc:mode
147
+
|> Json.Codec.Object.opt_mem "directories"
148
+
(Json.Codec.list Json.Codec.string)
147
149
~enc:directories
148
-
|> Jsont.Object.opt_mem "destination" destination_jsont ~enc:destination
149
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
150
-
|> Jsont.Object.finish
150
+
|> Json.Codec.Object.opt_mem "destination" destination_jsont
151
+
~enc:destination
152
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
153
+
|> Json.Codec.Object.finish
151
154
end
152
155
153
156
module Context = struct
···
159
162
let suggestions t = t.suggestions
160
163
let unknown t = t.unknown
161
164
162
-
let jsont : t Jsont.t =
165
+
let json : t Json.codec =
163
166
let make suggestions unknown = { suggestions; unknown } in
164
-
Jsont.Object.map ~kind:"Context" make
165
-
|> Jsont.Object.mem "suggestions" (Jsont.list Update.jsont) ~enc:suggestions
166
-
~dec_absent:[]
167
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown
168
-
|> Jsont.Object.finish
167
+
Json.Codec.Object.map ~kind:"Context" make
168
+
|> Json.Codec.Object.mem "suggestions"
169
+
(Json.Codec.list Update.json)
170
+
~enc:suggestions ~dec_absent:[]
171
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:unknown
172
+
|> Json.Codec.Object.finish
169
173
end
170
174
171
175
module Result = struct
172
176
type t =
173
177
| Allow of {
174
-
updated_input : Jsont.json option;
178
+
updated_input : Json.t option;
175
179
updated_permissions : Update.t list option;
176
180
unknown : Unknown.t;
177
181
}
···
183
187
let deny ~message ~interrupt ?(unknown = Unknown.empty) () =
184
188
Deny { message; interrupt; unknown }
185
189
186
-
let jsont : t Jsont.t =
190
+
let json : t Json.codec =
187
191
let allow_record =
188
192
let make updated_input updated_permissions unknown =
189
193
Allow { updated_input; updated_permissions; unknown }
190
194
in
191
-
Jsont.Object.map ~kind:"AllowRecord" make
192
-
|> Jsont.Object.mem "updatedInput" (Jsont.option Jsont.json)
195
+
Json.Codec.Object.map ~kind:"AllowRecord" make
196
+
|> Json.Codec.Object.mem "updatedInput"
197
+
(Json.Codec.option Json.Codec.Value.t)
193
198
~enc:(function
194
199
| Allow { updated_input; _ } -> updated_input | _ -> None)
195
200
~dec_absent:None
196
-
|> Jsont.Object.opt_mem "updatedPermissions" (Jsont.list Update.jsont)
197
-
~enc:(function
201
+
|> Json.Codec.Object.opt_mem "updatedPermissions"
202
+
(Json.Codec.list Update.json) ~enc:(function
198
203
| Allow { updated_permissions; _ } -> updated_permissions
199
204
| _ -> None)
200
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(function
205
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(function
201
206
| Allow { unknown; _ } -> unknown
202
207
| _ -> Unknown.empty)
203
-
|> Jsont.Object.finish
208
+
|> Json.Codec.Object.finish
204
209
in
205
210
let deny_record =
206
211
let make message interrupt unknown =
207
212
Deny { message; interrupt; unknown }
208
213
in
209
-
Jsont.Object.map ~kind:"DenyRecord" make
210
-
|> Jsont.Object.mem "message" Jsont.string ~enc:(function
214
+
Json.Codec.Object.map ~kind:"DenyRecord" make
215
+
|> Json.Codec.Object.mem "message" Json.Codec.string ~enc:(function
211
216
| Deny { message; _ } -> message
212
217
| _ -> "")
213
-
|> Jsont.Object.mem "interrupt" Jsont.bool ~enc:(function
218
+
|> Json.Codec.Object.mem "interrupt" Json.Codec.bool ~enc:(function
214
219
| Deny { interrupt; _ } -> interrupt
215
220
| _ -> false)
216
-
|> Jsont.Object.keep_unknown Unknown.mems ~enc:(function
221
+
|> Json.Codec.Object.keep_unknown Unknown.mems ~enc:(function
217
222
| Deny { unknown; _ } -> unknown
218
223
| _ -> Unknown.empty)
219
-
|> Jsont.Object.finish
224
+
|> Json.Codec.Object.finish
220
225
in
221
226
let case_allow =
222
-
Jsont.Object.Case.map "allow" allow_record ~dec:(fun v -> v)
227
+
Json.Codec.Object.Case.map "allow" allow_record ~dec:(fun v -> v)
223
228
in
224
229
let case_deny =
225
-
Jsont.Object.Case.map "deny" deny_record ~dec:(fun v -> v)
230
+
Json.Codec.Object.Case.map "deny" deny_record ~dec:(fun v -> v)
226
231
in
227
232
let enc_case = function
228
-
| Allow _ as v -> Jsont.Object.Case.value case_allow v
229
-
| Deny _ as v -> Jsont.Object.Case.value case_deny v
233
+
| Allow _ as v -> Json.Codec.Object.Case.value case_allow v
234
+
| Deny _ as v -> Json.Codec.Object.Case.value case_deny v
230
235
in
231
-
let cases = Jsont.Object.Case.[ make case_allow; make case_deny ] in
232
-
Jsont.Object.map ~kind:"Result" Fun.id
233
-
|> Jsont.Object.case_mem "behavior" Jsont.string ~enc:Fun.id ~enc_case cases
234
-
~tag_to_string:Fun.id ~tag_compare:String.compare
235
-
|> Jsont.Object.finish
236
+
let cases = Json.Codec.Object.Case.[ make case_allow; make case_deny ] in
237
+
Json.Codec.Object.map ~kind:"Result" Fun.id
238
+
|> Json.Codec.Object.case_mem "behavior" Json.Codec.string ~enc:Fun.id
239
+
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
240
+
|> Json.Codec.Object.finish
236
241
end
237
242
238
243
module Decision = struct
+10
-10
lib/permissions.mli
+10
-10
lib/permissions.mli
···
14
14
15
15
val to_string : t -> string
16
16
val of_string : string -> t
17
-
val jsont : t Jsont.t
17
+
val json : t Json.codec
18
18
end
19
19
20
20
(** {1 Behaviors} *)
···
24
24
25
25
val to_string : t -> string
26
26
val of_string : string -> t
27
-
val jsont : t Jsont.t
27
+
val json : t Json.codec
28
28
end
29
29
30
30
(** {1 Permission Rules} *)
···
38
38
val tool_name : t -> string
39
39
val rule_content : t -> string option
40
40
val unknown : t -> Unknown.t
41
-
val jsont : t Jsont.t
41
+
val json : t Json.codec
42
42
end
43
43
44
44
(** {1 Permission Updates} *)
···
50
50
| Local_settings
51
51
| Session
52
52
53
-
val destination_jsont : destination Jsont.t
53
+
val destination_jsont : destination Json.codec
54
54
55
55
type update_type =
56
56
| Add_rules
···
60
60
| Add_directories
61
61
| Remove_directories
62
62
63
-
val update_type_jsont : update_type Jsont.t
63
+
val update_type_jsont : update_type Json.codec
64
64
65
65
type t
66
66
···
82
82
val directories : t -> string list option
83
83
val destination : t -> destination option
84
84
val unknown : t -> Unknown.t
85
-
val jsont : t Jsont.t
85
+
val json : t Json.codec
86
86
end
87
87
88
88
(** {1 Wire-level Permission Context} *)
···
93
93
val create : ?suggestions:Update.t list -> ?unknown:Unknown.t -> unit -> t
94
94
val suggestions : t -> Update.t list
95
95
val unknown : t -> Unknown.t
96
-
val jsont : t Jsont.t
96
+
val json : t Json.codec
97
97
end
98
98
99
99
(** {1 Wire-level Permission Result} *)
···
101
101
module Result : sig
102
102
type t =
103
103
| Allow of {
104
-
updated_input : Jsont.json option;
104
+
updated_input : Json.t option;
105
105
updated_permissions : Update.t list option;
106
106
unknown : Unknown.t;
107
107
}
108
108
| Deny of { message : string; interrupt : bool; unknown : Unknown.t }
109
109
110
110
val allow :
111
-
?updated_input:Jsont.json ->
111
+
?updated_input:Json.t ->
112
112
?updated_permissions:Update.t list ->
113
113
?unknown:Unknown.t ->
114
114
unit ->
115
115
t
116
116
117
117
val deny : message:string -> interrupt:bool -> ?unknown:Unknown.t -> unit -> t
118
-
val jsont : t Jsont.t
118
+
val json : t Json.codec
119
119
end
120
120
121
121
(** {1 Permission Decisions (typed)} *)
+1
-1
lib/response.mli
+1
-1
lib/response.mli
···
125
125
val result_text : t -> string option
126
126
(** [result_text t] returns the optional result string. *)
127
127
128
-
val structured_output : t -> Jsont.json option
128
+
val structured_output : t -> Json.t option
129
129
(** [structured_output t] returns the optional structured JSON output. *)
130
130
131
131
val of_result : Message.Result.t -> t
+17
-16
lib/structured_output.ml
+17
-16
lib/structured_output.ml
···
7
7
8
8
module Log = (val Logs.src_log src : Logs.LOG)
9
9
10
-
type t = { json_schema : Jsont.json }
10
+
type t = { json_schema : Json.t }
11
11
12
-
let pp ppf t = Jsont.pp_json ppf t.json_schema
13
-
14
-
let json_to_string json =
15
-
match Jsont_bytesrw.encode_string' Jsont.json json with
16
-
| Ok str -> str
17
-
| Error err -> failwith (Jsont.Error.to_string err)
12
+
let pp ppf t = Json.pp_json ppf t.json_schema
13
+
let json_to_string json = Json.Value.to_string json
18
14
19
15
let of_json_schema schema =
20
16
Log.debug (fun m ->
···
24
20
let json_schema t = t.json_schema
25
21
let to_json_schema = json_schema
26
22
27
-
let jsont : t Jsont.t =
28
-
Jsont.Object.map ~kind:"StructuredOutput" (fun json_schema -> { json_schema })
29
-
|> Jsont.Object.mem "jsonSchema" Jsont.json ~enc:(fun t -> t.json_schema)
30
-
|> Jsont.Object.finish
23
+
let json : t Json.codec =
24
+
let open Json.Codec in
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
31
28
32
29
let to_json t =
33
-
match Jsont.Json.encode jsont t with
30
+
match Json.encode json t with
34
31
| Ok json -> json
35
-
| Error msg -> failwith ("Structured_output.to_json: " ^ msg)
32
+
| Error err ->
33
+
failwith ("Structured_output.to_json: " ^ Json.Error.to_string err)
36
34
37
-
let of_json json =
38
-
match Jsont.Json.decode jsont json with
35
+
let of_json v =
36
+
match Json.decode json v with
39
37
| Ok t -> t
40
-
| Error msg -> raise (Invalid_argument ("Structured_output.of_json: " ^ msg))
38
+
| Error err ->
39
+
raise
40
+
(Invalid_argument
41
+
("Structured_output.of_json: " ^ Json.Error.to_string err))
+8
-8
lib/structured_output.mli
+8
-8
lib/structured_output.mli
···
21
21
val pp : Format.formatter -> t -> unit
22
22
(** [pp ppf t] pretty-prints the structured output configuration. *)
23
23
24
-
val of_json_schema : Jsont.json -> t
24
+
val of_json_schema : Json.t -> t
25
25
(** [of_json_schema schema] creates an output format from a JSON Schema.
26
26
27
-
The schema should be a valid JSON Schema Draft 7 as a {!type:Jsont.json}
28
-
value. *)
27
+
The schema should be a valid JSON Schema Draft 7 as a {!type:Json.t} value.
28
+
*)
29
29
30
-
val json_schema : t -> Jsont.json
30
+
val json_schema : t -> Json.t
31
31
(** [json_schema t] returns the underlying JSON Schema. *)
32
32
33
-
val to_json_schema : t -> Jsont.json
33
+
val to_json_schema : t -> Json.t
34
34
(** [to_json_schema t] is an alias of {!json_schema}. *)
35
35
36
-
val jsont : t Jsont.t
36
+
val json : t Json.codec
37
37
(** Codec for structured output format. *)
38
38
39
39
(** {1 Serialization} *)
40
40
41
-
val to_json : t -> Jsont.json
41
+
val to_json : t -> Json.t
42
42
(** [to_json t] converts the output format to its JSON representation. *)
43
43
44
-
val of_json : Jsont.json -> t
44
+
val of_json : Json.t -> t
45
45
(** [of_json json] parses an output format from JSON.
46
46
@raise Invalid_argument if the JSON is not a valid output format. *)
+33
-31
lib/tool.ml
+33
-31
lib/tool.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
module J = Jsont.Json
7
-
8
6
type t = {
9
7
name : string;
10
8
description : string;
11
-
input_schema : Jsont.json;
12
-
handler : Tool_input.t -> (Jsont.json, string) result;
9
+
input_schema : Json.t;
10
+
handler : Tool_input.t -> (Json.t, string) result;
13
11
}
14
12
15
13
let v ~name ~description ~input_schema ~handler =
···
20
18
let description t = t.description
21
19
let input_schema t = t.input_schema
22
20
let call t input = t.handler input
23
-
24
-
(* Convenience constructors using Jsont.Json builders *)
25
21
26
22
let text_result s =
27
-
J.list
23
+
Json.list
28
24
[
29
-
J.object'
25
+
Json.object'
30
26
[
31
-
J.mem (J.name "type") (J.string "text");
32
-
J.mem (J.name "text") (J.string s);
27
+
Json.mem (Json.name "type") (Json.string "text");
28
+
Json.mem (Json.name "text") (Json.string s);
33
29
];
34
30
]
35
31
36
32
let error_result s =
37
-
J.list
33
+
Json.list
38
34
[
39
-
J.object'
35
+
Json.object'
40
36
[
41
-
J.mem (J.name "type") (J.string "text");
42
-
J.mem (J.name "text") (J.string s);
43
-
J.mem (J.name "is_error") (J.bool true);
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);
44
40
];
45
41
]
46
42
47
-
(* Schema helpers *)
43
+
let schema_string =
44
+
Json.object' [ Json.mem (Json.name "type") (Json.string "string") ]
48
45
49
-
let schema_string = J.object' [ J.mem (J.name "type") (J.string "string") ]
50
-
let schema_int = J.object' [ J.mem (J.name "type") (J.string "integer") ]
51
-
let schema_number = J.object' [ J.mem (J.name "type") (J.string "number") ]
52
-
let schema_bool = J.object' [ J.mem (J.name "type") (J.string "boolean") ]
46
+
let schema_int =
47
+
Json.object' [ Json.mem (Json.name "type") (Json.string "integer") ]
48
+
49
+
let schema_number =
50
+
Json.object' [ Json.mem (Json.name "type") (Json.string "number") ]
51
+
52
+
let schema_bool =
53
+
Json.object' [ Json.mem (Json.name "type") (Json.string "boolean") ]
53
54
54
55
let schema_array item_schema =
55
-
J.object'
56
+
Json.object'
56
57
[
57
-
J.mem (J.name "type") (J.string "array");
58
-
J.mem (J.name "items") item_schema;
58
+
Json.mem (Json.name "type") (Json.string "array");
59
+
Json.mem (Json.name "items") item_schema;
59
60
]
60
61
61
62
let schema_string_enum values =
62
-
J.object'
63
+
Json.object'
63
64
[
64
-
J.mem (J.name "type") (J.string "string");
65
-
J.mem (J.name "enum") (J.list (List.map J.string values));
65
+
Json.mem (Json.name "type") (Json.string "string");
66
+
Json.mem (Json.name "enum") (Json.list (List.map Json.string values));
66
67
]
67
68
68
69
let schema_object props ~required =
69
-
J.object'
70
+
Json.object'
70
71
[
71
-
J.mem (J.name "type") (J.string "object");
72
-
J.mem (J.name "properties")
73
-
(J.object' (List.map (fun (k, v) -> J.mem (J.name k) v) props));
74
-
J.mem (J.name "required") (J.list (List.map J.string required));
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));
75
77
]
+13
-14
lib/tool.mli
+13
-14
lib/tool.mli
···
55
55
val v :
56
56
name:string ->
57
57
description:string ->
58
-
input_schema:Jsont.json ->
59
-
handler:(Tool_input.t -> (Jsont.json, string) result) ->
58
+
input_schema:Json.t ->
59
+
handler:(Tool_input.t -> (Json.t, string) result) ->
60
60
t
61
61
(** [v ~name ~description ~input_schema ~handler] creates a custom tool.
62
62
···
79
79
val description : t -> string
80
80
(** [description t] returns the tool's description. *)
81
81
82
-
val input_schema : t -> Jsont.json
82
+
val input_schema : t -> Json.t
83
83
(** [input_schema t] returns the JSON Schema for inputs. *)
84
84
85
-
val call : t -> Tool_input.t -> (Jsont.json, string) result
85
+
val call : t -> Tool_input.t -> (Json.t, string) result
86
86
(** [call t input] invokes the tool handler with the given input. *)
87
87
88
88
(** {1 Convenience Constructors}
89
89
90
90
Helper functions for common tool patterns. *)
91
91
92
-
val text_result : string -> Jsont.json
92
+
val text_result : string -> Json.t
93
93
(** [text_result s] creates a text content result:
94
94
[\`A [\`O ["type", \`String "text"; "text", \`String s]]]. *)
95
95
96
-
val error_result : string -> Jsont.json
96
+
val error_result : string -> Json.t
97
97
(** [error_result s] creates an error content result with is_error flag. *)
98
98
99
99
(** {2 Schema Helpers}
100
100
101
101
Build JSON Schema objects more easily. *)
102
102
103
-
val schema_object :
104
-
(string * Jsont.json) list -> required:string list -> Jsont.json
103
+
val schema_object : (string * Json.t) list -> required:string list -> Json.t
105
104
(** [schema_object props ~required] creates an object schema.
106
105
{[
107
106
schema_object
···
109
108
~required:[ "name" ]
110
109
]} *)
111
110
112
-
val schema_string : Jsont.json
111
+
val schema_string : Json.t
113
112
(** [schema_string] is string type schema: [{"type": "string"}]. *)
114
113
115
-
val schema_int : Jsont.json
114
+
val schema_int : Json.t
116
115
(** [schema_int] is integer type schema: [{"type": "integer"}]. *)
117
116
118
-
val schema_number : Jsont.json
117
+
val schema_number : Json.t
119
118
(** [schema_number] is number type schema: [{"type": "number"}]. *)
120
119
121
-
val schema_bool : Jsont.json
120
+
val schema_bool : Json.t
122
121
(** [schema_bool] is boolean type schema: [{"type": "boolean"}]. *)
123
122
124
-
val schema_array : Jsont.json -> Jsont.json
123
+
val schema_array : Json.t -> Json.t
125
124
(** [schema_array item_schema] creates array schema with given item type. *)
126
125
127
-
val schema_string_enum : string list -> Jsont.json
126
+
val schema_string_enum : string list -> Json.t
128
127
(** [schema_string_enum values] creates enum schema for string values. *)
+21
-49
lib/tool_input.ml
+21
-49
lib/tool_input.ml
···
5
5
6
6
(** Opaque tool input with typed accessors. *)
7
7
8
-
type t = Jsont.json
8
+
type t = Json.t
9
9
10
-
let pp = Jsont.pp_json
10
+
let pp = Json.pp_json
11
11
12
12
(** {1 Escape Hatch} *)
13
13
···
17
17
(** {1 Helper Functions} *)
18
18
19
19
(* Extract members from JSON object, or return empty list if not an object *)
20
-
let members = function Jsont.Object (members, _) -> members | _ -> []
20
+
let members = function Json.Object (members, _) -> members | _ -> []
21
21
22
22
(* Find a member by key in the object *)
23
23
let member key mems =
···
31
31
let mems = members t in
32
32
match member key mems with
33
33
| Some json -> (
34
-
match Jsont.Json.decode Jsont.string json with
34
+
match Json.decode Json.Codec.string json with
35
35
| Ok s -> Some s
36
36
| Error _ -> None)
37
37
| None -> None
···
40
40
let mems = members t in
41
41
match member key mems with
42
42
| Some json -> (
43
-
match Jsont.Json.decode Jsont.int json with
43
+
match Json.decode Json.Codec.int json with
44
44
| Ok i -> Some i
45
45
| Error _ -> None)
46
46
| None -> None
···
49
49
let mems = members t in
50
50
match member key mems with
51
51
| Some json -> (
52
-
match Jsont.Json.decode Jsont.bool json with
52
+
match Json.decode Json.Codec.bool json with
53
53
| Ok b -> Some b
54
54
| Error _ -> None)
55
55
| None -> None
···
58
58
let mems = members t in
59
59
match member key mems with
60
60
| Some json -> (
61
-
match Jsont.Json.decode Jsont.number json with
61
+
match Json.decode Json.Codec.number json with
62
62
| Ok f -> Some f
63
63
| Error _ -> None)
64
64
| None -> None
···
68
68
match member key mems with
69
69
| Some json -> (
70
70
match json with
71
-
| Jsont.Array (items, _) ->
71
+
| Json.Array (items, _) ->
72
72
let strings =
73
73
List.filter_map
74
74
(fun item ->
75
-
match Jsont.Json.decode Jsont.string item with
75
+
match Json.decode Json.Codec.string item with
76
76
| Ok s -> Some s
77
77
| Error _ -> None)
78
78
items
79
79
in
80
-
(* Only return Some if all items were strings *)
81
80
if List.length strings = List.length items then Some strings else None
82
81
| _ -> None)
83
82
| None -> None
···
88
87
89
88
let is_empty t =
90
89
match t with
91
-
| Jsont.Object ([], _) -> true
92
-
| Jsont.Object _ -> false
90
+
| Json.Object ([], _) -> true
91
+
| Json.Object _ -> false
93
92
| _ -> true
94
93
95
94
(** {1 Construction} *)
96
95
97
-
let empty = Jsont.Object ([], Jsont.Meta.none)
96
+
let empty = Json.Object ([], Json.Meta.none)
98
97
99
98
let add_member key value t =
100
99
let mems = members t in
101
-
let new_member = ((key, Jsont.Meta.none), value) in
100
+
let new_member = ((key, Json.Meta.none), value) in
102
101
(* Replace existing member or add new one *)
103
102
let filtered_members = List.filter (fun ((name, _), _) -> name <> key) mems in
104
-
Jsont.Object (new_member :: filtered_members, Jsont.Meta.none)
105
-
106
-
let add_string key value t =
107
-
let json_value =
108
-
match Jsont.Json.encode Jsont.string value with
109
-
| Ok json -> json
110
-
| Error _ -> failwith "add_string: encoding failed"
111
-
in
112
-
add_member key json_value t
103
+
Json.Object (new_member :: filtered_members, Json.Meta.none)
113
104
114
-
let add_int key value t =
115
-
let json_value =
116
-
match Jsont.Json.encode Jsont.int value with
117
-
| Ok json -> json
118
-
| Error _ -> failwith "add_int: encoding failed"
119
-
in
120
-
add_member key json_value t
121
-
122
-
let add_bool key value t =
123
-
let json_value =
124
-
match Jsont.Json.encode Jsont.bool value with
125
-
| Ok json -> json
126
-
| Error _ -> failwith "add_bool: encoding failed"
127
-
in
128
-
add_member key json_value t
129
-
130
-
let add_float key value t =
131
-
let json_value =
132
-
match Jsont.Json.encode Jsont.number value with
133
-
| Ok json -> json
134
-
| Error _ -> failwith "add_float: encoding failed"
135
-
in
136
-
add_member key json_value t
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
137
109
138
110
let of_assoc assoc =
139
111
let members =
140
-
List.map (fun (key, json) -> ((key, Jsont.Meta.none), json)) assoc
112
+
List.map (fun (key, json) -> ((key, Json.Meta.none), json)) assoc
141
113
in
142
-
Jsont.Object (members, Jsont.Meta.none)
114
+
Json.Object (members, Json.Meta.none)
143
115
144
116
let of_string_pairs pairs =
145
117
let assoc =
146
118
List.map
147
-
(fun (key, value) -> (key, Jsont.String (value, Jsont.Meta.none)))
119
+
(fun (key, value) -> (key, Json.String (value, Json.Meta.none)))
148
120
pairs
149
121
in
150
122
of_assoc assoc
+3
-3
lib/tool_input.mli
+3
-3
lib/tool_input.mli
···
42
42
43
43
(** {1 Escape Hatch} *)
44
44
45
-
val to_json : t -> Jsont.json
45
+
val to_json : t -> Json.t
46
46
(** [to_json t] returns the underlying JSON for advanced use cases. *)
47
47
48
-
val of_json : Jsont.json -> t
48
+
val of_json : Json.t -> t
49
49
(** [of_json json] wraps JSON as a tool input. *)
50
50
51
51
(** {1 Construction} *)
···
65
65
val add_float : string -> float -> t -> t
66
66
(** [add_float key value t] adds a float field. *)
67
67
68
-
val of_assoc : (string * Jsont.json) list -> t
68
+
val of_assoc : (string * Json.t) list -> t
69
69
(** [of_assoc assoc] creates tool input from an association list. *)
70
70
71
71
val of_string_pairs : (string * string) list -> t
+2
-8
lib/transport.ml
+2
-8
lib/transport.ml
···
57
57
(Option.map
58
58
(fun format ->
59
59
let schema = Structured_output.to_json_schema format in
60
-
match Jsont_bytesrw.encode_string' Jsont.json schema with
61
-
| Ok s -> s
62
-
| Error err -> failwith (Jsont.Error.to_string err))
60
+
Json.Value.to_string schema)
63
61
(Options.output_format options))
64
62
|> fun cmd -> cmd @ [ "--input-format"; "stream-json" ]
65
63
···
158
156
{ process = P process; stdin; stdin_close; stdout }
159
157
160
158
let send t json =
161
-
let data =
162
-
match Jsont_bytesrw.encode_string' Jsont.json json with
163
-
| Ok s -> s
164
-
| Error err -> failwith (Jsont.Error.to_string err)
165
-
in
159
+
let data = Json.Value.to_string json in
166
160
Log.debug (fun m -> m "Sending: %s" data);
167
161
try Eio.Flow.write t.stdin [ Cstruct.of_string (data ^ "\n") ]
168
162
with exn ->
+1
-1
lib/transport.mli
+1
-1
lib/transport.mli
+12
-13
lib/unknown.ml
+12
-13
lib/unknown.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
type t = (string * Jsont.json) list
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 Jsont.pp_json v in
9
+
let pp_pair ppf (k, v) = Fmt.pf ppf "@[%s: %a@]" k Json.pp_json v in
10
10
Fmt.pf ppf "@[{%a}@]"
11
11
(Fmt.list ~sep:(fun ppf () -> Fmt.pf ppf ",@ ") pp_pair)
12
12
t
···
16
16
let of_assoc x = x
17
17
let to_assoc x = x
18
18
19
-
let jsont =
20
-
let open Jsont in
19
+
let json =
20
+
let open Json.Codec in
21
21
let dec obj =
22
22
match obj with
23
-
| Object (fields, _) ->
23
+
| Json.Object (fields, _) ->
24
24
List.map (fun ((name, _meta), json) -> (name, json)) fields
25
25
| _ -> invalid_arg "Expected object"
26
26
in
27
27
let enc fields =
28
28
let mems =
29
-
List.map (fun (name, json) -> ((name, Meta.none), json)) fields
29
+
List.map (fun (name, json) -> ((name, Json.Meta.none), json)) fields
30
30
in
31
-
Object (mems, Meta.none)
31
+
Json.Object (mems, Json.Meta.none)
32
32
in
33
-
map ~dec ~enc json
33
+
map ~dec ~enc Value.t
34
34
35
-
let mems : (t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
36
-
let open Jsont in
35
+
let mems : (t, Json.t, Json.mem list) Json.Codec.Object.Mems.map =
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
39
39
let dec_finish _meta mems =
···
44
44
Object.Mems.enc =
45
45
(fun k fields acc ->
46
46
List.fold_left
47
-
(fun acc (name, json) -> k Meta.none name json acc)
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
52
-
Jsont.json
51
+
Object.Mems.map ~kind:"Unknown" ~dec_empty ~dec_add ~dec_finish ~enc Value.t
+6
-6
lib/unknown.mli
+6
-6
lib/unknown.mli
···
23
23
val is_empty : t -> bool
24
24
(** [is_empty t] returns [true] if there are no unknown fields stored in [t]. *)
25
25
26
-
val of_assoc : (string * Jsont.json) list -> t
26
+
val of_assoc : (string * Json.t) list -> t
27
27
(** [of_assoc assoc] creates unknown fields from an association list. *)
28
28
29
-
val to_assoc : t -> (string * Jsont.json) list
29
+
val to_assoc : t -> (string * Json.t) list
30
30
(** [to_assoc t] returns the association list of unknown fields. *)
31
31
32
-
val jsont : t Jsont.t
33
-
(** [jsont] is a codec for encoding and decoding unknown fields to/from JSON. *)
32
+
val json : t Json.codec
33
+
(** [json] is a codec for encoding and decoding unknown fields to/from JSON. *)
34
34
35
-
val mems : (t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map
36
-
(** [mems] is a mems codec for use with [Jsont.Object.keep_unknown]. *)
35
+
val mems : (t, Json.t, Json.mem list) Json.Codec.Object.Mems.map
36
+
(** [mems] is a mems codec for use with [Json.Codec.Object.keep_unknown]. *)
+1
-1
test/dune
+1
-1
test/dune
+1
-1
test/interop/python_sdk/dune
+1
-1
test/interop/python_sdk/dune
+12
-15
test/interop/python_sdk/test.ml
+12
-15
test/interop/python_sdk/test.ml
···
31
31
32
32
let trace name =
33
33
let path = Filename.concat "traces" ("control_" ^ name ^ ".json") in
34
-
match Jsont_bytesrw.decode_string' Jsont.json (read_file path) with
34
+
match Json.Value.of_string (read_file path) with
35
35
| Ok json -> json
36
-
| Error e -> Alcotest.failf "load %s: %s" path (Jsont.Error.to_string e)
36
+
| Error e -> Alcotest.failf "load %s: %s" path (Json.Error.to_string e)
37
37
38
38
let canonicalise json =
39
39
let rec go = function
40
-
| Jsont.Object (mems, meta) ->
40
+
| Json.Object (mems, meta) ->
41
41
let mems =
42
42
List.map
43
43
(fun ((name, name_meta), v) ->
44
44
let v' =
45
45
if name = "request_id" then
46
-
Jsont.String ("REQ_ID", Jsont.Meta.none)
46
+
Json.String ("REQ_ID", Json.Meta.none)
47
47
else go v
48
48
in
49
49
((name, name_meta), v'))
···
52
52
let sorted =
53
53
List.sort (fun ((a, _), _) ((b, _), _) -> String.compare a b) mems
54
54
in
55
-
Jsont.Object (sorted, meta)
56
-
| Jsont.Array (xs, meta) -> Jsont.Array (List.map go xs, meta)
55
+
Json.Object (sorted, meta)
56
+
| Json.Array (xs, meta) -> Json.Array (List.map go xs, meta)
57
57
| other -> other
58
58
in
59
59
go json
60
60
61
-
let to_string j =
62
-
match Jsont_bytesrw.encode_string' Jsont.json j with
63
-
| Ok s -> s
64
-
| Error e -> Alcotest.failf "encode: %s" (Jsont.Error.to_string e)
61
+
let to_string j = Json.Value.to_string j
65
62
66
63
let assert_equal ~name ~expected ~got =
67
64
let e = to_string (canonicalise expected) in
···
100
97
assert_equal ~name:"set_permission_mode" ~expected ~got
101
98
102
99
let json_object mems =
103
-
Jsont.Object
104
-
(List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) mems, Jsont.Meta.none)
100
+
Json.Object
101
+
(List.map (fun (k, v) -> ((k, Json.Meta.none), v)) mems, Json.Meta.none)
105
102
106
-
let json_string s = Jsont.String (s, Jsont.Meta.none)
107
-
let json_int n = Jsont.Number (float_of_int n, Jsont.Meta.none)
108
-
let json_array xs = Jsont.Array (xs, Jsont.Meta.none)
103
+
let json_string s = Json.String (s, Json.Meta.none)
104
+
let json_int n = Json.Number (float_of_int n, Json.Meta.none)
105
+
let json_array xs = Json.Array (xs, Json.Meta.none)
109
106
110
107
let test_initialize () =
111
108
let expected = trace "initialize" in
+24
-37
test/test_claude.ml
+24
-37
test/test_claude.ml
···
11
11
- Mcp_server module for in-process MCP servers
12
12
- Structured error handling *)
13
13
14
-
module J = Jsont.Json
14
+
module J = Json
15
15
16
16
(* ============================================
17
17
Protocol Tests - Incoming message codec
···
20
20
let test_decode_user_message () =
21
21
(* User messages from CLI come wrapped in a "message" envelope *)
22
22
let json_str = {|{"type":"user","message":{"content":"Hello"}}|} in
23
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
23
+
match Json.of_string Claude.Incoming.json json_str with
24
24
| Ok (Claude.Incoming.Message (Claude.Message.User _)) -> ()
25
25
| Ok _ -> Alcotest.fail "Wrong message type decoded"
26
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
26
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
27
27
28
28
let test_decode_assistant_message () =
29
29
(* Assistant messages from CLI come wrapped in a "message" envelope *)
30
30
let json_str =
31
31
{|{"type":"assistant","message":{"model":"claude-sonnet-4","content":[{"type":"text","text":"Hi"}]}}|}
32
32
in
33
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
33
+
match Json.of_string Claude.Incoming.json json_str with
34
34
| Ok (Claude.Incoming.Message (Claude.Message.Assistant _)) -> ()
35
35
| Ok _ -> Alcotest.fail "Wrong message type decoded"
36
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
36
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
37
37
38
38
let test_decode_system_message () =
39
39
let json_str =
40
40
{|{"type":"system","subtype":"init","data":{"session_id":"test-123"}}|}
41
41
in
42
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
42
+
match Json.of_string Claude.Incoming.json json_str with
43
43
| Ok (Claude.Incoming.Message (Claude.Message.System _)) -> ()
44
44
| Ok _ -> Alcotest.fail "Wrong message type decoded"
45
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
45
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
46
46
47
47
let test_decode_control_response_success () =
48
48
let json_str =
49
49
{|{"type":"control_response","response":{"subtype":"success","request_id":"test-req-1"}}|}
50
50
in
51
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
51
+
match Json.of_string Claude.Incoming.json json_str with
52
52
| Ok (Claude.Incoming.Control_response resp) -> (
53
53
match resp.response with
54
54
| Claude.Control.Response.Success s ->
···
56
56
| Claude.Control.Response.Error _ ->
57
57
Alcotest.fail "Got error response instead of success")
58
58
| Ok _ -> Alcotest.fail "Wrong message type decoded"
59
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
59
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
60
60
61
61
let test_decode_control_response_error () =
62
62
let json_str =
63
63
{|{"type":"control_response","response":{"subtype":"error","request_id":"test-req-2","error":{"code":-32603,"message":"Something went wrong"}}}|}
64
64
in
65
-
match Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str with
65
+
match Json.of_string Claude.Incoming.json json_str with
66
66
| Ok (Claude.Incoming.Control_response resp) -> (
67
67
match resp.response with
68
68
| Claude.Control.Response.Error e ->
···
73
73
| Claude.Control.Response.Success _ ->
74
74
Alcotest.fail "Got success response instead of error")
75
75
| Ok _ -> Alcotest.fail "Wrong message type decoded"
76
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
76
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
77
77
78
78
let protocol_tests =
79
79
[
···
93
93
94
94
let json_testable =
95
95
Alcotest.testable
96
-
(fun fmt json ->
97
-
match Jsont_bytesrw.encode_string' Jsont.json json with
98
-
| Ok s -> Format.pp_print_string fmt s
99
-
| Error e -> Format.pp_print_string fmt (Jsont.Error.to_string e))
100
-
(fun a b ->
101
-
match
102
-
( Jsont_bytesrw.encode_string' Jsont.json a,
103
-
Jsont_bytesrw.encode_string' Jsont.json b )
104
-
with
105
-
| Ok sa, Ok sb -> String.equal sa sb
106
-
| _ -> false)
96
+
(fun fmt json -> Format.pp_print_string fmt (Json.Value.to_string json))
97
+
(fun a b -> String.equal (Json.Value.to_string a) (Json.Value.to_string b))
107
98
108
99
let test_tool_schema_string () =
109
100
let schema = Claude.Tool.schema_string in
···
297
288
let response = Claude.Mcp_server.handle_json_message server request in
298
289
(* Check it's a success response with serverInfo *)
299
290
match response with
300
-
| Jsont.Object (mems, _) ->
291
+
| Json.Object (mems, _) ->
301
292
let has_result = List.exists (fun ((k, _), _) -> k = "result") mems in
302
293
Alcotest.(check bool) "has result" true has_result
303
294
| _ -> Alcotest.fail "Expected object response"
···
320
311
in
321
312
let response = Claude.Mcp_server.handle_json_message server request in
322
313
match response with
323
-
| Jsont.Object (mems, _) -> (
314
+
| Json.Object (mems, _) -> (
324
315
match List.find_opt (fun ((k, _), _) -> k = "result") mems with
325
-
| Some (_, Jsont.Object (result_mems, _)) -> (
316
+
| Some (_, Json.Object (result_mems, _)) -> (
326
317
match List.find_opt (fun ((k, _), _) -> k = "tools") result_mems with
327
-
| Some (_, Jsont.Array (tools, _)) ->
318
+
| Some (_, Json.Array (tools, _)) ->
328
319
Alcotest.(check int) "tools count" 1 (List.length tools)
329
320
| _ -> Alcotest.fail "Missing tools in result")
330
321
| _ -> Alcotest.fail "Missing result in response")
···
361
352
in
362
353
let response = Claude.Mcp_server.handle_json_message server request in
363
354
(* Verify it contains the expected uppercase result *)
364
-
let response_str =
365
-
match Jsont_bytesrw.encode_string' Jsont.json response with
366
-
| Ok s -> s
367
-
| Error _ -> ""
368
-
in
355
+
let response_str = Json.Value.to_string response in
369
356
(* Simple substring check for HELLO in response *)
370
357
let contains_hello =
371
358
let rec check i =
···
392
379
let response = Claude.Mcp_server.handle_json_message server request in
393
380
(* Should return an error response *)
394
381
match response with
395
-
| Jsont.Object (mems, _) ->
382
+
| Json.Object (mems, _) ->
396
383
let has_error = List.exists (fun ((k, _), _) -> k = "error") mems in
397
384
Alcotest.(check bool) "has error" true has_error
398
385
| _ -> Alcotest.fail "Expected object response"
···
410
397
in
411
398
let response = Claude.Mcp_server.handle_json_message server request in
412
399
match response with
413
-
| Jsont.Object (mems, _) ->
400
+
| Json.Object (mems, _) ->
414
401
let has_error = List.exists (fun ((k, _), _) -> k = "error") mems in
415
402
Alcotest.(check bool) "has error" true has_error
416
403
| _ -> Alcotest.fail "Expected object response"
···
462
449
let error_resp =
463
450
Claude.Control.Response.error ~request_id:"test-123" ~error:error_detail ()
464
451
in
465
-
match Jsont.Json.encode Claude.Control.Response.jsont error_resp with
452
+
match Json.encode Claude.Control.Response.json error_resp with
466
453
| Ok json -> (
467
-
match Jsont.Json.decode Claude.Control.Response.jsont json with
454
+
match Json.decode Claude.Control.Response.json json with
468
455
| Ok (Claude.Control.Response.Error decoded) ->
469
456
Alcotest.(check string) "request_id" "test-123" decoded.request_id;
470
457
Alcotest.(check int) "error code" (-32602) decoded.error.code;
471
458
Alcotest.(check string)
472
459
"error message" "Invalid parameters" decoded.error.message
473
460
| Ok _ -> Alcotest.fail "Wrong response type decoded"
474
-
| Error e -> Alcotest.fail e)
475
-
| Error e -> Alcotest.fail e
461
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
462
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
476
463
477
464
let structured_error_tests =
478
465
[
+8
-8
test/test_content_block.ml
+8
-8
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 = Jsont.Json.string "success" in
29
+
let content = Json.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)
···
62
62
| _ -> Alcotest.fail "Expected Thinking block"
63
63
64
64
let json_roundtrip block =
65
-
match Jsont.Json.encode CB.jsont block with
65
+
match Json.encode CB.json block with
66
66
| Ok json -> (
67
-
match Jsont.Json.decode CB.jsont json with
67
+
match Json.decode CB.json json with
68
68
| Ok back -> back
69
-
| Error e -> Alcotest.fail e)
70
-
| Error e -> Alcotest.fail e
69
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
70
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
71
71
72
72
let test_jsont_roundtrip_text () =
73
73
let block = CB.text "roundtrip test" in
···
112
112
Alcotest.test_case "tool_result no content" `Quick
113
113
test_tool_result_no_content;
114
114
Alcotest.test_case "thinking block" `Quick test_thinking_block;
115
-
Alcotest.test_case "jsont roundtrip text" `Quick test_jsont_roundtrip_text;
116
-
Alcotest.test_case "jsont roundtrip tool_use" `Quick
115
+
Alcotest.test_case "json roundtrip text" `Quick test_jsont_roundtrip_text;
116
+
Alcotest.test_case "json roundtrip tool_use" `Quick
117
117
test_jsont_roundtrip_tool_use;
118
-
Alcotest.test_case "jsont roundtrip thinking" `Quick
118
+
Alcotest.test_case "json roundtrip thinking" `Quick
119
119
test_jsont_roundtrip_thinking;
120
120
Alcotest.test_case "pp does not crash" `Quick test_pp_does_not_crash;
121
121
] )
+65
-68
test/test_control.ml
+65
-68
test/test_control.ml
···
11
11
| _ -> Alcotest.fail "Expected Interrupt"
12
12
13
13
let test_permission_request () =
14
-
let input = Jsont.Json.object' [] in
14
+
let input = Json.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
···
88
88
89
89
let test_request_jsont_interrupt () =
90
90
let req = C.Request.interrupt () in
91
-
match Jsont.Json.encode C.Request.jsont req with
91
+
match Json.encode C.Request.json req with
92
92
| Ok json -> (
93
-
match Jsont.Json.decode C.Request.jsont json with
93
+
match Json.decode C.Request.json json with
94
94
| Ok (C.Request.Interrupt _) -> ()
95
95
| Ok _ -> Alcotest.fail "Wrong variant"
96
-
| Error e -> Alcotest.fail e)
97
-
| Error e -> Alcotest.fail e
96
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
97
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
98
98
99
99
let test_request_jsont_permission () =
100
-
let input =
101
-
Jsont.Json.object'
102
-
[ Jsont.Json.mem (Jsont.Json.name "cmd") (Jsont.Json.string "ls") ]
103
-
in
100
+
let input = Json.object' [ Json.mem (Json.name "cmd") (Json.string "ls") ] in
104
101
let req = C.Request.permission ~tool_name:"Bash" ~input () in
105
-
match Jsont.Json.encode C.Request.jsont req with
102
+
match Json.encode C.Request.json req with
106
103
| Ok json -> (
107
-
match Jsont.Json.decode C.Request.jsont json with
104
+
match Json.decode C.Request.json json with
108
105
| Ok (C.Request.Permission p) ->
109
106
Alcotest.(check string) "tool_name" "Bash" p.tool_name
110
107
| Ok _ -> Alcotest.fail "Wrong variant"
111
-
| Error e -> Alcotest.fail e)
112
-
| Error e -> Alcotest.fail e
108
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
109
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
113
110
114
111
let test_request_jsont_set_model () =
115
112
let req = C.Request.set_model ~model:"claude-haiku-4" () in
116
-
match Jsont.Json.encode C.Request.jsont req with
113
+
match Json.encode C.Request.json req with
117
114
| Ok json -> (
118
-
match Jsont.Json.decode C.Request.jsont json with
115
+
match Json.decode C.Request.json json with
119
116
| Ok (C.Request.Set_model sm) ->
120
117
Alcotest.(check string) "model" "claude-haiku-4" sm.model
121
118
| Ok _ -> Alcotest.fail "Wrong variant"
122
-
| Error e -> Alcotest.fail e)
123
-
| Error e -> Alcotest.fail e
119
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
120
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
124
121
125
122
let test_request_jsont_get_server_info () =
126
123
let req = C.Request.get_server_info () in
127
-
match Jsont.Json.encode C.Request.jsont req with
124
+
match Json.encode C.Request.json req with
128
125
| Ok json -> (
129
-
match Jsont.Json.decode C.Request.jsont json with
126
+
match Json.decode C.Request.json json with
130
127
| Ok (C.Request.Get_server_info _) -> ()
131
128
| Ok _ -> Alcotest.fail "Wrong variant"
132
-
| Error e -> Alcotest.fail e)
133
-
| Error e -> Alcotest.fail e
129
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
130
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
134
131
135
132
let test_request_jsont_hook_callback () =
136
-
let input = Jsont.Json.object' [] in
133
+
let input = Json.object' [] in
137
134
let req = C.Request.hook_callback ~callback_id:"cb-1" ~input () in
138
-
match Jsont.Json.encode C.Request.jsont req with
135
+
match Json.encode C.Request.json req with
139
136
| Ok json -> (
140
-
match Jsont.Json.decode C.Request.jsont json with
137
+
match Json.decode C.Request.json json with
141
138
| Ok (C.Request.Hook_callback hc) ->
142
139
Alcotest.(check string) "callback_id" "cb-1" hc.callback_id
143
140
| Ok _ -> Alcotest.fail "Wrong variant"
144
-
| Error e -> Alcotest.fail e)
145
-
| Error e -> Alcotest.fail e
141
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
142
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
146
143
147
144
let test_request_jsont_mcp_message () =
148
-
let message = Jsont.Json.object' [] in
145
+
let message = Json.object' [] in
149
146
let req = C.Request.mcp_message ~server_name:"tools" ~message () in
150
-
match Jsont.Json.encode C.Request.jsont req with
147
+
match Json.encode C.Request.json req with
151
148
| Ok json -> (
152
-
match Jsont.Json.decode C.Request.jsont json with
149
+
match Json.decode C.Request.json json with
153
150
| Ok (C.Request.Mcp_message mm) ->
154
151
Alcotest.(check string) "server_name" "tools" mm.server_name
155
152
| Ok _ -> Alcotest.fail "Wrong variant"
156
-
| Error e -> Alcotest.fail e)
157
-
| Error e -> Alcotest.fail e
153
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
154
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
158
155
159
156
let test_response_jsont_success () =
160
157
let resp = C.Response.success ~request_id:"r1" () in
161
-
match Jsont.Json.encode C.Response.jsont resp with
158
+
match Json.encode C.Response.json resp with
162
159
| Ok json -> (
163
-
match Jsont.Json.decode C.Response.jsont json with
160
+
match Json.decode C.Response.json json with
164
161
| Ok (C.Response.Success s) ->
165
162
Alcotest.(check string) "request_id" "r1" s.request_id
166
163
| Ok _ -> Alcotest.fail "Wrong variant"
167
-
| Error e -> Alcotest.fail e)
168
-
| Error e -> Alcotest.fail e
164
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
165
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
169
166
170
167
let test_response_success_data () =
171
-
let data = Jsont.Json.string "result_data" in
168
+
let data = Json.string "result_data" in
172
169
let resp = C.Response.success ~request_id:"r2" ~response:data () in
173
-
match Jsont.Json.encode C.Response.jsont resp with
170
+
match Json.encode C.Response.json resp with
174
171
| Ok json -> (
175
-
match Jsont.Json.decode C.Response.jsont json with
172
+
match Json.decode C.Response.json json with
176
173
| Ok (C.Response.Success s) ->
177
174
Alcotest.(check bool) "has response" true (Option.is_some s.response)
178
175
| Ok _ -> Alcotest.fail "Wrong variant"
179
-
| Error e -> Alcotest.fail e)
180
-
| Error e -> Alcotest.fail e
176
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
177
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
181
178
182
179
let test_response_jsont_error () =
183
180
let detail =
184
181
C.Response.error_detail ~code:`Internal_error ~message:"oops" ()
185
182
in
186
183
let resp = C.Response.error ~request_id:"r3" ~error:detail () in
187
-
match Jsont.Json.encode C.Response.jsont resp with
184
+
match Json.encode C.Response.json resp with
188
185
| Ok json -> (
189
-
match Jsont.Json.decode C.Response.jsont json with
186
+
match Json.decode C.Response.json json with
190
187
| Ok (C.Response.Error e) ->
191
188
Alcotest.(check string) "request_id" "r3" e.request_id;
192
189
Alcotest.(check int) "code" (-32603) e.error.code;
193
190
Alcotest.(check string) "message" "oops" e.error.message
194
191
| Ok _ -> Alcotest.fail "Wrong variant"
195
-
| Error e -> Alcotest.fail e)
196
-
| Error e -> Alcotest.fail e
192
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
193
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
197
194
198
195
let test_server_info () =
199
196
let info =
···
212
209
C.Server_info.create ~version:"1.0.0" ~capabilities:[ "mcp" ] ~commands:[]
213
210
~output_styles:[] ()
214
211
in
215
-
match Jsont.Json.encode C.Server_info.jsont info with
212
+
match Json.encode C.Server_info.json info with
216
213
| Ok json -> (
217
-
match Jsont.Json.decode C.Server_info.jsont json with
214
+
match Json.decode C.Server_info.json json with
218
215
| Ok back ->
219
216
Alcotest.(check string) "version" "1.0.0" (C.Server_info.version back)
220
-
| Error e -> Alcotest.fail e)
221
-
| Error e -> Alcotest.fail e
217
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
218
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
222
219
223
220
let test_request_envelope () =
224
221
let req = C.Request.interrupt () in
···
245
242
unknown = Claude.Unknown.empty;
246
243
}
247
244
in
248
-
match Jsont.Json.encode C.control_request_jsont env with
245
+
match Json.encode C.control_request_jsont env with
249
246
| Ok json -> (
250
-
match Jsont.Json.decode C.control_request_jsont json with
247
+
match Json.decode C.control_request_jsont json with
251
248
| Ok back -> Alcotest.(check string) "request_id" "env-1" back.request_id
252
-
| Error e -> Alcotest.fail e)
253
-
| Error e -> Alcotest.fail e
249
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
250
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
254
251
255
252
let test_response_envelope_jsont () =
256
253
let resp = C.Response.success ~request_id:"x" () in
···
261
258
unknown = Claude.Unknown.empty;
262
259
}
263
260
in
264
-
match Jsont.Json.encode C.control_response_jsont env with
261
+
match Json.encode C.control_response_jsont env with
265
262
| Ok json -> (
266
-
match Jsont.Json.decode C.control_response_jsont json with
263
+
match Json.decode C.control_response_jsont json with
267
264
| Ok back -> (
268
265
match back.response with
269
266
| C.Response.Success _ -> ()
270
267
| _ -> Alcotest.fail "Wrong variant")
271
-
| Error e -> Alcotest.fail e)
272
-
| Error e -> Alcotest.fail e
268
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
269
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
273
270
274
271
let suite =
275
272
( "control",
···
287
284
Alcotest.test_case "error codes" `Quick test_error_codes;
288
285
Alcotest.test_case "error code of_int roundtrip" `Quick
289
286
test_error_code_of_int;
290
-
Alcotest.test_case "request jsont interrupt" `Quick
287
+
Alcotest.test_case "request json interrupt" `Quick
291
288
test_request_jsont_interrupt;
292
-
Alcotest.test_case "request jsont permission" `Quick
289
+
Alcotest.test_case "request json permission" `Quick
293
290
test_request_jsont_permission;
294
-
Alcotest.test_case "request jsont set_model" `Quick
291
+
Alcotest.test_case "request json set_model" `Quick
295
292
test_request_jsont_set_model;
296
-
Alcotest.test_case "request jsont get_server_info" `Quick
293
+
Alcotest.test_case "request json get_server_info" `Quick
297
294
test_request_jsont_get_server_info;
298
-
Alcotest.test_case "request jsont hook_callback" `Quick
295
+
Alcotest.test_case "request json hook_callback" `Quick
299
296
test_request_jsont_hook_callback;
300
-
Alcotest.test_case "request jsont mcp_message" `Quick
297
+
Alcotest.test_case "request json mcp_message" `Quick
301
298
test_request_jsont_mcp_message;
302
-
Alcotest.test_case "response jsont success" `Quick
299
+
Alcotest.test_case "response json success" `Quick
303
300
test_response_jsont_success;
304
-
Alcotest.test_case "response jsont success with data" `Quick
301
+
Alcotest.test_case "response json success with data" `Quick
305
302
test_response_success_data;
306
-
Alcotest.test_case "response jsont error" `Quick test_response_jsont_error;
303
+
Alcotest.test_case "response json error" `Quick test_response_jsont_error;
307
304
Alcotest.test_case "server_info" `Quick test_server_info;
308
-
Alcotest.test_case "server_info jsont roundtrip" `Quick
305
+
Alcotest.test_case "server_info json roundtrip" `Quick
309
306
test_server_info_jsont_roundtrip;
310
307
Alcotest.test_case "request envelope" `Quick test_request_envelope;
311
308
Alcotest.test_case "response envelope" `Quick test_response_envelope;
312
-
Alcotest.test_case "request envelope jsont" `Quick
309
+
Alcotest.test_case "request envelope json" `Quick
313
310
test_request_envelope_jsont;
314
-
Alcotest.test_case "response envelope jsont" `Quick
311
+
Alcotest.test_case "response envelope json" `Quick
315
312
test_response_envelope_jsont;
316
313
] )
+8
-9
test/test_incoming.ml
+8
-9
test/test_incoming.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
let decode_incoming json_str =
7
-
Jsont_bytesrw.decode_string' Claude.Incoming.jsont json_str
6
+
let decode_incoming json_str = Json.of_string Claude.Incoming.json json_str
8
7
9
8
let test_decode_system_init () =
10
9
let json =
···
22
21
"cwd" (Some "/tmp")
23
22
(Claude.Message.System.cwd sys)
24
23
| Ok _ -> Alcotest.fail "Wrong message type"
25
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
24
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
26
25
27
26
let test_decode_system_error () =
28
27
let json =
···
34
33
(Claude.Message.System (Claude.Message.System.Error e))) ->
35
34
Alcotest.(check string) "error" "something went wrong" e.error
36
35
| Ok _ -> Alcotest.fail "Wrong message type"
37
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
36
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
38
37
39
38
let test_decode_result () =
40
39
let json =
···
53
52
"not is_error" false
54
53
(Claude.Message.Result.is_error r)
55
54
| Ok _ -> Alcotest.fail "Wrong message type"
56
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
55
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
57
56
58
57
let test_decode_assistant_tools () =
59
58
let json =
···
69
68
in
70
69
Alcotest.(check bool) "has_tool_use" true has_tool_use
71
70
| Ok _ -> Alcotest.fail "Wrong message type"
72
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
71
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
73
72
74
73
let test_decode_control_response () =
75
74
let json =
···
78
77
match decode_incoming json with
79
78
| Ok (Claude.Incoming.Control_response _) -> ()
80
79
| Ok _ -> Alcotest.fail "Wrong message type, expected Control_response"
81
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
80
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
82
81
83
82
let test_decode_user_message () =
84
83
let json = {|{"type":"user","message":{"content":"Hi"}}|} in
85
84
match decode_incoming json with
86
85
| Ok (Claude.Incoming.Message (Claude.Message.User _)) -> ()
87
86
| Ok _ -> Alcotest.fail "Expected user message"
88
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
87
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
89
88
90
89
let test_pp_does_not_crash () =
91
90
let json = {|{"type":"user","message":{"content":"Hi"}}|} in
···
96
95
Claude.Incoming.pp ppf incoming;
97
96
Format.pp_print_flush ppf ();
98
97
Alcotest.(check bool) "pp output" true (Buffer.contents buf <> "")
99
-
| Error err -> Alcotest.fail (Jsont.Error.to_string err)
98
+
| Error err -> Alcotest.fail (Json.Error.to_string err)
100
99
101
100
let suite =
102
101
( "incoming",
+8
-12
test/test_mcp_server.ml
+8
-12
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 = Jsont.Json
9
+
module J = Json
10
10
11
11
let mk_tool name =
12
12
Claude.Tool.v ~name ~description:("Tool: " ^ name)
···
50
50
in
51
51
let resp = Claude.Mcp_server.handle_json_message server req in
52
52
match resp with
53
-
| Jsont.Object (mems, _) ->
53
+
| Json.Object (mems, _) ->
54
54
Alcotest.(check bool)
55
55
"has result" true
56
56
(List.exists (fun ((k, _), _) -> k = "result") mems)
···
69
69
in
70
70
let resp = Claude.Mcp_server.handle_json_message server req in
71
71
match resp with
72
-
| Jsont.Object (mems, _) -> (
72
+
| Json.Object (mems, _) -> (
73
73
match List.find_opt (fun ((k, _), _) -> k = "result") mems with
74
-
| Some (_, Jsont.Object (result_mems, _)) -> (
74
+
| Some (_, Json.Object (result_mems, _)) -> (
75
75
match List.find_opt (fun ((k, _), _) -> k = "tools") result_mems with
76
-
| Some (_, Jsont.Array (tools, _)) ->
76
+
| Some (_, Json.Array (tools, _)) ->
77
77
Alcotest.(check int) "0 tools" 0 (List.length tools)
78
78
| _ -> Alcotest.fail "Missing tools")
79
79
| _ -> Alcotest.fail "Missing result")
···
114
114
]
115
115
in
116
116
let resp = Claude.Mcp_server.handle_json_message server req in
117
-
let resp_str =
118
-
match Jsont_bytesrw.encode_string' Jsont.json resp with
119
-
| Ok s -> s
120
-
| Error _ -> ""
121
-
in
117
+
let resp_str = Json.Value.to_string resp in
122
118
(* Check the response contains "10" *)
123
119
Alcotest.(check bool)
124
120
"contains 10" true
···
142
138
in
143
139
let resp = Claude.Mcp_server.handle_json_message server req in
144
140
match resp with
145
-
| Jsont.Object (mems, _) ->
141
+
| Json.Object (mems, _) ->
146
142
Alcotest.(check bool)
147
143
"has error" true
148
144
(List.exists (fun ((k, _), _) -> k = "error") mems)
···
156
152
Claude.Mcp_server.handle_request server ~method_:"tools/list"
157
153
~params:(J.object' []) ~id
158
154
in
159
-
match resp with Jsont.Object _ -> () | _ -> Alcotest.fail "Expected object"
155
+
match resp with Json.Object _ -> () | _ -> Alcotest.fail "Expected object"
160
156
161
157
let suite =
162
158
( "mcp_server",
+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 = Jsont.Json.string "result data" in
31
+
let content = Json.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
+13
-13
test/test_outgoing.ml
+13
-13
test/test_outgoing.ml
···
11
11
let user = M.User.of_string "hello" in
12
12
let msg = O.Message (M.User user) in
13
13
let json = O.to_json msg in
14
-
match json with Jsont.Object _ -> () | _ -> Alcotest.fail "Expected object"
14
+
match json with Json.Object _ -> () | _ -> Alcotest.fail "Expected object"
15
15
16
16
let mk_control_request ?(request_id = "cr-1") request : C.control_request =
17
17
{
···
29
29
let envelope = mk_control_response resp in
30
30
let msg = O.Control_response envelope in
31
31
let json = O.to_json msg in
32
-
match json with Jsont.Object _ -> () | _ -> Alcotest.fail "Expected object"
32
+
match json with Json.Object _ -> () | _ -> Alcotest.fail "Expected object"
33
33
34
34
let test_encode_control_request () =
35
35
let req = C.Request.interrupt () in
36
36
let envelope = mk_control_request req in
37
37
let msg = O.Control_request envelope in
38
38
let json = O.to_json msg in
39
-
match json with Jsont.Object _ -> () | _ -> Alcotest.fail "Expected object"
39
+
match json with Json.Object _ -> () | _ -> Alcotest.fail "Expected object"
40
40
41
41
let test_jsont_roundtrip_user () =
42
42
let user = M.User.of_string "test" in
43
43
let msg = O.Message (M.User user) in
44
-
match Jsont.Json.encode O.jsont msg with
44
+
match Json.encode O.json msg with
45
45
| Ok json -> (
46
-
match Jsont.Json.decode O.jsont json with
46
+
match Json.decode O.json json with
47
47
| Ok (O.Message (M.User _)) -> ()
48
48
| Ok _ -> Alcotest.fail "Wrong variant after decode"
49
-
| Error e -> Alcotest.fail e)
50
-
| Error e -> Alcotest.fail e
49
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
50
+
| Error e -> Alcotest.fail (Json.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
54
54
let envelope = mk_control_response resp in
55
55
let msg = O.Control_response envelope in
56
-
match Jsont.Json.encode O.jsont msg with
56
+
match Json.encode O.json msg with
57
57
| Ok json -> (
58
-
match Jsont.Json.decode O.jsont json with
58
+
match Json.decode O.json json with
59
59
| Ok (O.Control_response _) -> ()
60
60
| Ok _ -> Alcotest.fail "Wrong variant after decode"
61
-
| Error e -> Alcotest.fail e)
62
-
| Error e -> Alcotest.fail e
61
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
62
+
| Error e -> Alcotest.fail (Json.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
···
87
87
test_encode_control_response;
88
88
Alcotest.test_case "encode control request" `Quick
89
89
test_encode_control_request;
90
-
Alcotest.test_case "jsont roundtrip user" `Quick test_jsont_roundtrip_user;
91
-
Alcotest.test_case "jsont roundtrip control response" `Quick
90
+
Alcotest.test_case "json roundtrip user" `Quick test_jsont_roundtrip_user;
91
+
Alcotest.test_case "json roundtrip control response" `Quick
92
92
test_jsont_roundtrip_control_response;
93
93
Alcotest.test_case "pp does not crash" `Quick test_pp_does_not_crash;
94
94
Alcotest.test_case "of_json user" `Quick test_of_json_user;
+2
-2
test/test_permissions.ml
+2
-2
test/test_permissions.ml
···
76
76
77
77
let test_rule_proto_roundtrip () =
78
78
let rule = P.Rule.create ~tool_name:"Read" ~rule_content:"*.txt" () in
79
-
let json = Jsont.Json.encode P.Rule.jsont rule |> Result.get_ok in
80
-
let back = Jsont.Json.decode P.Rule.jsont json |> Result.get_ok in
79
+
let json = Json.encode P.Rule.json rule |> Result.get_ok in
80
+
let back = Json.decode P.Rule.json json |> Result.get_ok in
81
81
Alcotest.(check string) "tool_name" "Read" (P.Rule.tool_name back);
82
82
Alcotest.(check (option string))
83
83
"rule_content" (Some "*.txt") (P.Rule.rule_content back)
+11
-11
test/test_structured_output.ml
+11
-11
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 = Jsont.Json
9
+
module J = Json
10
10
11
11
let mk_schema () =
12
12
J.object'
···
26
26
let so = SO.of_json_schema schema in
27
27
(* json_schema should return the schema we passed in *)
28
28
match SO.json_schema so with
29
-
| Jsont.Object _ -> ()
29
+
| Json.Object _ -> ()
30
30
| _ -> Alcotest.fail "Expected object schema back"
31
31
32
32
let test_json_roundtrip () =
···
35
35
let json = SO.to_json so in
36
36
let back = SO.of_json json in
37
37
match SO.json_schema back with
38
-
| Jsont.Object _ -> ()
38
+
| Json.Object _ -> ()
39
39
| _ -> Alcotest.fail "Expected object schema after roundtrip"
40
40
41
41
let test_jsont_encode_decode () =
42
42
let schema = J.object' [ J.mem (J.name "type") (J.string "string") ] in
43
43
let so = SO.of_json_schema schema in
44
-
match Jsont.Json.encode SO.jsont so with
44
+
match Json.encode SO.json so with
45
45
| Ok json -> (
46
-
match Jsont.Json.decode SO.jsont json with
46
+
match Json.decode SO.json json with
47
47
| Ok back -> (
48
48
match SO.json_schema back with
49
-
| Jsont.Object _ -> ()
49
+
| Json.Object _ -> ()
50
50
| _ -> Alcotest.fail "Expected object after decode")
51
-
| Error e -> Alcotest.fail e)
52
-
| Error e -> Alcotest.fail e
51
+
| Error e -> Alcotest.fail (Json.Error.to_string e))
52
+
| Error e -> Alcotest.fail (Json.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
56
56
let so = SO.of_json_schema schema in
57
57
match SO.json_schema so with
58
-
| Jsont.Object _ -> ()
58
+
| Json.Object _ -> ()
59
59
| _ -> Alcotest.fail "Expected object"
60
60
61
61
let test_of_json_invalid () =
62
62
(* of_json with bad data should raise Invalid_argument *)
63
-
match SO.of_json (Jsont.String ("not valid", Jsont.Meta.none)) with
63
+
match SO.of_json (Json.String ("not valid", Json.Meta.none)) with
64
64
| exception Invalid_argument _ -> ()
65
65
| _ -> Alcotest.fail "Expected Invalid_argument for bad JSON"
66
66
···
69
69
[
70
70
Alcotest.test_case "of_json_schema" `Quick test_of_json_schema;
71
71
Alcotest.test_case "to_json/of_json roundtrip" `Quick test_json_roundtrip;
72
-
Alcotest.test_case "jsont encode/decode" `Quick test_jsont_encode_decode;
72
+
Alcotest.test_case "json encode/decode" `Quick test_jsont_encode_decode;
73
73
Alcotest.test_case "simple string schema" `Quick test_simple_string_schema;
74
74
Alcotest.test_case "of_json invalid" `Quick test_of_json_invalid;
75
75
] )
+7
-7
test/test_tool.ml
+7
-7
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 = Jsont.Json
9
+
module J = Json
10
10
11
11
let test_tool_accessors () =
12
12
let t =
···
42
42
in
43
43
(* Just verify it doesn't crash and is a valid JSON object *)
44
44
match schema with
45
-
| Jsont.Object _ -> ()
45
+
| Json.Object _ -> ()
46
46
| _ -> Alcotest.fail "Expected JSON object"
47
47
48
48
let test_schema_array_of_int () =
49
49
let schema = Claude.Tool.schema_array Claude.Tool.schema_int in
50
50
match schema with
51
-
| Jsont.Object _ -> ()
51
+
| Json.Object _ -> ()
52
52
| _ -> Alcotest.fail "Expected JSON object for array schema"
53
53
54
54
let test_schema_string_enum_empty () =
55
55
let schema = Claude.Tool.schema_string_enum [] in
56
56
match schema with
57
-
| Jsont.Object _ -> ()
57
+
| Json.Object _ -> ()
58
58
| _ -> Alcotest.fail "Expected JSON object"
59
59
60
60
let test_text_result_format () =
61
61
let result = Claude.Tool.text_result "test output" in
62
62
match result with
63
-
| Jsont.Array ([ Jsont.Object (_, _) ], _) -> ()
63
+
| Json.Array ([ Json.Object (_, _) ], _) -> ()
64
64
| _ -> Alcotest.fail "Expected array with one object"
65
65
66
66
let test_error_result_format () =
67
67
let result = Claude.Tool.error_result "bad input" in
68
68
match result with
69
-
| Jsont.Array ([ Jsont.Object (_, _) ], _) -> ()
69
+
| Json.Array ([ Json.Object (_, _) ], _) -> ()
70
70
| _ -> Alcotest.fail "Expected array with one object"
71
71
72
72
let test_handler_returns_complex_json () =
···
91
91
in
92
92
let input = Claude.Tool_input.of_json (J.object' []) in
93
93
match Claude.Tool.call t input with
94
-
| Ok (Jsont.Array (items, _)) ->
94
+
| Ok (Json.Array (items, _)) ->
95
95
Alcotest.(check int) "two items" 2 (List.length items)
96
96
| Ok _ -> Alcotest.fail "Expected array"
97
97
| Error msg -> Alcotest.fail msg
+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 = Jsont.Json
8
+
module J = Json
9
9
10
10
let test_empty () =
11
11
let t = Claude.Tool_input.empty in
···
91
91
let t =
92
92
Claude.Tool_input.of_assoc
93
93
[
94
-
("num", Jsont.Number (42.0, Jsont.Meta.none));
95
-
("s", Jsont.String ("hi", Jsont.Meta.none));
94
+
("num", Json.Number (42.0, Json.Meta.none));
95
+
("s", Json.String ("hi", Json.Meta.none));
96
96
]
97
97
in
98
98
Alcotest.(check (option int)) "num" (Some 42) (Claude.Tool_input.int t "num");
+3
-3
test/test_unknown.ml
+3
-3
test/test_unknown.ml
···
9
9
Alcotest.(check bool) "empty is_empty" true (Unknown.is_empty Unknown.empty)
10
10
11
11
let test_non_empty_object () =
12
-
let assoc = [ ("extra", Jsont.String ("val", Jsont.Meta.none)) ] in
12
+
let assoc = [ ("extra", Json.String ("val", Json.Meta.none)) ] in
13
13
let unknown = Unknown.of_assoc assoc in
14
14
Alcotest.(check bool) "non-empty" false (Unknown.is_empty unknown)
15
15
···
20
20
let test_assoc_roundtrip () =
21
21
let assoc =
22
22
[
23
-
("key1", Jsont.String ("val1", Jsont.Meta.none));
24
-
("key2", Jsont.Number (42.0, Jsont.Meta.none));
23
+
("key1", Json.String ("val1", Json.Meta.none));
24
+
("key2", Json.Number (42.0, Json.Meta.none));
25
25
]
26
26
in
27
27
let unknown = Unknown.of_assoc assoc in