allow the model to list and select hosts

Author: simonpcouch

R/host.R

@@ -82,7 +82,10 @@ handle_message_from_server <- function(msg) {
 
   if (data$method == "tools/call") {
     name <- data$params$name
-    fn <- getNamespace("btw")[[name]]
+
+    # TODO: retrieve the function definitions directly from the configured tools
+    # (#12)
+    fn <- getNamespace("btw")[[name]] %||% getNamespace("acquaint")[[name]]
     args <- data$params$arguments
 
     # HACK for btw_tool_env_describe_environment. In the JSON, it will have

R/server.R

@@ -163,10 +163,9 @@ capabilities <- function() {
   )
 }
 
-# Hacky way of getting tools from btw
+# TODO: btw now surfaces a btw_tools() function that can be passed
+# directly to `tool_as_json()` along with .acquaint_tools (#12)
 get_all_btw_tools <- function() {
-  dummy_provider <- ellmer::Provider("dummy", "dummy", "dummy")
-
   .btw_tools <- getNamespace("btw")[[".btw_tools"]]
   tools <- lapply(unname(.btw_tools), function(tool_obj) {
     tool <- tool_obj$tool()
@@ -175,21 +174,29 @@ get_all_btw_tools <- function() {
       return(NULL)
     }
 
-    as_json <- getNamespace("ellmer")[["as_json"]]
-    inputSchema <- compact(as_json(dummy_provider, tool@arguments))
-    # This field is present but shouldn't be
-    inputSchema$description <- NULL
-
-    list(
-      name = tool@name,
-      description = tool@description,
-      inputSchema = inputSchema
-    )
+    tool_as_json(tool)
   })
 
+  tools <- c(tools, lapply(.acquaint_tools, tool_as_json))
+
   compact(tools)
 }
 
+tool_as_json <- function(tool) {
+  dummy_provider <- ellmer::Provider("dummy", "dummy", "dummy")
+
+  as_json <- getNamespace("ellmer")[["as_json"]]
+  inputSchema <- compact(as_json(dummy_provider, tool@arguments))
+  # This field is present but shouldn't be
+  inputSchema$description <- NULL
+
+  list(
+    name = tool@name,
+    description = tool@description,
+    inputSchema = inputSchema
+  )
+}
+
 compact <- function(.x) {
   Filter(length, .x)
 }
@@ -206,36 +213,3 @@ check_not_interactive <- function(call = caller_env()) {
     )
   }
 }
-
-mcp_discover <- function() {
-  sock <- nanonext::socket("poly")
-  on.exit(nanonext:::reap(sock))
-  cv <- nanonext::cv()
-  monitor <- nanonext::monitor(sock, cv)
-  suppressWarnings(
-    for (i in seq_len(1024L)) {
-      nanonext::dial(
-        sock,
-        url = sprintf("%s%d", acquaint_socket, i),
-        autostart = NA
-      ) &&
-        break
-    }
-  )
-  pipes <- nanonext::read_monitor(monitor)
-  res <- lapply(seq_along(pipes), function(x) nanonext::recv_aio(sock))
-  lapply(
-    pipes,
-    function(x) nanonext::send_aio(sock, "", mode = "raw", pipe = x)
-  )
-  nanonext::collect_aio_(res)
-}
-
-select_host <- function(i) {
-  lapply(the$server_socket[["dialer"]], nanonext::reap)
-  attr(the$server_socket, "dialer") <- NULL
-  nanonext::dial(
-    the$server_socket,
-    url = sprintf("%s%d", acquaint_socket, as.integer(i))
-  )
-}

R/tools.R

@@ -0,0 +1,65 @@
+# These two functions are supplied to the client as tools and allow the client
+# to discover R sessions which have called `acquaint::mcp_host()`. They
+# are "model-facing" rather than user-facing.
+list_r_sessions <- function() {
+  sock <- nanonext::socket("poly")
+  on.exit(nanonext::reap(sock))
+  cv <- nanonext::cv()
+  monitor <- nanonext::monitor(sock, cv)
+  suppressWarnings(
+    for (i in seq_len(1024L)) {
+      nanonext::dial(
+        sock,
+        url = sprintf("%s%d", acquaint_socket, i),
+        autostart = NA
+      ) &&
+        break
+    }
+  )
+  pipes <- nanonext::read_monitor(monitor)
+  res <- lapply(seq_along(pipes), function(x) nanonext::recv_aio(sock))
+  lapply(
+    pipes,
+    function(x) nanonext::send_aio(sock, "", mode = "raw", pipe = x)
+  )
+  # Convert the list result from nanonext to string
+  btw::btw_this(nanonext::collect_aio_(res))
+}
+
+list_r_sessions_tool <-
+  ellmer::tool(
+    .fun = list_r_sessions,
+    .description = paste(
+      "List the R sessions that are available to access.",
+      "R sessions which have run `acquaint::mcp_host()` will appear here.",
+      "In general, do not use this tool unless asked to list or",
+      "select a specific R session."
+    )
+  )
+
+select_r_session <- function(i) {
+  lapply(the$server_socket[["dialer"]], nanonext::reap)
+  attr(the$server_socket, "dialer") <- NULL
+  nanonext::dial(
+    the$server_socket,
+    url = sprintf("%s%d", acquaint_socket, as.integer(i))
+  )
+  paste0("Selected session ", i, "successfully.")
+}
+
+select_r_session_tool <-
+  ellmer::tool(
+    .fun = select_r_session,
+    .description = paste(
+      "Choose the R session host of interest.",
+      "Use the `list_r_sessions` tool to discover potential sessions.",
+      "In general, do not use this tool unless asked to select a specific R",
+      "session; the tools available to you have a default R session",
+      "that is usually the one the user wants.",
+      "Your choice of session will persist after the tool is called; only",
+      "call this tool more than once if you need to switch between sessions."
+    ),
+    i = ellmer::type_integer("The index of the host session to select.")
+  )
+
+.acquaint_tools <- list(list_r_sessions_tool, select_r_session_tool)