diff --git a/pkg-r/DESCRIPTION b/pkg-r/DESCRIPTION index 3d39b3e6..e71eb5f2 100644 --- a/pkg-r/DESCRIPTION +++ b/pkg-r/DESCRIPTION @@ -25,7 +25,8 @@ Imports: purrr, rlang, shiny, - shinychat (>= 0.2.0), + shinychat (>= 0.2.0.9000), + utils, whisker, xtable Suggests: @@ -35,6 +36,8 @@ Suggests: shinytest2, testthat (>= 3.0.0), withr +Remotes: + posit-dev/shinychat/pkg-r Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) diff --git a/pkg-r/NEWS.md b/pkg-r/NEWS.md index ccf7dbda..ee4670d6 100644 --- a/pkg-r/NEWS.md +++ b/pkg-r/NEWS.md @@ -19,3 +19,5 @@ * or the default model from `ellmer::chat_openai()`. * `querychat_server()` now uses a `shiny::ExtendedTask` for streaming the chat response, which allows the dashboard to update and remain responsive while the chat response is streaming in. (#63) + +* querychat now requires `ellmer` version 0.3.0 or later and uses rich tool cards for dashboard updates and database queries. (#65) diff --git a/pkg-r/R/querychat.R b/pkg-r/R/querychat.R index f90327a1..2f6c54bd 100644 --- a/pkg-r/R/querychat.R +++ b/pkg-r/R/querychat.R @@ -151,8 +151,14 @@ querychat_sidebar <- function(id, width = 400, height = "100%", ...) { querychat_ui <- function(id) { ns <- shiny::NS(id) htmltools::tagList( - # TODO: Make this into a proper HTML dependency - shiny::includeCSS(system.file("www", "styles.css", package = "querychat")), + htmltools::htmlDependency( + "querychat", + version = "0.0.1", + package = "querychat", + src = "htmldep", + script = "querychat.js", + stylesheet = "styles.css" + ), shinychat::chat_ui(ns("chat"), height = "100%", fill = TRUE) ) } @@ -198,76 +204,15 @@ querychat_server <- function(id, querychat_config) { ) } - # Modifies the data presented in the data dashboard, based on the given SQL - # query, and also updates the title. - # @param query A SQL query; must be a SELECT statement. - # @param title A title to display at the top of the data dashboard, - # summarizing the intent of the SQL query. - update_dashboard <- function(query, title) { - append_output("\n```sql\n", query, "\n```\n\n") - - tryCatch( - { - # Try it to see if it errors; if so, the LLM will see the error - test_query(data_source, query) - }, - error = function(err) { - append_output("> Error: ", conditionMessage(err), "\n\n") - stop(err) - } - ) - - if (!is.null(query)) { - current_query(query) - } - if (!is.null(title)) { - current_title(title) - } - - "Dashboard updated. Use `query` tool to review results, if needed." - } - - # Perform a SQL query on the data, and return the results as JSON. - # @param query A SQL query; must be a SELECT statement. - # @return The results of the query as a data frame. - query <- function(query) { - # Do this before query, in case it errors - append_output("\n```sql\n", query, "\n```\n") - - tryCatch( - { - # Execute the query and return the results - execute_query(data_source, query) - }, - error = function(e) { - append_output("> Error: ", conditionMessage(e), "\n\n") - stop(e) - } - ) - } - # Preload the conversation with the system prompt. These are instructions for # the chat model, and must not be shown to the end user. chat <- client$clone() chat$set_turns(list()) chat$set_system_prompt(system_prompt) - chat$register_tool(ellmer::tool( - update_dashboard, - "Modifies the data presented in the data dashboard, based on the given SQL query, and also updates the title.", - query = ellmer::type_string( - "A SQL query; must be a SELECT statement." - ), - title = ellmer::type_string( - "A title to display at the top of the data dashboard, summarizing the intent of the SQL query." - ) - )) - chat$register_tool(ellmer::tool( - query, - "Perform a SQL query on the data, and return the results.", - query = ellmer::type_string( - "A SQL query; must be a SELECT statement." - ) - )) + chat$register_tool( + tool_update_dashboard(data_source, current_query, current_title) + ) + chat$register_tool(tool_query(data_source)) # Prepopulate the chat UI with a welcome message that appears to be from the # chat model (but is actually hard-coded). This is just for the user, not for @@ -303,6 +248,11 @@ querychat_server <- function(id, querychat_config) { append_stream_task$invoke(chat, input$chat_user_input) }) + shiny::observeEvent(input$chat_update, { + current_query(input$chat_update$query) + current_title(input$chat_update$title) + }) + list( chat = chat, sql = shiny::reactive(current_query()), diff --git a/pkg-r/R/querychat_tools.R b/pkg-r/R/querychat_tools.R new file mode 100644 index 00000000..071dd69f --- /dev/null +++ b/pkg-r/R/querychat_tools.R @@ -0,0 +1,148 @@ +# Modifies the data presented in the data dashboard, based on the given SQL +# query, and also updates the title. +# @param query A SQL query; must be a SELECT statement. +# @param title A title to display at the top of the data dashboard, +# summarizing the intent of the SQL query. +tool_update_dashboard <- function( + data_source, + current_query, + current_title, + filtered_df +) { + ellmer::tool( + tool_update_dashboard_impl(data_source, current_query, current_title), + name = "querychat_update_dashboard", + description = "Modifies the data presented in the data dashboard, based on the given SQL query, and also updates the title.", + arguments = list( + query = ellmer::type_string( + "A SQL query; must be a SELECT statement." + ), + title = ellmer::type_string( + "A title to display at the top of the data dashboard, summarizing the intent of the SQL query." + ) + ), + annotations = ellmer::tool_annotations( + title = "Update Dashboard", + icon = '' + ) + ) +} + +tool_update_dashboard_impl <- function( + data_source, + current_query, + current_title +) { + force(data_source) + + function(query, title) { + res <- querychat_tool_result( + data_source, + query = query, + title = title, + action = "update" + ) + + if (is.null(res@error)) { + if (!is.null(query)) { + current_query(query) + } + if (!is.null(title)) { + current_title(title) + } + } + + res + } +} + +# Perform a SQL query on the data, and return the results as JSON. +# @param query A SQL query; must be a SELECT statement. +# @return The results of the query as a data frame. +tool_query <- function(data_source) { + force(data_source) + + ellmer::tool( + function(query) { + querychat_tool_result(data_source, query, action = "query") + }, + name = "querychat_query", + description = "Perform a SQL query on the data, and return the results.", + arguments = list( + query = ellmer::type_string( + "A SQL query; must be a SELECT statement." + ) + ), + annotations = ellmer::tool_annotations( + title = "Query Data", + icon = '' + ) + ) +} + +querychat_tool_result <- function( + data_source, + query, + title = NULL, + action = "update" +) { + action <- rlang::arg_match(action, c("update", "query")) + + res <- tryCatch( + switch( + action, + update = { + test_query(data_source, query) + NULL + }, + query = execute_query(data_source, query) + ), + error = function(err) err + ) + + is_error <- rlang::is_condition(res) + + output <- "" + if (!is_error && action == "query") { + output <- utils::capture.output(print(res)) + output <- paste( + c( + "\n\n
Result\n\n```", + output, + "```\n\n
" + ), + collapse = "\n" + ) + } + + if (!is_error && action == "update") { + output <- format( + shiny::tags$button( + class = "btn btn-outline-primary btn-sm float-end mt-3 querychat-update-dashboard-btn", + "data-query" = query, + "data-title" = title, + "Apply Filter" + ) + ) + output <- paste0("\n\n", output) + } + + value <- + switch( + action, + query = res, + update = "Dashboard updated. Use `querychat_query` tool to review results, if needed." + ) + + ellmer::ContentToolResult( + value = if (!is_error) value, + error = if (is_error) res, + extra = list( + display = list( + show_request = is_error, + markdown = sprintf("```sql\n%s\n```%s", query, output), + open = !is_error + ) + ) + ) +} diff --git a/pkg-r/inst/htmldep/querychat.js b/pkg-r/inst/htmldep/querychat.js new file mode 100644 index 00000000..326b5e34 --- /dev/null +++ b/pkg-r/inst/htmldep/querychat.js @@ -0,0 +1,20 @@ +(function () { + if (!window.Shiny) return; + + window.addEventListener("click", function (event) { + if (event.target.tagName.toLowerCase() !== "button") return; + if (!event.target.matches(".querychat-update-dashboard-btn")) return; + + const chatContainer = event.target.closest("shiny-chat-container"); + if (!chatContainer) return; + + const chatId = chatContainer.id; + const { query, title } = event.target.dataset; + + window.Shiny.setInputValue( + chatId + "_update", + { query, title }, + { priority: "event" } + ); + }); +})(); diff --git a/pkg-r/inst/www/styles.css b/pkg-r/inst/htmldep/styles.css similarity index 100% rename from pkg-r/inst/www/styles.css rename to pkg-r/inst/htmldep/styles.css