Allow R session tools to be optional

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mcptools
 Title: Model Context Protocol Servers and Clients
-Version: 0.1.1.9000
+Version: 0.1.1.9001
 Authors@R: c(
     person("Simon", "Couch", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-5676-5107")),
@@ -43,4 +43,4 @@ Config/Needs/website: tidyverse/tidytemplate
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3

NEWS.md

@@ -1,5 +1,7 @@
 # mcptools (development version)
 
+`mcp_server()` gains argument `include_session_tools`, allowing users to opt-out of presenting R sessions tools to clients.
+
 # mcptools 0.1.1
 
 Addressed an issue in tests on `r-devel-linux-x86_64-fedora-clang`.

R/server.R

@@ -51,11 +51,13 @@
 #' Examples for Claude Code on WSL and Claude Desktop on Windows are shown
 #' at <https://github.com/posit-dev/mcptools/issues/41#issuecomment-3036617046>.
 #'
-#' @param tools A list of tools created with [ellmer::tool()] that will be
-#' available from the server or a file path to an .R file that, when sourced,
-#' will return a list of tools. Any list that could be passed to
-#' `Chat$set_tools()` can be passed here. By default, the package won't serve
-#' any tools other than those needed to communicate with interactive R sessions.
+#' @param tools Optional collection of tools to expose. Supply either a list
+#'   of objects created by [ellmer::tool()] or a path to an `.R` file that,
+#'   when sourced, yields such a list. Defaults to `NULL`, which serves only
+#'   the built-in session tools when `include_session_tools` is `TRUE`.
+#' @param ... Reserved for future use; currently ignored.
+#' @param include_session_tools Logical. Include the built-in session tools
+#' (`list_r_sessions`, `select_r_session`) that work with `mcp_session()`. Defaults to `TRUE`.
 #'
 #' @returns
 #' `mcp_server()` and `mcp_session()` are both called primarily for side-effects.
@@ -102,21 +104,33 @@
 #'
 #' @name server
 #' @export
-mcp_server <- function(tools = NULL) {
+mcp_server <- function(tools = NULL, ..., include_session_tools = TRUE) {
   # TODO: should this actually be a check for being called within Rscript or not?
   check_not_interactive()
-  set_server_tools(tools)
+  set_server_tools(tools, include_session_tools)
+
+  the$do_sessions <- isTRUE(include_session_tools)
 
   cv <- nanonext::cv()
+
   reader_socket <- nanonext::read_stdin()
   on.exit(nanonext::reap(reader_socket))
   nanonext::pipe_notify(reader_socket, cv, remove = TRUE, flag = TRUE)
+  client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv)
+
+  if (!the$do_sessions) {
+    while (nanonext::wait(cv)) {
+      if (!nanonext::unresolved(client)) {
+        handle_message_from_client(client$data)
+        client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv)
+      }
+    }
+    return()
+  }
 
   the$server_socket <- nanonext::socket("poly")
   on.exit(nanonext::reap(the$server_socket), add = TRUE)
   nanonext::dial(the$server_socket, url = sprintf("%s%d", the$socket_url, 1L))
-
-  client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv)
   session <- nanonext::recv_aio(the$server_socket, mode = "string", cv = cv)
 
   while (nanonext::wait(cv)) {
@@ -178,10 +192,11 @@ handle_message_from_client <- function(line) {
   } else if (data$method == "tools/call") {
     tool_name <- data$params$name
     if (
-      # two tools provided by mcptools itself which must be executed in
-      # the server rather than a session (#18)
-      tool_name %in%
-        c("list_r_sessions", "select_r_session") ||
+      isFALSE(the$do_sessions) ||
+        # two tools provided by mcptools itself which must be executed in
+        # the server rather than a session (#18)
+        tool_name %in% c("list_r_sessions", "select_r_session") ||
+        # when session handling is disabled, never forward to sessions
         # with no sessions available, just execute tools in the server (#36)
         !nanonext::stat(the$server_socket, "pipes")
     ) {

R/tools.R

@@ -1,7 +1,16 @@
-set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) {
+set_server_tools <- function(
+  x,
+  include_session_tools = TRUE,
+  x_arg = caller_arg(x),
+  call = caller_env()
+) {
   if (is.null(x)) {
-    the$server_tools <- c(list(list_r_sessions_tool, select_r_session_tool))
-    return()
+    if (include_session_tools) {
+      the$server_tools <- c(list(list_r_sessions_tool, select_r_session_tool))
+      return()
+    } else {
+      cli::cli_abort("No tools selected to serve.", call = call)
+    }
   }
 
   # evaluate eagerly so that caller arg is correct if `looks_like_r_file()`
@@ -22,7 +31,11 @@ set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) {
     )
   }
 
-  if (!is_list(x) || !all(vapply(x, inherits, logical(1), "ellmer::ToolDef"))) {
+  if (!is.list(x)) {
+    x <- list(x)
+  }
+
+  if (!all(vapply(x, inherits, logical(1), "ellmer::ToolDef"))) {
     msg <-
       "{.arg {x_arg}} must be a list of tools created with {.fn ellmer::tool}
        or a .R file path that returns a list of ellmer tools when sourced."
@@ -39,19 +52,22 @@ set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) {
     )
   ) {
     cli::cli_abort(
-      "The tool names {.field list_r_sessions} and {.field select_r_session} are 
+      "The tool names {.field list_r_sessions} and {.field select_r_session} are
        reserved by {.pkg mcptools}.",
       call = call
     )
   }
 
-  the$server_tools <- c(
-    x,
-    list(
-      list_r_sessions_tool,
-      select_r_session_tool
+  if (include_session_tools) {
+    x <- c(
+      x,
+      list(
+        list_r_sessions_tool,
+        select_r_session_tool
+      )
     )
-  )
+  }
+  the$server_tools <- x
 }
 
 looks_like_r_file <- function(x) {

tests/testthat/_snaps/tools.md

@@ -27,11 +27,10 @@
 # set_server_tools errors informatively
 
     Code
-      set_server_tools(tls$value[[1]])
+      set_server_tools(123)
     Condition
       Error:
-      ! `tls$value[[1]]` must be a list of tools created with `ellmer::tool()` or a .R file path that returns a list of ellmer tools when sourced.
-      i Did you mean to wrap `tls$value[[1]]` in `list()`?
+      ! `123` must be a list of tools created with `ellmer::tool()` or a .R file path that returns a list of ellmer tools when sourced.
 
 ---
 

tests/testthat/test-tools.R

@@ -45,8 +45,11 @@ test_that("set_server_tools errors informatively", {
       local = TRUE
     )
 
-  # needs to be wrapped in `list()`
-  expect_snapshot(set_server_tools(tls$value[[1]]), error = TRUE)
+  # input must be a ToolDef or list of ToolDefs
+  expect_snapshot(set_server_tools(123), error = TRUE)
+
+  # check can accept a single ToolDef
+  expect_no_error(set_server_tools(tls$value[[1]]))
 
   # select_r_session and list_r_sessions are reserved names
   tls$value[[1]]@name <- "select_r_session"