commit f7779488c470c4df41cb2d66a67a19e72dfb999e · anil.recoil.org/ocaml-mcp

+1 -1

bin/capitalize_sdk.ml

···

       37
        
             }

     

       38
        
           with

     

       39
        
           | Failure msg ->

     

       40
       -
             Log.error (Printf.sprintf "Error in capitalize tool: %s" msg);

     

       41
        
             TextContent.yojson_of_t TextContent.{

     

       42
        
               text = Printf.sprintf "Error: %s" msg;

     

       43
        
               annotations = None

···

       37
        
             }

     

       38
        
           with

     

       39
        
           | Failure msg ->

     

       40
       +
             Log.errorf "Error in capitalize tool: %s" msg;

     

       41
        
             TextContent.yojson_of_t TextContent.{

     

       42
        
               text = Printf.sprintf "Error: %s" msg;

     

       43
        
               annotations = None

+3 -3

bin/multimodal_sdk.ml

···

       269
        
             ] ~is_error:false

     

       270
        
           with

     

       271
        
           | Failure msg -> 

     

       272
       -
             Log.error (Printf.sprintf "Error in multimodal tool: %s" msg);

     

       273
        
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       274
        
         )

     

       275
        
       

     
···

       298
        
                 ~is_error:false

     

       299
        
           with

     

       300
        
           | Failure msg ->

     

       301
       -
             Log.error (Printf.sprintf "Error in generate_image tool: %s" msg);

     

       302
        
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       303
        
         )

     

       304
        
       

     
···

       331
        
                 ~is_error:false

     

       332
        
           with

     

       333
        
           | Failure msg ->

     

       334
       -
             Log.error (Printf.sprintf "Error in generate_audio tool: %s" msg);

     

       335
        
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       336
        
         )

     

       337

···

       269
        
             ] ~is_error:false

     

       270
        
           with

     

       271
        
           | Failure msg -> 

     

       272
       +
             Log.errorf "Error in multimodal tool: %s" msg;

     

       273
        
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       274
        
         )

     

       275
        
       

     
···

       298
        
                 ~is_error:false

     

       299
        
           with

     

       300
        
           | Failure msg ->

     

       301
       +
             Log.errorf "Error in generate_image tool: %s" msg;

     

       302
        
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       303
        
         )

     

       304
        
       

     
···

       331
        
                 ~is_error:false

     

       332
        
           with

     

       333
        
           | Failure msg ->

     

       334
       +
             Log.errorf "Error in generate_audio tool: %s" msg;

     

       335
        
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       336
        
         )

     

       337

+1 -1

bin/ocaml_eval_sdk.ml

