diff --git a/pkg-r/NEWS.md b/pkg-r/NEWS.md index cf6d930f..2c5b3e82 100644 --- a/pkg-r/NEWS.md +++ b/pkg-r/NEWS.md @@ -8,6 +8,8 @@ * shinychat now shows tool call request and results in the UI, and the feature is enabled by default in `chat_app()` and the chat module (`chat_mod_server()`). When using `chat_append()` with `chat_ui()`, set `stream = "content"` when you call the `$stream_async()` method on the `ellmer::Chat` client to ensure tool calls are included in the chat stream output. Learn more in the [tool calling UI article](https://posit-dev.github.io/shinychat/r/articles/tool-ui.html). (#52) +* Added `chat_append(icon=...)` and `chat_ui(icon_assistant=...)` for customizing the icon that appears next to assistant responses. (#88) + ## Improvements * `chat_app()` now correctly restores the chat client state when refreshing the app, e.g. by reloading the page. (#71) diff --git a/pkg-r/R/chat.R b/pkg-r/R/chat.R index ae915dd3..44398422 100644 --- a/pkg-r/R/chat.R +++ b/pkg-r/R/chat.R @@ -54,6 +54,9 @@ chat_deps <- function() { #' @param fill Whether the chat element should try to vertically fill its #' container, if the container is #' [fillable](https://rstudio.github.io/bslib/articles/filling/index.html) +#' @param icon_assistant The icon to use for the assistant chat messages. +#' Can be HTML or a tag in the form of [htmltools::HTML()] or +#' [htmltools::tags()]. If `None`, a default robot icon is used. #' @returns A Shiny tag object, suitable for inclusion in a Shiny UI #' #' @examplesIf interactive() @@ -90,7 +93,8 @@ chat_ui <- function( placeholder = "Enter a message...", width = "min(680px, 100%)", height = "auto", - fill = TRUE + fill = TRUE, + icon_assistant = NULL ) { attrs <- rlang::list2(...) if (!all(nzchar(rlang::names2(attrs)))) { @@ -123,6 +127,7 @@ chat_ui <- function( tag_name, rlang::list2( content = ui[["html"]], + icon = if (!is.null(icon_assistant)) as.character(icon_assistant), ui[["dependencies"]], ) ) @@ -138,13 +143,19 @@ chat_ui <- function( ), placeholder = placeholder, fill = if (isTRUE(fill)) NA else NULL, + # Also include icon on the parent so that when messages are dynamically added, + # we know the default icon has changed + `icon-assistant` = if (!is.null(icon_assistant)) { + as.character(icon_assistant) + }, ..., tag("shiny-chat-messages", message_tags), tag( "shiny-chat-input", list(id = paste0(id, "_user_input"), placeholder = placeholder) ), - chat_deps() + chat_deps(), + htmltools::findDependencies(icon_assistant) ) ) @@ -195,6 +206,9 @@ chat_ui <- function( #' #' @param role The role of the message (either "assistant" or "user"). Defaults #' to "assistant". +#' @param icon An optional icon to display next to the message, currently only +#' used for assistant messages. The icon can be any HTML element (e.g., an +#' [htmltools::img()] tag) or a string of HTML. #' @param session The Shiny session object #' #' @returns Returns a promise that resolves to the contents of the stream, or an @@ -246,13 +260,14 @@ chat_append <- function( id, response, role = c("assistant", "user"), + icon = NULL, session = getDefaultReactiveDomain() ) { check_active_session(session) role <- match.arg(role) stream <- as_generator(response) - chat_append_stream(id, stream, role = role, session = session) + chat_append_stream(id, stream, role = role, icon = icon, session = session) } #' Low-level function to append a message to a chat control @@ -274,6 +289,9 @@ chat_append <- function( #' then the new content is appended to the existing message content. If #' `"replace"`, then the existing message content is replaced by the new #' content. Ignored if `chunk` is `FALSE`. +#' @param icon An optional icon to display next to the message, currently only +#' used for assistant messages. The icon can be any HTML element (e.g., +#' [htmltools::img()] tag) or a string of HTML. #' @param session The Shiny session object #' #' @returns Returns nothing (\code{invisible(NULL)}). @@ -329,6 +347,7 @@ chat_append_message <- function( msg, chunk = TRUE, operation = c("append", "replace"), + icon = NULL, session = getDefaultReactiveDomain() ) { check_active_session(session) @@ -405,6 +424,10 @@ chat_append_message <- function( operation = operation ) + if (!is.null(icon)) { + msg$icon <- as.character(icon) + } + session$sendCustomMessage( "shinyChatMessage", list( @@ -421,9 +444,10 @@ chat_append_stream <- function( id, stream, role = "assistant", + icon = NULL, session = getDefaultReactiveDomain() ) { - result <- chat_append_stream_impl(id, stream, role, session) + result <- chat_append_stream_impl(id, stream, role, icon, session) result <- chat_update_bookmark(id, result, session = session) # Handle erroneous result... result <- promises::catch(result, function(reason) { @@ -469,19 +493,21 @@ rlang::on_load( id, stream, role = "assistant", + icon = NULL, session = shiny::getDefaultReactiveDomain() ) { - chat_append_ <- function(content, chunk = TRUE) { + chat_append_ <- function(content, chunk = TRUE, ...) { chat_append_message( id, msg = list(role = role, content = content), operation = "append", chunk = chunk, - session = session + session = session, + ... ) } - chat_append_("", chunk = "start") + chat_append_("", chunk = "start", icon = icon) res <- fastmap::fastqueue(200) diff --git a/pkg-r/man/chat_append.Rd b/pkg-r/man/chat_append.Rd index 1c92eb56..0c51067e 100644 --- a/pkg-r/man/chat_append.Rd +++ b/pkg-r/man/chat_append.Rd @@ -8,6 +8,7 @@ chat_append( id, response, role = c("assistant", "user"), + icon = NULL, session = getDefaultReactiveDomain() ) } @@ -34,6 +35,10 @@ interpreted as markdown as long as they're not inside HTML. \item{role}{The role of the message (either "assistant" or "user"). Defaults to "assistant".} +\item{icon}{An optional icon to display next to the message, currently only +used for assistant messages. The icon can be any HTML element (e.g., an +\code{\link[htmltools:builder]{htmltools::img()}} tag) or a string of HTML.} + \item{session}{The Shiny session object} } \value{ diff --git a/pkg-r/man/chat_append_message.Rd b/pkg-r/man/chat_append_message.Rd index 27ebabd1..e55bd859 100644 --- a/pkg-r/man/chat_append_message.Rd +++ b/pkg-r/man/chat_append_message.Rd @@ -9,6 +9,7 @@ chat_append_message( msg, chunk = TRUE, operation = c("append", "replace"), + icon = NULL, session = getDefaultReactiveDomain() ) } @@ -31,6 +32,10 @@ then the new content is appended to the existing message content. If \code{"replace"}, then the existing message content is replaced by the new content. Ignored if \code{chunk} is \code{FALSE}.} +\item{icon}{An optional icon to display next to the message, currently only +used for assistant messages. The icon can be any HTML element (e.g., +\code{\link[htmltools:builder]{htmltools::img()}} tag) or a string of HTML.} + \item{session}{The Shiny session object} } \value{ diff --git a/pkg-r/man/chat_ui.Rd b/pkg-r/man/chat_ui.Rd index 0c28ef49..2ccf633f 100644 --- a/pkg-r/man/chat_ui.Rd +++ b/pkg-r/man/chat_ui.Rd @@ -11,7 +11,8 @@ chat_ui( placeholder = "Enter a message...", width = "min(680px, 100\%)", height = "auto", - fill = TRUE + fill = TRUE, + icon_assistant = NULL ) } \arguments{ @@ -47,6 +48,10 @@ as described above, and the \code{role} can be "assistant" or "user". \item{fill}{Whether the chat element should try to vertically fill its container, if the container is \href{https://rstudio.github.io/bslib/articles/filling/index.html}{fillable}} + +\item{icon_assistant}{The icon to use for the assistant chat messages. +Can be HTML or a tag in the form of \code{\link[htmltools:HTML]{htmltools::HTML()}} or +\code{\link[htmltools:builder]{htmltools::tags()}}. If \code{None}, a default robot icon is used.} } \value{ A Shiny tag object, suitable for inclusion in a Shiny UI diff --git a/pkg-r/tests/testthat/apps/icon/app.R b/pkg-r/tests/testthat/apps/icon/app.R new file mode 100644 index 00000000..cdbea499 --- /dev/null +++ b/pkg-r/tests/testthat/apps/icon/app.R @@ -0,0 +1,164 @@ +library(shiny) +library(bslib) +library(shinychat) +library(fontawesome) + +# Add resource path for images +addResourcePath("img", "img") + +ui <- page_fillable( + title = "Chat Icons", + + layout_columns( + # Default Bot ---- + div( + h2("Default Bot"), + chat_ui( + id = "chat_default", + messages = list( + list( + content = "Hello! I'm Default Bot. How can I help you today?", + role = "assistant" + ) + ), + icon_assistant = NULL # Uses default robot icon + ) + ), + + # Animal Bot ---- + div( + h2("Animal Bot"), + chat_ui( + id = "chat_animal", + messages = list("Hello! I'm Animal Bot. How can I help you today?"), + icon_assistant = fontawesome::fa("otter", title = "icon-otter") + ), + selectInput( + "animal", + "Animal", + choices = c("Otter", "Hippo", "Frog", "Dove"), + selected = "Otter" + ) + ), + + # SVG Bot ---- + div( + h2("SVG Bot"), + chat_ui( + id = "chat_svg", + messages = list("Hello! I'm SVG Bot. How can I help you today?"), + icon_assistant = HTML( + ' + + + + ' + ) + ) + ), + + # Image Bot ---- + div( + h2("Image Bot"), + chat_ui( + id = "chat_image", + messages = list("Hello! I'm Image Bot. How can I help you today?"), + icon_assistant = img( + src = "img/grace-hopper.jpg", + class = "icon-image grace-hopper" + ) + ), + selectInput( + "image", + "Image", + choices = c("Grace Hopper", "Shiny"), + selected = "Grace Hopper" + ) + ) + ) +) + +server <- function(input, output, session) { + # Default Bot ---- + observeEvent(input$chat_default_user_input, { + req(input$chat_default_user_input) + + # Simulate delay + Sys.sleep(1) + + chat_append( + "chat_default", + paste0("You said: ", input$chat_default_user_input) + ) + }) + + # Animal Bot ---- + observeEvent(input$chat_animal_user_input, { + req(input$chat_animal_user_input) + + # Simulate delay + Sys.sleep(1) + + animal <- tolower(input$animal) + + # Create icon based on selection + if (animal == "otter") { + # Use default icon (NULL) + icon <- NULL + } else { + icon_map <- list( + "hippo" = "hippo", + "frog" = "frog", + "dove" = "dove" + ) + + if (animal %in% names(icon_map)) { + icon <- fontawesome::fa( + icon_map[[animal]], + # fontawesome doesn't support `class` argument, so we use `title` + title = paste0("icon-", animal) + ) + } else { + icon <- NULL + } + } + + chat_append( + "chat_animal", + paste0(animal, " said: ", input$chat_animal_user_input), + icon = icon + ) + }) + + # SVG Bot ---- + observeEvent(input$chat_svg_user_input, { + req(input$chat_svg_user_input) + + chat_append( + "chat_svg", + paste0("You said: ", input$chat_svg_user_input) + ) + }) + + # Image Bot ---- + observeEvent(input$chat_image_user_input, { + req(input$chat_image_user_input) + + # Create icon based on selection + icon <- NULL + if (input$image == "Shiny") { + icon <- img( + src = "img/shiny.png", + class = "icon-image shiny" + ) + } + + chat_append( + "chat_image", + paste0("You said: ", input$chat_image_user_input), + icon = icon + ) + }) +} + +shinyApp(ui, server) diff --git a/pkg-r/tests/testthat/apps/icon/img/grace-hopper.jpg b/pkg-r/tests/testthat/apps/icon/img/grace-hopper.jpg new file mode 100644 index 00000000..b09e239a Binary files /dev/null and b/pkg-r/tests/testthat/apps/icon/img/grace-hopper.jpg differ diff --git a/pkg-r/tests/testthat/apps/icon/img/shiny.png b/pkg-r/tests/testthat/apps/icon/img/shiny.png new file mode 100644 index 00000000..d4f32399 Binary files /dev/null and b/pkg-r/tests/testthat/apps/icon/img/shiny.png differ