···
5
-
(* Create a server *)
6
-
let server = create_server
7
-
~name:"OCaml MCP Structured API Demo"
8
-
~version:"0.1.0" () |>
10
-
(* Set default capabilities *)
11
-
configure_server server ~with_tools:true ~with_resources:true ~with_prompts:true ()
4
+
(* Set up the formatter for capturing evaluation output *)
5
+
let capture_output f =
6
+
let buffer = Buffer.create 1024 in
7
+
let fmt = Format.formatter_of_buffer buffer in
8
+
let result = f fmt in
9
+
Format.pp_print_flush fmt ();
10
+
(result, Buffer.contents buffer)
(* Helper for extracting string value from JSON *)
let get_string_param json name =
···
(match List.assoc_opt name fields with
| Some (`String value) -> value
19
-
| _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
20
-
| _ -> raise (Failure "Expected JSON object")
18
+
| _ -> failwith (Printf.sprintf "Missing or invalid parameter: %s" name))
19
+
| _ -> failwith "Expected JSON object"
21
+
(* Initialize the OCaml toploop with standard libraries *)
22
+
let initialize_toploop () =
23
+
(* Initialize the toplevel environment *)
24
+
Toploop.initialize_toplevel_env ();
26
+
(* Set up the toplevel as if using the standard OCaml REPL *)
27
+
Clflags.nopervasives := false;
28
+
Clflags.real_paths := true;
29
+
Clflags.recursive_types := false;
30
+
Clflags.strict_sequence := false;
31
+
Clflags.applicative_functors := true;
33
+
(* Return success message *)
34
+
"OCaml evaluation environment initialized"
22
-
(* Register a ping tool that demonstrates the typed API *)
36
+
(* Evaluate an OCaml toplevel phrase *)
37
+
let evaluate_phrase phrase =
38
+
(* Parse the input text as a toplevel phrase *)
39
+
let lexbuf = Lexing.from_string phrase in
41
+
(* Capture both success/failure status and output *)
43
+
let parsed_phrase = !Toploop.parse_toplevel_phrase lexbuf in
44
+
let (success, output) = capture_output (fun fmt ->
45
+
Toploop.execute_phrase true fmt parsed_phrase
48
+
(* Return structured result with status and captured output *)
51
+
("success", `Bool true);
52
+
("output", `String output);
56
+
("success", `Bool false);
57
+
("error", `String "Execution failed");
58
+
("output", `String output);
61
+
(* Handle parsing or other errors with more detailed messages *)
62
+
let error_msg = match e with
63
+
| Syntaxerr.Error err ->
64
+
let msg = match err with
65
+
| Syntaxerr.Unclosed _ -> "Syntax error: Unclosed delimiter"
66
+
| Syntaxerr.Expecting _ -> "Syntax error: Expecting a different token"
67
+
| Syntaxerr.Not_expecting _ -> "Syntax error: Unexpected token"
68
+
| Syntaxerr.Applicative_path _ -> "Syntax error: Invalid applicative path"
69
+
| Syntaxerr.Variable_in_scope _ -> "Syntax error: Variable in scope"
70
+
| Syntaxerr.Other _ -> "Syntax error"
71
+
| _ -> "Syntax error (unknown kind)"
75
+
| Lexer.Error (err, _) ->
76
+
let msg = match err with
77
+
| Lexer.Illegal_character _ -> "Lexer error: Illegal character"
78
+
| Lexer.Illegal_escape _ -> "Lexer error: Illegal escape sequence"
79
+
| Lexer.Unterminated_comment _ -> "Lexer error: Unterminated comment"
80
+
| Lexer.Unterminated_string -> "Lexer error: Unterminated string"
81
+
| Lexer.Unterminated_string_in_comment _ -> "Lexer error: Unterminated string in comment"
82
+
| Lexer.Invalid_literal _ -> "Lexer error: Invalid literal"
83
+
| _ -> "Lexer error (unknown kind)"
86
+
| _ -> Printexc.to_string e
89
+
("success", `Bool false);
90
+
("error", `String error_msg);
93
+
(* Create evaluation server *)
94
+
let server = create_server
95
+
~name:"OCaml Evaluation Server"
96
+
~version:"0.1.0" () |>
98
+
(* Set default capabilities *)
99
+
configure_server server ~with_tools:true ()
101
+
(* Toplevel environment state management *)
102
+
let toplevel_initialized = ref false
104
+
(* Initialize OCaml toplevel on first use *)
105
+
let ensure_toploop_initialized () =
106
+
if not !toplevel_initialized then begin
107
+
let _ = initialize_toploop () in
108
+
toplevel_initialized := true;
111
+
(* Register eval tool *)
25
-
~description:"A simple ping tool that demonstrates the structured API"
114
+
~description:"Evaluates OCaml toplevel phrases and returns the result"
27
-
("message", "string", "The message to echo back")
116
+
("code", "string", "OCaml code to evaluate")
29
-
~schema_required:["message"]
118
+
~schema_required:["code"]
120
+
ensure_toploop_initialized ();
32
-
let message = get_string_param args "message" in
33
-
(* Create a typed tool response using the new API *)
35
-
ToolsCall.ToolContent.Text (TextContent.{
36
-
text = Printf.sprintf "Pong: %s" message;
40
-
(* Convert to JSON for the response *)
41
-
ToolsCall.Response.yojson_of_t {
123
+
(* Extract code parameter *)
124
+
let code = get_string_param args "code" in
126
+
(* Execute the code *)
127
+
let result = evaluate_phrase code in
129
+
(* Return formatted result *)
130
+
let success = match result with
131
+
| `Assoc fields -> (
132
+
match List.assoc_opt "success" fields with
133
+
| Some (`Bool true) -> true
139
+
let output = match result with
140
+
| `Assoc fields -> (
141
+
match List.assoc_opt "output" fields with
142
+
| Some (`String s) -> s
144
+
match List.assoc_opt "error" fields with
145
+
| Some (`String s) -> s
146
+
| _ -> "Unknown result"
149
+
| _ -> "Unknown result"
152
+
(* Create a tool result with colorized output *)
153
+
create_tool_result [
154
+
Mcp.make_text_content output
155
+
] ~is_error:(not success)
47
-
Log.error (Printf.sprintf "Error in ping tool: %s" msg);
48
-
ToolsCall.Response.yojson_of_t {
50
-
ToolsCall.ToolContent.Text (TextContent.{
51
-
text = Printf.sprintf "Error: %s" msg;
159
+
Log.error (Printf.sprintf "Error in OCaml eval tool: %s" msg);
160
+
create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true
59
-
(* Register a timestamp resource that uses the typed API *)
60
-
let _ = add_resource server
61
-
~uri_template:"timestamp://{format}"
62
-
~description:"Get the current timestamp in the specified format"
63
-
~mime_type:"text/plain"
67
-
| [format] -> format
68
-
| _ -> "iso" (* default format *)
72
-
| "unix" -> string_of_float (Unix.time ())
74
-
let tm = Unix.gmtime (Unix.time ()) in
75
-
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
76
-
(tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
77
-
tm.tm_hour tm.tm_min tm.tm_sec
82
-
(* Register a structured prompt that uses the typed API *)
83
-
let _ = add_prompt server
85
-
~description:"A prompt to greet someone using the structured API"
87
-
("name", Some "The name of the person to greet", true);
88
-
("formal", Some "Whether to use formal greetings", false)
91
-
let name = try List.assoc "name" args with Not_found -> "friend" in
92
-
let formal = try List.assoc "formal" args = "true" with Not_found -> false in
96
-
Printf.sprintf "Greetings, %s. It's a pleasure to make your acquaintance." name
98
-
Printf.sprintf "Hey %s! Nice to meet you!" name
104
-
content = make_text_content "I'd like to meet someone new."
108
-
content = make_text_content greeting
112
-
content = make_text_content "What should I say next?"
117
-
(* Process a resources/list request using the typed API *)
118
-
let handle_resources_list_request request_id =
120
-
ResourcesList.Resource.{
121
-
uri = "timestamp://iso";
122
-
name = "ISO Timestamp";
123
-
description = Some "Current time in ISO format";
124
-
mime_type = Some "text/plain";
127
-
ResourcesList.Resource.{
128
-
uri = "timestamp://unix";
129
-
name = "Unix Timestamp";
130
-
description = Some "Current time as Unix epoch";
131
-
mime_type = Some "text/plain";
136
-
(* Create a typed response *)
137
-
ResourcesList.create_response ~id:request_id ~resources ()
139
-
(* Process a tools/list request using the typed API *)
140
-
let handle_tools_list_request request_id =
144
-
description = Some "A simple ping tool that demonstrates the structured API";
145
-
input_schema = `Assoc [
146
-
("type", `String "object");
147
-
("properties", `Assoc [
148
-
("message", `Assoc [
149
-
("type", `String "string");
150
-
("description", `String "The message to echo back")
153
-
("required", `List [`String "message"])
155
-
annotations = None;
159
-
(* Create a typed response *)
160
-
ToolsList.create_response ~id:request_id ~tools ()
162
-
(* Process a prompts/list request using the typed API *)
163
-
let handle_prompts_list_request request_id =
165
-
PromptsList.Prompt.{
167
-
description = Some "A prompt to greet someone using the structured API";
169
-
PromptsList.PromptArgument.{
171
-
description = Some "The name of the person to greet";
174
-
PromptsList.PromptArgument.{
176
-
description = Some "Whether to use formal greetings";
183
-
(* Create a typed response *)
184
-
PromptsList.create_response ~id:request_id ~prompts ()
186
-
(* Run the server *)
163
+
(* Run the server with the default scheduler *)
188
-
(* Example of creating a structured message directly - not actually used in the server *)
189
-
let example_structured_request =
190
-
ToolsCall.create_request
192
-
~arguments:(`Assoc [("message", `String "hello")])
197
-
(* Log the example request for demonstration *)
198
-
let json_str = Yojson.Safe.to_string (JSONRPCMessage.yojson_of_t example_structured_request) in
199
-
Log.info (Printf.sprintf "Example structured request: %s" json_str);
201
-
(* Run the server with the default scheduler *)
Eio_main.run @@ fun env->
Mcp_server.run_server env server
anil.recoil.org