···
(* Utility functions for JSON parsing *)
5
+
(* Helper to raise a Json.Of_json exception with formatted message *)
6
+
let json_error fmt json =
7
+
Printf.ksprintf (fun msg -> raise (Json.Of_json (msg, json))) fmt
(* Extract a string field from JSON object or raise an error *)
let get_string_field fields name json =
match List.assoc_opt name fields with
9
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
13
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract an optional string field from JSON object *)
let get_optional_string_field fields name =
List.assoc_opt name fields |> Option.map (function
15
-
| j -> raise (Json.Of_json (Printf.sprintf "Expected string for %s" name, j))
19
+
| j -> json_error "Expected string for %s" j name
(* Extract an int field from JSON object or raise an error *)
let get_int_field fields name json =
match List.assoc_opt name fields with
22
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
26
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract a float field from JSON object or raise an error *)
let get_float_field fields name json =
match List.assoc_opt name fields with
28
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
32
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract a boolean field from JSON object or raise an error *)
let get_bool_field fields name json =
match List.assoc_opt name fields with
34
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
38
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract an object field from JSON object or raise an error *)
let get_object_field fields name json =
match List.assoc_opt name fields with
| Some (`Assoc obj) -> obj
40
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
44
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract a list field from JSON object or raise an error *)
let get_list_field fields name json =
match List.assoc_opt name fields with
| Some (`List items) -> items
46
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
50
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Verify a specific string value in a field *)
let verify_string_field fields name expected_value json =
match List.assoc_opt name fields with
| Some (`String s) when s = expected_value -> ()
52
-
| _ -> raise (Json.Of_json (Printf.sprintf "Field '%s' missing or not equal to '%s'" name expected_value, json))
56
+
| _ -> json_error "Field '%s' missing or not equal to '%s'" json name expected_value
(* Error codes for JSON-RPC *)
···
| "assistant" -> `Assistant
169
-
| s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))
173
+
| s -> Util.json_error "Unknown role: %s" (`String s) s
let yojson_of_t t = `String (to_string t)
let t_of_yojson = function
| `String s -> of_string s
174
-
| j -> raise (Json.Of_json ("Expected string for Role", j))
178
+
| j -> Util.json_error "Expected string for Role" j
module ProgressToken = struct
···
let yojson_of_t t = `String t
let t_of_yojson = function
191
-
| j -> raise (Json.Of_json ("Expected string for Cursor", j))
195
+
| j -> Util.json_error "Expected string for Cursor" j
···
let audience = List.assoc_opt "audience" fields |> Option.map (function
| `List items -> List.map Role.t_of_yojson items
221
-
| j -> raise (Json.Of_json ("Expected list for audience", j))
225
+
| j -> Util.json_error "Expected list for audience" j
let priority = List.assoc_opt "priority" fields |> Option.map (function
225
-
| j -> raise (Json.Of_json ("Expected float for priority", j))
229
+
| j -> Util.json_error "Expected float for priority" j
228
-
| j -> raise (Json.Of_json ("Expected object for annotation", j))
232
+
| j -> Util.json_error "Expected object for annotation" j
let yojson_of_t { annotations } =
···
let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
239
-
| j -> raise (Json.Of_json ("Expected object for Annotated", j))
243
+
| j -> Util.json_error "Expected object for Annotated" j
···
Util.verify_string_field fields "type" "text" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
267
-
| j -> raise (Json.Of_json ("Expected object for TextContent", j))
271
+
| j -> Util.json_error "Expected object for TextContent" j
module ImageContent = struct
···
Util.verify_string_field fields "type" "image" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ data; mime_type; annotations }
296
-
| j -> raise (Json.Of_json ("Expected object for ImageContent", j))
300
+
| j -> Util.json_error "Expected object for ImageContent" j
module AudioContent = struct
···
Util.verify_string_field fields "type" "audio" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ data; mime_type; annotations }
325
-
| j -> raise (Json.Of_json ("Expected object for AudioContent", j))
329
+
| j -> Util.json_error "Expected object for AudioContent" j
module ResourceContents = struct
···
let uri = Util.get_string_field fields "uri" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
349
-
| j -> raise (Json.Of_json ("Expected object for ResourceContents", j))
353
+
| j -> Util.json_error "Expected object for ResourceContents" j
module TextResourceContents = struct
···
let text = Util.get_string_field fields "text" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
376
-
| j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))
380
+
| j -> Util.json_error "Expected object for TextResourceContents" j
module BlobResourceContents = struct
···
let blob = Util.get_string_field fields "blob" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
403
-
| j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))
407
+
| j -> Util.json_error "Expected object for BlobResourceContents" j
module EmbeddedResource = struct
···
Util.verify_string_field fields "type" "resource" json;
let resource_fields = match List.assoc_opt "resource" fields with
| Some (`Assoc res_fields) -> res_fields
432
-
| _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", json))
436
+
| _ -> Util.json_error "Missing or invalid 'resource' field" json
if List.mem_assoc "text" resource_fields then
···
else if List.mem_assoc "blob" resource_fields then
`Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))
440
-
raise (Json.Of_json ("Invalid resource content", `Assoc resource_fields))
444
+
Util.json_error "Invalid resource content" (`Assoc resource_fields)
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ resource; annotations }
444
-
| j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))
448
+
| j -> Util.json_error "Expected object for EmbeddedResource" j
···
| Resource r -> EmbeddedResource.yojson_of_t r
let content_of_yojson = function
464
+
| `Assoc fields as json ->
(match List.assoc_opt "type" fields with
462
-
| Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))
463
-
| Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))
464
-
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson (`Assoc fields))
465
-
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))
466
-
| _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))
467
-
| j -> raise (Json.Of_json ("Expected object for content", j))
466
+
| Some (`String "text") -> Text (TextContent.t_of_yojson json)
467
+
| Some (`String "image") -> Image (ImageContent.t_of_yojson json)
468
+
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)
469
+
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)
470
+
| _ -> Util.json_error "Invalid or missing content type" json)
471
+
| j -> Util.json_error "Expected object for content" j
···
| `Assoc fields as json ->
let role = match List.assoc_opt "role" fields with
| Some json -> Role.t_of_yojson json
487
-
| None -> raise (Json.Of_json ("Missing role field", json))
491
+
| None -> Util.json_error "Missing role field" json
let content = match List.assoc_opt "content" fields with
| Some json -> content_of_yojson json
491
-
| None -> raise (Json.Of_json ("Missing content field", json))
495
+
| None -> Util.json_error "Missing content field" json
494
-
| j -> raise (Json.Of_json ("Expected object for PromptMessage", j))
498
+
| j -> Util.json_error "Expected object for PromptMessage" j
module SamplingMessage = struct
···
| `Assoc fields as json ->
let role = match List.assoc_opt "role" fields with
| Some json -> Role.t_of_yojson json
518
-
| None -> raise (Json.Of_json ("Missing role field", json))
522
+
| None -> Util.json_error "Missing role field" json
let content_obj = match List.assoc_opt "content" fields with
| Some (`Assoc content_fields) -> content_fields
522
-
| _ -> raise (Json.Of_json ("Missing or invalid content field", json))
526
+
| _ -> Util.json_error "Missing or invalid content field" json
let content_type = match List.assoc_opt "type" content_obj with
| Some (`String ty) -> ty
526
-
| _ -> raise (Json.Of_json ("Missing or invalid content type", `Assoc content_obj))
530
+
| _ -> Util.json_error "Missing or invalid content type" (`Assoc content_obj)
| "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))
| "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))
| "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))
533
-
| _ -> raise (Json.Of_json (Printf.sprintf "Invalid content type: %s" content_type, `Assoc content_obj))
537
+
| _ -> Util.json_error "Invalid content type: %s" (`Assoc content_obj) content_type
536
-
| j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))
540
+
| j -> Util.json_error "Expected object for SamplingMessage" j
(* Implementation info *)
···
let name = Util.get_string_field fields "name" json in
let version = Util.get_string_field fields "version" json in
558
-
| j -> raise (Json.Of_json ("Expected object for Implementation", j))
562
+
| j -> Util.json_error "Expected object for Implementation" j
(* JSONRPC Message types *)
···
let meth = match List.assoc_opt "method" fields with
662
-
with Failure msg -> raise (Json.Of_json (msg, `String s)))
663
-
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
666
+
with Failure msg -> Util.json_error "%s" (`String s) msg)
667
+
| _ -> Util.json_error "Missing or invalid 'method' field" (`Assoc fields)
let params = List.assoc_opt "params" fields in
667
-
| j -> raise (Json.Of_json ("Expected object for notification", j))
671
+
| j -> Util.json_error "Expected object for notification" j
let request_of_yojson = function
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
673
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
677
+
| _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)
let meth = match List.assoc_opt "method" fields with
678
-
with Failure msg -> raise (Json.Of_json (msg, `String s)))
679
-
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
682
+
with Failure msg -> Util.json_error "%s" (`String s) msg)
683
+
| _ -> Util.json_error "Missing or invalid 'method' field" (`Assoc fields)
let params = List.assoc_opt "params" fields in
···
{ id; meth; params; progress_token }
694
-
| j -> raise (Json.Of_json ("Expected object for request", j))
698
+
| j -> Util.json_error "Expected object for request" j
let response_of_yojson = function
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
700
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
704
+
| _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)
let result = match List.assoc_opt "result" fields with
704
-
| _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
708
+
| _ -> Util.json_error "Missing 'result' field" (`Assoc fields)
707
-
| j -> raise (Json.Of_json ("Expected object for response", j))
711
+
| j -> Util.json_error "Expected object for response" j
let error_of_yojson = function
714
+
| `Assoc fields as json ->
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
713
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
717
+
| _ -> Util.json_error "Missing or invalid 'id' field" json
let error = match List.assoc_opt "error" fields with
| Some (`Assoc error_fields) -> error_fields
717
-
| _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))
721
+
| _ -> Util.json_error "Missing or invalid 'error' field" json
let code = match List.assoc_opt "code" error with
| Some (`Int code) -> code
721
-
| _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))
725
+
| _ -> Util.json_error "Missing or invalid 'code' field in error" (`Assoc error)
let message = match List.assoc_opt "message" error with
| Some (`String msg) -> msg
725
-
| _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))
729
+
| _ -> Util.json_error "Missing or invalid 'message' field in error" (`Assoc error)
let data = List.assoc_opt "data" error in
{ id; code; message; data }
729
-
| j -> raise (Json.Of_json ("Expected object for error", j))
733
+
| j -> Util.json_error "Expected object for error" j
let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
| Some (`String "2.0") -> ()
736
-
| _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))
740
+
| _ -> Util.json_error "Missing or invalid 'jsonrpc' field" json
if List.mem_assoc "method" fields then
if List.mem_assoc "id" fields then
···
else if List.mem_assoc "error" fields then
Error (error_of_yojson json)
748
-
raise (Json.Of_json ("Invalid JSONRPC message format", json))
749
-
| j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))
752
+
Util.json_error "Invalid JSONRPC message format" json
753
+
| j -> Util.json_error "Expected object for JSONRPC message" j
let create_notification ?(params=None) ~meth () =
Notification { meth; params }
···
| `Assoc fields as json ->
let capabilities = match List.assoc_opt "capabilities" fields with
785
-
| None -> raise (Json.Of_json ("Missing capabilities field", json))
789
+
| None -> Util.json_error "Missing capabilities field" json
let client_info = match List.assoc_opt "clientInfo" fields with
| Some json -> Implementation.t_of_yojson json
789
-
| None -> raise (Json.Of_json ("Missing clientInfo field", json))
793
+
| None -> Util.json_error "Missing clientInfo field" json
let protocol_version = Util.get_string_field fields "protocolVersion" json in
{ capabilities; client_info; protocol_version }
793
-
| j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))
797
+
| j -> Util.json_error "Expected object for InitializeRequest" j
let create ~capabilities ~client_info ~protocol_version =
{ capabilities; client_info; protocol_version }
···
| `Assoc fields as json ->
let capabilities = match List.assoc_opt "capabilities" fields with
832
-
| None -> raise (Json.Of_json ("Missing capabilities field", json))
836
+
| None -> Util.json_error "Missing capabilities field" json
let server_info = match List.assoc_opt "serverInfo" fields with
| Some json -> Implementation.t_of_yojson json
836
-
| None -> raise (Json.Of_json ("Missing serverInfo field", json))
840
+
| None -> Util.json_error "Missing serverInfo field" json
let protocol_version = Util.get_string_field fields "protocolVersion" json in
let instructions = Util.get_optional_string_field fields "instructions" in
let meta = List.assoc_opt "_meta" fields in
{ capabilities; server_info; protocol_version; instructions; meta }
842
-
| j -> raise (Json.Of_json ("Expected object for InitializeResult", j))
846
+
| j -> Util.json_error "Expected object for InitializeResult" j
let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =
{ capabilities; server_info; protocol_version; instructions; meta }
···
let meta = List.assoc_opt "_meta" fields in
870
-
| j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
874
+
| j -> Util.json_error "Expected object for InitializedNotification" j
let create ?meta () = { meta }
anil.recoil.org