|
| 1 | +#' Add Shiny bookmarking for shinychat |
| 2 | +#' |
| 3 | +#' @description |
| 4 | +#' Adds Shiny bookmarking hooks to save and restore the \pkg{ellmer} chat `client`. |
| 5 | +#' |
| 6 | +#' If either `bookmark_on_input` or `bookmark_on_response` is `TRUE`, the Shiny |
| 7 | +#' App's bookmark will be automatically updated without showing a modal to the |
| 8 | +#' user. |
| 9 | +#' |
| 10 | +#' Note: Only the `client`'s chat state is saved/restored in the bookmark. If |
| 11 | +#' the `client`'s state doesn't properly capture the chat's UI (i.e., a |
| 12 | +#' transformation is applied in-between receiving and displaying the message), |
| 13 | +#' then you may need to implement your own `session$onRestore()` (and possibly |
| 14 | +#' `session$onBookmark`) handler to restore any additional state. |
| 15 | +#' |
| 16 | +#' @param id The ID of the chat element |
| 17 | +#' @param client The \pkg{ellmer} LLM chat client. |
| 18 | +#' @param ... Used for future parameter expansion. |
| 19 | +#' @param bookmark_on_input A logical value determines if the bookmark should be updated when the user submits a message. Default is `TRUE`. |
| 20 | +#' @param bookmark_on_response A logical value determines if the bookmark should be updated when the response stream completes. Default is `TRUE`. |
| 21 | +#' @param session The Shiny session object |
| 22 | +#' @returns Returns nothing (\code{invisible(NULL)}). |
| 23 | +#' |
| 24 | +#' @examplesIf interactive() |
| 25 | +#' library(shiny) |
| 26 | +#' library(bslib) |
| 27 | +#' library(shinychat) |
| 28 | +#' |
| 29 | +#' ui <- function(request) { |
| 30 | +#' page_fillable( |
| 31 | +#' chat_ui("chat", fill = TRUE) |
| 32 | +#' ) |
| 33 | +#' } |
| 34 | +#' |
| 35 | +#' server <- function(input, output, session) { |
| 36 | +#' chat_client <- ellmer::chat_ollama( |
| 37 | +#' system_prompt = "Important: Always respond in a limerick", |
| 38 | +#' model = "qwen2.5-coder:1.5b", |
| 39 | +#' echo = TRUE |
| 40 | +#' ) |
| 41 | +#' # Update bookmark to chat on user submission and completed response |
| 42 | +#' chat_enable_bookmarking("chat", chat_client) |
| 43 | +#' |
| 44 | +#' observeEvent(input$chat_user_input, { |
| 45 | +#' stream <- chat_client$stream_async(input$chat_user_input) |
| 46 | +#' chat_append("chat", stream) |
| 47 | +#' }) |
| 48 | +#' } |
| 49 | +#' |
| 50 | +#' # Enable bookmarking! |
| 51 | +#' shinyApp(ui, server, enableBookmarking = "server") |
| 52 | +#' @export |
| 53 | +chat_enable_bookmarking <- function( |
| 54 | + id, |
| 55 | + client, |
| 56 | + ..., |
| 57 | + bookmark_on_input = TRUE, |
| 58 | + bookmark_on_response = TRUE, |
| 59 | + session = getDefaultReactiveDomain() |
| 60 | +) { |
| 61 | + rlang::check_dots_empty() |
| 62 | + stopifnot(is.character(id) && length(id) == 1) |
| 63 | + |
| 64 | + rlang::check_installed("ellmer") |
| 65 | + if (!(inherits(client, "R6") && inherits(client, "Chat"))) { |
| 66 | + rlang::abort( |
| 67 | + "`client` must be an `ellmer::Chat()` object. If you would like to have {shinychat} support your own package, please submit a GitHub Issue at https://github.com/posit-dev/shinychat" |
| 68 | + ) |
| 69 | + } |
| 70 | + bookmark_on_input <- rlang::is_true(bookmark_on_input) |
| 71 | + bookmark_on_response <- rlang::is_true(bookmark_on_response) |
| 72 | + |
| 73 | + if (is.null(session)) { |
| 74 | + rlang::abort( |
| 75 | + "A `session` must be provided. Be sure to call `chat_enable_bookmarking()` where a session context is available." |
| 76 | + ) |
| 77 | + } |
| 78 | + |
| 79 | + # Verify bookmark store is not disabled. Bookmark options: "disable", "url", "server" |
| 80 | + bookmark_store <- shiny::getShinyOption("bookmarkStore", "disable") |
| 81 | + # TODO: Q - I feel this should be removed. Since we are only adding hooks, it doesn't matter if it's enabled or not. If the user diables chat, it would be very annoying to receive error messages for code they may not own. |
| 82 | + if (bookmark_store == "disable") { |
| 83 | + rlang::abort( |
| 84 | + paste0( |
| 85 | + "Error: Shiny bookmarking is not enabled. ", |
| 86 | + "Please enable bookmarking in your Shiny app either by calling ", |
| 87 | + "`shiny::enableBookmarking(\"server\")` or by setting the parameter in ", |
| 88 | + "`shiny::shinyApp(enableBookmarking = \"server\")`" |
| 89 | + ) |
| 90 | + ) |
| 91 | + } |
| 92 | + |
| 93 | + # Exclude works with bookmark names |
| 94 | + excluded_names <- session$getBookmarkExclude() |
| 95 | + id_user_input <- paste0(id, "_user_input") |
| 96 | + if (!(id_user_input %in% excluded_names)) { |
| 97 | + session$setBookmarkExclude(c(excluded_names, id_user_input)) |
| 98 | + } |
| 99 | + |
| 100 | + # Save |
| 101 | + cancel_on_bookmark_client <- |
| 102 | + session$onBookmark(function(state) { |
| 103 | + if (id %in% names(state$values)) { |
| 104 | + rlang::abort( |
| 105 | + paste0( |
| 106 | + "Bookmark value with id (`\"", |
| 107 | + id, |
| 108 | + "\"`)) already exists. Please remove it or use a different id." |
| 109 | + ) |
| 110 | + ) |
| 111 | + } |
| 112 | + |
| 113 | + client_state <- client_get_state(client) |
| 114 | + |
| 115 | + state$values[[id]] <- client_state |
| 116 | + }) |
| 117 | + |
| 118 | + # Restore |
| 119 | + cancel_on_restore_client <- |
| 120 | + session$onRestore(function(state) { |
| 121 | + client_state <- state$values[[id]] |
| 122 | + if (is.null(client_state)) return() |
| 123 | + |
| 124 | + client_set_state(client, client_state) |
| 125 | + |
| 126 | + # Set the UI |
| 127 | + chat_clear(id) |
| 128 | + client_set_ui(client, id = id) |
| 129 | + }) |
| 130 | + |
| 131 | + # Update URL |
| 132 | + cancel_bookmark_on_input <- |
| 133 | + if (bookmark_on_input) { |
| 134 | + shiny::observeEvent(session$input[[id_user_input]], { |
| 135 | + # On user submit |
| 136 | + session$doBookmark() |
| 137 | + }) |
| 138 | + } else { |
| 139 | + NULL |
| 140 | + } |
| 141 | + |
| 142 | + # Enable (or disable) session auto bookmarking if at least one chat wants it |
| 143 | + set_session_bookmark_on_response( |
| 144 | + session, |
| 145 | + id, |
| 146 | + enable = bookmark_on_response |
| 147 | + ) |
| 148 | + |
| 149 | + cancel_update_bookmark <- NULL |
| 150 | + if (bookmark_on_input || bookmark_on_response) { |
| 151 | + cancel_update_bookmark <- |
| 152 | + # Update the query string when bookmarked |
| 153 | + shiny::onBookmarked(function(url) { |
| 154 | + shiny::updateQueryString(url) |
| 155 | + }) |
| 156 | + } |
| 157 | + |
| 158 | + # Set callbacks to cancel if `chat_enable_bookmarking(id, client)` is called again with the same id |
| 159 | + # Only allow for bookmarks for each chat once. Last bookmark method would win if all values were to be computed. |
| 160 | + # Remove previous `on*()` methods under same hash (.. odd author behavior) |
| 161 | + previous_info <- get_session_chat_bookmark_info(session, id) |
| 162 | + if (!is.null(previous_info)) { |
| 163 | + for (cancel_session_registration in previous_info$callbacks_to_cancel) { |
| 164 | + try({ |
| 165 | + cancel_session_registration() |
| 166 | + }) |
| 167 | + } |
| 168 | + } |
| 169 | + |
| 170 | + # Store callbacks to cancel in case a new call to `chat_enable_bookmarking(id, client)` is called with the same id |
| 171 | + set_session_chat_bookmark_info( |
| 172 | + session, |
| 173 | + id, |
| 174 | + value = list( |
| 175 | + callbacks_to_cancel = c( |
| 176 | + cancel_on_bookmark_client, |
| 177 | + cancel_on_restore_client, |
| 178 | + cancel_bookmark_on_input, |
| 179 | + cancel_update_bookmark |
| 180 | + ) |
| 181 | + ) |
| 182 | + ) |
| 183 | + |
| 184 | + # Don't return anything, even by chance |
| 185 | + invisible(NULL) |
| 186 | +} |
| 187 | + |
| 188 | + |
| 189 | +# Method currently hooked into `chat_append_stream()` and `markdown_stream()` |
| 190 | +# When the incoming stream ends, possibly update the URL given the `id` |
| 191 | +chat_update_bookmark <- function( |
| 192 | + id, |
| 193 | + stream_promise, |
| 194 | + session = shiny::getDefaultReactiveDomain() |
| 195 | +) { |
| 196 | + if (!has_session_bookmark_on_response(session, id)) { |
| 197 | + # No auto bookmark set. Return early! |
| 198 | + return(stream_promise) |
| 199 | + } |
| 200 | + |
| 201 | + # Bookmark has been flagged for `id`. |
| 202 | + # When the stream ends, update the URL. |
| 203 | + prom <- |
| 204 | + promises::then(stream_promise, function(stream) { |
| 205 | + # Force a bookmark update when the stream ends! |
| 206 | + session$doBookmark() |
| 207 | + }) |
| 208 | + |
| 209 | + return(prom) |
| 210 | +} |
| 211 | + |
| 212 | + |
| 213 | +# These methods exist to set flags within the session. |
| 214 | +# These flags will determine if the session should be bookmarked when a response has completed. |
| 215 | +# `chat_update_bookmark()` will check if the flag is set and update the URL if it is. |
| 216 | +ON_RESPONSE_KEY <- ".bookmark-on-response" |
| 217 | +has_session_bookmark_on_response <- function(session, id) { |
| 218 | + has_session_chat_bookmark_info( |
| 219 | + session, |
| 220 | + paste0(id, ON_RESPONSE_KEY) |
| 221 | + ) |
| 222 | +} |
| 223 | +set_session_bookmark_on_response <- function(session, id, enable) { |
| 224 | + set_session_chat_bookmark_info( |
| 225 | + session, |
| 226 | + paste0(id, ON_RESPONSE_KEY), |
| 227 | + value = if (enable) TRUE else NULL |
| 228 | + ) |
| 229 | +} |
| 230 | + |
| 231 | + |
| 232 | +has_session_chat_bookmark_info <- function(session, id) { |
| 233 | + return(!is.null(get_session_chat_bookmark_info(session, id))) |
| 234 | +} |
| 235 | +get_session_chat_bookmark_info <- function(session, id) { |
| 236 | + if (is.null(session)) return(NULL) |
| 237 | + |
| 238 | + info <- session$userData$shinychat |
| 239 | + key <- session$ns(id) |
| 240 | + return(info[[key]]) |
| 241 | +} |
| 242 | +set_session_chat_bookmark_info <- function(session, id, value) { |
| 243 | + if (is.null(session)) return(NULL) |
| 244 | + |
| 245 | + if (is.null(session$userData$shinychat)) { |
| 246 | + session$userData$shinychat <- list() |
| 247 | + } |
| 248 | + session$userData$shinychat[[session$ns(id)]] <- value |
| 249 | + |
| 250 | + invisible(session) |
| 251 | +} |
0 commit comments