Skip to content

Commit 6a306e6

Browse files
schloerkecpsievert
andauthored
feat: Add chat_enable_bookmarking(id, client, ..., update_on_input = TRUE, update_on_response = TRUE) (#28)
Co-authored-by: Carson Sievert <[email protected]>
1 parent 342bc5c commit 6a306e6

16 files changed

+471
-8
lines changed

.gitignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,3 +11,4 @@ uv.lock
1111
.coverage
1212
README.html
1313
README_files
14+
shiny_bookmarks

pkg-r/.Rbuildignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,4 +10,6 @@
1010
^_dev$
1111
^cran-comments\.md$
1212
^CRAN-SUBMISSION$
13+
^_dev$
1314
^revdep$
15+
^shiny_bookmarks$

pkg-r/DESCRIPTION

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@ Authors@R: c(
66
person("Carson", "Sievert", , "[email protected]", role = "aut"),
77
person("Garrick", "Aden-Buie", , "[email protected]", role = c("aut", "cre"),
88
comment = c(ORCID = "0000-0002-7111-0077")),
9+
person("Barret", "Schloerke", , "[email protected]", role = "aut",
10+
comment = c(ORCID = "0000-0001-9986-114X")),
911
person("Posit Software, PBC", role = c("cph", "fnd"),
1012
comment = c(ROR = "03wc8by49"))
1113
)
@@ -18,18 +20,22 @@ URL: https://posit-dev.github.io/shinychat/r/,
1820
https://github.com/posit-dev/shinychat
1921
BugReports: https://github.com/posit-dev/shinychat/issues
2022
Imports:
23+
base64enc,
2124
bslib,
2225
coro,
23-
ellmer,
26+
ellmer (>= 0.2.0.9001),
2427
fastmap,
2528
htmltools,
2629
jsonlite,
2730
promises (>= 1.3.2),
2831
rlang,
32+
S7,
2933
shiny (>= 1.10.0)
3034
Suggests:
3135
later,
3236
testthat (>= 3.0.0)
37+
Remotes:
38+
tidyverse/ellmer#503
3339
Config/Needs/website: tidyverse/tidytemplate
3440
Config/testthat/edition: 3
3541
Encoding: UTF-8

pkg-r/NAMESPACE

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,14 @@ export(chat_app)
44
export(chat_append)
55
export(chat_append_message)
66
export(chat_clear)
7+
export(chat_enable_bookmarking)
78
export(chat_mod_server)
89
export(chat_mod_ui)
910
export(chat_ui)
1011
export(markdown_stream)
1112
export(output_markdown_stream)
13+
if (getRversion() < "4.3.0") importFrom("S7", "@")
14+
import(S7)
1215
import(rlang)
1316
importFrom(coro,async)
1417
importFrom(htmltools,HTML)

pkg-r/NEWS.md

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# shinychat (development version)
22

3+
## New features and improvements
4+
5+
* Added `chat_enable_bookmarking()` which adds Shiny bookmarking hooks to save and restore the `{ellmer}` chat client. (#28)
6+
37
# shinychat 0.2.0
48

59
## New features and improvements
@@ -10,7 +14,7 @@
1014

1115
* Added a new `chat_clear()` function to clear the chat of all messages. (#25)
1216

13-
* 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)
17+
* 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)
1418

1519
* The promise returned by `chat_append()` now resolves to the content streamed into the chat. (#49)
1620

pkg-r/R/chat.R

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ chat_deps <- function() {
6767
#'
6868
#' server <- function(input, output, session) {
6969
#' observeEvent(input$chat_user_input, {
70-
#' # In a real app, this would call out to a chat model or API,
70+
#' # In a real app, this would call out to a chat client or API,
7171
#' # perhaps using the 'ellmer' package.
7272
#' response <- paste0(
7373
#' "You said:\n\n",
@@ -76,6 +76,7 @@ chat_deps <- function() {
7676
#' "</blockquote>"
7777
#' )
7878
#' chat_append("chat", response)
79+
#' chat_append("chat", stream)
7980
#' })
8081
#' }
8182
#'
@@ -163,7 +164,7 @@ chat_ui <- function(
163164
#' `chat_async`, and `stream_async` methods, respectively).
164165
#'
165166
#' This function should be called from a Shiny app's server. It is generally
166-
#' used to append the model's response to the chat, while user messages are
167+
#' used to append the client's response to the chat, while user messages are
167168
#' added to the chat UI automatically by the front-end. You'd only need to use
168169
#' `chat_append(role="user")` if you are programmatically generating queries
169170
#' from the server and sending them on behalf of the user, and want them to be
@@ -333,7 +334,7 @@ chat_append_message <- function(
333334
check_active_session(session)
334335

335336
if (!is.list(msg)) {
336-
rlang::abort("msg must be a named list with 'role' and 'content' fields")
337+
rlang::abort("`msg` must be a named list with 'role' and 'content' fields")
337338
}
338339
if (!isTRUE(msg[["role"]] %in% c("user", "assistant"))) {
339340
warning("Invalid role argument; must be 'user' or 'assistant'")
@@ -407,6 +408,7 @@ chat_append_stream <- function(
407408
session = getDefaultReactiveDomain()
408409
) {
409410
result <- chat_append_stream_impl(id, stream, role, session)
411+
result <- chat_update_bookmark(id, result, session = session)
410412
# Handle erroneous result...
411413
result <- promises::catch(result, function(reason) {
412414
# ...but rethrow the error as a silent error, so the caller can also handle

pkg-r/R/chat_enable_bookmarking.R

Lines changed: 251 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,251 @@
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

Comments
 (0)