···
let report_progress ctx value total =
match ctx.progress_token, ctx.request_id with
45
-
| Some token, Some id ->
45
+
| Some token, Some _id ->
("progress", `Float value);
···
("required", required_json)
188
-
(* Server implementation *)
189
-
module Server = struct
190
-
type startup_hook = unit -> unit
191
-
type shutdown_hook = unit -> unit
188
+
(* Main server type *)
192
+
protocol_version: string;
193
+
mutable capabilities: Json.t;
194
+
mutable tools: Tool.t list;
195
+
mutable resources: Resource.t list;
196
+
mutable prompts: Prompt.t list;
197
+
mutable lifespan_context: (string * Json.t) list;
198
+
mutable startup_hook: (unit -> unit) option;
199
+
mutable shutdown_hook: (unit -> unit) option;
196
-
protocol_version: string;
197
-
mutable capabilities: Json.t;
198
-
mutable tools: Tool.t list;
199
-
mutable resources: Resource.t list;
200
-
mutable prompts: Prompt.t list;
201
-
mutable lifespan_context: (string * Json.t) list;
202
-
startup_hook: startup_hook option;
203
-
shutdown_hook: shutdown_hook option;
202
+
(* Create a new server *)
203
+
let create_server ~name ?(version="0.1.0") ?(protocol_version="2024-11-05") () =
208
+
capabilities = `Assoc [];
212
+
lifespan_context = [];
213
+
startup_hook = None;
214
+
shutdown_hook = None;
206
-
let create ~name ?(version="0.1.0") ?(protocol_version="2024-11-05") ?startup_hook ?shutdown_hook () =
211
-
capabilities = `Assoc [];
215
-
lifespan_context = [];
217
+
(* Default capabilities for the server *)
218
+
let default_capabilities ?(with_tools=true) ?(with_resources=false) ?(with_prompts=false) () =
223
+
("listChanged", `Bool true)
229
+
if with_resources then
230
+
("resources", `Assoc [
231
+
("listChanged", `Bool true);
232
+
("subscribe", `Bool false)
234
+
else if not with_resources then
235
+
("resources", `Assoc [
236
+
("listChanged", `Bool false);
237
+
("subscribe", `Bool false)
243
+
if with_prompts then
244
+
("prompts", `Assoc [
245
+
("listChanged", `Bool true)
247
+
else if not with_prompts then
248
+
("prompts", `Assoc [
249
+
("listChanged", `Bool false)
256
+
(* Register a tool *)
257
+
let register_tool server tool =
258
+
server.tools <- tool :: server.tools;
220
-
(* Register a tool *)
221
-
let register_tool server tool =
222
-
server.tools <- tool :: server.tools;
261
+
(* Create and register a tool in one step *)
262
+
let add_tool server ~name ?description ?(schema_properties=[]) ?(schema_required=[]) handler =
263
+
let input_schema = make_tool_schema schema_properties schema_required in
264
+
let handler' ctx args =
268
+
Error (Printexc.to_string exn)
270
+
let tool = Tool.create
277
+
register_tool server tool
225
-
(* Register a resource *)
226
-
let register_resource server resource =
227
-
server.resources <- resource :: server.resources;
279
+
(* Register a resource *)
280
+
let register_resource server resource =
281
+
server.resources <- resource :: server.resources;
284
+
(* Create and register a resource in one step *)
285
+
let add_resource server ~uri_template ?description ?mime_type handler =
286
+
let handler' _ctx params =
288
+
Ok (handler params)
290
+
Error (Printexc.to_string exn)
292
+
let resource = Resource.create
299
+
register_resource server resource
230
-
(* Register a prompt *)
231
-
let register_prompt server prompt =
232
-
server.prompts <- prompt :: server.prompts;
301
+
(* Register a prompt *)
302
+
let register_prompt server prompt =
303
+
server.prompts <- prompt :: server.prompts;
306
+
(* Create and register a prompt in one step *)
307
+
let add_prompt server ~name ?description ?(arguments=[]) handler =
308
+
let prompt_args = List.map (fun (name, desc, required) ->
309
+
Prompt.create_argument ~name ?description:desc ~required ()
311
+
let handler' _ctx args =
315
+
Error (Printexc.to_string exn)
317
+
let prompt = Prompt.create
320
+
~arguments:prompt_args
235
-
(* Default server capabilities *)
236
-
let default_capabilities ?(with_tools=true) ?(with_resources=false) ?(with_prompts=false) () =
241
-
("listChanged", `Bool true)
247
-
if with_resources then
248
-
("resources", `Assoc [
249
-
("listChanged", `Bool true);
250
-
("subscribe", `Bool false)
252
-
else if not with_resources then
253
-
("resources", `Assoc [
254
-
("listChanged", `Bool false);
255
-
("subscribe", `Bool false)
261
-
if with_prompts then
262
-
("prompts", `Assoc [
263
-
("listChanged", `Bool true)
265
-
else if not with_prompts then
266
-
("prompts", `Assoc [
267
-
("listChanged", `Bool false)
324
+
register_prompt server prompt
326
+
(* Set server capabilities *)
327
+
let set_capabilities server capabilities =
328
+
server.capabilities <- capabilities
274
-
(* Update server capabilities *)
275
-
let update_capabilities server capabilities =
276
-
server.capabilities <- capabilities
330
+
(* Configure server with default capabilities based on registered components *)
331
+
let configure_server server ?with_tools ?with_resources ?with_prompts () =
332
+
let with_tools = match with_tools with
334
+
| None -> server.tools <> []
336
+
let with_resources = match with_resources with
338
+
| None -> server.resources <> []
340
+
let with_prompts = match with_prompts with
342
+
| None -> server.prompts <> []
344
+
let capabilities = default_capabilities ~with_tools ~with_resources ~with_prompts () in
345
+
set_capabilities server capabilities;
278
-
(* Process a message *)
279
-
let process_message _server _json =
282
-
(* Main server loop *)
284
-
(* Placeholder implementation *)
348
+
(* Set startup and shutdown hooks *)
349
+
let set_startup_hook server hook =
350
+
server.startup_hook <- Some hook
288
-
(* Helper function for default capabilities *)
289
-
let default_capabilities = Server.default_capabilities
352
+
let set_shutdown_hook server hook =
353
+
server.shutdown_hook <- Some hook
291
-
(* Add syntactic sugar for creating a server *)
292
-
module MakeServer(S: sig val name: string val version: string option end) = struct
293
-
let _config = (S.name, S.version) (* Used to prevent unused parameter warning *)
355
+
(* Run the server *)
356
+
let run_server server =
358
+
Printexc.record_backtrace true;
359
+
set_binary_mode_out stdout false;
295
-
(* Create server *)
296
-
let server = Server.create
299
-
~protocol_version:"2024-11-05"
302
-
(* Create a tool *)
303
-
let tool ?name ?description ?(schema_properties=[]) ?(schema_required=[]) handler =
304
-
let name = match name with
305
-
| Some (Some n) -> n
306
-
| Some None | None -> "tool" in
307
-
let input_schema = make_tool_schema schema_properties schema_required in
308
-
let handler' ctx args =
312
-
Error (Printexc.to_string exn)
314
-
let tool = Tool.create
321
-
server.tools <- tool :: server.tools;
324
-
(* Create a resource *)
325
-
let resource ?uri_template ?description ?mime_type handler =
326
-
let uri_template = match uri_template with
327
-
| Some (Some uri) -> uri
328
-
| Some None | None -> "resource://" in
329
-
let handler' ctx params =
331
-
Ok (handler params)
333
-
Error (Printexc.to_string exn)
335
-
let resource = Resource.create
342
-
server.resources <- resource :: server.resources;
345
-
(* Create a prompt *)
346
-
let prompt ?name ?description ?(arguments=[]) handler =
347
-
let name = match name with
348
-
| Some (Some n) -> n
349
-
| Some None | None -> "prompt" in
350
-
let prompt_args = List.map (fun (name, desc, required) ->
351
-
Prompt.create_argument ~name ?description:desc ~required ()
353
-
let handler' ctx args =
357
-
Error (Printexc.to_string exn)
359
-
let prompt = Prompt.create
362
-
~arguments:prompt_args
366
-
server.prompts <- prompt :: server.prompts;
369
-
(* Run the server *)
370
-
let run ?with_tools ?with_resources ?with_prompts () =
371
-
let with_tools = match with_tools with
373
-
| None -> server.tools <> []
375
-
let with_resources = match with_resources with
377
-
| None -> server.resources <> []
379
-
let with_prompts = match with_prompts with
381
-
| None -> server.prompts <> []
383
-
let capabilities = Server.default_capabilities ~with_tools ~with_resources ~with_prompts () in
384
-
server.capabilities <- capabilities;
385
-
Log.info "Starting server...";
386
-
Log.info (Printf.sprintf "Server info: %s v%s" server.name
387
-
(match S.version with Some v -> v | None -> "unknown"));
388
-
Printexc.record_backtrace true;
389
-
set_binary_mode_out stdout false;
390
-
Log.info "This is just a placeholder server implementation."
361
+
Log.info (Printf.sprintf "%s server started" server.name);
362
+
Log.debug (Printf.sprintf "Protocol version: %s" server.protocol_version);
363
+
Log.debug (Printf.sprintf "Server info: %s v%s" server.name server.version);
365
+
(* Initialize capabilities if not already set *)
366
+
if server.capabilities = `Assoc [] then
367
+
ignore (configure_server server ());
369
+
(* Run startup hook if provided *)
370
+
(match server.startup_hook with
371
+
| Some hook -> hook ()
374
+
Log.info "Server initialized and ready."
anil.recoil.org