Model Context Protocol in OCaml
anil.recoil.org
1open Mcp_sdk
2open Mcp_rpc
3
4(* Set up the formatter for capturing evaluation output *)
5let 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)
11
12(* Helper for extracting string value from JSON *)
13let get_string_param json name =
14 match json with
15 | `Assoc fields ->
16 (match List.assoc_opt name fields with
17 | Some (`String value) -> value
18 | _ -> failwith (Printf.sprintf "Missing or invalid parameter: %s" name))
19 | _ -> failwith "Expected JSON object"
20
21(* Initialize the OCaml toploop with standard libraries *)
22let initialize_toploop () =
23 (* Initialize the toplevel environment *)
24 Toploop.initialize_toplevel_env ();
25
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;
32
33 (* Return success message *)
34 "OCaml evaluation environment initialized"
35
36(* Evaluate an OCaml toplevel phrase *)
37let evaluate_phrase phrase =
38 (* Parse the input text as a toplevel phrase *)
39 let lexbuf = Lexing.from_string phrase in
40
41 (* Capture both success/failure status and output *)
42 try
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
46 ) in
47
48 (* Return structured result with status and captured output *)
49 if success then
50 `Assoc [
51 ("success", `Bool true);
52 ("output", `String output);
53 ]
54 else
55 `Assoc [
56 ("success", `Bool false);
57 ("error", `String "Execution failed");
58 ("output", `String output);
59 ]
60 with e ->
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)"
72 in
73 msg
74
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)"
84 in
85 msg
86 | _ -> Printexc.to_string e
87 in
88 `Assoc [
89 ("success", `Bool false);
90 ("error", `String error_msg);
91 ]
92
93(* Create evaluation server *)
94let server = create_server
95 ~name:"OCaml Evaluation Server"
96 ~version:"0.1.0" () |>
97 fun server ->
98 (* Set default capabilities *)
99 configure_server server ~with_tools:true ()
100
101(* Toplevel environment state management *)
102let toplevel_initialized = ref false
103
104(* Initialize OCaml toplevel on first use *)
105let ensure_toploop_initialized () =
106 if not !toplevel_initialized then begin
107 let _ = initialize_toploop () in
108 toplevel_initialized := true;
109 end
110
111(* Register eval tool *)
112let _ = add_tool server
113 ~name:"ocaml_eval"
114 ~description:"Evaluates OCaml toplevel phrases and returns the result"
115 ~schema_properties:[
116 ("code", "string", "OCaml code to evaluate")
117 ]
118 ~schema_required:["code"]
119 (fun args ->
120 ensure_toploop_initialized ();
121
122 try
123 (* Extract code parameter *)
124 let code = get_string_param args "code" in
125
126 (* Execute the code *)
127 let result = evaluate_phrase code in
128
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
134 | _ -> false
135 )
136 | _ -> false
137 in
138
139 let output = match result with
140 | `Assoc fields -> (
141 match List.assoc_opt "output" fields with
142 | Some (`String s) -> s
143 | _ -> (
144 match List.assoc_opt "error" fields with
145 | Some (`String s) -> s
146 | _ -> "Unknown result"
147 )
148 )
149 | _ -> "Unknown result"
150 in
151
152 (* Create a tool result with colorized output *)
153 Tool.create_tool_result [
154 Mcp.make_text_content output
155 ] ~is_error:(not success)
156
157 with
158 | Failure msg ->
159 Log.errorf "Error in OCaml eval tool: %s" msg;
160 Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true
161 )
162
163(* Run the server with the default scheduler *)
164let () =
165 Eio_main.run @@ fun env->
166 Mcp_server.run_server env server