this repo has no description
more
+223
+3
claudeio/examples/dune
+3
claudeio/examples/dune
+220
claudeio/examples/mcp_server_example.ml
+220
claudeio/examples/mcp_server_example.ml
···
1
+
(** Example MCP server using the Server_session API.
2
+
3
+
This example demonstrates how to create a simple MCP server that provides:
4
+
- A few example tools (add, echo)
5
+
- A simple resource (example://greeting)
6
+
- Basic ping support
7
+
8
+
Note: This is a template/demonstration. A real MCP server would typically:
9
+
1. Read JSON-RPC messages from stdin
10
+
2. Write JSON-RPC responses to stdout
11
+
3. Use proper error handling and logging
12
+
13
+
To use this as a real server, you would need to:
14
+
- Create a custom Transport that reads/writes to stdio
15
+
- Handle process lifecycle properly
16
+
- Add comprehensive error handling
17
+
*)
18
+
19
+
open Mcp
20
+
21
+
(* Helper to find field in Jsont.Object *)
22
+
let find_field name fields =
23
+
List.find_map (fun ((n, _), value) ->
24
+
if n = name then Some value else None
25
+
) fields
26
+
27
+
(* Example tool: Add two numbers *)
28
+
let handle_add_tool ~name:_ ~arguments =
29
+
let open Messages.Tools in
30
+
match arguments with
31
+
| Some (Jsont.Object (fields, _)) ->
32
+
let a = match find_field "a" fields with
33
+
| Some (Jsont.Number (n, _)) -> n
34
+
| _ -> 0.0
35
+
in
36
+
let b = match find_field "b" fields with
37
+
| Some (Jsont.Number (n, _)) -> n
38
+
| _ -> 0.0
39
+
in
40
+
let result = a +. b in
41
+
let content = [
42
+
Content.text (Printf.sprintf "Result: %.2f" result)
43
+
] in
44
+
make_call_result ~content ()
45
+
| _ ->
46
+
make_call_result
47
+
~content:[Content.text "Invalid arguments"]
48
+
~is_error:true
49
+
()
50
+
51
+
(* Example tool: Echo a message *)
52
+
let handle_echo_tool ~name:_ ~arguments =
53
+
let open Messages.Tools in
54
+
match arguments with
55
+
| Some (Jsont.Object (fields, _)) ->
56
+
(match find_field "message" fields with
57
+
| Some (Jsont.String (msg, _)) ->
58
+
let content = [Content.text msg] in
59
+
make_call_result ~content ()
60
+
| _ ->
61
+
make_call_result
62
+
~content:[Content.text "No message provided"]
63
+
~is_error:true
64
+
())
65
+
| _ ->
66
+
make_call_result
67
+
~content:[Content.text "Invalid arguments"]
68
+
~is_error:true
69
+
()
70
+
71
+
(* Tool dispatcher *)
72
+
let call_tool ~name ~arguments =
73
+
match name with
74
+
| "add" -> handle_add_tool ~name ~arguments
75
+
| "echo" -> handle_echo_tool ~name ~arguments
76
+
| _ ->
77
+
Messages.Tools.make_call_result
78
+
~content:[Content.text (Printf.sprintf "Unknown tool: %s" name)]
79
+
~is_error:true
80
+
()
81
+
82
+
(* List available tools *)
83
+
let list_tools ~cursor:_ =
84
+
let open Messages.Tools in
85
+
let meta = Jsont.Meta.none in
86
+
let tools = [
87
+
make_tool
88
+
~name:"add"
89
+
~description:"Add two numbers together"
90
+
~input_schema:(Jsont.Object ([
91
+
(("type", meta), Jsont.String ("object", meta));
92
+
(("properties", meta), Jsont.Object ([
93
+
(("a", meta), Jsont.Object ([(("type", meta), Jsont.String ("number", meta))], meta));
94
+
(("b", meta), Jsont.Object ([(("type", meta), Jsont.String ("number", meta))], meta));
95
+
], meta));
96
+
(("required", meta), Jsont.Array ([Jsont.String ("a", meta); Jsont.String ("b", meta)], meta));
97
+
], meta))
98
+
();
99
+
make_tool
100
+
~name:"echo"
101
+
~description:"Echo a message back"
102
+
~input_schema:(Jsont.Object ([
103
+
(("type", meta), Jsont.String ("object", meta));
104
+
(("properties", meta), Jsont.Object ([
105
+
(("message", meta), Jsont.Object ([(("type", meta), Jsont.String ("string", meta))], meta));
106
+
], meta));
107
+
(("required", meta), Jsont.Array ([Jsont.String ("message", meta)], meta));
108
+
], meta))
109
+
();
110
+
] in
111
+
make_list_result ~tools ()
112
+
113
+
(* Example resource *)
114
+
let read_resource ~uri =
115
+
let open Messages.Resources in
116
+
match uri with
117
+
| "example://greeting" ->
118
+
let contents = [
119
+
make_text_contents
120
+
~uri
121
+
~text:"Hello from the MCP server!"
122
+
~mime_type:"text/plain"
123
+
()
124
+
] in
125
+
make_read_result ~contents
126
+
| _ ->
127
+
failwith (Printf.sprintf "Unknown resource: %s" uri)
128
+
129
+
let list_resources ~cursor:_ =
130
+
let open Messages.Resources in
131
+
let resources = [
132
+
make_resource
133
+
~uri:"example://greeting"
134
+
~name:"Greeting"
135
+
~description:"A simple greeting message"
136
+
~mime_type:"text/plain"
137
+
()
138
+
] in
139
+
make_list_result ~resources ()
140
+
141
+
(* Ping handler *)
142
+
let ping () = ()
143
+
144
+
(* Main server function *)
145
+
let run_server env =
146
+
let open Eio in
147
+
148
+
Switch.run @@ fun sw ->
149
+
(* Create stdio transport for the server *)
150
+
(* Note: For a real server, you would typically use a transport that
151
+
reads from stdin and writes to stdout. Here we create a simple
152
+
in-process transport for demonstration. *)
153
+
let params = {
154
+
Transport_stdio.command = "cat"; (* Echo back for demo *)
155
+
args = [];
156
+
env = None;
157
+
max_buffer_size = None;
158
+
} in
159
+
let transport = Transport_stdio.create
160
+
~sw
161
+
~process_mgr:(Eio.Stdenv.process_mgr env)
162
+
params
163
+
in
164
+
165
+
(* Configure server *)
166
+
let config = {
167
+
Server_session.server_info = Capabilities.Implementation.make
168
+
~name:"example-mcp-server"
169
+
~version:"1.0.0";
170
+
server_capabilities = Capabilities.Server.make
171
+
~tools:(Capabilities.Tools.make ())
172
+
~resources:(Capabilities.Resources.make ())
173
+
()
174
+
;
175
+
instructions = Some "Example MCP server with basic tools and resources";
176
+
} in
177
+
178
+
(* Set up handlers *)
179
+
let handlers = {
180
+
Server_session.list_resources = Some list_resources;
181
+
list_resource_templates = None;
182
+
read_resource = Some read_resource;
183
+
subscribe_resource = None;
184
+
unsubscribe_resource = None;
185
+
list_tools = Some list_tools;
186
+
call_tool = Some call_tool;
187
+
list_prompts = None;
188
+
get_prompt = None;
189
+
complete = None;
190
+
ping = Some ping;
191
+
} in
192
+
193
+
(* Create and run server *)
194
+
let server = Server_session.create
195
+
~sw
196
+
~transport
197
+
config
198
+
handlers
199
+
in
200
+
201
+
(* Log server startup *)
202
+
let client_info = Server_session.client_info server in
203
+
Eio.traceln "MCP server started, connected to client: %s v%s"
204
+
client_info.Capabilities.Implementation.name
205
+
client_info.Capabilities.Implementation.version;
206
+
207
+
(* The server runs in the background via the Session's receive loop *)
208
+
(* The switch will keep the server alive until it's explicitly closed or an error occurs *)
209
+
(* For this example, we just let it run until the process is terminated *)
210
+
()
211
+
(* Note: In a real server, you would wait for some termination signal or condition *)
212
+
213
+
let () =
214
+
Eio_main.run @@ fun env ->
215
+
try
216
+
run_server env
217
+
with
218
+
| exn ->
219
+
Printf.eprintf "Server error: %s\n%!" (Printexc.to_string exn);
220
+
exit 1