Model Context Protocol in OCaml

Add example servers to demonstrate MCP features

- audio_example.ml: Demonstrates audio content and tool results with multiple content types
- resource_template_example.ml: Shows resource templates and embedded resources
- completion_example.ml: Implements completion support with a custom tool

🤖 Generated with [Claude Code](https://claude.ai/code)

Co-Authored-By: Claude <noreply@anthropic.com>

+145
bin/audio_example.ml
···
···
+
open Mcp
+
open Mcp_sdk
+
+
(* Helper for extracting string value from JSON *)
+
let get_string_param json name =
+
match json with
+
| `Assoc fields ->
+
(match List.assoc_opt name fields with
+
| Some (`String value) -> value
+
| _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
+
| _ -> raise (Failure "Expected JSON object")
+
+
(* Create a server *)
+
let server = create_server
+
~name:"OCaml MCP Audio Example"
+
~version:"0.1.0"
+
~protocol_version:"2024-11-05"
+
()
+
+
(* Define startup and shutdown hooks *)
+
let startup () =
+
Printf.printf "AudioExampleServer is starting up!\n";
+
flush stdout;
+
Log.info "AudioExampleServer is starting up!"
+
+
let shutdown () =
+
Printf.printf "AudioExampleServer is shutting down. Goodbye!\n";
+
flush stdout;
+
Log.info "AudioExampleServer is shutting down. Goodbye!"
+
+
(* Register the hooks *)
+
let () =
+
set_startup_hook server startup;
+
set_shutdown_hook server shutdown
+
+
(* Helper to create audio content *)
+
let make_audio_content data mime_type =
+
let audio_content = AudioContent.{
+
data;
+
mime_type;
+
annotations = None;
+
} in
+
Audio audio_content
+
+
(* Define and register an audio tool *)
+
let _ = add_tool server
+
~name:"generate_audio_description"
+
~description:"Generates a description with an audio sample"
+
~schema_properties:[
+
("text", "string", "The text to describe with audio");
+
("frequency", "number", "The frequency in Hz for the tone (optional)");
+
]
+
~schema_required:["text"]
+
(fun args ->
+
try
+
let text = get_string_param args "text" in
+
let frequency =
+
try
+
match List.assoc_opt "frequency" (match args with `Assoc l -> l | _ -> []) with
+
| Some (`Int f) -> f
+
| Some (`Float f) -> int_of_float f
+
| _ -> 440 (* Default to A440 *)
+
with _ -> 440
+
in
+
+
(* This is just a placeholder for actual audio data *)
+
(* In a real implementation, you would generate a WAV or MP3 file and base64 encode it *)
+
let audio_data = Printf.sprintf "BASE64_ENCODED_AUDIO_DATA_FOR_%d_HZ_TONE" frequency in
+
+
(* Create a response with both text and audio content *)
+
CallToolResult.yojson_of_t CallToolResult.{
+
content = [
+
Text TextContent.{ text = Printf.sprintf "Description: %s (with %d Hz tone)" text frequency; annotations = None };
+
Audio AudioContent.{ data = audio_data; mime_type = "audio/wav"; annotations = None }
+
];
+
is_error = false;
+
meta = None
+
}
+
with
+
| Failure msg ->
+
Log.error (Printf.sprintf "Error in audio tool: %s" msg);
+
CallToolResult.yojson_of_t CallToolResult.{
+
content = [
+
Text TextContent.{
+
text = Printf.sprintf "Error: %s" msg;
+
annotations = None
+
}
+
];
+
is_error = true;
+
meta = None
+
}
+
)
+
+
(* Define and register a prompt example with audio *)
+
let _ = add_prompt server
+
~name:"audio-description-prompt"
+
~description:"A prompt with audio and text content"
+
~arguments:[
+
("description", Some "Text description to accompany the audio", true);
+
("frequency", Some "Frequency in Hz for the audio tone", false);
+
]
+
(fun args ->
+
let description =
+
try List.assoc "description" args
+
with Not_found -> "No description provided"
+
in
+
let frequency =
+
try int_of_string (List.assoc "frequency" args)
+
with _ -> 440 (* Default to A440 *)
+
in
+
+
(* Placeholder for audio data *)
+
let audio_data = Printf.sprintf "BASE64_ENCODED_AUDIO_DATA_FOR_%d_HZ_TONE" frequency in
+
+
[
+
Prompt.{
+
role = `User;
+
content = make_text_content "Here's a sound sample with description:"
+
};
+
Prompt.{
+
role = `User;
+
content = make_audio_content audio_data "audio/wav"
+
};
+
Prompt.{
+
role = `User;
+
content = make_text_content description
+
};
+
Prompt.{
+
role = `Assistant;
+
content = make_text_content "I've received your audio file and description."
+
}
+
]
+
)
+
+
(* Main function *)
+
let () =
+
(* Print directly to ensure we see output *)
+
Printf.printf "Starting AudioExampleServer...\n";
+
flush stdout;
+
+
(* Configure the server with appropriate capabilities *)
+
ignore (configure_server server ());
+
+
(* Run the server *)
+
run_server server
+180
bin/completion_example.ml
···
···
+
open Mcp
+
open Mcp_sdk
+
+
(* Helper for extracting string value from JSON *)
+
let get_string_param json name =
+
match json with
+
| `Assoc fields ->
+
(match List.assoc_opt name fields with
+
| Some (`String value) -> value
+
| _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
+
| _ -> raise (Failure "Expected JSON object")
+
+
(* Create a server *)
+
let server = create_server
+
~name:"OCaml MCP Completion Example"
+
~version:"0.1.0"
+
~protocol_version:"2024-11-05"
+
()
+
+
(* Define startup and shutdown hooks *)
+
let startup () =
+
Printf.printf "CompletionServer is starting up!\n";
+
flush stdout;
+
Log.info "CompletionServer is starting up!"
+
+
let shutdown () =
+
Printf.printf "CompletionServer is shutting down. Goodbye!\n";
+
flush stdout;
+
Log.info "CompletionServer is shutting down. Goodbye!"
+
+
(* Register the hooks *)
+
let () =
+
set_startup_hook server startup;
+
set_shutdown_hook server shutdown
+
+
(* Database of programming languages and their features *)
+
let languages = [
+
("ocaml", ["functional"; "static typing"; "pattern matching"; "modules"; "type inference"]);
+
("python", ["dynamic typing"; "interpreted"; "object-oriented"; "high-level"; "scripting"]);
+
("rust", ["memory safety"; "performance"; "static typing"; "ownership"; "zero-cost abstractions"]);
+
("javascript", ["dynamic typing"; "interpreted"; "prototypes"; "single-threaded"; "event-driven"]);
+
("go", ["concurrency"; "garbage collection"; "simplicity"; "static typing"; "compiled"]);
+
]
+
+
(* Helper function to create a completion response *)
+
let create_completion values ?(has_more=false) ?(total=None) () =
+
Completion.Result.{
+
completion = {
+
values;
+
has_more = Some has_more;
+
total;
+
};
+
meta = None;
+
}
+
+
(* Define and register a tool that handles completions *)
+
let _ = add_tool server
+
~name:"complete"
+
~description:"Handles completion requests for programming languages and features"
+
~schema_properties:[
+
("argument_name", "string", "The name of the argument to complete");
+
("argument_value", "string", "The partial value to complete");
+
]
+
~schema_required:["argument_name"; "argument_value"]
+
(fun args ->
+
try
+
let argument_name = get_string_param args "argument_name" in
+
let argument_value = get_string_param args "argument_value" in
+
+
Log.info (Printf.sprintf "Completion request for %s = %s" argument_name argument_value);
+
+
(* Handle different completion requests *)
+
let result =
+
match argument_name with
+
| "language" ->
+
(* Complete programming language names *)
+
let matches =
+
List.filter
+
(fun (lang, _) ->
+
let lang_lower = String.lowercase_ascii lang in
+
let arg_lower = String.lowercase_ascii argument_value in
+
String.length lang_lower >= String.length arg_lower &&
+
String.sub lang_lower 0 (String.length arg_lower) = arg_lower)
+
languages
+
in
+
let values = List.map fst matches in
+
create_completion values ~has_more:false ~total:(Some (List.length values)) ()
+
+
| "feature" ->
+
(* Complete programming language features *)
+
let all_features =
+
List.flatten (List.map snd languages) |>
+
List.sort_uniq String.compare
+
in
+
let matches =
+
List.filter
+
(fun feature ->
+
let feature_lower = String.lowercase_ascii feature in
+
let arg_lower = String.lowercase_ascii argument_value in
+
String.length feature_lower >= String.length arg_lower &&
+
String.sub feature_lower 0 (String.length arg_lower) = arg_lower)
+
all_features
+
in
+
create_completion matches ~has_more:false ~total:(Some (List.length matches)) ()
+
+
| _ ->
+
(* Default completions for unknown arguments *)
+
create_completion ["unknown argument"] ()
+
in
+
+
(* Convert to JSON and return *)
+
TextContent.yojson_of_t TextContent.{
+
text = Yojson.Safe.to_string (Completion.Result.to_result result);
+
annotations = None
+
}
+
with
+
| Failure msg ->
+
Log.error (Printf.sprintf "Error handling completion request: %s" msg);
+
TextContent.yojson_of_t TextContent.{
+
text = Printf.sprintf "Error: %s" msg;
+
annotations = None
+
}
+
)
+
+
(* Define and register a prompt that provides programming language info *)
+
let _ = add_prompt server
+
~name:"language-info-prompt"
+
~description:"A prompt that provides information about programming languages"
+
~arguments:[
+
("language", Some "Name of the programming language", true);
+
]
+
(fun args ->
+
let language =
+
try List.assoc "language" args
+
with Not_found -> "ocaml" (* Default to OCaml *)
+
in
+
+
let features =
+
try
+
let features = List.assoc (String.lowercase_ascii language) languages in
+
String.concat ", " features
+
with Not_found -> "unknown language"
+
in
+
+
[
+
Prompt.{
+
role = `User;
+
content = make_text_content (Printf.sprintf "Tell me about the %s programming language" language)
+
};
+
Prompt.{
+
role = `Assistant;
+
content = make_text_content (Printf.sprintf "%s is a programming language with the following features: %s" language features)
+
}
+
]
+
)
+
+
(* Main function *)
+
let () =
+
(* Print directly to ensure we see output *)
+
Printf.printf "Starting CompletionServer...\n";
+
flush stdout;
+
+
(* Set custom capabilities to indicate support for completions *)
+
let capabilities = `Assoc [
+
("completions", `Assoc []); (* Indicate support for completions *)
+
("prompts", `Assoc [
+
("listChanged", `Bool true)
+
]);
+
("resources", `Assoc [
+
("listChanged", `Bool true);
+
("subscribe", `Bool true)
+
]);
+
("tools", `Assoc [
+
("listChanged", `Bool true)
+
])
+
] in
+
set_capabilities server capabilities;
+
+
(* Run the server *)
+
run_server server
+15
bin/dune
···
(executable
(name capitalize_sdk)
(modules capitalize_sdk)
(libraries mcp mcp_sdk yojson unix))
···
(executable
(name capitalize_sdk)
(modules capitalize_sdk)
+
(libraries mcp mcp_sdk yojson unix))
+
+
(executable
+
(name audio_example)
+
(modules audio_example)
+
(libraries mcp mcp_sdk yojson unix))
+
+
(executable
+
(name resource_template_example)
+
(modules resource_template_example)
+
(libraries mcp mcp_sdk yojson unix))
+
+
(executable
+
(name completion_example)
+
(modules completion_example)
(libraries mcp mcp_sdk yojson unix))
+174
bin/resource_template_example.ml
···
···
+
open Mcp
+
open Mcp_sdk
+
+
(* Helper for extracting string value from JSON *)
+
let get_string_param json name =
+
match json with
+
| `Assoc fields ->
+
(match List.assoc_opt name fields with
+
| Some (`String value) -> value
+
| _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
+
| _ -> raise (Failure "Expected JSON object")
+
+
(* Create a server *)
+
let server = create_server
+
~name:"OCaml MCP Resource Template Example"
+
~version:"0.1.0"
+
~protocol_version:"2024-11-05"
+
()
+
+
(* Define startup and shutdown hooks *)
+
let startup () =
+
Printf.printf "ResourceTemplateServer is starting up!\n";
+
flush stdout;
+
Log.info "ResourceTemplateServer is starting up!"
+
+
let shutdown () =
+
Printf.printf "ResourceTemplateServer is shutting down. Goodbye!\n";
+
flush stdout;
+
Log.info "ResourceTemplateServer is shutting down. Goodbye!"
+
+
(* Register the hooks *)
+
let () =
+
set_startup_hook server startup;
+
set_shutdown_hook server shutdown
+
+
(* Database of "documents" *)
+
let documents = [
+
("doc1", "This is the first document content");
+
("doc2", "This document contains information about OCaml");
+
("doc3", "MCP protocol is a standard for LLM-based applications");
+
("doc4", "Resource templates allow for parameterized resources");
+
]
+
+
(* Define and register a resource template for documents *)
+
let _ = add_resource server
+
~uri_template:"document://{id}"
+
~description:"Get a document by ID"
+
~mime_type:"text/plain"
+
(fun params ->
+
match params with
+
| [id] ->
+
begin
+
try
+
let content = List.assoc id documents in
+
content
+
with Not_found ->
+
Printf.sprintf "Error: Document '%s' not found" id
+
end
+
| _ -> "Error: Invalid document ID"
+
)
+
+
(* Define and register a list documents resource *)
+
let _ = add_resource server
+
~uri_template:"documents://list"
+
~description:"List all available documents"
+
~mime_type:"text/plain"
+
(fun _ ->
+
let doc_list =
+
String.concat "\n"
+
(List.map (fun (id, _) -> Printf.sprintf "- %s" id) documents)
+
in
+
Printf.sprintf "Available Documents:\n%s" doc_list
+
)
+
+
(* Define and register a tool that uses resource references *)
+
let _ = add_tool server
+
~name:"get_document"
+
~description:"Gets a document by ID using resource references"
+
~schema_properties:[
+
("document_id", "string", "The ID of the document to retrieve");
+
]
+
~schema_required:["document_id"]
+
(fun args ->
+
try
+
let doc_id = get_string_param args "document_id" in
+
+
(* Create a resource reference *)
+
let ref = ResourceReference.{ uri = Printf.sprintf "document://%s" doc_id } in
+
(* Convert to JSON for logging purposes *)
+
let _ = ResourceReference.yojson_of_t ref in
+
+
(* Return the reference *)
+
CallToolResult.yojson_of_t CallToolResult.{
+
content = [
+
Text TextContent.{ text = Printf.sprintf "Resource reference for document %s:" doc_id; annotations = None };
+
Resource EmbeddedResource.{
+
resource = `Text TextResourceContents.{
+
uri = Printf.sprintf "document://%s" doc_id;
+
text = (try List.assoc doc_id documents with Not_found -> "Not found");
+
mime_type = Some "text/plain"
+
};
+
annotations = None
+
}
+
];
+
is_error = false;
+
meta = None
+
}
+
with
+
| Failure msg ->
+
Log.error (Printf.sprintf "Error in get_document tool: %s" msg);
+
CallToolResult.yojson_of_t CallToolResult.{
+
content = [
+
Text TextContent.{
+
text = Printf.sprintf "Error: %s" msg;
+
annotations = None
+
}
+
];
+
is_error = true;
+
meta = None
+
}
+
)
+
+
(* Define and register a prompt that uses resource templates *)
+
let _ = add_prompt server
+
~name:"document-prompt"
+
~description:"A prompt that references document resources"
+
~arguments:[
+
("document_id", Some "ID of the document to include in the prompt", true);
+
]
+
(fun args ->
+
let doc_id =
+
try List.assoc "document_id" args
+
with Not_found -> "doc1" (* Default to doc1 *)
+
in
+
+
let doc_text =
+
try List.assoc doc_id documents
+
with Not_found -> Printf.sprintf "Document '%s' not found" doc_id
+
in
+
+
[
+
Prompt.{
+
role = `User;
+
content = make_text_content (Printf.sprintf "Please summarize the following document (ID: %s):" doc_id)
+
};
+
Prompt.{
+
role = `User;
+
content = Resource EmbeddedResource.{
+
resource = `Text TextResourceContents.{
+
uri = Printf.sprintf "document://%s" doc_id;
+
text = doc_text;
+
mime_type = Some "text/plain"
+
};
+
annotations = None
+
}
+
};
+
Prompt.{
+
role = `Assistant;
+
content = make_text_content "I'll help summarize this document for you."
+
}
+
]
+
)
+
+
(* Main function *)
+
let () =
+
(* Print directly to ensure we see output *)
+
Printf.printf "Starting ResourceTemplateServer...\n";
+
flush stdout;
+
+
(* Configure the server with appropriate capabilities *)
+
ignore (configure_server server ());
+
+
(* Run the server *)
+
run_server server