diff --git a/pkg-py/src/querychat/prompts/tool-card.md b/pkg-py/src/querychat/prompts/tool-card.md new file mode 100644 index 00000000..7222d005 --- /dev/null +++ b/pkg-py/src/querychat/prompts/tool-card.md @@ -0,0 +1,57 @@ +Add, replace, patch, or remove a persistent card in the dashboard cards area + +Cards live in a developer-placed dashboard area and stay visible across queries. Use them to surface insights the user wants to keep in view (a key metric, a notable ranking, a trend, or a written takeaway), not to echo every query result. Add a card when the user asks to "pin", "save", or "add to the dashboard", or when you have answered a question and a persistent summary would clearly add lasting value. + +Match the display to the finding: + +- **value_box**: a single key metric. The SQL query must return exactly 1 row. The displayed number comes from the `value` column (or the first column if no `value` column). Columns named `title`, `text`, `theme`, or `icon` override the static card fields, enabling dynamic theming (e.g. `CASE WHEN ... THEN 'danger' ELSE 'success' END AS theme`). +- **table**: a ranked or comparative result set the user wants to see at a glance. +- **visualization**: a trend, distribution, or comparison that reads better as a chart. +- **markdown**: a written takeaway or note. Use the `text` field for the markdown body. Optionally supply a `query` (SQL returning exactly 1 row) whose columns become `{{var}}` placeholders in `text` for live interpolation (e.g. `Revenue grew {{pct}}% to {{total}}`). + +For a small set of related metrics (roughly 3-4 or fewer), add a separate value_box for each one; a row of value boxes reads better than one table of headline numbers. + +Query-backed cards (table, visualization, value_box) are validated by running the query before the card is added, replaced, or patched. If a query fails you receive the error message; fix the query and retry at least once before reporting failure to the user. + +Parameters +---------- +action : + The operation to perform. + - `"add"`: create a new card. Requires `display`, `title`, and `query` (or `text` for markdown). + - `"patch"`: the preferred way to edit a card. Send the `id` and only the fields you are changing; omitted fields keep their current values. Cannot clear an optional field; use `"replace"` for that. + - `"replace"`: fully overwrite a card. Send the `id` and every field for the new version (same requirements as `"add"`; changing `display` is allowed). Omitted optional fields are cleared. + - `"remove"`: delete a card. Requires only `id`. + - `"get"`: read existing cards. Omit `id` for all cards, or pass an `id` for one. Use it to discover card `id`s and their current contents before a patch, replace, or remove. +id : + The short card identifier. Required for `"replace"`, `"patch"`, and `"remove"`; optional for `"get"` (omit to return all cards); omit for `"add"`. +display : + Which renderer to use; required for `"add"` and `"replace"`. One of `"table"`, `"visualization"`, `"markdown"`, or `"value_box"`, as described above. +title : + A brief card heading shown in the card header. Required for `"add"` and `"replace"`. +query : + The data query; required for table, visualization, and value_box displays; optional for markdown (interpolation). Its meaning depends on `display`: + - `"table"`: a valid {{db_type}} SQL SELECT query. + - `"visualization"`: a full ggsql query including a VISUALISE clause. Do NOT include `LABEL title => ...`; use the `title` parameter instead. + - `"value_box"`: a {{db_type}} SQL SELECT query returning exactly 1 row. The displayed number comes from the `value` column (or the first column). Additional columns named `title`, `text`, `theme`, or `icon` override the static card fields. Format the displayed value as a human-readable string in SQL (thousands separators, currency, rounding, a `%` suffix, etc.). + - `"markdown"` (optional): a {{db_type}} SQL SELECT query returning exactly 1 row. Its columns become `{{var}}` placeholders in the `text` body. +text : + Supplementary text; its role depends on `display`: + - `"markdown"` (required): the body content, rendered as HTML via markdown. If a `query` is also supplied, its single-row columns are interpolated as `{{var}}` placeholders. + - `"table"` / `"visualization"`: a brief footer shown below the content. + - `"value_box"`: the subtitle shown under the main value. +theme : + Optional Bootstrap theme name for a value_box background (e.g. `primary`, `secondary`, `success`, `danger`, `warning`, `info`). Any valid Bootstrap theme class is accepted. Applies to value_box only; ignored for other displays. +icon : + Optional Bootstrap icon name (e.g., `"bar-chart"`, `"currency-dollar"`, `"people-fill"`). Honored by every display: the showcase icon for value_box, and shown beside the title for table/visualization/markdown. + +Returns +------- +: + For `"add"`, `"replace"`, `"patch"`, and `"remove"`: a JSON object with the + affected card's `id` and a `status` (e.g. `{"id": "a3f7", "status": "added"}`). + For `"get"`: a single card object when an `id` is given, otherwise a JSON array + of all cards. Each card object holds the card's full definition (`id`, `display`, + `title`, `query`/`text`, and any optional fields), e.g. + `{"id": "a3f7", "display": "value_box", "title": "Total Revenue", "query": "SELECT ..."}`. + If a query-backed card fails validation, an error message is returned instead and + no card is created or changed. diff --git a/pkg-r/NEWS.md b/pkg-r/NEWS.md index 7f8ba58a..527c9d77 100644 --- a/pkg-r/NEWS.md +++ b/pkg-r/NEWS.md @@ -29,12 +29,18 @@ * File attachments are now enabled by default in the Shiny chat UI. Users can attach images, PDFs, and text files to their messages and the LLM will receive them. Disable with `allow_attachments = FALSE` in `mod_ui()` or `QueryChat$ui()`. (#253) +* Card dashboards can now be **shared and author-seeded** without the LLM. `$cards_url()` encodes the current cards into a compact URL, and `$cards_set_url()` updates the address bar to that link; opening such a URL seeds the dashboard with exactly those cards and a fresh conversation. The new `cards` argument to `QueryChat$new()` (and `querychat()`) seeds an initial dashboard from a list of cards, a JSON string, or a path to a `.json` file. The bundled `querychat_app()` Insights panel shows an "open in new tab" link for the current cards. + ## Breaking changes * The `$data_source` property has been removed. Use `qc$table("name")$data_source` to read a table's data source, and `qc$add_table(df, "name", replace = TRUE)` to replace it. The `data_source` parameter to `$server()` has also been removed; call `$add_table()` before `$server()` instead. (#195) ## Improvements +* The `$server()` argument `enable_bookmarking` has been renamed to `bookmark_enable` (the old name is deprecated but still works). It now also selects *which* categories of state to bookmark, accepting `TRUE`/`FALSE` or a subset of `c("conversation", "cards")`. `bookmark_enable` is also available on `$app()`, `$app_obj()`, and `querychat_app()`, where `bookmark_store` now solely controls *where* state is stored. + +* The `bookmark_store` argument of `$app()`, `$app_obj()`, and `querychat_app()` now defaults to `NULL` instead of `"url"`. With `NULL`, querychat defers to a store you set yourself via `shiny::enableBookmarking()`, and otherwise picks a sensible default: `"server"` when the conversation is bookmarked or when running on a hosting platform (detected via `R_CONFIG_ACTIVE`), and `"url"` otherwise. Pass `bookmark_store` explicitly to override. + * Chat greetings now use shinychat's greeting API (requires shinychat >= 0.4.0). A provided `greeting` renders instantly when the app loads, and when no `greeting` is given one is generated on demand — now **schema-aware**, so it can describe the data it's about to help you explore — without being added to the conversation history. Generated greetings are preserved across bookmark/restore. Tables passed to `QueryChat$new()` are described in the greeting automatically; opt additional tables in with `include_in_greeting = TRUE` on `$add_table()`/`$add_tables()`, or fine-tune which tables and which template the greeting uses via `qc$greeter`. (#249, #261) * The system prompt is now lighter: full schema is no longer embedded upfront. Instead the LLM fetches per-table schema on demand via the new `querychat_get_schema` tool — and only when it needs to. When a `data_dict` is provided, the tool skips columns that already have descriptions, so the LLM only pays for what isn't already documented. (#195) diff --git a/pkg-r/R/QueryChat.R b/pkg-r/R/QueryChat.R index 9e0731bc..688cff49 100644 --- a/pkg-r/R/QueryChat.R +++ b/pkg-r/R/QueryChat.R @@ -104,6 +104,7 @@ QueryChat <- R6::R6Class( .categorical_threshold = NULL, .data_dicts = list(), .greeter = NULL, + .seed_cards = NULL, require_initialized = function(method_name) { if (length(private$.data_sources) == 0) { @@ -156,7 +157,8 @@ QueryChat <- R6::R6Class( session = NULL, update_dashboard = function(query, title, table) {}, reset_dashboard = function(table) {}, - visualize = function(data) {} + visualize = function(data) {}, + card = function(action, id = NULL, card = NULL) {} ) { spec <- client_spec %||% private$.client_spec chat <- create_client(spec) @@ -222,6 +224,12 @@ QueryChat <- R6::R6Class( ) } + if ("cards" %in% tools) { + chat$register_tool( + tool_card(executor, manage_card = card) + ) + } + chat } ), @@ -282,6 +290,17 @@ QueryChat <- R6::R6Class( #' format. #' @param data_dict Optional data dictionary. A path to a YAML file, or a #' list of YAML file paths. See [read_data_dict()] for the expected format. + #' @param cards Optional initial set of cards to display in the Insights + #' panel before any LLM interaction. Accepts: + #' - A list of named lists, where each named list contains the card fields + #' (`display`, `title`, `query` and/or `text`, and optionally `theme`, + #' `icon`). + #' - A JSON string encoding such a list. + #' - A path to a `.json` file containing such a list. + #' + #' Structural checks (e.g. each element is a named list) run at + #' construction time. Full field and query validation runs at app startup + #' and aborts loudly naming the 1-based card index on failure. #' @param cleanup Whether or not to automatically run `$cleanup()` when the #' Shiny session/app stops. By default, cleanup only occurs if `QueryChat` #' gets created within a Shiny session. Set to `TRUE` to always clean up, @@ -301,6 +320,7 @@ QueryChat <- R6::R6Class( extra_instructions = NULL, prompt_template = NULL, data_dict = NULL, + cards = NULL, cleanup = NA ) { check_dots_empty() @@ -310,7 +330,7 @@ QueryChat <- R6::R6Class( check_string(greeting, allow_null = TRUE) arg_match( tools, - values = c("filter", "update", "query", "visualize"), + values = c("filter", "update", "query", "visualize", "cards"), multiple = TRUE ) tools <- normalize_tools(tools) @@ -323,6 +343,10 @@ QueryChat <- R6::R6Class( # Normalize data_dicts private$.data_dicts <- normalize_data_dicts(data_dict) + # Normalize and structurally validate seed cards; full field/query + # validation is deferred to mod_server() where the executor is available. + private$.seed_cards <- normalize_seed_cards(cards) + # Store init parameters for deferred system prompt building private$.prompt_template <- prompt_template private$.data_description <- data_description @@ -633,6 +657,9 @@ QueryChat <- R6::R6Class( #' `reset_dashboard` tool is called. Takes a `table` argument. #' @param visualize Optional function to call with a list containing #' `ggsql`, `title`, and `widget_id` when a visualization succeeds. + #' @param card Optional function to call when the `querychat_card` tool + #' performs an `add`, `update`, or `remove` action. The function signature + #' must be `function(action, id = NULL, card = NULL)`. #' @param session A Shiny session object. Required when `"visualize"` is #' in `tools` and you want interactive chart rendering. When `NULL` #' (the default), visualizations still execute but are not rendered @@ -642,6 +669,7 @@ QueryChat <- R6::R6Class( update_dashboard = function(query, title, table) {}, reset_dashboard = function(table) {}, visualize = function(data) {}, + card = function(action, id = NULL, card = NULL) {}, session = NULL ) { private$require_initialized("$client") @@ -649,7 +677,7 @@ QueryChat <- R6::R6Class( if (!is_na(tools) && !is.null(tools)) { tools <- arg_match( tools, - values = c("filter", "update", "query", "visualize"), + values = c("filter", "update", "query", "visualize", "cards"), multiple = TRUE ) tools <- normalize_tools(tools) @@ -660,7 +688,8 @@ QueryChat <- R6::R6Class( session = session, update_dashboard = update_dashboard, reset_dashboard = reset_dashboard, - visualize = visualize + visualize = visualize, + card = card ) }, @@ -688,13 +717,30 @@ QueryChat <- R6::R6Class( #' Create and run a Shiny gadget for chatting with data #' #' @param ... Arguments passed to `$app_obj()`. - #' @param bookmark_store The bookmarking storage method. Passed to - #' [shiny::enableBookmarking()]. If `"url"` or `"server"`, the chat state - #' (including current query) will be bookmarked. Default is `"url"`. + #' @param bookmark_enable Which categories of state to bookmark. Passed to + #' `$server()`; see its documentation for accepted values. Default is + #' `TRUE` (bookmark everything). Nothing is bookmarked when this is `FALSE` + #' or when `bookmark_store` is `"disable"`. + #' @param bookmark_store Where bookmarked state is stored. Passed to + #' [shiny::enableBookmarking()]: `"url"` stores state in the URL, `"server"` + #' stores it server-side, and `"disable"` turns off bookmarking entirely. + #' Default is `NULL`, which defers to a store set via + #' [shiny::enableBookmarking()] if present, otherwise picks a sensible + #' default (`"server"` when the conversation is bookmarked or when running + #' on a hosting platform, `"url"` otherwise). Use `bookmark_enable` to + #' choose *which* state is saved. #' - #' @return Invisibly returns a list of session-specific values. - app = function(..., bookmark_store = "url") { - app <- self$app_obj(..., bookmark_store = bookmark_store) + #' @return Invisibly returns a list of session-specific values: + #' - `df`: The final filtered data frame + #' - `sql`: The final SQL query string + #' - `title`: The final title + #' - `client`: The session-specific chat client instance + app = function(..., bookmark_enable = TRUE, bookmark_store = NULL) { + app <- self$app_obj( + ..., + bookmark_enable = bookmark_enable, + bookmark_store = bookmark_store + ) vals <- tryCatch(shiny::runGadget(app), interrupt = function(cnd) NULL) invisible(vals) }, @@ -702,75 +748,133 @@ QueryChat <- R6::R6Class( #' @description #' A streamlined Shiny app for chatting with data #' + #' Creates a Shiny app designed for chatting with data, with: + #' - A sidebar containing the chat interface + #' - A "Data" tab with the current SQL query, a reset button, and the + #' filtered data table + #' - An "Insights" tab displaying LLM-curated cards, when the `"cards"` tool + #' is enabled + #' + #' ```r + #' library(querychat) + #' + #' qc <- QueryChat$new(mtcars) + #' app <- qc$app_obj() + #' shiny::runApp(app) + #' ``` + #' #' @param ... Additional arguments (currently unused). - #' @param bookmark_store The bookmarking storage method. Passed to - #' [shiny::enableBookmarking()]. Default is `"url"`. + #' @param bookmark_enable Which categories of state to bookmark. Passed to + #' `$server()`; see its documentation for accepted values. Default is + #' `TRUE` (bookmark everything). Nothing is bookmarked when this is `FALSE` + #' or when `bookmark_store` is `"disable"`. + #' @param bookmark_store Where bookmarked state is stored. Passed to + #' [shiny::enableBookmarking()]: `"url"` stores state in the URL, `"server"` + #' stores it server-side, and `"disable"` turns off bookmarking entirely. + #' Default is `NULL`, which defers to a store set via + #' [shiny::enableBookmarking()] if present, otherwise picks a sensible + #' default (`"server"` when the conversation is bookmarked or when running + #' on a hosting platform, `"url"` otherwise). Use `bookmark_enable` to + #' choose *which* state is saved. #' #' @return A Shiny app object that can be run with `shiny::runApp()`. - app_obj = function(..., bookmark_store = "url") { + app_obj = function(..., bookmark_enable = TRUE, bookmark_store = NULL) { private$require_initialized("$app_obj") check_installed("DT") check_dots_empty() first_table_name <- names(private$.data_sources)[[1]] + cards_enabled <- "cards" %in% self$tools ui <- function(req) { - bslib::page_sidebar( - title = shiny::HTML( - sprintf( - "querychat with %s", - first_table_name - ) - ), - class = "bslib-page-dashboard", - sidebar = self$sidebar(), - shiny::useBusyIndicators(pulse = TRUE, spinners = FALSE), - bslib::card( - fill = FALSE, - style = bslib::css(max_height = "33%"), - bslib::card_header( + sql_card <- bslib::card( + fill = FALSE, + style = bslib::css(max_height = "33%"), + bslib::card_header( + shiny::div( + class = "hstack w-100", + shiny::div( + bsicons::bs_icon("terminal-fill"), + shiny::textOutput("query_title", inline = TRUE) + ), shiny::div( - class = "hstack w-100", - shiny::div( - bsicons::bs_icon("terminal-fill"), - shiny::textOutput("query_title", inline = TRUE) - ), - shiny::div( - class = "ms-auto", - shiny::uiOutput("ui_reset", inline = TRUE) - ) + class = "ms-auto", + shiny::uiOutput("ui_reset", inline = TRUE) ) - ), - shiny::uiOutput("sql_output") + ) ), + shiny::uiOutput("sql_output") + ) + + data_nav <- bslib::nav_panel( + title = list(bsicons::bs_icon("table"), "Data"), + value = "data", + class = "bslib-page-dashboard", + sql_card, bslib::card( full_screen = TRUE, - bslib::card_header( - bsicons::bs_icon("table"), - "Data \u2014 ", - shiny::textOutput("data_card_header_text", inline = TRUE) - ), DT::DTOutput("dt") - ), - if (rlang::is_interactive()) { + ) + ) + + insights_nav <- if (cards_enabled) { + bslib::nav_panel( + title = list(bsicons::bs_icon("lightbulb"), "Insights"), + value = "insights", + class = "bslib-page-dashboard", + self$ui_cards(), + shiny::uiOutput("cards_share_link") + ) + } + + close_nav <- if (rlang::is_interactive()) { + bslib::nav_item( shiny::actionButton( "close_btn", label = "", class = "btn-close", - style = "position: fixed; top: 6px; right: 6px;" + style = "align-self: center;" ) - } - ) + ) + } + + rlang::inject(bslib::page_navbar( + title = shiny::HTML( + sprintf( + "querychat with %s", + first_table_name + ) + ), + window_title = paste("querychat with", first_table_name), + id = "querychat_navbar", + sidebar = self$sidebar(), + header = shiny::useBusyIndicators(pulse = TRUE, spinners = FALSE), + bslib::nav_spacer(), + !!!compact(list(data_nav, insights_nav)), + close_nav + )) } + # `bookmark_store` selects where state is stored; `bookmark_enable` + # selects whether and what is stored. `resolve_bookmark_store()` picks a + # default when `bookmark_store` is NULL and defers to a store the author + # already set via shiny::enableBookmarking() (returning NULL in that case). + bookmark_cats <- normalize_bookmark_categories(bookmark_enable) + effective_store <- resolve_bookmark_store(bookmark_store, bookmark_cats) + server <- function(input, output, session) { shiny::setBookmarkExclude(c( "close_btn", "reset_query", "sql_editor" )) - enable_bookmarking <- bookmark_store %in% c("url", "server") - qc_vals <- self$server(enable_bookmarking = enable_bookmarking) + qc_vals <- self$server( + bookmark_enable = if (identical(effective_store, "disable")) { + FALSE + } else { + bookmark_enable + } + ) active_table_name <- shiny::reactive({ ct <- qc_vals$current_table() @@ -830,6 +934,40 @@ QueryChat <- R6::R6Class( ) }) + if (cards_enabled) { + # Open the Insights tab on startup when it is seeded with cards, + # regardless of how they were seeded (author `cards=`, the + # `?querychat_cards=` URL param, or bookmark restore). onFlushed fires + # after the first reactive flush, by which point all three paths have + # applied to `qc_vals$cards()`. + shiny::onFlushed( + function() { + if (length(shiny::isolate(qc_vals$cards())) > 0) { + bslib::nav_select("querychat_navbar", "insights") + } + }, + once = TRUE + ) + + output$cards_share_link <- shiny::renderUI({ + current_cards <- qc_vals$cards() + if (length(current_cards) == 0) { + return(NULL) + } + url <- self$cards_url(current_cards) + htmltools::div( + class = "mt-auto pt-2 text-center border-top", + htmltools::a( + href = url, + target = "_blank", + rel = "noopener", + "Share these insights", + bsicons::bs_icon("box-arrow-up-right"), + ) + ) + }) + } + shiny::observe(label = "sync_sql_editor", { name <- active_table_name() bslib::update_code_editor( @@ -866,7 +1004,7 @@ QueryChat <- R6::R6Class( } } - shiny::shinyApp(ui, server, enableBookmarking = bookmark_store) + shiny::shinyApp(ui, server, enableBookmarking = effective_store) }, #' @description @@ -912,13 +1050,153 @@ QueryChat <- R6::R6Class( mod_ui(id, ..., greeting = self$greeting) }, + #' @description + #' Create the UI for the querychat cards area. + #' + #' This method generates the output area where cards created by the LLM are + #' displayed. Place it in your app's main panel, next to `$sidebar()`. + #' + #' ```r + #' qc <- QueryChat$new(mtcars) + #' + #' ui <- bslib::page_sidebar( + #' sidebar = qc$sidebar(), + #' qc$ui_cards() + #' ) + #' ``` + #' + #' The placeholder text is configured on `$server()` via `card_placeholder`. + #' Card layout is handled automatically. + #' + #' @param ... Additional arguments passed to [shiny::uiOutput()]. + #' @param id Optional ID for the QueryChat instance. If not provided, + #' will use the ID provided at initialization. If using `$ui_cards()` in a + #' Shiny module, you'll need to provide `id = ns("your_id")` where `ns` is + #' the namespacing function from [shiny::NS()]. + #' + #' @return A UI component containing the cards output area. + ui_cards = function(..., id = NULL) { + check_string(id, allow_null = TRUE, allow_empty = FALSE) + id <- id %||% namespaced_id(self$id) + mod_ui_cards(id, ...) + }, + + #' @description + #' Build a shareable URL that opens the app with the given cards pre-loaded. + #' + #' The cards list is encoded as a compact gzip+base64 query parameter. + #' When visited, `$server()` seeds the cards reactive from this parameter + #' before the first render — so the app opens with the shared insight cards + #' already visible, without requiring a bookmark. + #' + #' @param cards A list of card field-lists, or a JSON string that encodes + #' such a list. Required; there is no default. + #' @param ... Must be empty. + #' @param id Optional module ID override. Defaults to `self$id`. + #' + #' @return A URL string (absolute when called from a session, relative + #' otherwise). + cards_url = function(cards = NULL, ..., id = NULL) { + rlang::check_dots_empty() + if (is.null(cards)) { + cli::cli_abort( + "{.arg cards} is required: pass a list of cards or a JSON string." + ) + } + if (is.character(cards) && length(cards) == 1) { + cards <- jsonlite::fromJSON(cards, simplifyVector = FALSE) + } + id <- id %||% self$id + # shiny::NS(id)("querychat_cards") == paste0(id, "-querychat_cards") + key <- paste0(id, "-querychat_cards") + payload <- cards_to_payload(cards) + encoded_key <- utils::URLencode(key, reserved = TRUE) + encoded_val <- utils::URLencode(payload, reserved = TRUE) + qs <- sprintf("?%s=%s", encoded_key, encoded_val) + session <- shiny::getDefaultReactiveDomain() + if (!is.null(session)) { + cd <- session$clientData + port <- cd$url_port + host <- if (nzchar(port %||% "")) { + paste0(cd$url_hostname, ":", port) + } else { + cd$url_hostname + } + paste0(cd$url_protocol, "//", host, cd$url_pathname, qs) + } else { + qs + } + }, + + #' @description + #' Update the browser URL to a shareable cards link. + #' + #' A thin wrapper around `$cards_url()` that calls + #' [shiny::updateQueryString()] with the resulting URL. Must be called + #' from within a Shiny server function. + #' + #' @param cards A list of card field-lists, or a JSON string. Required. + #' @param ... Passed to `$cards_url()`. + #' @param id Optional module ID override. + #' + #' @return Invisibly returns the URL string. + cards_set_url = function(cards = NULL, ..., id = NULL) { + url <- self$cards_url(cards, ..., id = id) + shiny::updateQueryString(url) + invisible(url) + }, + #' @description #' Initialize the querychat server logic. #' - #' @param data_source Optional data source for backward compatibility. - #' If provided, calls `$add_table()` before initializing server logic. - #' @param client Optional chat client override for this session. - #' @param enable_bookmarking Whether to enable bookmarking. Default is `FALSE`. + #' This method must be called within a Shiny server function. It sets up the + #' reactive logic for the chat interface and returns session-specific + #' reactive values. + #' + #' ```r + #' qc <- QueryChat$new(mtcars) + #' + #' server <- function(input, output, session) { + #' qc_vals <- qc$server(bookmark_enable = TRUE) + #' + #' output$data <- renderDataTable(qc_vals$df()) + #' output$query <- renderText(qc_vals$sql()) + #' output$title <- renderText(qc_vals$title() %||% "No Query") + #' } + #' ``` + #' + #' @param data_source Optional data source to use. If provided, sets the + #' data_source property before initializing server logic. This is useful + #' for the deferred pattern where data_source is not known at + #' initialization time (e.g., when the data source depends on session- + #' specific authentication). + #' @param client Optional chat client override for this session. Can be an + #' [ellmer::Chat] object or a string (e.g., `"openai/gpt-4o"`). If provided, + #' overrides the client set at initialization for this session only — + #' other sessions are unaffected. This is useful when the client must be + #' created within a session scope (e.g., Posit Connect managed credentials). + #' @param bookmark_enable Which categories of state to bookmark. Default + #' is `FALSE` (no bookmarking). Accepts: + #' - `TRUE` to bookmark everything (equivalent to + #' `c("conversation", "cards")`). + #' - `FALSE` or `NULL` to disable bookmarking. + #' - A character vector subset of `c("conversation", "cards")` to bookmark + #' only those categories. `"conversation"` covers the chat transcript, + #' the active dashboard filter (query and title), the generated greeting, + #' and inline visualization widgets. `"cards"` covers the insight cards + #' created with the `querychat_card` tool. + #' + #' Bookmarking categories independently enables share patterns such as + #' `bookmark_enable = "cards"`, which produces links that open the app + #' with the same insights but a fresh conversation. + #' + #' This requires that the Shiny app has bookmarking enabled via + #' `shiny::enableBookmarking()` or the `enableBookmarking` parameter of + #' `shiny::shinyApp()`. + #' @param enable_bookmarking `r lifecycle::badge("deprecated")` Renamed to + #' `bookmark_enable`. + #' @param card_placeholder Text shown in the `$ui_cards()` area when no + #' cards exist. Set to `NULL` for no placeholder. #' @param ... Ignored. #' @param id Optional module ID override. #' @param session The Shiny session object. @@ -926,20 +1204,39 @@ QueryChat <- R6::R6Class( #' @return A list containing session-specific reactive values and the chat #' client. For single-table usage, includes `df`, `sql`, `title` directly. #' For multi-table, use `qc_vals$table("name")` to get a [TableAccessor] - #' with per-table reactive state. Also includes `table_names()` to list tables. - #' `current_table()` returns the name of the most recently queried table, - #' or `NULL` before any query. + #' with per-table reactive state. Also includes `table_names()` to list tables, + #' `current_table()` which returns the name of the most recently queried table + #' (or `NULL` before any query), and `cards`, a reactive value holding the + #' current list of cards. + #' server = function( data_source = NULL, client = NULL, - enable_bookmarking = FALSE, + bookmark_enable = FALSE, + card_placeholder = "Insights will appear here", ..., id = NULL, - session = shiny::getDefaultReactiveDomain() + session = shiny::getDefaultReactiveDomain(), + enable_bookmarking = lifecycle::deprecated() ) { check_string(id, allow_null = TRUE, allow_empty = FALSE) check_dots_empty() + if (lifecycle::is_present(enable_bookmarking)) { + if (!missing(bookmark_enable)) { + cli::cli_abort(c( + "Can't supply both {.arg bookmark_enable} and the deprecated {.arg enable_bookmarking}.", + "i" = "Use only {.arg bookmark_enable}." + )) + } + lifecycle::deprecate_warn( + when = "0.4.0", + what = "QueryChat$server(enable_bookmarking = )", + with = "QueryChat$server(bookmark_enable = )" + ) + bookmark_enable <- enable_bookmarking + } + if (is.null(session)) { cli::cli_abort( "{.fn $server} must be called within a Shiny server function" @@ -984,7 +1281,9 @@ QueryChat <- R6::R6Class( tools = self$tools, greeter = self$greeter, greeting_base = base_client, - enable_bookmarking = enable_bookmarking + bookmark_enable = bookmark_enable, + card_placeholder = card_placeholder, + seed_cards = private$.seed_cards ) result }, @@ -1091,16 +1390,41 @@ QueryChat <- R6::R6Class( #' connection). #' @param table_name A string specifying the table name to use in SQL queries. #' @param ... Additional arguments (currently unused). -#' @param id Optional module ID for the QueryChat instance. -#' @param greeting Optional initial message to display to users. -#' @param client Optional chat client. -#' @param tools Which querychat tools to include in the chat client. -#' @param data_description Optional description of the data. +#' @param id Optional module ID for the QueryChat instance. If not provided, +#' will be auto-generated from `table_name`. The ID is used to namespace +#' the Shiny module. +#' @param greeting Optional initial message to display to users. Can be a +#' character string (in Markdown format) or a file path. If not provided, +#' a greeting will be generated at the start of each conversation using the +#' LLM, which adds latency and cost. Use `$generate_greeting()` to create +#' a greeting to save and reuse. +#' @param client Optional chat client. Can be: +#' - An [ellmer::Chat] object +#' - A string to pass to [ellmer::chat()] (e.g., `"openai/gpt-4o"`) +#' - `NULL` (default): Uses the `querychat.client` option, the +#' `QUERYCHAT_CLIENT` environment variable, or defaults to +#' [ellmer::chat_openai()] +#' @param tools Which querychat tools to include in the chat client, by +#' default. `"filter"` includes the tools for filtering and resetting the +#' dashboard and `"query"` includes the tool for executing SQL queries. +#' Use `tools = "filter"` when you only want the dashboard filtering tools, +#' or when you want to disable the querying tool entirely to prevent the +#' LLM from seeing any of the data in your dataset. The legacy name +#' `"update"` is still accepted as an alias for `"filter"`. +#' `querychat_app()` defaults to +#' `c("filter", "query", "visualize", "cards")` so the bundled app's Insights +#' tab is populated; pass `tools` explicitly to override. +#' @param data_description Optional description of the data in plain text or +#' Markdown. Can be a string or a file path. This provides context to the +#' LLM about what the data represents. #' @param categorical_threshold For text columns, the maximum number of unique #' values to consider as a categorical variable. Default is 20. #' @param extra_instructions Optional additional instructions for the chat model. #' @param prompt_template Optional path to or string of a custom prompt template. #' @param data_dict Optional data dictionary. A path to a YAML file or a list of paths. +#' @param cards Optional initial set of cards to display in the Insights panel +#' before any LLM interaction. A list of named card field-lists, a JSON +#' string, or a path to a `.json` file. See `QueryChat$new()` for details. #' @param cleanup Whether or not to automatically run `$cleanup()` when the #' Shiny session/app stops. #' @@ -1121,6 +1445,7 @@ querychat <- function( extra_instructions = NULL, prompt_template = NULL, data_dict = NULL, + cards = NULL, cleanup = NA ) { if (is_missing(table_name)) { @@ -1148,12 +1473,24 @@ querychat <- function( extra_instructions = extra_instructions, prompt_template = prompt_template, data_dict = data_dict, + cards = cards, cleanup = cleanup ) } #' @rdname querychat-convenience -#' @param bookmark_store The bookmarking storage method. Default is `"url"`. +#' @param bookmark_enable Which categories of state to bookmark. Passed to +#' `QueryChat$server()`; see its documentation for accepted values. Default is +#' `TRUE` (bookmark everything). Nothing is bookmarked when this is `FALSE` or +#' when `bookmark_store` is `"disable"`. +#' @param bookmark_store Where bookmarked state is stored. Passed to +#' [shiny::enableBookmarking()]: `"url"` stores state in the URL, `"server"` +#' stores it server-side, and `"disable"` turns off bookmarking entirely. +#' Default is `NULL`, which defers to a store set via +#' [shiny::enableBookmarking()] if present, otherwise picks a sensible default +#' (`"server"` when the conversation is bookmarked or when running on a +#' hosting platform, `"url"` otherwise). Use `bookmark_enable` to choose +#' *which* state is saved. #' @return Invisibly returns the chat object after the app stops. #' #' @export @@ -1164,14 +1501,16 @@ querychat_app <- function( id = NULL, greeting = NULL, client = NULL, - tools = c("filter", "query"), + tools = c("filter", "query", "visualize", "cards"), data_description = NULL, categorical_threshold = 20, extra_instructions = NULL, prompt_template = NULL, data_dict = NULL, + cards = NULL, cleanup = NA, - bookmark_store = "url" + bookmark_enable = TRUE, + bookmark_store = NULL ) { if (shiny::isRunning()) { cli::cli_abort( @@ -1211,10 +1550,14 @@ querychat_app <- function( extra_instructions = extra_instructions, prompt_template = prompt_template, data_dict = data_dict, + cards = cards, cleanup = cleanup ) - qc$app(bookmark_store = bookmark_store) + qc$app( + bookmark_enable = bookmark_enable, + bookmark_store = bookmark_store + ) } normalize_tools <- function(tools) { diff --git a/pkg-r/R/QueryChatSystemPrompt.R b/pkg-r/R/QueryChatSystemPrompt.R index 165ffae8..350f39a0 100644 --- a/pkg-r/R/QueryChatSystemPrompt.R +++ b/pkg-r/R/QueryChatSystemPrompt.R @@ -164,6 +164,7 @@ QueryChatSystemPrompt <- R6::R6Class( has_tool_update = if ("update" %in% tools) "true", has_tool_query = if ("query" %in% tools) "true", has_tool_visualize = if ("visualize" %in% tools) "true", + has_tool_card = if ("cards" %in% tools) "true", include_query_guidelines = if (length(tools) > 0) "true", multi_table = length(self$data_sources) > 1 ) diff --git a/pkg-r/R/QueryExecutor.R b/pkg-r/R/QueryExecutor.R index 1347e3d8..491d5ae1 100644 --- a/pkg-r/R/QueryExecutor.R +++ b/pkg-r/R/QueryExecutor.R @@ -19,6 +19,12 @@ QueryExecutor <- R6::R6Class( class = "not_implemented_error" ) }, + validate_query = function(query) { + cli::cli_abort( + "{.fn validate_query} must be implemented by subclass", + class = "not_implemented_error" + ) + }, get_db_type = function() { cli::cli_abort( "{.fn get_db_type} must be implemented by subclass", @@ -122,6 +128,14 @@ DuckDBExecutor <- R6::R6Class( df }, + validate_query = function(query) { + check_query(query) + rs <- DBI::dbSendQuery(private$conn, query) + on.exit(DBI::dbClearResult(rs)) + DBI::dbFetch(rs, n = 1) + invisible(NULL) + }, + get_db_type = function() "DuckDB", get_schema = function( @@ -190,6 +204,11 @@ DataSourceExecutor <- R6::R6Class( ) }, + validate_query = function(query) { + private$primary$test_query(query) + invisible(NULL) + }, + get_db_type = function() { private$primary$get_db_type() }, diff --git a/pkg-r/R/import-standalone-purrr.R b/pkg-r/R/import-standalone-purrr.R new file mode 100644 index 00000000..85a185f3 --- /dev/null +++ b/pkg-r/R/import-standalone-purrr.R @@ -0,0 +1,246 @@ +# Standalone file: do not edit by hand +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-purrr.R +# Generated by: usethis::use_standalone("r-lib/rlang", "purrr") +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-purrr.R +# last-updated: 2023-02-23 +# license: https://unlicense.org +# imports: rlang +# --- +# +# This file provides a minimal shim to provide a purrr-like API on top of +# base R functions. They are not drop-in replacements but allow a similar style +# of programming. +# +# ## Changelog +# +# 2023-02-23: +# * Added `list_c()` +# +# 2022-06-07: +# * `transpose()` is now more consistent with purrr when inner names +# are not congruent (#1346). +# +# 2021-12-15: +# * `transpose()` now supports empty lists. +# +# 2021-05-21: +# * Fixed "object `x` not found" error in `imap()` (@mgirlich) +# +# 2020-04-14: +# * Removed `pluck*()` functions +# * Removed `*_cpl()` functions +# * Used `as_function()` to allow use of `~` +# * Used `.` prefix for helpers +# +# nocov start + +map <- function(.x, .f, ...) { + .f <- as_function(.f, env = global_env()) + lapply(.x, .f, ...) +} +walk <- function(.x, .f, ...) { + map(.x, .f, ...) + invisible(.x) +} + +map_lgl <- function(.x, .f, ...) { + .rlang_purrr_map_mold(.x, .f, logical(1), ...) +} +map_int <- function(.x, .f, ...) { + .rlang_purrr_map_mold(.x, .f, integer(1), ...) +} +map_dbl <- function(.x, .f, ...) { + .rlang_purrr_map_mold(.x, .f, double(1), ...) +} +map_chr <- function(.x, .f, ...) { + .rlang_purrr_map_mold(.x, .f, character(1), ...) +} +.rlang_purrr_map_mold <- function(.x, .f, .mold, ...) { + .f <- as_function(.f, env = global_env()) + out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE) + names(out) <- names(.x) + out +} + +map2 <- function(.x, .y, .f, ...) { + .f <- as_function(.f, env = global_env()) + out <- mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE) + if (length(out) == length(.x)) { + set_names(out, names(.x)) + } else { + set_names(out, NULL) + } +} +map2_lgl <- function(.x, .y, .f, ...) { + as.vector(map2(.x, .y, .f, ...), "logical") +} +map2_int <- function(.x, .y, .f, ...) { + as.vector(map2(.x, .y, .f, ...), "integer") +} +map2_dbl <- function(.x, .y, .f, ...) { + as.vector(map2(.x, .y, .f, ...), "double") +} +map2_chr <- function(.x, .y, .f, ...) { + as.vector(map2(.x, .y, .f, ...), "character") +} +imap <- function(.x, .f, ...) { + map2(.x, names(.x) %||% seq_along(.x), .f, ...) +} + +pmap <- function(.l, .f, ...) { + .f <- as.function(.f) + args <- .rlang_purrr_args_recycle(.l) + do.call( + "mapply", + c( + FUN = list(quote(.f)), + args, + MoreArgs = quote(list(...)), + SIMPLIFY = FALSE, + USE.NAMES = FALSE + ) + ) +} +.rlang_purrr_args_recycle <- function(args) { + lengths <- map_int(args, length) + n <- max(lengths) + + stopifnot(all(lengths == 1L | lengths == n)) + to_recycle <- lengths == 1L + args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n)) + + args +} + +keep <- function(.x, .f, ...) { + .x[.rlang_purrr_probe(.x, .f, ...)] +} +discard <- function(.x, .p, ...) { + sel <- .rlang_purrr_probe(.x, .p, ...) + .x[is.na(sel) | !sel] +} +map_if <- function(.x, .p, .f, ...) { + matches <- .rlang_purrr_probe(.x, .p) + .x[matches] <- map(.x[matches], .f, ...) + .x +} +.rlang_purrr_probe <- function(.x, .p, ...) { + if (is_logical(.p)) { + stopifnot(length(.p) == length(.x)) + .p + } else { + .p <- as_function(.p, env = global_env()) + map_lgl(.x, .p, ...) + } +} + +compact <- function(.x) { + .x[as.logical(lengths(.x))] +} + +transpose <- function(.l) { + if (!length(.l)) { + return(.l) + } + + inner_names <- names(.l[[1]]) + + if (is.null(inner_names)) { + fields <- seq_along(.l[[1]]) + } else { + fields <- set_names(inner_names) + .l <- map(.l, function(x) { + if (is.null(names(x))) { + set_names(x, inner_names) + } else { + x + } + }) + } + + # This way missing fields are subsetted as `NULL` instead of causing + # an error + .l <- map(.l, as.list) + + map(fields, function(i) { + map(.l, .subset2, i) + }) +} + +every <- function(.x, .p, ...) { + .p <- as_function(.p, env = global_env()) + + for (i in seq_along(.x)) { + if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE) + } + TRUE +} +some <- function(.x, .p, ...) { + .p <- as_function(.p, env = global_env()) + + for (i in seq_along(.x)) { + if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE) + } + FALSE +} +negate <- function(.p) { + .p <- as_function(.p, env = global_env()) + function(...) !.p(...) +} + +reduce <- function(.x, .f, ..., .init) { + f <- function(x, y) .f(x, y, ...) + Reduce(f, .x, init = .init) +} +reduce_right <- function(.x, .f, ..., .init) { + f <- function(x, y) .f(y, x, ...) + Reduce(f, .x, init = .init, right = TRUE) +} +accumulate <- function(.x, .f, ..., .init) { + f <- function(x, y) .f(x, y, ...) + Reduce(f, .x, init = .init, accumulate = TRUE) +} +accumulate_right <- function(.x, .f, ..., .init) { + f <- function(x, y) .f(y, x, ...) + Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE) +} + +detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) { + .p <- as_function(.p, env = global_env()) + .f <- as_function(.f, env = global_env()) + + for (i in .rlang_purrr_index(.x, .right)) { + if (.p(.f(.x[[i]], ...))) { + return(.x[[i]]) + } + } + NULL +} +detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) { + .p <- as_function(.p, env = global_env()) + .f <- as_function(.f, env = global_env()) + + for (i in .rlang_purrr_index(.x, .right)) { + if (.p(.f(.x[[i]], ...))) { + return(i) + } + } + 0L +} +.rlang_purrr_index <- function(x, right = FALSE) { + idx <- seq_along(x) + if (right) { + idx <- rev(idx) + } + idx +} + +list_c <- function(x) { + inject(c(!!!x)) +} + +# nocov end diff --git a/pkg-r/R/querychat_card.R b/pkg-r/R/querychat_card.R new file mode 100644 index 00000000..2ddba946 --- /dev/null +++ b/pkg-r/R/querychat_card.R @@ -0,0 +1,409 @@ +tool_card <- function(executor, manage_card) { + check_query_executor(executor) + check_function(manage_card) + + db_type <- executor$get_db_type() + + ellmer::tool( + tool_card_impl(executor, manage_card), + name = "querychat_card", + description = interpolate_package("tool-card.md", db_type = db_type), + arguments = list( + action = ellmer::type_enum( + c("add", "replace", "patch", "remove", "get"), + paste( + "The operation to perform.", + "- 'add': create a new card. Requires display, title, and query (or text for markdown).", + "- 'patch': the preferred way to edit a card. Send the id and only the fields you are changing; omitted fields keep their current values. Cannot clear an optional field; use 'replace' for that.", + "- 'replace': fully overwrite a card. Send the id and every field for the new version (same requirements as 'add'; changing display is allowed). Omitted optional fields are cleared.", + "- 'remove': delete a card. Requires only id.", + "- 'get': read existing cards. Omit id for all cards, or pass an id for one. Use it to discover card ids and their current contents before a patch, replace, or remove.", + sep = "\n" + ) + ), + id = ellmer::type_string( + "The short card identifier. Required for replace, patch, and remove; optional for get (omit to return all cards); omit for add.", + required = FALSE + ), + display = ellmer::type_enum( + c("table", "visualization", "markdown", "value_box"), + "Which renderer to use; required for add and replace. 'table' renders SQL query results as a table, 'visualization' renders a ggsql chart, 'markdown' renders static markdown text, 'value_box' renders a single highlighted metric (SQL query returning exactly 1 row and 1 column).", + required = FALSE + ), + title = ellmer::type_string( + "A brief card heading shown in the card header. Required for add and replace.", + required = FALSE + ), + query = ellmer::type_string( + ellmer::interpolate( + paste( + "The data query; required for table, visualization, and value_box displays; optional for markdown (interpolation). Its meaning depends on display:", + "- table: a {{db_type}} SQL SELECT query.", + "- visualization: a full ggsql query including a VISUALISE clause. Do NOT include `LABEL title => ...`; use the title parameter instead.", + "- value_box: a {{db_type}} SQL SELECT query returning exactly 1 row. The displayed number comes from the `value` column (or the first column). Additional columns named title, text, theme, or icon override the static card fields. Format the displayed value as a human-readable string in SQL (thousands separators, currency, rounding, a % suffix, etc.).", + "- markdown (optional): a {{db_type}} SQL SELECT query returning exactly 1 row. Its columns become {{{{var}}}} placeholders in the text body.", + sep = "\n" + ), + db_type = db_type + ), + required = FALSE + ), + text = ellmer::type_string( + paste( + "Supplementary text; its role depends on display:", + "- markdown (required): the body content, rendered as HTML via markdown. If a query is also supplied, its single-row columns are interpolated as {{var}} placeholders.", + "- table / visualization: a brief footer shown below the content.", + "- value_box: the subtitle shown under the main value.", + sep = "\n" + ), + required = FALSE + ), + theme = ellmer::type_string( + "Optional Bootstrap theme name for a value_box background (e.g. primary, secondary, success, danger, warning, info). Applies to value_box only; ignored for other displays.", + required = FALSE + ), + icon = ellmer::type_string( + "Optional Bootstrap icon name (e.g., 'bar-chart', 'currency-dollar', 'people-fill'). Honored by every display: the showcase icon for value_box, and shown beside the title for table/visualization/markdown.", + required = FALSE + ) + ), + annotations = ellmer::tool_annotations( + title = "Update Cards", + icon = card_icon() + ) + ) +} + +tool_card_impl <- function(executor, manage_card) { + force(executor) + force(manage_card) + + function( + action, + id = NULL, + display = NULL, + title = NULL, + query = NULL, + text = NULL, + theme = NULL, + icon = NULL + ) { + if (action == "get") { + if (is.null(id)) { + cards <- manage_card("get") + return(card_tool_result(lapply(cards, card_public), "View Cards")) + } + card <- manage_card("get", id = id) + if (is.null(card)) { + rlang::abort(sprintf("No card found with id '%s'.", id)) + } + return(card_tool_result(card_public(card), "View Card")) + } + + if (action == "remove") { + if (is.null(id)) { + rlang::abort("'id' is required for action 'remove'.") + } + manage_card("remove", id = id) + return(card_tool_result(list(id = id, status = "removed"), "Remove Card")) + } + + if (action %in% c("replace", "patch") && is.null(id)) { + rlang::abort(sprintf("'id' is required for action '%s'.", action)) + } + + # For 'patch', overlay the supplied fields onto the existing card and then + # validate the merged result the same way 'add'/'replace' do. Drop unset + # (NULL) fields first so modifyList() does not delete them. To clear an + # optional field, use 'replace' instead. + if (action == "patch") { + existing <- manage_card("get", id = id) + if (is.null(existing)) { + rlang::abort(sprintf("No card found with id '%s'.", id)) + } + supplied <- Filter( + Negate(is.null), + list( + display = display, + title = title, + query = query, + text = text, + theme = theme, + icon = icon + ) + ) + merged <- utils::modifyList(existing, supplied) + display <- merged$display + title <- merged$title + query <- merged$query + text <- merged$text + theme <- merged$theme + icon <- merged$icon + } + + card <- validate_and_build_card( + executor, + fields = list( + display = display, + title = title, + query = query, + text = text, + theme = theme, + icon = icon + ) + ) + + if (action == "add") { + id <- new_card_id(manage_card) + } + card$id <- id + + store_action <- if (action == "add") "add" else "replace" + manage_card(store_action, id = id, card = card) + status <- switch( + action, + add = "added", + replace = "replaced", + patch = "patched" + ) + title <- switch( + action, + add = "Add Card", + replace = "Replace Card", + patch = "Update Card" + ) + card_tool_result(list(id = id, status = status), title) + } +} + +# Validate fields and return the canonical card list (without id). +validate_and_build_card <- function(executor, fields) { + # Migrate legacy field names from persisted state (bookmarks, URL seeds) + if (!is.null(fields$caption) && is.null(fields$text)) { + fields$text <- fields$caption + } + fields$caption <- NULL + if (!is.null(fields$value) && is.null(fields$query)) { + fields$query <- fields$value + } + fields$value <- NULL + + display <- fields$display + title <- fields$title + query <- fields$query + text <- fields$text + theme <- fields$theme + icon <- fields$icon + + if (is.null(display)) { + rlang::abort( + "'display' is required for actions 'add', 'replace', and 'patch'." + ) + } + if (is.null(title)) { + rlang::abort( + "'title' is required for actions 'add', 'replace', and 'patch'." + ) + } + if (display == "markdown") { + if (is.null(text)) { + rlang::abort("'text' is required for display 'markdown'.") + } + } else { + if (is.null(query)) { + rlang::abort(sprintf("'query' is required for display '%s'.", display)) + } + } + + # Validate icon (bsicons) for any display that supplies one + if (!is.null(icon)) { + tryCatch( + bsicons::bs_icon(icon), + error = function(e) rlang::abort(conditionMessage(e)) + ) + } + + if (display == "value_box") { + df <- executor$execute_query(query) + if (nrow(df) != 1) { + rlang::abort(sprintf( + "Value box query must return exactly 1 row. Got %d row(s).", + nrow(df) + )) + } + row <- as.list(df[1, , drop = FALSE]) + vb_cols <- c("value", "title", "text", "theme", "icon") + for (col in intersect(names(row), vb_cols)) { + val <- as.character(row[[col]]) + if (!is.na(val) && nzchar(val)) { + if (col %in% c("value", "text", "theme")) { + next + } + if (col == "icon") { + tryCatch( + bsicons::bs_icon(val), + error = function(e) { + rlang::abort(sprintf( + "Value box query returned invalid icon '%s': %s", + val, + conditionMessage(e) + )) + } + ) + } + } + } + } else if (display == "table") { + tryCatch( + executor$validate_query(query), + error = function(e) rlang::abort(conditionMessage(e)) + ) + } else if (display == "visualization") { + rlang::check_installed("ggsql", reason = "for visualization support.") + validated <- ggsql::ggsql_validate(query) + if (!ggsql::ggsql_has_visual(validated)) { + rlang::abort("Visualization query must include a VISUALISE clause.") + } + if (!isTRUE(validated$valid)) { + rlang::abort(collapse_validation_errors(validated)) + } + tryCatch( + execute_ggsql(executor, validated), + error = function(e) rlang::abort(conditionMessage(e)) + ) + } else if (display == "markdown" && !is.null(query)) { + df <- executor$execute_query(query) + if (nrow(df) != 1) { + rlang::abort(sprintf( + "Markdown interpolation query must return exactly 1 row. Got %d row(s).", + nrow(df) + )) + } + } + + list( + display = display, + title = title, + query = query, + text = text, + theme = theme, + icon = icon + ) +} + +card_tool_result <- function(value, title) { + ellmer::ContentToolResult( + value = jsonlite::toJSON(value, auto_unbox = TRUE), + extra = list( + display = list(title = title) + ) + ) +} + +# Generate a short (4 hex char) card id that does not collide with an existing +# card. Cards are few, so collisions are rare; the loop guarantees uniqueness. +new_card_id <- function(manage_card) { + existing <- map_chr(manage_card("get"), function(cd) cd$id) + repeat { + id <- random_hex(2) + if (!id %in% existing) { + return(id) + } + } +} + +# Present a stored card to the model: drop unset optional fields and order +# the remaining fields with `id` first. +card_public <- function(card) { + card <- compact(card) + ordered <- c( + "id", + "display", + "title", + "query", + "text", + "theme", + "icon" + ) + card[intersect(ordered, names(card))] +} + +# Encode a list of cards to a URL-safe payload string. +# Each card is passed through card_public(), serialized to JSON, compressed +# with gzip, base64-encoded, then made URL-safe (RFC 4648 §5 alphabet). +cards_to_payload <- function(cards) { + public_cards <- lapply(cards, card_public) + json <- jsonlite::toJSON(public_cards, auto_unbox = TRUE) + compressed <- memCompress(charToRaw(json), "gzip") + b64 <- jsonlite::base64_enc(compressed) + # base64_enc may insert newlines; strip all whitespace before conversion + b64 <- gsub("[[:space:]]", "", b64) + # Convert standard base64 to URL-safe base64: + -> -, / -> _, strip = padding + b64 <- gsub("+", "-", b64, fixed = TRUE) + b64 <- gsub("/", "_", b64, fixed = TRUE) + b64 <- gsub("=", "", b64, fixed = TRUE) + b64 +} + +# Decode a URL-safe payload string back to a list of card field-lists. +# Structural decode only — does not run query validation. +payload_to_cards <- function(payload) { + # Restore URL-safe base64 to standard base64 and re-add = padding + b64 <- gsub("-", "+", payload, fixed = TRUE) + b64 <- gsub("_", "/", b64, fixed = TRUE) + pad <- (4L - nchar(b64) %% 4L) %% 4L + b64 <- paste0(b64, strrep("=", pad)) + raw_bytes <- jsonlite::base64_dec(b64) + json <- rawToChar(memDecompress(raw_bytes, "gzip")) + jsonlite::fromJSON(json, simplifyVector = FALSE) +} + +card_icon <- function() { + '' +} + +# Normalize the `cards` constructor argument into a list of field-lists. +# Accepts NULL (returns NULL), a list (used as-is), or a character scalar +# (parsed as JSON or read from a file path). Performs light structural checks +# only — authoritative field/query validation happens later in mod_server() +# where the executor is available. +normalize_seed_cards <- function(cards) { + if (is.null(cards)) { + return(NULL) + } + + if (is.character(cards) && length(cards) == 1) { + json <- if (file.exists(cards)) read_utf8(cards) else cards + cards <- tryCatch( + jsonlite::fromJSON(json, simplifyVector = FALSE), + error = function(e) { + cli::cli_abort( + c( + "{.arg cards} could not be parsed as JSON.", + "x" = "{conditionMessage(e)}" + ), + call = NULL + ) + } + ) + } + + if (!is.list(cards)) { + cli::cli_abort( + "{.arg cards} must be a list, a JSON string, or a path to a JSON file.", + call = NULL + ) + } + + # Each element must be a named list (field-list for one card). + for (i in seq_along(cards)) { + if (!is.list(cards[[i]])) { + cli::cli_abort( + "Element {i} of {.arg cards} must be a named list of card fields, not {.obj_type_friendly cards[[i]]}.", + call = NULL + ) + } + } + + cards +} diff --git a/pkg-r/R/querychat_module.R b/pkg-r/R/querychat_module.R index 224b46fe..edc99ab6 100644 --- a/pkg-r/R/querychat_module.R +++ b/pkg-r/R/querychat_module.R @@ -35,6 +35,88 @@ mod_ui <- function( ) } +mod_ui_cards <- function(id, ...) { + ns <- shiny::NS(id) + htmltools::tagList( + htmltools::htmlDependency( + "querychat", + version = "0.0.1", + package = "querychat", + src = "htmldep", + script = "querychat.js", + stylesheet = "styles.css" + ), + viz_dep(), + shiny::uiOutput(ns("cards"), ...) + ) +} + +# Valid bookmark categories +BOOKMARK_CATEGORIES <- c("conversation", "cards") + +# Normalize the `bookmark_enable` argument to a character vector of +# categories. Accepts TRUE (all), FALSE/NULL (none), or a character subset of +# `BOOKMARK_CATEGORIES`. +normalize_bookmark_categories <- function(bookmark_enable) { + if (is.null(bookmark_enable) || length(bookmark_enable) == 0) { + return(character(0)) + } + if (is.logical(bookmark_enable)) { + if (length(bookmark_enable) != 1 || is.na(bookmark_enable)) { + cli::cli_abort( + "{.arg bookmark_enable} must be {.code TRUE}, {.code FALSE}, or a character vector of {.or {.val {BOOKMARK_CATEGORIES}}}." + ) + } + return(if (bookmark_enable) BOOKMARK_CATEGORIES else character(0)) + } + if (is.character(bookmark_enable)) { + return(rlang::arg_match( + bookmark_enable, + BOOKMARK_CATEGORIES, + multiple = TRUE + )) + } + cli::cli_abort( + "{.arg bookmark_enable} must be {.code TRUE}, {.code FALSE}, or a character vector of {.or {.val {BOOKMARK_CATEGORIES}}}." + ) +} + +# Resolve the Shiny bookmark store from the (possibly NULL) `bookmark_store` +# argument and the normalized bookmark categories. Returns one of "url", +# "server", "disable", or NULL. NULL means "defer to whatever the app author +# already set via shiny::enableBookmarking()" -- passing NULL to +# shiny::shinyApp(enableBookmarking=) makes Shiny latch that existing option. +# +# Only meaningful at the app level (the layer that owns the shinyApp() call); +# `$server()` never sets a store. +resolve_bookmark_store <- function(bookmark_store, bookmark_cats) { + # Nothing to save. + if (length(bookmark_cats) == 0) { + return("disable") + } + # The author chose a store explicitly. + if (!is.null(bookmark_store)) { + return(rlang::arg_match0(bookmark_store, c("url", "server", "disable"))) + } + # The author already called shiny::enableBookmarking(); defer to it. + if (!is.null(shiny::getShinyOption("bookmarkStore"))) { + return(NULL) + } + # The chat transcript is unbounded and overflows URL length limits, so a + # conversation bookmark needs server storage. + if ("conversation" %in% bookmark_cats) { + return("server") + } + # On a hosting platform, server storage is available and reliable. + hosted <- tolower(Sys.getenv("R_CONFIG_ACTIVE")) %in% + c("connect", "shinyapps", "rsconnect", "connect_cloud", "rstudio_cloud") + if (hosted) { + return("server") + } + # Cards-only, run locally: small payload that is shareable via the URL. + "url" +} + # Main module server function mod_server <- function( id, @@ -45,8 +127,11 @@ mod_server <- function( tools, greeter = NULL, greeting_base = NULL, - enable_bookmarking = FALSE + bookmark_enable = FALSE, + card_placeholder = "Insights will appear here", + seed_cards = NULL ) { + bookmark_cats <- normalize_bookmark_categories(bookmark_enable) shiny::moduleServer(id, function(input, output, session) { current_table_val <- shiny::reactiveVal(NULL, label = "current_table") # Holds a generated greeting so it can be saved and restored on bookmark. @@ -57,6 +142,53 @@ mod_server <- function( # onBookmark/onRestore can be dropped (and the shinychat minimum bumped). current_greeting <- shiny::reactiveVal(NULL, label = "current_greeting") + # Build the initial card list from seed_cards (author-supplied at $new() + # time). This is the INITIAL state only; the URL reader and onRestore both + # call cards(...) and will overwrite it when they fire. + initial_cards <- if (is.null(seed_cards)) { + list() + } else { + # Validate each seed card and assign unique ids within this batch. + # We can't use new_card_id() here because it reads from the live cards + # store (via manage_card), which doesn't exist yet. Instead, we track + # used ids ourselves and generate unique ones via random_hex(2). + used_ids <- character(0) + validated <- vector("list", length(seed_cards)) + for (i in seq_along(seed_cards)) { + card <- tryCatch( + validate_and_build_card(executor, seed_cards[[i]]), + error = function(e) { + cli::cli_abort( + "Seed card {i} is invalid: {conditionMessage(e)}", + call = NULL + ) + } + ) + # Prefer the card's own id if supplied and not already used; otherwise + # generate a fresh one. + preferred_id <- seed_cards[[i]][["id"]] + id <- if ( + !is.null(preferred_id) && + is.character(preferred_id) && + nzchar(preferred_id) && + !preferred_id %in% used_ids + ) { + preferred_id + } else { + repeat { + candidate <- random_hex(2) + if (!candidate %in% used_ids) break + } + candidate + } + used_ids <- c(used_ids, id) + card$id <- id + validated[[i]] <- card + } + validated + } + cards <- shiny::reactiveVal(initial_cards, label = "cards") + # Per-table reactive state tables <- list() for (name in names(data_sources)) { @@ -126,16 +258,95 @@ mod_server <- function( ) } + manage_card <- function(action, id = NULL, card = NULL) { + card_list <- shiny::isolate(cards()) + if (action == "get") { + if (is.null(id)) { + return(card_list) + } + idx <- which(map_lgl( + card_list, + function(cd) identical(cd$id, id) + )) + return(if (length(idx) > 0) card_list[[idx[[1]]]] else NULL) + } + if (action == "remove") { + card_list <- discard(card_list, function(cd) identical(cd$id, id)) + } else if (action == "replace") { + idx <- which(map_lgl(card_list, function(cd) identical(cd$id, id))) + if (length(idx) > 0) { + card_list[[idx[[1]]]] <- card + } else { + card_list <- c(card_list, list(card)) + } + } else { + card_list <- c(card_list, list(card)) + } + cards(card_list) + invisible(card_list) + } + # Set up the chat object for this session check_function(client) chat <- client( update_dashboard = update_dashboard, reset_dashboard = reset_query, visualize = on_visualize, + card = manage_card, tools = tools, session = session ) + # Seed cards from the `querychat_cards` query parameter if present. + # session$ns("querychat_cards") == paste0(module_id, "-querychat_cards"), + # which is the key written by $cards_url() / $cards_set_url(). + url_cards_seeded <- FALSE + local({ + qs <- shiny::isolate( + shiny::parseQueryString(session$clientData$url_search) + ) + key <- session$ns("querychat_cards") + raw <- qs[[key]] + if (!is.null(raw) && nzchar(raw)) { + decoded <- tryCatch( + payload_to_cards(raw), + error = function(e) { + cli::cli_warn( + c( + "Could not decode {.arg querychat_cards} URL parameter.", + "x" = conditionMessage(e) + ) + ) + NULL + } + ) + if (!is.null(decoded)) { + validated <- vector("list", length(decoded)) + n_valid <- 0L + for (i in seq_along(decoded)) { + tryCatch( + { + card <- validate_and_build_card(executor, decoded[[i]]) + card$id <- new_card_id(manage_card) + n_valid <- n_valid + 1L + validated[[n_valid]] <- card + }, + error = function(e) { + cli::cli_warn( + "Skipping URL card {i}: {conditionMessage(e)}", + .envir = parent.env(environment()) + ) + } + ) + } + if (n_valid > 0L) { + cards(validated[seq_len(n_valid)]) + url_cards_seeded <<- TRUE + } + } + } + }) + if (is.null(greeting)) { shiny::observeEvent( input$chat_greeting_requested, @@ -206,64 +417,137 @@ mod_server <- function( } }) - if (enable_bookmarking) { - shinychat::chat_restore( - "chat", - chat, - restore_ui = FALSE, - session = session - ) + output$cards <- shiny::renderUI({ + card_list <- cards() + if (length(card_list) == 0) { + if (is.null(card_placeholder)) { + return(NULL) + } + return(htmltools::div( + class = "querychat-cards-placeholder text-muted", + card_placeholder + )) + } + runs <- coalesce_card_runs(card_list) + blocks <- lapply(runs, function(run) { + is_vb <- identical(run$kind, "value_box") + uis <- lapply(run$cards, function(cd) { + render_card(cd, executor, session) + }) + if (is_vb) { + bslib::layout_column_wrap(width = "200px", !!!uis) + } else { + bslib::layout_column_wrap( + width = "400px", + heights_equal = "row", + !!!uis + ) + } + }) + htmltools::tagList(!!!blocks) + }) + + if (length(bookmark_cats) > 0) { shiny::setBookmarkExclude("chat_update", session = session) + bookmark_conversation <- "conversation" %in% bookmark_cats + bookmark_cards <- "cards" %in% bookmark_cats + + # Bookmark state keys. Shiny's module scope automatically namespaces these + # per module id (it writes `state$values[[ns(key)]]` on save and strips the + # prefix on restore), so multiple QueryChat instances do not collide and we + # must NOT pre-namespace with session$ns() (that double-prefixes the key). + key_tables <- "querychat_tables" + key_greeting <- "querychat_greeting" + key_viz_widgets <- "querychat_viz_widgets" + key_cards <- "querychat_cards" + + if (bookmark_conversation) { + # shinychat owns the transcript state and the bookmark trigger + # (observes chat input/response -> doBookmark) plus updateQueryString. + shinychat::chat_restore( + "chat", + chat, + restore_ui = FALSE, + session = session + ) + } else { + # Cards-only: drive the bookmark trigger ourselves when cards change, + # mirroring shinychat's onBookmarked -> updateQueryString. + shiny::observeEvent(cards(), ignoreInit = TRUE, { + session$doBookmark() + }) + shiny::withReactiveDomain( + session$rootScope(), + shiny::onBookmarked(function(url) { + shiny::updateQueryString(url) + }) + ) + } shiny::onBookmark(function(state) { - table_states <- list() - for (name in names(tables)) { - table_states[[name]] <- list( - sql = tables[[name]]$sql(), - title = tables[[name]]$title() - ) - } - state$values$querychat_tables <- table_states - if (!is.null(current_greeting())) { - state$values$querychat_greeting <- current_greeting() + if (bookmark_conversation) { + table_states <- list() + for (name in names(tables)) { + table_states[[name]] <- list( + sql = tables[[name]]$sql(), + title = tables[[name]]$title() + ) + } + state$values[[key_tables]] <- table_states + if (!is.null(current_greeting())) { + state$values[[key_greeting]] <- current_greeting() + } + if (length(viz_widgets) > 0) { + state$values[[key_viz_widgets]] <- viz_widgets + } } - if (length(viz_widgets) > 0) { - state$values$querychat_viz_widgets <- viz_widgets + if (bookmark_cards && length(cards()) > 0) { + state$values[[key_cards]] <- cards() } }) shiny::onRestore(function(state) { - if (!is.null(state$values$querychat_tables)) { - last_restored <- NULL - for (name in names(state$values$querychat_tables)) { - tbl_state <- state$values$querychat_tables[[name]] - if (!is.null(tbl_state$sql)) { - tables[[name]]$sql(tbl_state$sql) - last_restored <- name + if (bookmark_conversation) { + if (!is.null(state$values[[key_tables]])) { + last_restored <- NULL + for (name in names(state$values[[key_tables]])) { + tbl_state <- state$values[[key_tables]][[name]] + if (!is.null(tbl_state$sql)) { + tables[[name]]$sql(tbl_state$sql) + last_restored <- name + } + if (!is.null(tbl_state$title)) { + tables[[name]]$title(tbl_state$title) + } } - if (!is.null(tbl_state$title)) { - tables[[name]]$title(tbl_state$title) + if (!is.null(last_restored)) { + current_table_val(last_restored) } } - if (!is.null(last_restored)) { - current_table_val(last_restored) + if (!is.null(state$values[[key_greeting]])) { + current_greeting(state$values[[key_greeting]]) + shinychat::chat_set_greeting( + "chat", + chat_greeting_persistent(state$values[[key_greeting]]), + session = session + ) + } + if (!is.null(state$values[[key_viz_widgets]])) { + restored <- restore_viz_widgets( + executor, + restore_record_list(state$values[[key_viz_widgets]]), + session + ) + viz_widgets <<- restored } } - if (!is.null(state$values$querychat_greeting)) { - current_greeting(state$values$querychat_greeting) - shinychat::chat_set_greeting( - "chat", - chat_greeting_persistent(state$values$querychat_greeting), - session = session - ) - } - if (!is.null(state$values$querychat_viz_widgets)) { - restored <- restore_viz_widgets( - executor, - restore_record_list(state$values$querychat_viz_widgets), - session - ) - viz_widgets <<- restored + # URL param takes precedence: skip bookmark restore when URL seeded cards. + if ( + bookmark_cards && + !is.null(state$values[[key_cards]]) && + !isTRUE(url_cards_seeded) + ) { + cards(restore_record_list(state$values[[key_cards]])) } }) } @@ -288,6 +572,7 @@ mod_server <- function( sql = first$sql, title = first$title, df = first$df, + cards = cards, table = table_fn, table_names = table_names_fn, current_table = current_table_val, @@ -306,6 +591,7 @@ mod_server <- function( sql = single_table_error("sql"), title = single_table_error("title"), df = single_table_error("df"), + cards = cards, table = table_fn, table_names = table_names_fn, current_table = current_table_val, @@ -334,15 +620,34 @@ restore_record_list <- function(x) { if (is.data.frame(x)) { return(lapply(seq_len(nrow(x)), function(i) { row <- as.list(x[i, , drop = FALSE]) - row <- lapply(row, function(v) { + compact(lapply(row, function(v) { if (length(v) == 1 && is.na(v)) NULL else v - }) - row[!vapply(row, is.null, logical(1))] + })) })) } as.list(x) } +# Migrate legacy card field names from persisted state. Copies `caption` to +# `text` (for non-markdown cards) and `value` to `query` when the new field is +# absent, so bookmarked or server-restored cards created before the rename +# still render correctly. +migrate_card_fields <- function(card) { + if ( + !is.null(card$caption) && + is.null(card$text) && + !identical(card$display, "markdown") + ) { + card$text <- card$caption + } + card$caption <- NULL + if (!is.null(card$value) && is.null(card$query)) { + card$query <- card$value + } + card$value <- NULL + card +} + restore_viz_widgets <- function(executor, saved_widgets, session) { if (!rlang::is_installed("ggsql")) { warning( @@ -374,3 +679,223 @@ restore_viz_widgets <- function(executor, saved_widgets, session) { } restored } + +# Split a flat card list into consecutive runs of the same kind. +# Returns a list of run objects: list(kind = "value_box" | "content", cards = list(...)) +coalesce_card_runs <- function(card_list) { + if (length(card_list) == 0) { + return(list()) + } + kinds <- map_chr(card_list, function(cd) { + if (identical(cd$display, "value_box")) "value_box" else "content" + }) + runs <- list() + run_start <- 1L + for (i in seq_along(kinds)) { + if (i == length(kinds) || kinds[i + 1L] != kinds[i]) { + runs <- c( + runs, + list(list( + kind = kinds[i], + cards = card_list[run_start:i] + )) + ) + run_start <- i + 1L + } + } + runs +} + +card_header_with_icon <- function(title, icon) { + if (!is.null(icon)) { + bslib::card_header(bsicons::bs_icon(icon), title) + } else { + bslib::card_header(title) + } +} + +navset_title_with_icon <- function(title, icon) { + if (!is.null(icon)) { + htmltools::tagList(bsicons::bs_icon(icon), title) + } else { + title + } +} + +render_card <- function(card, executor, session) { + card <- migrate_card_fields(card) + tryCatch( + switch( + card$display %||% "markdown", + value_box = render_card_value_box(card, executor, session), + table = render_card_table(card, executor, session), + visualization = render_card_visualization(card, executor, session), + render_card_markdown(card, executor, session) + ), + error = function(e) render_card_error(card, conditionMessage(e)) + ) +} + +render_card_error <- function(card, message) { + bslib::card( + class = "border-danger", + card_header_with_icon(card$title, card$icon), + bslib::card_body(class = "text-danger", message) + ) +} + +render_card_value_box <- function(card, executor, session) { + col_or <- function(row, col_name, fallback) { + val <- row[[col_name]] + if (!is.null(val) && !is.na(val) && nzchar(as.character(val))) { + as.character(val) + } else { + fallback + } + } + + df <- executor$execute_query(card$query) + row <- as.list(df[1, , drop = FALSE]) + + scalar <- if ("value" %in% names(row)) { + as.character(row[["value"]]) + } else { + as.character(row[[1]]) + } + + effective_title <- col_or(row, "title", card$title) + effective_text <- col_or(row, "text", card$text) + effective_theme <- col_or(row, "theme", card$theme %||% "primary") + effective_icon <- col_or(row, "icon", card$icon) + + showcase <- if (!is.null(effective_icon) && nzchar(effective_icon)) { + bsicons::bs_icon(effective_icon) + } + subtitle_content <- if (!is.null(effective_text) && nzchar(effective_text)) { + shiny::p(effective_text) + } + + sql_viewer <- htmltools::div( + class = "querychat-vb-sql", + htmltools::p(class = "h5 mb-2 mt-4", "SQL Query"), + bslib::input_code_editor( + id = session$ns(paste0("querychat_card_code_", card$id)), + value = card$query, + language = "sql", + read_only = TRUE, + height = "200px" + ) + ) + + bslib::value_box( + title = effective_title, + value = scalar, + subtitle_content, + sql_viewer, + showcase = showcase, + theme = effective_theme, + full_screen = TRUE + ) +} + +render_card_table <- function(card, executor, session) { + rlang::check_installed("DT", reason = "for table cards.") + df <- executor$execute_query(card$query) + if (inherits(df, "tbl_sql")) { + df <- dplyr::collect(df) + } + content_panel <- DT::datatable( + df, + fillContainer = TRUE, + options = list(pageLength = 10, scrollX = TRUE) + ) + bslib::navset_card_underline( + title = navset_title_with_icon(card$title, card$icon), + full_screen = TRUE, + footer = if (!is.null(card$text)) bslib::card_footer(card$text), + bslib::nav_spacer(), + bslib::nav_panel( + bsicons::bs_icon("table"), + content_panel + ), + bslib::nav_panel( + bsicons::bs_icon("code-slash"), + bslib::input_code_editor( + id = session$ns(paste0("querychat_card_code_", card$id)), + value = card$query, + language = "sql", + read_only = TRUE, + height = "auto" + ) + ) + ) +} + +render_card_visualization <- function(card, executor, session) { + widget_id <- paste0("querychat_card_viz_", card$id) + validated <- ggsql::ggsql_validate(card$query) + spec <- execute_ggsql(executor, validated) + session$output[[widget_id]] <- ggsql::renderGgsql(spec) + content_panel <- htmltools::div( + class = "querychat-viz-container", + bslib::as_fill_carrier(), + ggsql::ggsqlOutput(session$ns(widget_id)) + ) + bslib::navset_card_underline( + title = navset_title_with_icon(card$title, card$icon), + full_screen = TRUE, + footer = if (!is.null(card$text)) bslib::card_footer(card$text), + bslib::nav_spacer(), + bslib::nav_panel( + bsicons::bs_icon("bar-chart-fill"), + content_panel + ), + bslib::nav_panel( + bsicons::bs_icon("code-slash"), + bslib::input_code_editor( + id = session$ns(paste0("querychat_card_code_", card$id)), + value = card$query, + language = "ggsql", + read_only = TRUE, + height = "auto" + ) + ) + ) +} + +render_card_markdown <- function(card, executor, session) { + rendered_text <- if (!is.null(card$query)) { + df <- executor$execute_query(card$query) + row <- as.list(df[1, , drop = FALSE]) + whisker::whisker.render(card$text, row) + } else { + card$text + } + + if (!is.null(card$query)) { + bslib::navset_card_underline( + title = navset_title_with_icon(card$title, card$icon), + full_screen = TRUE, + bslib::nav_spacer(), + bslib::nav_panel( + bsicons::bs_icon("file-text"), + bslib::card_body(shiny::markdown(rendered_text)) + ), + bslib::nav_panel( + bsicons::bs_icon("code-slash"), + bslib::input_code_editor( + id = session$ns(paste0("querychat_card_code_", card$id)), + value = card$query, + language = "sql", + read_only = TRUE, + height = "auto" + ) + ) + ) + } else { + bslib::card( + card_header_with_icon(card$title, card$icon), + bslib::card_body(shiny::markdown(rendered_text)) + ) + } +} diff --git a/pkg-r/R/utils-check.R b/pkg-r/R/utils-check.R index 966df62d..6ac9c548 100644 --- a/pkg-r/R/utils-check.R +++ b/pkg-r/R/utils-check.R @@ -12,6 +12,20 @@ check_data_source <- function( } } +check_query_executor <- function( + x, + ..., + arg = caller_arg(x), + call = caller_env() +) { + if (!inherits(x, "QueryExecutor")) { + cli::cli_abort( + "{.arg {arg}} must be a {.cls QueryExecutor} object, not {.obj_type_friendly {x}}.", + call = call + ) + } +} + # SQL table name validation ---------------------------------------------- #' Check SQL table name validity diff --git a/pkg-r/inst/examples-shiny/11-cards-app/app.R b/pkg-r/inst/examples-shiny/11-cards-app/app.R new file mode 100644 index 00000000..af067991 --- /dev/null +++ b/pkg-r/inst/examples-shiny/11-cards-app/app.R @@ -0,0 +1,27 @@ +library(shiny) +library(bslib) +library(querychat) +library(palmerpenguins) + +qc <- QueryChat$new( + penguins, + tools = c("update", "query", "visualize", "cards"), + data_description = paste( + "The Palmer Penguins dataset contains measurements of bill", + "dimensions, flipper length, body mass, sex, and species", + "(Adelie, Chinstrap, and Gentoo) collected from three islands in", + "the Palmer Archipelago, Antarctica." + ) +) + +ui <- page_sidebar( + title = "querychat cards demo", + sidebar = qc$sidebar(width = 400, open = TRUE, position = "right"), + qc$ui_cards() +) + +server <- function(input, output, session) { + qc$server() +} + +shinyApp(ui, server) diff --git a/pkg-r/inst/htmldep/styles.css b/pkg-r/inst/htmldep/styles.css index bd227030..f67a4af1 100644 --- a/pkg-r/inst/htmldep/styles.css +++ b/pkg-r/inst/htmldep/styles.css @@ -8,6 +8,11 @@ font-family: var(--bs-font-monospace); } +/* hide value box SQL viewer unless the card is in full-screen mode */ +.bslib-card[data-full-screen="false"] .querychat-vb-sql { + display: none; +} + /* querychat takes up the full sidebar, so move the collapse toggle out of the way */ .bslib-sidebar-layout:has(.querychat-sidebar):not(.sidebar-collapsed)>.collapse-toggle { right: 4px; diff --git a/pkg-r/inst/prompts/prompt.md b/pkg-r/inst/prompts/prompt.md index 87b6d686..6d99f623 100644 --- a/pkg-r/inst/prompts/prompt.md +++ b/pkg-r/inst/prompts/prompt.md @@ -201,6 +201,19 @@ Match the chart type to what the user is trying to understand: **Avoid redundant expanded results.** If you run a preparatory query before visualizing, or if both a table and chart would show the same data, always pass `collapsed=true` on the query so the user sees the chart prominently, not a duplicate table above it. The user can still expand the table if they want the exact values. {{/has_tool_query}} {{/has_tool_visualize}} +{{#has_tool_card}} +### Pinning Cards to the Dashboard + +The `querychat_card` tool pins persistent cards to the dashboard cards area, where they stay visible across queries. + +- **Proactively offer to save noteworthy insights.** Don't pin unprompted; offer as a clickable suggestion (see "Providing Suggestions for Next Steps"), e.g. `Pin the average body mass by species to the dashboard`. Offer at most one or two of the most valuable insights per turn, and never for routine lookups. Watch for these moments in particular: + - an ah-ha result: a surprising finding, a clear trend, a striking ranking, or a key headline metric; + - the user signaling interest: follow-up questions, circling back to a topic, or reactions like "interesting" or "I didn't expect that"; + - several related findings accumulating over a few exchanges that would read well together on the dashboard. +- Add a card when the user asks to pin, save, or add something to the dashboard, including when they accept one of your offers. +- Keep the dashboard current as the conversation moves on: edit a card when the user refines a question, and remove cards that are no longer relevant. + +{{/has_tool_card}} {{^has_tool_visualize}} ### Visualization Requests @@ -252,6 +265,14 @@ Use explicit HTML ` {{/has_tool_visualize}} +{{#has_tool_card}} +##### Pin to dashboard + + +{{/has_tool_card}} ##### Filter and sort