Skip to content

Commit 13296ac

Browse files
gadenbuiegadenbuie
authored
chore: air format (#39)
1 parent 5f1cc93 commit 13296ac

File tree

3 files changed

+165
-102
lines changed

3 files changed

+165
-102
lines changed

‎R/chat.R‎

Lines changed: 112 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -38,18 +38,18 @@ chat_deps <- function() {
3838
#' @param ... Extra HTML attributes to include on the chat element
3939
#' @param messages A list of messages to prepopulate the chat with. Each
4040
#' message can be one of the following:
41-
#'
42-
#' * A string, which is interpreted as markdown and rendered to HTML on
41+
#'
42+
#' * A string, which is interpreted as markdown and rendered to HTML on
4343
#' the client.
44-
#' * To prevent interpreting as markdown, mark the string as
44+
#' * To prevent interpreting as markdown, mark the string as
4545
#' [htmltools::HTML()].
4646
#' * A UI element.
47-
#' * This includes [htmltools::tagList()], which take UI elements
48-
#' (including strings) as children. In this case, strings are still
47+
#' * This includes [htmltools::tagList()], which take UI elements
48+
#' (including strings) as children. In this case, strings are still
4949
#' interpreted as markdown as long as they're not inside HTML.
50-
#' * A named list of `content` and `role`. The `content` can contain content
50+
#' * A named list of `content` and `role`. The `content` can contain content
5151
#' as described above, and the `role` can be "assistant" or "user".
52-
#'
52+
#'
5353
#' @param placeholder The placeholder text for the chat's user input field
5454
#' @param width The CSS width of the chat element
5555
#' @param height The CSS height of the chat element
@@ -85,14 +85,14 @@ chat_deps <- function() {
8585
#'
8686
#' @export
8787
chat_ui <- function(
88-
id,
89-
...,
90-
messages = NULL,
91-
placeholder = "Enter a message...",
92-
width = "min(680px, 100%)",
93-
height = "auto",
94-
fill = TRUE) {
95-
88+
id,
89+
...,
90+
messages = NULL,
91+
placeholder = "Enter a message...",
92+
width = "min(680px, 100%)",
93+
height = "auto",
94+
fill = TRUE
95+
) {
9696
attrs <- rlang::list2(...)
9797
if (!all(nzchar(rlang::names2(attrs)))) {
9898
rlang::abort("All arguments in ... must be named.")
@@ -129,19 +129,25 @@ chat_ui <- function(
129129
)
130130
})
131131

132-
res <- tag("shiny-chat-container", rlang::list2(
133-
id = id,
134-
style = css(
135-
width = width,
136-
height = height
137-
),
138-
placeholder = placeholder,
139-
fill = if (isTRUE(fill)) NA else NULL,
140-
...,
141-
tag("shiny-chat-messages", message_tags),
142-
tag("shiny-chat-input", list(id=paste0(id, "_user_input"), placeholder=placeholder)),
143-
chat_deps()
144-
))
132+
res <- tag(
133+
"shiny-chat-container",
134+
rlang::list2(
135+
id = id,
136+
style = css(
137+
width = width,
138+
height = height
139+
),
140+
placeholder = placeholder,
141+
fill = if (isTRUE(fill)) NA else NULL,
142+
...,
143+
tag("shiny-chat-messages", message_tags),
144+
tag(
145+
"shiny-chat-input",
146+
list(id = paste0(id, "_user_input"), placeholder = placeholder)
147+
),
148+
chat_deps()
149+
)
150+
)
145151

146152
if (isTRUE(fill)) {
147153
res <- bslib::as_fill_carrier(res)
@@ -178,16 +184,16 @@ chat_ui <- function(
178184
#' @param id The ID of the chat element
179185
#' @param response The message or message stream to append to the chat element.
180186
#' The actual message content can one of the following:
181-
#'
182-
#' * A string, which is interpreted as markdown and rendered to HTML on
187+
#'
188+
#' * A string, which is interpreted as markdown and rendered to HTML on
183189
#' the client.
184-
#' * To prevent interpreting as markdown, mark the string as
190+
#' * To prevent interpreting as markdown, mark the string as
185191
#' [htmltools::HTML()].
186192
#' * A UI element.
187-
#' * This includes [htmltools::tagList()], which take UI elements
188-
#' (including strings) as children. In this case, strings are still
193+
#' * This includes [htmltools::tagList()], which take UI elements
194+
#' (including strings) as children. In this case, strings are still
189195
#' interpreted as markdown as long as they're not inside HTML.
190-
#'
196+
#'
191197
#' @param role The role of the message (either "assistant" or "user"). Defaults
192198
#' to "assistant".
193199
#' @param session The Shiny session object
@@ -236,10 +242,15 @@ chat_ui <- function(
236242
#' shinyApp(ui, server)
237243
#'
238244
#' @export
239-
chat_append <- function(id, response, role = c("assistant", "user"), session = getDefaultReactiveDomain()) {
245+
chat_append <- function(
246+
id,
247+
response,
248+
role = c("assistant", "user"),
249+
session = getDefaultReactiveDomain()
250+
) {
240251
check_active_session(session)
241252
role <- match.arg(role)
242-
253+
243254
stream <- as_generator(response)
244255
chat_append_stream(id, stream, role = role, session = session)
245256
}
@@ -313,7 +324,13 @@ chat_append <- function(id, response, role = c("assistant", "user"), session = g
313324
#' shinyApp(ui, server)
314325
#'
315326
#' @export
316-
chat_append_message <- function(id, msg, chunk = TRUE, operation = c("append", "replace"), session = getDefaultReactiveDomain()) {
327+
chat_append_message <- function(
328+
id,
329+
msg,
330+
chunk = TRUE,
331+
operation = c("append", "replace"),
332+
session = getDefaultReactiveDomain()
333+
) {
317334
check_active_session(session)
318335

319336
if (!is.list(msg)) {
@@ -341,7 +358,10 @@ chat_append_message <- function(id, msg, chunk = TRUE, operation = c("append", "
341358
}
342359

343360
content <- msg[["content"]]
344-
is_html <- inherits(content, c("shiny.tag", "shiny.tag.list", "html", "htmlwidget"))
361+
is_html <- inherits(
362+
content,
363+
c("shiny.tag", "shiny.tag.list", "html", "htmlwidget")
364+
)
345365
content_type <- if (is_html) "html" else "markdown"
346366

347367
operation <- match.arg(operation)
@@ -369,24 +389,35 @@ chat_append_message <- function(id, msg, chunk = TRUE, operation = c("append", "
369389
operation = operation
370390
)
371391

372-
session$sendCustomMessage("shinyChatMessage", list(
373-
id = resolve_id(id, session),
374-
handler = msg_type,
375-
obj = msg
376-
))
392+
session$sendCustomMessage(
393+
"shinyChatMessage",
394+
list(
395+
id = resolve_id(id, session),
396+
handler = msg_type,
397+
obj = msg
398+
)
399+
)
377400

378401
invisible(NULL)
379402
}
380403

381-
chat_append_stream <- function(id, stream, role = "assistant", session = getDefaultReactiveDomain()) {
404+
chat_append_stream <- function(
405+
id,
406+
stream,
407+
role = "assistant",
408+
session = getDefaultReactiveDomain()
409+
) {
382410
result <- chat_append_stream_impl(id, stream, role, session)
383411
# Handle erroneous result...
384412
promises::catch(result, function(reason) {
385413
chat_append_message(
386414
id,
387415
list(
388416
role = role,
389-
content = paste0("\n\n**An error occurred:** ", conditionMessage(reason))
417+
content = paste0(
418+
"\n\n**An error occurred:** ",
419+
conditionMessage(reason)
420+
)
390421
),
391422
chunk = "end",
392423
operation = "append",
@@ -404,19 +435,43 @@ chat_append_stream <- function(id, stream, role = "assistant", session = getDefa
404435
utils:::globalVariables(c("generator_env", "exits", "yield"))
405436

406437
chat_append_stream_impl <- NULL
407-
rlang::on_load(chat_append_stream_impl <- coro::async(function(id, stream, role = "assistant", session = shiny::getDefaultReactiveDomain()) {
408-
chat_append_message(id, list(role = role, content = ""), chunk = "start", session = session)
409-
for (msg in stream) {
410-
if (promises::is.promising(msg)) {
411-
msg <- await(msg)
412-
}
413-
if (coro::is_exhausted(msg)) {
414-
break
438+
rlang::on_load(
439+
chat_append_stream_impl <- coro::async(function(
440+
id,
441+
stream,
442+
role = "assistant",
443+
session = shiny::getDefaultReactiveDomain()
444+
) {
445+
chat_append_message(
446+
id,
447+
list(role = role, content = ""),
448+
chunk = "start",
449+
session = session
450+
)
451+
for (msg in stream) {
452+
if (promises::is.promising(msg)) {
453+
msg <- await(msg)
454+
}
455+
if (coro::is_exhausted(msg)) {
456+
break
457+
}
458+
chat_append_message(
459+
id,
460+
list(role = role, content = msg),
461+
chunk = TRUE,
462+
operation = "append",
463+
session = session
464+
)
415465
}
416-
chat_append_message(id, list(role = role, content = msg), chunk = TRUE, operation = "append", session = session)
417-
}
418-
chat_append_message(id, list(role = role, content = ""), chunk = "end", operation = "append", session = session)
419-
}))
466+
chat_append_message(
467+
id,
468+
list(role = role, content = ""),
469+
chunk = "end",
470+
operation = "append",
471+
session = session
472+
)
473+
})
474+
)
420475

421476

422477
#' Clear all messages from a chat control

‎R/markdown-stream.R‎

Lines changed: 52 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
21
markdown_stream_deps <- function() {
32
htmltools::htmlDependency(
43
"shinychat",
@@ -48,11 +47,10 @@ output_markdown_stream <- function(
4847
width = "min(680px, 100%)",
4948
height = "auto"
5049
) {
51-
5250
# `content` is most likely a string, so avoid overhead in that case
5351
# (it's also important that we *don't escape HTML* here).
5452
if (is.character(content)) {
55-
ui <- list(html = paste(content, collapse="\n"))
53+
ui <- list(html = paste(content, collapse = "\n"))
5654
} else {
5755
ui <- with_current_theme(htmltools::renderTags(content))
5856
}
@@ -136,7 +134,12 @@ output_markdown_stream <- function(
136134
#' }
137135
#'
138136
#' shinyApp(ui, server)
139-
markdown_stream <- function(id, content_stream, operation = c("replace", "append"), session = getDefaultReactiveDomain()) {
137+
markdown_stream <- function(
138+
id,
139+
content_stream,
140+
operation = c("replace", "append"),
141+
session = getDefaultReactiveDomain()
142+
) {
140143
stream <- as_generator(content_stream)
141144

142145
operation <- match.arg(operation)
@@ -145,7 +148,11 @@ markdown_stream <- function(id, content_stream, operation = c("replace", "append
145148
# Handle erroneous result...
146149
promises::catch(result, function(reason) {
147150
shiny::showNotification(
148-
sprintf("Error in markdown_stream('%s'): %s", id, conditionMessage(reason)),
151+
sprintf(
152+
"Error in markdown_stream('%s'): %s",
153+
id,
154+
conditionMessage(reason)
155+
),
149156
type = "error",
150157
duration = NULL,
151158
closeButton = TRUE
@@ -161,50 +168,51 @@ markdown_stream <- function(id, content_stream, operation = c("replace", "append
161168

162169

163170
markdown_stream_impl <- NULL
164-
rlang::on_load(markdown_stream_impl <- coro::async(function(id, stream, operation, session) {
171+
rlang::on_load(
172+
markdown_stream_impl <- coro::async(function(id, stream, operation, session) {
173+
send_stream_message <- function(...) {
174+
session$sendCustomMessage(
175+
"shinyMarkdownStreamMessage",
176+
rlang::list2(id = id, ...)
177+
)
178+
}
165179

166-
send_stream_message <- function(...) {
167-
session$sendCustomMessage(
168-
"shinyMarkdownStreamMessage",
169-
rlang::list2(id = id, ...)
170-
)
171-
}
180+
if (operation == "replace") {
181+
send_stream_message(content = "", operation = "replace")
182+
}
172183

173-
if (operation == "replace") {
174-
send_stream_message(content = "", operation = "replace")
175-
}
184+
send_stream_message(isStreaming = TRUE)
176185

177-
send_stream_message(isStreaming = TRUE)
186+
on.exit({
187+
send_stream_message(isStreaming = FALSE)
188+
})
178189

179-
on.exit({
180-
send_stream_message(isStreaming = FALSE)
181-
})
190+
for (msg in stream) {
191+
if (promises::is.promising(msg)) {
192+
msg <- await(msg)
193+
}
194+
if (coro::is_exhausted(msg)) {
195+
break
196+
}
182197

183-
for (msg in stream) {
184-
if (promises::is.promising(msg)) {
185-
msg <- await(msg)
186-
}
187-
if (coro::is_exhausted(msg)) {
188-
break
189-
}
198+
if (is.character(msg)) {
199+
# content is most likely a string, so avoid overhead in that case
200+
ui <- list(html = msg, deps = "[]")
201+
} else {
202+
# process_ui() does *not* render markdown->HTML, but it does:
203+
# 1. Extract and register HTMLdependency()s with the session.
204+
# 2. Returns a HTML string representation of the TagChild
205+
# (i.e., `div()` -> `"<div>"`).
206+
ui <- process_ui(msg, session)
207+
}
190208

191-
if (is.character(msg)) {
192-
# content is most likely a string, so avoid overhead in that case
193-
ui <- list(html = msg, deps = "[]")
194-
} else {
195-
# process_ui() does *not* render markdown->HTML, but it does:
196-
# 1. Extract and register HTMLdependency()s with the session.
197-
# 2. Returns a HTML string representation of the TagChild
198-
# (i.e., `div()` -> `"<div>"`).
199-
ui <- process_ui(msg, session)
209+
send_stream_message(
210+
content = ui[["html"]],
211+
operation = "append",
212+
html_deps = ui[["deps"]]
213+
)
200214
}
201-
202-
send_stream_message(
203-
content = ui[["html"]],
204-
operation = "append",
205-
html_deps = ui[["deps"]]
206-
)
207-
}
208215

209-
invisible(NULL)
210-
}))
216+
invisible(NULL)
217+
})
218+
)

‎tests/testthat/helper-tags.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,4 +11,4 @@ render_tags <- function(ui) {
1111
deps = jsonlite::toJSON(deps, auto_unbox = TRUE),
1212
html = res$html
1313
)
14-
}
14+
}

0 commit comments

Comments
 (0)