feat: Add chat_enable_bookmarking(id, client, ..., update_on_input = TRUE, update_on_response = TRUE)

.gitignore

@@ -11,3 +11,4 @@ uv.lock
 .coverage
 README.html
 README_files
+shiny_bookmarks

pkg-r/.Rbuildignore

@@ -10,4 +10,6 @@
 ^_dev$
 ^cran-comments\.md$
 ^CRAN-SUBMISSION$
+^_dev$
 ^revdep$
+^shiny_bookmarks$

pkg-r/DESCRIPTION

@@ -6,6 +6,8 @@ Authors@R: c(
     person("Carson", "Sievert", , "[email protected]", role = "aut"),
     person("Garrick", "Aden-Buie", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7111-0077")),
+    person("Barret", "Schloerke", , "[email protected]", role = "aut",
+           comment = c(ORCID = "0000-0001-9986-114X")),
     person("Posit Software, PBC", role = c("cph", "fnd"),
            comment = c(ROR = "03wc8by49"))
   )
@@ -18,18 +20,22 @@ URL: https://posit-dev.github.io/shinychat/r/,
     https://github.com/posit-dev/shinychat
 BugReports: https://github.com/posit-dev/shinychat/issues
 Imports:
+    base64enc,
     bslib,
     coro,
-    ellmer,
+    ellmer (>= 0.2.0.9001),
     fastmap,
     htmltools,
     jsonlite,
     promises (>= 1.3.2),
     rlang,
+    S7,
     shiny (>= 1.10.0)
 Suggests:
     later,
     testthat (>= 3.0.0)
+Remotes:
+    tidyverse/ellmer#503
 Config/Needs/website: tidyverse/tidytemplate
 Config/testthat/edition: 3
 Encoding: UTF-8

pkg-r/NAMESPACE

@@ -4,11 +4,14 @@ export(chat_app)
 export(chat_append)
 export(chat_append_message)
 export(chat_clear)
+export(chat_enable_bookmarking)
 export(chat_mod_server)
 export(chat_mod_ui)
 export(chat_ui)
 export(markdown_stream)
 export(output_markdown_stream)
+if (getRversion() < "4.3.0") importFrom("S7", "@")
+import(S7)
 import(rlang)
 importFrom(coro,async)
 importFrom(htmltools,HTML)

pkg-r/NEWS.md

@@ -1,5 +1,9 @@
 # shinychat (development version)
 
+## New features and improvements
+
+* Added `chat_enable_bookmarking()` which adds Shiny bookmarking hooks to save and restore the `{ellmer}` chat client. (#28)
+
 # shinychat 0.2.0
 
 ## New features and improvements
@@ -10,7 +14,7 @@
 
 * Added a new `chat_clear()` function to clear the chat of all messages. (#25)
 
-* Added `chat_app()`, `chat_mod_ui()` and `chat_mod_server()`. `chat_app()` takes an `ellmer::Chat` client and launches a simple Shiny app interface with the chat. `chat_mod_ui()` and `chat_mod_server()` replicate the interface as a Shiny module, for easily adding a simple chat interface connected to a specific `ellmer::Chat` client. (#36)
+* Added `chat_app()`, `chat_mod_ui()` and `chat_mod_server()`. `chat_app()` takes an `{ellmer}` chat client and launches a simple Shiny app interface with the chat. `chat_mod_ui()` and `chat_mod_server()` replicate the interface as a Shiny module, for easily adding a simple chat interface connected to a specific `{ellmer}` chat client. (#36)
 
 * The promise returned by `chat_append()` now resolves to the content streamed into the chat. (#49)
 

pkg-r/R/chat.R

@@ -67,7 +67,7 @@ chat_deps <- function() {
 #'
 #' server <- function(input, output, session) {
 #'   observeEvent(input$chat_user_input, {
-#'     # In a real app, this would call out to a chat model or API,
+#'     # In a real app, this would call out to a chat client or API,
 #'     # perhaps using the 'ellmer' package.
 #'     response <- paste0(
 #'       "You said:\n\n",
@@ -76,6 +76,7 @@ chat_deps <- function() {
 #'       "</blockquote>"
 #'     )
 #'     chat_append("chat", response)
+#'     chat_append("chat", stream)
 #'   })
 #' }
 #'
@@ -163,7 +164,7 @@ chat_ui <- function(
 #' `chat_async`, and `stream_async` methods, respectively).
 #'
 #' This function should be called from a Shiny app's server. It is generally
-#' used to append the model's response to the chat, while user messages are
+#' used to append the client's response to the chat, while user messages are
 #' added to the chat UI automatically by the front-end. You'd only need to use
 #' `chat_append(role="user")` if you are programmatically generating queries
 #' from the server and sending them on behalf of the user, and want them to be
@@ -333,7 +334,7 @@ chat_append_message <- function(
   check_active_session(session)
 
   if (!is.list(msg)) {
-    rlang::abort("msg must be a named list with 'role' and 'content' fields")
+    rlang::abort("`msg` must be a named list with 'role' and 'content' fields")
   }
   if (!isTRUE(msg[["role"]] %in% c("user", "assistant"))) {
     warning("Invalid role argument; must be 'user' or 'assistant'")
@@ -407,6 +408,7 @@ chat_append_stream <- function(
   session = getDefaultReactiveDomain()
 ) {
   result <- chat_append_stream_impl(id, stream, role, session)
+  result <- chat_update_bookmark(id, result, session = session)
   # Handle erroneous result...
   result <- promises::catch(result, function(reason) {
     # ...but rethrow the error as a silent error, so the caller can also handle

pkg-r/R/chat_enable_bookmarking.R

@@ -0,0 +1,251 @@
+#' Add Shiny bookmarking for shinychat
+#'
+#' @description
+#' Adds Shiny bookmarking hooks to save and restore the \pkg{ellmer} chat `client`.
+#'
+#' If either `bookmark_on_input` or `bookmark_on_response` is `TRUE`, the Shiny
+#' App's bookmark will be automatically updated without showing a modal to the
+#' user.
+#'
+#' Note: Only the `client`'s chat state is saved/restored in the bookmark. If
+#' the `client`'s state doesn't properly capture the chat's UI (i.e., a
+#' transformation is applied in-between receiving and displaying the message),
+#' then you may need to implement your own `session$onRestore()` (and possibly
+#' `session$onBookmark`) handler to restore any additional state.
+#'
+#' @param id The ID of the chat element
+#' @param client The \pkg{ellmer} LLM chat client.
+#' @param ... Used for future parameter expansion.
+#' @param bookmark_on_input A logical value determines if the bookmark should be updated when the user submits a message. Default is `TRUE`.
+#' @param bookmark_on_response A logical value determines if the bookmark should be updated when the response stream completes. Default is `TRUE`.
+#' @param session The Shiny session object
+#' @returns Returns nothing (\code{invisible(NULL)}).
+#'
+#' @examplesIf interactive()
+#' library(shiny)
+#' library(bslib)
+#' library(shinychat)
+#'
+#' ui <- function(request) {
+#'   page_fillable(
+#'     chat_ui("chat", fill = TRUE)
+#'   )
+#' }
+#'
+#' server <- function(input, output, session) {
+#'   chat_client <- ellmer::chat_ollama(
+#'     system_prompt = "Important: Always respond in a limerick",
+#'     model = "qwen2.5-coder:1.5b",
+#'     echo = TRUE
+#'   )
+#'   # Update bookmark to chat on user submission and completed response
+#'   chat_enable_bookmarking("chat", chat_client)
+#'
+#'   observeEvent(input$chat_user_input, {
+#'     stream <- chat_client$stream_async(input$chat_user_input)
+#'     chat_append("chat", stream)
+#'   })
+#' }
+#'
+#' # Enable bookmarking!
+#' shinyApp(ui, server, enableBookmarking = "server")
+#' @export
+chat_enable_bookmarking <- function(
+  id,
+  client,
+  ...,
+  bookmark_on_input = TRUE,
+  bookmark_on_response = TRUE,
+  session = getDefaultReactiveDomain()
+) {
+  rlang::check_dots_empty()
+  stopifnot(is.character(id) && length(id) == 1)
+
+  rlang::check_installed("ellmer")
+  if (!(inherits(client, "R6") && inherits(client, "Chat"))) {
+    rlang::abort(
+      "`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"
+    )
+  }
+  bookmark_on_input <- rlang::is_true(bookmark_on_input)
+  bookmark_on_response <- rlang::is_true(bookmark_on_response)
+
+  if (is.null(session)) {
+    rlang::abort(
+      "A `session` must be provided. Be sure to call `chat_enable_bookmarking()` where a session context is available."
+    )
+  }
+
+  # Verify bookmark store is not disabled. Bookmark options: "disable", "url", "server"
+  bookmark_store <- shiny::getShinyOption("bookmarkStore", "disable")
+  # 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.
+  if (bookmark_store == "disable") {
+    rlang::abort(
+      paste0(
+        "Error: Shiny bookmarking is not enabled. ",
+        "Please enable bookmarking in your Shiny app either by calling ",
+        "`shiny::enableBookmarking(\"server\")` or by setting the parameter in ",
+        "`shiny::shinyApp(enableBookmarking = \"server\")`"
+      )
+    )
+  }
+
+  # Exclude works with bookmark names
+  excluded_names <- session$getBookmarkExclude()
+  id_user_input <- paste0(id, "_user_input")
+  if (!(id_user_input %in% excluded_names)) {
+    session$setBookmarkExclude(c(excluded_names, id_user_input))
+  }
+
+  # Save
+  cancel_on_bookmark_client <-
+    session$onBookmark(function(state) {
+      if (id %in% names(state$values)) {
+        rlang::abort(
+          paste0(
+            "Bookmark value with id (`\"",
+            id,
+            "\"`)) already exists. Please remove it or use a different id."
+          )
+        )
+      }
+
+      client_state <- client_get_state(client)
+
+      state$values[[id]] <- client_state
+    })
+
+  # Restore
+  cancel_on_restore_client <-
+    session$onRestore(function(state) {
+      client_state <- state$values[[id]]
+      if (is.null(client_state)) return()
+
+      client_set_state(client, client_state)
+
+      # Set the UI
+      chat_clear(id)
+      client_set_ui(client, id = id)
+    })
+
+  # Update URL
+  cancel_bookmark_on_input <-
+    if (bookmark_on_input) {
+      shiny::observeEvent(session$input[[id_user_input]], {
+        # On user submit
+        session$doBookmark()
+      })
+    } else {
+      NULL
+    }
+
+  # Enable (or disable) session auto bookmarking if at least one chat wants it
+  set_session_bookmark_on_response(
+    session,
+    id,
+    enable = bookmark_on_response
+  )
+
+  cancel_update_bookmark <- NULL
+  if (bookmark_on_input || bookmark_on_response) {
+    cancel_update_bookmark <-
+      # Update the query string when bookmarked
+      shiny::onBookmarked(function(url) {
+        shiny::updateQueryString(url)
+      })
+  }
+
+  # Set callbacks to cancel if `chat_enable_bookmarking(id, client)` is called again with the same id
+  # Only allow for bookmarks for each chat once. Last bookmark method would win if all values were to be computed.
+  # Remove previous `on*()` methods under same hash (.. odd author behavior)
+  previous_info <- get_session_chat_bookmark_info(session, id)
+  if (!is.null(previous_info)) {
+    for (cancel_session_registration in previous_info$callbacks_to_cancel) {
+      try({
+        cancel_session_registration()
+      })
+    }
+  }
+
+  # Store callbacks to cancel in case a new call to `chat_enable_bookmarking(id, client)` is called with the same id
+  set_session_chat_bookmark_info(
+    session,
+    id,
+    value = list(
+      callbacks_to_cancel = c(
+        cancel_on_bookmark_client,
+        cancel_on_restore_client,
+        cancel_bookmark_on_input,
+        cancel_update_bookmark
+      )
+    )
+  )
+
+  # Don't return anything, even by chance
+  invisible(NULL)
+}
+
+
+# Method currently hooked into `chat_append_stream()` and `markdown_stream()`
+# When the incoming stream ends, possibly update the URL given the `id`
+chat_update_bookmark <- function(
+  id,
+  stream_promise,
+  session = shiny::getDefaultReactiveDomain()
+) {
+  if (!has_session_bookmark_on_response(session, id)) {
+    # No auto bookmark set. Return early!
+    return(stream_promise)
+  }
+
+  # Bookmark has been flagged for `id`.
+  # When the stream ends, update the URL.
+  prom <-
+    promises::then(stream_promise, function(stream) {
+      # Force a bookmark update when the stream ends!
+      session$doBookmark()
+    })
+
+  return(prom)
+}
+
+
+# These methods exist to set flags within the session.
+# These flags will determine if the session should be bookmarked when a response has completed.
+# `chat_update_bookmark()` will check if the flag is set and update the URL if it is.
+ON_RESPONSE_KEY <- ".bookmark-on-response"
+has_session_bookmark_on_response <- function(session, id) {
+  has_session_chat_bookmark_info(
+    session,
+    paste0(id, ON_RESPONSE_KEY)
+  )
+}
+set_session_bookmark_on_response <- function(session, id, enable) {
+  set_session_chat_bookmark_info(
+    session,
+    paste0(id, ON_RESPONSE_KEY),
+    value = if (enable) TRUE else NULL
+  )
+}
+
+
+has_session_chat_bookmark_info <- function(session, id) {
+  return(!is.null(get_session_chat_bookmark_info(session, id)))
+}
+get_session_chat_bookmark_info <- function(session, id) {
+  if (is.null(session)) return(NULL)
+
+  info <- session$userData$shinychat
+  key <- session$ns(id)
+  return(info[[key]])
+}
+set_session_chat_bookmark_info <- function(session, id, value) {
+  if (is.null(session)) return(NULL)
+
+  if (is.null(session$userData$shinychat)) {
+    session$userData$shinychat <- list()
+  }
+  session$userData$shinychat[[session$ns(id)]] <- value
+
+  invisible(session)
+}