mirror of
https://github.com/rstudio/shiny.git
synced 2026-04-07 03:00:20 -04:00
Support same-tick execution for synchronous outputs
This commit is contained in:
Joe Cheng
152
R/render-plot.R
152
R/render-plot.R
@@ -97,16 +97,18 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
|
||||
# Don't invalidate when width/height changes.
|
||||
dims <- if (execOnResize) getDims() else isolate(getDims())
|
||||
pixelratio <- session$clientData$pixelratio %OR% 1
|
||||
p1 <- drawPlot(outputName, session, func, dims$width, dims$height, pixelratio, res)
|
||||
p1 <- promises::catch(p1, function(reason) {
|
||||
# Non-isolating read. A common reason for errors in plotting is because
|
||||
# the dimensions are too small. By taking a dependency on width/height,
|
||||
# we can try again if the plot output element changes size.
|
||||
getDims()
|
||||
hybrid_chain(
|
||||
drawPlot(outputName, session, func, dims$width, dims$height, pixelratio, res),
|
||||
catch = function(reason) {
|
||||
# Non-isolating read. A common reason for errors in plotting is because
|
||||
# the dimensions are too small. By taking a dependency on width/height,
|
||||
# we can try again if the plot output element changes size.
|
||||
getDims()
|
||||
|
||||
# Propagate the error
|
||||
stop(reason)
|
||||
})
|
||||
# Propagate the error
|
||||
stop(reason)
|
||||
}
|
||||
)
|
||||
})
|
||||
|
||||
# This function is the one that's returned from renderPlot(), and gets
|
||||
@@ -115,13 +117,14 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
|
||||
outputName <<- name
|
||||
session <<- shinysession
|
||||
|
||||
p1 <- drawReactive()
|
||||
p1 <- promises::then(p1, function(result) {
|
||||
dims <- getDims()
|
||||
pixelratio <- session$clientData$pixelratio %OR% 1
|
||||
resizeSavedPlot(name, shinysession, result, dims$width, dims$height, pixelratio, res)
|
||||
})
|
||||
p1
|
||||
hybrid_chain(
|
||||
drawReactive(),
|
||||
function(result) {
|
||||
dims <- getDims()
|
||||
pixelratio <- session$clientData$pixelratio %OR% 1
|
||||
resizeSavedPlot(name, shinysession, result, dims$width, dims$height, pixelratio, res)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
# If renderPlot isn't going to adapt to the height of the div, then the
|
||||
@@ -175,64 +178,69 @@ drawPlot <- function(name, session, func, width, height, pixelratio, res, ...) {
|
||||
domain <- createGraphicsDevicePromiseDomain(device)
|
||||
grDevices::dev.control(displaylist = "enable")
|
||||
|
||||
p1 <- promises::with_promise_domain(domain, {
|
||||
p2 <- promises::promise(~resolve(func()))
|
||||
p2 <- promises::then(p2, function(value, .visible) {
|
||||
if (.visible) {
|
||||
# A modified version of print.ggplot which returns the built ggplot object
|
||||
# as well as the gtable grob. This overrides the ggplot::print.ggplot
|
||||
# method, but only within the context of renderPlot. The reason this needs
|
||||
# to be a (pseudo) S3 method is so that, if an object has a class in
|
||||
# addition to ggplot, and there's a print method for that class, that we
|
||||
# won't override that method. https://github.com/rstudio/shiny/issues/841
|
||||
print.ggplot <- custom_print.ggplot
|
||||
hybrid_chain(
|
||||
hybrid_chain(
|
||||
promises::with_promise_domain(domain, {
|
||||
hybrid_chain(
|
||||
func(),
|
||||
function(value, .visible) {
|
||||
if (.visible) {
|
||||
# A modified version of print.ggplot which returns the built ggplot object
|
||||
# as well as the gtable grob. This overrides the ggplot::print.ggplot
|
||||
# method, but only within the context of renderPlot. The reason this needs
|
||||
# to be a (pseudo) S3 method is so that, if an object has a class in
|
||||
# addition to ggplot, and there's a print method for that class, that we
|
||||
# won't override that method. https://github.com/rstudio/shiny/issues/841
|
||||
print.ggplot <- custom_print.ggplot
|
||||
|
||||
# Use capture.output to squelch printing to the actual console; we
|
||||
# are only interested in plot output
|
||||
utils::capture.output({
|
||||
# This ..stacktraceon.. negates the ..stacktraceoff.. that wraps
|
||||
# the call to plotFunc. The value needs to be printed just in case
|
||||
# it's an object that requires printing to generate plot output,
|
||||
# similar to ggplot2. But for base graphics, it would already have
|
||||
# been rendered when func was called above, and the print should
|
||||
# have no effect.
|
||||
result <- ..stacktraceon..(print(value))
|
||||
# TODO jcheng 2017-04-11: Verify above ..stacktraceon..
|
||||
})
|
||||
result
|
||||
} else {
|
||||
# Not necessary, but I wanted to make it explicit
|
||||
NULL
|
||||
# Use capture.output to squelch printing to the actual console; we
|
||||
# are only interested in plot output
|
||||
utils::capture.output({
|
||||
# This ..stacktraceon.. negates the ..stacktraceoff.. that wraps
|
||||
# the call to plotFunc. The value needs to be printed just in case
|
||||
# it's an object that requires printing to generate plot output,
|
||||
# similar to ggplot2. But for base graphics, it would already have
|
||||
# been rendered when func was called above, and the print should
|
||||
# have no effect.
|
||||
result <- ..stacktraceon..(print(value))
|
||||
# TODO jcheng 2017-04-11: Verify above ..stacktraceon..
|
||||
})
|
||||
result
|
||||
} else {
|
||||
# Not necessary, but I wanted to make it explicit
|
||||
NULL
|
||||
}
|
||||
},
|
||||
function(value) {
|
||||
list(
|
||||
plotResult = value,
|
||||
recordedPlot = grDevices::recordPlot(),
|
||||
coordmap = getCoordmap(value, width, height, pixelratio, res),
|
||||
pixelratio = pixelratio,
|
||||
res = res
|
||||
)
|
||||
}
|
||||
)
|
||||
}),
|
||||
finally = function() {
|
||||
grDevices::dev.off(device)
|
||||
}
|
||||
})
|
||||
p2 <- promises::then(p2, function(value) {
|
||||
list(
|
||||
plotResult = value,
|
||||
recordedPlot = grDevices::recordPlot(),
|
||||
coordmap = getCoordmap(value, width, height, pixelratio, res),
|
||||
pixelratio = pixelratio,
|
||||
res = res
|
||||
)
|
||||
})
|
||||
p2
|
||||
})
|
||||
p1 <- promises::finally(p1, function() {
|
||||
grDevices::dev.off(device)
|
||||
})
|
||||
p1 <- promises::then(p1, function(result) {
|
||||
result$img <- dropNulls(list(
|
||||
src = session$fileUrl(name, outfile, contentType='image/png'),
|
||||
width = width,
|
||||
height = height,
|
||||
coordmap = result$coordmap,
|
||||
# Get coordmap error message if present
|
||||
error = attr(result$coordmap, "error", exact = TRUE)
|
||||
))
|
||||
result
|
||||
})
|
||||
p1 <- promises::finally(p1, function() {
|
||||
unlink(outfile)
|
||||
})
|
||||
),
|
||||
function(result) {
|
||||
result$img <- dropNulls(list(
|
||||
src = session$fileUrl(name, outfile, contentType='image/png'),
|
||||
width = width,
|
||||
height = height,
|
||||
coordmap = result$coordmap,
|
||||
# Get coordmap error message if present
|
||||
error = attr(result$coordmap, "error", exact = TRUE)
|
||||
))
|
||||
result
|
||||
},
|
||||
finally = function() {
|
||||
unlink(outfile)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
# A modified version of print.ggplot which returns the built ggplot object
|
||||
|
||||
104
R/shiny.R
104
R/shiny.R
@@ -1151,62 +1151,62 @@ ShinySession <- R6Class(
|
||||
|
||||
# This shinyCallingHandlers should maybe be at a higher level,
|
||||
# to include the $then/$catch calls below?
|
||||
p <- promises::promise(~resolve(shinyCallingHandlers(func())))
|
||||
|
||||
p <- promises::catch(p,
|
||||
function(cond) {
|
||||
if (inherits(cond, "shiny.custom.error")) {
|
||||
if (isTRUE(getOption("show.error.messages"))) printError(cond)
|
||||
structure(list(), class = "try-error", condition = cond)
|
||||
} else if (inherits(cond, "shiny.output.cancel")) {
|
||||
structure(list(), class = "cancel-output")
|
||||
} else if (inherits(cond, "shiny.silent.error")) {
|
||||
# Don't let shiny.silent.error go through the normal stop
|
||||
# path of try, because we don't want it to print. But we
|
||||
# do want to try to return the same looking result so that
|
||||
# the code below can send the error to the browser.
|
||||
structure(list(), class = "try-error", condition = cond)
|
||||
} else {
|
||||
if (isTRUE(getOption("show.error.messages"))) printError(cond)
|
||||
if (getOption("shiny.sanitize.errors", FALSE)) {
|
||||
cond <- simpleError(paste("An error has occurred. Check your",
|
||||
"logs or contact the app author for",
|
||||
"clarification."))
|
||||
hybrid_chain(
|
||||
hybrid_chain(
|
||||
shinyCallingHandlers(func()),
|
||||
catch = function(cond) {
|
||||
if (inherits(cond, "shiny.custom.error")) {
|
||||
if (isTRUE(getOption("show.error.messages"))) printError(cond)
|
||||
structure(list(), class = "try-error", condition = cond)
|
||||
} else if (inherits(cond, "shiny.output.cancel")) {
|
||||
structure(list(), class = "cancel-output")
|
||||
} else if (inherits(cond, "shiny.silent.error")) {
|
||||
# Don't let shiny.silent.error go through the normal stop
|
||||
# path of try, because we don't want it to print. But we
|
||||
# do want to try to return the same looking result so that
|
||||
# the code below can send the error to the browser.
|
||||
structure(list(), class = "try-error", condition = cond)
|
||||
} else {
|
||||
if (isTRUE(getOption("show.error.messages"))) printError(cond)
|
||||
if (getOption("shiny.sanitize.errors", FALSE)) {
|
||||
cond <- simpleError(paste("An error has occurred. Check your",
|
||||
"logs or contact the app author for",
|
||||
"clarification."))
|
||||
}
|
||||
invisible(structure(list(), class = "try-error", condition = cond))
|
||||
}
|
||||
invisible(structure(list(), class = "try-error", condition = cond))
|
||||
}
|
||||
),
|
||||
function(value) {
|
||||
# Needed so that Shiny knows to flush the outputs. Even if no
|
||||
# outputs/errors are queued, it's necessary to flush so that the
|
||||
# client knows that progress is over.
|
||||
self$requestFlush()
|
||||
|
||||
private$sendMessage(recalculating = list(
|
||||
name = name, status = 'recalculated'
|
||||
))
|
||||
|
||||
if (inherits(value, "cancel-output")) {
|
||||
return()
|
||||
}
|
||||
|
||||
private$invalidatedOutputErrors$remove(name)
|
||||
private$invalidatedOutputValues$remove(name)
|
||||
|
||||
if (inherits(value, 'try-error')) {
|
||||
cond <- attr(value, 'condition')
|
||||
type <- setdiff(class(cond), c('simpleError', 'error', 'condition'))
|
||||
private$invalidatedOutputErrors$set(
|
||||
name,
|
||||
list(message = cond$message,
|
||||
call = utils::capture.output(print(cond$call)),
|
||||
type = if (length(type)) type))
|
||||
}
|
||||
else
|
||||
private$invalidatedOutputValues$set(name, value)
|
||||
}
|
||||
)
|
||||
|
||||
p <- promises::then(p, function(value) {
|
||||
# Needed so that Shiny knows to flush the outputs. Even if no
|
||||
# outputs/errors are queued, it's necessary to flush so that the
|
||||
# client knows that progress is over.
|
||||
self$requestFlush()
|
||||
|
||||
private$sendMessage(recalculating = list(
|
||||
name = name, status = 'recalculated'
|
||||
))
|
||||
|
||||
if (inherits(value, "cancel-output")) {
|
||||
return()
|
||||
}
|
||||
|
||||
private$invalidatedOutputErrors$remove(name)
|
||||
private$invalidatedOutputValues$remove(name)
|
||||
|
||||
if (inherits(value, 'try-error')) {
|
||||
cond <- attr(value, 'condition')
|
||||
type <- setdiff(class(cond), c('simpleError', 'error', 'condition'))
|
||||
private$invalidatedOutputErrors$set(
|
||||
name,
|
||||
list(message = cond$message,
|
||||
call = utils::capture.output(print(cond$call)),
|
||||
type = if (length(type)) type))
|
||||
}
|
||||
else
|
||||
private$invalidatedOutputValues$set(name, value)
|
||||
})
|
||||
}, suspended=private$shouldSuspend(name), label=label)
|
||||
|
||||
# If any output attributes were added to the render function attach
|
||||
|
||||
@@ -81,14 +81,12 @@ createRenderFunction <- function(
|
||||
) {
|
||||
|
||||
renderFunc <- function(shinysession, name, ...) {
|
||||
res <- func()
|
||||
if (promises::is.promise(res)) {
|
||||
return(promises::then(res, function(value) {
|
||||
transform(value, shinysession, name, ...)
|
||||
}))
|
||||
} else {
|
||||
return(transform(res, shinysession, name, ...))
|
||||
}
|
||||
hybrid_chain(
|
||||
func(),
|
||||
function(value, .visible) {
|
||||
transform(setVisible(value, .visible), shinysession, name, ...)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
if (!is.null(outputFunc))
|
||||
|
||||
@@ -6,10 +6,11 @@
|
||||
- [ ] options(shiny.error) should work in promise handlers
|
||||
|
||||
## Render functions
|
||||
- [ ] Non-async render functions should have their code all execute on the current tick. Otherwise order of execution will be surprising if they have side effects and explicit priorities.
|
||||
- [ ] promises::resolved(logic()) should use the current reactive domain to wrap the call to logic()
|
||||
- [x] Non-async render functions should have their code all execute on the current tick. Otherwise order of execution will be surprising if they have side effects and explicit priorities.
|
||||
- [x] Promise domains should maybe have an onExecute, for the "sync" part that kicks off async operations to also have wrapping behavior (like capturing output). Right now, I have to start off renderPrint with promise(~resolve(TRUE)) and then execute the user code in a then(), just to get the promise behavior. Same will be true when we tackle error handling (stack trace capture).
|
||||
- [x] invisible() doesn't seem to be working correctly with renderPrint. .visible doesn't survive promise chaining, e.g. promise(~resolve(promise(~resolve(invisible("Hi"))))) %>% then(function(x, .visible) { cat(.visible) }) will print TRUE, not FALSE.
|
||||
- [ ] renderDataTable should support async
|
||||
- [ ] App that tests that all built-in render functions support async
|
||||
|
||||
## Flush lifecycle
|
||||
- [x] While async operations are running in a session, hold off on any further processing of inputs and scheduled task items until all operations are complete.
|
||||
|
||||
Reference in New Issue
Block a user