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/AGENTS.md b/AGENTS.md index 2229c240..3e2a91fa 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_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 +- **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 diff --git a/DESCRIPTION b/DESCRIPTION index 5e0cc6b1..3a2a935f 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: @@ -96,6 +97,8 @@ Collate: 'task_create_btw_md.R' '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 106063f3..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) @@ -28,6 +29,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) diff --git a/NEWS.md b/NEWS.md index 036b77ac..93efe50c 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 `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 1.1.0 * `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). 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/btw_client.R b/R/btw_client.R index db010991..9b9d99e6 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) - } - - chat_args <- utils::modifyList( - list(echo = "output"), # defaults - config$client - ) - - chat_fn <- gsub(" ", "_", tolower(chat_args$provider)) - if (!grepl("^chat_", chat_fn)) { - chat_fn <- paste0("chat_", chat_fn) - } - chat_args$provider <- NULL + # 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_client <- call2(.ns = "ellmer", chat_fn, !!!chat_args) - config$client <- eval(chat_client) + config$client <- as_ellmer_client(config$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) @@ -214,14 +203,33 @@ as_ellmer_client <- function(client) { 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")) } - 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)) + } + + 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) { @@ -270,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.") @@ -286,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/btw_client_app.R b/R/btw_client_app.R index 09a599c2..595f4898 100644 --- a/R/btw_client_app.R +++ b/R/btw_client_app.R @@ -21,15 +21,37 @@ 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 { 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() + }) } - 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 +68,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 +84,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 +153,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(all_available_tools), + initial_tool_names = names(original_client_tools) ), shiny::uiOutput("ui_other_tools") ), @@ -165,8 +199,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(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 +217,7 @@ btw_app_from_client <- function(client, messages = list(), ...) { }) shiny::observeEvent(input$select_all, { - tools <- btw_tools_df() + tools <- btw_tools_df(all_available_tools) for (group in tool_groups) { shiny::updateCheckboxGroupInput( session = session, @@ -189,7 +228,7 @@ btw_app_from_client <- function(client, messages = list(), ...) { }) shiny::observeEvent(input$deselect_all, { - tools <- btw_tools_df() + tools <- btw_tools_df(all_available_tools) for (group in tool_groups) { shiny::updateCheckboxGroupInput( session = session, @@ -202,7 +241,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(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 +265,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) } }) @@ -415,73 +446,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, ...) { @@ -627,18 +603,15 @@ btw_status_bar_server <- function(id, chat) { # Tools in sidebar ---- -btw_tools_df <- function() { - .btw_tools <- map(.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, @@ -646,7 +619,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) { @@ -675,6 +648,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/sysdata.rda b/R/sysdata.rda new file mode 100644 index 00000000..644c5280 Binary files /dev/null and b/R/sysdata.rda differ diff --git a/R/tool-agent-custom.R b/R/tool-agent-custom.R new file mode 100644 index 00000000..d04da33a --- /dev/null +++ b/R/tool-agent-custom.R @@ -0,0 +1,647 @@ +#' @include tool-agent-subagent.R +NULL + +#' 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: `btw_tool_agent_{name}`. The final name cannot +#' conflict with any existing [btw_tools()] names. +#' +#' ### 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`: Icon specification for the agent (see **Icon Specification** +#' below). 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. +#' +#' ### Icon Specification +#' +#' The `icon` field supports three formats: +#' +#' 1. **Plain icon name**: Uses `shiny::icon()` (Font Awesome icons). Example: +#' `icon: robot` or `icon: code` +#' +#' 2. **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 +#' --- +#' name: code_reviewer +#' description: Reviews code for best practices and potential issues. +#' title: Code Reviewer +#' icon: magnifying-glass +#' 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 +#' 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, 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 +#' 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). +#' +#' @seealso [btw_tools()] for automatic agent discovery, [btw_client()] for +#' creating chat clients with tools. +#' +#' @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 +#' }) +#' +#' @export +btw_agent_tool <- function(path, client = NULL) { + 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) + } + + # 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) + + # 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 + # 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 = 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"), + tools_allowed = getOption("btw.subagent.tools_allowed") + ) + + # Create the tool function with agent_config captured in closure + tool_fn <- btw_tool_agent_custom_from_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 + tool@annotations$icon <- custom_icon(config$icon) %||% + tool_group_icon("agent") + + tool +} + +btw_tool_agent_custom_impl <- function( + prompt, + session_id = NULL, + agent_config +) { + check_string(prompt) + + session <- subagent_get_or_create_session( + session_id, + create_chat_fn = function() { + custom_agent_client_from_config(agent_config) + } + ) + + chat <- session$chat + session_id <- session$session_id + + response <- chat$chat(prompt) + + result <- subagent_process_result(chat, prompt, agent_config$name, session_id) + + display_md <- subagent_display_result( + result = result, + session_id = session_id, + agent_name = agent_config$name, + prompt = prompt + ) + + BtwSubagentResult( + value = result$message_text, + session_id = session_id, + extra = list( + prompt = prompt, + agent = agent_config$name, + provider = result$provider, + model = result$model, + tokens = result$tokens, + display = list(markdown = display_md, show_request = FALSE) + ) + ) +} + +# 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) + + # 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") + + 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_tools <- keep(configured_tools, function(t) { + t@name %in% allowed_names + }) + } + + # Build system 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 +} + +btw_tool_agent_custom_from_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 + ) + } +} + +# 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() + 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_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 +} + +# Ensures the agent name is a valid R identifier and not reserved. +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 +} + +# Converts Claude Code style names (with hyphens) to valid R identifiers +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. +#' +#' @param icon_spec String specifying the icon. Can be: +#' - Raw SVG: starts with ` `btw.subagent.*` +#' option > `btw.*` option > default value. The `tools_allowed` option acts as a +#' filter on top of the resolved tools, regardless of their source. +#' +#' @examples +#' # 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") +#' } +#' ) +#' +#' # Restrict subagents to only certain tools +#' withr::with_options( +#' list( +#' btw.subagent.tools_allowed = c("files", "docs"), +#' btw.subagent.tools_default = "files" +#' ), +#' { +#' 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 +#' `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_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 +#' 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_agent_subagent <- function( + prompt, + tools = NULL, + session_id = NULL, + `_intent` = "" +) {} + + +subagent_get_or_create_session <- function(session_id, create_chat_fn) { + check_string(session_id, allow_null = TRUE) + + if (!is.null(session_id)) { + session <- subagent_get_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." + )) + } + + return(list(chat = session$chat, session_id = session_id, is_new = FALSE)) + } + + session_id <- subagent_new_session_id() + chat <- create_chat_fn() + subagent_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 +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) { + "(The agent completed successfully but returned no message.)" + } else { + ellmer::contents_markdown(last_turn) + } + + # 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) { + 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) + }) + + list( + 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 = ", " + ) + ) +} + + +#' Generate display markdown for agent result +#' +#' @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 +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) + } else { + "" + } + + 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"( + {{ agent_line }}**Session ID:** {{ session_id }}
+ **Provider:** {{ result$provider }}
+ **Model:** `{{ result$model }}`
+ **Tools:** {{ result$tool_names }} + + #### Prompt + + {{ prompt }} + + #### Tokens + + **Tool Calls:** {{ length(unlist(result$tool_calls)) }} + + {{ md_table(result$tokens) }} + + #### Response + +
Full Conversation + + {{ full_results }} + + --- + +
+ + {{ result$message_text }} + )" + ) +} + + +# 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 %||% + getOption("btw.subagent.client") %||% + getOption("btw.client") + + if (!is.null(resolved)) { + 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() +} + + +btw_tool_agent_subagent_impl <- function( + prompt, + tools = NULL, + session_id = NULL, + config = NULL +) { + check_string(prompt) + + session <- subagent_get_or_create_session( + session_id, + create_chat_fn = function() { + subagent_client( + 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 <- subagent_process_result(chat, prompt, "subagent", session_id) + + display_md <- subagent_display_result( + result = result, + session_id = session_id, + agent_name = "subagent", + prompt = prompt + ) + + BtwSubagentResult( + value = result$message_text, + session_id = session_id, + extra = list( + prompt = prompt, + provider = result$provider, + model = result$model, + tokens = result$tokens, + display = list(markdown = display_md, show_request = FALSE) + ) + ) +} + +# 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"), + 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 +#' 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 +#' @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 +subagent_client <- function( + client = NULL, + tools = NULL, + tools_default = NULL, + tools_allowed = NULL +) { + # 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_is_explicitly_requested(tools)) { + cli::cli_abort(c( + "Subagents cannot spawn other subagents.", + "x" = "The {.arg tools} parameter includes {.val btw_tool_agent_subagent}.", + "i" = "Remove the subagent tool from the tools list." + )) + } + + subagent_client_resolved <- + client %||% + getOption("btw.subagent.client") %||% + getOption("btw.client") + + tools_default <- + 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") + # 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 %||% + tools_default %||% + compact(map(.btw_tools, function(t) { + if (t$name != "btw_tool_agent_subagent") t$tool() + })) + + configured_tools <- flatten_and_check_tools(configured_tools) + + # Apply tools_allowed whitelist if set + 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 + }) + } + + # 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 <- subagent_disallow_recursion(configured_tools) + + chat <- if (!is.null(subagent_client_resolved)) { + as_ellmer_client(subagent_client_resolved)$clone() + } else { + btw_default_chat_client() + } + + system_prompt <- btw_prompt("btw-subagent.md") + chat$set_system_prompt(system_prompt) + chat$set_tools(configured_tools) + + chat +} + +subagent_disallow_recursion <- function(tools) { + if (is.null(tools)) { + return(NULL) + } + + if (is.character(tools)) { + return(setdiff(tools, c("btw_tool_agent_subagent", "subagent"))) + } + + keep(tools, function(tool) { + !inherits(tool, "ellmer::ToolDef") || tool@name != "btw_tool_agent_subagent" + }) +} + +# 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) + } + + if (is.character(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_agent_subagent" + ) { + return(TRUE) + } + } + } + + FALSE +} + +# 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." + } else { + 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:)" + } + + 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 +- 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 + +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(desc_base, "\n", desc_tool_use, "\n", tool_summary) +} + +btw_tool_agent_subagent_from_config <- function(config) { + force(config) + + function(prompt, tools = NULL, session_id = NULL) { + btw_tool_agent_subagent_impl( + prompt = prompt, + tools = tools, + session_id = session_id, + config = 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_agent_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 <- subagent_config_options() + tools_allowed <- config$tools_allowed + + if (is.null(tools_allowed)) { + 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) + } + + tools_allowed <- flatten_and_check_tools(tools_allowed) + + ellmer::tool( + btw_tool_agent_subagent_from_config(config), + name = "btw_tool_agent_subagent", + description = subagent_build_description(tools_allowed), + annotations = ellmer::tool_annotations( + title = "Subagent", + read_only_hint = FALSE, + open_world_hint = TRUE + # btw_can_register is propagated from can_register by as_ellmer_tools() + ), + arguments = list( + prompt = ellmer::type_string( + "The complete task description for the subagent. Be specific and clear about requirements and expected output." + ), + tools = ellmer::type_array( + "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: session_id from a previous call to continue that conversation. Omit to start a new session.", + required = FALSE + ) + ) + ) + } +) + +.btw_subagent_sessions <- new.env(parent = emptyenv()) + + +# 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)) { + adj <- sample(.btw_memoids$adjective, 1) + noun <- sample(.btw_memoids$noun, 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." + )) + + suffix <- sample(1000:9999, 1) + paste(c(adj, noun, suffix), collapse = "_") +} + +subagent_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) +} + +subagent_get_session <- function(session_id) { + check_string(session_id) + + env_get(.btw_subagent_sessions, session_id, default = NULL) +} + +subagent_list_sessions <- function() { + env_get_list(.btw_subagent_sessions, env_names(.btw_subagent_sessions)) +} + +subagent_clear_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 +} + +subagent_clear_all_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/tool-git.R b/R/tool-git.R index 6a63cace..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"), @@ -81,6 +85,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 +103,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( @@ -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") @@ -182,6 +186,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 +206,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( @@ -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", @@ -302,6 +311,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 +329,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( @@ -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, @@ -409,6 +418,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 +441,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( @@ -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") @@ -515,6 +527,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 +544,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( @@ -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, @@ -615,6 +632,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 +654,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( @@ -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, @@ -719,6 +740,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 +763,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..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") @@ -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..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, @@ -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/tools.R b/R/tools.R index 35b6372e..02df23d6 100644 --- a/R/tools.R +++ b/R/tools.R @@ -43,13 +43,23 @@ 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 <- 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)) { + 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,16 +82,12 @@ 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() - }) + tools_to_keep <- map_lgl(all_btw_tools, is_tool_match, tools) + res <- all_btw_tools[tools_to_keep] - 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) { @@ -102,10 +108,42 @@ 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) + 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) tools <- compact(map(x, function(.x) .x$tool())) - tools <- map2(tools, groups, set_tool_icon) + + # 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 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) { + if (!is.null(fn)) { + tool@annotations$btw_can_register <- fn + } + tool + }) + + # 5. Wrap with intent map(tools, wrap_with_intent) } @@ -134,6 +172,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"), @@ -149,12 +188,15 @@ 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) + if (is.null(tool@annotations$icon)) { + tool@annotations$icon <- tool_group_icon(group) + } + tool@annotations$btw_group <- group tool } 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 + ) +} diff --git a/R/utils.R b/R/utils.R index 64576a88..779b5d77 100644 --- a/R/utils.R +++ b/R/utils.R @@ -174,9 +174,84 @@ 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 agent-*.md files in project .btw/ directory +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 agent-*.md files in user config directories (~/.btw/, ~/.config/btw/) +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 +} + +# Claude Code agent file discovery --------------------------------------------- + +# 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) + + 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 agent *.md files in ~/.claude/agents/ directory +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/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) } } 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) 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..9aca9e41 --- /dev/null +++ b/inst/prompts/btw-subagent.md @@ -0,0 +1,46 @@ +# Task Execution Guidelines + +You are completing a focused task. Follow these guidelines to deliver effective results. + +## 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. + +- **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. Use Available Tools Effectively + +- 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 + +## 4. 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 + +## 5. 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 +- Maintain consistency with prior responses + diff --git a/man/btw_agent_tool.Rd b/man/btw_agent_tool.Rd new file mode 100644 index 00000000..e2b3c600 --- /dev/null +++ b/man/btw_agent_tool.Rd @@ -0,0 +1,182 @@ +% 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, client = NULL) +} +\arguments{ +\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 +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: \verb{btw_tool_agent_\{name\}}. The final name cannot +conflict with any existing \code{\link[=btw_tools]{btw_tools()}} names. +} +} + +\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}: 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 +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 +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 +the following locations (in order of priority): +\itemize{ +\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} +} + +btw-style agents take precedence over Claude Code agents with the same name. +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, 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 +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{ +\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/man/btw_tool_agent_subagent.Rd b/man/btw_tool_agent_subagent.Rd new file mode 100644 index 00000000..93d9fe5f --- /dev/null +++ b/man/btw_tool_agent_subagent.Rd @@ -0,0 +1,137 @@ +% Generated by roxygen2: do not edit by hand +% 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_agent_subagent( + prompt, + tools = NULL, + session_id = NULL, + `_intent` = "" +) +} +\arguments{ +\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 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 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}{Optional string describing the intent of the tool call. Added +automatically by the ellmer framework when tools are called by LLMs.} +} +\value{ +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{ +\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 +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. +\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{ +# 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") + } +) + +# Restrict subagents to only certain tools +withr::with_options( + list( + btw.subagent.tools_allowed = c("files", "docs"), + btw.subagent.tools_default = "files" + ), + { + getOption("btw.subagent.tools_allowed") + } +) + +} +\seealso{ +\code{\link[=btw_tools]{btw_tools()}} for available tools and tool groups +} +\concept{agent tools} diff --git a/man/btw_tool_run_r.Rd b/man/btw_tool_run_r.Rd index 41f63fcd..f9353dce 100644 --- a/man/btw_tool_run_r.Rd +++ b/man/btw_tool_run_r.Rd @@ -9,7 +9,9 @@ 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: diff --git a/man/btw_tools.Rd b/man/btw_tools.Rd index fc251815..5b982abc 100644 --- a/man/btw_tools.Rd +++ b/man/btw_tools.Rd @@ -30,6 +30,14 @@ 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_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 +} + +} + \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/tests/testthat/helpers-mock-agent.R b/tests/testthat/helpers-mock-agent.R new file mode 100644 index 00000000..c3cae2e6 --- /dev/null +++ b/tests/testthat/helpers-mock-agent.R @@ -0,0 +1,43 @@ +#' 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 <- fs::path_norm(file.path(dir, sprintf("agent-%s.md", name))) + writeLines(content, path) + + withr::defer( + if (file.exists(path)) unlink(path), + envir = .envir + ) + + path +} 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/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/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-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")) diff --git a/tests/testthat/test-tool-agent-custom.R b/tests/testthat/test-tool-agent-custom.R new file mode 100644 index 00000000..cda6c99a --- /dev/null +++ b/tests/testthat/test-tool-agent-custom.R @@ -0,0 +1,654 @@ +# 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) + + local_test_agent_file(btw_dir, "integration_test") + + # Get tools from that directory + tools <- withr::with_dir(tmp_dir, custom_agent_discover_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("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, custom_agent_discover_tools()) + + expect_length(tools, 0) +}) + +test_that("custom_agent_discover_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 + local_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")) + + expect_warning( + tools <- withr::with_dir(tmp_dir, custom_agent_discover_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("custom_agent_discover_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")) + + # Should warn about missing name + expect_warning( + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()), + "Agent file has no name" + ) + + expect_length(tools, 0) +}) + +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) + + # 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")) + + expect_warning( + tools <- withr::with_dir(tmp_dir, custom_agent_discover_tools()), + "Error loading custom agent" + ) +}) + +test_that("custom_agent_discover_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) + + 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, custom_agent_discover_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) + } +}) + +# Internal closure structure is an implementation detail. +# Tool behavior is tested through integration tests below. + +# ---- Custom Agent Configuration (Behavioral) -------------------------------- + +test_that("custom_agent_client_from_config creates chat with custom system prompt", { + withr::local_dir(withr::local_tempdir()) + dir.create(".btw") + + # 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" + ), + ".btw/agent-code-reviewer.md" + ) + + # Load config and create chat + agent_config <- read_agent_md_file(".btw/agent-code-reviewer.md") + + chat <- custom_agent_client_from_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("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", + tools = "docs", + system_prompt = "You help with documentation.", + tools_default = NULL, + tools_allowed = NULL, + client = NULL + ) + + 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("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, + tools = "files", + system_prompt = "Custom instructions for this agent.", + tools_default = NULL, + tools_allowed = NULL + ) + + chat <- custom_agent_client_from_config(agent_config) + system_prompt <- chat$get_system_prompt() + + # 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, "---") +}) + +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( + name = "test", + client = custom_client, + tools = "files", + system_prompt = "Test" + ) + + chat <- custom_agent_client_from_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 <- custom_agent_client_from_config(agent_config) + expect_equal(chat2$get_model(), "claude-sonnet-4-20250514") +}) + +# ---- Multiple Custom Agents ------------------------------------------------- + +test_that("multiple custom agents can be discovered and registered", { + withr::local_dir(withr::local_tempdir()) + dir.create(".btw") + + # Create two agents + 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 <- custom_agent_discover_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") +}) + +# 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("warns and returns NULL for unknown icon names", { + skip_if_not_installed("shiny") + + expect_warning( + result <- custom_icon("some-unknown-icon-name"), + "is not supported" + ) + expect_null(result) + }) + + 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("falls back to default icon for unknown shiny icon names", { + 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 + ) + + expect_warning( + tool <- btw_agent_tool(agent_file), + "is not supported" + ) + + expect_false(is.null(tool)) + # Should fall back to default agent icon + expect_false(is.null(tool@annotations$icon)) + }) +}) diff --git a/tests/testthat/test-tool-agent-subagent.R b/tests/testthat/test-tool-agent-subagent.R new file mode 100644 index 00000000..5615563b --- /dev/null +++ b/tests/testthat/test-tool-agent-subagent.R @@ -0,0 +1,521 @@ +mock_chat <- function() { + structure( + list( + messages = list(), + system_prompt = NULL, + tools = list() + ), + class = "Chat" + ) +} + +# 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("subagent_client() uses default tools", { + withr::local_options( + btw.subagent.tools_default = NULL, + btw.tools = NULL + ) + + chat <- subagent_client() + + expect_true(inherits(chat, "Chat")) + expect_true(length(chat$get_tools()) > 0) +}) + +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("subagent_client() follows client precedence", { + skip_if_not_installed("ellmer") + + withr::local_options( + btw.subagent.client = "anthropic/claude-sonnet-4-20250514", + btw.client = "anthropic/claude-opus-4-20241120" + ) + + chat <- subagent_client() + expect_true(inherits(chat, "Chat")) + + chat_obj <- ellmer::chat_anthropic() + chat2 <- subagent_client(client = chat_obj) + expect_identical(chat2, chat_obj) +}) + +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 <- subagent_client() + chat2 <- subagent_client() + + expect_false(identical(chat1, chat2)) + expect_false(identical(chat1, chat_obj)) +}) + +# 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", { + all_tools <- btw_tools() + + tool_names <- sapply(all_tools, function(t) t@name) + expect_true("btw_tool_agent_subagent" %in% tool_names) + + subagent_tool <- all_tools[[which(tool_names == "btw_tool_agent_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) +}) + +test_that("BtwSubagentResult inherits from BtwToolResult", { + result <- BtwSubagentResult( + value = "test response", + session_id = "test_id", + extra = list() + ) + + 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") +}) + +# Tests for new btw.subagent.tools_default and btw.subagent.tools_allowed options + +test_that("subagent_client() uses tools_default when tools is NULL", { + withr::local_options( + btw.subagent.tools_default = c("docs"), + btw.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("subagent_client() 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 <- subagent_client(tools = NULL) + + 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() + withr::local_options( + btw.subagent.tools_default = NULL, + btw.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("subagent_client() filters tools with tools_allowed", { + withr::local_options( + btw.subagent.tools_allowed = c("docs"), + btw.subagent.tools_default = c("docs", "files") + ) + + 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("subagent_client() errors on disallowed tools", { + withr::local_options( + btw.subagent.tools_allowed = c("docs") + ) + + expect_error( + subagent_client(tools = c("files")), + "Subagent requested disallowed tools" + ) + + expect_error( + subagent_client(tools = c("files")), + "btw.subagent.tools_allowed" + ) +}) + +test_that("subagent_client() allows tools within whitelist", { + withr::local_options( + btw.subagent.tools_allowed = c("docs", "files") + ) + + # Should not error + 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("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( + subagent_client(tools = c("docs", "files")), + "disallowed tools" + ) + + # Requesting only allowed tools should work + 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("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 <- 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("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 <- 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("subagent_client() tools_allowed filters defaults", { + withr::local_options( + btw.subagent.tools_allowed = c("docs"), + btw.subagent.tools_default = c("docs", "files", "search") + ) + + 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))) + expect_false(any(grepl("^btw_tool_search_", tool_names))) +}) + +test_that("subagent_client() error message is helpful", { + withr::local_options( + btw.subagent.tools_allowed = c("docs") + ) + + expect_error( + subagent_client(tools = c("files")), + "btw_tool_files_" + ) + + expect_error( + subagent_client(tools = c("env")), + "btw_tool_env_describe_data_frame" + ) + + expect_error( + subagent_client(tools = c("files")), + "Set.*btw.subagent.tools_allowed = NULL" + ) +}) + +test_that("subagent_client() 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 <- 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) + expect_equal(length(tool_names), 1) + + # Should error with disallowed specific tool + expect_error( + subagent_client(tools = c("search_packages")), + "disallowed tools" + ) +}) + +# Tests for subagent tool filtering (prevents recursive subagents) + +test_that("btw_tool_agent_subagent errors when explicitly requested", { + # Explicitly requesting the subagent tool now throws an error + expect_error( + subagent_client(tools = c("btw_tool_agent_subagent", "docs")), + "Subagents cannot spawn other subagents" + ) + + # Same for short name + expect_error( + subagent_client(tools = c("subagent", "docs")), + "Subagents cannot spawn other subagents" + ) +}) + +test_that("btw_tool_agent_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 <- subagent_client(tools = NULL) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # 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_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 <- subagent_client(tools = c("agent")) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # btw_tool_agent_subagent should be filtered out + expect_false("btw_tool_agent_subagent" %in% tool_names) +}) + +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") + ) + + # Request agent group (which includes subagent tool) + # The subagent tool is silently filtered via can_register + chat <- subagent_client(tools = c("agent", "docs")) + + tool_names <- map_chr(chat$get_tools(), function(t) t@name) + + # 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_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( + subagent_client(tools = c("btw_tool_agent_subagent")), + "Subagents cannot spawn other subagents" + ) + + # Scenario 2: Via tool group → silently filtered + chat2 <- subagent_client(tools = c("agent")) + expect_false( + "btw_tool_agent_subagent" %in% sapply(chat2$get_tools(), function(t) t@name) + ) + + # Scenario 3: Default tools → silently filtered + withr::local_options( + btw.subagent.tools_default = NULL, + btw.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( + subagent_client( + 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_agent_subagent", "docs") + ) + + # Even if subagent tool is in allowed list, explicit request throws error + expect_error( + subagent_client(tools = c("btw_tool_agent_subagent", "docs")), + "Subagents cannot spawn other subagents" + ) + + # But requesting via group doesn't error - silently filters + chat <- subagent_client(tools = c("agent", "docs")) + 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) + + # Docs tools should remain + expect_true(any(grepl("^btw_tool_docs_", tool_names))) +}) + +# ---- Chat Client Configuration ---------------------------------------------- + +test_that("subagent_client creates chat with filtered tools", { + chat <- subagent_client(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("subagent_client respects explicit client parameter", { + custom_client <- ellmer::chat_anthropic(model = "claude-opus-4-20241120") + + chat <- subagent_client(client = custom_client) + + expect_identical(chat, custom_client) +}) + +test_that("subagent_client includes base subagent prompt", { + chat <- subagent_client() + + 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("subagent_get_or_create_session creates new session when ID is NULL", { + subagent_clear_all_sessions() + + result <- subagent_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")) + + subagent_clear_all_sessions() +}) + +test_that("subagent_get_or_create_session retrieves existing session", { + subagent_clear_all_sessions() + + # Create a session first + session_id <- subagent_new_session_id() + chat <- mock_chat() + subagent_store_session(session_id, chat) + + # Retrieve it + result <- subagent_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) + + subagent_clear_all_sessions() +}) + +test_that("subagent_get_or_create_session errors helpfully for invalid session", { + subagent_clear_all_sessions() + + expect_error( + subagent_get_or_create_session( + session_id = "nonexistent_badger_wombat", + create_chat_fn = function() mock_chat() + ), + regexp = "Session not found.*nonexistent_badger_wombat" + ) + + expect_error( + subagent_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 <- 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("subagent recursion is prevented in default tools", { + withr::local_options( + btw.subagent.tools_default = NULL, + btw.tools = NULL, + btw.subagent.tools_allowed = NULL + ) + + chat <- subagent_client(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) +})