From 2c38c90e6ae09c34f95f946a1341da0ecd39a799 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 08:34:53 -0500 Subject: [PATCH 01/44] initial implementation --- DESCRIPTION | 1 + NAMESPACE | 1 + R/btw_client_app.R | 1 + R/tool-subagent.R | 398 ++++++++++++++++++++++++++++ R/tools.R | 1 + inst/icons/robot.svg | 1 + inst/prompts/btw-subagent.md | 15 ++ man/btw_client.Rd | 20 +- man/btw_tool_subagent.Rd | 26 ++ man/btw_tools.Rd | 7 + man/generate_session_id.Rd | 17 ++ man/retrieve_session.Rd | 18 ++ tests/testthat/test-tool-subagent.R | 304 +++++++++++++++++++++ 13 files changed, 801 insertions(+), 9 deletions(-) create mode 100644 R/tool-subagent.R create mode 100644 inst/icons/robot.svg create mode 100644 inst/prompts/btw-subagent.md create mode 100644 man/btw_tool_subagent.Rd create mode 100644 man/generate_session_id.Rd create mode 100644 man/retrieve_session.Rd create mode 100644 tests/testthat/test-tool-subagent.R diff --git a/DESCRIPTION b/DESCRIPTION index 9da97ff4..f39f642f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -111,6 +111,7 @@ Collate: 'tool-search-packages.R' 'tool-session-info.R' 'tool-session-package-installed.R' + 'tool-subagent.R' 'tool-web.R' 'tools.R' 'utils-ellmer.R' diff --git a/NAMESPACE b/NAMESPACE index 106063f3..dc84c4c8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -58,6 +58,7 @@ export(btw_tool_search_packages) export(btw_tool_session_check_package_installed) export(btw_tool_session_package_info) export(btw_tool_session_platform_info) +export(btw_tool_subagent) export(btw_tool_web_read_url) export(btw_tools) export(edit_btw_md) diff --git a/R/btw_client_app.R b/R/btw_client_app.R index 60922554..cdf66153 100644 --- a/R/btw_client_app.R +++ b/R/btw_client_app.R @@ -666,6 +666,7 @@ app_tool_group_choice_input <- function( label_text <- switch( group, + "agent" = shiny::span(label_icon, "Agents"), "docs" = shiny::span(label_icon, "Documentation"), "env" = shiny::span(label_icon, "Environment"), "eval" = shiny::span(label_icon, "Code Evaluation"), diff --git a/R/tool-subagent.R b/R/tool-subagent.R new file mode 100644 index 00000000..2b01e277 --- /dev/null +++ b/R/tool-subagent.R @@ -0,0 +1,398 @@ +# Subagent Tool Implementation +# +# This file implements the btw_tool_subagent() tool that enables hierarchical +# agent workflows by allowing an orchestrating LLM agent to delegate tasks to +# specialized subagents with their own LLM chat sessions. + +# Result class for subagent tool +BtwSubagentResult <- S7::new_class( + "BtwSubagentResult", + parent = BtwToolResult, + properties = list( + session_id = S7::class_character + ) +) + +#' User-facing subagent tool function +#' +#' This is a stub function for documentation purposes. The actual implementation +#' is in btw_tool_subagent_impl(). +#' +#' @param prompt Character string with the task or question for the subagent +#' @param tools Optional character vector of tool names to make available to +#' the subagent +#' @param session_id Optional session ID from a previous call to resume that +#' conversation +#' @param _intent Intent parameter added by ellmer framework +#' @return A BtwSubagentResult object +#' +#' @export +btw_tool_subagent <- function( + prompt, + tools = NULL, + session_id = NULL, + `_intent` +) {} + + +btw_tool_subagent_impl <- function( + prompt, + tools = NULL, + session_id = NULL, + max_turns = getOption("btw.subagent.max_turns", 10) +) { + check_string(prompt) + check_string(session_id, allow_null = TRUE) + check_number_whole(max_turns, min = 1, allow_infinite = FALSE) + + # Resume existing session or create new one + if (!is.null(session_id)) { + session <- retrieve_session(session_id) + + if (is.null(session)) { + cli::cli_abort(c( + "Session not found: {.val {session_id}}", + "i" = "The session may have expired or the ID is incorrect.", + "i" = "Omit {.arg session_id} to start a new session." + )) + } + + chat <- session$chat + + # Warn if approaching max turns + if (session$turns >= max_turns) { + cli::cli_warn(c( + "Session {.val {session_id}} has reached {session$turns} turns (threshold: {max_turns}).", + "i" = "Consider starting a new session or increasing {.code btw.subagent.max_turns}." + )) + } + } else { + # Create new session + session_id <- generate_session_id() + + # Configure client + config <- btw_subagent_client_config(client = NULL, tools = tools) + chat <- config$client + + # Set system prompt + system_prompt <- btw_prompt("btw-subagent.md") + chat$set_system_prompt(system_prompt) + + # Set tools + chat$set_tools(config$tools) + + # Store new session + store_session(session_id, chat) + } + + # Send prompt to subagent + response <- chat$chat(prompt) + + # Extract final message text + last_turn <- chat$last_turn() + message_text <- if (is.null(last_turn) || length(last_turn@contents) == 0) { + "" + } else { + # Get text content from the last assistant message + text_contents <- keep( + last_turn@contents, + function(x) S7::S7_inherits(x, ellmer::ContentText) + ) + if (length(text_contents) > 0) { + paste(map_chr(text_contents, function(x) x@text), collapse = "\n\n") + } else { + "" + } + } + + # We could update session metadata here, but `chat` is stateful + + # Return result + BtwSubagentResult( + value = message_text, + session_id = session_id, + extra = list( + data = list( + chat = chat, + turns = retrieve_session(session_id)$turns + ) + ) + ) +} + +#' Configure subagent client +#' +#' Creates and configures an ellmer Chat client for a subagent session. Follows +#' the precedence: argument > btw.subagent.* option > btw.* option > default +#' +#' @param client Optional Chat object or provider/model string +#' @param tools Optional character vector or list of tool definitions +#' @return A list with `client` and `tools` elements +#' +#' @noRd +btw_subagent_client_config <- function(client = NULL, tools = NULL) { + config <- list() + + # Configure tools + config$tools <- + tools %||% + getOption("btw.subagent.tools") %||% + getOption("btw.tools") %||% + btw_tools() + + config$tools <- flatten_and_check_tools(config$tools) + + # Configure client + # Priority: argument > btw.subagent.client > btw.client > default + if (!is.null(client)) { + config$client <- as_ellmer_client(client)$clone() + return(config) + } + + subagent_client <- getOption("btw.subagent.client") + if (!is.null(subagent_client)) { + config$client <- as_ellmer_client(subagent_client)$clone() + return(config) + } + + default_client <- getOption("btw.client") + if (!is.null(default_client)) { + config$client <- as_ellmer_client(default_client)$clone() + return(config) + } + + # Fall back to default Anthropic client + config$client <- btw_default_chat_client() + config +} + +#' Build dynamic tool description for btw_tool_subagent +#' +#' Generates a description that includes available tool groups dynamically. +#' +#' @return Character string with the tool description +#' +#' @noRd +build_subagent_description <- function() { + # Get unique tool groups from registered tools + tool_groups <- unique(map_chr(.btw_tools, function(x) x$group)) + tool_groups <- sort(tool_groups) + + # Build tool groups summary + if (length(tool_groups) > 0) { + tool_summary <- paste( + "Available tool groups:", + paste(tool_groups, collapse = ", ") + ) + } else { + tool_summary <- "No tool groups currently registered." + } + + base_desc <- "Delegate a complex task to a specialized subagent with its own LLM chat session. + +Use this tool when you need to: +- Break down a complex task into a focused subtask +- Maintain a separate conversation context for a specific problem +- Resume a previous subagent session to continue work + +The subagent has access to tools (unless you restrict them with the 'tools' parameter). + +IMPORTANT: +- The subagent's final response will be returned as plain text +- Store the session_id if you need to continue the conversation later +- Each subagent session is independent and maintains its own context + +" + + paste0(base_desc, tool_summary) +} + +# Register the tool +.btw_add_to_tools( + name = "btw_tool_subagent", + group = "agent", + tool = function() { + ellmer::tool( + function(prompt, tools = NULL, session_id = NULL) { + btw_tool_subagent_impl( + prompt = prompt, + tools = tools, + session_id = session_id + ) + }, + name = "btw_tool_subagent", + description = build_subagent_description(), + annotations = ellmer::tool_annotations( + title = "Subagent", + read_only_hint = FALSE, + open_world_hint = TRUE, + btw_can_register = function() TRUE + ), + arguments = list( + prompt = ellmer::type_string( + "The task or question to send to the subagent. Be specific and clear about what you need." + ), + tools = ellmer::type_array( + "Optional: specific tool names to make available to the subagent. If omitted, default tools are provided. Use this to limit the subagent's scope.", + items = ellmer::type_string(), + required = FALSE + ), + session_id = ellmer::type_string( + "Optional: A session ID from a previous subagent call to continue that conversation. Omit to start a new session.", + required = FALSE + ) + ) + ) + } +) + +# ----- Subagent session management ----- +# Subagent Session Management +# +# This file implements session storage and word-based ID generation for +# hierarchical agent workflows. Subagent sessions persist for the duration +# of the R session and are automatically cleaned up when the session ends. + +# Module-level environment for storing subagent chat sessions +.btw_subagent_sessions <- new.env(parent = emptyenv()) + +# Word lists for generating human-readable session IDs +# fmt: skip +.btw_adjectives <- c( + "agile", "bold", "bright", "calm", "clever", "daring", "eager", "elegant", + "fair", "fierce", "gentle", "happy", "jolly", "keen", "lively", "merry", + "nimble", "noble", "placid", "quick", "quiet", "rapid", "serene", "shy", + "silent", "smooth", "stable", "steady", "swift", "tranquil", "valiant", + "vibrant", "vigilant", "vivid", "warm", "wise", "witty", "zealous" +) + +# fmt: skip +.btw_nouns <- c( + "aardvark", "badger", "beaver", "cheetah", "dolphin", "eagle", "falcon", + "gazelle", "hawk", "jaguar", "kangaroo", "leopard", "lynx", "meerkat", + "otter", "panther", "penguin", "puffin", "rabbit", "raven", "salmon", + "sparrow", "squirrel", "starling", "swift", "tiger", "turtle", "viper", + "walrus", "weasel", "whale", "wolf", "wombat", "zebra" +) + +#' Generate a word-based session ID +#' +#' Creates a human-readable session identifier in the format "adjective-noun" +#' (e.g., "stable-genius", "swift-falcon"). Checks for uniqueness against +#' currently active sessions. +#' +#' @return A character string containing the generated session ID +#' @keywords internal +generate_session_id <- function() { + # Try up to 100 times to generate a unique ID + for (i in seq_len(100)) { + adj <- sample(.btw_adjectives, 1) + noun <- sample(.btw_nouns, 1) + id <- paste(adj, noun, sep = "_") + + if (!env_has(.btw_subagent_sessions, id)) { + return(id) + } + } + + # If we couldn't generate a unique ID after 100 tries, fall back to UUID-style + cli::cli_warn(c( + "Could not generate unique word-based ID after 100 attempts.", + "i" = "Falling back to random suffix." + )) + + adj <- sample(.btw_adjectives, 1) + noun <- sample(.btw_nouns, 1) + suffix <- sample(1000:9999, 1) + paste(c(adj, noun, suffix), collapse = "_") +} + +#' Store a subagent session +#' +#' Stores a chat object and associated metadata in the session environment. +#' +#' @param session_id Character string with the session identifier +#' @param chat An ellmer Chat object +#' @param metadata Optional list of additional metadata to store +#' @return The session_id (invisibly) +#' +#' @noRd +store_session <- function(session_id, chat, metadata = list()) { + check_string(session_id) + check_inherits(chat, "Chat") + + session_data <- c( + list( + id = session_id, + chat = chat, + created = Sys.time() + ), + metadata + ) + + assign(session_id, session_data, envir = .btw_subagent_sessions) + invisible(session_id) +} + +#' Retrieve a subagent session +#' +#' Retrieves a stored session from the session environment. +#' +#' @param session_id Character string with the session identifier +#' @return A list containing the session data, or NULL if not found +#' +#' @keywords noRd +retrieve_session <- function(session_id) { + check_string(session_id) + + env_get(.btw_subagent_sessions, session_id, default = NULL) +} + +#' List all active subagent sessions +#' +#' Returns a list with information about all currently active subagent +#' sessions. Useful for debugging and monitoring. +#' +#' @return A list of sessions with: id, chat, created, last_used, turns +#' +#' @noRd +list_subagent_sessions <- function() { + env_get_list(.btw_subagent_sessions, env_names(.btw_subagent_sessions)) +} + +#' Clear a specific subagent session +#' +#' Explicitly removes a session from the session store. This is optional - +#' sessions will be automatically cleaned up when the R session ends. +#' +#' @param session_id Character string with the session identifier +#' @return TRUE if session was found and removed, FALSE otherwise +#' +#' @noRd +clear_subagent_session <- function(session_id) { + check_string(session_id) + + if (!env_has(.btw_subagent_sessions, session_id)) { + return(FALSE) + } + + rm(list = session_id, envir = .btw_subagent_sessions) + TRUE +} + +#' Clear all subagent sessions +#' +#' Removes all sessions from the session store. This is optional - sessions +#' will be automatically cleaned up when the R session ends. +#' +#' @noRd +clear_all_subagent_sessions <- function() { + session_ids <- env_names(.btw_subagent_sessions) + count <- length(session_ids) + + if (count > 0) { + rm(list = session_ids, envir = .btw_subagent_sessions) + } + + invisible(count) +} diff --git a/R/tools.R b/R/tools.R index 35b6372e..d929aab4 100644 --- a/R/tools.R +++ b/R/tools.R @@ -134,6 +134,7 @@ wrap_with_intent <- function(tool) { tool_group_icon <- function(group, default = NULL) { switch( group, + "agent" = tool_icon("robot"), "docs" = tool_icon("dictionary"), "env" = tool_icon("source-environment"), "eval" = tool_icon("play-circle"), diff --git a/inst/icons/robot.svg b/inst/icons/robot.svg new file mode 100644 index 00000000..80881516 --- /dev/null +++ b/inst/icons/robot.svg @@ -0,0 +1 @@ + diff --git a/inst/prompts/btw-subagent.md b/inst/prompts/btw-subagent.md new file mode 100644 index 00000000..ce3cbb03 --- /dev/null +++ b/inst/prompts/btw-subagent.md @@ -0,0 +1,15 @@ +# Subagent Instructions + +You are a specialized assistant helping to complete a specific task for another AI agent (the orchestrating agent). + +## Critical Guidelines + +1. **Return Final Answer Only**: Your response will be sent directly back to the orchestrating agent. Only provide your final answer, conclusion, or result. Do not include meta-commentary about the process. + +2. **Be Concise and Direct**: The orchestrating agent needs actionable information. Be thorough but focused on what was requested. + +3. **Tool Usage**: Use the available tools as needed to complete your task. The tools have been specifically selected for this subtask. + +4. **Error Handling**: If you cannot complete the task, explain why clearly and suggest what additional information or capabilities would be needed. + +5. **Session Context**: You may be called multiple times with follow-up prompts. Maintain context from previous interactions in this session. diff --git a/man/btw_client.Rd b/man/btw_client.Rd index bbb38d24..300361ce 100644 --- a/man/btw_client.Rd +++ b/man/btw_client.Rd @@ -40,11 +40,12 @@ alternatively in the shorter form \code{tools = "docs_help_page"}. Finally, set \code{tools = FALSE} to skip registering \pkg{btw} tools with the chat client.} -\item{path_btw}{A path to a \code{btw.md} or \code{AGENTS.md} project context file. If -\code{NULL}, btw will find a project-specific \code{btw.md} or \code{AGENTS.md} file in -the parents of the current working directory, with fallback to user-level -\code{btw.md} if no project file is found. Set \code{path_btw = FALSE} to -create a chat client without using a \code{btw.md} file.} +\item{path_btw}{A path to a \code{btw.md}, \code{AGENTS.md}, or \code{CLAUDE.md} project +context file. If \code{NULL}, btw will find a project-specific \code{btw.md}, +\code{AGENTS.md}, or \code{CLAUDE.md} file in the parents of the current working +directory, with fallback to user-level \code{btw.md} if no project file is +found. Set \code{path_btw = FALSE} to create a chat client without using a +\code{btw.md} file.} \item{path_llms_txt}{A path to an \code{llms.txt} file containing context about the current project. By default, btw will look for an \code{llms.txt} file in @@ -67,10 +68,11 @@ local workspace. \subsection{Project Context}{ You can keep track of project-specific rules, guidance and context by adding -a \code{btw.md} file or \href{https://agents.md/}{\code{AGENTS.md}} in your project -directory. See \code{\link[=use_btw_md]{use_btw_md()}} for help creating a \code{btw.md} file in your -project, or use \code{path_btw} to tell \code{btw_client()} to use a specific context -file. +a \code{btw.md} file, \href{https://agents.md/}{\code{AGENTS.md}}, or \code{CLAUDE.md} in your +project directory. See \code{\link[=use_btw_md]{use_btw_md()}} for help creating a \code{btw.md} file in +your project, or use \code{path_btw} to tell \code{btw_client()} to use a specific +context file. Note that \code{CLAUDE.md} files will have their YAML frontmatter +stripped but not used for configuration. \code{btw_client()} will also include context from an \code{llms.txt} file in the system prompt, if one is found in your project directory or as specified by diff --git a/man/btw_tool_subagent.Rd b/man/btw_tool_subagent.Rd new file mode 100644 index 00000000..2118973d --- /dev/null +++ b/man/btw_tool_subagent.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tool-subagent.R +\name{btw_tool_subagent} +\alias{btw_tool_subagent} +\title{User-facing subagent tool function} +\usage{ +btw_tool_subagent(prompt, tools = NULL, session_id = NULL, `_intent` = "") +} +\arguments{ +\item{prompt}{Character string with the task or question for the subagent} + +\item{tools}{Optional character vector of tool names to make available to +the subagent} + +\item{session_id}{Optional session ID from a previous call to resume that +conversation} + +\item{_intent}{Intent parameter added by ellmer framework} +} +\value{ +A BtwSubagentResult object +} +\description{ +This is a stub function for documentation purposes. The actual implementation +is in btw_tool_subagent_impl(). +} diff --git a/man/btw_tools.Rd b/man/btw_tools.Rd index fc251815..38c7bbf6 100644 --- a/man/btw_tools.Rd +++ b/man/btw_tools.Rd @@ -30,6 +30,13 @@ The \code{btw_tools()} function provides a list of tools that can be registered with an ellmer chat via \code{chat$register_tools()} that allow the chat to interface with your computational environment. Chats returned by this function have access to the tools: +\subsection{Group: agent}{\tabular{ll}{ + Name \tab Description \cr + \code{\link[=btw_tool_subagent]{btw_tool_subagent()}} \tab Delegate a complex task to a specialized subagent with its own LLM chat session. \cr +} + +} + \subsection{Group: docs}{\tabular{ll}{ Name \tab Description \cr \code{\link[=btw_tool_docs_available_vignettes]{btw_tool_docs_available_vignettes()}} \tab List available vignettes for an R package. \cr diff --git a/man/generate_session_id.Rd b/man/generate_session_id.Rd new file mode 100644 index 00000000..3f5e882b --- /dev/null +++ b/man/generate_session_id.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tool-subagent.R +\name{generate_session_id} +\alias{generate_session_id} +\title{Generate a word-based session ID} +\usage{ +generate_session_id() +} +\value{ +A character string containing the generated session ID +} +\description{ +Creates a human-readable session identifier in the format "adjective-noun" +(e.g., "stable-genius", "swift-falcon"). Checks for uniqueness against +currently active sessions. +} +\keyword{internal} diff --git a/man/retrieve_session.Rd b/man/retrieve_session.Rd new file mode 100644 index 00000000..fe4653af --- /dev/null +++ b/man/retrieve_session.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tool-subagent.R +\name{retrieve_session} +\alias{retrieve_session} +\title{Retrieve a subagent session} +\usage{ +retrieve_session(session_id) +} +\arguments{ +\item{session_id}{Character string with the session identifier} +} +\value{ +A list containing the session data, or NULL if not found +} +\description{ +Retrieves a stored session from the session environment. +} +\keyword{noRd} diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-subagent.R new file mode 100644 index 00000000..82acbb9d --- /dev/null +++ b/tests/testthat/test-tool-subagent.R @@ -0,0 +1,304 @@ +# Tests for subagent tool and session management + +# Helper to create a mock Chat object for testing +mock_chat <- function() { + structure( + list( + messages = list(), + system_prompt = NULL, + tools = list() + ), + class = "Chat" + ) +} + +# ---- Session ID Generation ---- + +test_that("generate_session_id() creates valid IDs", { + id1 <- generate_session_id() + id2 <- generate_session_id() + + # Check format: word_word (underscore separator) + expect_match(id1, "^[a-z]+_[a-z]+$") + expect_match(id2, "^[a-z]+_[a-z]+$") + + # IDs should be different (probabilistically) + # This could fail occasionally but very unlikely + ids <- replicate(10, generate_session_id()) + expect_true(length(unique(ids)) > 5) +}) + +test_that("generate_session_id() checks for uniqueness", { + # Clear any existing sessions + clear_all_subagent_sessions() + + # Generate first ID + id1 <- generate_session_id() + + # Store a session with this ID + store_session(id1, mock_chat()) + + # Generate more IDs - they should all be different from id1 + ids <- replicate(20, generate_session_id()) + expect_false(id1 %in% ids) + + # Clean up + clear_all_subagent_sessions() +}) + +# ---- Session Storage and Retrieval ---- + +test_that("store_session() and retrieve_session() work", { + clear_all_subagent_sessions() + + session_id <- "test_session" + chat <- mock_chat() + + # Store session + result <- store_session(session_id, chat) + expect_equal(result, session_id) + + # Retrieve session + session <- retrieve_session(session_id) + expect_type(session, "list") + expect_equal(session$id, session_id) + expect_equal(session$chat, chat) + expect_s3_class(session$created, "POSIXct") + + # Initial session should NOT have last_used or turns fields + expect_null(session$last_used) + expect_null(session$turns) + + # Clean up + clear_all_subagent_sessions() +}) + +test_that("store_session() requires Chat object", { + expect_error( + store_session("test", "not a chat object"), + "must be a.*Chat" + ) +}) + +test_that("retrieve_session() returns NULL for nonexistent session", { + clear_all_subagent_sessions() + session <- retrieve_session("nonexistent_session") + expect_null(session) +}) + +test_that("store_session() can include metadata", { + clear_all_subagent_sessions() + + session_id <- "test_with_metadata" + chat <- mock_chat() + metadata <- list(custom_field = "custom_value") + + store_session(session_id, chat, metadata) + session <- retrieve_session(session_id) + + expect_equal(session$custom_field, "custom_value") + + clear_all_subagent_sessions() +}) + +# ---- Session Listing ---- + +test_that("list_subagent_sessions() works with no sessions", { + clear_all_subagent_sessions() + + result <- list_subagent_sessions() + expect_type(result, "list") + expect_equal(length(result), 0) +}) + +test_that("list_subagent_sessions() lists all sessions", { + clear_all_subagent_sessions() + + # Create multiple sessions + store_session("session_1", mock_chat()) + store_session("session_2", mock_chat()) + store_session("session_3", mock_chat()) + + result <- list_subagent_sessions() + expect_type(result, "list") + expect_equal(length(result), 3) + + # Check that session IDs are present + session_ids <- names(result) + expect_true("session_1" %in% session_ids) + expect_true("session_2" %in% session_ids) + expect_true("session_3" %in% session_ids) + + # Each session should be a list with expected fields + expect_equal(result$session_1$id, "session_1") + expect_equal(result$session_2$id, "session_2") + expect_equal(result$session_3$id, "session_3") + + clear_all_subagent_sessions() +}) + +# ---- Session Clearing ---- + +test_that("clear_subagent_session() removes a session", { + clear_all_subagent_sessions() + + session_id <- "test_clear" + store_session(session_id, mock_chat()) + + # Verify it exists + expect_false(is.null(retrieve_session(session_id))) + + # Clear it + result <- clear_subagent_session(session_id) + expect_true(result) + + # Verify it's gone + expect_null(retrieve_session(session_id)) +}) + +test_that("clear_subagent_session() returns FALSE for nonexistent session", { + clear_all_subagent_sessions() + result <- clear_subagent_session("nonexistent") + expect_false(result) +}) + +test_that("clear_all_subagent_sessions() clears all sessions", { + clear_all_subagent_sessions() + + # Create multiple sessions + store_session("session_1", mock_chat()) + store_session("session_2", mock_chat()) + store_session("session_3", mock_chat()) + + # Verify they exist + expect_equal(length(list_subagent_sessions()), 3) + + # Clear all + count <- clear_all_subagent_sessions() + expect_equal(count, 3) + + # Verify they're all gone + expect_equal(length(list_subagent_sessions()), 0) +}) + +test_that("clear_all_subagent_sessions() returns 0 when no sessions", { + clear_all_subagent_sessions() + count <- clear_all_subagent_sessions() + expect_equal(count, 0) +}) + +# ---- Client Configuration ---- + +test_that("btw_subagent_client_config() uses default tools", { + withr::local_options( + btw.subagent.tools = NULL, + btw.tools = NULL + ) + + config <- btw_subagent_client_config() + + expect_type(config$tools, "list") + expect_true(length(config$tools) > 0) + expect_true(inherits(config$client, "Chat")) +}) + +test_that("btw_subagent_client_config() respects tool filtering", { + # Test with character vector + config <- btw_subagent_client_config(tools = c("docs")) + + expect_type(config$tools, "list") + # Should have some docs tools + expect_true(length(config$tools) > 0) +}) + +test_that("btw_subagent_client_config() follows client precedence", { + skip_if_not_installed("ellmer") + + # Test option precedence + withr::local_options( + btw.subagent.client = "anthropic/claude-sonnet-4-20250514", + btw.client = "anthropic/claude-opus-4-20241120" + ) + + config <- btw_subagent_client_config() + expect_true(inherits(config$client, "Chat")) + + # Test argument precedence + chat_obj <- ellmer::chat_anthropic() + config2 <- btw_subagent_client_config(client = chat_obj) + expect_identical(config2$client, chat_obj) +}) + +test_that("btw_subagent_client_config() clones clients from options", { + skip_if_not_installed("ellmer") + + chat_obj <- ellmer::chat_anthropic() + + withr::local_options(btw.subagent.client = chat_obj) + + config1 <- btw_subagent_client_config() + config2 <- btw_subagent_client_config() + + # Should be different objects (cloned) + expect_false(identical(config1$client, config2$client)) + expect_false(identical(config1$client, chat_obj)) +}) + +# ---- Tool Description ---- + +test_that("build_subagent_description() includes tool groups", { + desc <- build_subagent_description() + + expect_type(desc, "character") + expect_match(desc, "Delegate a complex task") + expect_match(desc, "Available tool groups") + + # Should mention at least one tool group (e.g., docs, env, etc.) + expect_true( + any(grepl("docs|env|search|github", desc)) + ) +}) + +test_that("build_subagent_description() includes basic text", { + desc <- build_subagent_description() + + expect_type(desc, "character") + expect_match(desc, "Delegate a complex task") + expect_match(desc, "subagent") +}) + +# ---- Tool Registration ---- + +test_that("btw_tool_subagent is registered in btw_tools", { + all_tools <- btw_tools() + + tool_names <- sapply(all_tools, function(t) t@name) + expect_true("btw_tool_subagent" %in% tool_names) + + # Get the specific tool + subagent_tool <- all_tools[[which(tool_names == "btw_tool_subagent")]] + + # Check properties + expect_equal(subagent_tool@name, "btw_tool_subagent") + expect_type(subagent_tool@description, "character") + expect_match(subagent_tool@description, "Delegate a complex task") + + # Check it has arguments + expect_true(length(subagent_tool@arguments) > 0) +}) + +# ---- BtwSubagentResult Class ---- + +test_that("BtwSubagentResult inherits from BtwToolResult", { + result <- BtwSubagentResult( + value = "test response", + session_id = "test_id", + extra = list() + ) + + # Check S7 class hierarchy + expect_true(S7::S7_inherits(result, BtwSubagentResult)) + expect_true(S7::S7_inherits(result, BtwToolResult)) + expect_equal(result@value, "test response") + expect_equal(result@session_id, "test_id") +}) From c7724c5947b000e511cc1fcfcc0b310d2786b146 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 09:05:01 -0500 Subject: [PATCH 02/44] refactor: create complete client --- R/tool-subagent.R | 96 +++++++++++++---------------- inst/prompts/btw-subagent.md | 33 +++++++--- tests/testthat/test-tool-subagent.R | 36 +++++------ 3 files changed, 86 insertions(+), 79 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 2b01e277..6cb58dc1 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -67,19 +67,8 @@ btw_tool_subagent_impl <- function( )) } } else { - # Create new session session_id <- generate_session_id() - - # Configure client - config <- btw_subagent_client_config(client = NULL, tools = tools) - chat <- config$client - - # Set system prompt - system_prompt <- btw_prompt("btw-subagent.md") - chat$set_system_prompt(system_prompt) - - # Set tools - chat$set_tools(config$tools) + chat <- btw_subagent_client_config(client = NULL, tools = tools) # Store new session store_session(session_id, chat) @@ -122,48 +111,43 @@ btw_tool_subagent_impl <- function( #' Configure subagent client #' -#' Creates and configures an ellmer Chat client for a subagent session. Follows -#' the precedence: argument > btw.subagent.* option > btw.* option > default +#' Creates and configures an ellmer Chat client for a subagent session. The +#' returned chat object has the system prompt and tools already attached. +#' Follows the precedence: argument > btw.subagent.* option > btw.* option > default #' #' @param client Optional Chat object or provider/model string #' @param tools Optional character vector or list of tool definitions -#' @return A list with `client` and `tools` elements +#' @return A configured Chat object with system prompt and tools attached #' #' @noRd btw_subagent_client_config <- function(client = NULL, tools = NULL) { - config <- list() - # Configure tools - config$tools <- + configured_tools <- tools %||% getOption("btw.subagent.tools") %||% getOption("btw.tools") %||% btw_tools() - config$tools <- flatten_and_check_tools(config$tools) + configured_tools <- flatten_and_check_tools(configured_tools) # Configure client # Priority: argument > btw.subagent.client > btw.client > default - if (!is.null(client)) { - config$client <- as_ellmer_client(client)$clone() - return(config) - } - - subagent_client <- getOption("btw.subagent.client") - if (!is.null(subagent_client)) { - config$client <- as_ellmer_client(subagent_client)$clone() - return(config) + chat <- if (!is.null(client)) { + as_ellmer_client(client)$clone() + } else if (!is.null(subagent_client <- getOption("btw.subagent.client"))) { + as_ellmer_client(subagent_client)$clone() + } else if (!is.null(default_client <- getOption("btw.client"))) { + as_ellmer_client(default_client)$clone() + } else { + btw_default_chat_client() } - default_client <- getOption("btw.client") - if (!is.null(default_client)) { - config$client <- as_ellmer_client(default_client)$clone() - return(config) - } + # Set system prompt and tools + system_prompt <- btw_prompt("btw-subagent.md") + chat$set_system_prompt(system_prompt) + chat$set_tools(configured_tools) - # Fall back to default Anthropic client - config$client <- btw_default_chat_client() - config + chat } #' Build dynamic tool description for btw_tool_subagent @@ -181,28 +165,34 @@ build_subagent_description <- function() { # Build tool groups summary if (length(tool_groups) > 0) { tool_summary <- paste( - "Available tool groups:", + "\n\nAvailable tool groups:", paste(tool_groups, collapse = ", ") ) } else { - tool_summary <- "No tool groups currently registered." + tool_summary <- "\n\nNo tool groups currently registered." } - base_desc <- "Delegate a complex task to a specialized subagent with its own LLM chat session. - -Use this tool when you need to: -- Break down a complex task into a focused subtask -- Maintain a separate conversation context for a specific problem -- Resume a previous subagent session to continue work + base_desc <- "Delegate a task to a specialized assistant that can work independently with its own conversation thread. -The subagent has access to tools (unless you restrict them with the 'tools' parameter). +WHEN TO USE: +- For complex, multi-step tasks that would benefit from focused attention +- When you need to isolate work on a specific subtask +- To resume previous work by providing the session_id from an earlier call +- When you can handle the task yourself with available tools, do so directly instead -IMPORTANT: -- The subagent's final response will be returned as plain text -- Store the session_id if you need to continue the conversation later -- Each subagent session is independent and maintains its own context +CRITICAL - TOOL SELECTION: +You MUST specify which tools the subagent needs using the 'tools' parameter. Choosing the right tools is essential for success: +- Analyze the task requirements carefully +- Select only the specific tools needed (e.g., ['btw_tool_files_read_text_file', 'btw_tool_files_write_text_file'] for file tasks) +- If uncertain which tools are needed, include relevant tool groups +- The subagent can ONLY use the tools you provide - wrong tools = task failure -" +BEST PRACTICES: +- Write clear, complete task descriptions in the prompt +- Specify expected output format if important +- Store the returned session_id if you need to continue the work later +- The subagent returns its final answer as plain text +- Each subagent session is independent with its own context" paste0(base_desc, tool_summary) } @@ -230,15 +220,15 @@ IMPORTANT: ), arguments = list( prompt = ellmer::type_string( - "The task or question to send to the subagent. Be specific and clear about what you need." + "The complete task description for the subagent. Be specific and clear about requirements and expected output." ), tools = ellmer::type_array( - "Optional: specific tool names to make available to the subagent. If omitted, default tools are provided. Use this to limit the subagent's scope.", + "REQUIRED (in practice): Array of specific tool names to provide to the subagent (e.g., ['btw_tool_files_read_text_file', 'btw_tool_code_search']). Choose tools that match the task requirements. The subagent can ONLY use these tools.", items = ellmer::type_string(), required = FALSE ), session_id = ellmer::type_string( - "Optional: A session ID from a previous subagent call to continue that conversation. Omit to start a new session.", + "Optional: session_id from a previous call to continue that conversation. Omit to start a new session.", required = FALSE ) ) diff --git a/inst/prompts/btw-subagent.md b/inst/prompts/btw-subagent.md index ce3cbb03..144b24c8 100644 --- a/inst/prompts/btw-subagent.md +++ b/inst/prompts/btw-subagent.md @@ -1,15 +1,32 @@ -# Subagent Instructions +# Task Execution Guidelines -You are a specialized assistant helping to complete a specific task for another AI agent (the orchestrating agent). +You are completing a focused task. Follow these guidelines to deliver effective results. -## Critical Guidelines +## 1. Deliver Complete, Actionable Answers -1. **Return Final Answer Only**: Your response will be sent directly back to the orchestrating agent. Only provide your final answer, conclusion, or result. Do not include meta-commentary about the process. +Provide your final answer, conclusion, or result directly. Your response is the deliverable. -2. **Be Concise and Direct**: The orchestrating agent needs actionable information. Be thorough but focused on what was requested. +- **Include all necessary information** in your response +- **Be thorough but focused** on the specific task +- **Do not add meta-commentary** about your process or limitations unless directly relevant to the answer -3. **Tool Usage**: Use the available tools as needed to complete your task. The tools have been specifically selected for this subtask. +## 2. Use Available Tools Effectively -4. **Error Handling**: If you cannot complete the task, explain why clearly and suggest what additional information or capabilities would be needed. +- Use the tools provided to complete your task successfully. +- Tools are specifically selected for this task +- Combine information from multiple tool calls when appropriate + +## 3. Handle Problems Clearly + +If you cannot complete the task: + +- **Explain why clearly** and specifically +- **State what is missing** (information, capabilities, clarification) +- **Provide partial results** if possible and indicate what remains incomplete + +## 4. Build on Previous Work + +- When you receive follow-up requests, build on what you've already done. +- Reference previous findings naturally +- Expand or refine earlier work as requested -5. **Session Context**: You may be called multiple times with follow-up prompts. Maintain context from previous interactions in this session. diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-subagent.R index 82acbb9d..96d89c00 100644 --- a/tests/testthat/test-tool-subagent.R +++ b/tests/testthat/test-tool-subagent.R @@ -195,20 +195,20 @@ test_that("btw_subagent_client_config() uses default tools", { btw.tools = NULL ) - config <- btw_subagent_client_config() + chat <- btw_subagent_client_config() - expect_type(config$tools, "list") - expect_true(length(config$tools) > 0) - expect_true(inherits(config$client, "Chat")) + expect_true(inherits(chat, "Chat")) + # Chat should have tools configured + expect_true(length(chat$get_tools()) > 0) }) test_that("btw_subagent_client_config() respects tool filtering", { # Test with character vector - config <- btw_subagent_client_config(tools = c("docs")) + chat <- btw_subagent_client_config(tools = c("docs")) - expect_type(config$tools, "list") + expect_true(inherits(chat, "Chat")) # Should have some docs tools - expect_true(length(config$tools) > 0) + expect_true(length(chat$get_tools()) > 0) }) test_that("btw_subagent_client_config() follows client precedence", { @@ -220,13 +220,13 @@ test_that("btw_subagent_client_config() follows client precedence", { btw.client = "anthropic/claude-opus-4-20241120" ) - config <- btw_subagent_client_config() - expect_true(inherits(config$client, "Chat")) + chat <- btw_subagent_client_config() + expect_true(inherits(chat, "Chat")) # Test argument precedence chat_obj <- ellmer::chat_anthropic() - config2 <- btw_subagent_client_config(client = chat_obj) - expect_identical(config2$client, chat_obj) + chat2 <- btw_subagent_client_config(client = chat_obj) + expect_identical(chat2, chat_obj) }) test_that("btw_subagent_client_config() clones clients from options", { @@ -236,12 +236,12 @@ test_that("btw_subagent_client_config() clones clients from options", { withr::local_options(btw.subagent.client = chat_obj) - config1 <- btw_subagent_client_config() - config2 <- btw_subagent_client_config() + chat1 <- btw_subagent_client_config() + chat2 <- btw_subagent_client_config() # Should be different objects (cloned) - expect_false(identical(config1$client, config2$client)) - expect_false(identical(config1$client, chat_obj)) + expect_false(identical(chat1, chat2)) + expect_false(identical(chat1, chat_obj)) }) # ---- Tool Description ---- @@ -250,7 +250,7 @@ test_that("build_subagent_description() includes tool groups", { desc <- build_subagent_description() expect_type(desc, "character") - expect_match(desc, "Delegate a complex task") + expect_match(desc, "Delegate a task") expect_match(desc, "Available tool groups") # Should mention at least one tool group (e.g., docs, env, etc.) @@ -263,7 +263,7 @@ test_that("build_subagent_description() includes basic text", { desc <- build_subagent_description() expect_type(desc, "character") - expect_match(desc, "Delegate a complex task") + expect_match(desc, "Delegate a task") expect_match(desc, "subagent") }) @@ -281,7 +281,7 @@ test_that("btw_tool_subagent is registered in btw_tools", { # Check properties expect_equal(subagent_tool@name, "btw_tool_subagent") expect_type(subagent_tool@description, "character") - expect_match(subagent_tool@description, "Delegate a complex task") + expect_match(subagent_tool@description, "Delegate a task") # Check it has arguments expect_true(length(subagent_tool@arguments) > 0) From 25492da2d5ab28b78f222a2455ef6d8e2de12d2c Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 09:11:47 -0500 Subject: [PATCH 03/44] drop max_turns --- R/tool-subagent.R | 18 +++++------------- tests/testthat/test-tool-subagent.R | 5 ++--- 2 files changed, 7 insertions(+), 16 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 6cb58dc1..32936ddb 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -38,12 +38,10 @@ btw_tool_subagent <- function( btw_tool_subagent_impl <- function( prompt, tools = NULL, - session_id = NULL, - max_turns = getOption("btw.subagent.max_turns", 10) + session_id = NULL ) { check_string(prompt) check_string(session_id, allow_null = TRUE) - check_number_whole(max_turns, min = 1, allow_infinite = FALSE) # Resume existing session or create new one if (!is.null(session_id)) { @@ -59,13 +57,8 @@ btw_tool_subagent_impl <- function( chat <- session$chat - # Warn if approaching max turns - if (session$turns >= max_turns) { - cli::cli_warn(c( - "Session {.val {session_id}} has reached {session$turns} turns (threshold: {max_turns}).", - "i" = "Consider starting a new session or increasing {.code btw.subagent.max_turns}." - )) - } + # TODO: Add turn limit tracking. Currently we can't limit turns within a subagent + # because the chat$chat() method doesn't expose turn count control. } else { session_id <- generate_session_id() chat <- btw_subagent_client_config(client = NULL, tools = tools) @@ -102,8 +95,7 @@ btw_tool_subagent_impl <- function( session_id = session_id, extra = list( data = list( - chat = chat, - turns = retrieve_session(session_id)$turns + chat = chat ) ) ) @@ -343,7 +335,7 @@ retrieve_session <- function(session_id) { #' Returns a list with information about all currently active subagent #' sessions. Useful for debugging and monitoring. #' -#' @return A list of sessions with: id, chat, created, last_used, turns +#' @return A list of sessions with: id, chat, created #' #' @noRd list_subagent_sessions <- function() { diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-subagent.R index 96d89c00..44fb1375 100644 --- a/tests/testthat/test-tool-subagent.R +++ b/tests/testthat/test-tool-subagent.R @@ -64,10 +64,9 @@ test_that("store_session() and retrieve_session() work", { expect_equal(session$id, session_id) expect_equal(session$chat, chat) expect_s3_class(session$created, "POSIXct") - - # Initial session should NOT have last_used or turns fields + + # Initial session should NOT have last_used field expect_null(session$last_used) - expect_null(session$turns) # Clean up clear_all_subagent_sessions() From f4d2048666de5731d1f0cbbc74b92a265faeb8f8 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 09:27:34 -0500 Subject: [PATCH 04/44] docs: add user-facing docs --- R/tool-subagent.R | 224 ++++++++++++++++++++++------ tests/testthat/test-tool-subagent.R | 65 +------- 2 files changed, 179 insertions(+), 110 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 32936ddb..9aa88439 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -1,10 +1,3 @@ -# Subagent Tool Implementation -# -# This file implements the btw_tool_subagent() tool that enables hierarchical -# agent workflows by allowing an orchestrating LLM agent to delegate tasks to -# specialized subagents with their own LLM chat sessions. - -# Result class for subagent tool BtwSubagentResult <- S7::new_class( "BtwSubagentResult", parent = BtwToolResult, @@ -13,19 +6,112 @@ BtwSubagentResult <- S7::new_class( ) ) -#' User-facing subagent tool function +#' Tool: Subagent +#' +#' @description +#' `btw_tool_subagent()` is a btw tool that enables hierarchical agent +#' workflows. When used by an LLM assistant (like Claude), this tool allows the +#' orchestrating agent to delegate complex tasks to specialized subagents, each +#' with their own isolated conversation thread and tool access. +#' +#' This function is primarily intended to be called by LLM assistants via tool +#' use, not directly by end users. However, it can be useful for testing and +#' debugging hierarchical workflows in R. +#' +#' ## How Subagents Work +#' +#' When an LLM calls this tool: +#' +#' 1. A new chat session is created (or an existing one is resumed) +#' 2. The subagent receives the `prompt` and begins working with only the tools +#' specified in the `tools` parameter +#' 3. The subagent works independently, making tool calls until it completes +#' the task +#' 4. The function returns the subagent's final message text and a `session_id` +#' 5. The orchestrating agent can resume the session later by providing the +#' `session_id` +#' +#' Each subagent maintains its own conversation context, separate from the +#' orchestrating agent's context. Subagent sessions persist for the duration of +#' the R session. +#' +#' ## Tool Access +#' +#' The orchestrating agent must specify which tools the subagent can use via +#' the `tools` parameter. The subagent is restricted to only these tools - it +#' cannot access tools from the parent session. Tools can be specified by: +#' +#' * **Specific tool names**: `c("btw_tool_files_read_text_file", +#' "btw_tool_files_write_text_file")` +#' * **Tool groups**: `"files"` includes all file-related tools +#' * **NULL** (default): Uses the default tool set from options or +#' `btw_tools()` +#' +#' ## Configuration Options #' -#' This is a stub function for documentation purposes. The actual implementation -#' is in btw_tool_subagent_impl(). +#' Subagent behavior can be configured via R options: #' -#' @param prompt Character string with the task or question for the subagent -#' @param tools Optional character vector of tool names to make available to -#' the subagent -#' @param session_id Optional session ID from a previous call to resume that -#' conversation -#' @param _intent Intent parameter added by ellmer framework -#' @return A BtwSubagentResult object +#' * `btw.subagent.client`: The ellmer::Chat client or `provider/model` string +#' to use for subagents. If not set, falls back to `btw.client`, then to the +#' default Anthropic client. #' +#' * `btw.subagent.tools`: Default tools to make available to subagents. If not +#' set, falls back to `btw.tools`, then to all btw tools from `btw_tools()`. +#' +#' These options follow the precedence: function argument > `btw.subagent.*` +#' option > `btw.*` option > default value. +#' +#' @examples +#' \dontrun{ +#' # Typically used by LLMs via tool use, but can be called directly for testing +#' result <- btw_tool_subagent( +#' prompt = "List all R files in the current directory", +#' tools = c("btw_tool_files_list_files") +#' ) +#' +#' # Access the subagent's response and session ID +#' cat(result@value) +#' session_id <- result@session_id +#' +#' # Resume the same session with a follow-up +#' result2 <- btw_tool_subagent( +#' prompt = "Now read the first file you found", +#' tools = c("btw_tool_files_read_text_file"), +#' session_id = session_id +#' ) +#' +#' # Configure the subagent client via options +#' withr::local_options(list( +#' btw.subagent.client = "anthropic/claude-sonnet-4-20250514", +#' btw.subagent.tools = "files" # Default to file tools only +#' )) +#' +#' result3 <- btw_tool_subagent( +#' prompt = "Find all TODO comments in R files" +#' ) +#' } +#' +#' @param prompt Character string with the task description for the subagent. +#' The subagent will work on this task using only the tools specified in +#' `tools`. The subagent does not have access to the orchestrating agent's +#' conversation history. +#' @param tools Optional character vector of tool names or tool groups that the +#' subagent is allowed to use. Can be specific tool names (e.g., +#' `"btw_tool_files_read_text_file"`), tool group names (e.g., `"files"`), or +#' `NULL` to use the default tools from `btw.subagent.tools` or `btw_tools()`. +#' @param session_id Optional character string with a session ID from a +#' previous call. When provided, resumes the existing subagent conversation +#' instead of starting a new one. Session IDs are returned in the result and +#' have the format "adjective_noun" (e.g., "swift_falcon"). +#' @param _intent Optional string describing the intent of the tool call. Added +#' automatically by the ellmer framework when tools are called by LLMs. +#' +#' @return A `BtwSubagentResult` object (inherits from `BtwToolResult`) with: +#' * `value`: The final message text from the subagent +#' * `session_id`: The session identifier for resuming this conversation +#' +#' @seealso [btw_tools()] for available tools and tool groups +#' @family agent tools #' @export btw_tool_subagent <- function( prompt, @@ -43,7 +129,6 @@ btw_tool_subagent_impl <- function( check_string(prompt) check_string(session_id, allow_null = TRUE) - # Resume existing session or create new one if (!is.null(session_id)) { session <- retrieve_session(session_id) @@ -62,20 +147,15 @@ btw_tool_subagent_impl <- function( } else { session_id <- generate_session_id() chat <- btw_subagent_client_config(client = NULL, tools = tools) - - # Store new session store_session(session_id, chat) } - # Send prompt to subagent response <- chat$chat(prompt) - # Extract final message text last_turn <- chat$last_turn() message_text <- if (is.null(last_turn) || length(last_turn@contents) == 0) { "" } else { - # Get text content from the last assistant message text_contents <- keep( last_turn@contents, function(x) S7::S7_inherits(x, ellmer::ContentText) @@ -89,7 +169,6 @@ btw_tool_subagent_impl <- function( # We could update session metadata here, but `chat` is stateful - # Return result BtwSubagentResult( value = message_text, session_id = session_id, @@ -113,7 +192,6 @@ btw_tool_subagent_impl <- function( #' #' @noRd btw_subagent_client_config <- function(client = NULL, tools = NULL) { - # Configure tools configured_tools <- tools %||% getOption("btw.subagent.tools") %||% @@ -122,8 +200,6 @@ btw_subagent_client_config <- function(client = NULL, tools = NULL) { configured_tools <- flatten_and_check_tools(configured_tools) - # Configure client - # Priority: argument > btw.subagent.client > btw.client > default chat <- if (!is.null(client)) { as_ellmer_client(client)$clone() } else if (!is.null(subagent_client <- getOption("btw.subagent.client"))) { @@ -134,7 +210,6 @@ btw_subagent_client_config <- function(client = NULL, tools = NULL) { btw_default_chat_client() } - # Set system prompt and tools system_prompt <- btw_prompt("btw-subagent.md") chat$set_system_prompt(system_prompt) chat$set_tools(configured_tools) @@ -228,33 +303,84 @@ BEST PRACTICES: } ) -# ----- Subagent session management ----- -# Subagent Session Management -# -# This file implements session storage and word-based ID generation for -# hierarchical agent workflows. Subagent sessions persist for the duration -# of the R session and are automatically cleaned up when the session ends. - -# Module-level environment for storing subagent chat sessions .btw_subagent_sessions <- new.env(parent = emptyenv()) -# Word lists for generating human-readable session IDs -# fmt: skip .btw_adjectives <- c( - "agile", "bold", "bright", "calm", "clever", "daring", "eager", "elegant", - "fair", "fierce", "gentle", "happy", "jolly", "keen", "lively", "merry", - "nimble", "noble", "placid", "quick", "quiet", "rapid", "serene", "shy", - "silent", "smooth", "stable", "steady", "swift", "tranquil", "valiant", - "vibrant", "vigilant", "vivid", "warm", "wise", "witty", "zealous" + "agile", + "bold", + "bright", + "calm", + "clever", + "daring", + "eager", + "elegant", + "fair", + "fierce", + "gentle", + "happy", + "jolly", + "keen", + "lively", + "merry", + "nimble", + "noble", + "placid", + "quick", + "quiet", + "rapid", + "serene", + "shy", + "silent", + "smooth", + "stable", + "steady", + "swift", + "tranquil", + "valiant", + "vibrant", + "vigilant", + "vivid", + "warm", + "wise", + "witty", + "zealous" ) -# fmt: skip .btw_nouns <- c( - "aardvark", "badger", "beaver", "cheetah", "dolphin", "eagle", "falcon", - "gazelle", "hawk", "jaguar", "kangaroo", "leopard", "lynx", "meerkat", - "otter", "panther", "penguin", "puffin", "rabbit", "raven", "salmon", - "sparrow", "squirrel", "starling", "swift", "tiger", "turtle", "viper", - "walrus", "weasel", "whale", "wolf", "wombat", "zebra" + "aardvark", + "badger", + "beaver", + "cheetah", + "dolphin", + "eagle", + "falcon", + "gazelle", + "hawk", + "jaguar", + "kangaroo", + "leopard", + "lynx", + "meerkat", + "otter", + "panther", + "penguin", + "puffin", + "rabbit", + "raven", + "salmon", + "sparrow", + "squirrel", + "starling", + "swift", + "tiger", + "turtle", + "viper", + "walrus", + "weasel", + "whale", + "wolf", + "wombat", + "zebra" ) #' Generate a word-based session ID diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-subagent.R index 44fb1375..f128c21b 100644 --- a/tests/testthat/test-tool-subagent.R +++ b/tests/testthat/test-tool-subagent.R @@ -1,6 +1,3 @@ -# Tests for subagent tool and session management - -# Helper to create a mock Chat object for testing mock_chat <- function() { structure( list( @@ -12,63 +9,46 @@ mock_chat <- function() { ) } -# ---- Session ID Generation ---- - test_that("generate_session_id() creates valid IDs", { id1 <- generate_session_id() id2 <- generate_session_id() - # Check format: word_word (underscore separator) expect_match(id1, "^[a-z]+_[a-z]+$") expect_match(id2, "^[a-z]+_[a-z]+$") - # IDs should be different (probabilistically) - # This could fail occasionally but very unlikely + # IDs should be different (probabilistically, could fail occasionally but unlikely) ids <- replicate(10, generate_session_id()) expect_true(length(unique(ids)) > 5) }) test_that("generate_session_id() checks for uniqueness", { - # Clear any existing sessions clear_all_subagent_sessions() - # Generate first ID id1 <- generate_session_id() - - # Store a session with this ID store_session(id1, mock_chat()) - # Generate more IDs - they should all be different from id1 ids <- replicate(20, generate_session_id()) expect_false(id1 %in% ids) - # Clean up clear_all_subagent_sessions() }) -# ---- Session Storage and Retrieval ---- - test_that("store_session() and retrieve_session() work", { clear_all_subagent_sessions() session_id <- "test_session" chat <- mock_chat() - # Store session result <- store_session(session_id, chat) expect_equal(result, session_id) - # Retrieve session session <- retrieve_session(session_id) expect_type(session, "list") expect_equal(session$id, session_id) expect_equal(session$chat, chat) expect_s3_class(session$created, "POSIXct") - - # Initial session should NOT have last_used field expect_null(session$last_used) - # Clean up clear_all_subagent_sessions() }) @@ -100,8 +80,6 @@ test_that("store_session() can include metadata", { clear_all_subagent_sessions() }) -# ---- Session Listing ---- - test_that("list_subagent_sessions() works with no sessions", { clear_all_subagent_sessions() @@ -113,7 +91,6 @@ test_that("list_subagent_sessions() works with no sessions", { test_that("list_subagent_sessions() lists all sessions", { clear_all_subagent_sessions() - # Create multiple sessions store_session("session_1", mock_chat()) store_session("session_2", mock_chat()) store_session("session_3", mock_chat()) @@ -121,14 +98,12 @@ test_that("list_subagent_sessions() lists all sessions", { result <- list_subagent_sessions() expect_type(result, "list") expect_equal(length(result), 3) - - # Check that session IDs are present + session_ids <- names(result) expect_true("session_1" %in% session_ids) expect_true("session_2" %in% session_ids) expect_true("session_3" %in% session_ids) - - # Each session should be a list with expected fields + expect_equal(result$session_1$id, "session_1") expect_equal(result$session_2$id, "session_2") expect_equal(result$session_3$id, "session_3") @@ -136,22 +111,17 @@ test_that("list_subagent_sessions() lists all sessions", { clear_all_subagent_sessions() }) -# ---- Session Clearing ---- - test_that("clear_subagent_session() removes a session", { clear_all_subagent_sessions() session_id <- "test_clear" store_session(session_id, mock_chat()) - # Verify it exists expect_false(is.null(retrieve_session(session_id))) - # Clear it result <- clear_subagent_session(session_id) expect_true(result) - # Verify it's gone expect_null(retrieve_session(session_id)) }) @@ -164,19 +134,15 @@ test_that("clear_subagent_session() returns FALSE for nonexistent session", { test_that("clear_all_subagent_sessions() clears all sessions", { clear_all_subagent_sessions() - # Create multiple sessions store_session("session_1", mock_chat()) store_session("session_2", mock_chat()) store_session("session_3", mock_chat()) - # Verify they exist expect_equal(length(list_subagent_sessions()), 3) - # Clear all count <- clear_all_subagent_sessions() expect_equal(count, 3) - # Verify they're all gone expect_equal(length(list_subagent_sessions()), 0) }) @@ -186,8 +152,6 @@ test_that("clear_all_subagent_sessions() returns 0 when no sessions", { expect_equal(count, 0) }) -# ---- Client Configuration ---- - test_that("btw_subagent_client_config() uses default tools", { withr::local_options( btw.subagent.tools = NULL, @@ -197,23 +161,19 @@ test_that("btw_subagent_client_config() uses default tools", { chat <- btw_subagent_client_config() expect_true(inherits(chat, "Chat")) - # Chat should have tools configured expect_true(length(chat$get_tools()) > 0) }) test_that("btw_subagent_client_config() respects tool filtering", { - # Test with character vector chat <- btw_subagent_client_config(tools = c("docs")) expect_true(inherits(chat, "Chat")) - # Should have some docs tools expect_true(length(chat$get_tools()) > 0) }) test_that("btw_subagent_client_config() follows client precedence", { skip_if_not_installed("ellmer") - # Test option precedence withr::local_options( btw.subagent.client = "anthropic/claude-sonnet-4-20250514", btw.client = "anthropic/claude-opus-4-20241120" @@ -222,7 +182,6 @@ test_that("btw_subagent_client_config() follows client precedence", { chat <- btw_subagent_client_config() expect_true(inherits(chat, "Chat")) - # Test argument precedence chat_obj <- ellmer::chat_anthropic() chat2 <- btw_subagent_client_config(client = chat_obj) expect_identical(chat2, chat_obj) @@ -238,24 +197,17 @@ test_that("btw_subagent_client_config() clones clients from options", { chat1 <- btw_subagent_client_config() chat2 <- btw_subagent_client_config() - # Should be different objects (cloned) expect_false(identical(chat1, chat2)) expect_false(identical(chat1, chat_obj)) }) -# ---- Tool Description ---- - test_that("build_subagent_description() includes tool groups", { desc <- build_subagent_description() expect_type(desc, "character") expect_match(desc, "Delegate a task") expect_match(desc, "Available tool groups") - - # Should mention at least one tool group (e.g., docs, env, etc.) - expect_true( - any(grepl("docs|env|search|github", desc)) - ) + expect_true(any(grepl("docs|env|search|github", desc))) }) test_that("build_subagent_description() includes basic text", { @@ -266,28 +218,20 @@ test_that("build_subagent_description() includes basic text", { expect_match(desc, "subagent") }) -# ---- Tool Registration ---- - test_that("btw_tool_subagent is registered in btw_tools", { all_tools <- btw_tools() tool_names <- sapply(all_tools, function(t) t@name) expect_true("btw_tool_subagent" %in% tool_names) - # Get the specific tool subagent_tool <- all_tools[[which(tool_names == "btw_tool_subagent")]] - # Check properties expect_equal(subagent_tool@name, "btw_tool_subagent") expect_type(subagent_tool@description, "character") expect_match(subagent_tool@description, "Delegate a task") - - # Check it has arguments expect_true(length(subagent_tool@arguments) > 0) }) -# ---- BtwSubagentResult Class ---- - test_that("BtwSubagentResult inherits from BtwToolResult", { result <- BtwSubagentResult( value = "test response", @@ -295,7 +239,6 @@ test_that("BtwSubagentResult inherits from BtwToolResult", { extra = list() ) - # Check S7 class hierarchy expect_true(S7::S7_inherits(result, BtwSubagentResult)) expect_true(S7::S7_inherits(result, BtwToolResult)) expect_equal(result@value, "test response") From 2a726d93f413dd275b7338784dc44b75da1e14e2 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 09:58:39 -0500 Subject: [PATCH 05/44] expand tool options for default and allowed --- R/tool-subagent.R | 80 ++++++++++-- man/btw_tool_subagent.Rd | 151 +++++++++++++++++++++-- man/btw_tools.Rd | 2 +- tests/testthat/test-tool-subagent.R | 184 +++++++++++++++++++++++++++- 4 files changed, 398 insertions(+), 19 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 9aa88439..b77a1087 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -55,11 +55,22 @@ BtwSubagentResult <- S7::new_class( #' to use for subagents. If not set, falls back to `btw.client`, then to the #' default Anthropic client. #' -#' * `btw.subagent.tools`: Default tools to make available to subagents. If not -#' set, falls back to `btw.tools`, then to all btw tools from `btw_tools()`. +#' * `btw.subagent.tools_default`: Default tools to provide to subagents when +#' the orchestrating agent doesn't specify tools via the `tools` parameter. +#' If not set, falls back to `btw.tools`, then all btw tools from +#' `btw_tools()`. This is a convenience option for setting reasonable +#' defaults. +#' +#' * `btw.subagent.tools_allowed`: An allowlist of tools that subagents are +#' allowed to use at all. When set, any tools requested (either explicitly via +#' the `tools` parameter or from defaults) will be filtered against this list. +#' If disallowed tools are requested, an error is thrown. This provides a +#' security boundary to restrict subagent capabilities. If not set, all +#' [btw_tools()] are allowed. #' #' These options follow the precedence: function argument > `btw.subagent.*` -#' option > `btw.*` option > default value. +#' option > `btw.*` option > default value. The `tools_allowed` option acts as a +#' filter on top of the resolved tools, regardless of their source. #' #' @examples #' \dontrun{ @@ -80,15 +91,36 @@ BtwSubagentResult <- S7::new_class( #' session_id = session_id #' ) #' -#' # Configure the subagent client via options +#' # Configure default tools for subagents #' withr::local_options(list( #' btw.subagent.client = "anthropic/claude-sonnet-4-20250514", -#' btw.subagent.tools = "files" # Default to file tools only +#' btw.subagent.tools_default = "files" # Default to file tools only #' )) #' #' result3 <- btw_tool_subagent( #' prompt = "Find all TODO comments in R files" #' ) +#' +#' # Restrict subagents to a whitelist of allowed tools +#' withr::local_options(list( +#' btw.subagent.tools_allowed = c("files", "search"), +#' btw.subagent.tools_default = "files" +#' )) +#' +#' # This works - files tools are allowed +#' result4 <- btw_tool_subagent( +#' prompt = "List R files", +#' tools = "files" +#' ) +#' +#' # This would error - github tools are not in the allowed list +#' tryCatch( +#' btw_tool_subagent( +#' prompt = "Create a GitHub issue", +#' tools = "github" +#' ), +#' error = function(e) message("Error: ", e$message) +#' ) #' } #' #' @param prompt Character string with the task description for the subagent. @@ -98,7 +130,8 @@ BtwSubagentResult <- S7::new_class( #' @param tools Optional character vector of tool names or tool groups that the #' subagent is allowed to use. Can be specific tool names (e.g., #' `"btw_tool_files_read_text_file"`), tool group names (e.g., `"files"`), or -#' `NULL` to use the default tools from `btw.subagent.tools` or `btw_tools()`. +#' `NULL` to use the default tools from `btw.subagent.tools_default`, +#' `btw.tools`, or `btw_tools()`. #' @param session_id Optional character string with a session ID from a #' previous call. When provided, resumes the existing subagent conversation #' instead of starting a new one. Session IDs are returned in the result and @@ -192,14 +225,47 @@ btw_tool_subagent_impl <- function( #' #' @noRd btw_subagent_client_config <- function(client = NULL, tools = NULL) { + # Track whether tools were explicitly provided + tools_explicit <- !is.null(tools) + + # Determine the tools to use (applying defaults) configured_tools <- tools %||% - getOption("btw.subagent.tools") %||% + getOption("btw.subagent.tools_default") %||% getOption("btw.tools") %||% btw_tools() configured_tools <- flatten_and_check_tools(configured_tools) + # Apply tools_allowed whitelist if set + tools_allowed <- getOption("btw.subagent.tools_allowed") + if (!is.null(tools_allowed)) { + # Convert tools_allowed to a flat list of tool names + allowed_tools <- flatten_and_check_tools(tools_allowed) + allowed_names <- map_chr(allowed_tools, function(t) t@name) + + # Get names of configured tools + configured_names <- map_chr(configured_tools, function(t) t@name) + + # Check if any requested tools are not allowed + disallowed <- setdiff(configured_names, allowed_names) + + # Only error if tools were explicitly provided and include disallowed tools + if (length(disallowed) > 0 && tools_explicit) { + cli::cli_abort(c( + "Subagent requested disallowed tools.", + "x" = "The following tools are not in {.code btw.subagent.tools_allowed}: {.val {disallowed}}", + "i" = "Allowed tools: {.val {allowed_names}}", + "i" = "Set {.code options(btw.subagent.tools_allowed = NULL)} to remove restrictions." + )) + } + + # Filter to only allowed tools + configured_tools <- keep(configured_tools, function(t) { + t@name %in% allowed_names + }) + } + chat <- if (!is.null(client)) { as_ellmer_client(client)$clone() } else if (!is.null(subagent_client <- getOption("btw.subagent.client"))) { diff --git a/man/btw_tool_subagent.Rd b/man/btw_tool_subagent.Rd index 2118973d..0e5f39ca 100644 --- a/man/btw_tool_subagent.Rd +++ b/man/btw_tool_subagent.Rd @@ -2,25 +2,156 @@ % Please edit documentation in R/tool-subagent.R \name{btw_tool_subagent} \alias{btw_tool_subagent} -\title{User-facing subagent tool function} +\title{Tool: Subagent} \usage{ btw_tool_subagent(prompt, tools = NULL, session_id = NULL, `_intent` = "") } \arguments{ -\item{prompt}{Character string with the task or question for the subagent} +\item{prompt}{Character string with the task description for the subagent. +The subagent will work on this task using only the tools specified in +\code{tools}. The subagent does not have access to the orchestrating agent's +conversation history.} -\item{tools}{Optional character vector of tool names to make available to -the subagent} +\item{tools}{Optional character vector of tool names or tool groups that the +subagent is allowed to use. Can be specific tool names (e.g., +\code{"btw_tool_files_read_text_file"}), tool group names (e.g., \code{"files"}), or +\code{NULL} to use the default tools from \code{btw.subagent.tools_default}, +\code{btw.tools}, or \code{btw_tools()}.} -\item{session_id}{Optional session ID from a previous call to resume that -conversation} +\item{session_id}{Optional character string with a session ID from a +previous call. When provided, resumes the existing subagent conversation +instead of starting a new one. Session IDs are returned in the result and +have the format "adjective_noun" (e.g., "swift_falcon").} -\item{_intent}{Intent parameter added by ellmer framework} +\item{_intent}{Optional string describing the intent of the tool call. Added +automatically by the ellmer framework when tools are called by LLMs.} } \value{ -A BtwSubagentResult object +A \code{BtwSubagentResult} object (inherits from \code{BtwToolResult}) with: +\itemize{ +\item \code{value}: The final message text from the subagent +\item \code{session_id}: The session identifier for resuming this conversation +} } \description{ -This is a stub function for documentation purposes. The actual implementation -is in btw_tool_subagent_impl(). +\code{btw_tool_subagent()} is a btw tool that enables hierarchical agent +workflows. When used by an LLM assistant (like Claude), this tool allows the +orchestrating agent to delegate complex tasks to specialized subagents, each +with their own isolated conversation thread and tool access. + +This function is primarily intended to be called by LLM assistants via tool +use, not directly by end users. However, it can be useful for testing and +debugging hierarchical workflows in R. +\subsection{How Subagents Work}{ + +When an LLM calls this tool: +\enumerate{ +\item A new chat session is created (or an existing one is resumed) +\item The subagent receives the \code{prompt} and begins working with only the tools +specified in the \code{tools} parameter +\item The subagent works independently, making tool calls until it completes +the task +\item The function returns the subagent's final message text and a \code{session_id} +\item The orchestrating agent can resume the session later by providing the +\code{session_id} +} + +Each subagent maintains its own conversation context, separate from the +orchestrating agent's context. Subagent sessions persist for the duration of +the R session. +} + +\subsection{Tool Access}{ + +The orchestrating agent must specify which tools the subagent can use via +the \code{tools} parameter. The subagent is restricted to only these tools - it +cannot access tools from the parent session. Tools can be specified by: +\itemize{ +\item \strong{Specific tool names}: \code{c("btw_tool_files_read_text_file", "btw_tool_files_write_text_file")} +\item \strong{Tool groups}: \code{"files"} includes all file-related tools +\item \strong{NULL} (default): Uses the default tool set from options or +\code{btw_tools()} +} +} + +\subsection{Configuration Options}{ + +Subagent behavior can be configured via R options: +\itemize{ +\item \code{btw.subagent.client}: The ellmer::Chat client or \code{provider/model} string +to use for subagents. If not set, falls back to \code{btw.client}, then to the +default Anthropic client. +\item \code{btw.subagent.tools_default}: Default tools to provide to subagents when +the orchestrating agent doesn't specify tools via the \code{tools} parameter. +If not set, falls back to \code{btw.tools}, then all btw tools from +\code{btw_tools()}. This is a convenience option for setting reasonable +defaults. +\item \code{btw.subagent.tools_allowed}: An allowlist of tools that subagents are +allowed to use at all. When set, any tools requested (either explicitly via +the \code{tools} parameter or from defaults) will be filtered against this list. +If disallowed tools are requested, an error is thrown. This provides a +security boundary to restrict subagent capabilities. If not set, all +\code{\link[=btw_tools]{btw_tools()}} are allowed. +} + +These options follow the precedence: function argument > \verb{btw.subagent.*} +option > \verb{btw.*} option > default value. The \code{tools_allowed} option acts as a +filter on top of the resolved tools, regardless of their source. +} +} +\examples{ +\dontrun{ +# Typically used by LLMs via tool use, but can be called directly for testing +result <- btw_tool_subagent( + prompt = "List all R files in the current directory", + tools = c("btw_tool_files_list_files") +) + +# Access the subagent's response and session ID +cat(result@value) +session_id <- result@session_id + +# Resume the same session with a follow-up +result2 <- btw_tool_subagent( + prompt = "Now read the first file you found", + tools = c("btw_tool_files_read_text_file"), + session_id = session_id +) + +# Configure default tools for subagents +withr::local_options(list( + btw.subagent.client = "anthropic/claude-sonnet-4-20250514", + btw.subagent.tools_default = "files" # Default to file tools only +)) + +result3 <- btw_tool_subagent( + prompt = "Find all TODO comments in R files" +) + +# Restrict subagents to a whitelist of allowed tools +withr::local_options(list( + btw.subagent.tools_allowed = c("files", "search"), + btw.subagent.tools_default = "files" +)) + +# This works - files tools are allowed +result4 <- btw_tool_subagent( + prompt = "List R files", + tools = "files" +) + +# This would error - github tools are not in the allowed list +tryCatch( + btw_tool_subagent( + prompt = "Create a GitHub issue", + tools = "github" + ), + error = function(e) message("Error: ", e$message) +) +} + +} +\seealso{ +\code{\link[=btw_tools]{btw_tools()}} for available tools and tool groups } +\concept{agent tools} diff --git a/man/btw_tools.Rd b/man/btw_tools.Rd index 38c7bbf6..257d456b 100644 --- a/man/btw_tools.Rd +++ b/man/btw_tools.Rd @@ -32,7 +32,7 @@ interface with your computational environment. Chats returned by this function have access to the tools: \subsection{Group: agent}{\tabular{ll}{ Name \tab Description \cr - \code{\link[=btw_tool_subagent]{btw_tool_subagent()}} \tab Delegate a complex task to a specialized subagent with its own LLM chat session. \cr + \code{\link[=btw_tool_subagent]{btw_tool_subagent()}} \tab Delegate a task to a specialized assistant that can work independently with its own conversation thread. \cr } } diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-subagent.R index f128c21b..0b8799a1 100644 --- a/tests/testthat/test-tool-subagent.R +++ b/tests/testthat/test-tool-subagent.R @@ -154,7 +154,7 @@ test_that("clear_all_subagent_sessions() returns 0 when no sessions", { test_that("btw_subagent_client_config() uses default tools", { withr::local_options( - btw.subagent.tools = NULL, + btw.subagent.tools_default = NULL, btw.tools = NULL ) @@ -244,3 +244,185 @@ test_that("BtwSubagentResult inherits from BtwToolResult", { expect_equal(result@value, "test response") expect_equal(result@session_id, "test_id") }) + +# Tests for new btw.subagent.tools_default and btw.subagent.tools_allowed options + +test_that("btw_subagent_client_config() uses tools_default when tools is NULL", { + withr::local_options( + btw.subagent.tools_default = c("docs"), + btw.tools = NULL + ) + + chat <- btw_subagent_client_config(tools = NULL) + + expect_true(inherits(chat, "Chat")) + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_docs_", tool_names))) +}) + +test_that("btw_subagent_client_config() falls back through precedence chain", { + # Test fallback: tools_default -> btw.tools -> btw_tools() + + # Test fallback to btw.tools + withr::local_options( + btw.subagent.tools_default = NULL, + btw.tools = c("search") + ) + + chat <- btw_subagent_client_config(tools = NULL) + + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_search_", tool_names))) + + # Test fallback to btw_tools() + withr::local_options( + btw.subagent.tools_default = NULL, + btw.tools = NULL + ) + + chat2 <- btw_subagent_client_config(tools = NULL) + + tool_names2 <- sapply(chat2$get_tools(), function(t) t@name) + expect_true(length(tool_names2) > 0) # Should get all btw_tools() +}) + +test_that("btw_subagent_client_config() filters tools with tools_allowed", { + withr::local_options( + btw.subagent.tools_allowed = c("docs"), + btw.subagent.tools_default = c("docs", "files") + ) + + chat <- btw_subagent_client_config(tools = NULL) + + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_docs_", tool_names))) + expect_false(any(grepl("^btw_tool_files_", tool_names))) +}) + +test_that("btw_subagent_client_config() errors on disallowed tools", { + withr::local_options( + btw.subagent.tools_allowed = c("docs") + ) + + expect_error( + btw_subagent_client_config(tools = c("files")), + "Subagent requested disallowed tools" + ) + + expect_error( + btw_subagent_client_config(tools = c("files")), + "btw.subagent.tools_allowed" + ) +}) + +test_that("btw_subagent_client_config() allows tools within whitelist", { + withr::local_options( + btw.subagent.tools_allowed = c("docs", "files") + ) + + # Should not error + chat <- btw_subagent_client_config(tools = c("docs")) + + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_docs_", tool_names))) +}) + +test_that("btw_subagent_client_config() filters explicit tools against tools_allowed", { + withr::local_options( + btw.subagent.tools_allowed = c("docs", "search") + ) + + # Requesting tools partially in whitelist should error + expect_error( + btw_subagent_client_config(tools = c("docs", "files")), + "disallowed tools" + ) + + # Requesting only allowed tools should work + chat <- btw_subagent_client_config(tools = c("docs", "search")) + + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true(any(grepl("^btw_tool_docs_", tool_names))) + expect_true(any(grepl("^btw_tool_search_", tool_names))) +}) + +test_that("btw_subagent_client_config() works without tools_allowed set", { + withr::local_options( + btw.subagent.tools_allowed = NULL, + btw.subagent.tools_default = c("files") + ) + + # Should work with any tools when tools_allowed is NULL + chat <- btw_subagent_client_config(tools = c("docs")) + + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_docs_", tool_names))) +}) + +test_that("btw_subagent_client_config() precedence: explicit tools > tools_default", { + withr::local_options( + btw.subagent.tools_default = c("docs"), + btw.subagent.tools_allowed = c("docs", "files") + ) + + # Explicit tools argument should override tools_default + chat <- btw_subagent_client_config(tools = c("files")) + + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_files_", tool_names))) + expect_false(any(grepl("^btw_tool_docs_", tool_names))) +}) + +test_that("btw_subagent_client_config() tools_allowed filters defaults", { + withr::local_options( + btw.subagent.tools_allowed = c("docs"), + btw.subagent.tools_default = c("docs", "files", "search") + ) + + chat <- btw_subagent_client_config(tools = NULL) + + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_docs_", tool_names))) + expect_false(any(grepl("^btw_tool_files_", tool_names))) + expect_false(any(grepl("^btw_tool_search_", tool_names))) +}) + +test_that("btw_subagent_client_config() error message is helpful", { + withr::local_options( + btw.subagent.tools_allowed = c("docs") + ) + + expect_error( + btw_subagent_client_config(tools = c("files", "github")), + "btw_tool_files_" + ) + + expect_error( + btw_subagent_client_config(tools = c("files", "github")), + "btw_tool_github" + ) + + expect_error( + btw_subagent_client_config(tools = c("files")), + "Set.*btw.subagent.tools_allowed = NULL" + ) +}) + +test_that("btw_subagent_client_config() tools_allowed works with specific tool names", { + withr::local_options( + btw.subagent.tools_allowed = c("btw_tool_docs_help_page", "btw_tool_files_read_text_file") + ) + + # Should work with specific allowed tools + chat <- btw_subagent_client_config(tools = c("btw_tool_docs_help_page")) + + tool_names <- sapply(chat$get_tools(), function(t) t@name) + expect_true("btw_tool_docs_help_page" %in% tool_names) + expect_equal(length(tool_names), 1) + + # Should error with disallowed specific tool + expect_error( + btw_subagent_client_config(tools = c("search_packages")), + "disallowed tools" + ) +}) From 1fba6d7aafafebfd2dc1c64f7e19b32111f772b0 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 09:59:56 -0500 Subject: [PATCH 06/44] refactor: clean up message code --- R/tool-subagent.R | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index b77a1087..847e522d 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -187,17 +187,9 @@ btw_tool_subagent_impl <- function( last_turn <- chat$last_turn() message_text <- if (is.null(last_turn) || length(last_turn@contents) == 0) { - "" + "(The subagent completed successfully but returned no message.)" } else { - text_contents <- keep( - last_turn@contents, - function(x) S7::S7_inherits(x, ellmer::ContentText) - ) - if (length(text_contents) > 0) { - paste(map_chr(text_contents, function(x) x@text), collapse = "\n\n") - } else { - "" - } + ellmer::contents_markdown(last_turn) } # We could update session metadata here, but `chat` is stateful From 2289da9bd95dd2d4c14c95ae89fef16fdf2fdf1a Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 10:19:19 -0500 Subject: [PATCH 07/44] format tool result and appearance --- R/tool-subagent.R | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 847e522d..7e48abc4 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -191,15 +191,44 @@ btw_tool_subagent_impl <- function( } else { ellmer::contents_markdown(last_turn) } + message_text <- sprintf( + '\n%s\n', + session_id, + message_text + ) # We could update session metadata here, but `chat` is stateful + tokens <- md_table(chat$get_tokens()) + + display_md <- glue_( + r"( + #### Prompt + + **Session ID:** {{ session_id }}
+ **Tools:** {{ paste(names(chat$get_tools()), collapse = ', ') }} + + {{ prompt }} + + #### Tokens + + {{ tokens }} + + #### Response + + {{ message_text }} + )" + ) + BtwSubagentResult( value = message_text, session_id = session_id, extra = list( - data = list( - chat = chat + prompt = prompt, + tokens = chat$get_tokens(), + display = list( + markdown = display_md, + show_request = FALSE ) ) ) From b0a45699f61e98fcbf5c6ca7e6ed369f475c91cb Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 10:51:39 -0500 Subject: [PATCH 08/44] steer toward efficient subagents --- inst/prompts/btw-subagent.md | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/inst/prompts/btw-subagent.md b/inst/prompts/btw-subagent.md index 144b24c8..9aca9e41 100644 --- a/inst/prompts/btw-subagent.md +++ b/inst/prompts/btw-subagent.md @@ -2,7 +2,18 @@ You are completing a focused task. Follow these guidelines to deliver effective results. -## 1. Deliver Complete, Actionable Answers +## 1. Work Efficiently + +Prioritize efficiency while completing your task: + +- **Be decisive**: Make tool calls purposefully and avoid redundant operations +- **Keep responses concise**: Provide clear, actionable results without excessive detail +- **Return early when appropriate**: If you need clarification, lack necessary tools, or have useful partial results, return them promptly +- **The orchestrating agent can help**: It can answer questions, provide context, or ask you to continue + +You should still aim to complete the assigned task, but efficiency matters. A focused partial result that can be refined is often better than an exhaustive but delayed response. + +## 2. Deliver Complete, Actionable Answers Provide your final answer, conclusion, or result directly. Your response is the deliverable. @@ -10,13 +21,14 @@ Provide your final answer, conclusion, or result directly. Your response is the - **Be thorough but focused** on the specific task - **Do not add meta-commentary** about your process or limitations unless directly relevant to the answer -## 2. Use Available Tools Effectively +## 3. Use Available Tools Effectively -- Use the tools provided to complete your task successfully. +- Use the tools provided to complete your task successfully - Tools are specifically selected for this task - Combine information from multiple tool calls when appropriate +- Avoid making excessive tool calls - plan your approach before executing -## 3. Handle Problems Clearly +## 4. Handle Problems Clearly If you cannot complete the task: @@ -24,9 +36,11 @@ If you cannot complete the task: - **State what is missing** (information, capabilities, clarification) - **Provide partial results** if possible and indicate what remains incomplete -## 4. Build on Previous Work +## 5. Build on Previous Work + +When you receive follow-up requests, build on what you've already done: -- When you receive follow-up requests, build on what you've already done. - Reference previous findings naturally - Expand or refine earlier work as requested +- Maintain consistency with prior responses From d55ae0852dff1ff873bed7db92f9f35aef09cbb5 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 14:22:34 -0500 Subject: [PATCH 09/44] docs: tweak description --- R/tool-subagent.R | 10 +++++----- man/btw_tool_subagent.Rd | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 7e48abc4..33e65c91 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -10,13 +10,13 @@ BtwSubagentResult <- S7::new_class( #' #' @description #' `btw_tool_subagent()` is a btw tool that enables hierarchical agent -#' workflows. When used by an LLM assistant (like Claude), this tool allows the -#' orchestrating agent to delegate complex tasks to specialized subagents, each -#' with their own isolated conversation thread and tool access. +#' workflows. When used by an LLM assistant (like [btw_app()], [btw_client()], +#' or third-party tools like Claude Code), this tool allows the orchestrating +#' agent to delegate complex tasks to specialized subagents, each with their own +#' isolated conversation thread and tool access. #' #' This function is primarily intended to be called by LLM assistants via tool -#' use, not directly by end users. However, it can be useful for testing and -#' debugging hierarchical workflows in R. +#' use, not directly by end users. #' #' ## How Subagents Work #' diff --git a/man/btw_tool_subagent.Rd b/man/btw_tool_subagent.Rd index 0e5f39ca..eaf92411 100644 --- a/man/btw_tool_subagent.Rd +++ b/man/btw_tool_subagent.Rd @@ -35,13 +35,13 @@ A \code{BtwSubagentResult} object (inherits from \code{BtwToolResult}) with: } \description{ \code{btw_tool_subagent()} is a btw tool that enables hierarchical agent -workflows. When used by an LLM assistant (like Claude), this tool allows the -orchestrating agent to delegate complex tasks to specialized subagents, each -with their own isolated conversation thread and tool access. +workflows. When used by an LLM assistant (like \code{\link[=btw_app]{btw_app()}}, \code{\link[=btw_client]{btw_client()}}, +or third-party tools like Claude Code), this tool allows the orchestrating +agent to delegate complex tasks to specialized subagents, each with their own +isolated conversation thread and tool access. This function is primarily intended to be called by LLM assistants via tool -use, not directly by end users. However, it can be useful for testing and -debugging hierarchical workflows in R. +use, not directly by end users. \subsection{How Subagents Work}{ When an LLM calls this tool: From b92faecc90682976861e3f17604e1f1696e486ed Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 14:33:02 -0500 Subject: [PATCH 10/44] chore: prevent subagent tool from being included in the subagent --- R/tool-subagent.R | 24 ++++- tests/testthat/test-tool-subagent.R | 159 ++++++++++++++++++++++++++-- 2 files changed, 169 insertions(+), 14 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 33e65c91..6ff7b6f5 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -253,8 +253,13 @@ btw_subagent_client_config <- function(client = NULL, tools = NULL) { configured_tools <- tools %||% getOption("btw.subagent.tools_default") %||% - getOption("btw.tools") %||% - btw_tools() + getOption("btw.tools") + + if (is.null(configured_tools)) { + configured_tools <- keep(btw_tools(), function(t) { + t@name != "btw_tool_subagent" + }) + } configured_tools <- flatten_and_check_tools(configured_tools) @@ -287,6 +292,19 @@ btw_subagent_client_config <- function(client = NULL, tools = NULL) { }) } + # Never allow subagents to create subagents (prevents infinite recursion) + # This filtering happens after all tool resolution and allowed-list filtering + # to ensure the subagent tool is always removed, regardless of how tools were specified + configured_tools <- keep(configured_tools, function(tool) { + if (tool@name != "btw_tool_subagent") { + return(TRUE) + } + cli::cli_warn( + "Removing {.code btw_tool_subagent} from subagent toolset to prevent recursion." + ) + FALSE + }) + chat <- if (!is.null(client)) { as_ellmer_client(client)$clone() } else if (!is.null(subagent_client <- getOption("btw.subagent.client"))) { @@ -313,7 +331,7 @@ btw_subagent_client_config <- function(client = NULL, tools = NULL) { #' @noRd build_subagent_description <- function() { # Get unique tool groups from registered tools - tool_groups <- unique(map_chr(.btw_tools, function(x) x$group)) + tool_groups <- unique(map_chr(btw_tools(), function(x) x$group)) tool_groups <- sort(tool_groups) # Build tool groups summary diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-subagent.R index 0b8799a1..c4317fa9 100644 --- a/tests/testthat/test-tool-subagent.R +++ b/tests/testthat/test-tool-subagent.R @@ -256,7 +256,7 @@ test_that("btw_subagent_client_config() uses tools_default when tools is NULL", chat <- btw_subagent_client_config(tools = NULL) expect_true(inherits(chat, "Chat")) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) }) @@ -271,7 +271,7 @@ test_that("btw_subagent_client_config() falls back through precedence chain", { chat <- btw_subagent_client_config(tools = NULL) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_search_", tool_names))) # Test fallback to btw_tools() @@ -283,7 +283,7 @@ test_that("btw_subagent_client_config() falls back through precedence chain", { chat2 <- btw_subagent_client_config(tools = NULL) tool_names2 <- sapply(chat2$get_tools(), function(t) t@name) - expect_true(length(tool_names2) > 0) # Should get all btw_tools() + expect_true(length(tool_names2) > 0) # Should get all btw_tools() }) test_that("btw_subagent_client_config() filters tools with tools_allowed", { @@ -294,7 +294,7 @@ test_that("btw_subagent_client_config() filters tools with tools_allowed", { chat <- btw_subagent_client_config(tools = NULL) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) expect_false(any(grepl("^btw_tool_files_", tool_names))) }) @@ -323,7 +323,7 @@ test_that("btw_subagent_client_config() allows tools within whitelist", { # Should not error chat <- btw_subagent_client_config(tools = c("docs")) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) }) @@ -341,7 +341,7 @@ test_that("btw_subagent_client_config() filters explicit tools against tools_all # Requesting only allowed tools should work chat <- btw_subagent_client_config(tools = c("docs", "search")) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(any(grepl("^btw_tool_docs_", tool_names))) expect_true(any(grepl("^btw_tool_search_", tool_names))) }) @@ -355,7 +355,7 @@ test_that("btw_subagent_client_config() works without tools_allowed set", { # Should work with any tools when tools_allowed is NULL chat <- btw_subagent_client_config(tools = c("docs")) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) }) @@ -368,7 +368,7 @@ test_that("btw_subagent_client_config() precedence: explicit tools > tools_defau # Explicit tools argument should override tools_default chat <- btw_subagent_client_config(tools = c("files")) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_files_", tool_names))) expect_false(any(grepl("^btw_tool_docs_", tool_names))) }) @@ -381,7 +381,7 @@ test_that("btw_subagent_client_config() tools_allowed filters defaults", { chat <- btw_subagent_client_config(tools = NULL) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) expect_false(any(grepl("^btw_tool_files_", tool_names))) expect_false(any(grepl("^btw_tool_search_", tool_names))) @@ -410,13 +410,16 @@ test_that("btw_subagent_client_config() error message is helpful", { test_that("btw_subagent_client_config() tools_allowed works with specific tool names", { withr::local_options( - btw.subagent.tools_allowed = c("btw_tool_docs_help_page", "btw_tool_files_read_text_file") + btw.subagent.tools_allowed = c( + "btw_tool_docs_help_page", + "btw_tool_files_read_text_file" + ) ) # Should work with specific allowed tools chat <- btw_subagent_client_config(tools = c("btw_tool_docs_help_page")) - tool_names <- sapply(chat$get_tools(), function(t) t@name) + tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true("btw_tool_docs_help_page" %in% tool_names) expect_equal(length(tool_names), 1) @@ -426,3 +429,137 @@ test_that("btw_subagent_client_config() tools_allowed works with specific tool n "disallowed tools" ) }) + +# Tests for subagent tool filtering (prevents recursive subagents) + +test_that("btw_tool_subagent is filtered out when explicitly requested", { + # Explicitly request the subagent tool + expect_warning( + chat <- btw_subagent_client_config(tools = c("btw_tool_subagent", "docs")), + "btw_tool_subagent" + ) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # Should not include btw_tool_subagent + expect_false("btw_tool_subagent" %in% tool_names) + + # Should still include other requested tools + expect_true(any(grepl("^btw_tool_docs_", tool_names))) +}) + +test_that("btw_tool_subagent is filtered out from default tools", { + withr::local_options( + btw.subagent.tools_default = NULL, + btw.tools = NULL, + btw.subagent.tools_allowed = NULL + ) + + # Use default tools (btw_tools()) + chat <- btw_subagent_client_config(tools = NULL) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # btw_tool_subagent should not be in the tools + expect_false("btw_tool_subagent" %in% tool_names) + + # But other tools should be present + expect_true(length(tool_names) > 0) +}) + +test_that("btw_tool_subagent is filtered out from 'agent' tool group", { + # Request the 'agent' tool group which includes btw_tool_subagent + expect_warning( + chat <- btw_subagent_client_config(tools = c("agent")), + "btw_tool_subagent" + ) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # btw_tool_subagent should be filtered out + expect_false("btw_tool_subagent" %in% tool_names) +}) + +test_that("btw_tool_subagent is filtered out even when in tools_allowed", { + withr::local_options( + btw.subagent.tools_allowed = c("agent", "docs") + ) + + # Request agent group (which includes subagent tool) + expect_warning( + chat <- btw_subagent_client_config(tools = c("agent", "docs")), + "btw_tool_subagent" + ) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # btw_tool_subagent should still be filtered out + expect_false("btw_tool_subagent" %in% tool_names) + + # But other tools should be present + expect_true(any(grepl("^btw_tool_docs_", tool_names))) +}) + +test_that("btw_tool_subagent never appears in chat$get_tools() for subagent", { + # Test multiple scenarios to ensure subagent tool never appears + + # Scenario 1: Explicit request + expect_warning( + chat1 <- btw_subagent_client_config(tools = c("btw_tool_subagent")), + "btw_tool_subagent" + ) + expect_false( + "btw_tool_subagent" %in% sapply(chat1$get_tools(), function(t) t@name) + ) + + # Scenario 2: Via tool group + expect_warning( + chat2 <- btw_subagent_client_config(tools = c("agent")), + "btw_tool_subagent" + ) + + expect_false( + "btw_tool_subagent" %in% sapply(chat2$get_tools(), function(t) t@name) + ) + + # Scenario 3: Default tools + withr::local_options( + btw.subagent.tools_default = NULL, + btw.tools = NULL + ) + chat3 <- btw_subagent_client_config(tools = NULL) + expect_false( + "btw_tool_subagent" %in% sapply(chat3$get_tools(), function(t) t@name) + ) + + # Scenario 4: Mixed with other tools + expect_warning( + chat4 <- btw_subagent_client_config( + tools = c("btw_tool_subagent", "docs", "files") + ), + "btw_tool_subagent" + ) + expect_false( + "btw_tool_subagent" %in% sapply(chat4$get_tools(), function(t) t@name) + ) +}) + +test_that("subagent tool filtering happens after tools_allowed filtering", { + withr::local_options( + btw.subagent.tools_allowed = c("btw_tool_subagent", "docs") + ) + + # Even if subagent tool is in allowed list, it should be filtered out + expect_warning( + chat <- btw_subagent_client_config(tools = c("btw_tool_subagent", "docs")), + "btw_tool_subagent" + ) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # Subagent tool should be filtered out + expect_false("btw_tool_subagent" %in% tool_names) + + # Docs tools should remain + expect_true(any(grepl("^btw_tool_docs_", tool_names))) +}) From 93e76beefcdbc5b5b7840c8494ab93370cce28e0 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 14:34:45 -0500 Subject: [PATCH 11/44] chore: Update AGENTS.md --- AGENTS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/AGENTS.md b/AGENTS.md index 2229c240..bb6d463a 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -87,10 +87,15 @@ Tools are defined in `R/tool-*.R` files following a consistent pattern: 3. **Tool registration** - Called via `.btw_add_to_tools()` to register with ellmer Tools are grouped by capability: +- **agent** - Hierarchical workflows via `btw_tool_subagent()` to delegate tasks to specialized subagents - **docs** - Package documentation, help pages, vignettes, NEWS - **env** - Describe data frames and environments - **files** - Read, write, list files; search code +- **git** - Git repository status, diffs, logs +- **github** - GitHub issues and pull requests - **ide** - Read current editor/selection in RStudio/Positron +_ **pkg** - Package testing, checking and documentation tasks +- **run** - Run R code - **search** - Search CRAN packages - **session** - Platform info, installed packages - **web** - Read web pages as markdown From 8567a3ee706f81bfb91bc4664ded3187b0514ecf Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 19 Dec 2025 14:48:19 -0500 Subject: [PATCH 12/44] docs: fix noRd --- R/tool-subagent.R | 6 +++--- man/generate_session_id.Rd | 17 ----------------- man/retrieve_session.Rd | 18 ------------------ 3 files changed, 3 insertions(+), 38 deletions(-) delete mode 100644 man/generate_session_id.Rd delete mode 100644 man/retrieve_session.Rd diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 6ff7b6f5..1fb38bd7 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -331,7 +331,7 @@ btw_subagent_client_config <- function(client = NULL, tools = NULL) { #' @noRd build_subagent_description <- function() { # Get unique tool groups from registered tools - tool_groups <- unique(map_chr(btw_tools(), function(x) x$group)) + tool_groups <- unique(map_chr(.btw_tools, function(x) x$group)) tool_groups <- sort(tool_groups) # Build tool groups summary @@ -495,7 +495,7 @@ BEST PRACTICES: #' currently active sessions. #' #' @return A character string containing the generated session ID -#' @keywords internal +#' @noRd generate_session_id <- function() { # Try up to 100 times to generate a unique ID for (i in seq_len(100)) { @@ -554,7 +554,7 @@ store_session <- function(session_id, chat, metadata = list()) { #' @param session_id Character string with the session identifier #' @return A list containing the session data, or NULL if not found #' -#' @keywords noRd +#' @noRd retrieve_session <- function(session_id) { check_string(session_id) diff --git a/man/generate_session_id.Rd b/man/generate_session_id.Rd deleted file mode 100644 index 3f5e882b..00000000 --- a/man/generate_session_id.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tool-subagent.R -\name{generate_session_id} -\alias{generate_session_id} -\title{Generate a word-based session ID} -\usage{ -generate_session_id() -} -\value{ -A character string containing the generated session ID -} -\description{ -Creates a human-readable session identifier in the format "adjective-noun" -(e.g., "stable-genius", "swift-falcon"). Checks for uniqueness against -currently active sessions. -} -\keyword{internal} diff --git a/man/retrieve_session.Rd b/man/retrieve_session.Rd deleted file mode 100644 index fe4653af..00000000 --- a/man/retrieve_session.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tool-subagent.R -\name{retrieve_session} -\alias{retrieve_session} -\title{Retrieve a subagent session} -\usage{ -retrieve_session(session_id) -} -\arguments{ -\item{session_id}{Character string with the session identifier} -} -\value{ -A list containing the session data, or NULL if not found -} -\description{ -Retrieves a stored session from the session environment. -} -\keyword{noRd} From c4d49560e5a19a6fb19b4b09d06d3cb936b94a34 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 22 Dec 2025 08:56:15 -0500 Subject: [PATCH 13/44] refactor: Pull out `chat_get_tokens()` --- R/btw_client_app.R | 63 +++------------------------------------------- R/utils-ellmer.R | 55 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+), 59 deletions(-) diff --git a/R/btw_client_app.R b/R/btw_client_app.R index f5bc066a..65a67ec3 100644 --- a/R/btw_client_app.R +++ b/R/btw_client_app.R @@ -415,73 +415,18 @@ btw_status_bar_server <- function(id, chat) { shiny::moduleServer( id, function(input, output, session) { - chat_get_tokens <- function() { - tokens <- tryCatch( - chat$client$get_tokens(), - error = function(e) NULL - ) - if (is.null(tokens)) { - return(NULL) - } - - input_tokens <- 0 - output_tokens <- 0 - cached_tokens <- 0 - - if (!is.null(tokens) && nrow(tokens) > 0) { - if (utils::packageVersion("ellmer") <= "0.3.0") { - last_user <- tokens[tokens$role == "user", ] - if (nrow(last_user) > 0) { - input_tokens <- as.integer(utils::tail(last_user$tokens_total, 1)) - } - tokens_assistant <- tokens[tokens$role == "assistant", ] - if (nrow(tokens_assistant) > 0) { - output_tokens <- as.integer(sum(tokens_assistant$tokens)) - } - } else { - # output tokens are by turn, so we sum them all - if ("output" %in% colnames(tokens)) { - output_tokens <- sum(tokens$output) - } - # input and cached tokens are accumulated in the last API call - if ("input" %in% colnames(tokens)) { - input_tokens <- - tokens$input[[length(tokens$input)]] - } - if ("cached_input" %in% colnames(tokens)) { - cached_tokens <- tokens$cached_input[[ - length(tokens$cached_input) - ]] - } - } - } - - list( - input = input_tokens, - output = output_tokens, - cached = cached_tokens - ) - } - - chat_get_cost <- function() { - tryCatch( - chat$client$get_cost(), - error = function(e) NA - ) - } - chat_tokens <- shiny::reactiveVal( - chat_get_tokens(), + chat_get_tokens(chat$client), label = "btw_app_tokens" ) chat_cost <- shiny::reactiveVal( - chat_get_cost(), + chat_get_cost(chat$client), label = "btw_app_cost" ) shiny::observeEvent(chat$last_turn(), { - chat_tokens(chat_get_tokens()) - chat_cost(chat_get_cost()) + chat_tokens(chat_get_tokens(chat$client)) + chat_cost(chat_get_cost(chat$client)) }) send_status_message <- function(id, status, ...) { diff --git a/R/utils-ellmer.R b/R/utils-ellmer.R index fe4294c8..4e31a427 100644 --- a/R/utils-ellmer.R +++ b/R/utils-ellmer.R @@ -2,3 +2,58 @@ btw_prompt <- function(path, ..., .envir = parent.frame()) { path <- system.file("prompts", path, package = "btw") ellmer::interpolate_file(path, ..., .envir = .envir) } + +chat_get_tokens <- function(client) { + tokens <- tryCatch( + client$get_tokens(), + error = function(e) NULL + ) + if (is.null(tokens)) { + return(NULL) + } + + input_tokens <- 0 + output_tokens <- 0 + cached_tokens <- 0 + + if (!is.null(tokens) && nrow(tokens) > 0) { + if (utils::packageVersion("ellmer") <= "0.3.0") { + last_user <- tokens[tokens$role == "user", ] + if (nrow(last_user) > 0) { + input_tokens <- as.integer(utils::tail(last_user$tokens_total, 1)) + } + tokens_assistant <- tokens[tokens$role == "assistant", ] + if (nrow(tokens_assistant) > 0) { + output_tokens <- as.integer(sum(tokens_assistant$tokens)) + } + } else { + # output tokens are by turn, so we sum them all + if ("output" %in% colnames(tokens)) { + output_tokens <- sum(tokens$output) + } + # input and cached tokens are accumulated in the last API call + if ("input" %in% colnames(tokens)) { + input_tokens <- + tokens$input[[length(tokens$input)]] + } + if ("cached_input" %in% colnames(tokens)) { + cached_tokens <- tokens$cached_input[[ + length(tokens$cached_input) + ]] + } + } + } + + list( + input = input_tokens, + output = output_tokens, + cached = cached_tokens + ) +} + +chat_get_cost <- function(client) { + tryCatch( + client$get_cost(), + error = function(e) NA + ) +} From 51cc620f9c56c6c6e07723c5f1b3dd94053e6967 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 22 Dec 2025 08:56:37 -0500 Subject: [PATCH 14/44] feat: Limit token summary to just this round --- R/tool-subagent.R | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 1fb38bd7..86daad29 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -199,7 +199,24 @@ btw_tool_subagent_impl <- function( # We could update session metadata here, but `chat` is stateful - tokens <- md_table(chat$get_tokens()) + # Get tokens for just this round + idx_prompt <- which(map_lgl(chat$get_turns(), function(t) { + t@role == "user" && identical(ellmer::contents_text(t), prompt) + })) + chat2 <- chat$clone() + if (idx_prompt > 1) { + chat2$set_turns(chat2$get_turns()[-seq_len(idx_prompt - 1)]) + } + tokens <- md_table(chat2$get_tokens()) + for (i in seq_len(ncol(tokens))) { + if (is.numeric(tokens[[i]])) { + tokens[[i]] <- format(tokens[[i]], big.mark = ",") + } + } + + tool_calls <- map(chat2$get_turns(), function(turn) { + keep(turn@contents, S7::S7_inherits, ellmer::ContentToolRequest) + }) display_md <- glue_( r"( @@ -212,6 +229,8 @@ btw_tool_subagent_impl <- function( #### Tokens + **Tool Calls:** {{ length(unlist(tool_calls)) }} + {{ tokens }} #### Response From 73bd9995d845e2e63aab8e8a67cdd8865eec3a59 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 22 Dec 2025 11:57:12 -0500 Subject: [PATCH 15/44] feat: close over config for tool in `btw_tools()` --- R/tool-subagent.R | 108 ++++++++++++++++++++++++++++++++++------------ 1 file changed, 80 insertions(+), 28 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 86daad29..00a7d5c4 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -157,7 +157,8 @@ btw_tool_subagent <- function( btw_tool_subagent_impl <- function( prompt, tools = NULL, - session_id = NULL + session_id = NULL, + config = NULL ) { check_string(prompt) check_string(session_id, allow_null = TRUE) @@ -179,7 +180,12 @@ btw_tool_subagent_impl <- function( # because the chat$chat() method doesn't expose turn count control. } else { session_id <- generate_session_id() - chat <- btw_subagent_client_config(client = NULL, tools = tools) + chat <- btw_subagent_client_config( + client = config$client, + tools = tools, + tools_default = config$tools_default, + tools_allowed = config$tools_allowed + ) store_session(session_id, chat) } @@ -207,7 +213,7 @@ btw_tool_subagent_impl <- function( if (idx_prompt > 1) { chat2$set_turns(chat2$get_turns()[-seq_len(idx_prompt - 1)]) } - tokens <- md_table(chat2$get_tokens()) + tokens <- chat2$get_tokens() for (i in seq_len(ncol(tokens))) { if (is.numeric(tokens[[i]])) { tokens[[i]] <- format(tokens[[i]], big.mark = ",") @@ -218,12 +224,21 @@ btw_tool_subagent_impl <- function( keep(turn@contents, S7::S7_inherits, ellmer::ContentToolRequest) }) + provider <- chat$get_provider()@name + model <- chat$get_model() + tool_names <- paste( + sprintf("`%s`", names(chat$get_tools())), + collapse = ", " + ) + display_md <- glue_( r"( #### Prompt **Session ID:** {{ session_id }}
- **Tools:** {{ paste(names(chat$get_tools()), collapse = ', ') }} + **Provider:** {{ provider }}
+ **Model:** `{{ model }}`
+ **Tools:** {{ tool_names }} {{ prompt }} @@ -231,7 +246,7 @@ btw_tool_subagent_impl <- function( **Tool Calls:** {{ length(unlist(tool_calls)) }} - {{ tokens }} + {{ md_table(tokens) }} #### Response @@ -244,7 +259,9 @@ btw_tool_subagent_impl <- function( session_id = session_id, extra = list( prompt = prompt, - tokens = chat$get_tokens(), + provider = provider, + model = model, + tokens = tokens, display = list( markdown = display_md, show_request = FALSE @@ -253,6 +270,23 @@ btw_tool_subagent_impl <- function( ) } +#' Capture subagent configuration from current R options +#' +#' Reads the relevant btw.subagent.* and btw.* options and returns them as a +#' named list for later use by btw_tool_subagent_impl(). +#' +#' @return A list with captured configuration +#' @noRd +capture_subagent_config <- function() { + list( + client = getOption("btw.subagent.client") %||% getOption("btw.client"), + tools_default = getOption("btw.subagent.tools_default") %||% + getOption("btw.tools"), + tools_allowed = getOption("btw.subagent.tools_allowed") + ) +} + + #' Configure subagent client #' #' Creates and configures an ellmer Chat client for a subagent session. The @@ -261,29 +295,42 @@ btw_tool_subagent_impl <- function( #' #' @param client Optional Chat object or provider/model string #' @param tools Optional character vector or list of tool definitions +#' @param tools_default Optional default tools from captured config +#' @param tools_allowed Optional allowed tools whitelist from captured config #' @return A configured Chat object with system prompt and tools attached #' #' @noRd -btw_subagent_client_config <- function(client = NULL, tools = NULL) { +btw_subagent_client_config <- function( + client = NULL, + tools = NULL, + tools_default = NULL, + tools_allowed = NULL +) { # Track whether tools were explicitly provided tools_explicit <- !is.null(tools) - # Determine the tools to use (applying defaults) - configured_tools <- - tools %||% + subagent_client <- + client %||% + getOption("btw.subagent.client") %||% + getOption("btw.client") + + tools_default <- + tools_default %||% getOption("btw.subagent.tools_default") %||% getOption("btw.tools") - if (is.null(configured_tools)) { - configured_tools <- keep(btw_tools(), function(t) { - t@name != "btw_tool_subagent" - }) - } + tools_allowed <- + tools_allowed %||% + getOption("btw.subagent.tools_allowed") + + configured_tools <- + tools %||% + tools_default %||% + keep(btw_tools(), function(t) t@name != "btw_tool_subagent") configured_tools <- flatten_and_check_tools(configured_tools) # Apply tools_allowed whitelist if set - tools_allowed <- getOption("btw.subagent.tools_allowed") if (!is.null(tools_allowed)) { # Convert tools_allowed to a flat list of tool names allowed_tools <- flatten_and_check_tools(tools_allowed) @@ -324,12 +371,8 @@ btw_subagent_client_config <- function(client = NULL, tools = NULL) { FALSE }) - chat <- if (!is.null(client)) { - as_ellmer_client(client)$clone() - } else if (!is.null(subagent_client <- getOption("btw.subagent.client"))) { + chat <- if (!is.null(subagent_client)) { as_ellmer_client(subagent_client)$clone() - } else if (!is.null(default_client <- getOption("btw.client"))) { - as_ellmer_client(default_client)$clone() } else { btw_default_chat_client() } @@ -388,19 +431,28 @@ BEST PRACTICES: paste0(base_desc, tool_summary) } +btw_tool_subagent_config <- function(config) { + force(config) + + function(prompt, tools = NULL, session_id = NULL) { + btw_tool_subagent_impl( + prompt = prompt, + tools = tools, + session_id = session_id, + config = config + ) + } +} + # Register the tool .btw_add_to_tools( name = "btw_tool_subagent", group = "agent", tool = function() { + config <- capture_subagent_config() + ellmer::tool( - function(prompt, tools = NULL, session_id = NULL) { - btw_tool_subagent_impl( - prompt = prompt, - tools = tools, - session_id = session_id - ) - }, + btw_tool_subagent_config(config), name = "btw_tool_subagent", description = build_subagent_description(), annotations = ellmer::tool_annotations( From 879de1f19df6686cd4c5b3b1d673c0e418f56063 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 22 Dec 2025 15:29:42 -0500 Subject: [PATCH 16/44] feat: Use reference tool list in `btw_app()` Resolves full available tools at the start of the `btw_app()` session, then adds/removes those tools directly --- R/btw_client_app.R | 73 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 51 insertions(+), 22 deletions(-) diff --git a/R/btw_client_app.R b/R/btw_client_app.R index 65a67ec3..2e0722df 100644 --- a/R/btw_client_app.R +++ b/R/btw_client_app.R @@ -21,7 +21,21 @@ btw_app <- function( cli::cli_alert("Starting up {.fn btw::btw_app} ...") } - if (!inherits(client, "AsIs")) { + # Get reference tools for the app + if (inherits(client, "AsIs")) { + # When client is AsIs (pre-configured), use btw_tools() as reference + reference_tools <- btw_tools() + } else { + # Create a reference client to get the full tool set + withr::with_options(list(btw.client.quiet = TRUE), { + reference_client <- btw_client( + tools = names(btw_tools()), + path_btw = path_btw + ) + reference_tools <- reference_client$get_tools() + }) + + # Also create the actual client if needed client <- btw_client( client = client, tools = tools, @@ -29,7 +43,12 @@ btw_app <- function( ) } - btw_app_from_client(client, messages = messages, ...) + btw_app_from_client( + client, + messages = messages, + allowed_tools = reference_tools, + ... + ) } btw_app_html_dep <- function() { @@ -46,7 +65,12 @@ btw_app_html_dep <- function() { ) } -btw_app_from_client <- function(client, messages = list(), ...) { +btw_app_from_client <- function( + client, + messages = list(), + allowed_tools = btw_tools(), + ... +) { path_figures_installed <- system.file("help", "figures", package = "btw") path_figures_dev <- system.file("man", "figures", package = "btw") path_logo <- "btw_figures/logo.png" @@ -57,6 +81,13 @@ btw_app_from_client <- function(client, messages = list(), ...) { client$get_model() ) + # Store original client tools (preserves configuration like closures) + # $get_tools() returns a named list where names are tool names + original_client_tools <- client$get_tools() + + # Union: all tools to show in UI preferring original client tools + all_available_tools <- utils::modifyList(allowed_tools, original_client_tools) + if (nzchar(path_figures_installed)) { shiny::addResourcePath("btw_figures", path_figures_installed) } else if (nzchar(path_figures_dev)) { @@ -119,8 +150,8 @@ btw_app_from_client <- function(client, messages = list(), ...) { shiny::div( class = "overflow-y-auto overflow-x-visible", app_tool_group_inputs( - btw_tools_df(), - initial_tool_names = map_chr(client$get_tools(), S7::prop, "name") + btw_tools_df(names(all_available_tools)), + initial_tool_names = names(original_client_tools) ), shiny::uiOutput("ui_other_tools") ), @@ -165,8 +196,13 @@ btw_app_from_client <- function(client, messages = list(), ...) { bslib::toggle_sidebar("tools_sidebar") }) - tool_groups <- unique(btw_tools_df()$group) - other_tools <- keep(client$get_tools(), function(tool) { + tool_groups <- unique(btw_tools_df(names(all_available_tools))$group) + + # Split tools: btw tools and other (non-btw) tools + btw_available_tools <- keep(all_available_tools, function(tool) { + identical(substring(tool@name, 1, 9), "btw_tool_") + }) + other_tools <- keep(all_available_tools, function(tool) { !identical(substring(tool@name, 1, 9), "btw_tool_") }) @@ -178,7 +214,7 @@ btw_app_from_client <- function(client, messages = list(), ...) { }) shiny::observeEvent(input$select_all, { - tools <- btw_tools_df() + tools <- btw_tools_df(names(all_available_tools)) for (group in tool_groups) { shiny::updateCheckboxGroupInput( session = session, @@ -189,7 +225,7 @@ btw_app_from_client <- function(client, messages = list(), ...) { }) shiny::observeEvent(input$deselect_all, { - tools <- btw_tools_df() + tools <- btw_tools_df(names(all_available_tools)) for (group in tool_groups) { shiny::updateCheckboxGroupInput( session = session, @@ -202,7 +238,7 @@ btw_app_from_client <- function(client, messages = list(), ...) { lapply(tool_groups, function(group) { shiny::observeEvent(input[[paste0("tools_toggle_", group)]], { current <- input[[paste0("tools_", group)]] - all_tools <- btw_tools_df() + all_tools <- btw_tools_df(names(all_available_tools)) group_tools <- all_tools[all_tools$group == group, ][["name"]] if (length(current) == length(group_tools)) { # All selected, so deselect all @@ -226,15 +262,7 @@ btw_app_from_client <- function(client, messages = list(), ...) { if (!length(selected_tools())) { client$set_tools(list()) } else { - sel_btw_tools <- btw_tools( - intersect(names(.btw_tools), selected_tools()) - ) - sel_other_tools <- keep(other_tools, function(tool) { - tool@name %in% selected_tools() - }) - sel_tools <- c(sel_btw_tools, sel_other_tools) - # tool_names <- map_chr(tools, S7::prop, "name") - # cli::cli_inform("Setting {.field client} tools to: {.val {tool_names}}") + sel_tools <- all_available_tools[selected_tools()] client$set_tools(sel_tools) } }) @@ -572,8 +600,9 @@ btw_status_bar_server <- function(id, chat) { # Tools in sidebar ---- -btw_tools_df <- function() { - .btw_tools <- map(.btw_tools, function(def) { +btw_tools_df <- function(include_tool_names = NULL) { + all_btw_tools <- .btw_tools[intersect(include_tool_names, names(.btw_tools))] + all_btw_tools <- map(all_btw_tools, function(def) { tool <- def$tool() if (is.null(tool)) { return() @@ -591,7 +620,7 @@ btw_tools_df <- function() { is_open_world = tool@annotations$open_world_hint %||% NA ) }) - dplyr::bind_rows(.btw_tools) + dplyr::bind_rows(all_btw_tools) } app_tool_group_inputs <- function(tools_df, initial_tool_names = NULL) { From ca54f07ac31dc0349c416219ce265425c61fdb11 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 22 Dec 2025 17:22:14 -0500 Subject: [PATCH 17/44] wip: trying to address load_all() vs run-time tool config --- R/tool-subagent.R | 105 +++++++++++++++++++--------- tests/testthat/test-tool-subagent.R | 3 +- 2 files changed, 73 insertions(+), 35 deletions(-) diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 00a7d5c4..43cae34c 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -318,15 +318,19 @@ btw_subagent_client_config <- function( tools_default %||% getOption("btw.subagent.tools_default") %||% getOption("btw.tools") + tools_default <- subagent_disallow_recursion(tools_default) tools_allowed <- tools_allowed %||% getOption("btw.subagent.tools_allowed") + tools_allowed <- subagent_disallow_recursion(tools_allowed) configured_tools <- tools %||% tools_default %||% - keep(btw_tools(), function(t) t@name != "btw_tool_subagent") + compact(map(.btw_tools, function(t) { + if (t$name != "btw_tool_subagent") t$tool() + })) configured_tools <- flatten_and_check_tools(configured_tools) @@ -361,15 +365,7 @@ btw_subagent_client_config <- function( # Never allow subagents to create subagents (prevents infinite recursion) # This filtering happens after all tool resolution and allowed-list filtering # to ensure the subagent tool is always removed, regardless of how tools were specified - configured_tools <- keep(configured_tools, function(tool) { - if (tool@name != "btw_tool_subagent") { - return(TRUE) - } - cli::cli_warn( - "Removing {.code btw_tool_subagent} from subagent toolset to prevent recursion." - ) - FALSE - }) + configured_tools <- subagent_disallow_recursion(configured_tools) chat <- if (!is.null(subagent_client)) { as_ellmer_client(subagent_client)$clone() @@ -384,6 +380,28 @@ btw_subagent_client_config <- function( chat } +subagent_disallow_recursion <- function(tools) { + if (is.character(tools)) { + if ("btw_tool_subagent" %in% tools || "subagent" %in% tools) { + cli::cli_warn( + "Removing {.code btw_tool_subagent} from subagent toolset to prevent recursion." + ) + return(setdiff(tools, c("btw_tool_subagent", "subagent"))) + } + return(tools) + } + + keep(tools, function(tool) { + if (tool@name != "btw_tool_subagent") { + return(TRUE) + } + cli::cli_warn( + "Removing {.code btw_tool_subagent} from subagent toolset to prevent recursion." + ) + FALSE + }) +} + #' Build dynamic tool description for btw_tool_subagent #' #' Generates a description that includes available tool groups dynamically. @@ -391,22 +409,40 @@ btw_subagent_client_config <- function( #' @return Character string with the tool description #' #' @noRd -build_subagent_description <- function() { - # Get unique tool groups from registered tools - tool_groups <- unique(map_chr(.btw_tools, function(x) x$group)) - tool_groups <- sort(tool_groups) - - # Build tool groups summary - if (length(tool_groups) > 0) { - tool_summary <- paste( - "\n\nAvailable tool groups:", - paste(tool_groups, collapse = ", ") - ) +build_subagent_description <- function(tools = .btw_tools) { + desc_tool_use <- if (length(tools) == 0) { + "No tools are available for use in the subagent." } else { - tool_summary <- "\n\nNo tool groups currently registered." + r"( +CRITICAL - TOOL SELECTION: +You MUST specify which tools the subagent needs using the 'tools' parameter. Choosing the right tools is essential for success: +- Analyze the task requirements carefully +- Select only the specific tools needed for the task +- If uncertain which tools are needed, include relevant tool groups +- The subagent can ONLY use the tools you provide - wrong tools = task failure + +AVAILABLE TOOLS FOR SUBAGENT USE:)" } - base_desc <- "Delegate a task to a specialized assistant that can work independently with its own conversation thread. + tool_summary <- if (length(tools) == 0) { + "" + } else { + map_chr(tools, function(tool) { + if (!inherits(tool, "ellmer::ToolDef")) { + if (is.function(tool$tool)) { + tool <- tool$tool() + } else { + rlang::abort("Unknown tool definition format.") + } + } + desc <- strsplit(tool@description, "\n|[.](\\s|$)")[[1]][1] + sprintf("- %s: %s", tool@name, desc) + }) + } + tool_summary <- paste(tool_summary, collapse = "\n") + + desc_base <- r"( +Delegate a task to a specialized assistant that can work independently with its own conversation thread. WHEN TO USE: - For complex, multi-step tasks that would benefit from focused attention @@ -414,21 +450,14 @@ WHEN TO USE: - To resume previous work by providing the session_id from an earlier call - When you can handle the task yourself with available tools, do so directly instead -CRITICAL - TOOL SELECTION: -You MUST specify which tools the subagent needs using the 'tools' parameter. Choosing the right tools is essential for success: -- Analyze the task requirements carefully -- Select only the specific tools needed (e.g., ['btw_tool_files_read_text_file', 'btw_tool_files_write_text_file'] for file tasks) -- If uncertain which tools are needed, include relevant tool groups -- The subagent can ONLY use the tools you provide - wrong tools = task failure - BEST PRACTICES: - Write clear, complete task descriptions in the prompt - Specify expected output format if important - Store the returned session_id if you need to continue the work later - The subagent returns its final answer as plain text -- Each subagent session is independent with its own context" +- Each subagent session is independent with its own context)" - paste0(base_desc, tool_summary) + paste0(desc_base, "\n", desc_tool_use, "\n", tool_summary) } btw_tool_subagent_config <- function(config) { @@ -450,11 +479,21 @@ btw_tool_subagent_config <- function(config) { group = "agent", tool = function() { config <- capture_subagent_config() + tools_allowed <- config$tools_allowed + + if (is.null(tools_allowed)) { + btw_other_tools <- setdiff(names(.btw_tools), "btw_tool_subagent") + tools_allowed <- map(.btw_tools[btw_other_tools], function(t) t$tool()) + } else { + tools_allowed <- subagent_disallow_recursion(tools_allowed) + } + + tools_allowed <- flatten_and_check_tools(tools_allowed) ellmer::tool( btw_tool_subagent_config(config), name = "btw_tool_subagent", - description = build_subagent_description(), + description = build_subagent_description(tools_allowed), annotations = ellmer::tool_annotations( title = "Subagent", read_only_hint = FALSE, diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-subagent.R index c4317fa9..1b670a94 100644 --- a/tests/testthat/test-tool-subagent.R +++ b/tests/testthat/test-tool-subagent.R @@ -206,8 +206,7 @@ test_that("build_subagent_description() includes tool groups", { expect_type(desc, "character") expect_match(desc, "Delegate a task") - expect_match(desc, "Available tool groups") - expect_true(any(grepl("docs|env|search|github", desc))) + expect_match(desc, "AVAILABLE TOOLS") }) test_that("build_subagent_description() includes basic text", { From 6de29305beaf094bb819cfd29c168d26ecd4eb97 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Thu, 1 Jan 2026 13:45:13 -0500 Subject: [PATCH 18/44] feat: Add pre-instantiation `can_register` check to prevent subagent recursion The subagent tool's description is dynamically generated based on available tools. This caused infinite recursion when `btw_tools()` tried to instantiate the subagent tool, which called `btw_tools()` again to build its description. Changes: - Add `can_register` argument to `.btw_add_to_tools()` for filtering tools before instantiation (preventing recursion) - Update `as_ellmer_tools()` to check `can_register` before calling `$tool()`, then propagate it to the `btw_can_register` annotation - Add `btw_can_register_subagent_tool()` that returns FALSE during subagent description generation (via `.btw_resolving_for_subagent` option) - Migrate git, github, run tools to use wrapper pattern: `can_register = function() btw_can_register_*()` for mockability - Add explicit error when subagent tool is directly requested by name (e.g., `tools = "btw_tool_subagent"`) - Simplify `subagent_disallow_recursion()` to silently filter without warnings The wrapper pattern `function() btw_can_register_*()` ensures the real function is looked up by name at call time, allowing test mocks to work correctly. --- R/aaa-tools.R | 7 ++- R/tool-git.R | 28 +++++----- R/tool-github.R | 4 +- R/tool-run.R | 4 +- R/tool-subagent.R | 77 ++++++++++++++++++++------ R/tools.R | 40 +++++++++++--- tests/testthat/helpers.R | 2 + tests/testthat/test-tool-subagent.R | 84 ++++++++++++----------------- 8 files changed, 152 insertions(+), 94 deletions(-) diff --git a/R/aaa-tools.R b/R/aaa-tools.R index 843ebc9d..ab66301e 100644 --- a/R/aaa-tools.R +++ b/R/aaa-tools.R @@ -1,8 +1,10 @@ .btw_tools <- list() -.btw_add_to_tools <- function(name, group = name, tool) { +.btw_add_to_tools <- function(name, group = name, tool, can_register = NULL) { check_string(name) check_string(group) + check_function(can_register, allow_null = TRUE) + if (!is_function(tool)) { abort( "`tool` must be a function to ensure `ellmer::tool()` is called at run time." @@ -16,7 +18,8 @@ .btw_tools[[name]] <<- list( name = name, group = group, - tool = tool + tool = tool, + can_register = can_register ) invisible(tool) diff --git a/R/tool-git.R b/R/tool-git.R index 6a63cace..d1a75e14 100644 --- a/R/tool-git.R +++ b/R/tool-git.R @@ -81,6 +81,7 @@ btw_tool_git_status_impl <- function( .btw_add_to_tools( name = "btw_tool_git_status", group = "git", + can_register = function() btw_can_register_git_tool(), tool = function() { ellmer::tool( btw_tool_git_status_impl, @@ -98,8 +99,7 @@ RETURNS: A list of file paths, their status (new, modified, deleted, etc.), and title = "Git Status", read_only_hint = TRUE, open_world_hint = FALSE, - idempotent_hint = FALSE, - btw_can_register = btw_can_register_git_tool + idempotent_hint = FALSE ), arguments = list( include = ellmer::type_enum( @@ -182,6 +182,7 @@ btw_tool_git_diff_impl <- function(ref = NULL) { .btw_add_to_tools( name = "btw_tool_git_diff", group = "git", + can_register = function() btw_can_register_git_tool(), tool = function() { ellmer::tool( btw_tool_git_diff_impl, @@ -201,8 +202,7 @@ LIMITATION: This tool does not support diffing between two arbitrary commits. title = "Git Diff", read_only_hint = TRUE, open_world_hint = FALSE, - idempotent_hint = TRUE, - btw_can_register = btw_can_register_git_tool + idempotent_hint = TRUE ), arguments = list( ref = ellmer::type_string( @@ -302,6 +302,7 @@ btw_tool_git_log_impl <- function( .btw_add_to_tools( name = "btw_tool_git_log", group = "git", + can_register = function() btw_can_register_git_tool(), tool = function() { ellmer::tool( btw_tool_git_log_impl, @@ -319,8 +320,7 @@ RETURNS: A list of commits with SHA (short), author, timestamp, number of files, title = "Git Log", read_only_hint = TRUE, open_world_hint = FALSE, - idempotent_hint = FALSE, - btw_can_register = btw_can_register_git_tool + idempotent_hint = FALSE ), arguments = list( ref = ellmer::type_string( @@ -409,6 +409,7 @@ btw_tool_git_commit_impl <- function( .btw_add_to_tools( name = "btw_tool_git_commit", group = "git", + can_register = function() btw_can_register_git_tool(), tool = function() { ellmer::tool( btw_tool_git_commit_impl, @@ -431,8 +432,7 @@ RETURNS: The commit SHA and confirmation message. title = "Git Commit", read_only_hint = FALSE, open_world_hint = FALSE, - idempotent_hint = FALSE, - btw_can_register = btw_can_register_git_tool + idempotent_hint = FALSE ), arguments = list( message = ellmer::type_string( @@ -515,6 +515,7 @@ btw_tool_git_branch_list_impl <- function( .btw_add_to_tools( name = "btw_tool_git_branch_list", group = "git", + can_register = function() btw_can_register_git_tool(), tool = function() { ellmer::tool( btw_tool_git_branch_list_impl, @@ -531,8 +532,7 @@ RETURNS: A table of branch names, upstream tracking, and last update time. title = "Git Branches", read_only_hint = TRUE, open_world_hint = FALSE, - idempotent_hint = TRUE, - btw_can_register = btw_can_register_git_tool + idempotent_hint = TRUE ), arguments = list( include = ellmer::type_enum( @@ -615,6 +615,7 @@ btw_tool_git_branch_create_impl <- function( .btw_add_to_tools( name = "btw_tool_git_branch_create", group = "git", + can_register = function() btw_can_register_git_tool(), tool = function() { ellmer::tool( btw_tool_git_branch_create_impl, @@ -636,8 +637,7 @@ RETURNS: Confirmation message with branch name and ref. title = "Git Branch Create", read_only_hint = FALSE, open_world_hint = FALSE, - idempotent_hint = FALSE, - btw_can_register = btw_can_register_git_tool + idempotent_hint = FALSE ), arguments = list( branch = ellmer::type_string( @@ -719,6 +719,7 @@ btw_tool_git_branch_checkout_impl <- function( .btw_add_to_tools( name = "btw_tool_git_branch_checkout", group = "git", + can_register = function() btw_can_register_git_tool(), tool = function() { ellmer::tool( btw_tool_git_branch_checkout_impl, @@ -741,8 +742,7 @@ RETURNS: Confirmation message with branch name. title = "Git Checkout", read_only_hint = FALSE, open_world_hint = FALSE, - idempotent_hint = FALSE, - btw_can_register = btw_can_register_git_tool + idempotent_hint = FALSE ), arguments = list( branch = ellmer::type_string( diff --git a/R/tool-github.R b/R/tool-github.R index c0b42ce3..8f41a192 100644 --- a/R/tool-github.R +++ b/R/tool-github.R @@ -268,6 +268,7 @@ btw_tool_github_impl <- function(code, fields = "default") { .btw_add_to_tools( name = "btw_tool_github", group = "github", + can_register = function() btw_can_register_gh_tool(), tool = function() { ellmer::tool( btw_tool_github_impl, @@ -340,8 +341,7 @@ RETURNS: The result from the GitHub API call, formatted as JSON. title = "GitHub API", read_only_hint = FALSE, # Can perform writes open_world_hint = TRUE, - idempotent_hint = FALSE, - btw_can_register = btw_can_register_gh_tool + idempotent_hint = FALSE ), arguments = list( code = ellmer::type_string( diff --git a/R/tool-run.R b/R/tool-run.R index bf549633..b02fe53c 100644 --- a/R/tool-run.R +++ b/R/tool-run.R @@ -383,6 +383,7 @@ fansi_to_html <- function(text) { .btw_add_to_tools( name = "btw_tool_run_r", group = "run", + can_register = function() btw_can_register_run_r_tool(), tool = function() { ellmer::tool( function(code) { @@ -426,8 +427,7 @@ Executes R code and captures printed values, text output, plots, messages, warni annotations = ellmer::tool_annotations( title = "Run R Code", read_only_hint = FALSE, - open_world_hint = FALSE, - btw_can_register = btw_can_register_run_r_tool + open_world_hint = FALSE ), arguments = list( code = ellmer::type_string("The R code to run") diff --git a/R/tool-subagent.R b/R/tool-subagent.R index 43cae34c..04f55101 100644 --- a/R/tool-subagent.R +++ b/R/tool-subagent.R @@ -309,6 +309,16 @@ btw_subagent_client_config <- function( # Track whether tools were explicitly provided tools_explicit <- !is.null(tools) + # Error immediately if subagent is explicitly requested + # This provides clear feedback rather than silent filtering + if (subagent_explicitly_requested(tools)) { + cli::cli_abort(c( + "Subagents cannot spawn other subagents.", + "x" = "The {.arg tools} parameter includes {.val btw_tool_subagent}.", + "i" = "Remove the subagent tool from the tools list." + )) + } + subagent_client <- client %||% getOption("btw.subagent.client") %||% @@ -323,7 +333,9 @@ btw_subagent_client_config <- function( tools_allowed <- tools_allowed %||% getOption("btw.subagent.tools_allowed") - tools_allowed <- subagent_disallow_recursion(tools_allowed) + # Note: Don't filter subagent from tools_allowed here. + # The allowed list should be used as-is for validation. + # The final subagent_disallow_recursion() at the end handles the actual filtering. configured_tools <- tools %||% @@ -381,27 +393,44 @@ btw_subagent_client_config <- function( } subagent_disallow_recursion <- function(tools) { + if (is.null(tools)) return(NULL) + if (is.character(tools)) { - if ("btw_tool_subagent" %in% tools || "subagent" %in% tools) { - cli::cli_warn( - "Removing {.code btw_tool_subagent} from subagent toolset to prevent recursion." - ) - return(setdiff(tools, c("btw_tool_subagent", "subagent"))) - } - return(tools) + return(setdiff(tools, c("btw_tool_subagent", "subagent"))) } keep(tools, function(tool) { - if (tool@name != "btw_tool_subagent") { - return(TRUE) - } - cli::cli_warn( - "Removing {.code btw_tool_subagent} from subagent toolset to prevent recursion." - ) - FALSE + !inherits(tool, "ellmer::ToolDef") || tool@name != "btw_tool_subagent" }) } +#' Check if subagent tool is explicitly requested +#' +#' Detects explicit requests for the subagent tool by name (not via group). +#' Used to provide clear error messages when users try to give subagents +#' the ability to spawn other subagents. +#' +#' @param tools Character vector of tool names/groups or list of ToolDef objects +#' @return TRUE if subagent is explicitly requested by name, FALSE otherwise +#' @noRd +subagent_explicitly_requested <- function(tools) { + if (is.null(tools)) return(FALSE) + + if (is.character(tools)) { + return("btw_tool_subagent" %in% tools || "subagent" %in% tools) + } + + if (is.list(tools)) { + for (t in tools) { + if (inherits(t, "ellmer::ToolDef") && t@name == "btw_tool_subagent") { + return(TRUE) + } + } + } + + FALSE +} + #' Build dynamic tool description for btw_tool_subagent #' #' Generates a description that includes available tool groups dynamically. @@ -473,11 +502,25 @@ btw_tool_subagent_config <- function(config) { } } +# Helper: Check if subagent tool can register +btw_can_register_subagent_tool <- function() { + + # Prevent registration when resolving tools for subagent description. + # This breaks the infinite recursion chain that occurs when the tool's + # $tool() function calls btw_tools() which would try to instantiate + # this tool again. + !isTRUE(getOption(".btw_resolving_for_subagent")) +} + # Register the tool .btw_add_to_tools( name = "btw_tool_subagent", group = "agent", + can_register = function() btw_can_register_subagent_tool(), tool = function() { + # Set context flag before any tool resolution to prevent recursion + withr::local_options(.btw_resolving_for_subagent = TRUE) + config <- capture_subagent_config() tools_allowed <- config$tools_allowed @@ -497,8 +540,8 @@ btw_tool_subagent_config <- function(config) { annotations = ellmer::tool_annotations( title = "Subagent", read_only_hint = FALSE, - open_world_hint = TRUE, - btw_can_register = function() TRUE + open_world_hint = TRUE + # btw_can_register is propagated from can_register by as_ellmer_tools() ), arguments = list( prompt = ellmer::type_string( diff --git a/R/tools.R b/R/tools.R index d929aab4..3d0cd76b 100644 --- a/R/tools.R +++ b/R/tools.R @@ -74,14 +74,10 @@ btw_tools <- function(...) { tools_to_keep <- map_lgl(.btw_tools, is_tool_match, tools) res <- .btw_tools[tools_to_keep] - res <- as_ellmer_tools(res) - tools_can_register <- map_lgl(res, function(tool) { - is.null(tool@annotations$btw_can_register) || - tool@annotations$btw_can_register() - }) - - res[tools_can_register] + # as_ellmer_tools() now handles can_register checks before instantiation + # and propagates can_register to btw_can_register annotation + as_ellmer_tools(res) } is_tool_match <- function(tool, labels = NULL) { @@ -103,9 +99,39 @@ is_tool_match <- function(tool, labels = NULL) { # Convert from .btw_tools (or a filtered version of it) # to a format compatible with `client$set_tools()` as_ellmer_tools <- function(x) { + # 1. Filter by can_register BEFORE instantiation + # This prevents infinite recursion when a tool's $tool() function + # tries to resolve tools that include itself (e.g., subagent) + can_register_fns <- map(x, function(.x) .x$can_register) + can_instantiate <- map_lgl(can_register_fns, function(fn) { + is.null(fn) || fn() + }) + x <- x[can_instantiate] + can_register_fns <- can_register_fns[can_instantiate] + + # 2. Instantiate tools groups <- map_chr(x, function(.x) .x$group) tools <- compact(map(x, function(.x) .x$tool())) + + # Handle case where compact() removed some tools + # (shouldn't happen normally, but be defensive) + if (length(tools) < length(groups)) { + groups <- groups[seq_along(tools)] + can_register_fns <- can_register_fns[seq_along(tools)] + } + + # 3. Set icons tools <- map2(tools, groups, set_tool_icon) + + # 4. Propagate can_register to btw_can_register annotation + tools <- map2(tools, can_register_fns, function(tool, fn) { + if (!is.null(fn)) { + tool@annotations$btw_can_register <- fn + } + tool + }) + + # 5. Wrap with intent map(tools, wrap_with_intent) } diff --git a/tests/testthat/helpers.R b/tests/testthat/helpers.R index 14780cf1..c75c94c9 100644 --- a/tests/testthat/helpers.R +++ b/tests/testthat/helpers.R @@ -93,6 +93,7 @@ local_enable_tools <- function( btw_can_register_git_tool = TRUE, btw_can_register_gh_tool = TRUE, btw_can_register_run_r_tool = TRUE, + btw_can_register_subagent_tool = TRUE, .env = caller_env() ) { local_mocked_bindings( @@ -105,6 +106,7 @@ local_enable_tools <- function( btw_can_register_git_tool = function() btw_can_register_git_tool, btw_can_register_gh_tool = function() btw_can_register_gh_tool, btw_can_register_run_r_tool = function() btw_can_register_run_r_tool, + btw_can_register_subagent_tool = function() btw_can_register_subagent_tool, .env = .env ) } diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-subagent.R index 1b670a94..b82345f7 100644 --- a/tests/testthat/test-tool-subagent.R +++ b/tests/testthat/test-tool-subagent.R @@ -431,20 +431,18 @@ test_that("btw_subagent_client_config() tools_allowed works with specific tool n # Tests for subagent tool filtering (prevents recursive subagents) -test_that("btw_tool_subagent is filtered out when explicitly requested", { - # Explicitly request the subagent tool - expect_warning( - chat <- btw_subagent_client_config(tools = c("btw_tool_subagent", "docs")), - "btw_tool_subagent" +test_that("btw_tool_subagent errors when explicitly requested", { + # Explicitly requesting the subagent tool now throws an error + expect_error( + btw_subagent_client_config(tools = c("btw_tool_subagent", "docs")), + "Subagents cannot spawn other subagents" ) - tool_names <- map_chr(chat$get_tools(), function(t) t@name) - - # Should not include btw_tool_subagent - expect_false("btw_tool_subagent" %in% tool_names) - - # Should still include other requested tools - expect_true(any(grepl("^btw_tool_docs_", tool_names))) + # Same for short name + expect_error( + btw_subagent_client_config(tools = c("subagent", "docs")), + "Subagents cannot spawn other subagents" + ) }) test_that("btw_tool_subagent is filtered out from default tools", { @@ -466,12 +464,10 @@ test_that("btw_tool_subagent is filtered out from default tools", { expect_true(length(tool_names) > 0) }) -test_that("btw_tool_subagent is filtered out from 'agent' tool group", { +test_that("btw_tool_subagent is silently filtered out from 'agent' tool group", { # Request the 'agent' tool group which includes btw_tool_subagent - expect_warning( - chat <- btw_subagent_client_config(tools = c("agent")), - "btw_tool_subagent" - ) + # The subagent tool is silently filtered via can_register (no warning) + chat <- btw_subagent_client_config(tools = c("agent")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) @@ -479,16 +475,14 @@ test_that("btw_tool_subagent is filtered out from 'agent' tool group", { expect_false("btw_tool_subagent" %in% tool_names) }) -test_that("btw_tool_subagent is filtered out even when in tools_allowed", { +test_that("btw_tool_subagent is silently filtered out even when in tools_allowed", { withr::local_options( btw.subagent.tools_allowed = c("agent", "docs") ) # Request agent group (which includes subagent tool) - expect_warning( - chat <- btw_subagent_client_config(tools = c("agent", "docs")), - "btw_tool_subagent" - ) + # The subagent tool is silently filtered via can_register + chat <- btw_subagent_client_config(tools = c("agent", "docs")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) @@ -502,26 +496,19 @@ test_that("btw_tool_subagent is filtered out even when in tools_allowed", { test_that("btw_tool_subagent never appears in chat$get_tools() for subagent", { # Test multiple scenarios to ensure subagent tool never appears - # Scenario 1: Explicit request - expect_warning( - chat1 <- btw_subagent_client_config(tools = c("btw_tool_subagent")), - "btw_tool_subagent" - ) - expect_false( - "btw_tool_subagent" %in% sapply(chat1$get_tools(), function(t) t@name) - ) - - # Scenario 2: Via tool group - expect_warning( - chat2 <- btw_subagent_client_config(tools = c("agent")), - "btw_tool_subagent" + # Scenario 1: Explicit request → throws error + expect_error( + btw_subagent_client_config(tools = c("btw_tool_subagent")), + "Subagents cannot spawn other subagents" ) + # Scenario 2: Via tool group → silently filtered + chat2 <- btw_subagent_client_config(tools = c("agent")) expect_false( "btw_tool_subagent" %in% sapply(chat2$get_tools(), function(t) t@name) ) - # Scenario 3: Default tools + # Scenario 3: Default tools → silently filtered withr::local_options( btw.subagent.tools_default = NULL, btw.tools = NULL @@ -531,29 +518,26 @@ test_that("btw_tool_subagent never appears in chat$get_tools() for subagent", { "btw_tool_subagent" %in% sapply(chat3$get_tools(), function(t) t@name) ) - # Scenario 4: Mixed with other tools - expect_warning( - chat4 <- btw_subagent_client_config( - tools = c("btw_tool_subagent", "docs", "files") - ), - "btw_tool_subagent" - ) - expect_false( - "btw_tool_subagent" %in% sapply(chat4$get_tools(), function(t) t@name) + # Scenario 4: Mixed explicit with other tools → throws error + expect_error( + btw_subagent_client_config(tools = c("btw_tool_subagent", "docs", "files")), + "Subagents cannot spawn other subagents" ) }) -test_that("subagent tool filtering happens after tools_allowed filtering", { +test_that("subagent tool errors even when in tools_allowed", { withr::local_options( btw.subagent.tools_allowed = c("btw_tool_subagent", "docs") ) - # Even if subagent tool is in allowed list, it should be filtered out - expect_warning( - chat <- btw_subagent_client_config(tools = c("btw_tool_subagent", "docs")), - "btw_tool_subagent" + # Even if subagent tool is in allowed list, explicit request throws error + expect_error( + btw_subagent_client_config(tools = c("btw_tool_subagent", "docs")), + "Subagents cannot spawn other subagents" ) + # But requesting via group doesn't error - silently filters + chat <- btw_subagent_client_config(tools = c("agent", "docs")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) # Subagent tool should be filtered out From 8d76699f3108a260455f7350e60986d20162607d Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Thu, 1 Jan 2026 14:49:40 -0500 Subject: [PATCH 19/44] chore: Rename `btw_tool_agent_subagent` --- AGENTS.md | 2 +- DESCRIPTION | 2 +- NAMESPACE | 2 +- R/{tool-subagent.R => tool-agent-subagent.R} | 58 +++++++++++-------- ...subagent.Rd => btw_tool_agent_subagent.Rd} | 25 ++++---- man/btw_tool_run_r.Rd | 2 +- man/btw_tools.Rd | 3 +- tests/testthat/helpers-mock-pkg.R | 26 +++++---- ...-subagent.R => test-tool-agent-subagent.R} | 50 ++++++++-------- 9 files changed, 95 insertions(+), 75 deletions(-) rename R/{tool-subagent.R => tool-agent-subagent.R} (94%) rename man/{btw_tool_subagent.Rd => btw_tool_agent_subagent.Rd} (92%) rename tests/testthat/{test-tool-subagent.R => test-tool-agent-subagent.R} (89%) diff --git a/AGENTS.md b/AGENTS.md index bb6d463a..3e2a91fa 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -87,7 +87,7 @@ Tools are defined in `R/tool-*.R` files following a consistent pattern: 3. **Tool registration** - Called via `.btw_add_to_tools()` to register with ellmer Tools are grouped by capability: -- **agent** - Hierarchical workflows via `btw_tool_subagent()` to delegate tasks to specialized subagents +- **agent** - Hierarchical workflows via `btw_tool_agent_subagent()` to delegate tasks to specialized subagents - **docs** - Package documentation, help pages, vignettes, NEWS - **env** - Describe data frames and environments - **files** - Read, write, list files; search code diff --git a/DESCRIPTION b/DESCRIPTION index f39f642f..4560f186 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -96,6 +96,7 @@ Collate: 'task_create_btw_md.R' 'task_create_readme.R' 'tool-result.R' + 'tool-agent-subagent.R' 'tool-docs-news.R' 'tool-docs.R' 'tool-env-df.R' @@ -111,7 +112,6 @@ Collate: 'tool-search-packages.R' 'tool-session-info.R' 'tool-session-package-installed.R' - 'tool-subagent.R' 'tool-web.R' 'tools.R' 'utils-ellmer.R' diff --git a/NAMESPACE b/NAMESPACE index dc84c4c8..aacbb3d3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(btw_mcp_session) export(btw_task_create_btw_md) export(btw_task_create_readme) export(btw_this) +export(btw_tool_agent_subagent) export(btw_tool_docs_available_vignettes) export(btw_tool_docs_help_page) export(btw_tool_docs_package_help_topics) @@ -58,7 +59,6 @@ export(btw_tool_search_packages) export(btw_tool_session_check_package_installed) export(btw_tool_session_package_info) export(btw_tool_session_platform_info) -export(btw_tool_subagent) export(btw_tool_web_read_url) export(btw_tools) export(edit_btw_md) diff --git a/R/tool-subagent.R b/R/tool-agent-subagent.R similarity index 94% rename from R/tool-subagent.R rename to R/tool-agent-subagent.R index 04f55101..2f8f30f5 100644 --- a/R/tool-subagent.R +++ b/R/tool-agent-subagent.R @@ -1,3 +1,6 @@ +#' @include tool-result.R +NULL + BtwSubagentResult <- S7::new_class( "BtwSubagentResult", parent = BtwToolResult, @@ -9,7 +12,7 @@ BtwSubagentResult <- S7::new_class( #' Tool: Subagent #' #' @description -#' `btw_tool_subagent()` is a btw tool that enables hierarchical agent +#' `btw_tool_agent_subagent()` is a btw tool that enables hierarchical agent #' workflows. When used by an LLM assistant (like [btw_app()], [btw_client()], #' or third-party tools like Claude Code), this tool allows the orchestrating #' agent to delegate complex tasks to specialized subagents, each with their own @@ -75,7 +78,7 @@ BtwSubagentResult <- S7::new_class( #' @examples #' \dontrun{ #' # Typically used by LLMs via tool use, but can be called directly for testing -#' result <- btw_tool_subagent( +#' result <- btw_tool_agent_subagent( #' prompt = "List all R files in the current directory", #' tools = c("btw_tool_files_list_files") #' ) @@ -85,7 +88,7 @@ BtwSubagentResult <- S7::new_class( #' session_id <- result@session_id #' #' # Resume the same session with a follow-up -#' result2 <- btw_tool_subagent( +#' result2 <- btw_tool_agent_subagent( #' prompt = "Now read the first file you found", #' tools = c("btw_tool_files_read_text_file"), #' session_id = session_id @@ -97,7 +100,7 @@ BtwSubagentResult <- S7::new_class( #' btw.subagent.tools_default = "files" # Default to file tools only #' )) #' -#' result3 <- btw_tool_subagent( +#' result3 <- btw_tool_agent_subagent( #' prompt = "Find all TODO comments in R files" #' ) #' @@ -108,14 +111,14 @@ BtwSubagentResult <- S7::new_class( #' )) #' #' # This works - files tools are allowed -#' result4 <- btw_tool_subagent( +#' result4 <- btw_tool_agent_subagent( #' prompt = "List R files", #' tools = "files" #' ) #' #' # This would error - github tools are not in the allowed list #' tryCatch( -#' btw_tool_subagent( +#' btw_tool_agent_subagent( #' prompt = "Create a GitHub issue", #' tools = "github" #' ), @@ -146,7 +149,7 @@ BtwSubagentResult <- S7::new_class( #' @seealso [btw_tools()] for available tools and tool groups #' @family agent tools #' @export -btw_tool_subagent <- function( +btw_tool_agent_subagent <- function( prompt, tools = NULL, session_id = NULL, @@ -154,7 +157,7 @@ btw_tool_subagent <- function( ) {} -btw_tool_subagent_impl <- function( +btw_tool_agent_subagent_impl <- function( prompt, tools = NULL, session_id = NULL, @@ -273,7 +276,7 @@ btw_tool_subagent_impl <- function( #' Capture subagent configuration from current R options #' #' Reads the relevant btw.subagent.* and btw.* options and returns them as a -#' named list for later use by btw_tool_subagent_impl(). +#' named list for later use by btw_tool_agent_subagent_impl(). #' #' @return A list with captured configuration #' @noRd @@ -314,7 +317,7 @@ btw_subagent_client_config <- function( if (subagent_explicitly_requested(tools)) { cli::cli_abort(c( "Subagents cannot spawn other subagents.", - "x" = "The {.arg tools} parameter includes {.val btw_tool_subagent}.", + "x" = "The {.arg tools} parameter includes {.val btw_tool_agent_subagent}.", "i" = "Remove the subagent tool from the tools list." )) } @@ -341,7 +344,7 @@ btw_subagent_client_config <- function( tools %||% tools_default %||% compact(map(.btw_tools, function(t) { - if (t$name != "btw_tool_subagent") t$tool() + if (t$name != "btw_tool_agent_subagent") t$tool() })) configured_tools <- flatten_and_check_tools(configured_tools) @@ -393,14 +396,16 @@ btw_subagent_client_config <- function( } subagent_disallow_recursion <- function(tools) { - if (is.null(tools)) return(NULL) + if (is.null(tools)) { + return(NULL) + } if (is.character(tools)) { - return(setdiff(tools, c("btw_tool_subagent", "subagent"))) + return(setdiff(tools, c("btw_tool_agent_subagent", "subagent"))) } keep(tools, function(tool) { - !inherits(tool, "ellmer::ToolDef") || tool@name != "btw_tool_subagent" + !inherits(tool, "ellmer::ToolDef") || tool@name != "btw_tool_agent_subagent" }) } @@ -414,15 +419,19 @@ subagent_disallow_recursion <- function(tools) { #' @return TRUE if subagent is explicitly requested by name, FALSE otherwise #' @noRd subagent_explicitly_requested <- function(tools) { - if (is.null(tools)) return(FALSE) + if (is.null(tools)) { + return(FALSE) + } if (is.character(tools)) { - return("btw_tool_subagent" %in% tools || "subagent" %in% tools) + return("btw_tool_agent_subagent" %in% tools || "subagent" %in% tools) } if (is.list(tools)) { for (t in tools) { - if (inherits(t, "ellmer::ToolDef") && t@name == "btw_tool_subagent") { + if ( + inherits(t, "ellmer::ToolDef") && t@name == "btw_tool_agent_subagent" + ) { return(TRUE) } } @@ -431,7 +440,7 @@ subagent_explicitly_requested <- function(tools) { FALSE } -#' Build dynamic tool description for btw_tool_subagent +#' Build dynamic tool description for btw_tool_agent_subagent #' #' Generates a description that includes available tool groups dynamically. #' @@ -489,11 +498,11 @@ BEST PRACTICES: paste0(desc_base, "\n", desc_tool_use, "\n", tool_summary) } -btw_tool_subagent_config <- function(config) { +btw_tool_agent_subagent_config <- function(config) { force(config) function(prompt, tools = NULL, session_id = NULL) { - btw_tool_subagent_impl( + btw_tool_agent_subagent_impl( prompt = prompt, tools = tools, session_id = session_id, @@ -504,7 +513,6 @@ btw_tool_subagent_config <- function(config) { # Helper: Check if subagent tool can register btw_can_register_subagent_tool <- function() { - # Prevent registration when resolving tools for subagent description. # This breaks the infinite recursion chain that occurs when the tool's # $tool() function calls btw_tools() which would try to instantiate @@ -514,7 +522,7 @@ btw_can_register_subagent_tool <- function() { # Register the tool .btw_add_to_tools( - name = "btw_tool_subagent", + name = "btw_tool_agent_subagent", group = "agent", can_register = function() btw_can_register_subagent_tool(), tool = function() { @@ -525,7 +533,7 @@ btw_can_register_subagent_tool <- function() { tools_allowed <- config$tools_allowed if (is.null(tools_allowed)) { - btw_other_tools <- setdiff(names(.btw_tools), "btw_tool_subagent") + btw_other_tools <- setdiff(names(.btw_tools), "btw_tool_agent_subagent") tools_allowed <- map(.btw_tools[btw_other_tools], function(t) t$tool()) } else { tools_allowed <- subagent_disallow_recursion(tools_allowed) @@ -534,8 +542,8 @@ btw_can_register_subagent_tool <- function() { tools_allowed <- flatten_and_check_tools(tools_allowed) ellmer::tool( - btw_tool_subagent_config(config), - name = "btw_tool_subagent", + btw_tool_agent_subagent_config(config), + name = "btw_tool_agent_subagent", description = build_subagent_description(tools_allowed), annotations = ellmer::tool_annotations( title = "Subagent", diff --git a/man/btw_tool_subagent.Rd b/man/btw_tool_agent_subagent.Rd similarity index 92% rename from man/btw_tool_subagent.Rd rename to man/btw_tool_agent_subagent.Rd index eaf92411..9a82d16b 100644 --- a/man/btw_tool_subagent.Rd +++ b/man/btw_tool_agent_subagent.Rd @@ -1,10 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tool-subagent.R -\name{btw_tool_subagent} -\alias{btw_tool_subagent} +% Please edit documentation in R/tool-agent-subagent.R +\name{btw_tool_agent_subagent} +\alias{btw_tool_agent_subagent} \title{Tool: Subagent} \usage{ -btw_tool_subagent(prompt, tools = NULL, session_id = NULL, `_intent` = "") +btw_tool_agent_subagent( + prompt, + tools = NULL, + session_id = NULL, + `_intent` = "" +) } \arguments{ \item{prompt}{Character string with the task description for the subagent. @@ -34,7 +39,7 @@ A \code{BtwSubagentResult} object (inherits from \code{BtwToolResult}) with: } } \description{ -\code{btw_tool_subagent()} is a btw tool that enables hierarchical agent +\code{btw_tool_agent_subagent()} is a btw tool that enables hierarchical agent workflows. When used by an LLM assistant (like \code{\link[=btw_app]{btw_app()}}, \code{\link[=btw_client]{btw_client()}}, or third-party tools like Claude Code), this tool allows the orchestrating agent to delegate complex tasks to specialized subagents, each with their own @@ -102,7 +107,7 @@ filter on top of the resolved tools, regardless of their source. \examples{ \dontrun{ # Typically used by LLMs via tool use, but can be called directly for testing -result <- btw_tool_subagent( +result <- btw_tool_agent_subagent( prompt = "List all R files in the current directory", tools = c("btw_tool_files_list_files") ) @@ -112,7 +117,7 @@ cat(result@value) session_id <- result@session_id # Resume the same session with a follow-up -result2 <- btw_tool_subagent( +result2 <- btw_tool_agent_subagent( prompt = "Now read the first file you found", tools = c("btw_tool_files_read_text_file"), session_id = session_id @@ -124,7 +129,7 @@ withr::local_options(list( btw.subagent.tools_default = "files" # Default to file tools only )) -result3 <- btw_tool_subagent( +result3 <- btw_tool_agent_subagent( prompt = "Find all TODO comments in R files" ) @@ -135,14 +140,14 @@ withr::local_options(list( )) # This works - files tools are allowed -result4 <- btw_tool_subagent( +result4 <- btw_tool_agent_subagent( prompt = "List R files", tools = "files" ) # This would error - github tools are not in the allowed list tryCatch( - btw_tool_subagent( + btw_tool_agent_subagent( prompt = "Create a GitHub issue", tools = "github" ), diff --git a/man/btw_tool_run_r.Rd b/man/btw_tool_run_r.Rd index 41f63fcd..8aad7d1f 100644 --- a/man/btw_tool_run_r.Rd +++ b/man/btw_tool_run_r.Rd @@ -4,7 +4,7 @@ \alias{btw_tool_run_r} \title{Tool: Run R code} \usage{ -btw_tool_run_r(code, `_intent` = "") +btw_tool_run_r(code, `_intent`) } \arguments{ \item{code}{A character string containing R code to run.} diff --git a/man/btw_tools.Rd b/man/btw_tools.Rd index 257d456b..5b982abc 100644 --- a/man/btw_tools.Rd +++ b/man/btw_tools.Rd @@ -32,7 +32,8 @@ interface with your computational environment. Chats returned by this function have access to the tools: \subsection{Group: agent}{\tabular{ll}{ Name \tab Description \cr - \code{\link[=btw_tool_subagent]{btw_tool_subagent()}} \tab Delegate a task to a specialized assistant that can work independently with its own conversation thread. \cr + \code{\link[=btw_tool_agent_subagent]{btw_tool_agent_subagent()}} \tab \cr + Delegate a task to a specialized assistant that can work independently with its own conversation thread. \tab \cr } } diff --git a/tests/testthat/helpers-mock-pkg.R b/tests/testthat/helpers-mock-pkg.R index 493573d0..bb5a0b87 100644 --- a/tests/testthat/helpers-mock-pkg.R +++ b/tests/testthat/helpers-mock-pkg.R @@ -7,14 +7,14 @@ local_minimal_package <- function( .local_envir = parent.frame() ) { pkg_dir <- withr::local_tempdir(.local_envir = .local_envir) - + # Create package structure dir.create(file.path(pkg_dir, "R"), recursive = TRUE) if (with_tests) { dir.create(file.path(pkg_dir, "tests", "testthat"), recursive = TRUE) } dir.create(file.path(pkg_dir, "man"), recursive = TRUE) - + # Write minimal DESCRIPTION desc <- sprintf( "Package: %s @@ -30,11 +30,13 @@ RoxygenNote: 7.0.0 pkg_name ) writeLines(desc, file.path(pkg_dir, "DESCRIPTION")) - + # Write minimal NAMESPACE - writeLines("# Generated by roxygen2: do not edit by hand", - file.path(pkg_dir, "NAMESPACE")) - + writeLines( + "# Generated by roxygen2: do not edit by hand", + file.path(pkg_dir, "NAMESPACE") + ) + # Always write at least a simple R function for valid package structure if (with_coverage) { r_code <- "# Example function @@ -65,7 +67,7 @@ multiply_numbers <- function(x, y) { } " writeLines(r_code, file.path(pkg_dir, "R", "example.R")) - + # Write corresponding test (only tests add_numbers, not multiply_numbers) if (with_tests) { test_code <- "test_that(\"add_numbers works\", { @@ -79,8 +81,11 @@ test_that(\"add_numbers validates input\", { expect_error(add_numbers(1, \"b\"), \"must be numeric\") }) " - writeLines(test_code, file.path(pkg_dir, "tests", "testthat", "test-example.R")) - + writeLines( + test_code, + file.path(pkg_dir, "tests", "testthat", "test-example.R") + ) + # Write testthat.R helper testthat_helper <- sprintf( "library(testthat) @@ -102,7 +107,6 @@ pkg_version <- \"0.1.0\" " writeLines(r_code, file.path(pkg_dir, "R", "constants.R")) } - + invisible(pkg_dir) } - diff --git a/tests/testthat/test-tool-subagent.R b/tests/testthat/test-tool-agent-subagent.R similarity index 89% rename from tests/testthat/test-tool-subagent.R rename to tests/testthat/test-tool-agent-subagent.R index b82345f7..e0f03028 100644 --- a/tests/testthat/test-tool-subagent.R +++ b/tests/testthat/test-tool-agent-subagent.R @@ -217,15 +217,15 @@ test_that("build_subagent_description() includes basic text", { expect_match(desc, "subagent") }) -test_that("btw_tool_subagent is registered in btw_tools", { +test_that("btw_tool_agent_subagent is registered in btw_tools", { all_tools <- btw_tools() tool_names <- sapply(all_tools, function(t) t@name) - expect_true("btw_tool_subagent" %in% tool_names) + expect_true("btw_tool_agent_subagent" %in% tool_names) - subagent_tool <- all_tools[[which(tool_names == "btw_tool_subagent")]] + subagent_tool <- all_tools[[which(tool_names == "btw_tool_agent_subagent")]] - expect_equal(subagent_tool@name, "btw_tool_subagent") + expect_equal(subagent_tool@name, "btw_tool_agent_subagent") expect_type(subagent_tool@description, "character") expect_match(subagent_tool@description, "Delegate a task") expect_true(length(subagent_tool@arguments) > 0) @@ -431,10 +431,10 @@ test_that("btw_subagent_client_config() tools_allowed works with specific tool n # Tests for subagent tool filtering (prevents recursive subagents) -test_that("btw_tool_subagent errors when explicitly requested", { +test_that("btw_tool_agent_subagent errors when explicitly requested", { # Explicitly requesting the subagent tool now throws an error expect_error( - btw_subagent_client_config(tools = c("btw_tool_subagent", "docs")), + btw_subagent_client_config(tools = c("btw_tool_agent_subagent", "docs")), "Subagents cannot spawn other subagents" ) @@ -445,7 +445,7 @@ test_that("btw_tool_subagent errors when explicitly requested", { ) }) -test_that("btw_tool_subagent is filtered out from default tools", { +test_that("btw_tool_agent_subagent is filtered out from default tools", { withr::local_options( btw.subagent.tools_default = NULL, btw.tools = NULL, @@ -457,25 +457,25 @@ test_that("btw_tool_subagent is filtered out from default tools", { tool_names <- map_chr(chat$get_tools(), function(t) t@name) - # btw_tool_subagent should not be in the tools - expect_false("btw_tool_subagent" %in% tool_names) + # btw_tool_agent_subagent should not be in the tools + expect_false("btw_tool_agent_subagent" %in% tool_names) # But other tools should be present expect_true(length(tool_names) > 0) }) -test_that("btw_tool_subagent is silently filtered out from 'agent' tool group", { - # Request the 'agent' tool group which includes btw_tool_subagent +test_that("btw_tool_agent_subagent is silently filtered out from 'agent' tool group", { + # Request the 'agent' tool group which includes btw_tool_agent_subagent # The subagent tool is silently filtered via can_register (no warning) chat <- btw_subagent_client_config(tools = c("agent")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) - # btw_tool_subagent should be filtered out - expect_false("btw_tool_subagent" %in% tool_names) + # btw_tool_agent_subagent should be filtered out + expect_false("btw_tool_agent_subagent" %in% tool_names) }) -test_that("btw_tool_subagent is silently filtered out even when in tools_allowed", { +test_that("btw_tool_agent_subagent is silently filtered out even when in tools_allowed", { withr::local_options( btw.subagent.tools_allowed = c("agent", "docs") ) @@ -486,26 +486,26 @@ test_that("btw_tool_subagent is silently filtered out even when in tools_allowed tool_names <- map_chr(chat$get_tools(), function(t) t@name) - # btw_tool_subagent should still be filtered out - expect_false("btw_tool_subagent" %in% tool_names) + # btw_tool_agent_subagent should still be filtered out + expect_false("btw_tool_agent_subagent" %in% tool_names) # But other tools should be present expect_true(any(grepl("^btw_tool_docs_", tool_names))) }) -test_that("btw_tool_subagent never appears in chat$get_tools() for subagent", { +test_that("btw_tool_agent_subagent never appears in chat$get_tools() for subagent", { # Test multiple scenarios to ensure subagent tool never appears # Scenario 1: Explicit request → throws error expect_error( - btw_subagent_client_config(tools = c("btw_tool_subagent")), + btw_subagent_client_config(tools = c("btw_tool_agent_subagent")), "Subagents cannot spawn other subagents" ) # Scenario 2: Via tool group → silently filtered chat2 <- btw_subagent_client_config(tools = c("agent")) expect_false( - "btw_tool_subagent" %in% sapply(chat2$get_tools(), function(t) t@name) + "btw_tool_agent_subagent" %in% sapply(chat2$get_tools(), function(t) t@name) ) # Scenario 3: Default tools → silently filtered @@ -515,24 +515,26 @@ test_that("btw_tool_subagent never appears in chat$get_tools() for subagent", { ) chat3 <- btw_subagent_client_config(tools = NULL) expect_false( - "btw_tool_subagent" %in% sapply(chat3$get_tools(), function(t) t@name) + "btw_tool_agent_subagent" %in% sapply(chat3$get_tools(), function(t) t@name) ) # Scenario 4: Mixed explicit with other tools → throws error expect_error( - btw_subagent_client_config(tools = c("btw_tool_subagent", "docs", "files")), + btw_subagent_client_config( + tools = c("btw_tool_agent_subagent", "docs", "files") + ), "Subagents cannot spawn other subagents" ) }) test_that("subagent tool errors even when in tools_allowed", { withr::local_options( - btw.subagent.tools_allowed = c("btw_tool_subagent", "docs") + btw.subagent.tools_allowed = c("btw_tool_agent_subagent", "docs") ) # Even if subagent tool is in allowed list, explicit request throws error expect_error( - btw_subagent_client_config(tools = c("btw_tool_subagent", "docs")), + btw_subagent_client_config(tools = c("btw_tool_agent_subagent", "docs")), "Subagents cannot spawn other subagents" ) @@ -541,7 +543,7 @@ test_that("subagent tool errors even when in tools_allowed", { tool_names <- map_chr(chat$get_tools(), function(t) t@name) # Subagent tool should be filtered out - expect_false("btw_tool_subagent" %in% tool_names) + expect_false("btw_tool_agent_subagent" %in% tool_names) # Docs tools should remain expect_true(any(grepl("^btw_tool_docs_", tool_names))) From fe6b471c7459988610eb13857530da97e3249f52 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 10:59:21 -0500 Subject: [PATCH 20/44] tests: fix tests --- tests/testthat/test-tool-agent-subagent.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-tool-agent-subagent.R b/tests/testthat/test-tool-agent-subagent.R index e0f03028..86efcc82 100644 --- a/tests/testthat/test-tool-agent-subagent.R +++ b/tests/testthat/test-tool-agent-subagent.R @@ -392,12 +392,12 @@ test_that("btw_subagent_client_config() error message is helpful", { ) expect_error( - btw_subagent_client_config(tools = c("files", "github")), + btw_subagent_client_config(tools = c("files")), "btw_tool_files_" ) expect_error( - btw_subagent_client_config(tools = c("files", "github")), + btw_subagent_client_config(tools = c("github")), "btw_tool_github" ) From 9871cea3e1df9007fb386105c5c65d3e21df6e1a Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 2 Jan 2026 09:42:00 -0500 Subject: [PATCH 21/44] feat: custom agents --- DESCRIPTION | 1 + NAMESPACE | 1 + R/tool-agent-custom.R | 536 +++++++++++++++++++++++ R/tools.R | 21 +- R/utils.R | 50 +++ man/btw_agent_tool.Rd | 98 +++++ tests/testthat/test-tool-agent-custom.R | 558 ++++++++++++++++++++++++ 7 files changed, 1260 insertions(+), 5 deletions(-) create mode 100644 R/tool-agent-custom.R create mode 100644 man/btw_agent_tool.Rd create mode 100644 tests/testthat/test-tool-agent-custom.R diff --git a/DESCRIPTION b/DESCRIPTION index 4560f186..293ab684 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -97,6 +97,7 @@ Collate: 'task_create_readme.R' 'tool-result.R' 'tool-agent-subagent.R' + 'tool-agent-custom.R' 'tool-docs-news.R' 'tool-docs.R' 'tool-env-df.R' diff --git a/NAMESPACE b/NAMESPACE index aacbb3d3..4b169d11 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ S3method(btw_this,pkg_search_result) S3method(btw_this,tbl) S3method(btw_this,vignette) export(btw) +export(btw_agent_tool) export(btw_app) export(btw_client) export(btw_mcp_server) diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R new file mode 100644 index 00000000..01a4fa63 --- /dev/null +++ b/R/tool-agent-custom.R @@ -0,0 +1,536 @@ +#' @include tool-agent-subagent.R +NULL + +#' Discover agent-*.md files from project and user directories +#' +#' Scans for custom agent definition files in: +#' - `.btw/agent-*.md` (project level) +#' - `~/.btw/agent-*.md` (user level) +#' - `~/.config/btw/agent-*.md` (user level) +#' +#' @return Character vector of absolute paths to agent-*.md files +#' @noRd +discover_agent_md_files <- function() { + project_files <- find_project_agent_files() + user_files <- find_user_agent_files() + unique(c(project_files, user_files)) +} + +#' Read and parse an agent-*.md file +#' +#' Wrapper around `read_single_btw_file()` that extracts YAML frontmatter +#' and body content from an agent definition file. +#' +#' @param path Path to the agent-*.md file +#' @return List with YAML config and body content (system_prompt) +#' @noRd +read_agent_md_file <- function(path) { + if (!fs::file_exists(path)) { + return(NULL) + } + + config <- read_single_btw_file(path) + + # Rename btw_system_prompt to system_prompt for agent configs + if (!is.null(config$btw_system_prompt)) { + config$system_prompt <- config$btw_system_prompt + config$btw_system_prompt <- NULL + } + + config +} + +#' Validate agent name +#' +#' Ensures the agent name is a valid R identifier and not reserved. +#' +#' @param name The agent name from YAML frontmatter +#' @param path Path to the file (for error messages) +#' @return TRUE if valid, otherwise signals an error +#' @noRd +validate_agent_name <- function(name, path) { + check_string(name, allow_null = TRUE) + + if (is.null(name) || !nzchar(name)) { + cli::cli_warn(c( + "Agent file has no name: {.path {path}}", + "i" = "Add {.code name: agent_name} to the YAML frontmatter.", + "i" = "Skipping this file." + )) + return(FALSE) + } + + # Check for reserved name + if (name %in% names(.btw_tools)) { + cli::cli_warn(c( + "Agent name cannot be {.val {name}}: {.path {path}}", + "i" = "The name {.val {name}} is reserved. Skipping this file." + )) + return(FALSE) + } + + # Check if valid R identifier + if (!grepl("^[a-zA-Z][a-zA-Z0-9_]*$", name)) { + cli::cli_warn(c( + "Invalid agent name {.val {name}}: {.path {path}}", + "i" = "Agent names must be valid R identifiers (letters, numbers, underscores).", + "i" = "Names must start with a letter.", + "i" = "Skipping this file." + )) + return(FALSE) + } + + TRUE +} + +#' Create a custom agent tool from a markdown file +#' +#' @description +#' Creates an [ellmer::tool()] from a markdown file that defines a custom agent. +#' The tool can be registered with a chat client to delegate tasks to a +#' specialized assistant with its own system prompt and tool configuration. +#' +#' ## Agent File Format +#' +#' Agent files use YAML frontmatter to configure the agent, with the markdown +#' body becoming the agent's system prompt. The file should be named +#' `agent-{name}.md`. +#' +#' ### Required Fields +#' +#' * `name`: A valid R identifier (letters, numbers, underscores) that becomes +#' part of the tool name. Cannot be `"subagent"` (reserved). +#' +#' ### Optional Fields +#' +#' * `description`: Tool description shown to the LLM. Defaults to a generic +#' delegation message. +#' * `title`: User-facing title for the tool. Defaults to title-cased name. +#' * `icon`: Font Awesome icon name (e.g., `"robot"`, `"code"`). Defaults to +#' the standard agent icon. +#' * `client`: Model specification like `"anthropic/claude-sonnet-4-20250514"`. +#' Falls back to `btw.subagent.client` or `btw.client` options. +#' * `tools`: List of tool names or groups available to this agent. Defaults to +#' all non-agent tools. +#' +#' ### Example Agent File +#' +#' ```yaml +#' --- +#' name: code_reviewer +#' description: Reviews code for best practices and potential issues. +#' title: Code Reviewer +#' icon: magnifying-glass-chart +#' tools: +#' - files +#' - docs +#' --- +#' +#' You are a code reviewer. Analyze code for: +#' - Best practices and style + +#' - Potential bugs or issues +#' - Performance considerations +#' +#' Provide specific, actionable feedback. +#' ``` +#' +#' ## Automatic Discovery +#' +#' Agent files are automatically discovered by [btw_tools()] when placed in: +#' +#' * **Project level**: `.btw/agent-*.md` in your project directory +#' * **User level**: `~/.btw/agent-*.md` or `~/.config/btw/agent-*.md` +#' +#' Project-level agents take precedence over user-level agents with the same +#' name. +#' +#' @param path Path to an agent markdown file (`agent-*.md`). +#' +#' @return An `ellmer::ToolDef` object that can be registered with a chat +#' client, or `NULL` if the file is invalid (with a warning). +#' +#' @seealso [btw_tools()] for automatic agent discovery, [btw_client()] for +#' creating chat clients with tools. +#' +#' @examples +#' \dontrun{ +#' # Create a tool from a specific agent file +#' tool <- btw_agent_tool("path/to/agent-reviewer.md") +#' +#' # Register with a chat client +#' chat <- ellmer::chat_anthropic() +#' chat$register_tool(tool) +#' +#' # Or include with other btw tools +#' chat$register_tools(c(btw_tools("docs"), tool)) +#' } +#' +#' @export +btw_agent_tool <- function(path) { + check_string(path) + + if (!fs::file_exists(path)) { + cli::cli_abort("Agent file not found: {.path {path}}") + } + + config <- read_agent_md_file(path) + + if (is.null(config)) { + return(NULL) + } + + name <- config$name + + if (!validate_agent_name(name, path)) { + return(NULL) + } + + # Build tool name: btw_tool_agent_{name} + tool_name <- paste0("btw_tool_agent_", name) + + # Description: use provided or generate default + description <- config$description %||% + sprintf("Delegate a task to the %s specialized assistant.", name) + + # Title: use provided or generate from name + title <- config$title %||% to_title_case(gsub("_", " ", name)) + + # Build the agent configuration for btw_tool_agent_custom_impl + agent_config <- list( + name = name, + client = config$client, + tools = config$tools, + system_prompt = config$system_prompt, + tools_default = getOption("btw.subagent.tools_default") %||% + getOption("btw.tools"), + tools_allowed = getOption("btw.subagent.tools_allowed") + ) + + # Create the tool function with agent_config captured in closure + tool_fn <- btw_tool_agent_custom_config(agent_config) + + # Build the ellmer::tool() + tool <- ellmer::tool( + tool_fn, + name = tool_name, + description = description, + annotations = ellmer::tool_annotations( + title = title, + read_only_hint = FALSE, + open_world_hint = TRUE + ), + arguments = list( + prompt = ellmer::type_string( + "The complete task description for the agent. Be specific and clear about requirements and expected output." + ), + session_id = ellmer::type_string( + "Optional: session_id from a previous call to continue that conversation. Omit to start a new session.", + required = FALSE + ) + ) + ) + + # Set icon if specified, otherwise use default agent icon + if (!is.null(config$icon) && nzchar(config$icon)) { + tryCatch( + { + tool@annotations$icon <- shiny::icon(config$icon) + }, + error = function(e) { + cli::cli_warn(c( + "Invalid icon {.val {config$icon}} for agent {.val {name}}: {.path {path}}", + "i" = "Using default agent icon.", + "x" = conditionMessage(e) + )) + tool@annotations$icon <<- tool_group_icon("agent") + } + ) + } else { + tool@annotations$icon <- tool_group_icon("agent") + } + + tool +} + +#' Execute custom subagent +#' +#' Implementation function that executes a custom agent with its configuration. +#' This reuses the session management and execution logic from btw_tool_agent_subagent_impl. +#' +#' @param prompt Task description for the agent +#' @param session_id Optional session ID to resume a conversation +#' @param agent_config Configuration for this custom agent +#' @return A BtwSubagentResult object +#' @noRd +btw_tool_agent_custom_impl <- function( + prompt, + session_id = NULL, + agent_config +) { + check_string(prompt) + check_string(session_id, allow_null = TRUE) + + if (!is.null(session_id)) { + session <- retrieve_session(session_id) + + if (is.null(session)) { + cli::cli_abort(c( + "Session not found: {.val {session_id}}", + "i" = "The session may have expired or the ID is incorrect.", + "i" = "Omit {.arg session_id} to start a new session." + )) + } + + chat <- session$chat + } else { + session_id <- generate_session_id() + chat <- btw_custom_agent_client_config(agent_config) + store_session(session_id, chat) + } + + response <- chat$chat(prompt) + + last_turn <- chat$last_turn() + message_text <- if (is.null(last_turn) || length(last_turn@contents) == 0) { + "(The agent completed successfully but returned no message.)" + } else { + ellmer::contents_markdown(last_turn) + } + message_text <- sprintf( + '\n%s\n', + agent_config$name, + session_id, + message_text + ) + + # Get tokens for just this round + idx_prompt <- which(map_lgl(chat$get_turns(), function(t) { + t@role == "user" && identical(ellmer::contents_text(t), prompt) + })) + chat2 <- chat$clone() + if (idx_prompt > 1) { + chat2$set_turns(chat2$get_turns()[-seq_len(idx_prompt - 1)]) + } + tokens <- chat2$get_tokens() + for (i in seq_len(ncol(tokens))) { + if (is.numeric(tokens[[i]])) { + tokens[[i]] <- format(tokens[[i]], big.mark = ",") + } + } + + tool_calls <- map(chat2$get_turns(), function(turn) { + keep(turn@contents, S7::S7_inherits, ellmer::ContentToolRequest) + }) + + provider <- chat$get_provider()@name + model <- chat$get_model() + tool_names <- paste( + sprintf("`%s`", names(chat$get_tools())), + collapse = ", " + ) + + display_md <- glue_( + r"( + #### Prompt + + **Agent:** {{ agent_config$name }}
+ **Session ID:** {{ session_id }}
+ **Provider:** {{ provider }}
+ **Model:** `{{ model }}`
+ **Tools:** {{ tool_names }} + + {{ prompt }} + + #### Tokens + + **Tool Calls:** {{ length(unlist(tool_calls)) }} + + {{ md_table(tokens) }} + + #### Response + + {{ message_text }} + )" + ) + + BtwSubagentResult( + value = message_text, + session_id = session_id, + extra = list( + prompt = prompt, + agent = agent_config$name, + provider = provider, + model = model, + tokens = tokens, + display = list( + markdown = display_md, + show_request = FALSE + ) + ) + ) +} + +#' Configure custom agent client +#' +#' Creates and configures an ellmer Chat client for a custom agent session. +#' Similar to btw_subagent_client_config but uses agent-specific configuration. +#' +#' @param agent_config List with agent configuration +#' @return A configured Chat object with system prompt and tools attached +#' @noRd +btw_custom_agent_client_config <- function(agent_config) { + # Determine client + custom_client <- + agent_config$client %||% + getOption("btw.subagent.client") %||% + getOption("btw.client") + + # Determine tools + tools_default <- + agent_config$tools_default %||% + getOption("btw.subagent.tools_default") %||% + getOption("btw.tools") + + tools_allowed <- + agent_config$tools_allowed %||% + getOption("btw.subagent.tools_allowed") + + # If agent specifies tools, use them; otherwise use defaults (non-agent tools) + configured_tools <- if (!is.null(agent_config$tools)) { + agent_config$tools + } else if (!is.null(tools_default)) { + tools_default + } else { + # Default: all non-agent tools + compact(map(.btw_tools, function(t) { + if (!grepl("^btw_tool_agent_", t$name)) t$tool() + })) + } + + configured_tools <- flatten_and_check_tools(configured_tools) + + # Apply tools_allowed whitelist if set + if (!is.null(tools_allowed)) { + allowed_tools <- flatten_and_check_tools(tools_allowed) + allowed_names <- map_chr(allowed_tools, function(t) t@name) + configured_names <- map_chr(configured_tools, function(t) t@name) + + # Filter to only allowed tools (no error for custom agents) + configured_tools <- keep(configured_tools, function(t) { + t@name %in% allowed_names + }) + } + + # Create chat client + chat <- if (!is.null(custom_client)) { + as_ellmer_client(custom_client)$clone() + } else { + btw_default_chat_client() + } + + # Build system prompt: base subagent prompt + custom agent prompt + base_prompt <- btw_prompt("btw-subagent.md") + custom_prompt <- agent_config$system_prompt %||% "" + + system_prompt <- if (nzchar(custom_prompt)) { + paste(base_prompt, custom_prompt, sep = "\n\n---\n\n") + } else { + base_prompt + } + + chat$set_system_prompt(system_prompt) + chat$set_tools(configured_tools) + + chat +} + +#' Create tool function with captured agent configuration +#' +#' Returns a closure that captures the agent_config and calls btw_tool_agent_custom_impl. +#' +#' @param agent_config List with agent configuration +#' @return Function that implements the tool +#' @noRd +btw_tool_agent_custom_config <- function(agent_config) { + force(agent_config) + + function(prompt, session_id = NULL) { + btw_tool_agent_custom_impl( + prompt = prompt, + session_id = session_id, + agent_config = agent_config + ) + } +} + +#' Get custom agent tools with lazy discovery and caching +#' +#' Discovers agent-*.md files, validates and loads them, and returns +#' a list of tool definitions ready to be added to .btw_tools. +#' +#' Called during tool registration to dynamically add custom agent tools. +#' +#' @return Named list of tool definitions compatible with .btw_add_to_tools +#' @noRd +get_custom_agent_tools <- function() { + files <- discover_agent_md_files() + + if (length(files) == 0) { + return(list()) + } + + tools <- list() + + for (file in files) { + tryCatch( + { + tool <- btw_agent_tool(file) + + if (!is.null(tool)) { + tool_name <- tool@name + # Use local() to properly capture tool in closure + tools[[tool_name]] <- local({ + captured_tool <- tool + list( + name = tool_name, + group = "agent", + tool = function() captured_tool + ) + }) + } + }, + error = function(e) { + cli::cli_warn(c( + "Error loading custom agent: {.path {file}}", + "x" = conditionMessage(e), + "i" = "Skipping this file." + )) + } + ) + } + + tools +} + +#' Register custom agent tools +#' +#' This function is called to dynamically register custom agents found in +#' agent-*.md files. It's separated from the discovery logic to allow +#' registration to happen at the appropriate time during package load. +#' +#' @noRd +register_custom_agent_tools <- function() { + tools <- get_custom_agent_tools() + + for (tool_name in names(tools)) { + tool_def <- tools[[tool_name]] + .btw_add_to_tools( + name = tool_def$name, + group = tool_def$group, + tool = tool_def$tool + ) + } + + invisible(NULL) +} diff --git a/R/tools.R b/R/tools.R index 3d0cd76b..06627aaa 100644 --- a/R/tools.R +++ b/R/tools.R @@ -40,16 +40,27 @@ #' #' @export btw_tools <- function(...) { + tools <- c(...) check_character(tools, allow_null = TRUE) + # Merge built-in tools with custom agent tools from agent-*.md files + all_btw_tools <- .btw_tools + custom_agents <- get_custom_agent_tools() + for (name in names(custom_agents)) { + # Custom agents don't override built-in tools + if (!name %in% names(all_btw_tools)) { + all_btw_tools[[name]] <- custom_agents[[name]] + } + } + if (length(tools) == 0) { withr::local_options(.btw_tools.match_mode = "all") - tools <- names(.btw_tools) + tools <- names(all_btw_tools) } else { withr::local_options(.btw_tools.match_mode = "explicit") - tool_names <- map_chr(.btw_tools, function(x) x$name) - tool_groups <- map_chr(.btw_tools, function(x) x$group) + tool_names <- map_chr(all_btw_tools, function(x) x$name) + tool_groups <- map_chr(all_btw_tools, function(x) x$group) allowed <- c( tool_groups, @@ -72,8 +83,8 @@ btw_tools <- function(...) { ) } - tools_to_keep <- map_lgl(.btw_tools, is_tool_match, tools) - res <- .btw_tools[tools_to_keep] + tools_to_keep <- map_lgl(all_btw_tools, is_tool_match, tools) + res <- all_btw_tools[tools_to_keep] # as_ellmer_tools() now handles can_register checks before instantiation # and propagates can_register to btw_can_register annotation diff --git a/R/utils.R b/R/utils.R index 64576a88..d9b08bd2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -174,9 +174,59 @@ path_find_user <- function(filename) { } detect_project_is_r_package <- function(dir = getwd()) { + !is.null(path_find_in_project("DESCRIPTION", dir)) } +# Agent file discovery --------------------------------------------------------- + +#' Find project-level agent-*.md files +#' +#' Searches for agent definition files in the `.btw/` directory within the +#' project root. +#' +#' @param dir Starting directory for search (defaults to current working directory) +#' @return Character vector of absolute paths to agent-*.md files, or empty character +#' @noRd +find_project_agent_files <- function(dir = getwd()) { + btw_dir <- path_find_in_project(".btw", dir) + + if (is.null(btw_dir) || !fs::dir_exists(btw_dir)) { + return(character()) + } + + files <- fs::dir_ls(btw_dir, regexp = "agent-.*\\.md$", type = "file") + as.character(files) +} + +#' Find user-level agent-*.md files +#' +#' Searches for agent definition files in user configuration directories: +#' `~/.btw/` and `~/.config/btw/`. +#' +#' @return Character vector of absolute paths to agent-*.md files, or empty character +#' @noRd +find_user_agent_files <- function() { + if (identical(Sys.getenv("TESTTHAT"), "true")) { + return(character()) + } + + user_dirs <- c( + fs::path_home(".btw"), + fs::path_home(".config", "btw") + ) + + files <- character() + for (dir in user_dirs) { + if (fs::dir_exists(dir)) { + found <- fs::dir_ls(dir, regexp = "agent-.*\\.md$", type = "file") + files <- c(files, as.character(found)) + } + } + + files +} + path_btw_cache <- function(...) { cache_base <- normalizePath( tools::R_user_dir("btw", which = "cache"), diff --git a/man/btw_agent_tool.Rd b/man/btw_agent_tool.Rd new file mode 100644 index 00000000..3d69cc4a --- /dev/null +++ b/man/btw_agent_tool.Rd @@ -0,0 +1,98 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tool-agent-custom.R +\name{btw_agent_tool} +\alias{btw_agent_tool} +\title{Create a custom agent tool from a markdown file} +\usage{ +btw_agent_tool(path) +} +\arguments{ +\item{path}{Path to an agent markdown file (\verb{agent-*.md}).} +} +\value{ +An \code{ellmer::ToolDef} object that can be registered with a chat +client, or \code{NULL} if the file is invalid (with a warning). +} +\description{ +Creates an \code{\link[ellmer:tool]{ellmer::tool()}} from a markdown file that defines a custom agent. +The tool can be registered with a chat client to delegate tasks to a +specialized assistant with its own system prompt and tool configuration. +\subsection{Agent File Format}{ + +Agent files use YAML frontmatter to configure the agent, with the markdown +body becoming the agent's system prompt. The file should be named +\verb{agent-\{name\}.md}. +\subsection{Required Fields}{ +\itemize{ +\item \code{name}: A valid R identifier (letters, numbers, underscores) that becomes +part of the tool name. Cannot be \code{"subagent"} (reserved). +} +} + +\subsection{Optional Fields}{ +\itemize{ +\item \code{description}: Tool description shown to the LLM. Defaults to a generic +delegation message. +\item \code{title}: User-facing title for the tool. Defaults to title-cased name. +\item \code{icon}: Font Awesome icon name (e.g., \code{"robot"}, \code{"code"}). Defaults to +the standard agent icon. +\item \code{client}: Model specification like \code{"anthropic/claude-sonnet-4-20250514"}. +Falls back to \code{btw.subagent.client} or \code{btw.client} options. +\item \code{tools}: List of tool names or groups available to this agent. Defaults to +all non-agent tools. +} +} + +\subsection{Example Agent File}{ + +\if{html}{\out{
}}\preformatted{--- +name: code_reviewer +description: Reviews code for best practices and potential issues. +title: Code Reviewer +icon: magnifying-glass-chart +tools: + - files + - docs +--- + +You are a code reviewer. Analyze code for: +- Best practices and style +- Potential bugs or issues +- Performance considerations + +Provide specific, actionable feedback. +}\if{html}{\out{
}} +} + +} + +\subsection{Automatic Discovery}{ + +Agent files are automatically discovered by \code{\link[=btw_tools]{btw_tools()}} when placed in: +\itemize{ +\item \strong{Project level}: \verb{.btw/agent-*.md} in your project directory +\item \strong{User level}: \verb{~/.btw/agent-*.md} or \verb{~/.config/btw/agent-*.md} +} + +Project-level agents take precedence over user-level agents with the same +name. +} +} +\examples{ +\dontrun{ +# Create a tool from a specific agent file +tool <- btw_agent_tool("path/to/agent-reviewer.md") + +# Register with a chat client +chat <- ellmer::chat_anthropic() +chat$register_tool(tool) + +# Or include with other btw tools +chat$register_tools(c(btw_tools("docs"), tool)) +} + +} +\seealso{ +\code{\link[=btw_tools]{btw_tools()}} for automatic agent discovery, \code{\link[=btw_client]{btw_client()}} for +creating chat clients with tools. +} diff --git a/tests/testthat/test-tool-agent-custom.R b/tests/testthat/test-tool-agent-custom.R new file mode 100644 index 00000000..ef3e8566 --- /dev/null +++ b/tests/testthat/test-tool-agent-custom.R @@ -0,0 +1,558 @@ +# Helper to create a valid agent-*.md file +create_test_agent_file <- function(dir, name = "test_agent", content = NULL) { + if (is.null(content)) { + content <- sprintf( + "--- +name: %s +description: A test agent +title: Test Agent +tools: + - files +--- + +This is the system prompt for the test agent.", + name + ) + } + + path <- file.path(dir, sprintf("agent-%s.md", name)) + writeLines(content, path) + path +} + +# Test file discovery --------------------------------------------------------- + +test_that("find_project_agent_files() finds .btw/agent-*.md files", { + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + # Create some agent files + agent1 <- file.path(btw_dir, "agent-code-reviewer.md") + agent2 <- file.path(btw_dir, "agent-docs-writer.md") + writeLines("---\nname: code_reviewer\n---\nReview code.", agent1) + writeLines("---\nname: docs_writer\n---\nWrite docs.", agent2) + + # Also create a non-matching file + writeLines("Not an agent", file.path(btw_dir, "other.md")) + + files <- withr::with_dir(tmp_dir, find_project_agent_files()) + + expect_length(files, 2) + expect_true(any(grepl("agent-code-reviewer.md$", files))) + expect_true(any(grepl("agent-docs-writer.md$", files))) + expect_false(any(grepl("other.md$", files))) +}) + +test_that("find_project_agent_files() returns empty when no .btw directory", { + tmp_dir <- withr::local_tempdir() + + files <- withr::with_dir(tmp_dir, find_project_agent_files()) + + expect_length(files, 0) +}) + +test_that("find_project_agent_files() returns empty when .btw exists but no agents", { + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + # Create a non-agent file + writeLines("Not an agent", file.path(btw_dir, "other.md")) + + files <- withr::with_dir(tmp_dir, find_project_agent_files()) + + expect_length(files, 0) +}) + +test_that("find_user_agent_files() returns empty in test mode", { + # In testthat, TESTTHAT=true, so should return empty + expect_equal(Sys.getenv("TESTTHAT"), "true") + + files <- find_user_agent_files() + + expect_length(files, 0) +}) + +test_that("discover_agent_md_files() combines project and user files", { + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + agent1 <- file.path(btw_dir, "agent-test1.md") + writeLines("---\nname: test1\n---\nTest 1.", agent1) + + # Clear cache + + files <- withr::with_dir(tmp_dir, discover_agent_md_files()) + + expect_length(files, 1) + expect_true(any(grepl("agent-test1.md$", files))) +}) + +test_that("discover_agent_md_files() returns unique files", { + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + agent1 <- file.path(btw_dir, "agent-unique.md") + writeLines("---\nname: unique\n---\nUnique agent.", agent1) + + # Clear cache + + files <- withr::with_dir(tmp_dir, discover_agent_md_files()) + + # Should not have duplicates + expect_equal(length(files), length(unique(files))) +}) + +# Test name validation -------------------------------------------------------- + +test_that("validate_agent_name() accepts valid names", { + valid_names <- c( + "my_agent", + "CodeReviewer", + "agent1", + "test_agent_v2", + "AgentName" + ) + + for (name in valid_names) { + expect_true(validate_agent_name(name, "test.md")) + } +}) + +test_that("validate_agent_name() rejects empty or NULL names", { + expect_warning( + result <- validate_agent_name(NULL, "test.md"), + "has no name" + ) + expect_false(result) + + expect_warning( + result <- validate_agent_name("", "test.md"), + "has no name" + ) + expect_false(result) +}) + +test_that("validate_agent_name() rejects reserved names (built-in tool names)", { + # Any name that matches a built-in tool name is reserved + reserved_name <- names(.btw_tools)[1] + + expect_warning( + result <- validate_agent_name(reserved_name, "test.md"), + "reserved" + ) + expect_false(result) +}) + +test_that("validate_agent_name() rejects invalid characters", { + invalid_names <- c( + "123invalid", + "has-dash", + "has space", + "has.dot", + "has@symbol" + ) + + for (name in invalid_names) { + expect_warning( + result <- validate_agent_name(name, "test.md"), + "Invalid agent name" + ) + expect_false(result) + } +}) + +test_that("validate_agent_name() warning messages include path", { + expect_warning( + validate_agent_name(NULL, "/path/to/agent.md"), + "/path/to/agent.md" + ) + + expect_warning( + validate_agent_name(names(.btw_tools)[1], "/path/to/agent.md"), + "/path/to/agent.md" + ) + + expect_warning( + validate_agent_name("123invalid", "/path/to/agent.md"), + "/path/to/agent.md" + ) +}) + +# Test file parsing ----------------------------------------------------------- + +test_that("read_agent_md_file() returns NULL for non-existent file", { + result <- read_agent_md_file("/nonexistent/path/agent.md") + + expect_null(result) +}) + +test_that("read_agent_md_file() parses YAML frontmatter", { + tmp_dir <- withr::local_tempdir() + path <- create_test_agent_file(tmp_dir, "parser_test") + + config <- read_agent_md_file(path) + + expect_type(config, "list") + expect_equal(config$name, "parser_test") + expect_equal(config$description, "A test agent") + expect_equal(config$title, "Test Agent") + # YAML parses tools as character vector, not list + expect_equal(config$tools, "files") +}) + +test_that("read_agent_md_file() extracts body as system_prompt", { + tmp_dir <- withr::local_tempdir() + path <- create_test_agent_file(tmp_dir, "body_test") + + config <- read_agent_md_file(path) + + expect_true("system_prompt" %in% names(config)) + expect_match(config$system_prompt, "This is the system prompt") +}) + +test_that("read_agent_md_file() handles files without YAML", { + tmp_dir <- withr::local_tempdir() + path <- file.path(tmp_dir, "agent-no-yaml.md") + writeLines("Just body content, no frontmatter.", path) + + # This should still work but return minimal config + config <- read_agent_md_file(path) + + expect_type(config, "list") + expect_true("system_prompt" %in% names(config)) +}) + +test_that("read_agent_md_file() handles various YAML fields", { + tmp_dir <- withr::local_tempdir() + content <- "--- +name: complex_agent +description: A complex agent +title: Complex Agent +icon: robot +client: anthropic/claude-sonnet-4-20250514 +tools: + - files + - docs +--- + +Complex system prompt with multiple lines. +And more content here." + + path <- file.path(tmp_dir, "agent-complex.md") + writeLines(content, path) + + config <- read_agent_md_file(path) + + expect_equal(config$name, "complex_agent") + expect_equal(config$description, "A complex agent") + expect_equal(config$title, "Complex Agent") + expect_equal(config$icon, "robot") + expect_equal(config$client, "anthropic/claude-sonnet-4-20250514") + expect_length(config$tools, 2) + expect_match(config$system_prompt, "Complex system prompt") +}) + +# Test tool creation ---------------------------------------------------------- +# Note: btw_agent_tool() returns raw tools that get wrapped with _intent +# argument later by as_ellmer_tools(). These tests check the unwrapped tools. + +test_that("btw_agent_tool() returns NULL for invalid name", { + tmp_dir <- withr::local_tempdir() + agent_file <- file.path(tmp_dir, "agent-invalid.md") + writeLines( + "---\nname: 123invalid\ndescription: Test\n---\nPrompt.", + agent_file + ) + + expect_warning( + result <- btw_agent_tool(agent_file), + "Invalid agent name" + ) + expect_null(result) +}) + +test_that("btw_agent_tool() returns NULL for reserved name", { + tmp_dir <- withr::local_tempdir() + reserved_name <- names(.btw_tools)[1] + agent_file <- file.path(tmp_dir, sprintf("agent-%s.md", reserved_name)) + writeLines( + sprintf("---\nname: %s\ndescription: Test\n---\nPrompt.", reserved_name), + agent_file + ) + + expect_warning( + result <- btw_agent_tool(agent_file), + "reserved" + ) + expect_null(result) +}) + +test_that("btw_agent_tool() errors for non-existent file", { + expect_error( + btw_agent_tool("/nonexistent/path/agent-test.md"), + "Agent file not found" + ) +}) + +# Test integration with btw_tools() ------------------------------------------- +# These tests check the full integration through btw_tools() which applies +# all the necessary wrapping including _intent argument. + +test_that("custom agents can be discovered and loaded", { + skip_if_not_installed("ellmer") + + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + create_test_agent_file(btw_dir, "integration_test") + + # Clear cache + + # Get tools from that directory + tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + + expect_type(tools, "list") + expect_true("btw_tool_agent_integration_test" %in% names(tools)) + + tool_def <- tools[["btw_tool_agent_integration_test"]] + expect_equal(tool_def$name, "btw_tool_agent_integration_test") + expect_equal(tool_def$group, "agent") + expect_type(tool_def$tool, "closure") + + # Calling tool() should return a tool object (before wrapping) + tool <- tool_def$tool() + expect_equal(tool@name, "btw_tool_agent_integration_test") + expect_equal(tool@description, "A test agent") +}) + +test_that("get_custom_agent_tools() returns empty list when no agents", { + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + # Clear cache + + tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + + expect_length(tools, 0) +}) + +test_that("get_custom_agent_tools() skips files with invalid names", { + skip_if_not_installed("ellmer") + + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + # Create valid agent + create_test_agent_file(btw_dir, "valid_agent") + + # Create agent with invalid name + content_invalid <- "--- +name: 123invalid +description: Invalid +--- +Invalid agent." + writeLines(content_invalid, file.path(btw_dir, "agent-invalid.md")) + + # Clear cache + + expect_warning( + tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()), + "Invalid agent name" + ) + + # Should only have the valid agent + expect_length(tools, 1) + expect_true("btw_tool_agent_valid_agent" %in% names(tools)) +}) + +test_that("get_custom_agent_tools() skips files with missing name", { + skip_if_not_installed("ellmer") + + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + # Create agent without name + content_no_name <- "--- +description: No name +--- +Agent without name." + writeLines(content_no_name, file.path(btw_dir, "agent-noname.md")) + + # Clear cache + + tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + + expect_length(tools, 0) +}) + +test_that("get_custom_agent_tools() warns on error loading agent", { + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + # Create file with malformed YAML + content_bad_yaml <- "--- +name: bad_yaml +description: [invalid yaml structure +--- +Bad YAML." + writeLines(content_bad_yaml, file.path(btw_dir, "agent-bad.md")) + + # Clear cache + + expect_warning( + tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()), + "Error loading custom agent" + ) +}) + +test_that("get_custom_agent_tools() handles multiple agents", { + skip_if_not_installed("ellmer") + + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + create_test_agent_file(btw_dir, "agent_one") + create_test_agent_file(btw_dir, "agent_two") + create_test_agent_file(btw_dir, "agent_three") + + # Clear cache + + tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + + expect_length(tools, 3) + expect_true("btw_tool_agent_agent_one" %in% names(tools)) + expect_true("btw_tool_agent_agent_two" %in% names(tools)) + expect_true("btw_tool_agent_agent_three" %in% names(tools)) +}) + +# Test error handling --------------------------------------------------------- + +test_that("validate_agent_name() includes helpful messages", { + expect_warning( + validate_agent_name(NULL, "test.md"), + "Add.*name: agent_name" + ) + + expect_warning( + validate_agent_name(names(.btw_tools)[1], "test.md"), + "reserved" + ) + + expect_warning( + validate_agent_name("123bad", "test.md"), + "must be valid R identifiers" + ) + + expect_warning( + validate_agent_name("has-dash", "test.md"), + "must start with a letter" + ) +}) + +test_that("btw_agent_tool() returns valid tool for valid config", { + tmp_dir <- withr::local_tempdir() + agent_file <- file.path(tmp_dir, "agent-config_test.md") + writeLines( + c( + "---", + "name: config_test", + "description: A config test agent", + "tools:", + " - files", + " - docs", + "---", + "Test prompt" + ), + agent_file + ) + + tool <- btw_agent_tool(agent_file) + + # The tool should be created (not NULL) + expect_false(is.null(tool)) + # Check basic properties + expect_equal(tool@name, "btw_tool_agent_config_test") + expect_equal(tool@description, "A config test agent") +}) + +# Test agent name variations -------------------------------------------------- + +test_that("validate_agent_name() handles various valid patterns", { + valid_patterns <- c( + "a", # Single letter + "A", # Capital letter + "agent_123", # With numbers + "AgentName", # CamelCase + "agent_name_v2", # Multiple underscores + "MyAgent123" # Mixed + ) + + for (name in valid_patterns) { + expect_true(validate_agent_name(name, "test.md"), info = name) + } +}) + +test_that("validate_agent_name() rejects edge cases", { + invalid_cases <- c( + "_agent", # Starts with underscore + "1agent", # Starts with number + "agent-name", # Contains dash + "agent name", # Contains space + "agent.name", # Contains dot + "agent$name", # Contains special char + "" # Empty string + ) + + for (name in invalid_cases) { + expect_warning( + result <- validate_agent_name(name, "test.md"), + info = name + ) + expect_false(result, info = name) + } +}) + +# Test tool closure and configuration ----------------------------------------- + +test_that("btw_tool_agent_custom_config() creates proper closure", { + agent_config <- list( + name = "closure_test", + client = NULL, + tools = c("files"), + system_prompt = "Test", + tools_default = NULL, + tools_allowed = NULL + ) + + tool_fn <- btw_tool_agent_custom_config(agent_config) + + expect_type(tool_fn, "closure") + + # Function should have correct parameters (without _intent, which is added by wrapper) + fn_args <- names(formals(tool_fn)) + expect_true("prompt" %in% fn_args) + expect_true("session_id" %in% fn_args) + # _intent is NOT in the closure - it's added later by wrap_with_intent() + expect_false("_intent" %in% fn_args) +}) + +# Test register_custom_agent_tools() ------------------------------------------ + +test_that("register_custom_agent_tools() can be called without error", { + # This is mainly a smoke test - the function modifies .btw_tools + # which is a global state + + # Clear cache first + + expect_no_error(register_custom_agent_tools()) +}) From 9a92f38423050f157eaf4f6e17c3390c85b0c025 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 10:19:20 -0500 Subject: [PATCH 22/44] refactor: Consolidate subagent code, improve tests --- R/tool-agent-custom.R | 125 ++---- R/tool-agent-subagent.R | 183 ++++++--- tests/testthat/helpers-mock-agent.R | 44 +++ tests/testthat/test-tool-agent-custom.R | 441 +++++++--------------- tests/testthat/test-tool-agent-subagent.R | 285 +++++++------- 5 files changed, 473 insertions(+), 605 deletions(-) create mode 100644 tests/testthat/helpers-mock-agent.R diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R index 01a4fa63..319732c5 100644 --- a/R/tool-agent-custom.R +++ b/R/tool-agent-custom.R @@ -269,104 +269,38 @@ btw_tool_agent_custom_impl <- function( agent_config ) { check_string(prompt) - check_string(session_id, allow_null = TRUE) - if (!is.null(session_id)) { - session <- retrieve_session(session_id) - - if (is.null(session)) { - cli::cli_abort(c( - "Session not found: {.val {session_id}}", - "i" = "The session may have expired or the ID is incorrect.", - "i" = "Omit {.arg session_id} to start a new session." - )) - } - - chat <- session$chat - } else { - session_id <- generate_session_id() - chat <- btw_custom_agent_client_config(agent_config) - store_session(session_id, chat) - } - - response <- chat$chat(prompt) - - last_turn <- chat$last_turn() - message_text <- if (is.null(last_turn) || length(last_turn@contents) == 0) { - "(The agent completed successfully but returned no message.)" - } else { - ellmer::contents_markdown(last_turn) - } - message_text <- sprintf( - '\n%s\n', - agent_config$name, + session <- btw_agent_get_or_create_session( session_id, - message_text - ) - - # Get tokens for just this round - idx_prompt <- which(map_lgl(chat$get_turns(), function(t) { - t@role == "user" && identical(ellmer::contents_text(t), prompt) - })) - chat2 <- chat$clone() - if (idx_prompt > 1) { - chat2$set_turns(chat2$get_turns()[-seq_len(idx_prompt - 1)]) - } - tokens <- chat2$get_tokens() - for (i in seq_len(ncol(tokens))) { - if (is.numeric(tokens[[i]])) { - tokens[[i]] <- format(tokens[[i]], big.mark = ",") + create_chat_fn = function() { + btw_custom_agent_client_config(agent_config) } - } - - tool_calls <- map(chat2$get_turns(), function(turn) { - keep(turn@contents, S7::S7_inherits, ellmer::ContentToolRequest) - }) - - provider <- chat$get_provider()@name - model <- chat$get_model() - tool_names <- paste( - sprintf("`%s`", names(chat$get_tools())), - collapse = ", " ) - display_md <- glue_( - r"( - #### Prompt - - **Agent:** {{ agent_config$name }}
- **Session ID:** {{ session_id }}
- **Provider:** {{ provider }}
- **Model:** `{{ model }}`
- **Tools:** {{ tool_names }} - - {{ prompt }} + chat <- session$chat + session_id <- session$session_id - #### Tokens - - **Tool Calls:** {{ length(unlist(tool_calls)) }} - - {{ md_table(tokens) }} + response <- chat$chat(prompt) - #### Response + result <- btw_agent_process_response(chat, prompt, agent_config$name, session_id) - {{ message_text }} - )" + display_md <- btw_agent_display_markdown( + result = result, + session_id = session_id, + agent_name = agent_config$name, + prompt = prompt ) BtwSubagentResult( - value = message_text, + value = result$message_text, session_id = session_id, extra = list( prompt = prompt, agent = agent_config$name, - provider = provider, - model = model, - tokens = tokens, - display = list( - markdown = display_md, - show_request = FALSE - ) + provider = result$provider, + model = result$model, + tokens = result$tokens, + display = list(markdown = display_md, show_request = FALSE) ) ) } @@ -380,23 +314,16 @@ btw_tool_agent_custom_impl <- function( #' @return A configured Chat object with system prompt and tools attached #' @noRd btw_custom_agent_client_config <- function(agent_config) { - # Determine client - custom_client <- - agent_config$client %||% - getOption("btw.subagent.client") %||% - getOption("btw.client") + chat <- btw_agent_resolve_client(agent_config$client) # Determine tools - tools_default <- - agent_config$tools_default %||% + tools_default <- agent_config$tools_default %||% getOption("btw.subagent.tools_default") %||% getOption("btw.tools") - tools_allowed <- - agent_config$tools_allowed %||% + tools_allowed <- agent_config$tools_allowed %||% getOption("btw.subagent.tools_allowed") - # If agent specifies tools, use them; otherwise use defaults (non-agent tools) configured_tools <- if (!is.null(agent_config$tools)) { agent_config$tools } else if (!is.null(tools_default)) { @@ -414,22 +341,12 @@ btw_custom_agent_client_config <- function(agent_config) { if (!is.null(tools_allowed)) { allowed_tools <- flatten_and_check_tools(tools_allowed) allowed_names <- map_chr(allowed_tools, function(t) t@name) - configured_names <- map_chr(configured_tools, function(t) t@name) - - # Filter to only allowed tools (no error for custom agents) configured_tools <- keep(configured_tools, function(t) { t@name %in% allowed_names }) } - # Create chat client - chat <- if (!is.null(custom_client)) { - as_ellmer_client(custom_client)$clone() - } else { - btw_default_chat_client() - } - - # Build system prompt: base subagent prompt + custom agent prompt + # Build system prompt base_prompt <- btw_prompt("btw-subagent.md") custom_prompt <- agent_config$system_prompt %||% "" diff --git a/R/tool-agent-subagent.R b/R/tool-agent-subagent.R index 2f8f30f5..c5dc0b5f 100644 --- a/R/tool-agent-subagent.R +++ b/R/tool-agent-subagent.R @@ -157,13 +157,13 @@ btw_tool_agent_subagent <- function( ) {} -btw_tool_agent_subagent_impl <- function( - prompt, - tools = NULL, - session_id = NULL, - config = NULL -) { - check_string(prompt) +#' Get existing session or create new one +#' +#' @param session_id Optional session ID to retrieve +#' @param create_chat_fn Function that creates a new Chat when called +#' @return List with `chat`, `session_id`, and `is_new` +#' @noRd +btw_agent_get_or_create_session <- function(session_id, create_chat_fn) { check_string(session_id, allow_null = TRUE) if (!is.null(session_id)) { @@ -177,36 +177,49 @@ btw_tool_agent_subagent_impl <- function( )) } - chat <- session$chat - - # TODO: Add turn limit tracking. Currently we can't limit turns within a subagent - # because the chat$chat() method doesn't expose turn count control. - } else { - session_id <- generate_session_id() - chat <- btw_subagent_client_config( - client = config$client, - tools = tools, - tools_default = config$tools_default, - tools_allowed = config$tools_allowed - ) - store_session(session_id, chat) + return(list(chat = session$chat, session_id = session_id, is_new = FALSE)) } - response <- chat$chat(prompt) + session_id <- generate_session_id() + chat <- create_chat_fn() + store_session(session_id, chat) + + list(chat = chat, session_id = session_id, is_new = TRUE) +} + +#' Process agent chat response into result components +#' +#' @param chat The Chat object after running +#' @param prompt The original prompt +#' @param agent_name Name for the response tag (e.g., "subagent" or custom agent name) +#' @param session_id The session ID +#' @return List with message_text, tokens, tool_calls, provider, model, tool_names +#' @noRd +btw_agent_process_response <- function(chat, prompt, agent_name, session_id) { + # Extract last turn message last_turn <- chat$last_turn() message_text <- if (is.null(last_turn) || length(last_turn@contents) == 0) { - "(The subagent completed successfully but returned no message.)" + "(The agent completed successfully but returned no message.)" } else { ellmer::contents_markdown(last_turn) } - message_text <- sprintf( - '\n%s\n', - session_id, - message_text - ) - # We could update session metadata here, but `chat` is stateful + # Format with XML-like wrapper - "subagent" uses , others use + if (agent_name == "subagent") { + message_text <- sprintf( + '\n%s\n', + session_id, + message_text + ) + } else { + message_text <- sprintf( + '\n%s\n', + agent_name, + session_id, + message_text + ) + } # Get tokens for just this round idx_prompt <- which(map_lgl(chat$get_turns(), function(t) { @@ -227,48 +240,120 @@ btw_tool_agent_subagent_impl <- function( keep(turn@contents, S7::S7_inherits, ellmer::ContentToolRequest) }) - provider <- chat$get_provider()@name - model <- chat$get_model() - tool_names <- paste( - sprintf("`%s`", names(chat$get_tools())), - collapse = ", " + list( + message_text = message_text, + tokens = tokens, + tool_calls = tool_calls, + provider = chat$get_provider()@name, + model = chat$get_model(), + tool_names = paste(sprintf("`%s`", names(chat$get_tools())), collapse = ", ") ) +} + + +#' Generate display markdown for agent result +#' +#' @param result List returned from btw_agent_process_response() containing +#' message_text, tokens, tool_calls, provider, model, and tool_names +#' @param session_id Session ID +#' @param agent_name Agent name (NULL or "subagent" for subagent, otherwise custom agent name) +#' @param prompt The prompt text +#' @return Markdown string for display +#' @noRd +btw_agent_display_markdown <- function(result, session_id, agent_name, prompt) { + # Only show agent line for custom agents, not for subagent + agent_line <- if (!is.null(agent_name) && agent_name != "subagent") { + sprintf("**Agent:** %s
\n ", agent_name) + } else { + "" + } - display_md <- glue_( + glue_( r"( #### Prompt - **Session ID:** {{ session_id }}
- **Provider:** {{ provider }}
- **Model:** `{{ model }}`
- **Tools:** {{ tool_names }} + {{ agent_line }}**Session ID:** {{ session_id }}
+ **Provider:** {{ result$provider }}
+ **Model:** `{{ result$model }}`
+ **Tools:** {{ result$tool_names }} {{ prompt }} #### Tokens - **Tool Calls:** {{ length(unlist(tool_calls)) }} + **Tool Calls:** {{ length(unlist(result$tool_calls)) }} - {{ md_table(tokens) }} + {{ md_table(result$tokens) }} #### Response - {{ message_text }} + {{ result$message_text }} )" ) +} + + +#' Resolve agent chat client from options hierarchy +#' +#' @param client Optional explicit client +#' @return A Chat object +#' @noRd +btw_agent_resolve_client <- function(client = NULL) { + resolved <- client %||% + getOption("btw.subagent.client") %||% + getOption("btw.client") + + if (!is.null(resolved)) { + as_ellmer_client(resolved)$clone() + } else { + btw_default_chat_client() + } +} + + +btw_tool_agent_subagent_impl <- function( + prompt, + tools = NULL, + session_id = NULL, + config = NULL +) { + check_string(prompt) + + session <- btw_agent_get_or_create_session( + session_id, + create_chat_fn = function() { + btw_subagent_client_config( + client = config$client, + tools = tools, + tools_default = config$tools_default, + tools_allowed = config$tools_allowed + ) + } + ) + + chat <- session$chat + session_id <- session$session_id + + response <- chat$chat(prompt) + + result <- btw_agent_process_response(chat, prompt, "subagent", session_id) + + display_md <- btw_agent_display_markdown( + result = result, + session_id = session_id, + agent_name = "subagent", + prompt = prompt + ) BtwSubagentResult( - value = message_text, + value = result$message_text, session_id = session_id, extra = list( prompt = prompt, - provider = provider, - model = model, - tokens = tokens, - display = list( - markdown = display_md, - show_request = FALSE - ) + provider = result$provider, + model = result$model, + tokens = result$tokens, + display = list(markdown = display_md, show_request = FALSE) ) ) } diff --git a/tests/testthat/helpers-mock-agent.R b/tests/testthat/helpers-mock-agent.R new file mode 100644 index 00000000..9031d08a --- /dev/null +++ b/tests/testthat/helpers-mock-agent.R @@ -0,0 +1,44 @@ +#' Create a test agent file with automatic cleanup +#' +#' Creates a valid agent-*.md file in the specified directory. The file is +#' automatically cleaned up when the calling test completes. +#' +#' @param dir Directory to create the agent file in (typically a .btw directory) +#' @param name Name of the agent (without 'agent-' prefix or '.md' suffix) +#' @param content Optional custom content. If NULL, creates a standard test agent. +#' @param .envir Environment to use for cleanup (typically parent.frame()) +#' +#' @return Path to the created agent file +#' @noRd +local_test_agent_file <- function( + dir, + name = "test_agent", + content = NULL, + .envir = parent.frame() +) { + if (is.null(content)) { + content <- sprintf( + "--- +name: %s +description: A test agent +title: Test Agent +tools: + - files +--- + +This is the system prompt for the test agent.", + name + ) + } + + path <- file.path(dir, sprintf("agent-%s.md", name)) + writeLines(content, path) + + # Register cleanup in parent frame + withr::defer( + if (file.exists(path)) unlink(path), + envir = .envir + ) + + path +} diff --git a/tests/testthat/test-tool-agent-custom.R b/tests/testthat/test-tool-agent-custom.R index ef3e8566..5a8722bc 100644 --- a/tests/testthat/test-tool-agent-custom.R +++ b/tests/testthat/test-tool-agent-custom.R @@ -1,261 +1,3 @@ -# Helper to create a valid agent-*.md file -create_test_agent_file <- function(dir, name = "test_agent", content = NULL) { - if (is.null(content)) { - content <- sprintf( - "--- -name: %s -description: A test agent -title: Test Agent -tools: - - files ---- - -This is the system prompt for the test agent.", - name - ) - } - - path <- file.path(dir, sprintf("agent-%s.md", name)) - writeLines(content, path) - path -} - -# Test file discovery --------------------------------------------------------- - -test_that("find_project_agent_files() finds .btw/agent-*.md files", { - tmp_dir <- withr::local_tempdir() - btw_dir <- file.path(tmp_dir, ".btw") - dir.create(btw_dir) - - # Create some agent files - agent1 <- file.path(btw_dir, "agent-code-reviewer.md") - agent2 <- file.path(btw_dir, "agent-docs-writer.md") - writeLines("---\nname: code_reviewer\n---\nReview code.", agent1) - writeLines("---\nname: docs_writer\n---\nWrite docs.", agent2) - - # Also create a non-matching file - writeLines("Not an agent", file.path(btw_dir, "other.md")) - - files <- withr::with_dir(tmp_dir, find_project_agent_files()) - - expect_length(files, 2) - expect_true(any(grepl("agent-code-reviewer.md$", files))) - expect_true(any(grepl("agent-docs-writer.md$", files))) - expect_false(any(grepl("other.md$", files))) -}) - -test_that("find_project_agent_files() returns empty when no .btw directory", { - tmp_dir <- withr::local_tempdir() - - files <- withr::with_dir(tmp_dir, find_project_agent_files()) - - expect_length(files, 0) -}) - -test_that("find_project_agent_files() returns empty when .btw exists but no agents", { - tmp_dir <- withr::local_tempdir() - btw_dir <- file.path(tmp_dir, ".btw") - dir.create(btw_dir) - - # Create a non-agent file - writeLines("Not an agent", file.path(btw_dir, "other.md")) - - files <- withr::with_dir(tmp_dir, find_project_agent_files()) - - expect_length(files, 0) -}) - -test_that("find_user_agent_files() returns empty in test mode", { - # In testthat, TESTTHAT=true, so should return empty - expect_equal(Sys.getenv("TESTTHAT"), "true") - - files <- find_user_agent_files() - - expect_length(files, 0) -}) - -test_that("discover_agent_md_files() combines project and user files", { - tmp_dir <- withr::local_tempdir() - btw_dir <- file.path(tmp_dir, ".btw") - dir.create(btw_dir) - - agent1 <- file.path(btw_dir, "agent-test1.md") - writeLines("---\nname: test1\n---\nTest 1.", agent1) - - # Clear cache - - files <- withr::with_dir(tmp_dir, discover_agent_md_files()) - - expect_length(files, 1) - expect_true(any(grepl("agent-test1.md$", files))) -}) - -test_that("discover_agent_md_files() returns unique files", { - tmp_dir <- withr::local_tempdir() - btw_dir <- file.path(tmp_dir, ".btw") - dir.create(btw_dir) - - agent1 <- file.path(btw_dir, "agent-unique.md") - writeLines("---\nname: unique\n---\nUnique agent.", agent1) - - # Clear cache - - files <- withr::with_dir(tmp_dir, discover_agent_md_files()) - - # Should not have duplicates - expect_equal(length(files), length(unique(files))) -}) - -# Test name validation -------------------------------------------------------- - -test_that("validate_agent_name() accepts valid names", { - valid_names <- c( - "my_agent", - "CodeReviewer", - "agent1", - "test_agent_v2", - "AgentName" - ) - - for (name in valid_names) { - expect_true(validate_agent_name(name, "test.md")) - } -}) - -test_that("validate_agent_name() rejects empty or NULL names", { - expect_warning( - result <- validate_agent_name(NULL, "test.md"), - "has no name" - ) - expect_false(result) - - expect_warning( - result <- validate_agent_name("", "test.md"), - "has no name" - ) - expect_false(result) -}) - -test_that("validate_agent_name() rejects reserved names (built-in tool names)", { - # Any name that matches a built-in tool name is reserved - reserved_name <- names(.btw_tools)[1] - - expect_warning( - result <- validate_agent_name(reserved_name, "test.md"), - "reserved" - ) - expect_false(result) -}) - -test_that("validate_agent_name() rejects invalid characters", { - invalid_names <- c( - "123invalid", - "has-dash", - "has space", - "has.dot", - "has@symbol" - ) - - for (name in invalid_names) { - expect_warning( - result <- validate_agent_name(name, "test.md"), - "Invalid agent name" - ) - expect_false(result) - } -}) - -test_that("validate_agent_name() warning messages include path", { - expect_warning( - validate_agent_name(NULL, "/path/to/agent.md"), - "/path/to/agent.md" - ) - - expect_warning( - validate_agent_name(names(.btw_tools)[1], "/path/to/agent.md"), - "/path/to/agent.md" - ) - - expect_warning( - validate_agent_name("123invalid", "/path/to/agent.md"), - "/path/to/agent.md" - ) -}) - -# Test file parsing ----------------------------------------------------------- - -test_that("read_agent_md_file() returns NULL for non-existent file", { - result <- read_agent_md_file("/nonexistent/path/agent.md") - - expect_null(result) -}) - -test_that("read_agent_md_file() parses YAML frontmatter", { - tmp_dir <- withr::local_tempdir() - path <- create_test_agent_file(tmp_dir, "parser_test") - - config <- read_agent_md_file(path) - - expect_type(config, "list") - expect_equal(config$name, "parser_test") - expect_equal(config$description, "A test agent") - expect_equal(config$title, "Test Agent") - # YAML parses tools as character vector, not list - expect_equal(config$tools, "files") -}) - -test_that("read_agent_md_file() extracts body as system_prompt", { - tmp_dir <- withr::local_tempdir() - path <- create_test_agent_file(tmp_dir, "body_test") - - config <- read_agent_md_file(path) - - expect_true("system_prompt" %in% names(config)) - expect_match(config$system_prompt, "This is the system prompt") -}) - -test_that("read_agent_md_file() handles files without YAML", { - tmp_dir <- withr::local_tempdir() - path <- file.path(tmp_dir, "agent-no-yaml.md") - writeLines("Just body content, no frontmatter.", path) - - # This should still work but return minimal config - config <- read_agent_md_file(path) - - expect_type(config, "list") - expect_true("system_prompt" %in% names(config)) -}) - -test_that("read_agent_md_file() handles various YAML fields", { - tmp_dir <- withr::local_tempdir() - content <- "--- -name: complex_agent -description: A complex agent -title: Complex Agent -icon: robot -client: anthropic/claude-sonnet-4-20250514 -tools: - - files - - docs ---- - -Complex system prompt with multiple lines. -And more content here." - - path <- file.path(tmp_dir, "agent-complex.md") - writeLines(content, path) - - config <- read_agent_md_file(path) - - expect_equal(config$name, "complex_agent") - expect_equal(config$description, "A complex agent") - expect_equal(config$title, "Complex Agent") - expect_equal(config$icon, "robot") - expect_equal(config$client, "anthropic/claude-sonnet-4-20250514") - expect_length(config$tools, 2) - expect_match(config$system_prompt, "Complex system prompt") -}) - # Test tool creation ---------------------------------------------------------- # Note: btw_agent_tool() returns raw tools that get wrapped with _intent # argument later by as_ellmer_tools(). These tests check the unwrapped tools. @@ -309,9 +51,7 @@ test_that("custom agents can be discovered and loaded", { btw_dir <- file.path(tmp_dir, ".btw") dir.create(btw_dir) - create_test_agent_file(btw_dir, "integration_test") - - # Clear cache + local_test_agent_file(btw_dir, "integration_test") # Get tools from that directory tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) @@ -335,8 +75,6 @@ test_that("get_custom_agent_tools() returns empty list when no agents", { btw_dir <- file.path(tmp_dir, ".btw") dir.create(btw_dir) - # Clear cache - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) expect_length(tools, 0) @@ -350,7 +88,7 @@ test_that("get_custom_agent_tools() skips files with invalid names", { dir.create(btw_dir) # Create valid agent - create_test_agent_file(btw_dir, "valid_agent") + local_test_agent_file(btw_dir, "valid_agent") # Create agent with invalid name content_invalid <- "--- @@ -360,8 +98,6 @@ description: Invalid Invalid agent." writeLines(content_invalid, file.path(btw_dir, "agent-invalid.md")) - # Clear cache - expect_warning( tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()), "Invalid agent name" @@ -386,9 +122,11 @@ description: No name Agent without name." writeLines(content_no_name, file.path(btw_dir, "agent-noname.md")) - # Clear cache - - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + # Should warn about missing name + expect_warning( + tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()), + "Agent file has no name" + ) expect_length(tools, 0) }) @@ -406,8 +144,6 @@ description: [invalid yaml structure Bad YAML." writeLines(content_bad_yaml, file.path(btw_dir, "agent-bad.md")) - # Clear cache - expect_warning( tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()), "Error loading custom agent" @@ -421,11 +157,9 @@ test_that("get_custom_agent_tools() handles multiple agents", { btw_dir <- file.path(tmp_dir, ".btw") dir.create(btw_dir) - create_test_agent_file(btw_dir, "agent_one") - create_test_agent_file(btw_dir, "agent_two") - create_test_agent_file(btw_dir, "agent_three") - - # Clear cache + local_test_agent_file(btw_dir, "agent_one") + local_test_agent_file(btw_dir, "agent_two") + local_test_agent_file(btw_dir, "agent_three") tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) @@ -522,37 +256,154 @@ test_that("validate_agent_name() rejects edge cases", { } }) -# Test tool closure and configuration ----------------------------------------- +# Internal closure structure is an implementation detail. +# Tool behavior is tested through integration tests below. + +# Test register_custom_agent_tools() ------------------------------------------ + +test_that("register_custom_agent_tools() can be called without error", { + # This is mainly a smoke test - the function modifies .btw_tools + # which is a global state + + # Clear cache first + + expect_no_error(register_custom_agent_tools()) +}) + +# ---- Custom Agent Configuration (Behavioral) -------------------------------- + +test_that("btw_custom_agent_client_config creates chat with custom system prompt", { + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) + + # Create agent file + writeLines( + c( + "---", + "name: code_reviewer", + "description: Expert code reviewer", + "tools:", + " - files", + "---", + "", + "You are an expert code reviewer. Focus on:", + "- Code quality and best practices", + "- Performance issues", + "- Security vulnerabilities" + ), + file.path(btw_dir, "agent-code-reviewer.md") + ) + + # Load config and create chat + agent_config <- withr::with_dir(tmp_dir, { + read_agent_md_file(file.path(btw_dir, "agent-code-reviewer.md")) + }) + + chat <- btw_custom_agent_client_config(agent_config) + + expect_true(inherits(chat, "Chat")) + + # Verify system prompt + system_prompt <- chat$get_system_prompt() + expect_match(system_prompt, "expert code reviewer", ignore.case = TRUE) + expect_match(system_prompt, "Code quality", ignore.case = TRUE) + + # Verify tools + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_files_", tool_names))) + expect_false(any(grepl("^btw_tool_docs_", tool_names))) +}) + +test_that("btw_custom_agent_client_config respects tool restrictions", { + agent_config <- list( + name = "docs_agent", + description = "Documentation expert", + tools = "docs", + system_prompt = "You help with documentation.", + tools_default = NULL, + tools_allowed = NULL, + client = NULL + ) + + chat <- btw_custom_agent_client_config(agent_config) -test_that("btw_tool_agent_custom_config() creates proper closure", { + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_docs_", tool_names))) + expect_false(any(grepl("^btw_tool_files_", tool_names))) +}) + +test_that("btw_custom_agent_client_config concatenates system prompts", { agent_config <- list( - name = "closure_test", + name = "test", client = NULL, - tools = c("files"), - system_prompt = "Test", + tools = "files", + system_prompt = "Custom instructions for this agent.", tools_default = NULL, tools_allowed = NULL ) - tool_fn <- btw_tool_agent_custom_config(agent_config) + chat <- btw_custom_agent_client_config(agent_config) + system_prompt <- chat$get_system_prompt() - expect_type(tool_fn, "closure") + # Should include base prompt + expect_match(system_prompt, "Task Execution", ignore.case = TRUE) + # Should include custom prompt + expect_match(system_prompt, "Custom instructions", ignore.case = TRUE) + # Should have separator + expect_match(system_prompt, "---") +}) - # Function should have correct parameters (without _intent, which is added by wrapper) - fn_args <- names(formals(tool_fn)) - expect_true("prompt" %in% fn_args) - expect_true("session_id" %in% fn_args) - # _intent is NOT in the closure - it's added later by wrap_with_intent() - expect_false("_intent" %in% fn_args) +test_that("btw_custom_agent_client_config uses btw_agent_resolve_client", { + # Test explicit client + custom_client <- ellmer::chat_anthropic(model = "claude-opus-4-20241120") + agent_config <- list( + name = "test", + client = custom_client, + tools = "files", + system_prompt = "Test" + ) + + chat <- btw_custom_agent_client_config(agent_config) + expect_identical(chat, custom_client) + + # Test option fallback + withr::local_options( + btw.subagent.client = "anthropic/claude-sonnet-4-20250514" + ) + agent_config$client <- NULL + + chat2 <- btw_custom_agent_client_config(agent_config) + expect_equal(chat2$get_model(), "claude-sonnet-4-20250514") }) -# Test register_custom_agent_tools() ------------------------------------------ +# ---- Multiple Custom Agents ------------------------------------------------- -test_that("register_custom_agent_tools() can be called without error", { - # This is mainly a smoke test - the function modifies .btw_tools - # which is a global state +test_that("multiple custom agents can be discovered and registered", { + tmp_dir <- withr::local_tempdir() + btw_dir <- file.path(tmp_dir, ".btw") + dir.create(btw_dir) - # Clear cache first + # Create two agents + local_test_agent_file(btw_dir, "agent_one") + local_test_agent_file(btw_dir, "agent_two") - expect_no_error(register_custom_agent_tools()) + # Use get_custom_agent_tools() to get internal btw tool structure + tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + + expect_type(tools, "list") + expect_true("btw_tool_agent_agent_one" %in% names(tools)) + expect_true("btw_tool_agent_agent_two" %in% names(tools)) + + # Verify they have correct structure + agent_one_def <- tools[["btw_tool_agent_agent_one"]] + agent_two_def <- tools[["btw_tool_agent_agent_two"]] + + expect_equal(agent_one_def$name, "btw_tool_agent_agent_one") + expect_equal(agent_one_def$group, "agent") + expect_type(agent_one_def$tool, "closure") + + expect_equal(agent_two_def$name, "btw_tool_agent_agent_two") + expect_equal(agent_two_def$group, "agent") + expect_type(agent_two_def$tool, "closure") }) diff --git a/tests/testthat/test-tool-agent-subagent.R b/tests/testthat/test-tool-agent-subagent.R index 86efcc82..a73492ee 100644 --- a/tests/testthat/test-tool-agent-subagent.R +++ b/tests/testthat/test-tool-agent-subagent.R @@ -9,148 +9,9 @@ mock_chat <- function() { ) } -test_that("generate_session_id() creates valid IDs", { - id1 <- generate_session_id() - id2 <- generate_session_id() - - expect_match(id1, "^[a-z]+_[a-z]+$") - expect_match(id2, "^[a-z]+_[a-z]+$") - - # IDs should be different (probabilistically, could fail occasionally but unlikely) - ids <- replicate(10, generate_session_id()) - expect_true(length(unique(ids)) > 5) -}) - -test_that("generate_session_id() checks for uniqueness", { - clear_all_subagent_sessions() - - id1 <- generate_session_id() - store_session(id1, mock_chat()) - - ids <- replicate(20, generate_session_id()) - expect_false(id1 %in% ids) - - clear_all_subagent_sessions() -}) - -test_that("store_session() and retrieve_session() work", { - clear_all_subagent_sessions() - - session_id <- "test_session" - chat <- mock_chat() - - result <- store_session(session_id, chat) - expect_equal(result, session_id) - - session <- retrieve_session(session_id) - expect_type(session, "list") - expect_equal(session$id, session_id) - expect_equal(session$chat, chat) - expect_s3_class(session$created, "POSIXct") - expect_null(session$last_used) - - clear_all_subagent_sessions() -}) - -test_that("store_session() requires Chat object", { - expect_error( - store_session("test", "not a chat object"), - "must be a.*Chat" - ) -}) - -test_that("retrieve_session() returns NULL for nonexistent session", { - clear_all_subagent_sessions() - session <- retrieve_session("nonexistent_session") - expect_null(session) -}) - -test_that("store_session() can include metadata", { - clear_all_subagent_sessions() - - session_id <- "test_with_metadata" - chat <- mock_chat() - metadata <- list(custom_field = "custom_value") - - store_session(session_id, chat, metadata) - session <- retrieve_session(session_id) - - expect_equal(session$custom_field, "custom_value") - - clear_all_subagent_sessions() -}) - -test_that("list_subagent_sessions() works with no sessions", { - clear_all_subagent_sessions() - - result <- list_subagent_sessions() - expect_type(result, "list") - expect_equal(length(result), 0) -}) - -test_that("list_subagent_sessions() lists all sessions", { - clear_all_subagent_sessions() - - store_session("session_1", mock_chat()) - store_session("session_2", mock_chat()) - store_session("session_3", mock_chat()) - - result <- list_subagent_sessions() - expect_type(result, "list") - expect_equal(length(result), 3) - - session_ids <- names(result) - expect_true("session_1" %in% session_ids) - expect_true("session_2" %in% session_ids) - expect_true("session_3" %in% session_ids) - - expect_equal(result$session_1$id, "session_1") - expect_equal(result$session_2$id, "session_2") - expect_equal(result$session_3$id, "session_3") - - clear_all_subagent_sessions() -}) - -test_that("clear_subagent_session() removes a session", { - clear_all_subagent_sessions() - - session_id <- "test_clear" - store_session(session_id, mock_chat()) - - expect_false(is.null(retrieve_session(session_id))) - - result <- clear_subagent_session(session_id) - expect_true(result) - - expect_null(retrieve_session(session_id)) -}) - -test_that("clear_subagent_session() returns FALSE for nonexistent session", { - clear_all_subagent_sessions() - result <- clear_subagent_session("nonexistent") - expect_false(result) -}) - -test_that("clear_all_subagent_sessions() clears all sessions", { - clear_all_subagent_sessions() - - store_session("session_1", mock_chat()) - store_session("session_2", mock_chat()) - store_session("session_3", mock_chat()) - - expect_equal(length(list_subagent_sessions()), 3) - - count <- clear_all_subagent_sessions() - expect_equal(count, 3) - - expect_equal(length(list_subagent_sessions()), 0) -}) - -test_that("clear_all_subagent_sessions() returns 0 when no sessions", { - clear_all_subagent_sessions() - count <- clear_all_subagent_sessions() - expect_equal(count, 0) -}) +# Internal session management functions (generate_session_id, store_session, etc.) +# are tested through the public API via btw_agent_get_or_create_session() +# See behavioral tests at the end of this file. test_that("btw_subagent_client_config() uses default tools", { withr::local_options( @@ -201,21 +62,8 @@ test_that("btw_subagent_client_config() clones clients from options", { expect_false(identical(chat1, chat_obj)) }) -test_that("build_subagent_description() includes tool groups", { - desc <- build_subagent_description() - - expect_type(desc, "character") - expect_match(desc, "Delegate a task") - expect_match(desc, "AVAILABLE TOOLS") -}) - -test_that("build_subagent_description() includes basic text", { - desc <- build_subagent_description() - - expect_type(desc, "character") - expect_match(desc, "Delegate a task") - expect_match(desc, "subagent") -}) +# build_subagent_description() is internal - description content is tested +# through btw_tool_agent_subagent registration tests below test_that("btw_tool_agent_subagent is registered in btw_tools", { all_tools <- btw_tools() @@ -548,3 +396,126 @@ test_that("subagent tool errors even when in tools_allowed", { # Docs tools should remain expect_true(any(grepl("^btw_tool_docs_", tool_names))) }) + +# ---- Chat Client Configuration ---------------------------------------------- + +test_that("btw_subagent_client_config creates chat with filtered tools", { + chat <- btw_subagent_client_config(tools = "files") + + expect_true(inherits(chat, "Chat")) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + expect_true(all(grepl("^btw_tool_files_", tool_names))) + expect_false(any(grepl("^btw_tool_docs_", tool_names))) +}) + +test_that("btw_subagent_client_config respects explicit client parameter", { + custom_client <- ellmer::chat_anthropic(model = "claude-opus-4-20241120") + + chat <- btw_subagent_client_config(client = custom_client) + + expect_identical(chat, custom_client) +}) + +test_that("btw_subagent_client_config includes base subagent prompt", { + chat <- btw_subagent_client_config() + + system_prompt <- chat$get_system_prompt() + + expect_match(system_prompt, "Task Execution Guidelines") + expect_match(system_prompt, "Work Efficiently") + expect_true(nchar(system_prompt) > 0) +}) + +# ---- Session Management (via helpers) --------------------------------------- + +test_that("btw_agent_get_or_create_session creates new session when ID is NULL", { + clear_all_subagent_sessions() + + result <- btw_agent_get_or_create_session( + session_id = NULL, + create_chat_fn = function() mock_chat() + ) + + expect_type(result, "list") + expect_false(is.null(result$session_id)) + expect_match(result$session_id, "^[a-z]+_[a-z]+$") + expect_true(result$is_new) + expect_true(inherits(result$chat, "Chat")) + + clear_all_subagent_sessions() +}) + +test_that("btw_agent_get_or_create_session retrieves existing session", { + clear_all_subagent_sessions() + + # Create a session first + session_id <- generate_session_id() + chat <- mock_chat() + store_session(session_id, chat) + + # Retrieve it + result <- btw_agent_get_or_create_session( + session_id = session_id, + create_chat_fn = function() stop("Should not be called") + ) + + expect_equal(result$session_id, session_id) + expect_identical(result$chat, chat) + expect_false(result$is_new) + + clear_all_subagent_sessions() +}) + +test_that("btw_agent_get_or_create_session errors helpfully for invalid session", { + clear_all_subagent_sessions() + + expect_error( + btw_agent_get_or_create_session( + session_id = "nonexistent_badger_wombat", + create_chat_fn = function() mock_chat() + ), + regexp = "Session not found.*nonexistent_badger_wombat" + ) + + expect_error( + btw_agent_get_or_create_session( + session_id = "nonexistent", + create_chat_fn = function() mock_chat() + ), + regexp = "Omit.*session_id.*to start a new session" + ) +}) + +# ---- Tool Filtering and Restrictions ---------------------------------------- + +test_that("tools_allowed option filters configured tools", { + withr::local_options( + btw.subagent.tools_allowed = c("docs"), + btw.subagent.tools_default = c("docs", "files") + ) + + chat <- btw_subagent_client_config(tools = NULL) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + expect_true(all(grepl("^btw_tool_docs_", tool_names))) + expect_false(any(grepl("^btw_tool_files_", tool_names))) +}) + +test_that("subagent recursion is prevented in default tools", { + withr::local_options( + btw.subagent.tools_default = NULL, + btw.tools = NULL, + btw.subagent.tools_allowed = NULL + ) + + chat <- btw_subagent_client_config(tools = NULL) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # Subagent tool should be filtered out + expect_false("btw_tool_agent_subagent" %in% tool_names) + # But other tools should be present + expect_true(length(tool_names) > 0) +}) From 8688c40c2f1cafe78bff891db43ece487b46946a Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 10:42:45 -0500 Subject: [PATCH 23/44] feat: include full response in display --- R/tool-agent-subagent.R | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/R/tool-agent-subagent.R b/R/tool-agent-subagent.R index c5dc0b5f..d696f4c7 100644 --- a/R/tool-agent-subagent.R +++ b/R/tool-agent-subagent.R @@ -244,9 +244,13 @@ btw_agent_process_response <- function(chat, prompt, agent_name, session_id) { message_text = message_text, tokens = tokens, tool_calls = tool_calls, + chat_round = chat2, provider = chat$get_provider()@name, model = chat$get_model(), - tool_names = paste(sprintf("`%s`", names(chat$get_tools())), collapse = ", ") + tool_names = paste( + sprintf("`%s`", names(chat$get_tools())), + collapse = ", " + ) ) } @@ -268,15 +272,25 @@ btw_agent_display_markdown <- function(result, session_id, agent_name, prompt) { "" } + chat <- result$chat_round$clone() + chat$set_turns(chat$get_turns()[-1]) # remove prompt + chat$set_turns(chat$get_turns()[-length(chat$get_turns())]) # and final response + + full_results <- map(chat$get_turns(), function(turn) { + turn <- shinychat::contents_shinychat(turn) + map(turn, function(c) as.character(htmltools::as.tags(c))) + }) + full_results <- paste(unlist(full_results), collapse = "\n\n") + glue_( r"( - #### Prompt - {{ agent_line }}**Session ID:** {{ session_id }}
**Provider:** {{ result$provider }}
**Model:** `{{ result$model }}`
**Tools:** {{ result$tool_names }} + #### Prompt + {{ prompt }} #### Tokens @@ -287,6 +301,14 @@ btw_agent_display_markdown <- function(result, session_id, agent_name, prompt) { #### Response +
Full Conversation + + {{ full_results }} + + --- + +
+ {{ result$message_text }} )" ) From 84193fbbeb61e213222aebbe3961faf7d449adf1 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 11:57:24 -0500 Subject: [PATCH 24/44] fix(app): Attach group to tool annotation for use in app --- R/btw_client_app.R | 14 +++++--------- R/tools.R | 8 ++++---- 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/R/btw_client_app.R b/R/btw_client_app.R index 2e0722df..38697da0 100644 --- a/R/btw_client_app.R +++ b/R/btw_client_app.R @@ -600,19 +600,15 @@ btw_status_bar_server <- function(id, chat) { # Tools in sidebar ---- -btw_tools_df <- function(include_tool_names = NULL) { - all_btw_tools <- .btw_tools[intersect(include_tool_names, names(.btw_tools))] - all_btw_tools <- map(all_btw_tools, function(def) { - tool <- def$tool() - if (is.null(tool)) { - return() - } - if (def$group == "env" && isTRUE(getOption("btw.app.in_addin"))) { +btw_tools_df <- function(tools = btw_tools()) { + all_btw_tools <- map(tools, function(tool) { + group <- tool@annotations$btw_group %||% "other" + if (group == "env" && isTRUE(getOption("btw.app.in_addin"))) { # TODO: Remove this check when the addin can reach the global env return() } dplyr::tibble( - group = def$group, + group = group, name = tool@name, description = tool@description, title = tool@annotations$title, diff --git a/R/tools.R b/R/tools.R index 06627aaa..66be321d 100644 --- a/R/tools.R +++ b/R/tools.R @@ -40,7 +40,6 @@ #' #' @export btw_tools <- function(...) { - tools <- c(...) check_character(tools, allow_null = TRUE) @@ -131,8 +130,8 @@ as_ellmer_tools <- function(x) { can_register_fns <- can_register_fns[seq_along(tools)] } - # 3. Set icons - tools <- map2(tools, groups, set_tool_icon) + # 3. Set icon and group annotations + tools <- map2(tools, groups, set_tool_annotations) # 4. Propagate can_register to btw_can_register annotation tools <- map2(tools, can_register_fns, function(tool, fn) { @@ -187,12 +186,13 @@ tool_group_icon <- function(group, default = NULL) { ) } -set_tool_icon <- function(tool, group) { +set_tool_annotations <- function(tool, group) { if (!is.list(tool@annotations)) { tool@annotations <- list() } tool@annotations$icon <- tool_group_icon(group) + tool@annotations$btw_group <- group tool } From 3bafaad2674ca5c1e4efd9bd175be60c482258be Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 11:58:04 -0500 Subject: [PATCH 25/44] fix(app): Use bare_client to avoid additional messages --- R/btw_client_app.R | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/R/btw_client_app.R b/R/btw_client_app.R index 38697da0..595f4898 100644 --- a/R/btw_client_app.R +++ b/R/btw_client_app.R @@ -26,21 +26,24 @@ btw_app <- function( # When client is AsIs (pre-configured), use btw_tools() as reference reference_tools <- btw_tools() } else { + client <- btw_client( + client = client, + tools = tools, + path_btw = path_btw + ) + # Create a reference client to get the full tool set withr::with_options(list(btw.client.quiet = TRUE), { + bare_client <- client$clone() + bare_client$set_tools(list()) + reference_client <- btw_client( + client = bare_client, tools = names(btw_tools()), path_btw = path_btw ) reference_tools <- reference_client$get_tools() }) - - # Also create the actual client if needed - client <- btw_client( - client = client, - tools = tools, - path_btw = path_btw - ) } btw_app_from_client( @@ -150,7 +153,7 @@ btw_app_from_client <- function( shiny::div( class = "overflow-y-auto overflow-x-visible", app_tool_group_inputs( - btw_tools_df(names(all_available_tools)), + btw_tools_df(all_available_tools), initial_tool_names = names(original_client_tools) ), shiny::uiOutput("ui_other_tools") @@ -196,7 +199,7 @@ btw_app_from_client <- function( bslib::toggle_sidebar("tools_sidebar") }) - tool_groups <- unique(btw_tools_df(names(all_available_tools))$group) + tool_groups <- unique(btw_tools_df(all_available_tools)$group) # Split tools: btw tools and other (non-btw) tools btw_available_tools <- keep(all_available_tools, function(tool) { @@ -214,7 +217,7 @@ btw_app_from_client <- function( }) shiny::observeEvent(input$select_all, { - tools <- btw_tools_df(names(all_available_tools)) + tools <- btw_tools_df(all_available_tools) for (group in tool_groups) { shiny::updateCheckboxGroupInput( session = session, @@ -225,7 +228,7 @@ btw_app_from_client <- function( }) shiny::observeEvent(input$deselect_all, { - tools <- btw_tools_df(names(all_available_tools)) + tools <- btw_tools_df(all_available_tools) for (group in tool_groups) { shiny::updateCheckboxGroupInput( session = session, @@ -238,7 +241,7 @@ btw_app_from_client <- function( lapply(tool_groups, function(group) { shiny::observeEvent(input[[paste0("tools_toggle_", group)]], { current <- input[[paste0("tools_", group)]] - all_tools <- btw_tools_df(names(all_available_tools)) + all_tools <- btw_tools_df(all_available_tools) group_tools <- all_tools[all_tools$group == group, ][["name"]] if (length(current) == length(group_tools)) { # All selected, so deselect all From 62e5583551a60dfdf65f2f5c6fb3b2a574e519ec Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 12:16:07 -0500 Subject: [PATCH 26/44] fix: Respect client in agent md frontmatter --- R/btw_client.R | 59 +++++++++++++++++++++++++++++--------------------- 1 file changed, 34 insertions(+), 25 deletions(-) diff --git a/R/btw_client.R b/R/btw_client.R index db010991..f9c0e0cc 100644 --- a/R/btw_client.R +++ b/R/btw_client.R @@ -174,28 +174,17 @@ btw_client_config <- function(client = NULL, tools = NULL, config = list()) { } if (!is.null(config$client)) { - if (is_string(config$client)) { - config$client <- as_ellmer_client(config$client) - return(config) - } + # Show informational message for list configs with model specified + show_model_info <- + is.list(config$client) && + !is.null(config$client$model) && + !isTRUE(getOption("btw.client.quiet")) - chat_args <- utils::modifyList( - list(echo = "output"), # defaults - config$client - ) + config$client <- as_ellmer_client(config$client) - chat_fn <- gsub(" ", "_", tolower(chat_args$provider)) - if (!grepl("^chat_", chat_fn)) { - chat_fn <- paste0("chat_", chat_fn) - } - chat_args$provider <- NULL - - chat_client <- call2(.ns = "ellmer", chat_fn, !!!chat_args) - config$client <- eval(chat_client) - - if (!is.null(chat_args$model) && !isTRUE(getOption("btw.client.quiet"))) { + if (show_model_info) { cli::cli_inform( - "Using {.field {chat_args$model}} from {.strong {config$client$get_provider()@name}}." + "Using {.field {config$client$get_model()}} from {.strong {config$client$get_provider()@name}}." ) } return(config) @@ -210,18 +199,38 @@ btw_default_chat_client <- function() { } as_ellmer_client <- function(client) { + if (inherits(client, "Chat")) { return(client) } - if (!is_string(client)) { - cli::cli_abort(c( - "{.arg client} must be an {.help ellmer::Chat} client or a string naming a chat provider and model to pass to {.fn ellmer::chat}, not {.obj_type_friendly {client}}.", - "i" = "Examples: {.or {.val {c('openai/gpt-5-mini', 'anthropic/claude-3-7-sonnet-20250219')}}}." - )) + if (is_string(client)) { + return(ellmer::chat(client, echo = "output")) + } + + # Handle list/mapping configuration (e.g., from YAML frontmatter) + # Example: client: {provider: aws_bedrock, model: claude-sonnet-4} + if (is.list(client) && !is.null(client$provider)) { + chat_args <- utils::modifyList( + list(echo = "output"), + client + ) + + chat_fn <- gsub(" ", "_", tolower(chat_args$provider)) + if (!grepl("^chat_", chat_fn)) { + chat_fn <- paste0("chat_", chat_fn) + } + chat_args$provider <- NULL + + chat_client <- call2(.ns = "ellmer", chat_fn, !!!chat_args) + return(eval(chat_client)) } - ellmer::chat(client, echo = "output") + cli::cli_abort(c( + "{.arg client} must be an {.help ellmer::Chat} client, a {.val provider/model} string, or a list with {.field provider} (and optionally {.field model}).", + "i" = "Examples: {.or {.val {c('openai/gpt-4.1-mini', 'anthropic/claude-sonnet-4-20250514')}}}.", + "i" = "Or as a list: {.code list(provider = 'anthropic', model = 'claude-sonnet-4-20250514')}" + )) } flatten_and_check_tools <- function(tools) { From 8913f52f54e8f7db2c3c0d7ba04e62bd277f5ecd Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 12:37:29 -0500 Subject: [PATCH 27/44] fix: `client` in options can also be a list now --- R/btw_client.R | 15 ++++++++++----- R/tool-agent-subagent.R | 28 +++++++++++++++++++++++++--- 2 files changed, 35 insertions(+), 8 deletions(-) diff --git a/R/btw_client.R b/R/btw_client.R index f9c0e0cc..9b9d99e6 100644 --- a/R/btw_client.R +++ b/R/btw_client.R @@ -199,7 +199,6 @@ btw_default_chat_client <- function() { } as_ellmer_client <- function(client) { - if (inherits(client, "Chat")) { return(client) } @@ -279,11 +278,17 @@ flatten_and_check_tools <- function(tools) { } flatten_config_options <- function(opts, prefix = "btw", sep = ".") { + # Keys that should be treated as leaf values (not recursed into) + # even if they contain nested lists + leaf_keys <- c("client") + out <- list() - recurse <- function(x, key_prefix) { - # If x is a list, dive deeper - if (is.list(x) && !is.data.frame(x)) { + recurse <- function(x, key_prefix, current_key = "") { + is_leaf_key <- current_key %in% leaf_keys + + # If x is a list and not a leaf key, dive deeper + if (is.list(x) && !is.data.frame(x) && !is_leaf_key) { nm <- names2(x) if (!all(nzchar(nm))) { cli::cli_abort("All options must be named.") @@ -295,7 +300,7 @@ flatten_config_options <- function(opts, prefix = "btw", sep = ".") { } else { new_key <- nm[i] } - recurse(x[[i]], new_key) + recurse(x[[i]], new_key, current_key = nm[i]) } } else { # Leaf: assign it directly diff --git a/R/tool-agent-subagent.R b/R/tool-agent-subagent.R index d696f4c7..65da81dc 100644 --- a/R/tool-agent-subagent.R +++ b/R/tool-agent-subagent.R @@ -317,19 +317,41 @@ btw_agent_display_markdown <- function(result, session_id, agent_name, prompt) { #' Resolve agent chat client from options hierarchy #' +#' Checks for client configuration in the following order: +#' 1. Explicit `client` argument (from agent-*.md file) +#' 2. `btw.subagent.client` R option +#' 3. `btw.md` file's `options.subagent.client` +#' 4. `btw.client` R option +#' 5. `btw.md` file's `client` +#' 6. Default Anthropic client +#' #' @param client Optional explicit client #' @return A Chat object #' @noRd btw_agent_resolve_client <- function(client = NULL) { + # Check explicit argument and R options first resolved <- client %||% getOption("btw.subagent.client") %||% getOption("btw.client") if (!is.null(resolved)) { - as_ellmer_client(resolved)$clone() - } else { - btw_default_chat_client() + return(as_ellmer_client(resolved)$clone()) } + + + # Fall back to btw.md file configuration + + btw_config <- read_btw_file() + + # Check for subagent-specific client in btw.md options + resolved <- btw_config$options[["btw.subagent.client"]] %||% + btw_config$client + + if (!is.null(resolved)) { + return(as_ellmer_client(resolved)$clone()) + } + + btw_default_chat_client() } From d4ae2768bef6943887c416c2ab46a757e78e26db Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 12:45:32 -0500 Subject: [PATCH 28/44] chore: refactor memoids data --- .Rbuildignore | 1 + DESCRIPTION | 1 + R/sysdata.rda | Bin 0 -> 553 bytes R/tool-agent-subagent.R | 84 +---------------------------------- data-raw/memoids.R | 94 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 98 insertions(+), 82 deletions(-) create mode 100644 R/sysdata.rda create mode 100644 data-raw/memoids.R diff --git a/.Rbuildignore b/.Rbuildignore index fc0fe07f..7e92f04b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -18,3 +18,4 @@ ^CRAN-SUBMISSION$ ^\.prettierrc$ ^node_modules$ +^data-raw$ diff --git a/DESCRIPTION b/DESCRIPTION index 293ab684..f9a18bf9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -77,6 +77,7 @@ Config/testthat/edition: 3 Config/testthat/parallel: true Config/testthat/start-first: web, news, covr, search Encoding: UTF-8 +LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 Collate: diff --git a/R/sysdata.rda b/R/sysdata.rda new file mode 100644 index 0000000000000000000000000000000000000000..644c5280da314377270a89366df4f7324b7d8fb8 GIT binary patch literal 553 zcmV+^0@nRPT4*^jL0KkKSN zih3qYfHVLA7=RFGlg~8BP+&+aB7xWRK?Yi}xd;?&Zt%=E+t1|V@*I6?=dMojNXVK2 zjbNmI#+Y%Pnlc4rWS`-rna-A&-xEpS?6wOMK3%iR9e-ksY9zx!sgQ(gK#;(gZES>u z_qY%uu5Lw^I`W4;)b6T&RbiukI$yF;zUqj=$u?JHfY`RxUk=Tt7eas$GjR)iyjr}? z(&sQ9O2;?BY7x&K1eP3-rWgdHaRS&FP|*Sc0&AI@>k0cAJoDteHOP0{O`}U<-E7$f z!}l%C1I^$!T#imgiCIrJK7+-|0ZyYAN#&ua-i1jd3MO3}B-}A* zrlnUZp*Z>@2Q3`*Ow>py{TW*jX8IEN+Hdi3Ji*}eA%!mBlD@CUuxfV8uM+g=4$L4* r>6u?SmF{Tn*c2l!PH(v&kbWnrRkW4$TH2KSm#DjvDZ+$?m>R7Bpv?tN literal 0 HcmV?d00001 diff --git a/R/tool-agent-subagent.R b/R/tool-agent-subagent.R index 65da81dc..b330efdc 100644 --- a/R/tool-agent-subagent.R +++ b/R/tool-agent-subagent.R @@ -338,7 +338,6 @@ btw_agent_resolve_client <- function(client = NULL) { return(as_ellmer_client(resolved)$clone()) } - # Fall back to btw.md file configuration btw_config <- read_btw_file() @@ -700,83 +699,6 @@ btw_can_register_subagent_tool <- function() { .btw_subagent_sessions <- new.env(parent = emptyenv()) -.btw_adjectives <- c( - "agile", - "bold", - "bright", - "calm", - "clever", - "daring", - "eager", - "elegant", - "fair", - "fierce", - "gentle", - "happy", - "jolly", - "keen", - "lively", - "merry", - "nimble", - "noble", - "placid", - "quick", - "quiet", - "rapid", - "serene", - "shy", - "silent", - "smooth", - "stable", - "steady", - "swift", - "tranquil", - "valiant", - "vibrant", - "vigilant", - "vivid", - "warm", - "wise", - "witty", - "zealous" -) - -.btw_nouns <- c( - "aardvark", - "badger", - "beaver", - "cheetah", - "dolphin", - "eagle", - "falcon", - "gazelle", - "hawk", - "jaguar", - "kangaroo", - "leopard", - "lynx", - "meerkat", - "otter", - "panther", - "penguin", - "puffin", - "rabbit", - "raven", - "salmon", - "sparrow", - "squirrel", - "starling", - "swift", - "tiger", - "turtle", - "viper", - "walrus", - "weasel", - "whale", - "wolf", - "wombat", - "zebra" -) #' Generate a word-based session ID #' @@ -789,8 +711,8 @@ btw_can_register_subagent_tool <- function() { generate_session_id <- function() { # Try up to 100 times to generate a unique ID for (i in seq_len(100)) { - adj <- sample(.btw_adjectives, 1) - noun <- sample(.btw_nouns, 1) + adj <- sample(.btw_memoids$adjective, 1) + noun <- sample(.btw_memoids$noun, 1) id <- paste(adj, noun, sep = "_") if (!env_has(.btw_subagent_sessions, id)) { @@ -804,8 +726,6 @@ generate_session_id <- function() { "i" = "Falling back to random suffix." )) - adj <- sample(.btw_adjectives, 1) - noun <- sample(.btw_nouns, 1) suffix <- sample(1000:9999, 1) paste(c(adj, noun, suffix), collapse = "_") } diff --git a/data-raw/memoids.R b/data-raw/memoids.R new file mode 100644 index 00000000..64474da2 --- /dev/null +++ b/data-raw/memoids.R @@ -0,0 +1,94 @@ +.btw_memoids <- list( + adjective = c( + "agile", + "bold", + "bright", + "calm", + "clever", + "daring", + "eager", + "elegant", + "fair", + "fierce", + "gentle", + "happy", + "intrepid", + "jolly", + "keen", + "lively", + "merry", + "nimble", + "noble", + "optimistic", + "outgoing", + "placid", + "quick", + "quiet", + "rapid", + "serene", + "shy", + "silent", + "smooth", + "stable", + "steady", + "swift", + "tranquil", + "urbane", + "valiant", + "vibrant", + "vigilant", + "vivid", + "warm", + "wise", + "witty", + "xenial", + "youthful", + "zealous" + ), + + noun = c( + "aardvark", + "alpaca", + "antelope", + "badger", + "beaver", + "cheetah", + "dolphin", + "eagle", + "falcon", + "gazelle", + "hawk", + "ibis", + "jaguar", + "kangaroo", + "leopard", + "lynx", + "meerkat", + "narwhal", + "otter", + "panther", + "penguin", + "puffin", + "quokka", + "rabbit", + "raven", + "salmon", + "sparrow", + "squirrel", + "starling", + "swift", + "tiger", + "turtle", + "urchin", + "viper", + "walrus", + "weasel", + "whale", + "wolf", + "wombat", + "yak", + "zebra" + ) +) + +usethis::use_data(.btw_memoids, overwrite = TRUE, internal = TRUE) From 0b2507bb0c94d94af1fe010bbf253ab1740c8de1 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 13:33:56 -0500 Subject: [PATCH 29/44] refactor: rename functions for consistency --- R/tool-agent-custom.R | 42 ++---- R/tool-agent-subagent.R | 60 ++++----- R/tools.R | 2 +- tests/testthat/test-tool-agent-custom.R | 55 ++++---- tests/testthat/test-tool-agent-subagent.R | 148 +++++++++++----------- 5 files changed, 137 insertions(+), 170 deletions(-) diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R index 319732c5..659813a9 100644 --- a/R/tool-agent-custom.R +++ b/R/tool-agent-custom.R @@ -208,7 +208,7 @@ btw_agent_tool <- function(path) { ) # Create the tool function with agent_config captured in closure - tool_fn <- btw_tool_agent_custom_config(agent_config) + tool_fn <- btw_tool_agent_custom_from_config(agent_config) # Build the ellmer::tool() tool <- ellmer::tool( @@ -270,10 +270,10 @@ btw_tool_agent_custom_impl <- function( ) { check_string(prompt) - session <- btw_agent_get_or_create_session( + session <- subagent_get_or_create_session( session_id, create_chat_fn = function() { - btw_custom_agent_client_config(agent_config) + custom_agent_client_from_config(agent_config) } ) @@ -282,9 +282,9 @@ btw_tool_agent_custom_impl <- function( response <- chat$chat(prompt) - result <- btw_agent_process_response(chat, prompt, agent_config$name, session_id) + result <- subagent_process_result(chat, prompt, agent_config$name, session_id) - display_md <- btw_agent_display_markdown( + display_md <- subagent_display_result( result = result, session_id = session_id, agent_name = agent_config$name, @@ -308,13 +308,13 @@ btw_tool_agent_custom_impl <- function( #' Configure custom agent client #' #' Creates and configures an ellmer Chat client for a custom agent session. -#' Similar to btw_subagent_client_config but uses agent-specific configuration. +#' Similar to subagent_client but uses agent-specific configuration. #' #' @param agent_config List with agent configuration #' @return A configured Chat object with system prompt and tools attached #' @noRd -btw_custom_agent_client_config <- function(agent_config) { - chat <- btw_agent_resolve_client(agent_config$client) +custom_agent_client_from_config <- function(agent_config) { + chat <- subagent_resolve_client(agent_config$client) # Determine tools tools_default <- agent_config$tools_default %||% @@ -369,7 +369,7 @@ btw_custom_agent_client_config <- function(agent_config) { #' @param agent_config List with agent configuration #' @return Function that implements the tool #' @noRd -btw_tool_agent_custom_config <- function(agent_config) { +btw_tool_agent_custom_from_config <- function(agent_config) { force(agent_config) function(prompt, session_id = NULL) { @@ -390,7 +390,7 @@ btw_tool_agent_custom_config <- function(agent_config) { #' #' @return Named list of tool definitions compatible with .btw_add_to_tools #' @noRd -get_custom_agent_tools <- function() { +custom_agent_discover_tools <- function() { files <- discover_agent_md_files() if (length(files) == 0) { @@ -429,25 +429,3 @@ get_custom_agent_tools <- function() { tools } - -#' Register custom agent tools -#' -#' This function is called to dynamically register custom agents found in -#' agent-*.md files. It's separated from the discovery logic to allow -#' registration to happen at the appropriate time during package load. -#' -#' @noRd -register_custom_agent_tools <- function() { - tools <- get_custom_agent_tools() - - for (tool_name in names(tools)) { - tool_def <- tools[[tool_name]] - .btw_add_to_tools( - name = tool_def$name, - group = tool_def$group, - tool = tool_def$tool - ) - } - - invisible(NULL) -} diff --git a/R/tool-agent-subagent.R b/R/tool-agent-subagent.R index b330efdc..9b1dd516 100644 --- a/R/tool-agent-subagent.R +++ b/R/tool-agent-subagent.R @@ -163,11 +163,11 @@ btw_tool_agent_subagent <- function( #' @param create_chat_fn Function that creates a new Chat when called #' @return List with `chat`, `session_id`, and `is_new` #' @noRd -btw_agent_get_or_create_session <- function(session_id, create_chat_fn) { +subagent_get_or_create_session <- function(session_id, create_chat_fn) { check_string(session_id, allow_null = TRUE) if (!is.null(session_id)) { - session <- retrieve_session(session_id) + session <- subagent_get_session(session_id) if (is.null(session)) { cli::cli_abort(c( @@ -180,9 +180,9 @@ btw_agent_get_or_create_session <- function(session_id, create_chat_fn) { return(list(chat = session$chat, session_id = session_id, is_new = FALSE)) } - session_id <- generate_session_id() + session_id <- subagent_new_session_id() chat <- create_chat_fn() - store_session(session_id, chat) + subagent_store_session(session_id, chat) list(chat = chat, session_id = session_id, is_new = TRUE) } @@ -196,7 +196,7 @@ btw_agent_get_or_create_session <- function(session_id, create_chat_fn) { #' @param session_id The session ID #' @return List with message_text, tokens, tool_calls, provider, model, tool_names #' @noRd -btw_agent_process_response <- function(chat, prompt, agent_name, session_id) { +subagent_process_result <- function(chat, prompt, agent_name, session_id) { # Extract last turn message last_turn <- chat$last_turn() message_text <- if (is.null(last_turn) || length(last_turn@contents) == 0) { @@ -257,14 +257,14 @@ btw_agent_process_response <- function(chat, prompt, agent_name, session_id) { #' Generate display markdown for agent result #' -#' @param result List returned from btw_agent_process_response() containing +#' @param result List returned from subagent_process_result() containing #' message_text, tokens, tool_calls, provider, model, and tool_names #' @param session_id Session ID #' @param agent_name Agent name (NULL or "subagent" for subagent, otherwise custom agent name) #' @param prompt The prompt text #' @return Markdown string for display #' @noRd -btw_agent_display_markdown <- function(result, session_id, agent_name, prompt) { +subagent_display_result <- function(result, session_id, agent_name, prompt) { # Only show agent line for custom agents, not for subagent agent_line <- if (!is.null(agent_name) && agent_name != "subagent") { sprintf("**Agent:** %s
\n ", agent_name) @@ -328,7 +328,7 @@ btw_agent_display_markdown <- function(result, session_id, agent_name, prompt) { #' @param client Optional explicit client #' @return A Chat object #' @noRd -btw_agent_resolve_client <- function(client = NULL) { +subagent_resolve_client <- function(client = NULL) { # Check explicit argument and R options first resolved <- client %||% getOption("btw.subagent.client") %||% @@ -362,10 +362,10 @@ btw_tool_agent_subagent_impl <- function( ) { check_string(prompt) - session <- btw_agent_get_or_create_session( + session <- subagent_get_or_create_session( session_id, create_chat_fn = function() { - btw_subagent_client_config( + subagent_client( client = config$client, tools = tools, tools_default = config$tools_default, @@ -379,9 +379,9 @@ btw_tool_agent_subagent_impl <- function( response <- chat$chat(prompt) - result <- btw_agent_process_response(chat, prompt, "subagent", session_id) + result <- subagent_process_result(chat, prompt, "subagent", session_id) - display_md <- btw_agent_display_markdown( + display_md <- subagent_display_result( result = result, session_id = session_id, agent_name = "subagent", @@ -408,7 +408,7 @@ btw_tool_agent_subagent_impl <- function( #' #' @return A list with captured configuration #' @noRd -capture_subagent_config <- function() { +subagent_config_options <- function() { list( client = getOption("btw.subagent.client") %||% getOption("btw.client"), tools_default = getOption("btw.subagent.tools_default") %||% @@ -431,7 +431,7 @@ capture_subagent_config <- function() { #' @return A configured Chat object with system prompt and tools attached #' #' @noRd -btw_subagent_client_config <- function( +subagent_client <- function( client = NULL, tools = NULL, tools_default = NULL, @@ -442,7 +442,7 @@ btw_subagent_client_config <- function( # Error immediately if subagent is explicitly requested # This provides clear feedback rather than silent filtering - if (subagent_explicitly_requested(tools)) { + if (subagent_is_explicitly_requested(tools)) { cli::cli_abort(c( "Subagents cannot spawn other subagents.", "x" = "The {.arg tools} parameter includes {.val btw_tool_agent_subagent}.", @@ -450,7 +450,7 @@ btw_subagent_client_config <- function( )) } - subagent_client <- + subagent_client_resolved <- client %||% getOption("btw.subagent.client") %||% getOption("btw.client") @@ -510,8 +510,8 @@ btw_subagent_client_config <- function( # to ensure the subagent tool is always removed, regardless of how tools were specified configured_tools <- subagent_disallow_recursion(configured_tools) - chat <- if (!is.null(subagent_client)) { - as_ellmer_client(subagent_client)$clone() + chat <- if (!is.null(subagent_client_resolved)) { + as_ellmer_client(subagent_client_resolved)$clone() } else { btw_default_chat_client() } @@ -546,7 +546,7 @@ subagent_disallow_recursion <- function(tools) { #' @param tools Character vector of tool names/groups or list of ToolDef objects #' @return TRUE if subagent is explicitly requested by name, FALSE otherwise #' @noRd -subagent_explicitly_requested <- function(tools) { +subagent_is_explicitly_requested <- function(tools) { if (is.null(tools)) { return(FALSE) } @@ -575,7 +575,7 @@ subagent_explicitly_requested <- function(tools) { #' @return Character string with the tool description #' #' @noRd -build_subagent_description <- function(tools = .btw_tools) { +subagent_build_description <- function(tools = .btw_tools) { desc_tool_use <- if (length(tools) == 0) { "No tools are available for use in the subagent." } else { @@ -626,7 +626,7 @@ BEST PRACTICES: paste0(desc_base, "\n", desc_tool_use, "\n", tool_summary) } -btw_tool_agent_subagent_config <- function(config) { +btw_tool_agent_subagent_from_config <- function(config) { force(config) function(prompt, tools = NULL, session_id = NULL) { @@ -657,7 +657,7 @@ btw_can_register_subagent_tool <- function() { # Set context flag before any tool resolution to prevent recursion withr::local_options(.btw_resolving_for_subagent = TRUE) - config <- capture_subagent_config() + config <- subagent_config_options() tools_allowed <- config$tools_allowed if (is.null(tools_allowed)) { @@ -670,9 +670,9 @@ btw_can_register_subagent_tool <- function() { tools_allowed <- flatten_and_check_tools(tools_allowed) ellmer::tool( - btw_tool_agent_subagent_config(config), + btw_tool_agent_subagent_from_config(config), name = "btw_tool_agent_subagent", - description = build_subagent_description(tools_allowed), + description = subagent_build_description(tools_allowed), annotations = ellmer::tool_annotations( title = "Subagent", read_only_hint = FALSE, @@ -708,7 +708,7 @@ btw_can_register_subagent_tool <- function() { #' #' @return A character string containing the generated session ID #' @noRd -generate_session_id <- function() { +subagent_new_session_id <- function() { # Try up to 100 times to generate a unique ID for (i in seq_len(100)) { adj <- sample(.btw_memoids$adjective, 1) @@ -740,7 +740,7 @@ generate_session_id <- function() { #' @return The session_id (invisibly) #' #' @noRd -store_session <- function(session_id, chat, metadata = list()) { +subagent_store_session <- function(session_id, chat, metadata = list()) { check_string(session_id) check_inherits(chat, "Chat") @@ -765,7 +765,7 @@ store_session <- function(session_id, chat, metadata = list()) { #' @return A list containing the session data, or NULL if not found #' #' @noRd -retrieve_session <- function(session_id) { +subagent_get_session <- function(session_id) { check_string(session_id) env_get(.btw_subagent_sessions, session_id, default = NULL) @@ -779,7 +779,7 @@ retrieve_session <- function(session_id) { #' @return A list of sessions with: id, chat, created #' #' @noRd -list_subagent_sessions <- function() { +subagent_list_sessions <- function() { env_get_list(.btw_subagent_sessions, env_names(.btw_subagent_sessions)) } @@ -792,7 +792,7 @@ list_subagent_sessions <- function() { #' @return TRUE if session was found and removed, FALSE otherwise #' #' @noRd -clear_subagent_session <- function(session_id) { +subagent_clear_session <- function(session_id) { check_string(session_id) if (!env_has(.btw_subagent_sessions, session_id)) { @@ -809,7 +809,7 @@ clear_subagent_session <- function(session_id) { #' will be automatically cleaned up when the R session ends. #' #' @noRd -clear_all_subagent_sessions <- function() { +subagent_clear_all_sessions <- function() { session_ids <- env_names(.btw_subagent_sessions) count <- length(session_ids) diff --git a/R/tools.R b/R/tools.R index 66be321d..9576a213 100644 --- a/R/tools.R +++ b/R/tools.R @@ -45,7 +45,7 @@ btw_tools <- function(...) { # Merge built-in tools with custom agent tools from agent-*.md files all_btw_tools <- .btw_tools - custom_agents <- get_custom_agent_tools() + custom_agents <- custom_agent_discover_tools() for (name in names(custom_agents)) { # Custom agents don't override built-in tools if (!name %in% names(all_btw_tools)) { diff --git a/tests/testthat/test-tool-agent-custom.R b/tests/testthat/test-tool-agent-custom.R index 5a8722bc..0e9c0694 100644 --- a/tests/testthat/test-tool-agent-custom.R +++ b/tests/testthat/test-tool-agent-custom.R @@ -54,7 +54,7 @@ test_that("custom agents can be discovered and loaded", { local_test_agent_file(btw_dir, "integration_test") # Get tools from that directory - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()) expect_type(tools, "list") expect_true("btw_tool_agent_integration_test" %in% names(tools)) @@ -70,17 +70,17 @@ test_that("custom agents can be discovered and loaded", { expect_equal(tool@description, "A test agent") }) -test_that("get_custom_agent_tools() returns empty list when no agents", { +test_that("custom_agent_discover_tools() returns empty list when no agents", { tmp_dir <- withr::local_tempdir() btw_dir <- file.path(tmp_dir, ".btw") dir.create(btw_dir) - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()) expect_length(tools, 0) }) -test_that("get_custom_agent_tools() skips files with invalid names", { +test_that("custom_agent_discover_tools() skips files with invalid names", { skip_if_not_installed("ellmer") tmp_dir <- withr::local_tempdir() @@ -99,7 +99,7 @@ Invalid agent." writeLines(content_invalid, file.path(btw_dir, "agent-invalid.md")) expect_warning( - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()), + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()), "Invalid agent name" ) @@ -108,7 +108,7 @@ Invalid agent." expect_true("btw_tool_agent_valid_agent" %in% names(tools)) }) -test_that("get_custom_agent_tools() skips files with missing name", { +test_that("custom_agent_discover_tools() skips files with missing name", { skip_if_not_installed("ellmer") tmp_dir <- withr::local_tempdir() @@ -124,14 +124,14 @@ Agent without name." # Should warn about missing name expect_warning( - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()), + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()), "Agent file has no name" ) expect_length(tools, 0) }) -test_that("get_custom_agent_tools() warns on error loading agent", { +test_that("custom_agent_discover_tools() warns on error loading agent", { tmp_dir <- withr::local_tempdir() btw_dir <- file.path(tmp_dir, ".btw") dir.create(btw_dir) @@ -145,12 +145,12 @@ Bad YAML." writeLines(content_bad_yaml, file.path(btw_dir, "agent-bad.md")) expect_warning( - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()), + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()), "Error loading custom agent" ) }) -test_that("get_custom_agent_tools() handles multiple agents", { +test_that("custom_agent_discover_tools() handles multiple agents", { skip_if_not_installed("ellmer") tmp_dir <- withr::local_tempdir() @@ -161,7 +161,7 @@ test_that("get_custom_agent_tools() handles multiple agents", { local_test_agent_file(btw_dir, "agent_two") local_test_agent_file(btw_dir, "agent_three") - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()) expect_length(tools, 3) expect_true("btw_tool_agent_agent_one" %in% names(tools)) @@ -259,20 +259,9 @@ test_that("validate_agent_name() rejects edge cases", { # Internal closure structure is an implementation detail. # Tool behavior is tested through integration tests below. -# Test register_custom_agent_tools() ------------------------------------------ - -test_that("register_custom_agent_tools() can be called without error", { - # This is mainly a smoke test - the function modifies .btw_tools - # which is a global state - - # Clear cache first - - expect_no_error(register_custom_agent_tools()) -}) - # ---- Custom Agent Configuration (Behavioral) -------------------------------- -test_that("btw_custom_agent_client_config creates chat with custom system prompt", { +test_that("custom_agent_client_from_config creates chat with custom system prompt", { tmp_dir <- withr::local_tempdir() btw_dir <- file.path(tmp_dir, ".btw") dir.create(btw_dir) @@ -300,7 +289,7 @@ test_that("btw_custom_agent_client_config creates chat with custom system prompt read_agent_md_file(file.path(btw_dir, "agent-code-reviewer.md")) }) - chat <- btw_custom_agent_client_config(agent_config) + chat <- custom_agent_client_from_config(agent_config) expect_true(inherits(chat, "Chat")) @@ -315,7 +304,7 @@ test_that("btw_custom_agent_client_config creates chat with custom system prompt expect_false(any(grepl("^btw_tool_docs_", tool_names))) }) -test_that("btw_custom_agent_client_config respects tool restrictions", { +test_that("custom_agent_client_from_config respects tool restrictions", { agent_config <- list( name = "docs_agent", description = "Documentation expert", @@ -326,14 +315,14 @@ test_that("btw_custom_agent_client_config respects tool restrictions", { client = NULL ) - chat <- btw_custom_agent_client_config(agent_config) + chat <- custom_agent_client_from_config(agent_config) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) expect_false(any(grepl("^btw_tool_files_", tool_names))) }) -test_that("btw_custom_agent_client_config concatenates system prompts", { +test_that("custom_agent_client_from_config concatenates system prompts", { agent_config <- list( name = "test", client = NULL, @@ -343,7 +332,7 @@ test_that("btw_custom_agent_client_config concatenates system prompts", { tools_allowed = NULL ) - chat <- btw_custom_agent_client_config(agent_config) + chat <- custom_agent_client_from_config(agent_config) system_prompt <- chat$get_system_prompt() # Should include base prompt @@ -354,7 +343,7 @@ test_that("btw_custom_agent_client_config concatenates system prompts", { expect_match(system_prompt, "---") }) -test_that("btw_custom_agent_client_config uses btw_agent_resolve_client", { +test_that("custom_agent_client_from_config uses subagent_resolve_client", { # Test explicit client custom_client <- ellmer::chat_anthropic(model = "claude-opus-4-20241120") agent_config <- list( @@ -364,7 +353,7 @@ test_that("btw_custom_agent_client_config uses btw_agent_resolve_client", { system_prompt = "Test" ) - chat <- btw_custom_agent_client_config(agent_config) + chat <- custom_agent_client_from_config(agent_config) expect_identical(chat, custom_client) # Test option fallback @@ -373,7 +362,7 @@ test_that("btw_custom_agent_client_config uses btw_agent_resolve_client", { ) agent_config$client <- NULL - chat2 <- btw_custom_agent_client_config(agent_config) + chat2 <- custom_agent_client_from_config(agent_config) expect_equal(chat2$get_model(), "claude-sonnet-4-20250514") }) @@ -388,8 +377,8 @@ test_that("multiple custom agents can be discovered and registered", { local_test_agent_file(btw_dir, "agent_one") local_test_agent_file(btw_dir, "agent_two") - # Use get_custom_agent_tools() to get internal btw tool structure - tools <- withr::with_dir(tmp_dir, get_custom_agent_tools()) + # Use custom_agent_discover_tools() to get internal btw tool structure + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()) expect_type(tools, "list") expect_true("btw_tool_agent_agent_one" %in% names(tools)) diff --git a/tests/testthat/test-tool-agent-subagent.R b/tests/testthat/test-tool-agent-subagent.R index a73492ee..7ced1afc 100644 --- a/tests/testthat/test-tool-agent-subagent.R +++ b/tests/testthat/test-tool-agent-subagent.R @@ -9,30 +9,30 @@ mock_chat <- function() { ) } -# Internal session management functions (generate_session_id, store_session, etc.) -# are tested through the public API via btw_agent_get_or_create_session() +# Internal session management functions (subagent_new_session_id, subagent_store_session, etc.) +# are tested through the public API via subagent_get_or_create_session() # See behavioral tests at the end of this file. -test_that("btw_subagent_client_config() uses default tools", { +test_that("subagent_client() uses default tools", { withr::local_options( btw.subagent.tools_default = NULL, btw.tools = NULL ) - chat <- btw_subagent_client_config() + chat <- subagent_client() expect_true(inherits(chat, "Chat")) expect_true(length(chat$get_tools()) > 0) }) -test_that("btw_subagent_client_config() respects tool filtering", { - chat <- btw_subagent_client_config(tools = c("docs")) +test_that("subagent_client() respects tool filtering", { + chat <- subagent_client(tools = c("docs")) expect_true(inherits(chat, "Chat")) expect_true(length(chat$get_tools()) > 0) }) -test_that("btw_subagent_client_config() follows client precedence", { +test_that("subagent_client() follows client precedence", { skip_if_not_installed("ellmer") withr::local_options( @@ -40,29 +40,29 @@ test_that("btw_subagent_client_config() follows client precedence", { btw.client = "anthropic/claude-opus-4-20241120" ) - chat <- btw_subagent_client_config() + chat <- subagent_client() expect_true(inherits(chat, "Chat")) chat_obj <- ellmer::chat_anthropic() - chat2 <- btw_subagent_client_config(client = chat_obj) + chat2 <- subagent_client(client = chat_obj) expect_identical(chat2, chat_obj) }) -test_that("btw_subagent_client_config() clones clients from options", { +test_that("subagent_client() clones clients from options", { skip_if_not_installed("ellmer") chat_obj <- ellmer::chat_anthropic() withr::local_options(btw.subagent.client = chat_obj) - chat1 <- btw_subagent_client_config() - chat2 <- btw_subagent_client_config() + chat1 <- subagent_client() + chat2 <- subagent_client() expect_false(identical(chat1, chat2)) expect_false(identical(chat1, chat_obj)) }) -# build_subagent_description() is internal - description content is tested +# subagent_build_description() is internal - description content is tested # through btw_tool_agent_subagent registration tests below test_that("btw_tool_agent_subagent is registered in btw_tools", { @@ -94,20 +94,20 @@ test_that("BtwSubagentResult inherits from BtwToolResult", { # Tests for new btw.subagent.tools_default and btw.subagent.tools_allowed options -test_that("btw_subagent_client_config() uses tools_default when tools is NULL", { +test_that("subagent_client() uses tools_default when tools is NULL", { withr::local_options( btw.subagent.tools_default = c("docs"), btw.tools = NULL ) - chat <- btw_subagent_client_config(tools = NULL) + chat <- subagent_client(tools = NULL) expect_true(inherits(chat, "Chat")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) }) -test_that("btw_subagent_client_config() falls back through precedence chain", { +test_that("subagent_client() falls back through precedence chain", { # Test fallback: tools_default -> btw.tools -> btw_tools() # Test fallback to btw.tools @@ -116,7 +116,7 @@ test_that("btw_subagent_client_config() falls back through precedence chain", { btw.tools = c("search") ) - chat <- btw_subagent_client_config(tools = NULL) + chat <- subagent_client(tools = NULL) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_search_", tool_names))) @@ -127,106 +127,106 @@ test_that("btw_subagent_client_config() falls back through precedence chain", { btw.tools = NULL ) - chat2 <- btw_subagent_client_config(tools = NULL) + chat2 <- subagent_client(tools = NULL) tool_names2 <- sapply(chat2$get_tools(), function(t) t@name) expect_true(length(tool_names2) > 0) # Should get all btw_tools() }) -test_that("btw_subagent_client_config() filters tools with tools_allowed", { +test_that("subagent_client() filters tools with tools_allowed", { withr::local_options( btw.subagent.tools_allowed = c("docs"), btw.subagent.tools_default = c("docs", "files") ) - chat <- btw_subagent_client_config(tools = NULL) + chat <- subagent_client(tools = NULL) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) expect_false(any(grepl("^btw_tool_files_", tool_names))) }) -test_that("btw_subagent_client_config() errors on disallowed tools", { +test_that("subagent_client() errors on disallowed tools", { withr::local_options( btw.subagent.tools_allowed = c("docs") ) expect_error( - btw_subagent_client_config(tools = c("files")), + subagent_client(tools = c("files")), "Subagent requested disallowed tools" ) expect_error( - btw_subagent_client_config(tools = c("files")), + subagent_client(tools = c("files")), "btw.subagent.tools_allowed" ) }) -test_that("btw_subagent_client_config() allows tools within whitelist", { +test_that("subagent_client() allows tools within whitelist", { withr::local_options( btw.subagent.tools_allowed = c("docs", "files") ) # Should not error - chat <- btw_subagent_client_config(tools = c("docs")) + chat <- subagent_client(tools = c("docs")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) }) -test_that("btw_subagent_client_config() filters explicit tools against tools_allowed", { +test_that("subagent_client() filters explicit tools against tools_allowed", { withr::local_options( btw.subagent.tools_allowed = c("docs", "search") ) # Requesting tools partially in whitelist should error expect_error( - btw_subagent_client_config(tools = c("docs", "files")), + subagent_client(tools = c("docs", "files")), "disallowed tools" ) # Requesting only allowed tools should work - chat <- btw_subagent_client_config(tools = c("docs", "search")) + chat <- subagent_client(tools = c("docs", "search")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(any(grepl("^btw_tool_docs_", tool_names))) expect_true(any(grepl("^btw_tool_search_", tool_names))) }) -test_that("btw_subagent_client_config() works without tools_allowed set", { +test_that("subagent_client() works without tools_allowed set", { withr::local_options( btw.subagent.tools_allowed = NULL, btw.subagent.tools_default = c("files") ) # Should work with any tools when tools_allowed is NULL - chat <- btw_subagent_client_config(tools = c("docs")) + chat <- subagent_client(tools = c("docs")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) }) -test_that("btw_subagent_client_config() precedence: explicit tools > tools_default", { +test_that("subagent_client() precedence: explicit tools > tools_default", { withr::local_options( btw.subagent.tools_default = c("docs"), btw.subagent.tools_allowed = c("docs", "files") ) # Explicit tools argument should override tools_default - chat <- btw_subagent_client_config(tools = c("files")) + chat <- subagent_client(tools = c("files")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_files_", tool_names))) expect_false(any(grepl("^btw_tool_docs_", tool_names))) }) -test_that("btw_subagent_client_config() tools_allowed filters defaults", { +test_that("subagent_client() tools_allowed filters defaults", { withr::local_options( btw.subagent.tools_allowed = c("docs"), btw.subagent.tools_default = c("docs", "files", "search") ) - chat <- btw_subagent_client_config(tools = NULL) + chat <- subagent_client(tools = NULL) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true(all(grepl("^btw_tool_docs_", tool_names))) @@ -234,28 +234,28 @@ test_that("btw_subagent_client_config() tools_allowed filters defaults", { expect_false(any(grepl("^btw_tool_search_", tool_names))) }) -test_that("btw_subagent_client_config() error message is helpful", { +test_that("subagent_client() error message is helpful", { withr::local_options( btw.subagent.tools_allowed = c("docs") ) expect_error( - btw_subagent_client_config(tools = c("files")), + subagent_client(tools = c("files")), "btw_tool_files_" ) expect_error( - btw_subagent_client_config(tools = c("github")), + subagent_client(tools = c("github")), "btw_tool_github" ) expect_error( - btw_subagent_client_config(tools = c("files")), + subagent_client(tools = c("files")), "Set.*btw.subagent.tools_allowed = NULL" ) }) -test_that("btw_subagent_client_config() tools_allowed works with specific tool names", { +test_that("subagent_client() tools_allowed works with specific tool names", { withr::local_options( btw.subagent.tools_allowed = c( "btw_tool_docs_help_page", @@ -264,7 +264,7 @@ test_that("btw_subagent_client_config() tools_allowed works with specific tool n ) # Should work with specific allowed tools - chat <- btw_subagent_client_config(tools = c("btw_tool_docs_help_page")) + chat <- subagent_client(tools = c("btw_tool_docs_help_page")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) expect_true("btw_tool_docs_help_page" %in% tool_names) @@ -272,7 +272,7 @@ test_that("btw_subagent_client_config() tools_allowed works with specific tool n # Should error with disallowed specific tool expect_error( - btw_subagent_client_config(tools = c("search_packages")), + subagent_client(tools = c("search_packages")), "disallowed tools" ) }) @@ -282,13 +282,13 @@ test_that("btw_subagent_client_config() tools_allowed works with specific tool n test_that("btw_tool_agent_subagent errors when explicitly requested", { # Explicitly requesting the subagent tool now throws an error expect_error( - btw_subagent_client_config(tools = c("btw_tool_agent_subagent", "docs")), + subagent_client(tools = c("btw_tool_agent_subagent", "docs")), "Subagents cannot spawn other subagents" ) # Same for short name expect_error( - btw_subagent_client_config(tools = c("subagent", "docs")), + subagent_client(tools = c("subagent", "docs")), "Subagents cannot spawn other subagents" ) }) @@ -301,7 +301,7 @@ test_that("btw_tool_agent_subagent is filtered out from default tools", { ) # Use default tools (btw_tools()) - chat <- btw_subagent_client_config(tools = NULL) + chat <- subagent_client(tools = NULL) tool_names <- map_chr(chat$get_tools(), function(t) t@name) @@ -315,7 +315,7 @@ test_that("btw_tool_agent_subagent is filtered out from default tools", { test_that("btw_tool_agent_subagent is silently filtered out from 'agent' tool group", { # Request the 'agent' tool group which includes btw_tool_agent_subagent # The subagent tool is silently filtered via can_register (no warning) - chat <- btw_subagent_client_config(tools = c("agent")) + chat <- subagent_client(tools = c("agent")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) @@ -330,7 +330,7 @@ test_that("btw_tool_agent_subagent is silently filtered out even when in tools_a # Request agent group (which includes subagent tool) # The subagent tool is silently filtered via can_register - chat <- btw_subagent_client_config(tools = c("agent", "docs")) + chat <- subagent_client(tools = c("agent", "docs")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) @@ -346,12 +346,12 @@ test_that("btw_tool_agent_subagent never appears in chat$get_tools() for subagen # Scenario 1: Explicit request → throws error expect_error( - btw_subagent_client_config(tools = c("btw_tool_agent_subagent")), + subagent_client(tools = c("btw_tool_agent_subagent")), "Subagents cannot spawn other subagents" ) # Scenario 2: Via tool group → silently filtered - chat2 <- btw_subagent_client_config(tools = c("agent")) + chat2 <- subagent_client(tools = c("agent")) expect_false( "btw_tool_agent_subagent" %in% sapply(chat2$get_tools(), function(t) t@name) ) @@ -361,14 +361,14 @@ test_that("btw_tool_agent_subagent never appears in chat$get_tools() for subagen btw.subagent.tools_default = NULL, btw.tools = NULL ) - chat3 <- btw_subagent_client_config(tools = NULL) + chat3 <- subagent_client(tools = NULL) expect_false( "btw_tool_agent_subagent" %in% sapply(chat3$get_tools(), function(t) t@name) ) # Scenario 4: Mixed explicit with other tools → throws error expect_error( - btw_subagent_client_config( + subagent_client( tools = c("btw_tool_agent_subagent", "docs", "files") ), "Subagents cannot spawn other subagents" @@ -382,12 +382,12 @@ test_that("subagent tool errors even when in tools_allowed", { # Even if subagent tool is in allowed list, explicit request throws error expect_error( - btw_subagent_client_config(tools = c("btw_tool_agent_subagent", "docs")), + subagent_client(tools = c("btw_tool_agent_subagent", "docs")), "Subagents cannot spawn other subagents" ) # But requesting via group doesn't error - silently filters - chat <- btw_subagent_client_config(tools = c("agent", "docs")) + chat <- subagent_client(tools = c("agent", "docs")) tool_names <- map_chr(chat$get_tools(), function(t) t@name) # Subagent tool should be filtered out @@ -399,8 +399,8 @@ test_that("subagent tool errors even when in tools_allowed", { # ---- Chat Client Configuration ---------------------------------------------- -test_that("btw_subagent_client_config creates chat with filtered tools", { - chat <- btw_subagent_client_config(tools = "files") +test_that("subagent_client creates chat with filtered tools", { + chat <- subagent_client(tools = "files") expect_true(inherits(chat, "Chat")) @@ -409,16 +409,16 @@ test_that("btw_subagent_client_config creates chat with filtered tools", { expect_false(any(grepl("^btw_tool_docs_", tool_names))) }) -test_that("btw_subagent_client_config respects explicit client parameter", { +test_that("subagent_client respects explicit client parameter", { custom_client <- ellmer::chat_anthropic(model = "claude-opus-4-20241120") - chat <- btw_subagent_client_config(client = custom_client) + chat <- subagent_client(client = custom_client) expect_identical(chat, custom_client) }) -test_that("btw_subagent_client_config includes base subagent prompt", { - chat <- btw_subagent_client_config() +test_that("subagent_client includes base subagent prompt", { + chat <- subagent_client() system_prompt <- chat$get_system_prompt() @@ -429,10 +429,10 @@ test_that("btw_subagent_client_config includes base subagent prompt", { # ---- Session Management (via helpers) --------------------------------------- -test_that("btw_agent_get_or_create_session creates new session when ID is NULL", { - clear_all_subagent_sessions() +test_that("subagent_get_or_create_session creates new session when ID is NULL", { + subagent_clear_all_sessions() - result <- btw_agent_get_or_create_session( + result <- subagent_get_or_create_session( session_id = NULL, create_chat_fn = function() mock_chat() ) @@ -443,19 +443,19 @@ test_that("btw_agent_get_or_create_session creates new session when ID is NULL", expect_true(result$is_new) expect_true(inherits(result$chat, "Chat")) - clear_all_subagent_sessions() + subagent_clear_all_sessions() }) -test_that("btw_agent_get_or_create_session retrieves existing session", { - clear_all_subagent_sessions() +test_that("subagent_get_or_create_session retrieves existing session", { + subagent_clear_all_sessions() # Create a session first - session_id <- generate_session_id() + session_id <- subagent_new_session_id() chat <- mock_chat() - store_session(session_id, chat) + subagent_store_session(session_id, chat) # Retrieve it - result <- btw_agent_get_or_create_session( + result <- subagent_get_or_create_session( session_id = session_id, create_chat_fn = function() stop("Should not be called") ) @@ -464,14 +464,14 @@ test_that("btw_agent_get_or_create_session retrieves existing session", { expect_identical(result$chat, chat) expect_false(result$is_new) - clear_all_subagent_sessions() + subagent_clear_all_sessions() }) -test_that("btw_agent_get_or_create_session errors helpfully for invalid session", { - clear_all_subagent_sessions() +test_that("subagent_get_or_create_session errors helpfully for invalid session", { + subagent_clear_all_sessions() expect_error( - btw_agent_get_or_create_session( + subagent_get_or_create_session( session_id = "nonexistent_badger_wombat", create_chat_fn = function() mock_chat() ), @@ -479,7 +479,7 @@ test_that("btw_agent_get_or_create_session errors helpfully for invalid session" ) expect_error( - btw_agent_get_or_create_session( + subagent_get_or_create_session( session_id = "nonexistent", create_chat_fn = function() mock_chat() ), @@ -495,7 +495,7 @@ test_that("tools_allowed option filters configured tools", { btw.subagent.tools_default = c("docs", "files") ) - chat <- btw_subagent_client_config(tools = NULL) + chat <- subagent_client(tools = NULL) tool_names <- map_chr(chat$get_tools(), function(t) t@name) @@ -510,7 +510,7 @@ test_that("subagent recursion is prevented in default tools", { btw.subagent.tools_allowed = NULL ) - chat <- btw_subagent_client_config(tools = NULL) + chat <- subagent_client(tools = NULL) tool_names <- map_chr(chat$get_tools(), function(t) t@name) From 0bcd31d6ca036a77bc37491ab485bd0f2641e561 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 14:12:18 -0500 Subject: [PATCH 30/44] chore: support additional custom icon packs --- R/tool-agent-custom.R | 162 +++++++++++++-- R/tools.R | 4 +- tests/testthat/test-tool-agent-custom.R | 254 ++++++++++++++++++++++++ 3 files changed, 398 insertions(+), 22 deletions(-) diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R index 659813a9..545eb146 100644 --- a/R/tool-agent-custom.R +++ b/R/tool-agent-custom.R @@ -83,6 +83,114 @@ validate_agent_name <- function(name, path) { TRUE } +#' Resolve custom icon from string specification +#' +#' Parses an icon specification and returns the appropriate icon object. +#' +#' @param icon_spec String specifying the icon. Can be: +#' - Raw SVG: starts with `...'` +#' +#' 3. **Package-prefixed icon**: Uses `pkg::icon-name` format to specify icons +#' from other icon packages. Supported packages: +#' +#' | Package | Syntax | Function Called | +#' |----------------|-----------------------------|-------------------------- +#' | fontawesome | `fontawesome::home` | [fontawesome::fa()] | +#' | bsicons | `bsicons::house` | [bsicons::bs_icon()] | +#' | phosphoricons | `phosphoricons::house` | [phosphoricons::ph()] | +#' | rheroicons | `rheroicons::home` | [rheroicons::rheroicon()]| +#' | tabler | `tabler::home` | [tabler::icon()] | +#' | shiny | `shiny::home` | [shiny::icon()] | +#' +#' The specified package must be installed. If the package is missing or the +#' icon name is invalid, a warning is issued and the default agent icon is +#' used. +#' #' ### Example Agent File #' #' ```yaml @@ -120,7 +255,7 @@ validate_agent_name <- function(name, path) { #' name: code_reviewer #' description: Reviews code for best practices and potential issues. #' title: Code Reviewer -#' icon: magnifying-glass-chart +#' icon: magnifying-glass #' tools: #' - files #' - docs @@ -232,23 +367,8 @@ btw_agent_tool <- function(path) { ) # Set icon if specified, otherwise use default agent icon - if (!is.null(config$icon) && nzchar(config$icon)) { - tryCatch( - { - tool@annotations$icon <- shiny::icon(config$icon) - }, - error = function(e) { - cli::cli_warn(c( - "Invalid icon {.val {config$icon}} for agent {.val {name}}: {.path {path}}", - "i" = "Using default agent icon.", - "x" = conditionMessage(e) - )) - tool@annotations$icon <<- tool_group_icon("agent") - } - ) - } else { - tool@annotations$icon <- tool_group_icon("agent") - } + tool@annotations$icon <- custom_icon(config$icon) %||% + tool_group_icon("agent") tool } diff --git a/R/tools.R b/R/tools.R index 9576a213..6af80bfc 100644 --- a/R/tools.R +++ b/R/tools.R @@ -191,7 +191,9 @@ set_tool_annotations <- function(tool, group) { tool@annotations <- list() } - tool@annotations$icon <- tool_group_icon(group) + if (is.null(tool@annotations$icon)) { + tool@annotations$icon <- tool_group_icon(group) + } tool@annotations$btw_group <- group tool } diff --git a/tests/testthat/test-tool-agent-custom.R b/tests/testthat/test-tool-agent-custom.R index 0e9c0694..875ad12c 100644 --- a/tests/testthat/test-tool-agent-custom.R +++ b/tests/testthat/test-tool-agent-custom.R @@ -396,3 +396,257 @@ test_that("multiple custom agents can be discovered and registered", { expect_equal(agent_two_def$group, "agent") expect_type(agent_two_def$tool, "closure") }) + +# Test custom_icon() ----------------------------------------------------------- + +describe("custom_icon()", { + it("returns NULL for NULL or empty input", { + expect_null(custom_icon(NULL)) + expect_null(custom_icon("")) + }) + + it("handles raw SVG input", { + svg <- '' + result <- custom_icon(svg) + + expect_s3_class(result, "html") + expect_true(grepl("' + result <- custom_icon(svg) + + expect_s3_class(result, "html") + }) + + it("handles SVG case-insensitively", { + svg <- '' + result <- custom_icon(svg) + + expect_s3_class(result, "html") + }) + + it("uses shiny::icon() for plain icon names", { + skip_if_not_installed("shiny") + + result <- custom_icon("home") + expect_s3_class(result, "shiny.tag") + # Font Awesome 6 uses "fa-house" for "home" + expect_true(grepl("fa-ho", as.character(result))) + }) + + it("returns shiny.tag even for unknown icon names", { + # shiny::icon() doesn't error for unknown names, it just prints a message + skip_if_not_installed("shiny") + + result <- custom_icon("some-unknown-icon-name") + # shiny::icon() returns a tag anyway + expect_s3_class(result, "shiny.tag") + }) + + it("warns for unknown package prefix", { + expect_warning( + result <- custom_icon("unknownpkg::someicon"), + "Unknown icon package" + ) + expect_null(result) + }) + + it("warns for invalid specification format", { + expect_warning( + result <- custom_icon("too::many::colons"), + "Invalid icon specification" + ) + expect_null(result) + }) + + it("warns when package is not installed", { + # Use a package that definitely isn't installed + expect_warning( + result <- custom_icon("notarealpackage123::home"), + "Unknown icon package" + ) + expect_null(result) + }) +}) + +describe("custom_icon() with fontawesome package", { + skip_if_not_installed("fontawesome") + + it("uses fontawesome::fa() for fontawesome:: prefix", { + result <- custom_icon("fontawesome::home") + + expect_s3_class(result, "fontawesome") + expect_true(grepl("svg", as.character(result))) + }) + + it("warns for invalid fontawesome icon", { + expect_warning( + result <- custom_icon("fontawesome::nonexistent-icon-xyz"), + "Error creating icon" + ) + expect_null(result) + }) +}) + +describe("custom_icon() with bsicons package", { + skip_if_not_installed("bsicons") + + it("uses bsicons::bs_icon() for bsicons:: prefix", { + result <- custom_icon("bsicons::house") + + # bsicons returns an "html" class object + expect_s3_class(result, "html") + expect_true(grepl("svg", as.character(result))) + }) + + it("warns for invalid bsicons icon", { + expect_warning( + result <- custom_icon("bsicons::nonexistent-icon-xyz"), + "Error creating icon" + ) + expect_null(result) + }) +}) + +describe("custom_icon() with phosphoricons package", { + skip_if_not_installed("phosphoricons") + + it("uses phosphoricons::ph() for phosphoricons:: prefix", { + result <- custom_icon("phosphoricons::house") + + expect_s3_class(result, "shiny.tag") + expect_true(grepl("svg", as.character(result))) + }) +}) + +describe("custom_icon() with shiny:: prefix", { + skip_if_not_installed("shiny") + + it("uses shiny::icon() for shiny:: prefix", { + result <- custom_icon("shiny::home") + + expect_s3_class(result, "shiny.tag") + # Font Awesome 6 uses "fa-house" for "home" + expect_true(grepl("fa-ho", as.character(result))) + }) +}) + +describe("custom_icon() integration with btw_agent_tool()", { + it("applies custom icon from config", { + skip_if_not_installed("shiny") + + tmp_dir <- withr::local_tempdir() + agent_file <- file.path(tmp_dir, "agent-icon_test.md") + writeLines( + c( + "---", + "name: icon_test", + "description: Test icon configuration", + "icon: robot", + "---", + "Test prompt" + ), + agent_file + ) + + tool <- btw_agent_tool(agent_file) + + expect_false(is.null(tool)) + expect_s3_class(tool@annotations$icon, "shiny.tag") + }) + + it("applies SVG icon from config", { + tmp_dir <- withr::local_tempdir() + agent_file <- file.path(tmp_dir, "agent-svg_test.md") + writeLines( + c( + "---", + "name: svg_test", + "description: Test SVG icon", + 'icon: \'\'', + "---", + "Test prompt" + ), + agent_file + ) + + tool <- btw_agent_tool(agent_file) + + expect_false(is.null(tool)) + expect_s3_class(tool@annotations$icon, "html") + }) + + it("falls back to default icon when custom_icon returns NULL", { + tmp_dir <- withr::local_tempdir() + agent_file <- file.path(tmp_dir, "agent-no_icon.md") + writeLines( + c( + "---", + "name: no_icon", + "description: Test without icon", + "---", + "Test prompt" + ), + agent_file + ) + + tool <- btw_agent_tool(agent_file) + + expect_false(is.null(tool)) + # Should have the default agent icon + expect_false(is.null(tool@annotations$icon)) + }) + + it("falls back to default icon for unknown package prefix", { + tmp_dir <- withr::local_tempdir() + agent_file <- file.path(tmp_dir, "agent-bad_icon.md") + writeLines( + c( + "---", + "name: bad_icon", + "description: Test with invalid icon", + "icon: unknownpkg::someicon", + "---", + "Test prompt" + ), + agent_file + ) + + expect_warning( + tool <- btw_agent_tool(agent_file), + "Unknown icon package" + ) + + expect_false(is.null(tool)) + # Should fall back to default agent icon + expect_false(is.null(tool@annotations$icon)) + }) + + it("accepts unknown shiny icon names without warning", { + # shiny::icon() doesn't warn for unknown icon names, so neither do we + skip_if_not_installed("shiny") + + tmp_dir <- withr::local_tempdir() + agent_file <- file.path(tmp_dir, "agent-unknown_icon.md") + writeLines( + c( + "---", + "name: unknown_icon", + "description: Test with unknown shiny icon", + "icon: some-unknown-icon-xyz", + "---", + "Test prompt" + ), + agent_file + ) + + # No warning expected since shiny::icon() accepts any name + tool <- btw_agent_tool(agent_file) + + expect_false(is.null(tool)) + # Will have the shiny icon (even though it's not a real FA icon) + expect_s3_class(tool@annotations$icon, "shiny.tag") + }) +}) From fb3f97f13cd9bc973bfd469e2cca9977026a41e2 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 14:13:10 -0500 Subject: [PATCH 31/44] chore: move custom agent code up top --- R/tool-agent-custom.R | 380 +++++++++++++++++++++--------------------- 1 file changed, 190 insertions(+), 190 deletions(-) diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R index 545eb146..91b54ad6 100644 --- a/R/tool-agent-custom.R +++ b/R/tool-agent-custom.R @@ -1,196 +1,6 @@ #' @include tool-agent-subagent.R NULL -#' Discover agent-*.md files from project and user directories -#' -#' Scans for custom agent definition files in: -#' - `.btw/agent-*.md` (project level) -#' - `~/.btw/agent-*.md` (user level) -#' - `~/.config/btw/agent-*.md` (user level) -#' -#' @return Character vector of absolute paths to agent-*.md files -#' @noRd -discover_agent_md_files <- function() { - project_files <- find_project_agent_files() - user_files <- find_user_agent_files() - unique(c(project_files, user_files)) -} - -#' Read and parse an agent-*.md file -#' -#' Wrapper around `read_single_btw_file()` that extracts YAML frontmatter -#' and body content from an agent definition file. -#' -#' @param path Path to the agent-*.md file -#' @return List with YAML config and body content (system_prompt) -#' @noRd -read_agent_md_file <- function(path) { - if (!fs::file_exists(path)) { - return(NULL) - } - - config <- read_single_btw_file(path) - - # Rename btw_system_prompt to system_prompt for agent configs - if (!is.null(config$btw_system_prompt)) { - config$system_prompt <- config$btw_system_prompt - config$btw_system_prompt <- NULL - } - - config -} - -#' Validate agent name -#' -#' Ensures the agent name is a valid R identifier and not reserved. -#' -#' @param name The agent name from YAML frontmatter -#' @param path Path to the file (for error messages) -#' @return TRUE if valid, otherwise signals an error -#' @noRd -validate_agent_name <- function(name, path) { - check_string(name, allow_null = TRUE) - - if (is.null(name) || !nzchar(name)) { - cli::cli_warn(c( - "Agent file has no name: {.path {path}}", - "i" = "Add {.code name: agent_name} to the YAML frontmatter.", - "i" = "Skipping this file." - )) - return(FALSE) - } - - # Check for reserved name - if (name %in% names(.btw_tools)) { - cli::cli_warn(c( - "Agent name cannot be {.val {name}}: {.path {path}}", - "i" = "The name {.val {name}} is reserved. Skipping this file." - )) - return(FALSE) - } - - # Check if valid R identifier - if (!grepl("^[a-zA-Z][a-zA-Z0-9_]*$", name)) { - cli::cli_warn(c( - "Invalid agent name {.val {name}}: {.path {path}}", - "i" = "Agent names must be valid R identifiers (letters, numbers, underscores).", - "i" = "Names must start with a letter.", - "i" = "Skipping this file." - )) - return(FALSE) - } - - TRUE -} - -#' Resolve custom icon from string specification -#' -#' Parses an icon specification and returns the appropriate icon object. -#' -#' @param icon_spec String specifying the icon. Can be: -#' - Raw SVG: starts with ` Date: Mon, 5 Jan 2026 14:25:37 -0500 Subject: [PATCH 32/44] fix: better warning for unsupported icons --- R/tool-agent-custom.R | 87 ++++++++++++++----------- tests/testthat/test-tool-agent-custom.R | 24 +++---- 2 files changed, 62 insertions(+), 49 deletions(-) diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R index 91b54ad6..2e424808 100644 --- a/R/tool-agent-custom.R +++ b/R/tool-agent-custom.R @@ -422,7 +422,12 @@ custom_icon <- function(icon_spec) { return(htmltools::HTML(icon_spec)) } - # Package icon: pkg::icon-name + # Default to shiny::icon() + pkg <- "shiny" + icon_fn <- "icon" + icon_name <- icon_spec + + # Parse package prefix if present: pkg::icon-name if (grepl("::", icon_spec, fixed = TRUE)) { parts <- strsplit(icon_spec, "::", fixed = TRUE)[[1]] if (length(parts) != 2) { @@ -449,56 +454,62 @@ custom_icon <- function(icon_spec) { cli::cli_warn("Unknown icon package: {.val {pkg}}") return(NULL) } + } - # Check if package is installed - if (!requireNamespace(pkg, quietly = TRUE)) { - cli::cli_warn( - "Package {.pkg {pkg}} is not installed for icon {.val {icon_spec}}" - ) - return(NULL) - } - - # Get the function from the package namespace - ns <- tryCatch(asNamespace(pkg), error = function(e) NULL) - if (is.null(ns)) { - cli::cli_warn("Cannot access namespace for package {.pkg {pkg}}") - return(NULL) - } + # Check if package is installed + if (!requireNamespace(pkg, quietly = TRUE)) { + cli::cli_warn( + "Package {.pkg {pkg}} is not installed for icon {.val {icon_spec}}" + ) + return(NULL) + } - fn <- ns[[icon_fn]] - if (is.null(fn) || !is.function(fn)) { - cli::cli_warn( - "Function {.fn {icon_fn}} not found in package {.pkg {pkg}}" - ) - return(NULL) - } + # Get the function from the package namespace + ns <- tryCatch(asNamespace(pkg), error = function(e) NULL) + if (is.null(ns)) { + cli::cli_warn("Cannot access namespace for package {.pkg {pkg}}") + return(NULL) + } - # Call the icon function - result <- tryCatch( - fn(icon_name), - error = function(e) { - cli::cli_warn(c( - "Error creating icon {.val {icon_name}} from {.pkg {pkg}}", - "x" = conditionMessage(e) - )) - NULL - } + fn <- ns[[icon_fn]] + if (is.null(fn) || !is.function(fn)) { + cli::cli_warn( + "Function {.fn {icon_fn}} not found in package {.pkg {pkg}}" ) - - return(result) + return(NULL) } - # Default: use shiny::icon() - tryCatch( - shiny::icon(icon_spec), + # Call the icon function, catching errors and "unknown icon" messages + unknown_icon <- FALSE + + result <- tryCatch( + withCallingHandlers( + fn(icon_name), + message = function(m) { + if (grepl("does not correspond to a known icon", conditionMessage(m))) { + unknown_icon <<- TRUE + invokeRestart("muffleMessage") + } + } + ), error = function(e) { cli::cli_warn(c( - "Invalid icon name: {.val {icon_spec}}", + "Error creating icon {.val {icon_name}} from {.pkg {pkg}}", "x" = conditionMessage(e) )) NULL } ) + + if (unknown_icon) { + pkg_fn <- paste0(pkg, "::", icon_fn) + cli::cli_warn( + "Icon {.val {icon_name}} is not supported by {.fn {pkg_fn}}." + ) + return(NULL) + } + + result } #' Get custom agent tools with lazy discovery and caching diff --git a/tests/testthat/test-tool-agent-custom.R b/tests/testthat/test-tool-agent-custom.R index 875ad12c..4d5f7f41 100644 --- a/tests/testthat/test-tool-agent-custom.R +++ b/tests/testthat/test-tool-agent-custom.R @@ -436,13 +436,14 @@ describe("custom_icon()", { expect_true(grepl("fa-ho", as.character(result))) }) - it("returns shiny.tag even for unknown icon names", { - # shiny::icon() doesn't error for unknown names, it just prints a message + it("warns and returns NULL for unknown icon names", { skip_if_not_installed("shiny") - result <- custom_icon("some-unknown-icon-name") - # shiny::icon() returns a tag anyway - expect_s3_class(result, "shiny.tag") + expect_warning( + result <- custom_icon("some-unknown-icon-name"), + "is not supported" + ) + expect_null(result) }) it("warns for unknown package prefix", { @@ -624,8 +625,7 @@ describe("custom_icon() integration with btw_agent_tool()", { expect_false(is.null(tool@annotations$icon)) }) - it("accepts unknown shiny icon names without warning", { - # shiny::icon() doesn't warn for unknown icon names, so neither do we + it("falls back to default icon for unknown shiny icon names", { skip_if_not_installed("shiny") tmp_dir <- withr::local_tempdir() @@ -642,11 +642,13 @@ describe("custom_icon() integration with btw_agent_tool()", { agent_file ) - # No warning expected since shiny::icon() accepts any name - tool <- btw_agent_tool(agent_file) + expect_warning( + tool <- btw_agent_tool(agent_file), + "is not supported" + ) expect_false(is.null(tool)) - # Will have the shiny icon (even though it's not a real FA icon) - expect_s3_class(tool@annotations$icon, "shiny.tag") + # Should fall back to default agent icon + expect_false(is.null(tool@annotations$icon)) }) }) From df5e27650f3f5f509a7ed7d2d30dcfe7a986968b Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 14:38:33 -0500 Subject: [PATCH 33/44] chore: document() --- man/btw_agent_tool.Rd | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/man/btw_agent_tool.Rd b/man/btw_agent_tool.Rd index 3d69cc4a..49a593e5 100644 --- a/man/btw_agent_tool.Rd +++ b/man/btw_agent_tool.Rd @@ -25,7 +25,8 @@ body becoming the agent's system prompt. The file should be named \subsection{Required Fields}{ \itemize{ \item \code{name}: A valid R identifier (letters, numbers, underscores) that becomes -part of the tool name. Cannot be \code{"subagent"} (reserved). +part of the tool name: \verb{btw_tool_agent_\{name\}}. The final name cannot +conflict with any existing \code{\link[=btw_tools]{btw_tools()}} names. } } @@ -34,8 +35,8 @@ part of the tool name. Cannot be \code{"subagent"} (reserved). \item \code{description}: Tool description shown to the LLM. Defaults to a generic delegation message. \item \code{title}: User-facing title for the tool. Defaults to title-cased name. -\item \code{icon}: Font Awesome icon name (e.g., \code{"robot"}, \code{"code"}). Defaults to -the standard agent icon. +\item \code{icon}: Icon specification for the agent (see \strong{Icon Specification} +below). Defaults to the standard agent icon. \item \code{client}: Model specification like \code{"anthropic/claude-sonnet-4-20250514"}. Falls back to \code{btw.subagent.client} or \code{btw.client} options. \item \code{tools}: List of tool names or groups available to this agent. Defaults to @@ -43,13 +44,39 @@ all non-agent tools. } } +\subsection{Icon Specification}{ + +The \code{icon} field supports three formats: +\enumerate{ +\item \strong{Plain icon name}: Uses \code{shiny::icon()} (Font Awesome icons). Example: +\code{icon: robot} or \code{icon: code} +\item \strong{Raw SVG}: Starts with \verb{...'} +\item \strong{Package-prefixed icon}: Uses \code{pkg::icon-name} format to specify icons +from other icon packages. Supported packages:\tabular{lll}{ + Package \tab Syntax \tab Function Called \cr + fontawesome \tab \code{fontawesome::home} \tab \code{\link[fontawesome:fa]{fontawesome::fa()}} \cr + bsicons \tab \code{bsicons::house} \tab \code{\link[bsicons:bs_icon]{bsicons::bs_icon()}} \cr + phosphoricons \tab \code{phosphoricons::house} \tab \code{\link[phosphoricons:ph]{phosphoricons::ph()}} \cr + rheroicons \tab \code{rheroicons::home} \tab \code{\link[rheroicons:rheroicon]{rheroicons::rheroicon()}} \cr + tabler \tab \code{tabler::home} \tab \code{\link[tabler:tabler-components]{tabler::icon()}} \cr + shiny \tab \code{shiny::home} \tab \code{\link[shiny:icon]{shiny::icon()}} \cr +} + + +The specified package must be installed. If the package is missing or the +icon name is invalid, a warning is issued and the default agent icon is +used. +} +} + \subsection{Example Agent File}{ \if{html}{\out{
}}\preformatted{--- name: code_reviewer description: Reviews code for best practices and potential issues. title: Code Reviewer -icon: magnifying-glass-chart +icon: magnifying-glass tools: - files - docs From 90edc70256dcad0d47d631956b4d7d5460c9a417 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 15:14:56 -0500 Subject: [PATCH 34/44] feat: Support Claude Code subagents --- R/tool-agent-custom.R | 203 +++++++++++++++++++++++++++++++++++------- R/utils.R | 53 +++++++++++ man/btw_agent_tool.Rd | 91 +++++++++++++++---- 3 files changed, 298 insertions(+), 49 deletions(-) diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R index 2e424808..bd2a487c 100644 --- a/R/tool-agent-custom.R +++ b/R/tool-agent-custom.R @@ -82,15 +82,38 @@ NULL #' #' ## Automatic Discovery #' -#' Agent files are automatically discovered by [btw_tools()] when placed in: -#' -#' * **Project level**: `.btw/agent-*.md` in your project directory -#' * **User level**: `~/.btw/agent-*.md` or `~/.config/btw/agent-*.md` -#' -#' Project-level agents take precedence over user-level agents with the same -#' name. -#' -#' @param path Path to an agent markdown file (`agent-*.md`). +#' Agent files are automatically discovered by [btw_tools()] when placed in +#' the following locations (in order of priority): +#' +#' * **Project level (btw)**: `.btw/agent-*.md` in your project directory +#' * **User level (btw)**: `~/.btw/agent-*.md` or `~/.config/btw/agent-*.md` +#' * **Project level (Claude Code)**: `.claude/agents/*.md` in your project directory +#' * **User level (Claude Code)**: `~/.claude/agents/*.md` +#' +#' btw-style agents take precedence over Claude Code agents with the same name. +#' When duplicate agent names are found, a warning is issued. +#' +#' ## Claude Code Compatibility +#' +#' btw supports loading agent files from Claude Code's `.claude/agents/` +#' directory for compatibility. However, some Claude Code fields are not +#' supported: +#' +#' * **Name normalization**: Agent names with hyphens (e.g., `code-reviewer`) +#' are automatically converted to underscores (`code_reviewer`) for R +#' compatibility. +#' * **Ignored fields**: The following Claude Code fields are ignored (with +#' a warning): `model`, `tools`, `permissionMode`, `skills`. Use btw's +#' `client` field instead of `model`, and btw agents use default tools. +#' * **`client` argument**: Use the `client` argument to manually override +#' the model for any agent file. +#' +#' @param path Path to an agent markdown file. +#' @param client Optional. A client specification to override the agent's +#' configured client. Can be a string like +#' `"anthropic/claude-sonnet-4-20250514"`, an [ellmer::Chat] object, or a list +#' with `provider` and `model` keys. If `NULL` (default), uses the `client` +#' field from the agent file or falls back to btw's default client resolution. #' #' @return An `ellmer::ToolDef` object that can be registered with a chat #' client, or `NULL` if the file is invalid (with a warning). @@ -99,20 +122,51 @@ NULL #' creating chat clients with tools. #' #' @examples -#' \dontrun{ -#' # Create a tool from a specific agent file -#' tool <- btw_agent_tool("path/to/agent-reviewer.md") -#' -#' # Register with a chat client -#' chat <- ellmer::chat_anthropic() -#' chat$register_tool(tool) -#' -#' # Or include with other btw tools -#' chat$register_tools(c(btw_tools("docs"), tool)) -#' } +#' # Create a btw-style agent file +#' withr::with_tempdir({ +#' dir.create(".btw") +#' writeLines( +#' c( +#' "---", +#' "name: code_reviewer", +#' "description: Reviews code for best practices.", +#' "---", +#' "", +#' "You are a code reviewer. Analyze code for best practices." +#' ), +#' ".btw/agent-code_reviewer.md" +#' ) +#' +#' tool <- btw_agent_tool(".btw/agent-code_reviewer.md") +#' # Use `chat$register_tool(tool)` to register with an ellmer chat client +#' +#' tool +#' }) +#' +#' # Create a Claude Code-style agent file (name with hyphens) +#' withr::with_tempdir({ +#' dir.create(".claude/agents", recursive = TRUE) +#' writeLines( +#' c( +#' "---", +#' "name: test-helper", +#' "description: Helps write tests.", +#' "model: sonnet", +#' "---", +#' "", +#' "You help write tests for R code." +#' ), +#' ".claude/agents/test-helper.md" +#' ) +#' +#' tool <- btw_agent_tool(".claude/agents/test-helper.md") +#' # Use `chat$register_tool(tool)` to register with an ellmer chat client +#' +#' tool +#' }) #' #' @export -btw_agent_tool <- function(path) { +btw_agent_tool <- function(path, client = NULL) { check_string(path) if (!fs::file_exists(path)) { @@ -125,12 +179,16 @@ btw_agent_tool <- function(path) { return(NULL) } - name <- config$name + # Normalize agent name: convert hyphens to underscores for R identifier + name <- normalize_agent_name(config$name) if (!validate_agent_name(name, path)) { return(NULL) } + # Warn about unsupported Claude Code fields + warn_claude_code_unsupported_fields(config, path) + # Build tool name: btw_tool_agent_{name} tool_name <- paste0("btw_tool_agent_", name) @@ -142,10 +200,12 @@ btw_agent_tool <- function(path) { title <- config$title %||% to_title_case(gsub("_", " ", name)) # Build the agent configuration for btw_tool_agent_custom_impl + # Note: client argument takes precedence over config$client + # Note: tools from Claude Code format are ignored (incompatible tool names) agent_config <- list( name = name, - client = config$client, - tools = config$tools, + client = client %||% config$client, + tools = if (is_claude_code_agent_file(path)) NULL else config$tools, system_prompt = config$system_prompt, tools_default = getOption("btw.subagent.tools_default") %||% getOption("btw.tools"), @@ -313,17 +373,25 @@ btw_tool_agent_custom_from_config <- function(agent_config) { #' Discover agent-*.md files from project and user directories #' -#' Scans for custom agent definition files in: -#' - `.btw/agent-*.md` (project level) -#' - `~/.btw/agent-*.md` (user level) -#' - `~/.config/btw/agent-*.md` (user level) +#' Scans for custom agent definition files in the following order (earlier = higher priority): +#' - `.btw/agent-*.md` (project level btw) +#' - `~/.btw/agent-*.md` (user level btw) +#' - `~/.config/btw/agent-*.md` (user level btw) +#' - `.claude/agents/*.md` (project level Claude Code) +#' - `~/.claude/agents/*.md` (user level Claude Code) #' -#' @return Character vector of absolute paths to agent-*.md files +#' @return Character vector of absolute paths to agent .md files #' @noRd discover_agent_md_files <- function() { - project_files <- find_project_agent_files() - user_files <- find_user_agent_files() - unique(c(project_files, user_files)) + # btw locations (highest priority) + project_btw <- find_project_agent_files() + user_btw <- find_user_agent_files() + + # Claude Code locations (lower priority) + project_cc <- find_project_claude_code_agent_files() + user_cc <- find_user_claude_code_agent_files() + + unique(c(project_btw, user_btw, project_cc, user_cc)) } #' Read and parse an agent-*.md file @@ -393,6 +461,62 @@ validate_agent_name <- function(name, path) { TRUE } +#' Normalize agent name for R compatibility +#' +#' Converts Claude Code style names (with hyphens) to valid R identifiers +#' (with underscores). +#' +#' @param name The agent name from YAML frontmatter +#' @return Normalized name with hyphens converted to underscores +#' @noRd +normalize_agent_name <- function(name) { + if (is.null(name)) { + return(NULL) + } + gsub("-", "_", name, fixed = TRUE) +} + +#' Check if file is from Claude Code agent directory +#' +#' Determines if the agent file is from a Claude Code `.claude/agents/` directory +#' rather than btw's `.btw/` directory. +#' +#' @param path Path to the agent file +#' @return TRUE if file is from Claude Code directory, FALSE otherwise +#' @noRd +is_claude_code_agent_file <- function(path) { + grepl("[\\/]\\.claude[\\/]agents[\\/]", path) +} + +#' Warn about unsupported fields in Claude Code agent files +#' +#' Issues a warning if a Claude Code agent file contains fields that +#' btw does not support: model, tools, permissionMode, skills. +#' Only warns for files from `.claude/agents/` directories. +#' +#' @param config Agent configuration list from YAML frontmatter +#' @param path Path to the agent file (for error messages) +#' @return NULL (called for side effect) +#' @noRd +warn_claude_code_unsupported_fields <- function(config, path) { + # Only warn for Claude Code agent files + if (!is_claude_code_agent_file(path)) { + return(invisible(NULL)) + } + + unsupported_fields <- c("model", "tools", "permissionMode", "skills") + present <- intersect(names(config), unsupported_fields) + + if (length(present) > 0) { + cli::cli_warn(c( + "Unsupported Claude Code fields in {.path {path}}", + "i" = "btw ignores: {.field {present}}" + )) + } + + invisible(NULL) +} + #' Resolve custom icon from string specification #' #' Parses an icon specification and returns the appropriate icon object. @@ -529,6 +653,8 @@ custom_agent_discover_tools <- function() { } tools <- list() + # Track which file each tool came from for conflict warnings + tool_sources <- list() for (file in files) { tryCatch( @@ -537,6 +663,19 @@ custom_agent_discover_tools <- function() { if (!is.null(tool)) { tool_name <- tool@name + + # Check for name conflict (duplicate agent after normalization) + if (tool_name %in% names(tools)) { + cli::cli_warn(c( + "Skipping duplicate agent {.val {tool_name}} from {.path {file}}", + "i" = "An agent with this name was already loaded from {.path {tool_sources[[tool_name]]}}." + )) + next + } + + # Track source file for conflict warnings + tool_sources[[tool_name]] <- file + # Use local() to properly capture tool in closure tools[[tool_name]] <- local({ captured_tool <- tool diff --git a/R/utils.R b/R/utils.R index d9b08bd2..a5efad3a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -227,6 +227,59 @@ find_user_agent_files <- function() { files } +# Claude Code agent file discovery --------------------------------------------- + +#' Find project-level Claude Code agent files +#' +#' Searches for agent definition files in the `.claude/agents/` directory within +#' the project root. Claude Code agent files are any `.md` files in this directory +#' (no `agent-` prefix required). +#' +#' @param dir Starting directory for search (defaults to current working directory) +#' @return Character vector of absolute paths to agent .md files, or empty character +#' @noRd +find_project_claude_code_agent_files <- function(dir = getwd()) { + agents_dir <- path_find_in_project(".claude/agents", dir) + + if (is.null(agents_dir) || !fs::dir_exists(agents_dir)) { + # Also try .claude then agents subdirectory + claude_dir <- path_find_in_project(".claude", dir) + if (!is.null(claude_dir)) { + agents_dir <- fs::path(claude_dir, "agents") + } + } + + if (is.null(agents_dir) || !fs::dir_exists(agents_dir)) { + return(character()) + } + + files <- fs::dir_ls(agents_dir, regexp = "\\.md$", type = "file") + as.character(files) +} + +#' Find user-level Claude Code agent files +#' +#' Searches for agent definition files in the user's `~/.claude/agents/` +#' directory. Claude Code agent files are any `.md` files in this directory +#' (no `agent-` prefix required). +#' +#' @return Character vector of absolute paths to agent .md files, or empty character +#' @noRd +find_user_claude_code_agent_files <- function() { + if (identical(Sys.getenv("TESTTHAT"), "true")) { + return(character()) + } + + agents_dir <- fs::path_home(".claude", "agents") + + if (!fs::dir_exists(agents_dir)) { + return(character()) + } + + files <- fs::dir_ls(agents_dir, regexp = "\\.md$", type = "file") + as.character(files) +} + path_btw_cache <- function(...) { cache_base <- normalizePath( tools::R_user_dir("btw", which = "cache"), diff --git a/man/btw_agent_tool.Rd b/man/btw_agent_tool.Rd index 49a593e5..59ad22a0 100644 --- a/man/btw_agent_tool.Rd +++ b/man/btw_agent_tool.Rd @@ -4,10 +4,16 @@ \alias{btw_agent_tool} \title{Create a custom agent tool from a markdown file} \usage{ -btw_agent_tool(path) +btw_agent_tool(path, client = NULL) } \arguments{ -\item{path}{Path to an agent markdown file (\verb{agent-*.md}).} +\item{path}{Path to an agent markdown file.} + +\item{client}{Optional. A client specification to override the agent's +configured client. Can be a string like +\code{"anthropic/claude-sonnet-4-20250514"}, an \link[ellmer:Chat]{ellmer::Chat} object, or a list +with \code{provider} and \code{model} keys. If \code{NULL} (default), uses the \code{client} +field from the agent file or falls back to btw's default client resolution.} } \value{ An \code{ellmer::ToolDef} object that can be registered with a chat @@ -95,28 +101,79 @@ Provide specific, actionable feedback. \subsection{Automatic Discovery}{ -Agent files are automatically discovered by \code{\link[=btw_tools]{btw_tools()}} when placed in: +Agent files are automatically discovered by \code{\link[=btw_tools]{btw_tools()}} when placed in +the following locations (in order of priority): \itemize{ -\item \strong{Project level}: \verb{.btw/agent-*.md} in your project directory -\item \strong{User level}: \verb{~/.btw/agent-*.md} or \verb{~/.config/btw/agent-*.md} +\item \strong{Project level (btw)}: \verb{.btw/agent-*.md} in your project directory +\item \strong{User level (btw)}: \verb{~/.btw/agent-*.md} or \verb{~/.config/btw/agent-*.md} +\item \strong{Project level (Claude Code)}: \verb{.claude/agents/*.md} in your project directory +\item \strong{User level (Claude Code)}: \verb{~/.claude/agents/*.md} } -Project-level agents take precedence over user-level agents with the same -name. -} +btw-style agents take precedence over Claude Code agents with the same name. +When duplicate agent names are found, a warning is issued. } -\examples{ -\dontrun{ -# Create a tool from a specific agent file -tool <- btw_agent_tool("path/to/agent-reviewer.md") -# Register with a chat client -chat <- ellmer::chat_anthropic() -chat$register_tool(tool) +\subsection{Claude Code Compatibility}{ -# Or include with other btw tools -chat$register_tools(c(btw_tools("docs"), tool)) +btw supports loading agent files from Claude Code's \verb{.claude/agents/} +directory for compatibility. However, some Claude Code fields are not +supported: +\itemize{ +\item \strong{Name normalization}: Agent names with hyphens (e.g., \code{code-reviewer}) +are automatically converted to underscores (\code{code_reviewer}) for R +compatibility. +\item \strong{Ignored fields}: The following Claude Code fields are ignored (with +a warning): \code{model}, \code{tools}, \code{permissionMode}, \code{skills}. Use btw's +\code{client} field instead of \code{model}, and btw agents use default tools. +\item \strong{\code{client} argument}: Use the \code{client} argument to manually override +the model for any agent file. } +} +} +\examples{ +# Create a btw-style agent file +withr::with_tempdir({ + dir.create(".btw") + writeLines( + c( + "---", + "name: code_reviewer", + "description: Reviews code for best practices.", + "---", + "", + "You are a code reviewer. Analyze code for best practices." + ), + ".btw/agent-code_reviewer.md" + ) + + tool <- btw_agent_tool(".btw/agent-code_reviewer.md") + # Use `chat$register_tool(tool)` to register with an ellmer chat client + + tool +}) + +# Create a Claude Code-style agent file (name with hyphens) +withr::with_tempdir({ + dir.create(".claude/agents", recursive = TRUE) + writeLines( + c( + "---", + "name: test-helper", + "description: Helps write tests.", + "model: sonnet", + "---", + "", + "You help write tests for R code." + ), + ".claude/agents/test-helper.md" + ) + + tool <- btw_agent_tool(".claude/agents/test-helper.md") + # Use `chat$register_tool(tool)` to register with an ellmer chat client + + tool +}) } \seealso{ From 596fa838750eb265bb9007bce678eca17c3d6435 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 15:18:20 -0500 Subject: [PATCH 35/44] docs: gut/refactor subagent example to avoid CRAN outrage --- R/tool-agent-subagent.R | 65 +++++++++++----------------------- man/btw_tool_agent_subagent.Rd | 65 +++++++++++----------------------- 2 files changed, 40 insertions(+), 90 deletions(-) diff --git a/R/tool-agent-subagent.R b/R/tool-agent-subagent.R index 9b1dd516..230e5e85 100644 --- a/R/tool-agent-subagent.R +++ b/R/tool-agent-subagent.R @@ -76,55 +76,30 @@ BtwSubagentResult <- S7::new_class( #' filter on top of the resolved tools, regardless of their source. #' #' @examples -#' \dontrun{ -#' # Typically used by LLMs via tool use, but can be called directly for testing -#' result <- btw_tool_agent_subagent( -#' prompt = "List all R files in the current directory", -#' tools = c("btw_tool_files_list_files") -#' ) -#' -#' # Access the subagent's response and session ID -#' cat(result@value) -#' session_id <- result@session_id -#' -#' # Resume the same session with a follow-up -#' result2 <- btw_tool_agent_subagent( -#' prompt = "Now read the first file you found", -#' tools = c("btw_tool_files_read_text_file"), -#' session_id = session_id -#' ) -#' -#' # Configure default tools for subagents -#' withr::local_options(list( -#' btw.subagent.client = "anthropic/claude-sonnet-4-20250514", -#' btw.subagent.tools_default = "files" # Default to file tools only -#' )) -#' -#' result3 <- btw_tool_agent_subagent( -#' prompt = "Find all TODO comments in R files" -#' ) -#' -#' # Restrict subagents to a whitelist of allowed tools -#' withr::local_options(list( -#' btw.subagent.tools_allowed = c("files", "search"), -#' btw.subagent.tools_default = "files" -#' )) -#' -#' # This works - files tools are allowed -#' result4 <- btw_tool_agent_subagent( -#' prompt = "List R files", -#' tools = "files" +#' # This tool is typically called by LLMs via tool use, not directly. +#' # The examples below show how to configure subagent behavior. +#' +#' # Configure the client and default tools for subagents +#' withr::with_options( +#' list( +#' btw.subagent.client = "anthropic/claude-sonnet-4-20250514", +#' btw.subagent.tools_default = "files" +#' ), +#' { +#' getOption("btw.subagent.client") +#' } #' ) #' -#' # This would error - github tools are not in the allowed list -#' tryCatch( -#' btw_tool_agent_subagent( -#' prompt = "Create a GitHub issue", -#' tools = "github" +#' # Restrict subagents to only certain tools +#' withr::with_options( +#' list( +#' btw.subagent.tools_allowed = c("files", "docs"), +#' btw.subagent.tools_default = "files" #' ), -#' error = function(e) message("Error: ", e$message) +#' { +#' getOption("btw.subagent.tools_allowed") +#' } #' ) -#' } #' #' @param prompt Character string with the task description for the subagent. #' The subagent will work on this task using only the tools specified in diff --git a/man/btw_tool_agent_subagent.Rd b/man/btw_tool_agent_subagent.Rd index 9a82d16b..93d9fe5f 100644 --- a/man/btw_tool_agent_subagent.Rd +++ b/man/btw_tool_agent_subagent.Rd @@ -105,55 +105,30 @@ filter on top of the resolved tools, regardless of their source. } } \examples{ -\dontrun{ -# Typically used by LLMs via tool use, but can be called directly for testing -result <- btw_tool_agent_subagent( - prompt = "List all R files in the current directory", - tools = c("btw_tool_files_list_files") -) - -# Access the subagent's response and session ID -cat(result@value) -session_id <- result@session_id - -# Resume the same session with a follow-up -result2 <- btw_tool_agent_subagent( - prompt = "Now read the first file you found", - tools = c("btw_tool_files_read_text_file"), - session_id = session_id -) - -# Configure default tools for subagents -withr::local_options(list( - btw.subagent.client = "anthropic/claude-sonnet-4-20250514", - btw.subagent.tools_default = "files" # Default to file tools only -)) - -result3 <- btw_tool_agent_subagent( - prompt = "Find all TODO comments in R files" -) - -# Restrict subagents to a whitelist of allowed tools -withr::local_options(list( - btw.subagent.tools_allowed = c("files", "search"), - btw.subagent.tools_default = "files" -)) - -# This works - files tools are allowed -result4 <- btw_tool_agent_subagent( - prompt = "List R files", - tools = "files" +# This tool is typically called by LLMs via tool use, not directly. +# The examples below show how to configure subagent behavior. + +# Configure the client and default tools for subagents +withr::with_options( + list( + btw.subagent.client = "anthropic/claude-sonnet-4-20250514", + btw.subagent.tools_default = "files" + ), + { + getOption("btw.subagent.client") + } ) -# This would error - github tools are not in the allowed list -tryCatch( - btw_tool_agent_subagent( - prompt = "Create a GitHub issue", - tools = "github" +# Restrict subagents to only certain tools +withr::with_options( + list( + btw.subagent.tools_allowed = c("files", "docs"), + btw.subagent.tools_default = "files" ), - error = function(e) message("Error: ", e$message) + { + getOption("btw.subagent.tools_allowed") + } ) -} } \seealso{ From 9e7f546f62fc60575461f23d4ac6dafb4ff809e1 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 15:29:14 -0500 Subject: [PATCH 36/44] tests: Use "env" instead of "github" --- tests/testthat/test-tool-agent-subagent.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-tool-agent-subagent.R b/tests/testthat/test-tool-agent-subagent.R index 7ced1afc..5615563b 100644 --- a/tests/testthat/test-tool-agent-subagent.R +++ b/tests/testthat/test-tool-agent-subagent.R @@ -245,8 +245,8 @@ test_that("subagent_client() error message is helpful", { ) expect_error( - subagent_client(tools = c("github")), - "btw_tool_github" + subagent_client(tools = c("env")), + "btw_tool_env_describe_data_frame" ) expect_error( From 6406c09c8cb1a1955767dd66f783494347bb5fd3 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 15:32:45 -0500 Subject: [PATCH 37/44] chore: Fix param docs issues --- R/tool-agent-subagent.R | 2 +- R/tool-github.R | 2 +- R/tool-run.R | 4 ++-- man/btw_tool_run_r.Rd | 6 ++++-- 4 files changed, 8 insertions(+), 6 deletions(-) diff --git a/R/tool-agent-subagent.R b/R/tool-agent-subagent.R index 230e5e85..11fe663f 100644 --- a/R/tool-agent-subagent.R +++ b/R/tool-agent-subagent.R @@ -128,7 +128,7 @@ btw_tool_agent_subagent <- function( prompt, tools = NULL, session_id = NULL, - `_intent` + `_intent` = "" ) {} diff --git a/R/tool-github.R b/R/tool-github.R index 8f41a192..91c12853 100644 --- a/R/tool-github.R +++ b/R/tool-github.R @@ -228,7 +228,7 @@ get_github_repo <- function(owner = NULL, repo = NULL) { #' #' @family github tools #' @export -btw_tool_github <- function(code, fields, `_intent`) {} +btw_tool_github <- function(code, fields = "default", `_intent` = "") {} btw_tool_github_impl <- function(code, fields = "default") { check_installed("gh") diff --git a/R/tool-run.R b/R/tool-run.R index b02fe53c..5db846dc 100644 --- a/R/tool-run.R +++ b/R/tool-run.R @@ -92,7 +92,7 @@ #' ``` #' #' @param code A character string containing R code to run. -#' @param _intent Intent description (automatically added by ellmer). +#' @inheritParams btw_tool_docs_package_news #' #' @returns A list of ellmer Content objects: #' - `ContentText`: visible return values and text output @@ -116,7 +116,7 @@ #' @seealso [btw_tools()] #' @family run tools #' @export -btw_tool_run_r <- function(code, `_intent`) {} +btw_tool_run_r <- function(code, `_intent` = "") {} btw_tool_run_r_impl <- function( code, diff --git a/man/btw_tool_run_r.Rd b/man/btw_tool_run_r.Rd index 8aad7d1f..f9353dce 100644 --- a/man/btw_tool_run_r.Rd +++ b/man/btw_tool_run_r.Rd @@ -4,12 +4,14 @@ \alias{btw_tool_run_r} \title{Tool: Run R code} \usage{ -btw_tool_run_r(code, `_intent`) +btw_tool_run_r(code, `_intent` = "") } \arguments{ \item{code}{A character string containing R code to run.} -\item{_intent}{Intent description (automatically added by ellmer).} +\item{_intent}{An optional string describing the intent of the tool use. +When the tool is used by an LLM, the model will use this argument to +explain why it called the tool.} } \value{ A list of ellmer Content objects: From ee04d57482b0810bc311b4d1f72983a8636bff94 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 5 Jan 2026 15:40:02 -0500 Subject: [PATCH 38/44] fix: make sure tools are always added into package namespace --- R/tool-git.R | 35 ++++++++++++++++++++++++++++------- R/tools.R | 14 ++++++++------ R/zzz.R | 2 +- 3 files changed, 37 insertions(+), 14 deletions(-) diff --git a/R/tool-git.R b/R/tool-git.R index d1a75e14..23f0939e 100644 --- a/R/tool-git.R +++ b/R/tool-git.R @@ -44,7 +44,11 @@ btw_can_register_git_tool <- function() { #' #' @family git tools #' @export -btw_tool_git_status <- function(include, pathspec, `_intent`) {} +btw_tool_git_status <- function( + include = c("both", "staged", "unstaged"), + pathspec = NULL, + `_intent` = "" +) {} btw_tool_git_status_impl <- function( include = c("both", "staged", "unstaged"), @@ -147,7 +151,7 @@ RETURNS: A list of file paths, their status (new, modified, deleted, etc.), and #' #' @family git tools #' @export -btw_tool_git_diff <- function(ref, `_intent`) {} +btw_tool_git_diff <- function(ref = NULL, `_intent` = "") {} btw_tool_git_diff_impl <- function(ref = NULL) { check_installed("gert") @@ -250,7 +254,12 @@ LIMITATION: This tool does not support diffing between two arbitrary commits. #' #' @family git tools #' @export -btw_tool_git_log <- function(ref, max, after, `_intent`) {} +btw_tool_git_log <- function( + ref = "HEAD", + max = 10, + after = NULL, + `_intent` = "" +) {} btw_tool_git_log_impl <- function( ref = "HEAD", @@ -372,7 +381,7 @@ RETURNS: A list of commits with SHA (short), author, timestamp, number of files, #' #' @family git tools #' @export -btw_tool_git_commit <- function(message, files, `_intent`) {} +btw_tool_git_commit <- function(message, files = NULL, `_intent` = "") {} btw_tool_git_commit_impl <- function( message, @@ -480,7 +489,10 @@ RETURNS: The commit SHA and confirmation message. #' #' @family git tools #' @export -btw_tool_git_branch_list <- function(include, `_intent`) {} +btw_tool_git_branch_list <- function( + include = c("local", "remote", "all"), + `_intent` = "" +) {} btw_tool_git_branch_list_impl <- function( include = c("local", "remote", "all") @@ -579,7 +591,12 @@ RETURNS: A table of branch names, upstream tracking, and last update time. #' #' @family git tools #' @export -btw_tool_git_branch_create <- function(branch, ref, checkout, `_intent`) {} +btw_tool_git_branch_create <- function( + branch, + ref = "HEAD", + checkout = TRUE, + `_intent` = "" +) {} btw_tool_git_branch_create_impl <- function( branch, @@ -693,7 +710,11 @@ RETURNS: Confirmation message with branch name and ref. #' #' @family git tools #' @export -btw_tool_git_branch_checkout <- function(branch, force, `_intent`) {} +btw_tool_git_branch_checkout <- function( + branch, + force = FALSE, + `_intent` = "" +) {} btw_tool_git_branch_checkout_impl <- function( branch, diff --git a/R/tools.R b/R/tools.R index 6af80bfc..02df23d6 100644 --- a/R/tools.R +++ b/R/tools.R @@ -108,16 +108,18 @@ is_tool_match <- function(tool, labels = NULL) { # Convert from .btw_tools (or a filtered version of it) # to a format compatible with `client$set_tools()` -as_ellmer_tools <- function(x) { +as_ellmer_tools <- function(x, force = FALSE) { # 1. Filter by can_register BEFORE instantiation # This prevents infinite recursion when a tool's $tool() function # tries to resolve tools that include itself (e.g., subagent) can_register_fns <- map(x, function(.x) .x$can_register) - can_instantiate <- map_lgl(can_register_fns, function(fn) { - is.null(fn) || fn() - }) - x <- x[can_instantiate] - can_register_fns <- can_register_fns[can_instantiate] + if (!force) { + can_instantiate <- map_lgl(can_register_fns, function(fn) { + is.null(fn) || fn() + }) + x <- x[can_instantiate] + can_register_fns <- can_register_fns[can_instantiate] + } # 2. Instantiate tools groups <- map_chr(x, function(.x) .x$group) diff --git a/R/zzz.R b/R/zzz.R index 7bfa5e66..23974bca 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -3,7 +3,7 @@ S7::methods_register() pkg_env <- rlang::fn_env(btw_tools) - for (tool_def in as_ellmer_tools(.btw_tools)) { + for (tool_def in as_ellmer_tools(.btw_tools, force = TRUE)) { assign(tool_def@name, tool_def, envir = pkg_env) } } From bc7662cfe9ec5b3df7ec79d54fe41e2fe5381cce Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Tue, 6 Jan 2026 10:19:58 -0500 Subject: [PATCH 39/44] tests: fixup for no skips --- tests/testthat/helpers-mock-agent.R | 5 ++--- tests/testthat/helpers-state.R | 9 +++++++++ tests/testthat/test-tool-agent-custom.R | 26 ++++++++++++------------- 3 files changed, 24 insertions(+), 16 deletions(-) create mode 100644 tests/testthat/helpers-state.R diff --git a/tests/testthat/helpers-mock-agent.R b/tests/testthat/helpers-mock-agent.R index 9031d08a..c3cae2e6 100644 --- a/tests/testthat/helpers-mock-agent.R +++ b/tests/testthat/helpers-mock-agent.R @@ -11,7 +11,7 @@ #' @return Path to the created agent file #' @noRd local_test_agent_file <- function( - dir, + dir = ".", name = "test_agent", content = NULL, .envir = parent.frame() @@ -31,10 +31,9 @@ This is the system prompt for the test agent.", ) } - path <- file.path(dir, sprintf("agent-%s.md", name)) + path <- fs::path_norm(file.path(dir, sprintf("agent-%s.md", name))) writeLines(content, path) - # Register cleanup in parent frame withr::defer( if (file.exists(path)) unlink(path), envir = .envir diff --git a/tests/testthat/helpers-state.R b/tests/testthat/helpers-state.R new file mode 100644 index 00000000..bad09c0e --- /dev/null +++ b/tests/testthat/helpers-state.R @@ -0,0 +1,9 @@ +stopifnot(is.null(getOption("btw.client"))) +stopifnot(is.null(getOption("btw.subagent.client"))) + +set_state_inspector(function() { + list( + btw_client = getOption("btw.client"), + btw_subagent_client = getOption("btw.subagent.client") + ) +}) diff --git a/tests/testthat/test-tool-agent-custom.R b/tests/testthat/test-tool-agent-custom.R index 4d5f7f41..cda6c99a 100644 --- a/tests/testthat/test-tool-agent-custom.R +++ b/tests/testthat/test-tool-agent-custom.R @@ -262,9 +262,8 @@ test_that("validate_agent_name() rejects edge cases", { # ---- Custom Agent Configuration (Behavioral) -------------------------------- test_that("custom_agent_client_from_config creates chat with custom system prompt", { - tmp_dir <- withr::local_tempdir() - btw_dir <- file.path(tmp_dir, ".btw") - dir.create(btw_dir) + withr::local_dir(withr::local_tempdir()) + dir.create(".btw") # Create agent file writeLines( @@ -281,13 +280,11 @@ test_that("custom_agent_client_from_config creates chat with custom system promp "- Performance issues", "- Security vulnerabilities" ), - file.path(btw_dir, "agent-code-reviewer.md") + ".btw/agent-code-reviewer.md" ) # Load config and create chat - agent_config <- withr::with_dir(tmp_dir, { - read_agent_md_file(file.path(btw_dir, "agent-code-reviewer.md")) - }) + agent_config <- read_agent_md_file(".btw/agent-code-reviewer.md") chat <- custom_agent_client_from_config(agent_config) @@ -305,6 +302,8 @@ test_that("custom_agent_client_from_config creates chat with custom system promp }) test_that("custom_agent_client_from_config respects tool restrictions", { + withr::local_dir(withr::local_tempdir()) # avoid any user/global btw.md files + agent_config <- list( name = "docs_agent", description = "Documentation expert", @@ -323,6 +322,8 @@ test_that("custom_agent_client_from_config respects tool restrictions", { }) test_that("custom_agent_client_from_config concatenates system prompts", { + withr::local_dir(withr::local_tempdir()) # avoid any user/global btw.md files + agent_config <- list( name = "test", client = NULL, @@ -369,16 +370,15 @@ test_that("custom_agent_client_from_config uses subagent_resolve_client", { # ---- Multiple Custom Agents ------------------------------------------------- test_that("multiple custom agents can be discovered and registered", { - tmp_dir <- withr::local_tempdir() - btw_dir <- file.path(tmp_dir, ".btw") - dir.create(btw_dir) + withr::local_dir(withr::local_tempdir()) + dir.create(".btw") # Create two agents - local_test_agent_file(btw_dir, "agent_one") - local_test_agent_file(btw_dir, "agent_two") + local_test_agent_file(".btw", "agent_one") + local_test_agent_file(".btw", "agent_two") # Use custom_agent_discover_tools() to get internal btw tool structure - tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()) + tools <- custom_agent_discover_tools() expect_type(tools, "list") expect_true("btw_tool_agent_agent_one" %in% names(tools)) From 6f37673ef8a74a9c00b1ff9a3176b1329c5b9df5 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Tue, 6 Jan 2026 10:21:28 -0500 Subject: [PATCH 40/44] tests: Another fix for skipped tests Avoid picking up local btw.md configs --- tests/testthat/test-btw_client.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-btw_client.R b/tests/testthat/test-btw_client.R index 0d269ce6..9fdd6678 100644 --- a/tests/testthat/test-btw_client.R +++ b/tests/testthat/test-btw_client.R @@ -761,6 +761,7 @@ describe("remove_hidden_content()", { }) test_that("btw_client() accepts a list of tools in `tools` argument", { + withr::local_dir(withr::local_tempdir()) # avoid any user/global btw.md files withr::local_envvar(list(ANTHROPIC_API_KEY = "beep")) chat <- btw_client(tools = btw_tools("docs")) From 09f99a6727e5cef08ca76baf512d174d4d7b9bfc Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Sat, 10 Jan 2026 08:46:44 -0500 Subject: [PATCH 41/44] chore: clean up roxygen comments in internal fns --- R/tool-agent-custom.R | 66 +++--------------------- R/tool-agent-subagent.R | 108 +++++++--------------------------------- R/utils.R | 36 ++------------ 3 files changed, 27 insertions(+), 183 deletions(-) diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R index bd2a487c..25e37a80 100644 --- a/R/tool-agent-custom.R +++ b/R/tool-agent-custom.R @@ -243,16 +243,6 @@ btw_agent_tool <- function(path, client = NULL) { tool } -#' Execute custom subagent -#' -#' Implementation function that executes a custom agent with its configuration. -#' This reuses the session management and execution logic from btw_tool_agent_subagent_impl. -#' -#' @param prompt Task description for the agent -#' @param session_id Optional session ID to resume a conversation -#' @param agent_config Configuration for this custom agent -#' @return A BtwSubagentResult object -#' @noRd btw_tool_agent_custom_impl <- function( prompt, session_id = NULL, @@ -295,14 +285,7 @@ btw_tool_agent_custom_impl <- function( ) } -#' Configure custom agent client -#' -#' Creates and configures an ellmer Chat client for a custom agent session. -#' Similar to subagent_client but uses agent-specific configuration. -#' -#' @param agent_config List with agent configuration -#' @return A configured Chat object with system prompt and tools attached -#' @noRd +# Create a configured ellmer Chat client for a custom agent session custom_agent_client_from_config <- function(agent_config) { chat <- subagent_resolve_client(agent_config$client) @@ -352,13 +335,6 @@ custom_agent_client_from_config <- function(agent_config) { chat } -#' Create tool function with captured agent configuration -#' -#' Returns a closure that captures the agent_config and calls btw_tool_agent_custom_impl. -#' -#' @param agent_config List with agent configuration -#' @return Function that implements the tool -#' @noRd btw_tool_agent_custom_from_config <- function(agent_config) { force(agent_config) @@ -371,17 +347,9 @@ btw_tool_agent_custom_from_config <- function(agent_config) { } } -#' Discover agent-*.md files from project and user directories -#' -#' Scans for custom agent definition files in the following order (earlier = higher priority): -#' - `.btw/agent-*.md` (project level btw) -#' - `~/.btw/agent-*.md` (user level btw) -#' - `~/.config/btw/agent-*.md` (user level btw) -#' - `.claude/agents/*.md` (project level Claude Code) -#' - `~/.claude/agents/*.md` (user level Claude Code) -#' -#' @return Character vector of absolute paths to agent .md files -#' @noRd +# Discover agent definition files from project and user directories. +# Priority order (highest first): project .btw/, user .btw/, user .config/btw/, +# project .claude/agents/, user .claude/agents/ discover_agent_md_files <- function() { # btw locations (highest priority) project_btw <- find_project_agent_files() @@ -394,14 +362,6 @@ discover_agent_md_files <- function() { unique(c(project_btw, user_btw, project_cc, user_cc)) } -#' Read and parse an agent-*.md file -#' -#' Wrapper around `read_single_btw_file()` that extracts YAML frontmatter -#' and body content from an agent definition file. -#' -#' @param path Path to the agent-*.md file -#' @return List with YAML config and body content (system_prompt) -#' @noRd read_agent_md_file <- function(path) { if (!fs::file_exists(path)) { return(NULL) @@ -418,14 +378,7 @@ read_agent_md_file <- function(path) { config } -#' Validate agent name -#' -#' Ensures the agent name is a valid R identifier and not reserved. -#' -#' @param name The agent name from YAML frontmatter -#' @param path Path to the file (for error messages) -#' @return TRUE if valid, otherwise signals an error -#' @noRd +# Ensures the agent name is a valid R identifier and not reserved. validate_agent_name <- function(name, path) { check_string(name, allow_null = TRUE) @@ -461,14 +414,7 @@ validate_agent_name <- function(name, path) { TRUE } -#' Normalize agent name for R compatibility -#' -#' Converts Claude Code style names (with hyphens) to valid R identifiers -#' (with underscores). -#' -#' @param name The agent name from YAML frontmatter -#' @return Normalized name with hyphens converted to underscores -#' @noRd +# Converts Claude Code style names (with hyphens) to valid R identifiers normalize_agent_name <- function(name) { if (is.null(name)) { return(NULL) diff --git a/R/tool-agent-subagent.R b/R/tool-agent-subagent.R index 11fe663f..1012e1c0 100644 --- a/R/tool-agent-subagent.R +++ b/R/tool-agent-subagent.R @@ -132,12 +132,6 @@ btw_tool_agent_subagent <- function( ) {} -#' Get existing session or create new one -#' -#' @param session_id Optional session ID to retrieve -#' @param create_chat_fn Function that creates a new Chat when called -#' @return List with `chat`, `session_id`, and `is_new` -#' @noRd subagent_get_or_create_session <- function(session_id, create_chat_fn) { check_string(session_id, allow_null = TRUE) @@ -290,19 +284,13 @@ subagent_display_result <- function(result, session_id, agent_name, prompt) { } -#' Resolve agent chat client from options hierarchy -#' -#' Checks for client configuration in the following order: -#' 1. Explicit `client` argument (from agent-*.md file) -#' 2. `btw.subagent.client` R option -#' 3. `btw.md` file's `options.subagent.client` -#' 4. `btw.client` R option -#' 5. `btw.md` file's `client` -#' 6. Default Anthropic client -#' -#' @param client Optional explicit client -#' @return A Chat object -#' @noRd +# Resolve agent chat client from options hierarchy in the following order: +# 1. Explicit `client` argument (from agent-*.md file) +# 2. `btw.subagent.client` R option +# 3. `btw.md` file's `options.subagent.client` +# 4. `btw.client` R option +# 5. `btw.md` file's `client` +# 6. Default Anthropic client subagent_resolve_client <- function(client = NULL) { # Check explicit argument and R options first resolved <- client %||% @@ -376,13 +364,10 @@ btw_tool_agent_subagent_impl <- function( ) } -#' Capture subagent configuration from current R options -#' -#' Reads the relevant btw.subagent.* and btw.* options and returns them as a -#' named list for later use by btw_tool_agent_subagent_impl(). -#' -#' @return A list with captured configuration -#' @noRd +# Capture subagent configuration from current R options +# +# Reads the relevant btw.subagent.* and btw.* options and returns them as a +# named list for later use by btw_tool_agent_subagent_impl(). subagent_config_options <- function() { list( client = getOption("btw.subagent.client") %||% getOption("btw.client"), @@ -512,15 +497,8 @@ subagent_disallow_recursion <- function(tools) { }) } -#' Check if subagent tool is explicitly requested -#' -#' Detects explicit requests for the subagent tool by name (not via group). -#' Used to provide clear error messages when users try to give subagents -#' the ability to spawn other subagents. -#' -#' @param tools Character vector of tool names/groups or list of ToolDef objects -#' @return TRUE if subagent is explicitly requested by name, FALSE otherwise -#' @noRd +# Check if subagent tool is explicitly requested to provide clear error messages +# when users try to give subagents the ability to spawn other subagents. subagent_is_explicitly_requested <- function(tools) { if (is.null(tools)) { return(FALSE) @@ -543,13 +521,7 @@ subagent_is_explicitly_requested <- function(tools) { FALSE } -#' Build dynamic tool description for btw_tool_agent_subagent -#' -#' Generates a description that includes available tool groups dynamically. -#' -#' @return Character string with the tool description -#' -#' @noRd +# Build dynamic tool description that includes available tool groups subagent_build_description <- function(tools = .btw_tools) { desc_tool_use <- if (length(tools) == 0) { "No tools are available for use in the subagent." @@ -675,14 +647,9 @@ btw_can_register_subagent_tool <- function() { .btw_subagent_sessions <- new.env(parent = emptyenv()) -#' Generate a word-based session ID -#' -#' Creates a human-readable session identifier in the format "adjective-noun" -#' (e.g., "stable-genius", "swift-falcon"). Checks for uniqueness against -#' currently active sessions. -#' -#' @return A character string containing the generated session ID -#' @noRd +# Generate unique session ID in "adjective_noun" format (e.g., "stable_genius", +# "swift_falcon"). Falls back to adding numeric suffix if uniqueness fails after +# 100 attempts. subagent_new_session_id <- function() { # Try up to 100 times to generate a unique ID for (i in seq_len(100)) { @@ -705,16 +672,6 @@ subagent_new_session_id <- function() { paste(c(adj, noun, suffix), collapse = "_") } -#' Store a subagent session -#' -#' Stores a chat object and associated metadata in the session environment. -#' -#' @param session_id Character string with the session identifier -#' @param chat An ellmer Chat object -#' @param metadata Optional list of additional metadata to store -#' @return The session_id (invisibly) -#' -#' @noRd subagent_store_session <- function(session_id, chat, metadata = list()) { check_string(session_id) check_inherits(chat, "Chat") @@ -732,41 +689,16 @@ subagent_store_session <- function(session_id, chat, metadata = list()) { invisible(session_id) } -#' Retrieve a subagent session -#' -#' Retrieves a stored session from the session environment. -#' -#' @param session_id Character string with the session identifier -#' @return A list containing the session data, or NULL if not found -#' -#' @noRd subagent_get_session <- function(session_id) { check_string(session_id) env_get(.btw_subagent_sessions, session_id, default = NULL) } -#' List all active subagent sessions -#' -#' Returns a list with information about all currently active subagent -#' sessions. Useful for debugging and monitoring. -#' -#' @return A list of sessions with: id, chat, created -#' -#' @noRd subagent_list_sessions <- function() { env_get_list(.btw_subagent_sessions, env_names(.btw_subagent_sessions)) } -#' Clear a specific subagent session -#' -#' Explicitly removes a session from the session store. This is optional - -#' sessions will be automatically cleaned up when the R session ends. -#' -#' @param session_id Character string with the session identifier -#' @return TRUE if session was found and removed, FALSE otherwise -#' -#' @noRd subagent_clear_session <- function(session_id) { check_string(session_id) @@ -778,12 +710,6 @@ subagent_clear_session <- function(session_id) { TRUE } -#' Clear all subagent sessions -#' -#' Removes all sessions from the session store. This is optional - sessions -#' will be automatically cleaned up when the R session ends. -#' -#' @noRd subagent_clear_all_sessions <- function() { session_ids <- env_names(.btw_subagent_sessions) count <- length(session_ids) diff --git a/R/utils.R b/R/utils.R index a5efad3a..779b5d77 100644 --- a/R/utils.R +++ b/R/utils.R @@ -180,14 +180,7 @@ detect_project_is_r_package <- function(dir = getwd()) { # Agent file discovery --------------------------------------------------------- -#' Find project-level agent-*.md files -#' -#' Searches for agent definition files in the `.btw/` directory within the -#' project root. -#' -#' @param dir Starting directory for search (defaults to current working directory) -#' @return Character vector of absolute paths to agent-*.md files, or empty character -#' @noRd +# Find agent-*.md files in project .btw/ directory find_project_agent_files <- function(dir = getwd()) { btw_dir <- path_find_in_project(".btw", dir) @@ -199,13 +192,7 @@ find_project_agent_files <- function(dir = getwd()) { as.character(files) } -#' Find user-level agent-*.md files -#' -#' Searches for agent definition files in user configuration directories: -#' `~/.btw/` and `~/.config/btw/`. -#' -#' @return Character vector of absolute paths to agent-*.md files, or empty character -#' @noRd +# Find agent-*.md files in user config directories (~/.btw/, ~/.config/btw/) find_user_agent_files <- function() { if (identical(Sys.getenv("TESTTHAT"), "true")) { return(character()) @@ -229,15 +216,7 @@ find_user_agent_files <- function() { # Claude Code agent file discovery --------------------------------------------- -#' Find project-level Claude Code agent files -#' -#' Searches for agent definition files in the `.claude/agents/` directory within -#' the project root. Claude Code agent files are any `.md` files in this directory -#' (no `agent-` prefix required). -#' -#' @param dir Starting directory for search (defaults to current working directory) -#' @return Character vector of absolute paths to agent .md files, or empty character -#' @noRd +# Find agent *.md files in project .claude/agents/ directory find_project_claude_code_agent_files <- function(dir = getwd()) { agents_dir <- path_find_in_project(".claude/agents", dir) @@ -257,14 +236,7 @@ find_project_claude_code_agent_files <- function(dir = getwd()) { as.character(files) } -#' Find user-level Claude Code agent files -#' -#' Searches for agent definition files in the user's `~/.claude/agents/` -#' directory. Claude Code agent files are any `.md` files in this directory -#' (no `agent-` prefix required). -#' -#' @return Character vector of absolute paths to agent .md files, or empty character -#' @noRd +# Find agent *.md files in ~/.claude/agents/ directory find_user_claude_code_agent_files <- function() { if (identical(Sys.getenv("TESTTHAT"), "true")) { return(character()) From c57f76efdb24e13e91234b8722cb2cb050756441 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Sat, 10 Jan 2026 08:48:15 -0500 Subject: [PATCH 42/44] docs: clarify list is about differences --- R/tool-agent-custom.R | 4 ++-- man/btw_agent_tool.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R index 25e37a80..d04da33a 100644 --- a/R/tool-agent-custom.R +++ b/R/tool-agent-custom.R @@ -96,8 +96,8 @@ NULL #' ## Claude Code Compatibility #' #' btw supports loading agent files from Claude Code's `.claude/agents/` -#' directory for compatibility. However, some Claude Code fields are not -#' supported: +#' directory for compatibility. However, there are some small differences +#' when Claude Code agents are used in btw: #' #' * **Name normalization**: Agent names with hyphens (e.g., `code-reviewer`) #' are automatically converted to underscores (`code_reviewer`) for R diff --git a/man/btw_agent_tool.Rd b/man/btw_agent_tool.Rd index 59ad22a0..e2b3c600 100644 --- a/man/btw_agent_tool.Rd +++ b/man/btw_agent_tool.Rd @@ -117,8 +117,8 @@ When duplicate agent names are found, a warning is issued. \subsection{Claude Code Compatibility}{ btw supports loading agent files from Claude Code's \verb{.claude/agents/} -directory for compatibility. However, some Claude Code fields are not -supported: +directory for compatibility. However, there are some small differences +when Claude Code agents are used in btw: \itemize{ \item \strong{Name normalization}: Agent names with hyphens (e.g., \code{code-reviewer}) are automatically converted to underscores (\code{code_reviewer}) for R From 9faaef3995c74ee7609faadd8c1a35fbb10f09da Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Sat, 10 Jan 2026 09:20:14 -0500 Subject: [PATCH 43/44] chore: Add NEWS item --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 7d47c78d..b6792bf0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # btw (development version) +* New `btw_tool_agent_subagent()` tool enables hierarchical agent workflows by allowing an orchestrating LLM to delegate tasks to subagents. Each subagent runs in its own isolated chat session with restricted tool access and maintains conversation state that can be resumed via `session_id`. This allows you to delegate tasks to smaller cheaper models or reduce context bloat in the main conversation (#149). + +* New custom agent tools feature allows users to define specialized LLM assistants via `agent-*.md` files with YAML frontmatter. Agent files are automatically discovered from `.btw/` (project and user directories) and `.claude/agents/` (for Claude Code compatibility), and are registered as callable tools in `btw_tools()`. Custom agents can specify their own system prompts, icons, models, and available tools. The new exported function `btw_agent_tool()` allows programmatic creation of agent tools from markdown files (#149). + * `btw_client()` now supports reading `CLAUDE.md` files as project context files. `CLAUDE.md` files are searched after `AGENTS.md` but before user-level `btw.md`. YAML frontmatter in `CLAUDE.md` files is stripped but not used for configuration (#146). * `btw_app()` now shows a rich diff view in the `btw_tool_files_write_text_file()` tool, if the `{diffviewer}` package is installed (#144). From fa15a58f528804794a86a6127842276a8a7e3be5 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Sat, 10 Jan 2026 09:25:36 -0500 Subject: [PATCH 44/44] chore: edit news item --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index b6792bf0..be702646 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ * New `btw_tool_agent_subagent()` tool enables hierarchical agent workflows by allowing an orchestrating LLM to delegate tasks to subagents. Each subagent runs in its own isolated chat session with restricted tool access and maintains conversation state that can be resumed via `session_id`. This allows you to delegate tasks to smaller cheaper models or reduce context bloat in the main conversation (#149). -* New custom agent tools feature allows users to define specialized LLM assistants via `agent-*.md` files with YAML frontmatter. Agent files are automatically discovered from `.btw/` (project and user directories) and `.claude/agents/` (for Claude Code compatibility), and are registered as callable tools in `btw_tools()`. Custom agents can specify their own system prompts, icons, models, and available tools. The new exported function `btw_agent_tool()` allows programmatic creation of agent tools from markdown files (#149). +* New `btw_agent_tool()` allows you to create specialized custom subagents from `btw.md` style markdown files. Agent files are automatically discovered from `.btw/agent-*.md` (project and user directories) and `.claude/agents/` (for Claude Code compatibility), and are registered as callable tools in `btw_tools()`. Custom agents can specify their own system prompts, icons, models, and available tools (#149). * `btw_client()` now supports reading `CLAUDE.md` files as project context files. `CLAUDE.md` files are searched after `AGENTS.md` but before user-level `btw.md`. YAML frontmatter in `CLAUDE.md` files is stripped but not used for configuration (#146).