anil.recoil.org
OCaml Claude SDK using Eio and Jsont
refine pp usage to trim interface size
+46
-409
+3
-3
lib/client.ml
+3
-3
lib/client.ml
···
395
395
let request_id = Printf.sprintf "set_perm_mode_%f" (Unix.gettimeofday ()) in
396
396
let request = Sdk_control.Request.set_permission_mode ~mode () in
397
397
let _response = send_control_request t ~request_id request in
398
-
Log.info (fun m -> m "Permission mode set to: %a" Permissions.Mode.pp mode)
398
+
Log.info (fun m -> m "Permission mode set to: %s" (Permissions.Mode.to_string mode))
399
399
400
400
let set_model t model =
401
401
let model_str = Model.to_string model in
402
402
let request_id = Printf.sprintf "set_model_%f" (Unix.gettimeofday ()) in
403
403
let request = Sdk_control.Request.set_model ~model:model_str () in
404
404
let _response = send_control_request t ~request_id request in
405
-
Log.info (fun m -> m "Model set to: %a" Model.pp model)
405
+
Log.info (fun m -> m "Model set to: %s" model_str)
406
406
407
407
let set_model_string t model_str =
408
408
set_model t (Model.of_string model_str)
···
416
416
| Ok si -> si
417
417
| Error msg -> raise (Invalid_argument ("Failed to decode server info: " ^ msg))
418
418
in
419
-
Log.info (fun m -> m "Retrieved server info: %a" Sdk_control.Server_info.pp server_info);
419
+
Log.info (fun m -> m "Retrieved server info: %a" (Jsont.pp_value Sdk_control.Server_info.jsont ()) server_info);
420
420
server_info
421
421
| None ->
422
422
raise (Failure "No response data from get_server_info request")
+2
-47
lib/content_block.ml
+2
-47
lib/content_block.ml
···
19
19
|> Jsont.Object.mem "text" Jsont.string ~enc:text
20
20
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
21
21
|> Jsont.Object.finish
22
-
23
-
let pp fmt t =
24
-
if String.length t.text > 60 then
25
-
let truncated = String.sub t.text 0 57 in
26
-
Fmt.pf fmt "Text[%s...]" truncated
27
-
else
28
-
Fmt.pf fmt "Text[%S]" t.text
29
22
end
30
23
31
24
module Tool_use = struct
···
88
81
|> Jsont.Object.mem "input" Input.jsont ~enc:input
89
82
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
90
83
|> Jsont.Object.finish
91
-
92
-
let pp fmt t =
93
-
let keys = Input.keys t.input in
94
-
let key_info = match keys with
95
-
| [] -> ""
96
-
| [k] -> Printf.sprintf "(%s)" k
97
-
| ks -> Printf.sprintf "(%d params)" (List.length ks)
98
-
in
99
-
Fmt.pf fmt "Tool[%s%s]" t.name key_info
100
84
end
101
85
102
86
module Tool_result = struct
···
124
108
|> Jsont.Object.opt_mem "is_error" Jsont.bool ~enc:is_error
125
109
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
126
110
|> Jsont.Object.finish
127
-
128
-
let pp fmt t =
129
-
match t.is_error, t.content with
130
-
| Some true, Some c ->
131
-
if String.length c > 40 then
132
-
let truncated = String.sub c 0 37 in
133
-
Fmt.pf fmt "ToolResult[error: %s...]" truncated
134
-
else
135
-
Fmt.pf fmt "ToolResult[error: %s]" c
136
-
| _, Some c ->
137
-
if String.length c > 40 then
138
-
let truncated = String.sub c 0 37 in
139
-
Fmt.pf fmt "ToolResult[%s...]" truncated
140
-
else
141
-
Fmt.pf fmt "ToolResult[%s]" c
142
-
| _, None -> Fmt.pf fmt "ToolResult[empty]"
143
111
end
144
112
145
113
module Thinking = struct
···
162
130
|> Jsont.Object.mem "signature" Jsont.string ~enc:signature
163
131
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
164
132
|> Jsont.Object.finish
165
-
166
-
let pp fmt t =
167
-
if String.length t.thinking > 50 then
168
-
let truncated = String.sub t.thinking 0 47 in
169
-
Fmt.pf fmt "Thinking[%s...]" truncated
170
-
else
171
-
Fmt.pf fmt "Thinking[%s]" t.thinking
172
133
end
173
134
174
135
type t =
···
211
172
~tag_to_string:Fun.id ~tag_compare:String.compare
212
173
|> Jsont.Object.finish
213
174
214
-
let pp fmt = function
215
-
| Text t -> Text.pp fmt t
216
-
| Tool_use t -> Tool_use.pp fmt t
217
-
| Tool_result t -> Tool_result.pp fmt t
218
-
| Thinking t -> Thinking.pp fmt t
219
-
220
175
let log_received t =
221
-
Log.debug (fun m -> m "Received content block: %a" pp t)
176
+
Log.debug (fun m -> m "Received content block: %a" (Jsont.pp_value jsont ()) t)
222
177
223
178
let log_sending t =
224
-
Log.debug (fun m -> m "Sending content block: %a" pp t)
179
+
Log.debug (fun m -> m "Sending content block: %a" (Jsont.pp_value jsont ()) t)
+10
-20
lib/content_block.mli
+10
-20
lib/content_block.mli
···
25
25
26
26
val jsont : t Jsont.t
27
27
(** [jsont] is the Jsont codec for text blocks.
28
-
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization. *)
29
-
30
-
val pp : Format.formatter -> t -> unit
31
-
(** [pp fmt t] pretty-prints the text block. *)
28
+
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization.
29
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
32
30
end
33
31
34
32
(** {1 Tool Use Blocks} *)
···
91
89
92
90
val jsont : t Jsont.t
93
91
(** [jsont] is the Jsont codec for tool use blocks.
94
-
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization. *)
95
-
96
-
val pp : Format.formatter -> t -> unit
97
-
(** [pp fmt t] pretty-prints the tool use block. *)
92
+
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization.
93
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
98
94
end
99
95
100
96
(** {1 Tool Result Blocks} *)
···
125
121
126
122
val jsont : t Jsont.t
127
123
(** [jsont] is the Jsont codec for tool result blocks.
128
-
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization. *)
129
-
130
-
val pp : Format.formatter -> t -> unit
131
-
(** [pp fmt t] pretty-prints the tool result block. *)
124
+
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization.
125
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
132
126
end
133
127
134
128
(** {1 Thinking Blocks} *)
···
155
149
156
150
val jsont : t Jsont.t
157
151
(** [jsont] is the Jsont codec for thinking blocks.
158
-
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization. *)
159
-
160
-
val pp : Format.formatter -> t -> unit
161
-
(** [pp fmt t] pretty-prints the thinking block. *)
152
+
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization.
153
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
162
154
end
163
155
164
156
(** {1 Content Block Union Type} *)
···
184
176
185
177
val jsont : t Jsont.t
186
178
(** [jsont] is the Jsont codec for content blocks.
187
-
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization. *)
188
-
189
-
val pp : Format.formatter -> t -> unit
190
-
(** [pp fmt t] pretty-prints any content block. *)
179
+
Use [Jsont.Json.encode jsont] and [Jsont.Json.decode jsont] for serialization.
180
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
191
181
192
182
(** {1 Logging} *)
193
183
+2
-14
lib/control.ml
+2
-14
lib/control.ml
···
1
1
let src = Logs.Src.create "claude.control" ~doc:"Claude control messages"
2
2
module Log = (val Logs.src_log src : Logs.LOG)
3
3
4
-
(* Helper for pretty-printing JSON *)
5
-
let pp_json fmt json =
6
-
let s = match Jsont_bytesrw.encode_string' Jsont.json json with
7
-
| Ok s -> s
8
-
| Error err -> Jsont.Error.to_string err
9
-
in
10
-
Fmt.string fmt s
11
-
12
4
type t = {
13
5
request_id : string;
14
6
subtype : string;
···
48
40
| Error e -> raise (Invalid_argument ("Control.of_json: " ^ e)))
49
41
| Error e -> raise (Invalid_argument ("Control.of_json: " ^ e))
50
42
51
-
let pp fmt t =
52
-
Fmt.pf fmt "@[<2>Control@ { request_id = %S;@ subtype = %S;@ data = %a }@]"
53
-
t.request_id t.subtype pp_json t.data
54
-
55
43
let log_received t =
56
-
Log.debug (fun m -> m "Received control message: %a" pp t)
44
+
Log.debug (fun m -> m "Received control message: %a" (Jsont.pp_value jsont ()) t)
57
45
58
46
let log_sending t =
59
-
Log.debug (fun m -> m "Sending control message: %a" pp t)
47
+
Log.debug (fun m -> m "Sending control message: %a" (Jsont.pp_value jsont ()) t)
-3
lib/control.mli
-3
lib/control.mli
···
35
35
(** [of_json json] parses a control message from JSON.
36
36
@raise Invalid_argument if the JSON is not a valid control message. *)
37
37
38
-
val pp : Format.formatter -> t -> unit
39
-
(** [pp fmt t] pretty-prints the control message. *)
40
-
41
38
(** {1 Logging} *)
42
39
43
40
val log_received : t -> unit
-6
lib/incoming.ml
-6
lib/incoming.ml
···
180
180
in
181
181
182
182
Jsont.map ~kind:"Incoming" ~dec ~enc Jsont.json
183
-
184
-
let pp fmt = function
185
-
| Message msg -> Format.fprintf fmt "@[<2>Message@ %a@]" Message.pp msg
186
-
| Control_response resp -> Format.fprintf fmt "@[<2>ControlResponse@ %a@]" Sdk_control.pp (Sdk_control.Response resp)
187
-
| Control_request req -> Format.fprintf fmt "@[<2>ControlRequest@ { request_id=%S; subtype=%S }@]"
188
-
(Control_request.request_id req) (Control_request.subtype req)
+2
-4
lib/incoming.mli
+2
-4
lib/incoming.mli
···
54
54
| Control_request of Control_request.t
55
55
56
56
val jsont : t Jsont.t
57
-
(** Codec for incoming messages. Uses the "type" field to discriminate. *)
58
-
59
-
val pp : Format.formatter -> t -> unit
60
-
(** [pp fmt t] pretty-prints the incoming message. *)
57
+
(** Codec for incoming messages. Uses the "type" field to discriminate.
58
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
+2
-109
lib/message.ml
+2
-109
lib/message.ml
···
125
125
match Jsont.Json.decode incoming_jsont json with
126
126
| Ok v -> v
127
127
| Error msg -> raise (Invalid_argument ("User.of_json: " ^ msg))
128
-
129
-
let pp fmt t =
130
-
match t.content with
131
-
| String s ->
132
-
if String.length s > 60 then
133
-
let truncated = String.sub s 0 57 in
134
-
Fmt.pf fmt "@[<2>User:@ %s...@]" truncated
135
-
else
136
-
Fmt.pf fmt "@[<2>User:@ %S@]" s
137
-
| Blocks blocks ->
138
-
let text_count = List.length (List.filter (function
139
-
| Content_block.Text _ -> true | _ -> false) blocks) in
140
-
let tool_result_count = List.length (List.filter (function
141
-
| Content_block.Tool_result _ -> true | _ -> false) blocks) in
142
-
match text_count, tool_result_count with
143
-
| 1, 0 ->
144
-
let text = List.find_map (function
145
-
| Content_block.Text t -> Some (Content_block.Text.text t)
146
-
| _ -> None) blocks in
147
-
Fmt.pf fmt "@[<2>User:@ %a@]" Fmt.(option string) text
148
-
| 0, 1 ->
149
-
Fmt.pf fmt "@[<2>User:@ [tool result]@]"
150
-
| 0, n when n > 1 ->
151
-
Fmt.pf fmt "@[<2>User:@ [%d tool results]@]" n
152
-
| _ ->
153
-
Fmt.pf fmt "@[<2>User:@ [%d blocks]@]" (List.length blocks)
154
128
end
155
129
156
130
module Assistant = struct
···
294
268
match Jsont.Json.decode incoming_jsont json with
295
269
| Ok v -> v
296
270
| Error msg -> raise (Invalid_argument ("Assistant.of_json: " ^ msg))
297
-
298
-
let pp fmt t =
299
-
let text_count = List.length (get_text_blocks t) in
300
-
let tool_count = List.length (get_tool_uses t) in
301
-
let thinking_count = List.length (get_thinking t) in
302
-
match text_count, tool_count, thinking_count with
303
-
| 1, 0, 0 ->
304
-
(* Simple text response *)
305
-
Fmt.pf fmt "@[<2>Assistant@ [%s]:@ %S@]"
306
-
t.model (combined_text t)
307
-
| _, 0, 0 when text_count > 0 ->
308
-
(* Multiple text blocks *)
309
-
Fmt.pf fmt "@[<2>Assistant@ [%s]:@ %d text blocks@]"
310
-
t.model text_count
311
-
| 0, _, 0 when tool_count > 0 ->
312
-
(* Only tool uses *)
313
-
let tools = get_tool_uses t in
314
-
let tool_names = List.map Content_block.Tool_use.name tools in
315
-
Fmt.pf fmt "@[<2>Assistant@ [%s]:@ tools(%a)@]"
316
-
t.model Fmt.(list ~sep:comma string) tool_names
317
-
| _ ->
318
-
(* Mixed content *)
319
-
let parts = [] in
320
-
let parts = if text_count > 0 then
321
-
Printf.sprintf "%d text" text_count :: parts else parts in
322
-
let parts = if tool_count > 0 then
323
-
Printf.sprintf "%d tools" tool_count :: parts else parts in
324
-
let parts = if thinking_count > 0 then
325
-
Printf.sprintf "%d thinking" thinking_count :: parts else parts in
326
-
Fmt.pf fmt "@[<2>Assistant@ [%s]:@ %s@]"
327
-
t.model (String.concat ", " (List.rev parts))
328
271
end
329
272
330
273
module System = struct
···
427
370
match Jsont.Json.decode jsont json with
428
371
| Ok v -> v
429
372
| Error msg -> raise (Invalid_argument ("System.of_json: " ^ msg))
430
-
431
-
let pp fmt = function
432
-
| Init i ->
433
-
Fmt.pf fmt "@[<2>System.init@ { session_id = %a;@ model = %a;@ cwd = %a }@]"
434
-
Fmt.(option string) i.session_id
435
-
Fmt.(option string) i.model
436
-
Fmt.(option string) i.cwd
437
-
| Error e ->
438
-
Fmt.pf fmt "@[<2>System.error@ { error = %s }@]" e.error
439
-
| Other o ->
440
-
Fmt.pf fmt "@[<2>System.%s@ { ... }@]" o.subtype
441
373
end
442
374
443
375
module Result = struct
···
493
425
let output_cost = float_of_int output *. output_price /. 1_000_000. in
494
426
Some (input_cost +. output_cost)
495
427
| _ -> None
496
-
497
-
let pp fmt t =
498
-
Fmt.pf fmt "@[<2>Usage@ { input = %a;@ output = %a;@ total = %a;@ \
499
-
cache_creation = %a;@ cache_read = %a }@]"
500
-
Fmt.(option int) t.input_tokens
501
-
Fmt.(option int) t.output_tokens
502
-
Fmt.(option int) t.total_tokens
503
-
Fmt.(option int) t.cache_creation_input_tokens
504
-
Fmt.(option int) t.cache_read_input_tokens
505
-
506
428
end
507
429
508
430
type t = {
···
620
542
match Jsont.Json.decode jsont json with
621
543
| Ok v -> v
622
544
| Error msg -> raise (Invalid_argument ("Result.of_json: " ^ msg))
623
-
624
-
let pp fmt t =
625
-
if t.is_error then
626
-
Fmt.pf fmt "@[<2>Result.error@ { session = %S;@ result = %a }@]"
627
-
t.session_id
628
-
Fmt.(option string) t.result
629
-
else
630
-
let tokens_info = match t.usage with
631
-
| Some u ->
632
-
let input = Usage.input_tokens u in
633
-
let output = Usage.output_tokens u in
634
-
let cached = Usage.cache_read_input_tokens u in
635
-
(match input, output, cached with
636
-
| Some i, Some o, Some c when c > 0 ->
637
-
Printf.sprintf " (tokens: %d+%d, cached: %d)" i o c
638
-
| Some i, Some o, _ ->
639
-
Printf.sprintf " (tokens: %d+%d)" i o
640
-
| _ -> "")
641
-
| None -> ""
642
-
in
643
-
Fmt.pf fmt "@[<2>Result.%s@ { duration = %dms;@ cost = $%.4f%s }@]"
644
-
t.subtype
645
-
t.duration_ms
646
-
(Option.value t.total_cost_usd ~default:0.0)
647
-
tokens_info
648
545
end
649
546
650
547
type t =
···
708
605
| Ok v -> v
709
606
| Error msg -> raise (Invalid_argument ("Message.of_json: " ^ msg))
710
607
711
-
let pp fmt = function
712
-
| User t -> User.pp fmt t
713
-
| Assistant t -> Assistant.pp fmt t
714
-
| System t -> System.pp fmt t
715
-
| Result t -> Result.pp fmt t
716
-
717
608
let is_user = function User _ -> true | _ -> false
718
609
let is_assistant = function Assistant _ -> true | _ -> false
719
610
let is_system = function System _ -> true | _ -> false
···
739
630
| System s -> System.session_id s
740
631
| Result r -> Some (Result.session_id r)
741
632
| _ -> None
633
+
634
+
let pp = Jsont.pp_value jsont ()
742
635
743
636
let log_received t =
744
637
Log.info (fun m -> m "← %a" pp t)
-15
lib/message.mli
-15
lib/message.mli
···
59
59
val of_json : Jsont.json -> t
60
60
(** [of_json json] parses a user message from JSON.
61
61
@raise Invalid_argument if the JSON is not a valid user message. *)
62
-
63
-
val pp : Format.formatter -> t -> unit
64
-
(** [pp fmt t] pretty-prints the user message. *)
65
62
end
66
63
67
64
(** {1 Assistant Messages} *)
···
130
127
val of_json : Jsont.json -> t
131
128
(** [of_json json] parses an assistant message from JSON.
132
129
@raise Invalid_argument if the JSON is not a valid assistant message. *)
133
-
134
-
val pp : Format.formatter -> t -> unit
135
-
(** [pp fmt t] pretty-prints the assistant message. *)
136
130
end
137
131
138
132
(** {1 System Messages} *)
···
213
207
val of_json : Jsont.json -> t
214
208
(** [of_json json] parses from JSON.
215
209
@raise Invalid_argument if invalid. *)
216
-
217
-
val pp : Format.formatter -> t -> unit
218
-
(** [pp fmt t] pretty-prints the message. *)
219
210
end
220
211
221
212
(** {1 Result Messages} *)
···
266
257
val total_cost_estimate : t -> input_price:float -> output_price:float -> float option
267
258
(** [total_cost_estimate t ~input_price ~output_price] estimates the cost based on token
268
259
prices per million tokens. Returns None if token counts are not available. *)
269
-
270
-
val pp : Format.formatter -> t -> unit
271
-
(** [pp fmt t] pretty-prints the usage statistics. *)
272
260
end
273
261
274
262
type t
···
341
329
val of_json : Jsont.json -> t
342
330
(** [of_json json] parses a result message from JSON.
343
331
@raise Invalid_argument if the JSON is not a valid result message. *)
344
-
345
-
val pp : Format.formatter -> t -> unit
346
-
(** [pp fmt t] pretty-prints the result message. *)
347
332
end
348
333
349
334
(** {1 Message Union Type} *)
-3
lib/model.ml
-3
lib/model.ml
-3
lib/model.mli
-3
lib/model.mli
+1
-21
lib/options.ml
+1
-21
lib/options.ml
···
230
230
| Error msg -> raise (Invalid_argument ("Options.of_json: " ^ msg))
231
231
*)
232
232
233
-
let pp fmt t =
234
-
Fmt.pf fmt "@[<v>Options {@ \
235
-
allowed_tools = %a;@ \
236
-
disallowed_tools = %a;@ \
237
-
max_thinking_tokens = %d;@ \
238
-
system_prompt = %a;@ \
239
-
append_system_prompt = %a;@ \
240
-
permission_mode = %a;@ \
241
-
model = %a;@ \
242
-
env = %a@ \
243
-
}@]"
244
-
Fmt.(list string) t.allowed_tools
245
-
Fmt.(list string) t.disallowed_tools
246
-
t.max_thinking_tokens
247
-
Fmt.(option string) t.system_prompt
248
-
Fmt.(option string) t.append_system_prompt
249
-
Fmt.(option Permissions.Mode.pp) t.permission_mode
250
-
Fmt.(option Model.pp) t.model
251
-
Fmt.(list (pair string string)) t.env
252
-
253
233
let log_options t =
254
-
Log.debug (fun m -> m "Claude options: %a" pp t)
234
+
Log.debug (fun m -> m "Claude options: %a" (Jsont.pp_value jsont ()) t)
+2
-4
lib/options.mli
+2
-4
lib/options.mli
···
354
354
(** {1 Serialization} *)
355
355
356
356
val jsont : t Jsont.t
357
-
(** [jsont] is the Jsont codec for Options.t *)
358
-
359
-
val pp : Format.formatter -> t -> unit
360
-
(** [pp fmt t] pretty-prints the options. *)
357
+
(** [jsont] is the Jsont codec for Options.t
358
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
361
359
362
360
(** {1 Logging} *)
363
361
-52
lib/permissions.ml
-52
lib/permissions.ml
···
1
1
let src = Logs.Src.create "claude.permission" ~doc:"Claude permission system"
2
2
module Log = (val Logs.src_log src : Logs.LOG)
3
3
4
-
(* Helper for pretty-printing JSON *)
5
-
let pp_json fmt json =
6
-
let s = match Jsont_bytesrw.encode_string' Jsont.json json with
7
-
| Ok s -> s
8
-
| Error err -> Jsont.Error.to_string err
9
-
in
10
-
Fmt.string fmt s
11
-
12
4
(** Permission modes *)
13
5
module Mode = struct
14
6
type t =
···
29
21
| "plan" -> Plan
30
22
| "bypassPermissions" -> Bypass_permissions
31
23
| s -> raise (Invalid_argument (Printf.sprintf "Mode.of_string: unknown mode %s" s))
32
-
33
-
let pp fmt t = Fmt.string fmt (to_string t)
34
24
35
25
let jsont : t Jsont.t =
36
26
Jsont.enum [
···
56
46
| "ask" -> Ask
57
47
| s -> raise (Invalid_argument (Printf.sprintf "Behavior.of_string: unknown behavior %s" s))
58
48
59
-
let pp fmt t = Fmt.string fmt (to_string t)
60
-
61
49
let jsont : t Jsont.t =
62
50
Jsont.enum [
63
51
"allow", Allow;
···
87
75
|> Jsont.Object.opt_mem "rule_content" Jsont.string ~enc:rule_content
88
76
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
89
77
|> Jsont.Object.finish
90
-
91
-
let pp fmt t =
92
-
Fmt.pf fmt "@[<2>Rule@ { tool_name = %S;@ rule_content = %a }@]"
93
-
t.tool_name Fmt.(option string) t.rule_content
94
78
end
95
79
96
80
(** Permission updates *)
···
100
84
| Project_settings
101
85
| Local_settings
102
86
| Session
103
-
104
-
let destination_to_string = function
105
-
| User_settings -> "userSettings"
106
-
| Project_settings -> "projectSettings"
107
-
| Local_settings -> "localSettings"
108
-
| Session -> "session"
109
87
110
88
let _destination_of_string = function
111
89
| "userSettings" -> User_settings
···
130
108
| Add_directories
131
109
| Remove_directories
132
110
133
-
let update_type_to_string = function
134
-
| Add_rules -> "addRules"
135
-
| Replace_rules -> "replaceRules"
136
-
| Remove_rules -> "removeRules"
137
-
| Set_mode -> "setMode"
138
-
| Add_directories -> "addDirectories"
139
-
| Remove_directories -> "removeDirectories"
140
-
141
111
let _update_type_of_string = function
142
112
| "addRules" -> Add_rules
143
113
| "replaceRules" -> Replace_rules
···
191
161
|> Jsont.Object.opt_mem "destination" destination_jsont ~enc:destination
192
162
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
193
163
|> Jsont.Object.finish
194
-
195
-
let pp fmt t =
196
-
Fmt.pf fmt "@[<2>Update@ { type = %s;@ rules = %a;@ behavior = %a;@ \
197
-
mode = %a;@ directories = %a;@ destination = %a }@]"
198
-
(update_type_to_string t.update_type)
199
-
Fmt.(option (list Rule.pp)) t.rules
200
-
Fmt.(option Behavior.pp) t.behavior
201
-
Fmt.(option Mode.pp) t.mode
202
-
Fmt.(option (list string)) t.directories
203
-
Fmt.(option (fun fmt d -> Fmt.string fmt (destination_to_string d))) t.destination
204
164
end
205
165
206
166
(** Permission context for callbacks *)
···
220
180
|> Jsont.Object.mem "suggestions" (Jsont.list Update.jsont) ~enc:suggestions ~dec_absent:[]
221
181
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
222
182
|> Jsont.Object.finish
223
-
224
-
let pp fmt t =
225
-
Fmt.pf fmt "@[<2>Context@ { suggestions = @[<v>%a@] }@]"
226
-
Fmt.(list ~sep:(any "@,") Update.pp) t.suggestions
227
183
end
228
184
229
185
(** Permission results *)
···
296
252
|> Jsont.Object.case_mem "behavior" Jsont.string ~enc:Fun.id ~enc_case cases
297
253
~tag_to_string:Fun.id ~tag_compare:String.compare
298
254
|> Jsont.Object.finish
299
-
300
-
let pp fmt = function
301
-
| Allow { updated_input; updated_permissions; _ } ->
302
-
Fmt.pf fmt "@[<2>Allow@ { updated_input = %a;@ updated_permissions = %a }@]"
303
-
Fmt.(option pp_json) updated_input
304
-
Fmt.(option (list Update.pp)) updated_permissions
305
-
| Deny { message; interrupt; _ } ->
306
-
Fmt.pf fmt "@[<2>Deny@ { message = %S;@ interrupt = %b }@]" message interrupt
307
255
end
308
256
309
257
(** Permission callback type *)
+12
-24
lib/permissions.mli
+12
-24
lib/permissions.mli
···
26
26
(** [of_string s] parses a mode from its string representation.
27
27
@raise Invalid_argument if the string is not a valid mode. *)
28
28
29
-
val pp : Format.formatter -> t -> unit
30
-
(** [pp fmt t] pretty-prints the mode. *)
31
-
32
29
val jsont : t Jsont.t
33
-
(** [jsont] is the Jsont codec for permission modes. *)
30
+
(** [jsont] is the Jsont codec for permission modes.
31
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
34
32
end
35
33
36
34
(** {1 Permission Behaviors} *)
···
50
48
val of_string : string -> t
51
49
(** [of_string s] parses a behavior from its string representation.
52
50
@raise Invalid_argument if the string is not a valid behavior. *)
53
-
54
-
val pp : Format.formatter -> t -> unit
55
-
(** [pp fmt t] pretty-prints the behavior. *)
56
51
57
52
val jsont : t Jsont.t
58
-
(** [jsont] is the Jsont codec for permission behaviors. *)
53
+
(** [jsont] is the Jsont codec for permission behaviors.
54
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
59
55
end
60
56
61
57
(** {1 Permission Rules} *)
···
85
81
val unknown : t -> Unknown.t
86
82
(** [unknown t] returns the unknown fields. *)
87
83
88
-
val pp : Format.formatter -> t -> unit
89
-
(** [pp fmt t] pretty-prints the rule. *)
90
-
91
84
val jsont : t Jsont.t
92
-
(** [jsont] is the Jsont codec for permission rules. *)
85
+
(** [jsont] is the Jsont codec for permission rules.
86
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
93
87
end
94
88
95
89
(** {1 Permission Updates} *)
···
156
150
val unknown : t -> Unknown.t
157
151
(** [unknown t] returns the unknown fields. *)
158
152
159
-
val pp : Format.formatter -> t -> unit
160
-
(** [pp fmt t] pretty-prints the update. *)
161
-
162
153
val jsont : t Jsont.t
163
-
(** [jsont] is the Jsont codec for permission updates. *)
154
+
(** [jsont] is the Jsont codec for permission updates.
155
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
164
156
end
165
157
166
158
(** {1 Permission Context} *)
···
184
176
185
177
val unknown : t -> Unknown.t
186
178
(** [unknown t] returns the unknown fields. *)
187
-
188
-
val pp : Format.formatter -> t -> unit
189
-
(** [pp fmt t] pretty-prints the context. *)
190
179
191
180
val jsont : t Jsont.t
192
-
(** [jsont] is the Jsont codec for permission context. *)
181
+
(** [jsont] is the Jsont codec for permission context.
182
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
193
183
end
194
184
195
185
(** {1 Permission Results} *)
···
222
212
@param interrupt Whether to interrupt further execution
223
213
@param unknown Optional unknown fields to preserve *)
224
214
225
-
val pp : Format.formatter -> t -> unit
226
-
(** [pp fmt t] pretty-prints the result. *)
227
-
228
215
val jsont : t Jsont.t
229
-
(** [jsont] is the Jsont codec for permission results. *)
216
+
(** [jsont] is the Jsont codec for permission results.
217
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
230
218
end
231
219
232
220
(** {1 Permission Callbacks} *)
+2
-48
lib/sdk_control.ml
+2
-48
lib/sdk_control.ml
···
218
218
|> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases
219
219
~tag_to_string:Fun.id ~tag_compare:String.compare
220
220
|> Jsont.Object.finish
221
-
222
-
let pp fmt = function
223
-
| Interrupt _ ->
224
-
Fmt.pf fmt "@[<2>Interrupt@]"
225
-
| Permission p ->
226
-
Fmt.pf fmt "@[<2>Permission@ { tool = %S;@ blocked_path = %a }@]"
227
-
p.tool_name Fmt.(option string) p.blocked_path
228
-
| Initialize i ->
229
-
Fmt.pf fmt "@[<2>Initialize@ { hooks = %s }@]"
230
-
(if Option.is_some i.hooks then "present" else "none")
231
-
| Set_permission_mode s ->
232
-
Fmt.pf fmt "@[<2>SetPermissionMode@ { mode = %a }@]"
233
-
Permissions.Mode.pp s.mode
234
-
| Hook_callback h ->
235
-
Fmt.pf fmt "@[<2>HookCallback@ { id = %S;@ tool_use_id = %a }@]"
236
-
h.callback_id Fmt.(option string) h.tool_use_id
237
-
| Mcp_message m ->
238
-
Fmt.pf fmt "@[<2>McpMessage@ { server = %S }@]"
239
-
m.server_name
240
-
| Set_model s ->
241
-
Fmt.pf fmt "@[<2>SetModel@ { model = %S }@]" s.model
242
-
| Get_server_info _ ->
243
-
Fmt.pf fmt "@[<2>GetServerInfo@]"
244
221
end
245
222
246
223
module Response = struct
···
318
295
|> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases
319
296
~tag_to_string:Fun.id ~tag_compare:String.compare
320
297
|> Jsont.Object.finish
321
-
322
-
let pp fmt = function
323
-
| Success s ->
324
-
Fmt.pf fmt "@[<2>Success@ { request_id = %S;@ response = %s }@]"
325
-
s.request_id (if Option.is_some s.response then "present" else "none")
326
-
| Error e ->
327
-
Fmt.pf fmt "@[<2>Error@ { request_id = %S;@ error = %S }@]"
328
-
e.request_id e.error
329
298
end
330
299
331
300
type control_request = {
···
400
369
~tag_to_string:Fun.id ~tag_compare:String.compare
401
370
|> Jsont.Object.finish
402
371
403
-
let pp fmt = function
404
-
| Request r ->
405
-
Fmt.pf fmt "@[<2>ControlRequest@ { id = %S;@ request = %a }@]"
406
-
r.request_id Request.pp r.request
407
-
| Response r ->
408
-
Fmt.pf fmt "@[<2>ControlResponse@ { %a }@]"
409
-
Response.pp r.response
410
-
411
372
let log_request req =
412
-
Log.debug (fun m -> m "SDK control request: %a" Request.pp req)
373
+
Log.debug (fun m -> m "SDK control request: %a" (Jsont.pp_value Request.jsont ()) req)
413
374
414
375
let log_response resp =
415
-
Log.debug (fun m -> m "SDK control response: %a" Response.pp resp)
376
+
Log.debug (fun m -> m "SDK control response: %a" (Jsont.pp_value Response.jsont ()) resp)
416
377
417
378
(** Server information *)
418
379
module Server_info = struct
···
444
405
|> Jsont.Object.mem "outputStyles" (Jsont.list Jsont.string) ~enc:(fun (r : t) -> r.output_styles) ~dec_absent:[]
445
406
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : t) -> r.unknown)
446
407
|> Jsont.Object.finish
447
-
448
-
let pp fmt t =
449
-
Fmt.pf fmt "@[<2>ServerInfo@ { version = %S;@ capabilities = [%a];@ commands = [%a];@ output_styles = [%a] }@]"
450
-
t.version
451
-
Fmt.(list ~sep:(any ", ") (quote string)) t.capabilities
452
-
Fmt.(list ~sep:(any ", ") (quote string)) t.commands
453
-
Fmt.(list ~sep:(any ", ") (quote string)) t.output_styles
454
408
end
+8
-16
lib/sdk_control.mli
+8
-16
lib/sdk_control.mli
···
167
167
(** [get_server_info ?unknown ()] creates a server info request. *)
168
168
169
169
val jsont : t Jsont.t
170
-
(** [jsont] is the jsont codec for requests. *)
171
-
172
-
val pp : Format.formatter -> t -> unit
173
-
(** [pp fmt t] pretty-prints the request. *)
170
+
(** [jsont] is the jsont codec for requests.
171
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
174
172
end
175
173
176
174
(** {1 Response Types} *)
···
206
204
(** [error ~request_id ~error ?unknown] creates an error response. *)
207
205
208
206
val jsont : t Jsont.t
209
-
(** [jsont] is the jsont codec for responses. *)
210
-
211
-
val pp : Format.formatter -> t -> unit
212
-
(** [pp fmt t] pretty-prints the response. *)
207
+
(** [jsont] is the jsont codec for responses.
208
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
213
209
end
214
210
215
211
(** {1 Control Messages} *)
···
244
240
(** [create_response ~response ?unknown ()] creates a control response message. *)
245
241
246
242
val jsont : t Jsont.t
247
-
(** [jsont] is the jsont codec for control messages. *)
248
-
249
-
val pp : Format.formatter -> t -> unit
250
-
(** [pp fmt t] pretty-prints the control message. *)
243
+
(** [jsont] is the jsont codec for control messages.
244
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
251
245
252
246
(** {1 Logging} *)
253
247
···
331
325
(** [unknown t] returns the unknown fields. *)
332
326
333
327
val jsont : t Jsont.t
334
-
(** [jsont] is the jsont codec for server info. *)
335
-
336
-
val pp : Format.formatter -> t -> unit
337
-
(** [pp fmt t] pretty-prints the server info. *)
328
+
(** [jsont] is the jsont codec for server info.
329
+
Use [Jsont.pp_value jsont ()] for pretty-printing. *)
338
330
end
-14
lib/structured_output.ml
-14
lib/structured_output.ml
···
33
33
match Jsont.Json.decode jsont json with
34
34
| Ok t -> t
35
35
| Error msg -> raise (Invalid_argument ("Structured_output.of_json: " ^ msg))
36
-
37
-
let pp fmt t =
38
-
let schema_str =
39
-
match Jsont_bytesrw.encode_string' ~format:Jsont.Minify Jsont.json t.json_schema with
40
-
| Ok s -> s
41
-
| Error err -> Jsont.Error.to_string err
42
-
in
43
-
let truncated =
44
-
if String.length schema_str > 100 then
45
-
String.sub schema_str 0 97 ^ "..."
46
-
else
47
-
schema_str
48
-
in
49
-
Fmt.pf fmt "@[<2>StructuredOutput { schema = %s }@]" truncated
-3
lib/structured_output.mli
-3
lib/structured_output.mli