Model Context Protocol in OCaml
anil.recoil.org
1open Mcp
2open Mcp_sdk
3open Mcp_server
4
5(* Helper for extracting string value from JSON *)
6let get_string_param json name =
7 match json with
8 | `Assoc fields ->
9 (match List.assoc_opt name fields with
10 | Some (`String value) -> value
11 | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
12 | _ -> raise (Failure "Expected JSON object")
13
14(* Create a server *)
15let server = create_server
16 ~name:"OCaml MCP Capitalizer"
17 ~version:"0.1.0"
18 ~protocol_version:"2024-11-05"
19 ()
20
21(* Define startup and shutdown hooks *)
22let startup () =
23 (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)
24 Printf.fprintf stderr "CapitalizeServer is starting up!\n";
25 flush stderr;
26 Log.info "CapitalizeServer is starting up!"
27
28let shutdown () =
29 Printf.fprintf stderr "CapitalizeServer is shutting down. Goodbye!\n";
30 flush stderr;
31 Log.info "CapitalizeServer is shutting down. Goodbye!"
32
33(* Register the hooks *)
34let () =
35 set_startup_hook server startup;
36 set_shutdown_hook server shutdown
37
38(* Define and register a capitalize tool *)
39let _ = add_tool server
40 ~name:"capitalize"
41 ~description:"Capitalizes the provided text"
42 ~schema_properties:[
43 ("text", "string", "The text to capitalize")
44 ]
45 ~schema_required:["text"]
46 (fun args ->
47 try
48 let text = get_string_param args "text" in
49 let capitalized_text = String.uppercase_ascii text in
50 TextContent.yojson_of_t TextContent.{
51 text = capitalized_text;
52 annotations = None
53 }
54 with
55 | Failure msg ->
56 Log.error (Printf.sprintf "Error in capitalize tool: %s" msg);
57 TextContent.yojson_of_t TextContent.{
58 text = Printf.sprintf "Error: %s" msg;
59 annotations = None
60 }
61 )
62
63(* Define and register a resource example *)
64let _ = add_resource server
65 ~uri_template:"greeting://{name}"
66 ~description:"Get a greeting for a name"
67 ~mime_type:"text/plain"
68 (fun params ->
69 match params with
70 | [name] -> Printf.sprintf "Hello, %s! Welcome to the OCaml MCP server." name
71 | _ -> "Hello, world! Welcome to the OCaml MCP server."
72 )
73
74(* Define and register a prompt example *)
75let _ = add_prompt server
76 ~name:"capitalize-prompt"
77 ~description:"A prompt to help with text capitalization"
78 ~arguments:[
79 ("text", Some "The text to be capitalized", true)
80 ]
81 (fun args ->
82 let text =
83 try
84 List.assoc "text" args
85 with
86 | Not_found -> "No text provided"
87 in
88 [
89 Prompt.{
90 role = `User;
91 content = make_text_content "Please help me capitalize the following text:"
92 };
93 Prompt.{
94 role = `User;
95 content = make_text_content text
96 };
97 Prompt.{
98 role = `Assistant;
99 content = make_text_content "Here's the capitalized version:"
100 };
101 Prompt.{
102 role = `Assistant;
103 content = make_text_content (String.uppercase_ascii text)
104 }
105 ]
106 )
107
108(* Main function *)
109let () =
110 (* Parse command line arguments *)
111 let transport_type = ref Stdio in
112 let args = [
113 ("--http", Arg.Unit (fun () -> transport_type := Http),
114 "Start server with HTTP transport (default is stdio)");
115 ] in
116 let usage_msg = "Usage: capitalize_sdk [--http]" in
117 Arg.parse args (fun _ -> ()) usage_msg;
118
119 (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)
120 Printf.fprintf stderr "Starting CapitalizeServer...\n";
121 flush stderr;
122 Log.info "Starting CapitalizeServer...";
123
124 (* Configure the server with appropriate capabilities *)
125 ignore (configure_server server ());
126
127 (* Create and start MCP server with the selected transport *)
128 let mcp_server = create ~server ~transport:!transport_type () in
129 start mcp_server