···

       156
        
             

     

       157
        
           with

     

       158
        
           | Failure msg ->

     

       159
       -
             Log.error (Printf.sprintf "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

···

       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

+17 -10

lib/mcp_sdk.ml

···

       14
        
           | Warning -> "WARNING"

     

       15
        
           | Error -> "ERROR"

     

       16
        
       

     

       17
       -
         let log level msg =

     

       18
       -
           Printf.eprintf "[%s] %s\n" (string_of_level level) msg;

     

       19
       -
           flush stderr

     

       20
        
       

     

       21
       -
         let debug = log Debug

     

       22
       -
         let info = log Info

     

       23
       -
         let warning = log Warning

     

       24
       -
         let error = log Error

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       25
        
       end

     

       26
        
       

     

       27
        
       (* Context for tools and resources *)

     
···

       88
        
         

     

       89
        
         (* Handle tool execution errors *)

     

       90
        
         let handle_execution_error err =

     

       91
       -
           Log.error (Printf.sprintf "Tool execution failed: %s" err);

     

       92
        
           create_error_result (Printf.sprintf "Error executing tool: %s" err)

     

       93
        
         

     

       94
        
         (* Handle unknown tool error *)

     

       95
        
         let handle_unknown_tool_error name =

     

       96
       -
           Log.error (Printf.sprintf "Unknown tool: %s" name);

     

       97
        
           create_error_result (Printf.sprintf "Unknown tool: %s" name)

     

       98
        
         

     

       99
        
         (* Handle general tool execution exception *)

     

       100
        
         let handle_execution_exception exn =

     

       101
       -
           Log.error (Printf.sprintf "Exception executing tool: %s" (Printexc.to_string exn));

     

       102
        
           create_error_result (Printf.sprintf "Internal error: %s" (Printexc.to_string exn))

     

       103
        
       end

     

       104

···

       14
        
           | Warning -> "WARNING"

     

       15
        
           | Error -> "ERROR"

     

       16
        
       

     

       17
       +
         let logf level fmt =

     

       18
       +
           Printf.fprintf stderr "[%s] " (string_of_level level);

     

       19
       +
           Printf.kfprintf (fun oc -> Printf.fprintf oc "\n"; flush oc) stderr fmt

     

       20
        
       

     

       21
       +
         let debugf fmt = logf Debug fmt

     

       22
       +
         let infof fmt = logf Info fmt

     

       23
       +
         let warningf fmt = logf Warning fmt

     

       24
       +
         let errorf fmt = logf Error fmt

     

       25
       +
         

     

       26
       +
         (* Backward compatibility functions that take a simple string *)

     

       27
       +
         let log level msg = logf level "%s" msg

     

       28
       +
         let debug msg = debugf "%s" msg

     

       29
       +
         let info msg = infof "%s" msg

     

       30
       +
         let warning msg = warningf "%s" msg

     

       31
       +
         let error msg = errorf "%s" msg

     

       32
        
       end

     

       33
        
       

     

       34
        
       (* Context for tools and resources *)

     
···

       95
        
         

     

       96
        
         (* Handle tool execution errors *)

     

       97
        
         let handle_execution_error err =

     

       98
       +
           Log.errorf "Tool execution failed: %s" err;

     

       99
        
           create_error_result (Printf.sprintf "Error executing tool: %s" err)

     

       100
        
         

     

       101
        
         (* Handle unknown tool error *)

     

       102
        
         let handle_unknown_tool_error name =

     

       103
       +
           Log.errorf "Unknown tool: %s" name;

     

       104
        
           create_error_result (Printf.sprintf "Unknown tool: %s" name)

     

       105
        
         

     

       106
        
         (* Handle general tool execution exception *)

     

       107
        
         let handle_execution_exception exn =

     

       108
       +
           Log.errorf "Exception executing tool: %s" (Printexc.to_string exn);

     

       109
        
           create_error_result (Printf.sprintf "Internal error: %s" (Printexc.to_string exn))

     

       110
        
       end

     

       111

lib/mcp_sdk.mli

···

       12
        
       

     

       13
        
         val string_of_level : level -> string

     

       14
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       15
        
         val log : level -> string -> unit

     

       16
        
         val debug : string -> unit

     

       17
        
         val info : string -> unit

···

       12
        
       

     

       13
        
         val string_of_level : level -> string

     

       14
        
       

     

       15
       +
         (** Format-string based logging functions *)

     

       16
       +
         val logf : level -> ('a, out_channel, unit) format -> 'a

     

       17
       +
         val debugf : ('a, out_channel, unit) format -> 'a

     

       18
       +
         val infof : ('a, out_channel, unit) format -> 'a

     

       19
       +
         val warningf : ('a, out_channel, unit) format -> 'a

     

       20
       +
         val errorf : ('a, out_channel, unit) format -> 'a

     

       21
       +
       

     

       22
       +
         (** Simple string logging functions (for backward compatibility) *)

     

       23
        
         val log : level -> string -> unit

     

       24
        
         val debug : string -> unit

     

       25
        
         val info : string -> unit

+26 -26

lib/mcp_server.ml

···

       8
        
         let result = match req.JSONRPCMessage.params with

     

       9
        
           | Some params -> 

     

       10
        
               let req_data = Initialize.Request.t_of_yojson params in

     

       11
       -
               Log.debug (Printf.sprintf "Client info: %s v%s" 

     

       12
       -
                 req_data.client_info.name req_data.client_info.version);

     

       13
       -
               Log.debug (Printf.sprintf "Client protocol version: %s" req_data.protocol_version);

     

       14
        
               

     

       15
        
               (* Create initialize response *)

     

       16
        
               let result = Initialize.Result.create

     
···

       55
        
       let extract_tool_name params =

     

       56
        
         match List.assoc_opt "name" params with

     

       57
        
           | Some (`String name) -> 

     

       58
       -
               Log.debug (Printf.sprintf "Tool name: %s" name);

     

       59
        
               Some name

     

       60
        
           | _ -> 

     

       61
        
               Log.error "Missing or invalid 'name' parameter in tool call";

     
···

       65
        
       let extract_tool_arguments params =

     

       66
        
         match List.assoc_opt "arguments" params with

     

       67
        
           | Some (args) -> 

     

       68
       -
               Log.debug (Printf.sprintf "Tool arguments: %s" (Yojson.Safe.to_string args));

     

       69
        
               args

     

       70
        
           | _ -> 

     

       71
        
               Log.debug "No arguments provided for tool call, using empty object";

     
···

       85
        
       let execute_tool server ctx name args =

     

       86
        
         try

     

       87
        
           let tool = List.find (fun t -> t.Tool.name = name) (tools server) in

     

       88
       -
           Log.debug (Printf.sprintf "Found tool: %s" name);

     

       89
        
           

     

       90
        
           (* Call the tool handler *)

     

       91
        
           match tool.handler ctx args with

     
···

       132
        
       (* Handle notifications/initialized *)

     

       133
        
       let handle_initialized (notif:JSONRPCMessage.notification) =

     

       134
        
         Log.debug "Client initialization complete - Server is now ready to receive requests";

     

       135
       -
         Log.debug (Printf.sprintf "Notification params: %s" 

     

       136
        
           (match notif.JSONRPCMessage.params with

     

       137
        
             | Some p -> Yojson.Safe.to_string p

     

       138
       -
             | None -> "null"));

     

       139
        
         None

     

       140
        
       

     

       141
        
       (* Process a single message using the MCP SDK *)

     

       142
        
       let process_message server message =

     

       143
        
         try

     

       144
       -
           Log.debug (Printf.sprintf "Processing message: %s" (Yojson.Safe.to_string message));

     

       145
        
           match JSONRPCMessage.t_of_yojson message with

     

       146
        
           | JSONRPCMessage.Request req ->

     

       147
       -
             Log.debug (Printf.sprintf "Received request with method: %s" (Method.to_string req.meth));

     

       148
        
             (match req.meth with

     

       149
        
              | Method.Initialize -> handle_initialize server req

     

       150
        
              | Method.ToolsList -> handle_tools_list server req

     
···

       152
        
              | Method.PromptsList -> handle_prompts_list server req

     

       153
        
              | Method.ResourcesList -> handle_resources_list server req

     

       154
        
              | _ -> 

     

       155
       -
                 Log.error (Printf.sprintf "Unknown method received: %s" (Method.to_string req.meth));

     

       156
        
                 Some (create_jsonrpc_error req.id MethodNotFound ("Method not found: " ^ (Method.to_string req.meth)) ()))

     

       157
        
           | JSONRPCMessage.Notification notif ->

     

       158
       -
             Log.debug (Printf.sprintf "Received notification with method: %s" (Method.to_string notif.meth));

     

       159
        
             (match notif.meth with

     

       160
        
              | Method.Initialized -> handle_initialized notif

     

       161
        
              | _ ->

     

       162
       -
                 Log.debug (Printf.sprintf "Ignoring notification: %s" (Method.to_string notif.meth));

     

       163
        
                 None)

     

       164
        
           | JSONRPCMessage.Response _ ->

     

       165
        
             Log.error "Unexpected response message received";

     
···

       169
        
             None

     

       170
        
         with

     

       171
        
         | Json.Of_json (msg, _) ->

     

       172
       -
           Log.error (Printf.sprintf "JSON error: %s" msg);

     

       173
        
           (* Can't respond with error because we don't have a request ID *)

     

       174
        
           None

     

       175
        
         | Yojson.Json_error msg -> 

     

       176
       -
           Log.error (Printf.sprintf "JSON parse error: %s" msg);

     

       177
        
           (* Can't respond with error because we don't have a request ID *)

     

       178
        
           None

     

       179
        
         | exc ->

     

       180
       -
           Log.error (Printf.sprintf "Exception during message processing: %s" (Printexc.to_string exc));

     

       181
       -
           Log.error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       182
       -
           Log.error (Printf.sprintf "Message was: %s" (Yojson.Safe.to_string message));

     

       183
        
           None

     

       184
        
       

     

       185
        
       (* Extract a request ID from a potentially malformed message *)

     
···

       200
        
           Log.debug "Empty line received, ignoring";

     

       201
        
           None

     

       202
        
         ) else (

     

       203
       -
           Log.debug (Printf.sprintf "Raw input: %s" line);

     

       204
        
           try

     

       205
        
             let json = Yojson.Safe.from_string line in

     

       206
        
             Log.debug "Successfully parsed JSON";

     
···

       209
        
             process_message server json

     

       210
        
           with

     

       211
        
           | Yojson.Json_error msg -> begin

     

       212
       -
               Log.error (Printf.sprintf "Error parsing JSON: %s" msg);

     

       213
       -
               Log.error (Printf.sprintf "Input was: %s" line);

     

       214
        
               None

     

       215
        
           end

     

       216
        
         )

     
···

       219
        
       let send_response stdout response =

     

       220
        
         let response_json = JSONRPCMessage.yojson_of_t response in

     

       221
        
         let response_str = Yojson.Safe.to_string response_json in

     

       222
       -
         Log.debug (Printf.sprintf "Sending response: %s" response_str);

     

       223
        
         

     

       224
        
         (* Write the response followed by a newline *)

     

       225
        
         Eio.Flow.copy_string response_str stdout;

     
···

       230
        
         let stdin = Eio.Stdenv.stdin env in

     

       231
        
         let stdout = Eio.Stdenv.stdout env in

     

       232
        
       

     

       233
       -
         Log.debug (Printf.sprintf "Starting MCP server: %s v%s" (name server) (version server));

     

       234
       -
         Log.debug (Printf.sprintf "Protocol version: %s" (protocol_version server));

     

       235
        
       

     

       236
        
         (* Enable exception backtraces *)

     

       237
        
         Printexc.record_backtrace true;

     
···

       254
        
             Log.debug "End of file received on stdin";

     

       255
        
             ()

     

       256
        
         | Eio.Exn.Io _ as exn ->

     

       257
       -
             Log.error (Printf.sprintf "I/O error while reading: %s" (Printexc.to_string exn));

     

       258
        
             ()

     

       259
        
         | exn ->

     

       260
       -
             Log.error (Printf.sprintf "Exception while reading: %s" (Printexc.to_string exn));

     

       261
        
             ()

···

       8
        
         let result = match req.JSONRPCMessage.params with

     

       9
        
           | Some params -> 

     

       10
        
               let req_data = Initialize.Request.t_of_yojson params in

     

       11
       +
               Log.debugf "Client info: %s v%s" 

     

       12
       +
                 req_data.client_info.name req_data.client_info.version;

     

       13
       +
               Log.debugf "Client protocol version: %s" req_data.protocol_version;

     

       14
        
               

     

       15
        
               (* Create initialize response *)

     

       16
        
               let result = Initialize.Result.create

     
···

       55
        
       let extract_tool_name params =

     

       56
        
         match List.assoc_opt "name" params with

     

       57
        
           | Some (`String name) -> 

     

       58
       +
               Log.debugf "Tool name: %s" name;

     

       59
        
               Some name

     

       60
        
           | _ -> 

     

       61
        
               Log.error "Missing or invalid 'name' parameter in tool call";

     
···

       65
        
       let extract_tool_arguments params =

     

       66
        
         match List.assoc_opt "arguments" params with

     

       67
        
           | Some (args) -> 

     

       68
       +
               Log.debugf "Tool arguments: %s" (Yojson.Safe.to_string args);

     

       69
        
               args

     

       70
        
           | _ -> 

     

       71
        
               Log.debug "No arguments provided for tool call, using empty object";

     
···

       85
        
       let execute_tool server ctx name args =

     

       86
        
         try

     

       87
        
           let tool = List.find (fun t -> t.Tool.name = name) (tools server) in

     

       88
       +
           Log.debugf "Found tool: %s" name;

     

       89
        
           

     

       90
        
           (* Call the tool handler *)

     

       91
        
           match tool.handler ctx args with

     
···

       132
        
       (* Handle notifications/initialized *)

     

       133
        
       let handle_initialized (notif:JSONRPCMessage.notification) =

     

       134
        
         Log.debug "Client initialization complete - Server is now ready to receive requests";

     

       135
       +
         Log.debugf "Notification params: %s" 

     

       136
        
           (match notif.JSONRPCMessage.params with

     

       137
        
             | Some p -> Yojson.Safe.to_string p

     

       138
       +
             | None -> "null");

     

       139
        
         None

     

       140
        
       

     

       141
        
       (* Process a single message using the MCP SDK *)

     

       142
        
       let process_message server message =

     

       143
        
         try

     

       144
       +
           Log.debugf "Processing message: %s" (Yojson.Safe.to_string message);

     

       145
        
           match JSONRPCMessage.t_of_yojson message with

     

       146
        
           | JSONRPCMessage.Request req ->

     

       147
       +
             Log.debugf "Received request with method: %s" (Method.to_string req.meth);

     

       148
        
             (match req.meth with

     

       149
        
              | Method.Initialize -> handle_initialize server req

     

       150
        
              | Method.ToolsList -> handle_tools_list server req

     
···

       152
        
              | Method.PromptsList -> handle_prompts_list server req

     

       153
        
              | Method.ResourcesList -> handle_resources_list server req

     

       154
        
              | _ -> 

     

       155
       +
                 Log.errorf "Unknown method received: %s" (Method.to_string req.meth);

     

       156
        
                 Some (create_jsonrpc_error req.id MethodNotFound ("Method not found: " ^ (Method.to_string req.meth)) ()))

     

       157
        
           | JSONRPCMessage.Notification notif ->

     

       158
       +
             Log.debugf "Received notification with method: %s" (Method.to_string notif.meth);

     

       159
        
             (match notif.meth with

     

       160
        
              | Method.Initialized -> handle_initialized notif

     

       161
        
              | _ ->

     

       162
       +
                 Log.debugf "Ignoring notification: %s" (Method.to_string notif.meth);

     

       163
        
                 None)

     

       164
        
           | JSONRPCMessage.Response _ ->

     

       165
        
             Log.error "Unexpected response message received";

     
···

       169
        
             None

     

       170
        
         with

     

       171
        
         | Json.Of_json (msg, _) ->

     

       172
       +
           Log.errorf "JSON error: %s" msg;

     

       173
        
           (* Can't respond with error because we don't have a request ID *)

     

       174
        
           None

     

       175
        
         | Yojson.Json_error msg -> 

     

       176
       +
           Log.errorf "JSON parse error: %s" msg;

     

       177
        
           (* Can't respond with error because we don't have a request ID *)

     

       178
        
           None

     

       179
        
         | exc ->

     

       180
       +
           Log.errorf "Exception during message processing: %s" (Printexc.to_string exc);

     

       181
       +
           Log.errorf "Backtrace: %s" (Printexc.get_backtrace());

     

       182
       +
           Log.errorf "Message was: %s" (Yojson.Safe.to_string message);

     

       183
        
           None

     

       184
        
       

     

       185
        
       (* Extract a request ID from a potentially malformed message *)

     
···

       200
        
           Log.debug "Empty line received, ignoring";

     

       201
        
           None

     

       202
        
         ) else (

     

       203
       +
           Log.debugf "Raw input: %s" line;

     

       204
        
           try

     

       205
        
             let json = Yojson.Safe.from_string line in

     

       206
        
             Log.debug "Successfully parsed JSON";

     
···

       209
        
             process_message server json

     

       210
        
           with

     

       211
        
           | Yojson.Json_error msg -> begin

     

       212
       +
               Log.errorf "Error parsing JSON: %s" msg;

     

       213
       +
               Log.errorf "Input was: %s" line;

     

       214
        
               None

     

       215
        
           end

     

       216
        
         )

     
···

       219
        
       let send_response stdout response =

     

       220
        
         let response_json = JSONRPCMessage.yojson_of_t response in

     

       221
        
         let response_str = Yojson.Safe.to_string response_json in

     

       222
       +
         Log.debugf "Sending response: %s" response_str;

     

       223
        
         

     

       224
        
         (* Write the response followed by a newline *)

     

       225
        
         Eio.Flow.copy_string response_str stdout;

     
···

       230
        
         let stdin = Eio.Stdenv.stdin env in

     

       231
        
         let stdout = Eio.Stdenv.stdout env in

     

       232
        
       

     

       233
       +
         Log.debugf "Starting MCP server: %s v%s" (name server) (version server);

     

       234
       +
         Log.debugf "Protocol version: %s" (protocol_version server);

     

       235
        
       

     

       236
        
         (* Enable exception backtraces *)

     

       237
        
         Printexc.record_backtrace true;

     
···

       254
        
             Log.debug "End of file received on stdin";

     

       255
        
             ()

     

       256
        
         | Eio.Exn.Io _ as exn ->

     

       257
       +
             Log.errorf "I/O error while reading: %s" (Printexc.to_string exn);

     

       258
        
             ()

     

       259
        
         | exn ->

     

       260
       +
             Log.errorf "Exception while reading: %s" (Printexc.to_string exn);

     

       261
        
             ()