anil.recoil.org
OCaml Claude SDK using Eio and Jsont
1module User = struct
2 type content = String of string | Blocks of Content_block.t list
3 type t = { content : content; unknown : Unknown.t }
4
5 let create_string s = { content = String s; unknown = Unknown.empty }
6
7 let create_blocks blocks =
8 { content = Blocks blocks; unknown = Unknown.empty }
9
10 let create_with_tool_result ~tool_use_id ~content ?is_error () =
11 let tool_result =
12 Content_block.tool_result ~tool_use_id ~content ?is_error ()
13 in
14 { content = Blocks [ tool_result ]; unknown = Unknown.empty }
15
16 let make content unknown = { content; unknown }
17 let content t = t.content
18 let unknown t = t.unknown
19
20 (* Decode content from json value *)
21 let decode_content json =
22 match json with
23 | Jsont.String (s, _) -> String s
24 | Jsont.Array (items, _) ->
25 let blocks =
26 List.map
27 (fun j ->
28 match Jsont.Json.decode Content_block.jsont j with
29 | Ok v -> v
30 | Error e -> invalid_arg ("Invalid content block: " ^ e))
31 items
32 in
33 Blocks blocks
34 | _ -> failwith "Content must be string or array"
35
36 (* Encode content to json value *)
37 let encode_content = function
38 | String s -> Jsont.String (s, Jsont.Meta.none)
39 | Blocks blocks ->
40 let jsons =
41 List.map
42 (fun b ->
43 match Jsont.Json.encode Content_block.jsont b with
44 | Ok json -> json
45 | Error e -> invalid_arg ("encode_content: " ^ e))
46 blocks
47 in
48 Jsont.Array (jsons, Jsont.Meta.none)
49
50 let jsont : t Jsont.t =
51 Jsont.Object.map ~kind:"User" (fun json_content unknown ->
52 let content = decode_content json_content in
53 make content unknown)
54 |> Jsont.Object.mem "content" Jsont.json ~enc:(fun t ->
55 encode_content (content t))
56 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
57 |> Jsont.Object.finish
58
59 (* Jsont codec for parsing incoming user messages from CLI *)
60 let incoming_jsont : t Jsont.t =
61 let message_jsont =
62 Jsont.Object.map ~kind:"UserMessage" (fun json_content ->
63 let content = decode_content json_content in
64 { content; unknown = Unknown.empty })
65 |> Jsont.Object.mem "content" Jsont.json ~enc:(fun t ->
66 encode_content (content t))
67 |> Jsont.Object.finish
68 in
69 Jsont.Object.map ~kind:"UserEnvelope" Fun.id
70 |> Jsont.Object.mem "message" message_jsont ~enc:Fun.id
71 |> Jsont.Object.finish
72end
73
74module Assistant = struct
75 type error =
76 [ `Authentication_failed
77 | `Billing_error
78 | `Rate_limit
79 | `Invalid_request
80 | `Server_error
81 | `Unknown ]
82
83 let error_jsont : error Jsont.t =
84 Jsont.enum
85 [
86 ("authentication_failed", `Authentication_failed);
87 ("billing_error", `Billing_error);
88 ("rate_limit", `Rate_limit);
89 ("invalid_request", `Invalid_request);
90 ("server_error", `Server_error);
91 ("unknown", `Unknown);
92 ]
93
94 type t = {
95 content : Content_block.t list;
96 model : string;
97 error : error option;
98 unknown : Unknown.t;
99 }
100
101 let create ~content ~model ?error () =
102 { content; model; error; unknown = Unknown.empty }
103
104 let make content model error unknown = { content; model; error; unknown }
105 let content t = t.content
106 let model t = t.model
107 let error t = t.error
108 let unknown t = t.unknown
109
110 let jsont : t Jsont.t =
111 Jsont.Object.map ~kind:"Assistant" make
112 |> Jsont.Object.mem "content" (Jsont.list Content_block.jsont) ~enc:content
113 |> Jsont.Object.mem "model" Jsont.string ~enc:model
114 |> Jsont.Object.opt_mem "error" error_jsont ~enc:error
115 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
116 |> Jsont.Object.finish
117
118 (* Jsont codec for parsing incoming assistant messages from CLI *)
119 let incoming_jsont : t Jsont.t =
120 Jsont.Object.map ~kind:"AssistantEnvelope" Fun.id
121 |> Jsont.Object.mem "message" jsont ~enc:Fun.id
122 |> Jsont.Object.finish
123end
124
125module System = struct
126 (** System messages as a discriminated union on "subtype" field *)
127
128 type init = {
129 session_id : string option;
130 model : string option;
131 cwd : string option;
132 unknown : Unknown.t;
133 }
134
135 type error = { error : string; unknown : Unknown.t }
136 type t = Init of init | Error of error
137
138 (* Accessors *)
139 let session_id = function Init i -> i.session_id | _ -> None
140 let model = function Init i -> i.model | _ -> None
141 let cwd = function Init i -> i.cwd | _ -> None
142 let error_msg = function Error e -> Some e.error | _ -> None
143 let unknown = function Init i -> i.unknown | Error e -> e.unknown
144
145 (* Constructors *)
146 let init ?session_id ?model ?cwd () =
147 Init { session_id; model; cwd; unknown = Unknown.empty }
148
149 let error ~error = Error { error; unknown = Unknown.empty }
150
151 (* Individual record codecs *)
152 let init_jsont : init Jsont.t =
153 let make session_id model cwd unknown : init =
154 { session_id; model; cwd; unknown }
155 in
156 Jsont.Object.map ~kind:"SystemInit" make
157 |> Jsont.Object.opt_mem "session_id" Jsont.string ~enc:(fun (r : init) ->
158 r.session_id)
159 |> Jsont.Object.opt_mem "model" Jsont.string ~enc:(fun (r : init) ->
160 r.model)
161 |> Jsont.Object.opt_mem "cwd" Jsont.string ~enc:(fun (r : init) -> r.cwd)
162 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : init) ->
163 r.unknown)
164 |> Jsont.Object.finish
165
166 let error_jsont : error Jsont.t =
167 let make err unknown : error = { error = err; unknown } in
168 Jsont.Object.map ~kind:"SystemError" make
169 |> Jsont.Object.mem "error" Jsont.string ~enc:(fun (r : error) -> r.error)
170 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : error) ->
171 r.unknown)
172 |> Jsont.Object.finish
173
174 (* Main codec using case_mem for "subtype" discriminator *)
175 let jsont : t Jsont.t =
176 let case_init =
177 Jsont.Object.Case.map "init" init_jsont ~dec:(fun v -> Init v)
178 in
179 let case_error =
180 Jsont.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
181 in
182 let enc_case = function
183 | Init v -> Jsont.Object.Case.value case_init v
184 | Error v -> Jsont.Object.Case.value case_error v
185 in
186 let cases = Jsont.Object.Case.[ make case_init; make case_error ] in
187 Jsont.Object.map ~kind:"System" Fun.id
188 |> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases
189 ~tag_to_string:Fun.id ~tag_compare:String.compare
190 |> Jsont.Object.finish
191end
192
193module Result = struct
194 module Usage = struct
195 type t = {
196 input_tokens : int option;
197 output_tokens : int option;
198 total_tokens : int option;
199 cache_creation_input_tokens : int option;
200 cache_read_input_tokens : int option;
201 unknown : Unknown.t;
202 }
203
204 let make input_tokens output_tokens total_tokens cache_creation_input_tokens
205 cache_read_input_tokens unknown =
206 {
207 input_tokens;
208 output_tokens;
209 total_tokens;
210 cache_creation_input_tokens;
211 cache_read_input_tokens;
212 unknown;
213 }
214
215 let create ?input_tokens ?output_tokens ?total_tokens
216 ?cache_creation_input_tokens ?cache_read_input_tokens () =
217 {
218 input_tokens;
219 output_tokens;
220 total_tokens;
221 cache_creation_input_tokens;
222 cache_read_input_tokens;
223 unknown = Unknown.empty;
224 }
225
226 let input_tokens t = t.input_tokens
227 let output_tokens t = t.output_tokens
228 let total_tokens t = t.total_tokens
229 let cache_creation_input_tokens t = t.cache_creation_input_tokens
230 let cache_read_input_tokens t = t.cache_read_input_tokens
231 let unknown t = t.unknown
232
233 let jsont : t Jsont.t =
234 Jsont.Object.map ~kind:"Usage" make
235 |> Jsont.Object.opt_mem "input_tokens" Jsont.int ~enc:input_tokens
236 |> Jsont.Object.opt_mem "output_tokens" Jsont.int ~enc:output_tokens
237 |> Jsont.Object.opt_mem "total_tokens" Jsont.int ~enc:total_tokens
238 |> Jsont.Object.opt_mem "cache_creation_input_tokens" Jsont.int
239 ~enc:cache_creation_input_tokens
240 |> Jsont.Object.opt_mem "cache_read_input_tokens" Jsont.int
241 ~enc:cache_read_input_tokens
242 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
243 |> Jsont.Object.finish
244 end
245
246 type t = {
247 subtype : string;
248 duration_ms : int;
249 duration_api_ms : int;
250 is_error : bool;
251 num_turns : int;
252 session_id : string;
253 total_cost_usd : float option;
254 usage : Usage.t option;
255 result : string option;
256 structured_output : Jsont.json option;
257 unknown : Unknown.t;
258 }
259
260 let create ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns
261 ~session_id ?total_cost_usd ?usage ?result ?structured_output () =
262 {
263 subtype;
264 duration_ms;
265 duration_api_ms;
266 is_error;
267 num_turns;
268 session_id;
269 total_cost_usd;
270 usage;
271 result;
272 structured_output;
273 unknown = Unknown.empty;
274 }
275
276 let make subtype duration_ms duration_api_ms is_error num_turns session_id
277 total_cost_usd usage result structured_output unknown =
278 {
279 subtype;
280 duration_ms;
281 duration_api_ms;
282 is_error;
283 num_turns;
284 session_id;
285 total_cost_usd;
286 usage;
287 result;
288 structured_output;
289 unknown;
290 }
291
292 let subtype t = t.subtype
293 let duration_ms t = t.duration_ms
294 let duration_api_ms t = t.duration_api_ms
295 let is_error t = t.is_error
296 let num_turns t = t.num_turns
297 let session_id t = t.session_id
298 let total_cost_usd t = t.total_cost_usd
299 let usage t = t.usage
300 let result t = t.result
301 let structured_output t = t.structured_output
302 let unknown t = t.unknown
303
304 let jsont : t Jsont.t =
305 Jsont.Object.map ~kind:"Result" make
306 |> Jsont.Object.mem "subtype" Jsont.string ~enc:subtype
307 |> Jsont.Object.mem "duration_ms" Jsont.int ~enc:duration_ms
308 |> Jsont.Object.mem "duration_api_ms" Jsont.int ~enc:duration_api_ms
309 |> Jsont.Object.mem "is_error" Jsont.bool ~enc:is_error
310 |> Jsont.Object.mem "num_turns" Jsont.int ~enc:num_turns
311 |> Jsont.Object.mem "session_id" Jsont.string ~enc:session_id
312 |> Jsont.Object.opt_mem "total_cost_usd" Jsont.number ~enc:total_cost_usd
313 |> Jsont.Object.opt_mem "usage" Usage.jsont ~enc:usage
314 |> Jsont.Object.opt_mem "result" Jsont.string ~enc:result
315 |> Jsont.Object.opt_mem "structured_output" Jsont.json
316 ~enc:structured_output
317 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
318 |> Jsont.Object.finish
319end
320
321type t =
322 | User of User.t
323 | Assistant of Assistant.t
324 | System of System.t
325 | Result of Result.t
326
327(* Jsont codec for the main Message variant type.
328 Uses case_mem for discriminated union based on "type" field. *)
329let jsont : t Jsont.t =
330 let case_map kind obj dec = Jsont.Object.Case.map kind obj ~dec in
331 let case_user = case_map "user" User.incoming_jsont (fun v -> User v) in
332 let case_assistant =
333 case_map "assistant" Assistant.incoming_jsont (fun v -> Assistant v)
334 in
335 let case_system = case_map "system" System.jsont (fun v -> System v) in
336 let case_result = case_map "result" Result.jsont (fun v -> Result v) in
337 let enc_case = function
338 | User v -> Jsont.Object.Case.value case_user v
339 | Assistant v -> Jsont.Object.Case.value case_assistant v
340 | System v -> Jsont.Object.Case.value case_system v
341 | Result v -> Jsont.Object.Case.value case_result v
342 in
343 let cases =
344 Jsont.Object.Case.
345 [
346 make case_user; make case_assistant; make case_system; make case_result;
347 ]
348 in
349 Jsont.Object.map ~kind:"Message" Fun.id
350 |> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
351 ~tag_to_string:Fun.id ~tag_compare:String.compare
352 |> Jsont.Object.finish