anil.recoil.org
OCaml Claude SDK using Eio and Jsont
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6module J = Jsont.Json
7
8type t = {
9 name : string;
10 version : string;
11 tools : Tool.t list;
12 tool_map : (string, Tool.t) Hashtbl.t;
13}
14
15let create ~name ?(version = "1.0.0") ~tools () =
16 let tool_map = Hashtbl.create (List.length tools) in
17 List.iter (fun tool -> Hashtbl.add tool_map (Tool.name tool) tool) tools;
18 { name; version; tools; tool_map }
19
20let name t = t.name
21let version t = t.version
22let tools t = t.tools
23
24(* JSONRPC helpers using Jsont.Json builders *)
25
26let jsonrpc_success ~id result =
27 J.object'
28 [
29 J.mem (J.name "jsonrpc") (J.string "2.0");
30 J.mem (J.name "id") id;
31 J.mem (J.name "result") result;
32 ]
33
34let jsonrpc_error ~id ~code ~message =
35 J.object'
36 [
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'
41 [
42 J.mem (J.name "code") (J.number (Float.of_int code));
43 J.mem (J.name "message") (J.string message);
44 ]);
45 ]
46
47(* Extract string from JSON *)
48let get_string key (obj : Jsont.json) =
49 match obj with
50 | Jsont.Object (mems, _) -> (
51 match J.find_mem key mems with
52 | Some (_, Jsont.String (s, _)) -> Some s
53 | _ -> None)
54 | _ -> None
55
56(* Extract object from JSON *)
57let get_object key (obj : Jsont.json) : Jsont.json option =
58 match obj with
59 | Jsont.Object (mems, _) -> (
60 match J.find_mem key mems with
61 | Some (_, (Jsont.Object _ as o)) -> Some o
62 | _ -> None)
63 | _ -> None
64
65(* Get ID from JSON message *)
66let get_id (msg : Jsont.json) : Jsont.json =
67 match msg with
68 | Jsont.Object (mems, _) -> (
69 match J.find_mem "id" mems with Some (_, id) -> id | None -> J.null ())
70 | _ -> J.null ()
71
72(* Handle initialize request *)
73let handle_initialize t ~id =
74 jsonrpc_success ~id
75 (J.object'
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'
82 [
83 J.mem (J.name "name") (J.string t.name);
84 J.mem (J.name "version") (J.string t.version);
85 ]);
86 ])
87
88(* Handle tools/list request *)
89let handle_tools_list t ~id =
90 let tools_json =
91 List.map
92 (fun tool ->
93 J.object'
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);
98 ])
99 t.tools
100 in
101 jsonrpc_success ~id (J.object' [ J.mem (J.name "tools") (J.list tools_json) ])
102
103(* Handle tools/call request *)
104let handle_tools_call t ~id ~params =
105 match get_string "name" params with
106 | None -> jsonrpc_error ~id ~code:(-32602) ~message:"Missing 'name' parameter"
107 | Some tool_name -> (
108 match Hashtbl.find_opt t.tool_map tool_name with
109 | None ->
110 jsonrpc_error ~id ~code:(-32601)
111 ~message:(Printf.sprintf "Tool '%s' not found" tool_name)
112 | Some tool -> (
113 let arguments =
114 match get_object "arguments" params with
115 | Some args -> args
116 | None -> J.object' []
117 in
118 let input = Tool_input.of_json arguments in
119 match Tool.call tool input with
120 | Ok content ->
121 jsonrpc_success ~id
122 (J.object' [ J.mem (J.name "content") content ])
123 | Error msg ->
124 (* Return error as content with is_error flag *)
125 jsonrpc_success ~id
126 (J.object'
127 [
128 J.mem (J.name "content")
129 (J.list
130 [
131 J.object'
132 [
133 J.mem (J.name "type") (J.string "text");
134 J.mem (J.name "text") (J.string msg);
135 ];
136 ]);
137 J.mem (J.name "isError") (J.bool true);
138 ])))
139
140let handle_request t ~method_ ~params ~id =
141 match method_ with
142 | "initialize" -> handle_initialize t ~id
143 | "tools/list" -> handle_tools_list t ~id
144 | "tools/call" -> handle_tools_call t ~id ~params
145 | _ ->
146 jsonrpc_error ~id ~code:(-32601)
147 ~message:(Printf.sprintf "Method '%s' not found" method_)
148
149let handle_json_message t (msg : Jsont.json) =
150 let method_ = match get_string "method" msg with Some m -> m | None -> "" in
151 let params =
152 match get_object "params" msg with Some p -> p | None -> J.object' []
153 in
154 let id = get_id msg in
155 handle_request t ~method_ ~params ~id