Model Context Protocol in OCaml
anil.recoil.org
1open Mcp_sdk
2
3(* Set up the formatter for capturing evaluation output *)
4let capture_output f =
5 let buffer = Buffer.create 1024 in
6 let fmt = Format.formatter_of_buffer buffer in
7 let result = f fmt in
8 Format.pp_print_flush fmt ();
9 (result, Buffer.contents buffer)
10
11(* Helper for extracting string value from JSON *)
12let get_string_param json name =
13 match json with
14 | `Assoc fields ->
15 (match List.assoc_opt name fields with
16 | Some (`String value) -> value
17 | _ -> failwith (Printf.sprintf "Missing or invalid parameter: %s" name))
18 | _ -> failwith "Expected JSON object"
19
20(* Initialize the OCaml toploop with standard libraries *)
21let initialize_toploop () =
22 (* Initialize the toplevel environment *)
23 Toploop.initialize_toplevel_env ();
24
25 (* Set up the toplevel as if using the standard OCaml REPL *)
26 Clflags.nopervasives := false;
27 Clflags.real_paths := true;
28 Clflags.recursive_types := false;
29 Clflags.strict_sequence := false;
30 Clflags.applicative_functors := true;
31
32 (* Return success message *)
33 "OCaml evaluation environment initialized"
34
35(* Evaluate an OCaml toplevel phrase *)
36let evaluate_phrase phrase =
37 (* Parse the input text as a toplevel phrase *)
38 let lexbuf = Lexing.from_string phrase in
39
40 (* Capture both success/failure status and output *)
41 try
42 let parsed_phrase = !Toploop.parse_toplevel_phrase lexbuf in
43 let (success, output) = capture_output (fun fmt ->
44 Toploop.execute_phrase true fmt parsed_phrase
45 ) in
46
47 (* Return structured result with status and captured output *)
48 if success then
49 `Assoc [
50 ("success", `Bool true);
51 ("output", `String output);
52 ]
53 else
54 `Assoc [
55 ("success", `Bool false);
56 ("error", `String "Execution failed");
57 ("output", `String output);
58 ]
59 with e ->
60 (* Handle parsing or other errors with more detailed messages *)
61 let error_msg = match e with
62 | Syntaxerr.Error err ->
63 let msg = match err with
64 | Syntaxerr.Unclosed _ -> "Syntax error: Unclosed delimiter"
65 | Syntaxerr.Expecting _ -> "Syntax error: Expecting a different token"
66 | Syntaxerr.Not_expecting _ -> "Syntax error: Unexpected token"
67 | Syntaxerr.Applicative_path _ -> "Syntax error: Invalid applicative path"
68 | Syntaxerr.Variable_in_scope _ -> "Syntax error: Variable in scope"
69 | Syntaxerr.Other _ -> "Syntax error"
70 | _ -> "Syntax error (unknown kind)"
71 in
72 msg
73
74 | Lexer.Error (err, _) ->
75 let msg = match err with
76 | Lexer.Illegal_character _ -> "Lexer error: Illegal character"
77 | Lexer.Illegal_escape _ -> "Lexer error: Illegal escape sequence"
78 | Lexer.Unterminated_comment _ -> "Lexer error: Unterminated comment"
79 | Lexer.Unterminated_string -> "Lexer error: Unterminated string"
80 | Lexer.Unterminated_string_in_comment _ -> "Lexer error: Unterminated string in comment"
81 | Lexer.Invalid_literal _ -> "Lexer error: Invalid literal"
82 | _ -> "Lexer error (unknown kind)"
83 in
84 msg
85 | _ -> Printexc.to_string e
86 in
87 `Assoc [
88 ("success", `Bool false);
89 ("error", `String error_msg);
90 ]
91
92(* Create evaluation server *)
93let server = create_server
94 ~name:"OCaml Evaluation Server"
95 ~version:"0.1.0" () |>
96 fun server ->
97 (* Set default capabilities *)
98 configure_server server ~with_tools:true ()
99
100(* Toplevel environment state management *)
101let toplevel_initialized = ref false
102
103(* Initialize OCaml toplevel on first use *)
104let ensure_toploop_initialized () =
105 if not !toplevel_initialized then begin
106 let _ = initialize_toploop () in
107 toplevel_initialized := true;
108 end
109
110(* Register eval tool *)
111let _ = add_tool server
112 ~name:"ocaml_eval"
113 ~description:"Evaluates OCaml toplevel phrases and returns the result"
114 ~schema_properties:[
115 ("code", "string", "OCaml code to evaluate")
116 ]
117 ~schema_required:["code"]
118 (fun args ->
119 ensure_toploop_initialized ();
120
121 try
122 (* Extract code parameter *)
123 let code = get_string_param args "code" in
124
125 (* Execute the code *)
126 let result = evaluate_phrase code in
127
128 (* Return formatted result *)
129 let success = match result with
130 | `Assoc fields -> (
131 match List.assoc_opt "success" fields with
132 | Some (`Bool true) -> true
133 | _ -> false
134 )
135 | _ -> false
136 in
137
138 let output = match result with
139 | `Assoc fields -> (
140 match List.assoc_opt "output" fields with
141 | Some (`String s) -> s
142 | _ -> (
143 match List.assoc_opt "error" fields with
144 | Some (`String s) -> s
145 | _ -> "Unknown result"
146 )
147 )
148 | _ -> "Unknown result"
149 in
150
151 (* Create a tool result with colorized output *)
152 create_tool_result [
153 TextContent output
154 ] ~is_error:(not success)
155
156 with
157 | Failure msg ->
158 Log.error (Printf.sprintf "Error in OCaml eval tool: %s" msg);
159 create_tool_result [TextContent (Printf.sprintf "Error: %s" msg)] ~is_error:true
160 )
161
162(* Run the server with the default scheduler *)
163let () =
164 Eio_main.run @@ fun env->
165 Mcp_server.run_server env server