···
(* Utility functions for JSON parsing *)
(* 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
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* Extract an optional string field from JSON object *)
let get_optional_string_field fields name =
List.assoc_opt name fields |> Option.map (function
-
| j -> raise (Json.Of_json (Printf.sprintf "Expected string for %s" name, j))
(* 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
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* 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
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* 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
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* 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
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* 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
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* 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 -> ()
-
| _ -> raise (Json.Of_json (Printf.sprintf "Field '%s' missing or not equal to '%s'" name expected_value, json))
(* Error codes for JSON-RPC *)
···
| "assistant" -> `Assistant
-
| s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))
let yojson_of_t t = `String (to_string t)
let t_of_yojson = function
| `String s -> of_string s
-
| j -> raise (Json.Of_json ("Expected string for Role", j))
module ProgressToken = struct
···
let yojson_of_t t = `String t
let t_of_yojson = function
-
| j -> raise (Json.Of_json ("Expected string for Cursor", j))
···
let audience = List.assoc_opt "audience" fields |> Option.map (function
| `List items -> List.map Role.t_of_yojson items
-
| j -> raise (Json.Of_json ("Expected list for audience", j))
let priority = List.assoc_opt "priority" fields |> Option.map (function
-
| j -> raise (Json.Of_json ("Expected float for priority", j))
-
| j -> raise (Json.Of_json ("Expected object for annotation", j))
let yojson_of_t { annotations } =
···
let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
-
| j -> raise (Json.Of_json ("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
-
| j -> raise (Json.Of_json ("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 }
-
| j -> raise (Json.Of_json ("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 }
-
| j -> raise (Json.Of_json ("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
-
| j -> raise (Json.Of_json ("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
-
| j -> raise (Json.Of_json ("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
-
| j -> raise (Json.Of_json ("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
-
| _ -> raise (Json.Of_json ("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))
-
raise (Json.Of_json ("Invalid resource content", `Assoc resource_fields))
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ resource; annotations }
-
| j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))
···
| Resource r -> EmbeddedResource.yojson_of_t r
let content_of_yojson = function
(match List.assoc_opt "type" fields with
-
| Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))
-
| Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))
-
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson (`Assoc fields))
-
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))
-
| _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))
-
| j -> raise (Json.Of_json ("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
-
| None -> raise (Json.Of_json ("Missing role field", json))
let content = match List.assoc_opt "content" fields with
| Some json -> content_of_yojson json
-
| None -> raise (Json.Of_json ("Missing content field", json))
-
| j -> raise (Json.Of_json ("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
-
| None -> raise (Json.Of_json ("Missing role field", json))
let content_obj = match List.assoc_opt "content" fields with
| Some (`Assoc content_fields) -> content_fields
-
| _ -> raise (Json.Of_json ("Missing or invalid content field", json))
let content_type = match List.assoc_opt "type" content_obj with
| Some (`String ty) -> ty
-
| _ -> raise (Json.Of_json ("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))
-
| _ -> raise (Json.Of_json (Printf.sprintf "Invalid content type: %s" content_type, `Assoc content_obj))
-
| j -> raise (Json.Of_json ("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
-
| j -> raise (Json.Of_json ("Expected object for Implementation", j))
(* JSONRPC Message types *)
···
let meth = match List.assoc_opt "method" fields with
-
with Failure msg -> raise (Json.Of_json (msg, `String s)))
-
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
let params = List.assoc_opt "params" fields in
-
| j -> raise (Json.Of_json ("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
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
let meth = match List.assoc_opt "method" fields with
-
with Failure msg -> raise (Json.Of_json (msg, `String s)))
-
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
let params = List.assoc_opt "params" fields in
···
{ id; meth; params; progress_token }
-
| j -> raise (Json.Of_json ("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
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
let result = match List.assoc_opt "result" fields with
-
| _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
-
| j -> raise (Json.Of_json ("Expected object for response", j))
let error_of_yojson = function
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
let error = match List.assoc_opt "error" fields with
| Some (`Assoc error_fields) -> error_fields
-
| _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))
let code = match List.assoc_opt "code" error with
| Some (`Int code) -> code
-
| _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))
let message = match List.assoc_opt "message" error with
| Some (`String msg) -> msg
-
| _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))
let data = List.assoc_opt "data" error in
{ id; code; message; data }
-
| j -> raise (Json.Of_json ("Expected object for error", j))
let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
| Some (`String "2.0") -> ()
-
| _ -> raise (Json.Of_json ("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)
-
raise (Json.Of_json ("Invalid JSONRPC message format", json))
-
| j -> raise (Json.Of_json ("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
-
| None -> raise (Json.Of_json ("Missing capabilities field", json))
let client_info = match List.assoc_opt "clientInfo" fields with
| Some json -> Implementation.t_of_yojson json
-
| None -> raise (Json.Of_json ("Missing clientInfo field", json))
let protocol_version = Util.get_string_field fields "protocolVersion" json in
{ capabilities; client_info; protocol_version }
-
| j -> raise (Json.Of_json ("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
-
| None -> raise (Json.Of_json ("Missing capabilities field", json))
let server_info = match List.assoc_opt "serverInfo" fields with
| Some json -> Implementation.t_of_yojson json
-
| None -> raise (Json.Of_json ("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 }
-
| j -> raise (Json.Of_json ("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
-
| j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
let create ?meta () = { meta }