exprToFunction() and installExprFunction() support quosures (#3472)

Co-authored-by: Barret Schloerke <schloerke@gmail.com>
Co-authored-by: Winston Chang <winston@stdout.org>
Co-authored-by: Carson Sievert <cpsievert1@gmail.com>
Co-authored-by: Joe Cheng <joe@rstudio.com>
This commit is contained in:
Barret Schloerke
2021-08-02 22:09:19 -04:00
committed by GitHub
parent f01dc9f0fb
commit 1b3ed88bd1
41 changed files with 818 additions and 1048 deletions

View File

@@ -159,9 +159,9 @@ jobs:
if: github.event_name == 'push'
run: |
# Can't push to a protected branch
if [ -z "`git cherry`"]; then
if [ -z "`git cherry origin/master`"]; then
echo "Un-pushed commits:"
git cherry -v
git cherry -v origin/master
echo "\nCan not push to a protected branch. Exiting"
exit 1
fi

View File

@@ -273,7 +273,6 @@ export(stopApp)
export(strong)
export(submitButton)
export(suppressDependencies)
export(sustainEnvAndQuoted)
export(tabPanel)
export(tabPanelBody)
export(tableOutput)
@@ -399,6 +398,7 @@ importFrom(rlang,enquos)
importFrom(rlang,enquos0)
importFrom(rlang,eval_tidy)
importFrom(rlang,expr)
importFrom(rlang,fn_body)
importFrom(rlang,get_env)
importFrom(rlang,get_expr)
importFrom(rlang,inject)

View File

@@ -292,11 +292,11 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
#' In some cases, however, the automatic cache hint inference is not
#' sufficient, and it is necessary to provide a cache hint. This is true
#' for `renderPrint()`. Unlike `renderText()`, it wraps the user-provided
#' expression in another function, before passing it to [markRenderFunction()]
#' expression in another function, before passing it to [createRenderFunction()]
#' (instead of [createRenderFunction()]). Because the user code is wrapped in
#' another function, `markRenderFunction()` is not able to automatically
#' another function, `createRenderFunction()` is not able to automatically
#' extract the user-provided code and use it in the cache key. Instead,
#' `renderPrint` calls `markRenderFunction()`, it explicitly passes along a
#' `renderPrint` calls `createRenderFunction()`, it explicitly passes along a
#' `cacheHint`, which includes a label and the original user expression.
#'
#' In general, if you need to provide a `cacheHint`, it is best practice to
@@ -310,19 +310,19 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
#'
#' ```
#' renderMyWidget <- function(expr) {
#' expr <- substitute(expr)
#' q <- rlang::enquo0(expr)
#'
#' htmlwidgets::shinyRenderWidget(expr,
#' htmlwidgets::shinyRenderWidget(
#' q,
#' myWidgetOutput,
#' quoted = TRUE,
#' env = parent.frame(),
#' cacheHint = list(label = "myWidget", userExpr = expr)
#' cacheHint = list(label = "myWidget", userQuo = q)
#' )
#' }
#' ```
#'
#' If your `render` function sets any internal state, you may find it useful
#' in your call to [createRenderFunction()] or [markRenderFunction()] to use
#' in your call to [createRenderFunction()] to use
#' the `cacheWriteHook` and/or `cacheReadHook` parameters. These hooks are
#' functions that run just before the object is stored in the cache, and just
#' after the object is retrieved from the cache. They can modify the data
@@ -339,8 +339,8 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
#' effects or modify some external state, and they must re-execute each time
#' in order to work properly.
#'
#' For developers of such code, they should call [createRenderFunction()] or
#' [markRenderFunction()] with `cacheHint = FALSE`.
#' For developers of such code, they should call [createRenderFunction()] (or
#' [markRenderFunction()]) with `cacheHint = FALSE`.
#'
#'
#' @section Caching with `renderPlot()`:

View File

@@ -38,13 +38,20 @@ deprecatedEnvQuotedMessage <- function() {
if (!in_devmode()) return(invisible())
if (is_false(getOption("shiny.deprecation.messages"))) return(invisible())
# manually
# Capture calling function
grandparent_call <- sys.call(-2)
# Turn language into user friendly string
grandparent_txt <- paste0(utils::capture.output({grandparent_call}), collapse = "\n")
msg <- paste0(
"The `env` and `quoted` arguments are deprecated as of shiny 1.6.0.",
"The `env` and `quoted` arguments are deprecated as of shiny 1.7.0.",
" Please use quosures from `rlang` instead.\n",
"See <https://github.com/rstudio/shiny/issues/3108> for more information."
"See <https://github.com/rstudio/shiny/issues/3108> for more information.\n",
"Function call:\n",
grandparent_txt
)
rlang::inform(message = msg, .frequency = "always", .frequency_id = msg, .file = stderr())
# Call less often as users do not have much control over this warning
rlang::inform(message = msg, .frequency = "regularly", .frequency_id = msg, .file = stderr())
}

View File

@@ -512,7 +512,7 @@ MessageLogger = R6Class(
return(txt)
},
singleLine = function(txt) {
gsub("[^\\]\\n", "\\\\n", txt)
gsub("([^\\])\\n", "\\1\\\\n", txt)
},
valueStr = function(valueStr) {
paste0(

View File

@@ -20,7 +20,6 @@
#' `delay` milliseconds before sending an event.
#' @seealso [brushOpts()] for brushing events.
#' @export
#' @keywords internal
clickOpts <- function(id, clip = TRUE) {
if (is.null(id))
stop("id must not be NULL")

View File

@@ -4,6 +4,7 @@
#' themselves in knitr/rmarkdown documents.
#'
#' @name knitr_methods
#' @keywords internal
#' @param x Object to knit_print
#' @param ... Additional knit_print arguments
NULL

View File

@@ -875,8 +875,7 @@ Observable <- R6Class(
invisible(.value)
},
format = function() {
label <- sprintf('reactive(%s)', paste(deparse(body(.origFunc)), collapse='\n'))
strsplit(label, "\n")[[1]]
simpleExprToFunction(fn_body(.origFunc), "reactive")
},
.updateValue = function() {
ctx <- Context$new(.domain, .label, type = 'observable',
@@ -945,14 +944,15 @@ Observable <- R6Class(
#' See the [Shiny tutorial](https://shiny.rstudio.com/tutorial/) for
#' more information about reactive expressions.
#'
#' @param x TODO-barret docs; For `reactive`, an expression (quoted or unquoted). For
#' `is.reactive`, an object to test.
#' @param env TODO-barret docs; The parent environment for the reactive expression. By default,
#' this is the calling environment, the same as when defining an ordinary
#' non-reactive expression.
#' @param quoted TODO-barret docs; Is the expression quoted? By default, this is `FALSE`.
#' This is useful when you want to use an expression that is stored in a
#' variable; to do so, it must be quoted with `quote()`.
#' @param x For `is.reactive()`, an object to test. For `reactive()`, an expression. When passing in a [`quo()`]sure with `reactive()`, remember to use [`rlang::inject()`] to distinguish that you are passing in the content of your quosure, not the expression of the quosure.
#' @template param-env
#' @templateVar x x
#' @templateVar env env
#' @templateVar quoted quoted
#' @template param-quoted
#' @templateVar x x
#' @templateVar quoted quoted
#' @param label A label for the reactive expression, useful for debugging.
#' @param domain See [domains].
#' @param ..stacktraceon Advanced use only. For stack manipulation purposes; see
@@ -961,49 +961,56 @@ Observable <- R6Class(
#' @return a function, wrapped in a S3 class "reactive"
#'
#' @examples
#' # TODO-barret docs; with quosures, not env / quoted
#' library(rlang)
#' values <- reactiveValues(A=1)
#'
#' reactiveB <- reactive({
#' values$A + 1
#' })
#'
#' # Can use quoted expressions
#' reactiveC <- reactive(quote({ values$A + 2 }), quoted = TRUE)
#'
#' # To store expressions for later conversion to reactive, use quote()
#' expr_q <- quote({ values$A + 3 })
#' reactiveD <- reactive(expr_q, quoted = TRUE)
#'
#' # View the values from the R console with isolate()
#' isolate(reactiveB())
#' # 2
#'
#' # To store expressions for later conversion to reactive, use quote()
#' myquo <- rlang::quo(values$A + 2)
#' # Unexpected value! Sending a quosure directly will not work as expected.
#' reactiveC <- reactive(myquo)
#' # We'd hope for `3`, but instead we get the quosure that was supplied.
#' isolate(reactiveC())
#'
#' # Instead, the quosure should be `rlang::inject()`ed
#' reactiveD <- rlang::inject(reactive(!!myquo))
#' isolate(reactiveD())
#' # 3
#'
#' # (Legacy) Can use quoted expressions
#' expr <- quote({ values$A + 3 })
#' reactiveE <- reactive(expr, quoted = TRUE)
#' isolate(reactiveE())
#' # 4
#'
#' @export
reactive <- function(
x,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
...,
label = NULL,
domain = getDefaultReactiveDomain(),
..stacktraceon = TRUE)
{
..stacktraceon = TRUE
) {
check_dots_empty()
q <- enquo0(x)
q <- sustainEnvAndQuotedInternal(q, x, env, quoted)
fun <- quoToSimpleFunction(q)
func <- installExprFunction(x, "func", env, quoted, wrappedWithLabel = FALSE)
# Attach a label and a reference to the original user source for debugging
q_expr <- quo_get_expr(q)
label <- exprToLabel(q_expr, "reactive", label)
userExpr <- fn_body(func)
label <- exprToLabel(userExpr, "reactive", label)
o <- Observable$new(fun, label, domain, ..stacktraceon = ..stacktraceon)
o <- Observable$new(func, label, domain, ..stacktraceon = ..stacktraceon)
structure(
o$getValue,
observable = o,
cacheHint = list(userExpr = zap_srcref(q_expr)),
cacheHint = list(userExpr = zap_srcref(userExpr)),
class = c("reactiveExpr", "reactive", "function")
)
}
@@ -1328,12 +1335,7 @@ Observer <- R6Class(
#'
#' @param x An expression (quoted or unquoted). Any return value will be
#' ignored.
#' @param env TODO-barret docs; The parent environment for the reactive expression. By default,
#' this is the calling environment, the same as when defining an ordinary
#' non-reactive expression.
#' @param quoted TODO-barret docs; Is the expression quoted? By default, this is `FALSE`.
#' This is useful when you want to use an expression that is stored in a
#' variable; to do so, it must be quoted with `quote()`.
#' @inheritParams reactive
#' @param label A label for the observer, useful for debugging.
#' @param suspended If `TRUE`, start the observer in a suspended state. If
#' `FALSE` (the default), start in a non-suspended state.
@@ -1386,19 +1388,18 @@ Observer <- R6Class(
#' }
#'
#' @examples
#' # TODO-barret docs; examples are outdated
#' values <- reactiveValues(A=1)
#'
#' obsB <- observe({
#' print(values$A + 1)
#' })
#'
#' # Can use quoted expressions
#' obsC <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
#' # To store expressions for later conversion to observe, use rlang::quo()
#' myquo <- rlang::quo({ print(values$A + 3) })
#' obsC <- rlang::inject(observe(!!myquo))
#'
#' # To store expressions for later conversion to observe, use quote()
#' expr_q <- quote({ print(values$A + 3) })
#' obsD <- observe(expr_q, quoted = TRUE)
#' # (Legacy) Can use quoted expressions
#' obsD <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
#'
#' # In a normal Shiny app, the web client will trigger flush events. If you
#' # are at the console, you can force a flush with flushReact()
@@ -1406,8 +1407,8 @@ Observer <- R6Class(
#' @export
observe <- function(
x,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
...,
label = NULL,
suspended = FALSE,
@@ -1418,16 +1419,11 @@ observe <- function(
{
check_dots_empty()
q <- enquo0(x)
q <- sustainEnvAndQuotedInternal(q, x, env, quoted)
fun <- quoToSimpleFunction(q)
if (is.null(label)) {
label <- sprintf('observe(%s)', paste(deparse(quo_get_expr(q)), collapse='\n'))
}
func <- installExprFunction(x, "func", env, quoted)
label <- funcToLabel(func, "observe", label)
o <- Observer$new(
fun,
func,
label = label,
suspended = suspended,
priority = priority,
@@ -2149,23 +2145,30 @@ maskReactiveContext <- function(expr) {
#' @param valueExpr The expression that produces the return value of the
#' `eventReactive`. It will be executed within an [isolate()]
#' scope.
#' @param event.env The parent environment for `eventExpr`. By default,
#' this is the calling environment.
#' @param event.quoted TODO-barret docs; Is the `eventExpr` expression quoted? By default,
#' this is `FALSE`. This is useful when you want to use an expression
#' that is stored in a variable; to do so, it must be quoted with
#' `quote()`.
#' @param handler.env TODO-barret docs; The parent environment for `handlerExpr`. By default,
#' this is the calling environment.
#' @param handler.quoted TODO-barret docs; Is the `handlerExpr` expression quoted? By
#' default, this is `FALSE`. This is useful when you want to use an
#' expression that is stored in a variable; to do so, it must be quoted with
#' `quote()`.
#' @param value.env TODO-barret docs; The parent environment for `valueExpr`. By default,
#' this is the calling environment.
#' @param value.quoted Is the `valueExpr` expression quoted? By default,
#' this is `FALSE`. This is useful when you want to use an expression
#' that is stored in a variable; to do so, it must be quoted with `quote()`.
#' @param event.env The parent environment for the reactive expression. By default,
#' this is the calling environment, the same as when defining an ordinary
#' non-reactive expression. If `eventExpr` is a quosure and `event.quoted` is `TRUE`,
#' then `event.env` is ignored.
#' @param event.quoted If it is `TRUE`, then the [`quote()`]ed value of `eventExpr`
#' will be used when `eventExpr` is evaluated. If `eventExpr` is a quosure and you
#' would like to use its expression as a value for `eventExpr`, then you must set
#' `event.quoted` to `TRUE`.
#' @param handler.env The parent environment for the reactive expression. By default,
#' this is the calling environment, the same as when defining an ordinary
#' non-reactive expression. If `handlerExpr` is a quosure and `handler.quoted` is `TRUE`,
#' then `handler.env` is ignored.
#' @param handler.quoted If it is `TRUE`, then the [`quote()`]ed value of `handlerExpr`
#' will be used when `handlerExpr` is evaluated. If `handlerExpr` is a quosure and you
#' would like to use its expression as a value for `handlerExpr`, then you must set
#' `handler.quoted` to `TRUE`.
#' @param value.env The parent environment for the reactive expression. By default,
#' this is the calling environment, the same as when defining an ordinary
#' non-reactive expression. If `valueExpr` is a quosure and `value.quoted` is `TRUE`,
#' then `value.env` is ignored.
#' @param value.quoted If it is `TRUE`, then the [`quote()`]ed value of `valueExpr`
#' will be used when `valueExpr` is evaluated. If `valueExpr` is a quosure and you
#' would like to use its expression as a value for `valueExpr`, then you must set
#' `value.quoted` to `TRUE`.
#' @param label A label for the observer or reactive, useful for debugging.
#' @param suspended If `TRUE`, start the observer in a suspended state. If
#' `FALSE` (the default), start in a non-suspended state.
@@ -2270,8 +2273,8 @@ maskReactiveContext <- function(expr) {
#' }
#' @export
observeEvent <- function(eventExpr, handlerExpr,
event.env = deprecated(), event.quoted = deprecated(),
handler.env = deprecated(), handler.quoted = deprecated(),
event.env = parent.frame(), event.quoted = FALSE,
handler.env = parent.frame(), handler.quoted = FALSE,
...,
label = NULL, suspended = FALSE, priority = 0,
domain = getDefaultReactiveDomain(), autoDestroy = TRUE,
@@ -2279,14 +2282,10 @@ observeEvent <- function(eventExpr, handlerExpr,
{
check_dots_empty()
eventQ <- enquo0(eventExpr)
handlerQ <- enquo0(handlerExpr)
eventQ <- sustainEnvAndQuotedInternal(eventQ, eventExpr, event.env, event.quoted)
handlerQ <- sustainEnvAndQuotedInternal(handlerQ, handlerExpr, handler.env, handler.quoted)
eventQ <- exprToQuo(eventExpr, event.env, event.quoted)
handlerQ <- exprToQuo(handlerExpr, handler.env, handler.quoted)
if (is.null(label)) {
label <- sprintf('observeEvent(%s)', paste(deparse(get_expr(eventQ)), collapse='\n'))
}
label <- quoToLabel(eventQ, "observeEvent", label)
handler <- inject(observe(
!!handlerQ,
@@ -2313,22 +2312,18 @@ observeEvent <- function(eventExpr, handlerExpr,
#' @rdname observeEvent
#' @export
eventReactive <- function(eventExpr, valueExpr,
event.env = deprecated(), event.quoted = deprecated(),
value.env = deprecated(), value.quoted = deprecated(),
event.env = parent.frame(), event.quoted = FALSE,
value.env = parent.frame(), value.quoted = FALSE,
...,
label = NULL, domain = getDefaultReactiveDomain(),
ignoreNULL = TRUE, ignoreInit = FALSE)
{
check_dots_empty()
eventQ <- enquo0(eventExpr)
valueQ <- enquo0(valueExpr)
eventQ <- sustainEnvAndQuotedInternal(eventQ, eventExpr, event.env, event.quoted)
valueQ <- sustainEnvAndQuotedInternal(valueQ, valueExpr, value.env, value.quoted)
eventQ <- exprToQuo(eventExpr, event.env, event.quoted)
valueQ <- exprToQuo(valueExpr, value.env, value.quoted)
if (is.null(label)) {
label <- sprintf('eventReactive(%s)', paste(deparse(get_expr(eventQ)), collapse='\n'))
}
label <- quoToLabel(eventQ, "eventReactive", label)
invisible(inject(bindEvent(
ignoreNULL = ignoreNULL,

View File

@@ -46,9 +46,7 @@
#' decorative images.
#' @param ... Arguments to be passed through to [grDevices::png()].
#' These can be used to set the width, height, background color, etc.
#' @param env TODO-barret docs; The environment in which to evaluate `expr`.
#' @param quoted TODO-barret docs; Is `expr` a quoted expression (with `quote()`)? This
#' is useful if you want to save an expression in a variable.
#' @inheritParams renderUI
#' @param execOnResize If `FALSE` (the default), then when a plot is
#' resized, Shiny will *replay* the plot drawing commands with
#' [grDevices::replayPlot()] instead of re-executing `expr`.
@@ -61,15 +59,17 @@
#' @export
renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
alt = NA,
env = deprecated(), quoted = deprecated(),
env = parent.frame(), quoted = FALSE,
execOnResize = FALSE, outputArgs = list()
) {
q <- enquo0(expr)
q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
# This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
# is called
func <- quoToFunction(q, "renderPlot", ..stacktraceon = TRUE)
func <- installExprFunction(
expr, "func", env, quoted,
label = "renderPlot",
# This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
# is called
..stacktraceon = TRUE
)
args <- list(...)
@@ -187,7 +187,7 @@ renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
outputFunc,
renderFunc,
outputArgs,
cacheHint = list(userExpr = get_expr(q), res = res)
cacheHint = list(userExpr = installedFuncExpr(func), res = res)
)
class(markedFunc) <- c("shiny.renderPlot", class(markedFunc))
markedFunc

View File

@@ -42,9 +42,7 @@
#' (i.e. they either evaluate to `NA` or `NaN`).
#' @param ... Arguments to be passed through to [xtable::xtable()]
#' and [xtable::print.xtable()].
#' @param env TODO-barret docs; The environment in which to evaluate `expr`.
#' @param quoted TODO-barret docs; Is `expr` a quoted expression (with `quote()`)?
#' This is useful if you want to save an expression in a variable.
#' @inheritParams renderUI
#' @param outputArgs A list of arguments to be passed through to the
#' implicit call to [tableOutput()] when `renderTable` is
#' used in an interactive R Markdown document.
@@ -71,12 +69,10 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
width = "auto", align = NULL,
rownames = FALSE, colnames = TRUE,
digits = NULL, na = "NA", ...,
env = deprecated(), quoted = deprecated(),
env = parent.frame(), quoted = FALSE,
outputArgs=list())
{
q <- enquo0(expr)
q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
func <- quoToFunction(q, "renderTable")
func <- installExprFunction(expr, "func", env, quoted, label = "renderTable")
if (!is.function(spacing)) spacing <- match.arg(spacing)

View File

@@ -5,7 +5,6 @@
#' value. The returned value will be used for the test snapshot.
#' @param session A Shiny session object.
#'
#' @keywords internal
#' @export
setSerializer <- function(inputId, fun, session = getDefaultReactiveDomain()) {
if (is.null(session)) {

View File

@@ -46,7 +46,7 @@ inputHandlers <- Map$new()
#' }
#'
#' }
#' @seealso [removeInputHandler()]
#' @seealso [removeInputHandler()] [applyInputHandlers()]
#' @export
registerInputHandler <- function(type, fun, force=FALSE){
if (inputHandlers$containsKey(type) && !force){

View File

@@ -17,7 +17,7 @@
#' enquos0 zap_srcref %||% is_na
#' is_false list2
#' missing_arg is_missing maybe_missing
#' quo_is_missing fn_fmls<- fn_body<-
#' quo_is_missing fn_fmls<- fn_body fn_body<-
#' @importFrom ellipsis
#' check_dots_empty check_dots_unnamed
#' @import htmltools

View File

@@ -2,6 +2,9 @@ utils::globalVariables('func', add = TRUE)
#' Mark a function as a render function
#'
#' `r lifecycle::badge("superseded")` Please use [`createRenderFunction()`] to
#' support async execution. (Shiny 1.1.0)
#'
#' Should be called by implementers of `renderXXX` functions in order to mark
#' their return values as Shiny render functions, and to provide a hint to Shiny
#' regarding what UI function is most commonly used with this type of render
@@ -10,9 +13,11 @@ utils::globalVariables('func', add = TRUE)
#'
#' Note that it is generally preferable to use [createRenderFunction()] instead
#' of `markRenderFunction()`. It essentially wraps up the user-provided
#' expression in the `transform` function passed to it, then pases the resulting
#' expression in the `transform` function passed to it, then passes the resulting
#' function to `markRenderFunction()`. It also provides a simpler calling
#' interface.
#' interface. There may be cases where `markRenderFunction()` must be used instead of
#' [createRenderFunction()] -- for example, when the `transform` parameter of
#' [createRenderFunction()] is not flexible enough for your needs.
#'
#' @param uiFunc A function that renders Shiny UI. Must take a single argument:
#' an output ID.
@@ -43,7 +48,7 @@ utils::globalVariables('func', add = TRUE)
#' is able to serve JS and CSS resources.
#' @return The `renderFunc` function, with annotations.
#'
#' @seealso [createRenderFunction()], [quoToFunction()]
#' @seealso [createRenderFunction()]
#' @export
markRenderFunction <- function(
uiFunc,
@@ -53,6 +58,12 @@ markRenderFunction <- function(
cacheWriteHook = NULL,
cacheReadHook = NULL
) {
# (Do not emit warning for superseded code, "since theres no risk if you keep using it")
# # This method is called by the superseding function, createRenderFunction().
# if (in_devmode()) {
# shinyDeprecated("1.1.0", "markRenderFunction()", "createRenderFunction()")
# }
force(renderFunc)
# a mutable object that keeps track of whether `useRenderFunction` has been
@@ -100,6 +111,7 @@ markRenderFunction <- function(
# For everything else, do nothing.
cacheHint <- lapply(cacheHint, function(x) {
if (is.function(x)) formalsAndBody(x)
else if (is_quosure(x)) zap_srcref(quo_get_expr(x))
else if (is.language(x)) zap_srcref(x)
else x
})
@@ -139,11 +151,27 @@ print.shiny.render.function <- function(x, ...) {
cat_line("<shiny.render.function>")
}
#' Implement render functions
#' Implement custom render functions
#'
#' This function is a wrapper for [markRenderFunction()] which provides support
#' for async computation via promises. It is recommended to use
#' `createRenderFunction()` instead of `markRenderFunction()`.
#' Developer-facing utilities for implementing a custom `renderXXX()` function.
#' Before using these utilities directly, consider using the [`htmlwidgets`
#' package](http://www.htmlwidgets.org/develop_intro.html) to implement custom
#' outputs (i.e., custom `renderXXX()`/`xxxOutput()` functions). That said,
#' these utilities can be used more directly if a full-blown htmlwidget isn't
#' needed and/or the user-supplied reactive expression needs to be wrapped in
#' additional call(s).
#'
#' To implement a custom `renderXXX()` function, essentially 2 things are needed:
#' 1. Capture the user's reactive expression as a function.
#' * New `renderXXX()` functions can use `quoToFunction()` for this, but
#' already existing `renderXXX()` functions that contain `env` and `quoted`
#' parameters may want to continue using `installExprFunction()` for better
#' legacy support (see examples).
#' 2. Flag the resulting function (from 1) as a Shiny rendering function and
#' also provide a UI container for displaying the result of the rendering
#' function.
#' * `createRenderFunction()` is currently recommended (instead of
#' [markRenderFunction()]) for this step (see examples).
#'
#' @param func A function without parameters, that returns user data. If the
#' returned value is a promise, then the render function will proceed in async
@@ -160,11 +188,10 @@ print.shiny.render.function <- function(x, ...) {
#' @return An annotated render function, ready to be assigned to an
#' `output` slot.
#'
#' @seealso [quoToFunction()], [markRenderFunction()], [rlang::enquo()].
#'
#' @examples
#' # A very simple render function
#' # A custom render function that repeats the supplied value 3 times
#' renderTriple <- function(expr) {
#' # Wrap user-supplied reactive expression into a function
#' func <- quoToFunction(rlang::enquo0(expr))
#'
#' createRenderFunction(
@@ -176,12 +203,52 @@ print.shiny.render.function <- function(x, ...) {
#' )
#' }
#'
#' # For better legacy support, consider using installExprFunction() over quoToFunction()
#' renderTripleLegacy <- function(expr, env = parent.frame(), quoted = FALSE) {
#' func <- installExprFunction(expr, "func", env, quoted)
#'
#' createRenderFunction(
#' func,
#' transform = function(value, session, name, ...) {
#' paste(rep(value, 3), collapse=", ")
#' },
#' outputFunc = textOutput
#' )
#' }
#'
#' # Test render function from the console
#' a <- 1
#' r <- renderTriple({ a * 10 })
#' a <- 2
#' reactiveConsole(TRUE)
#'
#' v <- reactiveVal("basic")
#' r <- renderTriple({ v() })
#' r()
#' # [1] "20, 20, 20"
#' #> [1] "basic, basic, basic"
#'
#' # User can supply quoted code via rlang::quo(). Note that evaluation of the
#' # expression happens when r2() is invoked, not when r2 is created.
#' q <- rlang::quo({ v() })
#' r2 <- rlang::inject(renderTriple(!!q))
#' v("rlang")
#' r2()
#' #> [1] "rlang, rlang, rlang"
#'
#' # Supplying quoted code without rlang::quo() requires installExprFunction()
#' expr <- quote({ v() })
#' r3 <- renderTripleLegacy(expr, quoted = TRUE)
#' v("legacy")
#' r3()
#' #> [1] "legacy, legacy, legacy"
#'
#' # The legacy approach also supports with quosures (env is ignored in this case)
#' q <- rlang::quo({ v() })
#' r4 <- renderTripleLegacy(q, quoted = TRUE)
#' v("legacy-rlang")
#' r4()
#' #> [1] "legacy-rlang, legacy-rlang, legacy-rlang"
#'
#' # Turn off reactivity in the console
#' reactiveConsole(FALSE)
#'
#' @export
createRenderFunction <- function(
func,
@@ -320,9 +387,7 @@ markOutputAttrs <- function(renderFunc, snapshotExclude = NULL,
#' the output, see [plotPNG()].
#'
#' @param expr An expression that returns a list.
#' @param env TODO-barret docs; The environment in which to evaluate `expr`.
#' @param quoted TODO-barret docs; Is `expr` a quoted expression (with `quote()`)? This
#' is useful if you want to save an expression in a variable.
#' @inheritParams renderUI
#' @param deleteFile Should the file in `func()$src` be deleted after
#' it is sent to the client browser? Generally speaking, if the image is a
#' temp file generated within `func`, then this should be `TRUE`;
@@ -401,12 +466,10 @@ markOutputAttrs <- function(renderFunc, snapshotExclude = NULL,
#'
#' shinyApp(ui, server)
#' }
renderImage <- function(expr, env = deprecated(), quoted = deprecated(),
renderImage <- function(expr, env = parent.frame(), quoted = FALSE,
deleteFile, outputArgs=list())
{
q <- enquo0(expr)
q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
func <- quoToFunction(q, "renderImage")
func <- installExprFunction(expr, "func", env, quoted, label = "renderImage")
# missing() must be used directly within the function with the given arg
if (missing(deleteFile)) {
@@ -528,9 +591,7 @@ isTemp <- function(path, tempDir = tempdir(), mustExist) {
#' function return [invisible()].
#'
#' @param expr An expression to evaluate.
#' @param env TODO-barret docs; The environment in which to evaluate `expr`. For expert use only.
#' @param quoted TODO-barret docs; Is `expr` a quoted expression (with `quote()`)? This
#' is useful if you want to save an expression in a variable.
#' @inheritParams renderUI
#' @param width Width of printed output.
#' @param outputArgs A list of arguments to be passed through to the implicit
#' call to [verbatimTextOutput()] or [textOutput()] when the functions are
@@ -538,12 +599,10 @@ isTemp <- function(path, tempDir = tempdir(), mustExist) {
#'
#' @example res/text-example.R
#' @export
renderPrint <- function(expr, env = deprecated(), quoted = deprecated(),
renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
width = getOption('width'), outputArgs=list())
{
q <- enquo0(expr)
q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
func <- quoToFunction(q, "renderPrint")
func <- installExprFunction(expr, "func", env, quoted, label = "renderPrint")
# Set a promise domain that sets the console width
# and captures output
@@ -575,7 +634,7 @@ renderPrint <- function(expr, env = deprecated(), quoted = deprecated(),
outputArgs,
cacheHint = list(
label = "renderPrint",
origUserExpr = get_expr(q)
origUserExpr = installedFuncExpr(func)
)
)
}
@@ -625,12 +684,10 @@ createRenderPrintPromiseDomain <- function(width) {
#' element.
#' @export
#' @rdname renderPrint
renderText <- function(expr, env = deprecated(), quoted = deprecated(),
renderText <- function(expr, env = parent.frame(), quoted = FALSE,
outputArgs=list(), sep=" ") {
q <- enquo0(expr)
q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
func <- quoToFunction(q, "renderText")
func <- installExprFunction(expr, "func", env, quoted, label = "renderText")
createRenderFunction(
func,
@@ -651,9 +708,13 @@ renderText <- function(expr, env = deprecated(), quoted = deprecated(),
#'
#' @param expr An expression that returns a Shiny tag object, [HTML()],
#' or a list of such objects.
#' @param env TODO-barret docs; The environment in which to evaluate `expr`.
#' @param quoted TODO-barret docs; Is `expr` a quoted expression (with `quote()`)? This
#' is useful if you want to save an expression in a variable.
#' @template param-env
#' @templateVar x expr
#' @templateVar env env
#' @templateVar quoted quoted
#' @template param-quoted
#' @templateVar x expr
#' @templateVar quoted quoted
#' @param outputArgs A list of arguments to be passed through to the implicit
#' call to [uiOutput()] when `renderUI` is used in an
#' interactive R Markdown document.
@@ -679,12 +740,10 @@ renderText <- function(expr, env = deprecated(), quoted = deprecated(),
#' shinyApp(ui, server)
#' }
#'
renderUI <- function(expr, env = deprecated(), quoted = deprecated(),
renderUI <- function(expr, env = parent.frame(), quoted = FALSE,
outputArgs = list())
{
q <- enquo0(expr)
q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
func <- quoToFunction(q, "renderUI")
func <- installExprFunction(expr, "func", env, quoted, label = "renderUI")
createRenderFunction(
func,
@@ -828,7 +887,7 @@ downloadHandler <- function(filename, content, contentType=NA, outputArgs=list()
#' }
renderDataTable <- function(expr, options = NULL, searchDelay = 500,
callback = 'function(oTable) {}', escape = TRUE,
env = deprecated(), quoted = deprecated(),
env = parent.frame(), quoted = FALSE,
outputArgs=list())
{
@@ -839,9 +898,7 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500,
)
}
q <- enquo0(expr)
q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
func <- quoToFunction(q, "renderDataTable")
func <- installExprFunction(expr, "func", env, quoted, label = "renderDataTable")
renderFunc <- function(shinysession, name, ...) {
if (is.function(options)) options <- options()

View File

@@ -51,36 +51,27 @@ formalsAndBody <- function(x) {
}
#' Convert a quosure to a function for a Shiny render function
#'
#' This takes a quosure and label, and wraps them into a function that should be
#' passed to [createRenderFunction()] or [markRenderFunction()].
#'
#' This function was added in Shiny 1.6.0. Previously, it was recommended to use
#' [installExprFunction()] or [exprToFunction()] in render functions, but now we
#' recommend using [quoToFunction()], because it does not require `env` and
#' `quoted` arguments -- that information is captured by quosures provided by
#' \pkg{rlang}.
#'
#' @param q A quosure.
#' @describeIn createRenderFunction convert a quosure to a function.
#' @param q Quosure of the expression `x`. When capturing expressions to create
#' your quosure, it is recommended to use [`enquo0()`] to not unquote the
#' object too early. See [`enquo0()`] for more details.
#' @inheritParams installExprFunction
#' @seealso [createRenderFunction()] for example usage.
#'
#' @export
quoToFunction <- function(q,
label = sys.call(-1)[[1]],
..stacktraceon = FALSE)
{
q <- as_quosure(q)
func <- quoToSimpleFunction(q)
wrapFunctionLabel(func, updateFunctionLabel(label), ..stacktraceon = ..stacktraceon)
quoToFunction <- function(
q,
label = sys.call(-1)[[1]],
..stacktraceon = FALSE
) {
func <- quoToSimpleFunction(as_quosure(q))
wrapFunctionLabel(func, updateFunctionLabel(label), ..stacktraceon = ..stacktraceon, dots = FALSE)
}
updateFunctionLabel <- function(label) {
# browser()
badFnName <- "anonymous"
if (all(is.language(label))) {
# Prevent immediately invoked functions like as.language(a()())
if (is.language(label) && length(label) > 1) {
return("wrappedFunction")
return(badFnName)
}
label <- deparse(label, width.cutoff = 500L)
}
@@ -88,10 +79,10 @@ updateFunctionLabel <- function(label) {
# Prevent function calls that are over one line; (Assignments are hard to perform)
# Prevent immediately invoked functions like "a()()"
if (length(label) > 1 || grepl("(", label, fixed = TRUE)) {
return("wrappedFunction")
return(badFnName)
}
if (label == "NULL") {
return("wrappedFunction")
return(badFnName)
}
label
}
@@ -105,361 +96,69 @@ quoToSimpleFunction <- function(q) {
# https://github.com/r-lib/rlang/issues/1244
if (quo_is_missing(q)) {
fn_body(fun) <- quote({})
return(fun)
}
# as_function returns a function that takes `...`. We need one that takes no
# `as_function()` returns a function that takes `...`. We need one that takes no
# args.
fn_fmls(fun) <- list()
fun
}
#' Convert expressions and quosures to functions
#'
#' `handleEnvAndQuoted()` and `quoToFunction()` are meant to be used together in a
#' `render` function, to capture user expressions or quosures and convert them
#' to functions. They are meant to replace the older functions
#' [installExprFunction()] and [exprToFunction()] (although those will continue
#' to work in the future). See the examples in [installExprFunction()] for
#' information on how to migrate to `getQuosure()` and `quoToFunction()`.
#'
#' Although `getQuosure()` can take `env` and `quoted` parameters, it is
#' recommended that they not be used, except for backward compatibility.
#' The recommended usage of `getQuosure()` and `quoToFunction()` does not
#' include use of the `env` and `quoted` parameters. If it is necessary to
#' use quoted expressions and/or custom environments for evaluating, it can be
#' done with quosures and [rlang::inject()]. The examples below demonstrate how
#' to do this.
#'
#' If you are updating from [installExprFunction()] or [exprToFunction()] to
#' these functions, see the examples in the documentation for the old functions
#' for how to migrate them.
#'
#' @param x An expression or quosure.
#' @param env An environment. This is provided for backward compatibility.
#' @param quoted A boolean indicating whether or not `env` is quoted. This is
#' provided for backward compatibility.
#'
#' @examples
#' # Example of a new renderer, similar to renderText.
#' # This is something that toolkit authors will do.
#' renderTriple <- function(expr) {
#' # Convert expr to a quosure, and then to a function
#' func <- quoToFunction(rlang::enquo0(expr))
#'
#' # Wrap up func, with another function which takes the value of func()
#' # and modifies it.
#' createRenderFunction(
#' func,
#' transform = function(value, session, name, ...) {
#' paste(rep(value, 3), collapse=", ")
#' },
#' # The outputFunc can be used by rmarkdown shiny apps to automatically
#' # generate outputs.
#' outputFunc = textOutput
#' )
#' }
#'
#'
#' # Example of using the renderer.
#' # This is something that app authors will do.
#' values <- reactiveValues(A="text")
#'
#' \dontrun{
#' # Create an output object
#' output$tripleA <- renderTriple({
#' values$A
#' })
#' }
#'
#' # At the R console, you can experiment with the renderer using isolate()
#' tripleA <- renderTriple({
#' values$A
#' })
#'
#' isolate(tripleA())
#' # "text, text, text"
#'
#'
#' # If you want to use a quoted expression, use rlang:inject().
#' a <- 1
#' expr <- quote({ values$A })
#' tripleA <- rlang::inject(renderTriple(!!expr))
#' isolate(tripleA())
#' # "text, text, text"
#'
#' # Capturing an expression and an environment, using a quosure and rlang::inject():
#' e <- new.env()
#' e$vals <- reactiveValues(A="hello")
#' # Create a quosure that captures both the expression and environment.
#' myquo <- rlang::new_quosure(quote({ vals$A }), env = e)
#' tripleA <- rlang::inject(renderTriple(!!myquo))
#' isolate(tripleA())
#' # "hello, hello, hello"
#'
#'
#' @rdname quoToFunction
#' @export
sustainEnvAndQuoted <- function(q, x, env, quoted) {
## To avoid possible boilerplate with `deprecated()`...
env_is_present <-
if (!is_present(env)) {
# If `env` is `deprecated()`, set to the parent frame of the caller
env <- parent.frame(2)
FALSE # env_is_present
} else {
# check of parent frame had a missing _`env`_ param
eval(substitute(!missing(env)), parent.frame())
}
quoted_is_present <-
if (!is_present(quoted)) {
# If `quoted` is deprecated(), set to `FALSE`
quoted <- FALSE
FALSE # quoted_is_present
} else {
# check of parent frame had a missing _`quoted`_ param
eval(substitute(!missing(quoted)), parent.frame())
}
##
# This is TRUE when the user called `inject(renderFoo(!!q))`
x_is_quosure <- is_quosure(eval(substitute(substitute(x)), parent.frame()))
sustainEnvAndQuoted_(
q = q, env = env, quoted = quoted,
env_is_present = env_is_present,
quoted_is_present = quoted_is_present,
x_is_quosure = x_is_quosure,
verbose = TRUE
)
}
# `sustainEnvAndQuotedInternal()` is to be called from functions like `reactive()`, `observe()`,
# and the various render functions. It handles the following cases:
# - The typical case where x is an unquoted expression, and `env` and `quoted`
# are not used.
# - New-style metaprogramming cases, where rlang::inject() is used to inline a
# quosure into the AST, as in `inject(reactive(!!x))`.
# - Old-style metaprogramming cases, where `env` and/or `quoted` are used.
# Same as `sustainEnvAndQuoted()`, but quiet
# Under assumption that `env = deprecated()` and `quoted = deprecated()`
sustainEnvAndQuotedInternal <- function(q, x, env, quoted) {
## Can leverage the fact that we know all `env` and `quoted` args are set to `deprecated()`
env_is_present <- is_present(env) # eval(substitute(!missing(env)), parent.frame())
quoted_is_present <- is_present(quoted) # eval(substitute(!missing(quoted)), parent.frame())
x_is_quosure <- is_quosure(eval(substitute(substitute(x)), parent.frame()))
if (!env_is_present) env <- parent.frame(2)
if (!quoted_is_present) quoted <- FALSE
sustainEnvAndQuoted_(
q = q,
env = env,
quoted = quoted,
env_is_present = env_is_present,
quoted_is_present = quoted_is_present,
x_is_quosure = x_is_quosure,
verbose = FALSE
)
}
# # Reaches up three calls to check if env / quoted were provided.
# # Can not leverage `is_present()` logic like in `sustainEnvAndQuotedInternal()`
# # This is similar to `sustainEnvAndQuotedInternal()`, but it is intended to be used only by
# # `installExprFunction()` and `exprToFunction()`. Whereas `sustainEnvAndQuotedInternal()` reaches
# # 2 calls back to find the expression passed in, this function reaches 3 calls
# # back, and it is only used internally within Shiny.
# sustainEnvAndQuoted3Internal <- function(q, x, env, quoted) {
# ## To avoid possible boilerplate with `deprecated()`...
# env_is_present <-
# if (!is_present(env)) {
# # If `env` is `deprecated()`, set to the parent frame of the caller
# env <- parent.frame(3)
# FALSE # env_is_present
# } else {
# # check of parent frame of the caller had a missing _`env`_ param
# eval(eval(substitute(substitute(!missing(env))), parent.frame()), parent.frame(2))
# }
# quoted_is_present <-
# if (!is_present(quoted)) {
# # If `quoted` is deprecated(), set to `FALSE`
# quoted <- FALSE
# FALSE # quoted_is_present
# } else {
# # check of parent frame had a missing _`quoted`_ param
# eval(eval(substitute(substitute(!missing(quoted))), parent.frame()), parent.frame(2))
# }
# ##
# x_is_quosure <- is_quosure(eval(eval(substitute(substitute(x)), parent.frame()), parent.frame(2)))
# sustainEnvAndQuoted_(
# q = q, env = env, quoted = quoted,
# env_is_present = env_is_present,
# quoted_is_present = quoted_is_present,
# x_is_quosure = x_is_quosure,
# verbose = FALSE
# )
# }
sustainEnvAndQuoted_ <- function(
q, env, quoted,
env_is_present, quoted_is_present, x_is_quosure,
verbose = TRUE
) {
if (
env_is_present ||
quoted_is_present
) {
if (verbose) deprecatedEnvQuotedMessage()
# browser()
# Can't have x be a quosure and use env/quoted.
if (x_is_quosure) {
stop(
"Can not use a `quosure()` with either the `env` or `quoted` parameters.\n",
"Please alter your quosure before the shiny function call and ",
"do not supply any `env` or `quoted` parameters.\n",
"To use your `quosure()` object directly, use `inject()` mixed with `!!`.\n",
"Ex: `inject(renderText(!!q))`"
)
}
# In this code path, x is NOT a literal quosure object
if (isTRUE(quoted)) {
q <- quo_set_expr(q, eval_tidy(q))
}
if (env_is_present) {
q <- quo_set_env(q, env)
}
}
q
}
#' Convert an expression to a function
#'
#' @description
#' `r lifecycle::badge("superseded")` Please see [`quoToFunction()`] for updated usage. (Shiny 1.7.0)
#'
#' Note: as of Shiny 1.7.0, it is
#' recommended to use [`quoToFunction()`] (and if necessary, [`sustainEnvAndQuoted()`]) instead of
#' `exprToFunction()` and `installExprFunction()`. See the examples for
#' information on how to migrate to `getQuosure()` and `quoToFunction()`.
#'
#' This is to be called from another function, because it will attempt to get
#' an unquoted expression from two calls back.
#'
#' For `exprToFunction()`:
#' If `expr` is a quoted expression, then this just converts it to a function.
#' If `expr` is a function, then this simply returns expr (and prints a
#' deprecation message).
#' If `expr` was a non-quoted expression from two calls back, then this will
#' quote the original expression and convert it to a function.
#'
#' `installExprFunction` installs an expression in the given environment as a
#' function, and registers debug hooks so that breakpoints may be set in the
#' function.
#'
#' `installExprFunction` can replace `exprToFunction` as follows: we may use
#' `func <- exprToFunction(expr)` if we do not want the debug hooks, or
#' `installExprFunction(expr, "func")` if we do. Both approaches create a
#' function named `func` in the current environment.
#' `r lifecycle::badge("superseded")` Please use [`installExprFunction()`] for a better
#' debugging experience (Shiny 0.8.0). If the `expr` and `quoted` parameters are not needed, please see
#' [`quoToFunction()`] (Shiny 1.6.0).
#'
#' Similar to [installExprFunction()] but doesn't register debug hooks.
#'
#' @param expr A quoted or unquoted expression, or a quosure.
#' @param env The desired environment for the function. Defaults to the
#' calling environment two steps back.
#' @param quoted Is the expression quoted?
#'
#' @examples
#' # These examples demonstrate the old method, with exprToFunction() and
#' # installExprFunction(), as well as how to replace them, with getQuosure().
#'
#' # Version 1: exprToFunction()
#' # The old way of converting the expression to a quosure, with exprToFunction()
#' renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
#' # Convert expr to a function
#' func <- exprToFunction(expr, env, quoted)
#'
#' function() {
#' value <- func()
#' paste(rep(value, 3), collapse=", ")
#' }
#' }
#'
#' # Version 2: installExprFunction()
#' # The not-quite-as-old way of converting the expression to a quosure, with
#' # installExprFunction()
#' renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
#' # Convert expr to a function
#' installExprFunction(expr, "func", env, quoted)
#'
#' function() {
#' value <- func()
#' paste(rep(value, 3), collapse=", ")
#' }
#' }
#'
#' # Version 3: Replacing the old functions with getQuosure() and quoToFunction()
#' # This keeps the `env` and `quoted` arguments, in case they are needed for
#' # backward compatibility
#' renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
#' # Convert expr to a quosure, and then to a function
#' q <- rlang::enquo0(expr)
#' q <- sustainEnvAndQuoted(q, expr, env, quoted)
#' func <- quoToFunction(q)
#'
#' function() {
#' value <- func()
#' paste(rep(value, 3), collapse=", ")
#' }
#' }
#'
#'
#' # Version 4: getQuosure()
#' # This is the recommended way to use getQuosure() and quoToFunction(), and
#' # it discards `env` and `quoted`, for simplicity.
#' renderTriple <- function(expr) {
#' # Convert expr to a quosure, and then to a function
#' func <- quoToFunction(rlang::enquo0(expr))
#'
#' function() {
#' value <- func()
#' paste(rep(value, 3), collapse=", ")
#' }
#' }
#'
#' # Example of using the renderer.
#' # This is something that app authors will do.
#' values <- reactiveValues(A="text")
#'
#' \dontrun{
#' # Create an output object
#' output$tripleA <- renderTriple({
#' values$A
#' })
#' }
#'
#' # At the R console, you can experiment with the renderer using isolate()
#' tripleA <- renderTriple({
#' values$A
#' })
#'
#' isolate(tripleA())
#' # "text, text, text"
#' @seealso [`installExprFunction()`] for the modern approach to converting an expression to a function
#' @export
#' @keywords internal
exprToFunction <- function(expr, env = parent.frame(), quoted = FALSE) {
# If `expr` is a raw quosure, must say `quoted = TRUE`; (env is ignored)
# If `inject()` a quosure, env is ignored, and quoted should be FALSE (aka ignored).
# Make article of usage
# * (by joe)
if (!quoted) {
expr <- eval(substitute(substitute(expr)), parent.frame())
}
# MUST call with `quoted = TRUE` as exprToQuo() will not reach high enough
q <- exprToQuo(expr, env, quoted = TRUE)
# expr is a quoted expression
new_function(list(), body = expr, env = env)
# MUST call `as_function()`. Can NOT call `new_function()`
# rlang has custom logic for handling converting a quosure to a function
quoToSimpleFunction(q)
}
# For internal use only; External users should be using `exprToFunction()` or `installExprFunction()`
# MUST be the exact same logic as `exprToFunction()`, but without the `quoToSimpleFunction()` call
exprToQuo <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) {
expr <- eval(substitute(substitute(expr)), parent.frame())
}
q <-
if (is_quosure(expr)) {
# inject()ed quosure
# do nothing
expr
} else if (is.language(expr) || rlang::is_atomic(expr) || is.null(expr)) {
# Most common case...
new_quosure(expr, env = env)
} else {
stop("Don't know how to convert '", class(expr)[1], "' to a function; a quosure or quoted expression was expected")
}
q
}
#' @rdname exprToFunction
#' @describeIn createRenderFunction converts a user's reactive `expr` into a
#' function that's assigned to a `name` in the `assign.env`.
#'
#' @param name The name the function should be given
#' @param eval.env The desired environment for the function. Defaults to the
@@ -469,6 +168,7 @@ exprToFunction <- function(expr, env = parent.frame(), quoted = FALSE) {
#' the name of the calling function.
#' @param wrappedWithLabel,..stacktraceon Advanced use only. For stack manipulation purposes; see
#' [stacktrace()].
#' @inheritParams exprToFunction
#' @export
installExprFunction <- function(expr, name, eval.env = parent.frame(2),
quoted = FALSE,
@@ -487,12 +187,16 @@ installExprFunction <- function(expr, name, eval.env = parent.frame(2),
# have a label with length > 1 it causes warnings in wrapFunctionLabel.
label <- paste0(label, collapse = "\n")
}
wrappedWithLabel <- isTRUE(wrappedWithLabel)
if (wrappedWithLabel) {
func <- wrapFunctionLabel(func, updateFunctionLabel(label), ..stacktraceon = ..stacktraceon)
} else {
registerDebugHook(name, assign.env, label)
func <- wrapFunctionLabel(func, updateFunctionLabel(label), ..stacktraceon = ..stacktraceon, dots = FALSE)
}
assign(name, func, envir = assign.env)
if (!wrappedWithLabel) {
registerDebugHook(name, assign.env, label)
}
invisible(func)
}
# Utility function for creating a debugging label, given an expression.
@@ -504,10 +208,42 @@ exprToLabel <- function(expr, function_name, label = NULL) {
if (is.null(label)) {
label <- rexprSrcrefToLabel(
srcref[[1]],
sprintf('%s(%s)', function_name, paste(deparse(expr), collapse = '\n'))
simpleExprToFunction(expr, function_name)
)
}
if (length(srcref) >= 2) attr(label, "srcref") <- srcref[[2]]
attr(label, "srcfile") <- srcFileOfRef(srcref[[1]])
label
}
simpleExprToFunction <- function(expr, function_name) {
sprintf('%s(%s)', function_name, paste(deparse(expr), collapse='\n'))
}
installedFuncExpr <- function(func) {
fn_body(attr(func, "wrappedFunc", exact = TRUE))
}
funcToLabelBody <- function(func) {
paste(deparse(installedFuncExpr(func)), collapse='\n')
}
funcToLabel <- function(func, functionLabel, label = NULL) {
if (!is.null(label)) return(label)
sprintf(
'%s(%s)',
functionLabel,
funcToLabelBody(func)
)
}
quoToLabelBody <- function(q) {
paste(deparse(quo_get_expr(q)), collapse='\n')
}
quoToLabel <- function(q, functionLabel, label = NULL) {
if (!is.null(label)) return(label)
sprintf(
'%s(%s)',
functionLabel,
quoToLabelBody(q)
)
}

View File

@@ -1438,21 +1438,31 @@ dateYMD <- function(date = NULL, argName = "value") {
# function which calls the original function using the specified name. This can
# be helpful for profiling, because the specified name will show up on the stack
# trace.
wrapFunctionLabel <- function(func, name, ..stacktraceon = FALSE) {
wrapFunctionLabel <- function(func, name, ..stacktraceon = FALSE, dots = TRUE) {
if (name == "name" || name == "func" || name == "relabelWrapper") {
stop("Invalid name for wrapFunctionLabel: ", name)
}
assign(name, func, environment())
registerDebugHook(name, environment(), name)
if (..stacktraceon) {
# We need to wrap the `...` in `!!quote(...)` so that R CMD check won't
# complain about "... may be used in an incorrect context"
body <- expr({ ..stacktraceon..((!!name)(!!quote(...))) })
if (isTRUE(dots)) {
if (..stacktraceon) {
# We need to wrap the `...` in `!!quote(...)` so that R CMD check won't
# complain about "... may be used in an incorrect context"
body <- expr({ ..stacktraceon..((!!name)(!!quote(...))) })
} else {
body <- expr({ (!!name)(!!quote(...)) })
}
relabelWrapper <- new_function(pairlist2(... =), body, environment())
} else {
body <- expr({ (!!name)(!!quote(...)) })
# Same logic as when `dots = TRUE`, but without the `...`
if (..stacktraceon) {
body <- expr({ ..stacktraceon..((!!name)()) })
} else {
body <- expr({ (!!name)() })
}
relabelWrapper <- new_function(list(), body, environment())
}
relabelWrapper <- new_function(pairlist2(... =), body, environment())
# Preserve the original function that was passed in; is used for caching.
attr(relabelWrapper, "wrappedFunc") <- func

6
man-roxygen/param-env.R Normal file
View File

@@ -0,0 +1,6 @@
# Also update observeEvent param descriptions!
# https://github.com/r-lib/roxygen2/issues/1241
#' @param <%= env %> The parent environment for the reactive expression. By default,
#' this is the calling environment, the same as when defining an ordinary
#' non-reactive expression. If `<%= x %>` is a quosure and `<%= quoted %>` is `TRUE`,
#' then `<%= env %>` is ignored.

View File

@@ -0,0 +1,6 @@
# Also update observeEvent param descriptions!
# https://github.com/r-lib/roxygen2/issues/1241
#' @param <%= quoted %> If it is `TRUE`, then the [`quote()`]ed value of `<%= x %>`
#' will be used when `<%= x %>` is evaluated. If `<%= x %>` is a quosure and you
#' would like to use its expression as a value for `<%= x %>`, then you must set
#' `<%= quoted %>` to `TRUE`.

View File

@@ -275,11 +275,11 @@ render function for cache collisions in a real application.
In some cases, however, the automatic cache hint inference is not
sufficient, and it is necessary to provide a cache hint. This is true
for \code{renderPrint()}. Unlike \code{renderText()}, it wraps the user-provided
expression in another function, before passing it to \code{\link[=markRenderFunction]{markRenderFunction()}}
expression in another function, before passing it to \code{\link[=createRenderFunction]{createRenderFunction()}}
(instead of \code{\link[=createRenderFunction]{createRenderFunction()}}). Because the user code is wrapped in
another function, \code{markRenderFunction()} is not able to automatically
another function, \code{createRenderFunction()} is not able to automatically
extract the user-provided code and use it in the cache key. Instead,
\code{renderPrint} calls \code{markRenderFunction()}, it explicitly passes along a
\code{renderPrint} calls \code{createRenderFunction()}, it explicitly passes along a
\code{cacheHint}, which includes a label and the original user expression.
In general, if you need to provide a \code{cacheHint}, it is best practice to
@@ -290,19 +290,19 @@ For \pkg{htmlwidgets}, it will try to automatically infer a cache hint;
again, you can inspect the cache hint with \code{shiny:::extractCacheHint()} and
also test it in an application. If you do need to explicitly provide a
cache hint, pass it to \code{shinyRenderWidget}. For example:\preformatted{renderMyWidget <- function(expr) \{
expr <- substitute(expr)
q <- rlang::enquo0(expr)
htmlwidgets::shinyRenderWidget(expr,
htmlwidgets::shinyRenderWidget(
q,
myWidgetOutput,
quoted = TRUE,
env = parent.frame(),
cacheHint = list(label = "myWidget", userExpr = expr)
cacheHint = list(label = "myWidget", userQuo = q)
)
\}
}
If your \code{render} function sets any internal state, you may find it useful
in your call to \code{\link[=createRenderFunction]{createRenderFunction()}} or \code{\link[=markRenderFunction]{markRenderFunction()}} to use
in your call to \code{\link[=createRenderFunction]{createRenderFunction()}} to use
the \code{cacheWriteHook} and/or \code{cacheReadHook} parameters. These hooks are
functions that run just before the object is stored in the cache, and just
after the object is retrieved from the cache. They can modify the data
@@ -321,8 +321,8 @@ Some render functions cannot be cached, typically because they have side
effects or modify some external state, and they must re-execute each time
in order to work properly.
For developers of such code, they should call \code{\link[=createRenderFunction]{createRenderFunction()}} or
\code{\link[=markRenderFunction]{markRenderFunction()}} with \code{cacheHint = FALSE}.
For developers of such code, they should call \code{\link[=createRenderFunction]{createRenderFunction()}} (or
\code{\link[=markRenderFunction]{markRenderFunction()}}) with \code{cacheHint = FALSE}.
}
\section{Caching with \code{renderPlot()}}{

View File

@@ -49,4 +49,3 @@ These functions give control over the \code{click}, \code{dblClick} and
\seealso{
\code{\link[=brushOpts]{brushOpts()}} for brushing events.
}
\keyword{internal}

View File

@@ -1,8 +1,10 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/shinywrappers.R
% Please edit documentation in R/shinywrappers.R, R/utils-lang.R
\name{createRenderFunction}
\alias{createRenderFunction}
\title{Implement render functions}
\alias{quoToFunction}
\alias{installExprFunction}
\title{Implement custom render functions}
\usage{
createRenderFunction(
func,
@@ -13,6 +15,19 @@ createRenderFunction(
cacheWriteHook = NULL,
cacheReadHook = NULL
)
quoToFunction(q, label = sys.call(-1)[[1]], ..stacktraceon = FALSE)
installExprFunction(
expr,
name,
eval.env = parent.frame(2),
quoted = FALSE,
assign.env = parent.frame(1),
label = sys.call(-1)[[1]],
wrappedWithLabel = TRUE,
..stacktraceon = FALSE
)
}
\arguments{
\item{func}{A function without parameters, that returns user data. If the
@@ -55,19 +70,71 @@ argument, the value retrieved from the cache. This can be useful when some
side effect needs to occur for a render function to behave correctly. For
example, some render functions call \code{\link[=createWebDependency]{createWebDependency()}} so that Shiny
is able to serve JS and CSS resources.}
\item{q}{Quosure of the expression \code{x}. When capturing expressions to create
your quosure, it is recommended to use \code{\link[=enquo0]{enquo0()}} to not unquote the
object too early. See \code{\link[=enquo0]{enquo0()}} for more details.}
\item{label}{A label for the object to be shown in the debugger. Defaults to
the name of the calling function.}
\item{expr}{A quoted or unquoted expression, or a quosure.}
\item{name}{The name the function should be given}
\item{eval.env}{The desired environment for the function. Defaults to the
calling environment two steps back.}
\item{quoted}{Is the expression quoted?}
\item{assign.env}{The environment in which the function should be assigned.}
\item{wrappedWithLabel, ..stacktraceon}{Advanced use only. For stack manipulation purposes; see
\code{\link[=stacktrace]{stacktrace()}}.}
}
\value{
An annotated render function, ready to be assigned to an
\code{output} slot.
}
\description{
This function is a wrapper for \code{\link[=markRenderFunction]{markRenderFunction()}} which provides support
for async computation via promises. It is recommended to use
\code{createRenderFunction()} instead of \code{markRenderFunction()}.
Developer-facing utilities for implementing a custom \code{renderXXX()} function.
Before using these utilities directly, consider using the \href{http://www.htmlwidgets.org/develop_intro.html}{\code{htmlwidgets} package} to implement custom
outputs (i.e., custom \code{renderXXX()}/\code{xxxOutput()} functions). That said,
these utilities can be used more directly if a full-blown htmlwidget isn't
needed and/or the user-supplied reactive expression needs to be wrapped in
additional call(s).
}
\details{
To implement a custom \code{renderXXX()} function, essentially 2 things are needed:
\enumerate{
\item Capture the user's reactive expression as a function.
\itemize{
\item New \code{renderXXX()} functions can use \code{quoToFunction()} for this, but
already existing \code{renderXXX()} functions that contain \code{env} and \code{quoted}
parameters may want to continue using \code{installExprFunction()} for better
legacy support (see examples).
}
\item Flag the resulting function (from 1) as a Shiny rendering function and
also provide a UI container for displaying the result of the rendering
function.
\itemize{
\item \code{createRenderFunction()} is currently recommended (instead of
\code{\link[=markRenderFunction]{markRenderFunction()}}) for this step (see examples).
}
}
}
\section{Functions}{
\itemize{
\item \code{quoToFunction}: convert a quosure to a function.
\item \code{installExprFunction}: converts a user's reactive \code{expr} into a
function that's assigned to a \code{name} in the \code{assign.env}.
}}
\examples{
# A very simple render function
# A custom render function that repeats the supplied value 3 times
renderTriple <- function(expr) {
# Wrap user-supplied reactive expression into a function
func <- quoToFunction(rlang::enquo0(expr))
createRenderFunction(
@@ -79,13 +146,50 @@ renderTriple <- function(expr) {
)
}
# For better legacy support, consider using installExprFunction() over quoToFunction()
renderTripleLegacy <- function(expr, env = parent.frame(), quoted = FALSE) {
func <- installExprFunction(expr, "func", env, quoted)
createRenderFunction(
func,
transform = function(value, session, name, ...) {
paste(rep(value, 3), collapse=", ")
},
outputFunc = textOutput
)
}
# Test render function from the console
a <- 1
r <- renderTriple({ a * 10 })
a <- 2
reactiveConsole(TRUE)
v <- reactiveVal("basic")
r <- renderTriple({ v() })
r()
# [1] "20, 20, 20"
}
\seealso{
\code{\link[=quoToFunction]{quoToFunction()}}, \code{\link[=markRenderFunction]{markRenderFunction()}}, \code{\link[rlang:nse-defuse]{rlang::enquo()}}.
#> [1] "basic, basic, basic"
# User can supply quoted code via rlang::quo(). Note that evaluation of the
# expression happens when r2() is invoked, not when r2 is created.
q <- rlang::quo({ v() })
r2 <- rlang::inject(renderTriple(!!q))
v("rlang")
r2()
#> [1] "rlang, rlang, rlang"
# Supplying quoted code without rlang::quo() requires installExprFunction()
expr <- quote({ v() })
r3 <- renderTripleLegacy(expr, quoted = TRUE)
v("legacy")
r3()
#> [1] "legacy, legacy, legacy"
# The legacy approach also supports with quosures (env is ignored in this case)
q <- rlang::quo({ v() })
r4 <- renderTripleLegacy(q, quoted = TRUE)
v("legacy-rlang")
r4()
#> [1] "legacy-rlang, legacy-rlang, legacy-rlang"
# Turn off reactivity in the console
reactiveConsole(FALSE)
}

View File

@@ -2,21 +2,9 @@
% Please edit documentation in R/utils-lang.R
\name{exprToFunction}
\alias{exprToFunction}
\alias{installExprFunction}
\title{Convert an expression to a function}
\usage{
exprToFunction(expr, env = parent.frame(), quoted = FALSE)
installExprFunction(
expr,
name,
eval.env = parent.frame(2),
quoted = FALSE,
assign.env = parent.frame(1),
label = sys.call(-1)[[1]],
wrappedWithLabel = TRUE,
..stacktraceon = FALSE
)
}
\arguments{
\item{expr}{A quoted or unquoted expression, or a quosure.}
@@ -25,121 +13,16 @@ installExprFunction(
calling environment two steps back.}
\item{quoted}{Is the expression quoted?}
\item{name}{The name the function should be given}
\item{eval.env}{The desired environment for the function. Defaults to the
calling environment two steps back.}
\item{assign.env}{The environment in which the function should be assigned.}
\item{label}{A label for the object to be shown in the debugger. Defaults to
the name of the calling function.}
\item{wrappedWithLabel, ..stacktraceon}{Advanced use only. For stack manipulation purposes; see
\code{\link[=stacktrace]{stacktrace()}}.}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Please see \code{\link[=quoToFunction]{quoToFunction()}} for updated usage. (Shiny 1.7.0)
Note: as of Shiny 1.7.0, it is
recommended to use \code{\link[=quoToFunction]{quoToFunction()}} (and if necessary, \code{\link[=sustainEnvAndQuoted]{sustainEnvAndQuoted()}}) instead of
\code{exprToFunction()} and \code{installExprFunction()}. See the examples for
information on how to migrate to \code{getQuosure()} and \code{quoToFunction()}.
This is to be called from another function, because it will attempt to get
an unquoted expression from two calls back.
For \code{exprToFunction()}:
If \code{expr} is a quoted expression, then this just converts it to a function.
If \code{expr} is a function, then this simply returns expr (and prints a
deprecation message).
If \code{expr} was a non-quoted expression from two calls back, then this will
quote the original expression and convert it to a function.
\code{installExprFunction} installs an expression in the given environment as a
function, and registers debug hooks so that breakpoints may be set in the
function.
\code{installExprFunction} can replace \code{exprToFunction} as follows: we may use
\code{func <- exprToFunction(expr)} if we do not want the debug hooks, or
\code{installExprFunction(expr, "func")} if we do. Both approaches create a
function named \code{func} in the current environment.
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Please use \code{\link[=installExprFunction]{installExprFunction()}} for a better
debugging experience (Shiny 0.8.0). If the \code{expr} and \code{quoted} parameters are not needed, please see
\code{\link[=quoToFunction]{quoToFunction()}} (Shiny 1.6.0).
}
\examples{
# These examples demonstrate the old method, with exprToFunction() and
# installExprFunction(), as well as how to replace them, with getQuosure().
# Version 1: exprToFunction()
# The old way of converting the expression to a quosure, with exprToFunction()
renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
# Convert expr to a function
func <- exprToFunction(expr, env, quoted)
function() {
value <- func()
paste(rep(value, 3), collapse=", ")
}
\details{
Similar to \code{\link[=installExprFunction]{installExprFunction()}} but doesn't register debug hooks.
}
# Version 2: installExprFunction()
# The not-quite-as-old way of converting the expression to a quosure, with
# installExprFunction()
renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
# Convert expr to a function
installExprFunction(expr, "func", env, quoted)
function() {
value <- func()
paste(rep(value, 3), collapse=", ")
}
}
# Version 3: Replacing the old functions with getQuosure() and quoToFunction()
# This keeps the `env` and `quoted` arguments, in case they are needed for
# backward compatibility
renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
# Convert expr to a quosure, and then to a function
q <- rlang::enquo0(expr)
q <- sustainEnvAndQuoted(q, expr, env, quoted)
func <- quoToFunction(q)
function() {
value <- func()
paste(rep(value, 3), collapse=", ")
}
}
# Version 4: getQuosure()
# This is the recommended way to use getQuosure() and quoToFunction(), and
# it discards `env` and `quoted`, for simplicity.
renderTriple <- function(expr) {
# Convert expr to a quosure, and then to a function
func <- quoToFunction(rlang::enquo0(expr))
function() {
value <- func()
paste(rep(value, 3), collapse=", ")
}
}
# Example of using the renderer.
# This is something that app authors will do.
values <- reactiveValues(A="text")
\dontrun{
# Create an output object
output$tripleA <- renderTriple({
values$A
})
}
# At the R console, you can experiment with the renderer using isolate()
tripleA <- renderTriple({
values$A
})
isolate(tripleA())
# "text, text, text"
\seealso{
\code{\link[=installExprFunction]{installExprFunction()}} for the modern approach to converting an expression to a function
}
\keyword{internal}

View File

@@ -24,3 +24,4 @@ knit_print.reactive(x, ..., inline = FALSE)
These S3 methods are necessary to help Shiny applications and UI chunks embed
themselves in knitr/rmarkdown documents.
}
\keyword{internal}

View File

@@ -51,19 +51,24 @@ is able to serve JS and CSS resources.}
The \code{renderFunc} function, with annotations.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Please use \code{\link[=createRenderFunction]{createRenderFunction()}} to
support async execution. (Shiny 1.1.0)
}
\details{
Should be called by implementers of \code{renderXXX} functions in order to mark
their return values as Shiny render functions, and to provide a hint to Shiny
regarding what UI function is most commonly used with this type of render
function. This can be used in R Markdown documents to create complete output
widgets out of just the render function.
}
\details{
Note that it is generally preferable to use \code{\link[=createRenderFunction]{createRenderFunction()}} instead
of \code{markRenderFunction()}. It essentially wraps up the user-provided
expression in the \code{transform} function passed to it, then pases the resulting
expression in the \code{transform} function passed to it, then passes the resulting
function to \code{markRenderFunction()}. It also provides a simpler calling
interface.
interface. There may be cases where \code{markRenderFunction()} must be used instead of
\code{\link[=createRenderFunction]{createRenderFunction()}} -- for example, when the \code{transform} parameter of
\code{\link[=createRenderFunction]{createRenderFunction()}} is not flexible enough for your needs.
}
\seealso{
\code{\link[=createRenderFunction]{createRenderFunction()}}, \code{\link[=quoToFunction]{quoToFunction()}}
\code{\link[=createRenderFunction]{createRenderFunction()}}
}

View File

@@ -6,8 +6,8 @@
\usage{
observe(
x,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
...,
label = NULL,
suspended = FALSE,
@@ -21,13 +21,15 @@ observe(
\item{x}{An expression (quoted or unquoted). Any return value will be
ignored.}
\item{env}{TODO-barret docs; The parent environment for the reactive expression. By default,
\item{env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression.}
non-reactive expression. If \code{x} is a quosure and \code{quoted} is \code{TRUE},
then \code{env} is ignored.}
\item{quoted}{TODO-barret docs; Is the expression quoted? By default, this is \code{FALSE}.
This is useful when you want to use an expression that is stored in a
variable; to do so, it must be quoted with \code{quote()}.}
\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{x}
will be used when \code{x} is evaluated. If \code{x} is a quosure and you
would like to use its expression as a value for \code{x}, then you must set
\code{quoted} to \code{TRUE}.}
\item{...}{Not used.}
@@ -110,19 +112,18 @@ when the \link[=domains]{domain} that owns them ends (e.g. when a Shiny
session ends).
}
\examples{
# TODO-barret docs; examples are outdated
values <- reactiveValues(A=1)
obsB <- observe({
print(values$A + 1)
})
# Can use quoted expressions
obsC <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
# To store expressions for later conversion to observe, use rlang::quo()
myquo <- rlang::quo({ print(values$A + 3) })
obsC <- rlang::inject(observe(!!myquo))
# To store expressions for later conversion to observe, use quote()
expr_q <- quote({ print(values$A + 3) })
obsD <- observe(expr_q, quoted = TRUE)
# (Legacy) Can use quoted expressions
obsD <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
# In a normal Shiny app, the web client will trigger flush events. If you
# are at the console, you can force a flush with flushReact()

View File

@@ -8,10 +8,10 @@
observeEvent(
eventExpr,
handlerExpr,
event.env = deprecated(),
event.quoted = deprecated(),
handler.env = deprecated(),
handler.quoted = deprecated(),
event.env = parent.frame(),
event.quoted = FALSE,
handler.env = parent.frame(),
handler.quoted = FALSE,
...,
label = NULL,
suspended = FALSE,
@@ -26,10 +26,10 @@ observeEvent(
eventReactive(
eventExpr,
valueExpr,
event.env = deprecated(),
event.quoted = deprecated(),
value.env = deprecated(),
value.quoted = deprecated(),
event.env = parent.frame(),
event.quoted = FALSE,
value.env = parent.frame(),
value.quoted = FALSE,
...,
label = NULL,
domain = getDefaultReactiveDomain(),
@@ -48,21 +48,25 @@ invalidated. This should be a side-effect-producing action (the return
value will be ignored). It will be executed within an \code{\link[=isolate]{isolate()}}
scope.}
\item{event.env}{The parent environment for \code{eventExpr}. By default,
this is the calling environment.}
\item{event.env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{eventExpr} is a quosure and \code{event.quoted} is \code{TRUE},
then \code{event.env} is ignored.}
\item{event.quoted}{TODO-barret docs; Is the \code{eventExpr} expression quoted? By default,
this is \code{FALSE}. This is useful when you want to use an expression
that is stored in a variable; to do so, it must be quoted with
\code{quote()}.}
\item{event.quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{eventExpr}
will be used when \code{eventExpr} is evaluated. If \code{eventExpr} is a quosure and you
would like to use its expression as a value for \code{eventExpr}, then you must set
\code{event.quoted} to \code{TRUE}.}
\item{handler.env}{TODO-barret docs; The parent environment for \code{handlerExpr}. By default,
this is the calling environment.}
\item{handler.env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{handlerExpr} is a quosure and \code{handler.quoted} is \code{TRUE},
then \code{handler.env} is ignored.}
\item{handler.quoted}{TODO-barret docs; Is the \code{handlerExpr} expression quoted? By
default, this is \code{FALSE}. This is useful when you want to use an
expression that is stored in a variable; to do so, it must be quoted with
\code{quote()}.}
\item{handler.quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{handlerExpr}
will be used when \code{handlerExpr} is evaluated. If \code{handlerExpr} is a quosure and you
would like to use its expression as a value for \code{handlerExpr}, then you must set
\code{handler.quoted} to \code{TRUE}.}
\item{...}{Currently not used.}
@@ -99,12 +103,15 @@ happen once.}
\code{eventReactive}. It will be executed within an \code{\link[=isolate]{isolate()}}
scope.}
\item{value.env}{TODO-barret docs; The parent environment for \code{valueExpr}. By default,
this is the calling environment.}
\item{value.env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{valueExpr} is a quosure and \code{value.quoted} is \code{TRUE},
then \code{value.env} is ignored.}
\item{value.quoted}{Is the \code{valueExpr} expression quoted? By default,
this is \code{FALSE}. This is useful when you want to use an expression
that is stored in a variable; to do so, it must be quoted with \code{quote()}.}
\item{value.quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{valueExpr}
will be used when \code{valueExpr} is evaluated. If \code{valueExpr} is a quosure and you
would like to use its expression as a value for \code{valueExpr}, then you must set
\code{value.quoted} to \code{TRUE}.}
}
\value{
\code{observeEvent} returns an observer reference class object (see

View File

@@ -1,119 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils-lang.R
\name{quoToFunction}
\alias{quoToFunction}
\alias{sustainEnvAndQuoted}
\title{Convert a quosure to a function for a Shiny render function}
\usage{
quoToFunction(q, label = sys.call(-1)[[1]], ..stacktraceon = FALSE)
sustainEnvAndQuoted(q, x, env, quoted)
}
\arguments{
\item{q}{A quosure.}
\item{label}{A label for the object to be shown in the debugger. Defaults to
the name of the calling function.}
\item{..stacktraceon}{Advanced use only. For stack manipulation purposes; see
\code{\link[=stacktrace]{stacktrace()}}.}
\item{x}{An expression or quosure.}
\item{env}{An environment. This is provided for backward compatibility.}
\item{quoted}{A boolean indicating whether or not \code{env} is quoted. This is
provided for backward compatibility.}
}
\description{
This takes a quosure and label, and wraps them into a function that should be
passed to \code{\link[=createRenderFunction]{createRenderFunction()}} or \code{\link[=markRenderFunction]{markRenderFunction()}}.
\code{handleEnvAndQuoted()} and \code{quoToFunction()} are meant to be used together in a
\code{render} function, to capture user expressions or quosures and convert them
to functions. They are meant to replace the older functions
\code{\link[=installExprFunction]{installExprFunction()}} and \code{\link[=exprToFunction]{exprToFunction()}} (although those will continue
to work in the future). See the examples in \code{\link[=installExprFunction]{installExprFunction()}} for
information on how to migrate to \code{getQuosure()} and \code{quoToFunction()}.
}
\details{
This function was added in Shiny 1.6.0. Previously, it was recommended to use
\code{\link[=installExprFunction]{installExprFunction()}} or \code{\link[=exprToFunction]{exprToFunction()}} in render functions, but now we
recommend using \code{\link[=quoToFunction]{quoToFunction()}}, because it does not require \code{env} and
\code{quoted} arguments -- that information is captured by quosures provided by
\pkg{rlang}.
Although \code{getQuosure()} can take \code{env} and \code{quoted} parameters, it is
recommended that they not be used, except for backward compatibility.
The recommended usage of \code{getQuosure()} and \code{quoToFunction()} does not
include use of the \code{env} and \code{quoted} parameters. If it is necessary to
use quoted expressions and/or custom environments for evaluating, it can be
done with quosures and \code{\link[rlang:inject]{rlang::inject()}}. The examples below demonstrate how
to do this.
If you are updating from \code{\link[=installExprFunction]{installExprFunction()}} or \code{\link[=exprToFunction]{exprToFunction()}} to
these functions, see the examples in the documentation for the old functions
for how to migrate them.
}
\examples{
# Example of a new renderer, similar to renderText.
# This is something that toolkit authors will do.
renderTriple <- function(expr) {
# Convert expr to a quosure, and then to a function
func <- quoToFunction(rlang::enquo0(expr))
# Wrap up func, with another function which takes the value of func()
# and modifies it.
createRenderFunction(
func,
transform = function(value, session, name, ...) {
paste(rep(value, 3), collapse=", ")
},
# The outputFunc can be used by rmarkdown shiny apps to automatically
# generate outputs.
outputFunc = textOutput
)
}
# Example of using the renderer.
# This is something that app authors will do.
values <- reactiveValues(A="text")
\dontrun{
# Create an output object
output$tripleA <- renderTriple({
values$A
})
}
# At the R console, you can experiment with the renderer using isolate()
tripleA <- renderTriple({
values$A
})
isolate(tripleA())
# "text, text, text"
# If you want to use a quoted expression, use rlang:inject().
a <- 1
expr <- quote({ values$A })
tripleA <- rlang::inject(renderTriple(!!expr))
isolate(tripleA())
# "text, text, text"
# Capturing an expression and an environment, using a quosure and rlang::inject():
e <- new.env()
e$vals <- reactiveValues(A="hello")
# Create a quosure that captures both the expression and environment.
myquo <- rlang::new_quosure(quote({ vals$A }), env = e)
tripleA <- rlang::inject(renderTriple(!!myquo))
isolate(tripleA())
# "hello, hello, hello"
}
\seealso{
\code{\link[=createRenderFunction]{createRenderFunction()}} for example usage.
}

View File

@@ -7,8 +7,8 @@
\usage{
reactive(
x,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
...,
label = NULL,
domain = getDefaultReactiveDomain(),
@@ -18,16 +18,17 @@ reactive(
is.reactive(x)
}
\arguments{
\item{x}{TODO-barret docs; For \code{reactive}, an expression (quoted or unquoted). For
\code{is.reactive}, an object to test.}
\item{x}{For \code{is.reactive()}, an object to test. For \code{reactive()}, an expression. When passing in a \code{\link[=quo]{quo()}}sure with \code{reactive()}, remember to use \code{\link[rlang:inject]{rlang::inject()}} to distinguish that you are passing in the content of your quosure, not the expression of the quosure.}
\item{env}{TODO-barret docs; The parent environment for the reactive expression. By default,
\item{env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression.}
non-reactive expression. If \code{x} is a quosure and \code{quoted} is \code{TRUE},
then \code{env} is ignored.}
\item{quoted}{TODO-barret docs; Is the expression quoted? By default, this is \code{FALSE}.
This is useful when you want to use an expression that is stored in a
variable; to do so, it must be quoted with \code{quote()}.}
\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{x}
will be used when \code{x} is evaluated. If \code{x} is a quosure and you
would like to use its expression as a value for \code{x}, then you must set
\code{quoted} to \code{TRUE}.}
\item{...}{Not used.}
@@ -58,22 +59,32 @@ See the \href{https://shiny.rstudio.com/tutorial/}{Shiny tutorial} for
more information about reactive expressions.
}
\examples{
# TODO-barret docs; with quosures, not env / quoted
library(rlang)
values <- reactiveValues(A=1)
reactiveB <- reactive({
values$A + 1
})
# Can use quoted expressions
reactiveC <- reactive(quote({ values$A + 2 }), quoted = TRUE)
# To store expressions for later conversion to reactive, use quote()
expr_q <- quote({ values$A + 3 })
reactiveD <- reactive(expr_q, quoted = TRUE)
# View the values from the R console with isolate()
isolate(reactiveB())
# 2
# To store expressions for later conversion to reactive, use quote()
myquo <- rlang::quo(values$A + 2)
# Unexpected value! Sending a quosure directly will not work as expected.
reactiveC <- reactive(myquo)
# We'd hope for `3`, but instead we get the quosure that was supplied.
isolate(reactiveC())
# Instead, the quosure should be `rlang::inject()`ed
reactiveD <- rlang::inject(reactive(!!myquo))
isolate(reactiveD())
# 3
# (Legacy) Can use quoted expressions
expr <- quote({ values$A + 3 })
reactiveE <- reactive(expr, quoted = TRUE)
isolate(reactiveE())
# 4
}

View File

@@ -58,5 +58,5 @@ getType: function(el) {
}
}
\seealso{
\code{\link[=removeInputHandler]{removeInputHandler()}}
\code{\link[=removeInputHandler]{removeInputHandler()}} \code{\link[=applyInputHandlers]{applyInputHandlers()}}
}

View File

@@ -13,8 +13,8 @@ renderDataTable(
searchDelay = 500,
callback = "function(oTable) {}",
escape = TRUE,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
outputArgs = list()
)
}
@@ -48,10 +48,15 @@ indicate which columns to escape, e.g. \code{1:5} (the first 5 columns),
\code{c(1, 3, 4)}, or \code{c(-1, -3)} (all columns except the first and
third), or \code{c('Species', 'Sepal.Length')}.}
\item{env}{TODO-barret docs; The environment in which to evaluate \code{expr}.}
\item{env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
then \code{env} is ignored.}
\item{quoted}{TODO-barret docs; Is \code{expr} a quoted expression (with \code{quote()})?
This is useful if you want to save an expression in a variable.}
\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
would like to use its expression as a value for \code{expr}, then you must set
\code{quoted} to \code{TRUE}.}
\item{outputArgs}{A list of arguments to be passed through to the implicit
call to \code{dataTableOutput()} when \code{renderDataTable()} is used

View File

@@ -6,8 +6,8 @@
\usage{
renderImage(
expr,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
deleteFile,
outputArgs = list()
)
@@ -15,10 +15,15 @@ renderImage(
\arguments{
\item{expr}{An expression that returns a list.}
\item{env}{TODO-barret docs; The environment in which to evaluate \code{expr}.}
\item{env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
then \code{env} is ignored.}
\item{quoted}{TODO-barret docs; Is \code{expr} a quoted expression (with \code{quote()})? This
is useful if you want to save an expression in a variable.}
\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
would like to use its expression as a value for \code{expr}, then you must set
\code{quoted} to \code{TRUE}.}
\item{deleteFile}{Should the file in \code{func()$src} be deleted after
it is sent to the client browser? Generally speaking, if the image is a

View File

@@ -11,8 +11,8 @@ renderPlot(
res = 72,
...,
alt = NA,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
execOnResize = FALSE,
outputArgs = list()
)
@@ -50,10 +50,15 @@ ggplot objects; for other plots, \code{NA} results in alt text of "Plot object".
\code{NULL} or \code{""} is not recommended because those should be limited to
decorative images.}
\item{env}{TODO-barret docs; The environment in which to evaluate \code{expr}.}
\item{env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
then \code{env} is ignored.}
\item{quoted}{TODO-barret docs; Is \code{expr} a quoted expression (with \code{quote()})? This
is useful if you want to save an expression in a variable.}
\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
would like to use its expression as a value for \code{expr}, then you must set
\code{quoted} to \code{TRUE}.}
\item{execOnResize}{If \code{FALSE} (the default), then when a plot is
resized, Shiny will \emph{replay} the plot drawing commands with

View File

@@ -7,16 +7,16 @@
\usage{
renderPrint(
expr,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
width = getOption("width"),
outputArgs = list()
)
renderText(
expr,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
outputArgs = list(),
sep = " "
)
@@ -24,10 +24,15 @@ renderText(
\arguments{
\item{expr}{An expression to evaluate.}
\item{env}{TODO-barret docs; The environment in which to evaluate \code{expr}. For expert use only.}
\item{env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
then \code{env} is ignored.}
\item{quoted}{TODO-barret docs; Is \code{expr} a quoted expression (with \code{quote()})? This
is useful if you want to save an expression in a variable.}
\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
would like to use its expression as a value for \code{expr}, then you must set
\code{quoted} to \code{TRUE}.}
\item{width}{Width of printed output.}

View File

@@ -20,8 +20,8 @@ renderTable(
digits = NULL,
na = "NA",
...,
env = deprecated(),
quoted = deprecated(),
env = parent.frame(),
quoted = FALSE,
outputArgs = list()
)
}
@@ -71,10 +71,15 @@ columns will be displayed in scientific format with a precision of
\item{...}{Arguments to be passed through to \code{\link[xtable:xtable]{xtable::xtable()}}
and \code{\link[xtable:print.xtable]{xtable::print.xtable()}}.}
\item{env}{TODO-barret docs; The environment in which to evaluate \code{expr}.}
\item{env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
then \code{env} is ignored.}
\item{quoted}{TODO-barret docs; Is \code{expr} a quoted expression (with \code{quote()})?
This is useful if you want to save an expression in a variable.}
\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
would like to use its expression as a value for \code{expr}, then you must set
\code{quoted} to \code{TRUE}.}
\item{outputArgs}{A list of arguments to be passed through to the
implicit call to \code{\link[=tableOutput]{tableOutput()}} when \code{renderTable} is

View File

@@ -4,16 +4,21 @@
\alias{renderUI}
\title{UI Output}
\usage{
renderUI(expr, env = deprecated(), quoted = deprecated(), outputArgs = list())
renderUI(expr, env = parent.frame(), quoted = FALSE, outputArgs = list())
}
\arguments{
\item{expr}{An expression that returns a Shiny tag object, \code{\link[=HTML]{HTML()}},
or a list of such objects.}
\item{env}{TODO-barret docs; The environment in which to evaluate \code{expr}.}
\item{env}{The parent environment for the reactive expression. By default,
this is the calling environment, the same as when defining an ordinary
non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
then \code{env} is ignored.}
\item{quoted}{TODO-barret docs; Is \code{expr} a quoted expression (with \code{quote()})? This
is useful if you want to save an expression in a variable.}
\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
would like to use its expression as a value for \code{expr}, then you must set
\code{quoted} to \code{TRUE}.}
\item{outputArgs}{A list of arguments to be passed through to the implicit
call to \code{\link[=uiOutput]{uiOutput()}} when \code{renderUI} is used in an

View File

@@ -17,4 +17,3 @@ value. The returned value will be used for the test snapshot.}
\description{
Add a function for serializing an input before bookmarking application state
}
\keyword{internal}

View File

@@ -1099,7 +1099,6 @@ test_that("Custom render functions that call installExprFunction", {
# quoToFunction + markRenderFunction (with cacheHint): OK
# Also, non-list cacheHint will get wrapped into a list
renderDouble <- function(expr) {
# browser()
func <- quoToFunction(enquo(expr), "renderDouble")
markRenderFunction(textOutput,
function() {
@@ -1263,3 +1262,33 @@ test_that("cacheHint to avoid collisions", {
extractCacheHint(renderUI({ a + 1 }))
))
})
test_that("cacheHint works with quosures", {
my_quo <- rlang::quo({a + 1})
expect_equal(
extractCacheHint(renderPlot({ a + 1 })),
list(userExpr = rlang::expr({a+1}), res = 72)
)
expect_equal(
extractCacheHint(renderPlot(my_quo, quoted = TRUE)),
list(userExpr = rlang::expr({a+1}), res = 72)
)
expect_equal(
extractCacheHint(reactive(a + 1)),
list(userExpr = rlang::expr({a+1}))
)
expect_equal(
extractCacheHint(reactive(my_quo, quoted = TRUE)),
list(userExpr = rlang::expr({a+1}))
)
expect_equal(
extractCacheHint(
markRenderFunction(force, force, cacheHint = list(q = my_quo))
),
list(q = rlang::expr({a+1}))
)
})

View File

@@ -83,7 +83,7 @@ test_that("message logger appears", {
{
react <- reactive(val() + values$a)
},
"- define: r3:'reactive(val() + values$a)' - observable ' NULL'"
"- define: r3:'reactive({\\n val() + values$a\\n})' - observable ' NULL'"
)
expect_logs(
@@ -91,13 +91,13 @@ test_that("message logger appears", {
react()
},
"- createContext: ctxDummy - isolate",
"- dependsOn: rDummyReactId:'DummyReactId' on r3:'reactive(val() + values$a)' in ctxDummy",
"- dependsOn: rDummyReactId:'DummyReactId' on r3:'reactive({\\n val() + values$a\\n})' in ctxDummy",
"- createContext: ctx1 - observable",
"- enter: r3:'reactive(val() + values$a)' in ctx1 - observable",
"= - dependsOn: r3:'reactive(val() + values$a)' on r1:'val' in ctx1",
"- enter: r3:'reactive({\\n val() + values$a\\n})' in ctx1 - observable",
"= - dependsOn: r3:'reactive({\\n val() + values$a\\n})' on r1:'val' in ctx1",
"= - define: r2$a:'values$a' - reactiveValuesKey ' num 2'",
"= - dependsOn: r3:'reactive(val() + values$a)' on r2$a:'values$a' in ctx1",
"- exit: r3:'reactive(val() + values$a)' in ctx1 - observable"
"= - dependsOn: r3:'reactive({\\n val() + values$a\\n})' on r2$a:'values$a' in ctx1",
"- exit: r3:'reactive({\\n val() + values$a\\n})' in ctx1 - observable"
)
expect_logs(
@@ -106,13 +106,13 @@ test_that("message logger appears", {
},
"- valueChange: r1:'val' ' num 4'",
"- invalidateStart: r1:'val'",
"= - invalidateStart: r3:'reactive(val() + values$a)' in ctx1 - observable",
"= - invalidateStart: r3:'reactive({\\n val() + values$a\\n})' in ctx1 - observable",
"= = - isolateInvalidateStart: rDummyReactId:'DummyReactId' in ctxDummy",
"= = = - dependsOnRemove: rDummyReactId:'DummyReactId' on r3:'reactive(val() + values$a)' in ctxDummy",
"= = = - dependsOnRemove: rDummyReactId:'DummyReactId' on r3:'reactive({\\n val() + values$a\\n})' in ctxDummy",
"= = - isolateInvalidateEnd: rDummyReactId:'DummyReactId' in ctxDummy",
"= = - dependsOnRemove: r3:'reactive(val() + values$a)' on r1:'val' in ctx1",
"= = - dependsOnRemove: r3:'reactive(val() + values$a)' on r2$a:'values$a' in ctx1",
"= - invalidateEnd: r3:'reactive(val() + values$a)' in ctx1 - observable",
"= = - dependsOnRemove: r3:'reactive({\\n val() + values$a\\n})' on r1:'val' in ctx1",
"= = - dependsOnRemove: r3:'reactive({\\n val() + values$a\\n})' on r2$a:'values$a' in ctx1",
"= - invalidateEnd: r3:'reactive({\\n val() + values$a\\n})' in ctx1 - observable",
"- invalidateEnd: r1:'val'"
)

View File

@@ -57,126 +57,84 @@ test_that("functionLabel returns static value when the label can not be assigned
(function(exprF) {
quoToFunction(enquo0(exprF))
})(),
"wrappedFunction"
"anonymous"
)
# parents are not supported
expect_label(
(function(exprF) {quoToFunction(enquo0(exprF))})(),
"wrappedFunction"
"anonymous"
)
})
local({
# (must also copy logic into `lower - quoToFunction(enquo0(expr))` code)
return_func <- function(func) {
function() {
value <- func()
list(value, value)
}
}
for (info in list(
list(
name = "exprToFunction(expr, env, quoted)",
fn = function(exprF, envF = parent.frame(), quotedF = FALSE) {
func <- exprToFunction(exprF, envF, quotedF)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
},
can_not_test_quosures = TRUE
return_func(func)
}
),
list(
name = "exprToFunction(expr, env, quoted = TRUE)",
fn = function(exprF, envF = parent.frame(), quotedF = FALSE) {
# `exprF` coudl be a raw quosure if `inject()`ed
if (!quotedF) exprF <- substitute(exprF)
func <- exprToFunction(exprF, envF, quoted = TRUE)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
},
can_not_test_quosures = TRUE
return_func(func)
}
),
list(
name = "exprToFunction(expr, env, quoted = TRUE) + force()",
fn = function(exprF, envF = parent.frame(), quotedF = FALSE) {
# Make `exprF` always language, even if `inject()`ed
if (!quotedF) exprF <- substitute(force(exprF))
func <- exprToFunction(exprF, envF, quoted = TRUE)
return_func(func)
}
),
list(
name = "installExprFunction(expr, \"func\", env, quoted)",
fn = function(exprF, envF = parent.frame(), quotedF = FALSE) {
a <- 1000
installExprFunction(exprF, "func", envF, quotedF)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
},
can_not_test_quosures = TRUE
return_func(func)
}
),
list(
name = "installExprFunction(expr, \"func\", env, quoted = TRUE)",
fn = function(exprF, envF = parent.frame(), quotedF = FALSE) {
a <- 1000
# `exprF` coudl be a raw quosure if `inject()`ed
if (!quotedF) exprF <- substitute(exprF)
installExprFunction(exprF, "func", envF, quoted = TRUE)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
},
can_not_test_quosures = TRUE
return_func(func)
}
),
list(
name = "sustainEnvAndQuoted(); quoToFunction()",
name = "installExprFunction(expr, \"func\", env, quoted = TRUE)",
fn = function(exprF, envF = parent.frame(), quotedF = FALSE) {
a <- 1000
q <- enquo0(exprF)
q <- sustainEnvAndQuoted(q, exprF, envF, quotedF)
func <- quoToFunction(q)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
}
),
list(
name = "lower1 - sustainEnvAndQuoted(); quoToFunction()",
fn = function(exprF, envF = parent.frame(), quotedF = FALSE) {
a <- 1000
q <- enquo0(exprF)
q <- sustainEnvAndQuoted(q, exprF, envF, quotedF)
function() {
func <- quoToFunction(q)
value <- func()
paste(rep(value, 2), collapse=", ")
}
}
),
list(
name = "old args - sustainEnvAndQuoted(),quoToFunction()",
fn = function(xF, envF = parent.frame(), quotedF = FALSE) {
a <- 1000
q <- enquo0(xF)
# Eventually can remove this, once users stop using env and quoted
q <- sustainEnvAndQuoted(q, xF, envF, quotedF)
func <- quoToFunction(q)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
}
),
list(
name = "deprecated args - sustainEnvAndQuoted(),quoToFunction()",
fn = function(xF, envF = deprecated(), quotedF = deprecated()) {
a <- 1000
q <- enquo0(xF)
# Eventually can remove this, once users stop using env and quoted
q <- sustainEnvAndQuoted(q, xF, envF, quotedF)
func <- quoToFunction(q)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
# Make `exprF` always language, even if `inject()`ed
if (!quotedF) exprF <- substitute(force(exprF))
installExprFunction(exprF, "func", envF, quoted = TRUE)
return_func(func)
}
),
list(
name = "quoToFunction(enquo0(expr))",
fn = function(expr) {
func <- quoToFunction(enquo0(expr))
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
return_func(func)
}
),
list(
@@ -185,7 +143,7 @@ for (info in list(
function() {
func <- quoToFunction(enquo0(expr))
value <- func()
paste(rep(value, 2), collapse=", ")
list(value, value)
}
}
)
@@ -194,7 +152,6 @@ for (info in list(
# Scope the local variables
local({
renderH <- info$fn %||% stop("`info$fn` not found")
messageVal <- info$messageVal %||% NA
# Different usages of env and quoted param
a <- 1
@@ -202,56 +159,90 @@ for (info in list(
e$a <- 10
test_that(paste0("vanilla: ", info$name), {
expect_message({
val <- renderH({a + 1})()
}, messageVal)
expect_identical(val, "2, 2")
val <- renderH({a + 1})()
expect_identical(val, list(2, 2))
})
# Test that no error is thrown when the function is created
# This proves that the expression is not immediately evaluated
test_that(paste0("stop('boom'): ", info$name), {
expect_error(
renderH(stop("boom")),
NA
)
})
if (length(formals(renderH)) > 1) {
test_that(paste0("quoted = FALSE: ", info$name), {
r <- renderH(a + 1, quotedF = FALSE)
expect_identical(r(), "2, 2")
expect_identical(r(), list(2, 2))
})
test_that(paste0("quoted = TRUE: ", info$name), {
r <- renderH(quote(a + 1), quotedF = TRUE)
expect_identical(r(), "2, 2")
expect_identical(r(), list(2, 2))
})
test_that(paste0("env = e: ", info$name), {
r <- renderH(a + 1, envF = e)
expect_identical(r(), "11, 11")
expect_identical(r(), list(11, 11))
})
test_that(paste0("env = e, quoted = FALSE: ", info$name), {
r <- renderH(a + 1, envF = e, quotedF = FALSE)
expect_identical(r(), "11, 11")
expect_identical(r(), list(11, 11))
})
test_that(paste0("env = e, quoted = TRUE: ", info$name), {
r <- renderH(quote(a + 1), envF = e, quotedF = TRUE)
expect_identical(r(), "11, 11")
expect_identical(r(), list(11, 11))
})
if (!isTRUE(info$can_not_test_quosures)) {
test_that(paste0("Works with injecting raw quosures: ", info$name), {
e <- list2env(list(a=10))
x <- new_quosure(quote({ a + 1 }) , env = e)
ans <- expect_message(
inject(renderH(!!x))(),
messageVal
)
expect_identical(ans, "11, 11")
test_that(paste0("Works with raw quosures, quoted = FALSE: ", info$name), {
e <- list2env(list(a=10))
x <- new_quosure(quote({ a + 1 }) , env = e)
r <- renderH(x, quotedF = FALSE)
expect_identical(r(), list(x, x))
})
test_that(paste0(
"Passing in a raw quosures, quoted = FALSE, env = otherenv",
" is treated like an expression: ", info$name),
{
e <- list2env(list(a=10))
x <- new_quosure(quote({ a + 1 }) , env = e)
other_env <- list2env(list(x=20))
r <- renderH(x, quotedF = FALSE, envF = e)
expect_identical(r(), list(x, x))
})
test_that(
paste0("Works with injected quosures, quoted = FALSE, env = otherenv: ", info$name), {
e <- list2env(list(a=10))
x <- new_quosure(quote({ a + 1 }) , env = e)
other_env <- new.env(parent = emptyenv())
r <- inject(renderH(!!x, quotedF = FALSE, envF = e))
expect_identical(r(), list(11, 11))
})
test_that(paste0("Works with raw quosures, quoted = TRUE: ", info$name), {
e <- list2env(list(a=10))
x <- new_quosure(quote({ a + 1 }) , env = e)
ans <- renderH(x, quotedF = TRUE)()
expect_identical(ans, list(11, 11))
})
test_that(paste0("Works with injecting raw quosures: ", info$name), {
e <- list2env(list(a=10))
x <- new_quosure(quote({ a + 1 }) , env = e)
ans <- inject(renderH(!!x))()
expect_identical(ans, list(11, 11))
})
test_that(paste0("Missing env with quosure, quoted = TRUE: ", info$name), {
e <- list2env(list(a=10))
x <- new_quosure(quote({ a + 1 }) , env = e)
ans <- renderH(x, envF = rlang::missing_arg(), quotedF = TRUE)()
expect_identical(ans, list(11, 11))
})
# All below should always error
expect_error(inject(renderH(!!x, quotedF = F)), "alter your quosure")
expect_error(inject(renderH(!!x, quotedF = T)), "alter your quosure")
expect_error(inject(renderH(!!x, envF = e)), "alter your quosure")
expect_error(inject(renderH(!!x, envF = environment())), "alter your quosure")
})
}
}
test_that(paste0("Works with inject / !!: ", info$name), {
@@ -260,11 +251,13 @@ for (info in list(
r1 <- inject(renderH({ !!a }))
r2 <- renderH({ eval_tidy(quo(!!a)) })
a <- 100
expect_identical(r1(), "1, 1")
expect_identical(r2(), "100, 100")
expect_identical(r1(), list(1,1))
expect_identical(r2(), list(100, 100))
})
})
}
})
test_that("nested observe events work with exprToFunction", {

View File

@@ -15,7 +15,6 @@ local({
unlist(lapply(yaml::yaml.load_file(pkgdown_file)$reference, function(x) x$contents))
}
indexed_topics <- get_indexed(pkgdown_file)
all_topics <- get_exported()
@@ -29,30 +28,48 @@ local({
})
})
)
# TODO check for internal help pages and not warn about them
# TODO .. or check that pkgdown::build_reference_index() does not produce warnings
known_unindexed <- c("shiny-package", "stacktrace", "knitr_methods",
"pageWithSidebar", "headerPanel", "shiny.appobj",
"reexports", "makeReactiveBinding",
"reactiveConsole", "registerThemeDependency",
"memoryCache", "diskCache", "shinyDeprecated")
## This test ensures that every documented topic is included in
## staticdocs/index.r, unless explicitly waived by specifying it
## in the known_unindexed variable above.
missing <- setdiff(all_topics, c(known_unindexed, indexed_topics))
## Explicitly add reexports man files as they will be added at shiny-dev-center documentation build time
unknown <- setdiff(c(known_unindexed, indexed_topics), c(all_topics, reexports_man_file_names))
## as `@keywords internal`
no_entry_topics <- setdiff(all_topics, indexed_topics)
internal_topics <- unlist(lapply(
all_topics,
function(topic) {
topic_txt <- readLines(rprojroot::find_package_root_file(paste0("man/", topic, ".Rd")))
if (
any(grepl("\\keyword{internal}", topic_txt, fixed = TRUE)) ||
any(grepl("\\docType{package}", topic_txt, fixed = TRUE))
) {
# Return internal topic name
topic
} else {
NULL
}
}
))
testthat::expect_equal(length(missing), 0,
# # Make sure internal functions to NOT have an entry
# displayed_internal_topics <- internal_topics[internal_topics %in% indexed_topics]
# testthat::expect_equal(length(displayed_internal_topics), 0,
# info = paste("Functions listed in ./tools/documentation/pkgdown.yml but has the keyword internal:\n",
# paste(" - ", displayed_internal_topics, sep = "", collapse = "\n"),
# "\nPlease update ./tools/documentation/pkgdown.yml or make it `#' @keywords internal`",
# sep = ""))
# Make sure there are no non-internal topics have an entry
missing_entry_topics <- setdiff(no_entry_topics, internal_topics)
testthat::expect_equal(length(missing_entry_topics), 0,
info = paste("Functions missing from ./tools/documentation/pkgdown.yml:\n",
paste(" - ", missing, sep = "", collapse = "\n"),
"\nPlease update ./tools/documentation/pkgdown.yml or ",
"`known_unindexed` in ./tools/documentation/checkPkgdown.R",
paste(" - ", missing_entry_topics, sep = "", collapse = "\n"),
"\nPlease update ./tools/documentation/pkgdown.yml or remove `#' @keywords internal`",
sep = ""))
testthat::expect_equal(length(unknown), 0,
## Explicitly add reexports man files as they will be added at shiny-dev-center documentation build time
unknown_topics <- setdiff(indexed_topics, c(all_topics, reexports_man_file_names))
testthat::expect_equal(length(unknown_topics), 0,
info = paste("Unrecognized functions in ./tools/documentation/pkgdown.yml:\n",
paste(" - ", unknown, sep = "", collapse = "\n"),
paste(" - ", unknown_topics, sep = "", collapse = "\n"),
"\nPlease update ./tools/documentation/pkgdown.yml",
sep = ""))
invisible(TRUE)

View File

@@ -130,11 +130,6 @@ reference:
- reactiveTimer
- domains
- freezeReactiveValue
- title: Boilerplate
desc: Functions that are required boilerplate in ui.R and server.R.
contents:
- shinyUI
- shinyServer
- title: Running
desc: Functions that are used to run or stop Shiny applications.
contents:
@@ -177,11 +172,8 @@ reference:
- onFlush
- restoreInput
- applyInputHandlers
- exprToFunction
- quoToFunction
- parseQueryString
- getCurrentOutputInfo
- getCurrentTheme
- plotPNG
- sizeGrowthRatio
- exportTestValues
@@ -189,7 +181,6 @@ reference:
- snapshotExclude
- snapshotPreprocessInput
- snapshotPreprocessOutput
- markOutputAttrs
- repeatable
- serverInfo
- onStop
@@ -218,3 +209,10 @@ reference:
- runTests
- testServer
- MockShinySession
- title: Superseded
desc: Functions that have been `r lifecycle::badge("superseded")`
contents:
- markRenderFunction
- shinyUI
- shinyServer
- exprToFunction