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 =
45 capture_output (fun fmt -> 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 [ ("success", `Bool true); ("output", `String output) ]
51 else
52 `Assoc
53 [
54 ("success", `Bool false);
55 ("error", `String "Execution failed");
56 ("output", `String output);
57 ]
58 with e ->
59 (* Handle parsing or other errors with more detailed messages *)
60 let error_msg =
61 match e with
62 | Syntaxerr.Error err ->
63 let msg =
64 match err with
65 | Syntaxerr.Unclosed _ -> "Syntax error: Unclosed delimiter"
66 | Syntaxerr.Expecting _ ->
67 "Syntax error: Expecting a different token"
68 | Syntaxerr.Not_expecting _ -> "Syntax error: Unexpected token"
69 | Syntaxerr.Applicative_path _ ->
70 "Syntax error: Invalid applicative path"
71 | Syntaxerr.Variable_in_scope _ -> "Syntax error: Variable in scope"
72 | Syntaxerr.Other _ -> "Syntax error"
73 | _ -> "Syntax error (unknown kind)"
74 in
75 msg
76 | Lexer.Error (err, _) ->
77 let msg =
78 match err with
79 | Lexer.Illegal_character _ -> "Lexer error: Illegal character"
80 | Lexer.Illegal_escape _ -> "Lexer error: Illegal escape sequence"
81 | Lexer.Unterminated_comment _ ->
82 "Lexer error: Unterminated comment"
83 | Lexer.Unterminated_string -> "Lexer error: Unterminated string"
84 | Lexer.Unterminated_string_in_comment _ ->
85 "Lexer error: Unterminated string in comment"
86 | Lexer.Invalid_literal _ -> "Lexer error: Invalid literal"
87 | _ -> "Lexer error (unknown kind)"
88 in
89 msg
90 | _ -> Printexc.to_string e
91 in
92 `Assoc [ ("success", `Bool false); ("error", `String error_msg) ]
93
94(* Create evaluation server *)
95let server =
96 create_server ~name:"OCaml Evaluation Server" ~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
107 let _ = initialize_toploop () in
108 toplevel_initialized := true
109
110(* Register eval tool *)
111let _ =
112 add_tool server ~name:"ocaml_eval"
113 ~description:"Evaluates OCaml toplevel phrases and returns the result"
114 ~schema_properties:[ ("code", "string", "OCaml code to evaluate") ]
115 ~schema_required:[ "code" ]
116 (fun args ->
117 ensure_toploop_initialized ();
118
119 try
120 (* Extract code parameter *)
121 let code = get_string_param args "code" in
122
123 (* Execute the code *)
124 let result = evaluate_phrase code in
125
126 (* Return formatted result *)
127 let success =
128 match result with
129 | `Assoc fields -> (
130 match List.assoc_opt "success" fields with
131 | Some (`Bool true) -> true
132 | _ -> false)
133 | _ -> false
134 in
135
136 let output =
137 match result with
138 | `Assoc fields -> (
139 match List.assoc_opt "output" fields with
140 | Some (`String s) -> s
141 | _ -> (
142 match List.assoc_opt "error" fields with
143 | Some (`String s) -> s
144 | _ -> "Unknown result"))
145 | _ -> "Unknown result"
146 in
147
148 (* Create a tool result with colorized output *)
149 Tool.create_tool_result
150 [ Mcp.make_text_content output ]
151 ~is_error:(not success)
152 with Failure msg ->
153 Log.errorf "Error in OCaml eval tool: %s" msg;
154 Tool.create_tool_result
155 [ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]
156 ~is_error:true)
157
158(* Run the server with the default scheduler *)
159let () = Eio_main.run @@ fun env -> Mcp_server.run_server env server