Replace %OR% with %||% from rlang (#3172)

NAMESPACE

@@ -389,6 +389,7 @@ importFrom(promises,is.promising)
 importFrom(promises,promise)
 importFrom(promises,promise_reject)
 importFrom(promises,promise_resolve)
+importFrom(rlang,"%||%")
 importFrom(rlang,as_function)
 importFrom(rlang,as_quosure)
 importFrom(rlang,enexpr)
@@ -400,6 +401,7 @@ importFrom(rlang,expr)
 importFrom(rlang,get_env)
 importFrom(rlang,get_expr)
 importFrom(rlang,inject)
+importFrom(rlang,is_na)
 importFrom(rlang,is_quosure)
 importFrom(rlang,new_function)
 importFrom(rlang,new_quosure)

R/bind-cache.R

@@ -703,8 +703,8 @@ bindCache.shiny.renderPlot <- function(x, ...,
       }
       session <- getDefaultReactiveDomain()
 
-      width  <- session$clientData[[paste0('output_', outputName, '_width')]]  %OR% 0
-      height <- session$clientData[[paste0('output_', outputName, '_height')]] %OR% 0
+      width  <- session$clientData[[paste0('output_', outputName, '_width')]]  %||% 0
+      height <- session$clientData[[paste0('output_', outputName, '_height')]] %||% 0
 
       rect <- sizePolicy(c(width, height))
       fitDims(list(width = rect[1], height = rect[2]))
@@ -755,7 +755,7 @@ bindCache.shiny.renderPlot <- function(x, ...,
       if (is.null(session) || is.null(fitDims())) {
         req(FALSE)
       }
-      pixelratio <- session$clientData$pixelratio %OR% 1
+      pixelratio <- session$clientData$pixelratio %||% 1
 
       list(fitDims(), pixelratio)
     },

R/bind-event.R

@@ -189,7 +189,7 @@ bindEvent.reactiveExpr <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE
   valueFunc <- reactive_get_value_func(x)
   valueFunc <- wrapFunctionLabel(valueFunc, "eventReactiveValueFunc", ..stacktraceon = TRUE)
 
-  label <- label %OR%
+  label <- label %||%
     sprintf('bindEvent(%s, %s)', attr(x, "observable", exact = TRUE)$.label, quos_to_label(qs))
 
   # Don't hold on to the reference for x, so that it can be GC'd
@@ -262,7 +262,7 @@ bindEvent.Observer <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE,
 
   # Note that because the observer will already have been logged by this point,
   # this updated label won't show up in the reactlog.
-  x$.label <- label %OR% sprintf('bindEvent(%s, %s)', x$.label, quos_to_label(qs))
+  x$.label <- label %||% sprintf('bindEvent(%s, %s)', x$.label, quos_to_label(qs))
 
   initialized <- FALSE
 

R/bootstrap-layout.R

@@ -440,7 +440,7 @@ verticalLayout <- function(..., fluid = TRUE) {
 flowLayout <- function(..., cellArgs = list()) {
 
   children <- list(...)
-  childIdx <- !nzchar(names(children) %OR% character(length(children)))
+  childIdx <- !nzchar(names(children) %||% character(length(children)))
   attribs <- children[!childIdx]
   children <- children[childIdx]
 
@@ -523,7 +523,7 @@ inputPanel <- function(...) {
 splitLayout <- function(..., cellWidths = NULL, cellArgs = list()) {
 
   children <- list(...)
-  childIdx <- !nzchar(names(children) %OR% character(length(children)))
+  childIdx <- !nzchar(names(children) %||% character(length(children)))
   attribs <- children[!childIdx]
   children <- children[childIdx]
   count <- length(children)

R/bootstrap.R

@@ -209,7 +209,7 @@ bootstrapDependency <- function(theme) {
       "accessibility/js/bootstrap-accessibility.min.js"
     ),
     stylesheet = c(
-      theme %OR% "css/bootstrap.min.css",
+      theme %||% "css/bootstrap.min.css",
       # Safely adding accessibility plugin for screen readers and keyboard users; no break for sighted aspects (see https://github.com/paypal/bootstrap-accessibility-plugin)
       "accessibility/css/bootstrap-accessibility.css"
     ),
@@ -868,7 +868,7 @@ findAndMarkSelectedTab <- function(tabs, selected, foundSelected) {
         foundSelected <<- TRUE
         div <- markTabAsSelected(div)
       } else {
-        tabValue <- div$attribs$`data-value` %OR% div$attribs$title
+        tabValue <- div$attribs$`data-value` %||% div$attribs$title
         if (identical(selected, tabValue)) {
           foundSelected <<- TRUE
           div <- markTabAsSelected(div)

R/deprecated.R

@@ -11,7 +11,7 @@ shinyDeprecated <- function(new=NULL, msg=NULL,
                             old=as.character(sys.call(sys.parent()))[1L],
                             version = NULL) {
 
-  if (getOption("shiny.deprecation.messages") %OR% TRUE == FALSE)
+  if (getOption("shiny.deprecation.messages") %||% TRUE == FALSE)
     return(invisible())
 
   if (is.null(msg)) {

R/graph.R

@@ -10,7 +10,7 @@ check_suggested <- function(package, version = NULL) {
 
   msg <- paste0(
     sQuote(package),
-    if (is.na(version %OR% NA)) "" else paste0("(>= ", version, ")"),
+    if (is.na(version %||% NA)) "" else paste0("(>= ", version, ")"),
     " must be installed for this functionality."
   )
 

R/image-interact.R

@@ -92,11 +92,21 @@ brushedPoints <- function(df, brush, xvar = NULL, yvar = NULL,
   use_x <- grepl("x", brush$direction)
   use_y <- grepl("y", brush$direction)
 
+  # We transitioned to using %||% in Shiny 1.6.0. Previously, these vars could
+  # be NA, because the old %OR% operator recognized NA. These warnings and
+  # the NULL replacement are here just to ease the transition in case anyone is
+  # using NA. We can remove these checks in a future version of Shiny.
+  # https://github.com/rstudio/shiny/pull/3172
+  if (is.na(xvar))      { xvar      <- NULL; warning("xvar should be NULL, not NA.") }
+  if (is.na(yvar))      { yvar      <- NULL; warning("yvar should be NULL, not NA.") }
+  if (is.na(panelvar1)) { panelvar1 <- NULL; warning("panelvar1 should be NULL, not NA.") }
+  if (is.na(panelvar2)) { panelvar2 <- NULL; warning("panelvar2 should be NULL, not NA.") }
+
   # Try to extract vars from brush object
-  xvar      <- xvar      %OR% brush$mapping$x
-  yvar      <- yvar      %OR% brush$mapping$y
-  panelvar1 <- panelvar1 %OR% brush$mapping$panelvar1
-  panelvar2 <- panelvar2 %OR% brush$mapping$panelvar2
+  xvar      <- xvar      %||% brush$mapping$x
+  yvar      <- yvar      %||% brush$mapping$y
+  panelvar1 <- panelvar1 %||% brush$mapping$panelvar1
+  panelvar2 <- panelvar2 %||% brush$mapping$panelvar2
 
   # Filter out x and y values
   keep_rows <- rep(TRUE, nrow(df))
@@ -230,11 +240,21 @@ nearPoints <- function(df, coordinfo, xvar = NULL, yvar = NULL,
     stop("nearPoints requires a click/hover/double-click object with x and y values.")
   }
 
+  # We transitioned to using %||% in Shiny 1.6.0. Previously, these vars could
+  # be NA, because the old %OR% operator recognized NA. These warnings and
+  # the NULL replacement are here just to ease the transition in case anyone is
+  # using NA. We can remove these checks in a future version of Shiny.
+  # https://github.com/rstudio/shiny/pull/3172
+  if (is.na(xvar))      { xvar      <- NULL; warning("xvar should be NULL, not NA.") }
+  if (is.na(yvar))      { yvar      <- NULL; warning("yvar should be NULL, not NA.") }
+  if (is.na(panelvar1)) { panelvar1 <- NULL; warning("panelvar1 should be NULL, not NA.") }
+  if (is.na(panelvar2)) { panelvar2 <- NULL; warning("panelvar2 should be NULL, not NA.") }
+
   # Try to extract vars from coordinfo object
-  xvar      <- xvar      %OR% coordinfo$mapping$x
-  yvar      <- yvar      %OR% coordinfo$mapping$y
-  panelvar1 <- panelvar1 %OR% coordinfo$mapping$panelvar1
-  panelvar2 <- panelvar2 %OR% coordinfo$mapping$panelvar2
+  xvar      <- xvar      %||% coordinfo$mapping$x
+  yvar      <- yvar      %||% coordinfo$mapping$y
+  panelvar1 <- panelvar1 %||% coordinfo$mapping$panelvar1
+  panelvar2 <- panelvar2 %||% coordinfo$mapping$panelvar2
 
   if (is.null(xvar))
     stop("nearPoints: not able to automatically infer `xvar` from coordinfo")

R/imageutils.R

@@ -4,12 +4,12 @@ startPNG <- function(filename, width, height, res, ...) {
   # to use ragg (say, instead of showtext, for custom font rendering).
   # In the next shiny release, this option will likely be superseded in
   # favor of a fully customizable graphics device option
-  if ((getOption('shiny.useragg') %OR% FALSE) && is_available("ragg")) {
+  if ((getOption('shiny.useragg') %||% FALSE) && is_available("ragg")) {
     pngfun <- ragg::agg_png
   } else if (capabilities("aqua")) {
     # i.e., png(type = 'quartz')
     pngfun <- grDevices::png
-  } else if ((getOption('shiny.usecairo') %OR% TRUE) && is_available("Cairo")) {
+  } else if ((getOption('shiny.usecairo') %||% TRUE) && is_available("Cairo")) {
     pngfun <- Cairo::CairoPNG
   } else {
     # i.e., png(type = 'cairo')

R/knitr.R

@@ -25,7 +25,7 @@ shiny_rmd_warning <- function() {
 
 #' @rdname knitr_methods
 knit_print.shiny.appobj <- function(x, ...) {
-  opts <- x$options %OR% list()
+  opts <- x$options %||% list()
   width <- if (is.null(opts$width)) "100%" else opts$width
   height <- if (is.null(opts$height)) "400" else opts$height
 

R/middleware.R

@@ -309,7 +309,7 @@ HandlerManager <- R6Class("HandlerManager",
     createHttpuvApp = function() {
       list(
         onHeaders = function(req) {
-          maxSize <- getOption('shiny.maxRequestSize') %OR% (5 * 1024 * 1024)
+          maxSize <- getOption('shiny.maxRequestSize') %||% (5 * 1024 * 1024)
           if (maxSize <= 0)
             return(NULL)
 

R/reactives.R

@@ -2454,7 +2454,7 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
     now <- getDomainTimeMs(domain)
     if (now >= v$when) {
       # Mod by 999999999 to get predictable overflow behavior
-      v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 + 1
+      v$trigger <- isolate(v$trigger %||% 0) %% 999999999 + 1
       v$when <- NULL
     } else {
       invalidateLater(v$when - now)

R/render-plot.R

@@ -123,7 +123,7 @@ renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
       {
         # If !execOnResize, don't invalidate when width/height changes.
         dims <- if (execOnResize) getDims() else isolate(getDims())
-        pixelratio <- session$clientData$pixelratio %OR% 1
+        pixelratio <- session$clientData$pixelratio %||% 1
         do.call("drawPlot", c(
           list(
             name = outputName,
@@ -162,7 +162,7 @@ renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
       drawReactive(),
       function(result) {
         dims <- getDims()
-        pixelratio <- session$clientData$pixelratio %OR% 1
+        pixelratio <- session$clientData$pixelratio %||% 1
         result <- do.call("resizeSavedPlot", c(
           list(name, shinysession, result, dims$width, dims$height, altWrapper(), pixelratio, res),
           args
@@ -610,6 +610,10 @@ find_panel_info_api <- function(b) {
   coord  <- ggplot2::summarise_coord(b)
   layers <- ggplot2::summarise_layers(b)
 
+  `%NA_OR%` <- function(x, y) {
+    if (is_na(x)) y else x
+  }
+
   # Given x and y scale objects and a coord object, return a list that has
   # the bases of log transformations for x and y, or NULL if it's not a
   # log transform.
@@ -626,8 +630,8 @@ find_panel_info_api <- function(b) {
 
     # First look for log base in scale, then coord; otherwise NULL.
     list(
-      x = get_log_base(xscale$trans) %OR% coord$xlog %OR% NULL,
-      y = get_log_base(yscale$trans) %OR% coord$ylog %OR% NULL
+      x = get_log_base(xscale$trans) %NA_OR% coord$xlog %NA_OR% NULL,
+      y = get_log_base(yscale$trans) %NA_OR% coord$ylog %NA_OR% NULL
     )
   }
 

R/shiny.R

@@ -33,7 +33,7 @@ NULL
 #'   as.promise
 #' @importFrom rlang quo enquo as_function get_expr get_env new_function enquos
 #'   eval_tidy expr pairlist2 new_quosure enexpr as_quosure is_quosure inject
-#'   enquos0 zap_srcref
+#'   enquos0 zap_srcref %||% is_na
 #' @importFrom ellipsis check_dots_empty check_dots_unnamed
 NULL
 
@@ -487,7 +487,7 @@ ShinySession <- R6Class(
           # The format of the response that will be sent back. Defaults to
           # "json" unless requested otherwise. The only other valid value is
           # "rds".
-          format <- params$format %OR% "json"
+          format <- params$format %||% "json"
 
           values <- list()
 
@@ -618,14 +618,14 @@ ShinySession <- R6Class(
     # function has been set, return the identity function.
     getSnapshotPreprocessOutput = function(name) {
       fun <- attr(private$.outputs[[name]], "snapshotPreprocess", exact = TRUE)
-      fun %OR% identity
+      fun %||% identity
     },
 
     # Get the snapshotPreprocessInput function for an input name. If no preprocess
     # function has been set, return the identity function.
     getSnapshotPreprocessInput = function(name) {
       fun <- private$.input$getMeta(name, "shiny.snapshot.preprocess")
-      fun %OR% identity
+      fun %||% identity
     },
 
     # See cycleStartAction
@@ -1411,7 +1411,7 @@ ShinySession <- R6Class(
         return(NULL)
       }
 
-      tmp_info <- private$outputInfo[[name]] %OR% list(name = name)
+      tmp_info <- private$outputInfo[[name]] %||% list(name = name)
 
       # cd_names() returns names of all items in clientData, without taking a
       # reactive dependency. It is a function and it's memoized, so that we do
@@ -1457,7 +1457,7 @@ ShinySession <- R6Class(
       # that string isn't a valid CSS color, will return NA)
       # https://github.com/rstudio/htmltools/issues/161
       parse_css_colors <- function(x) {
-        htmltools::parseCssColors(x %OR% "", mustWork = FALSE)
+        htmltools::parseCssColors(x %||% "", mustWork = FALSE)
       }
 
       bg <- paste0("output_", name, "_bg")
@@ -1919,15 +1919,17 @@ ShinySession <- R6Class(
                   }
                   return(httpResponse(
                     200,
-                    download$contentType %OR% getContentType(filename),
+                    download$contentType %||% getContentType(filename),
                     # owned=TRUE means tmpdata will be deleted after response completes
                     list(file=tmpdata, owned=TRUE),
                     c(
                       'Content-Disposition' = ifelse(
                         dlmatches[3] == '',
-                        'attachment; filename="' %.%
-                          gsub('(["\\\\])', '\\\\\\1', filename) %.%  # yes, that many \'s
-                          '"',
+                        paste0(
+                          'attachment; filename="',
+                          gsub('(["\\\\])', '\\\\\\1', filename),
+                          '"'
+                        ),
                         'attachment'
                       ),
                       'Cache-Control'='no-cache')))

R/shinyapp.R

@@ -569,7 +569,7 @@ as.tags.shiny.appobj <- function(x, ...) {
   # jcheng 06/06/2014: Unfortunate copy/paste between this function and
   # knit_print.shiny.appobj, but I am trying to make the most conservative
   # change possible due to upcoming release.
-  opts <- x$options %OR% list()
+  opts <- x$options %||% list()
   width <- if (is.null(opts$width)) "100%" else opts$width
   height <- if (is.null(opts$height)) "400" else opts$height
 

R/shinyui.R

@@ -142,7 +142,7 @@ uiHttpHandler <- function(ui, uiPattern = "^/$") {
 
   allowed_methods <- "GET"
   if (is.function(ui)) {
-    allowed_methods <- attr(ui, "http_methods_supported", exact = TRUE) %OR% allowed_methods
+    allowed_methods <- attr(ui, "http_methods_supported", exact = TRUE) %||% allowed_methods
   }
 
   function(req) {

R/shinywrappers.R

@@ -431,7 +431,7 @@ renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
       }
 
       # If contentType not specified, autodetect based on extension
-      contentType <- imageinfo$contentType %OR% getContentType(imageinfo$src)
+      contentType <- imageinfo$contentType %||% getContentType(imageinfo$src)
 
       # Extra values are everything in imageinfo except 'src' and 'contentType'
       extra_attr <- imageinfo[!names(imageinfo) %in% c('src', 'contentType')]

R/utils.R

@@ -113,24 +113,6 @@ isWholeNum <- function(x, tol = .Machine$double.eps^0.5) {
   abs(x - round(x)) < tol
 }
 
-`%OR%` <- function(x, y) {
-  if (is.null(x) || isTRUE(is.na(x)))
-    y
-  else
-    x
-}
-
-`%AND%` <- function(x, y) {
-  if (!is.null(x) && !isTRUE(is.na(x)))
-    if (!is.null(y) && !isTRUE(is.na(y)))
-      return(y)
-  return(NULL)
-}
-
-`%.%` <- function(x, y) {
-  paste(x, y, sep='')
-}
-
 # Given a vector or list, drop all the NULL items in it
 dropNulls <- function(x) {
   x[!vapply(x, is.null, FUN.VALUE=logical(1))]

tests/testthat/test-test-server.R

@@ -566,7 +566,7 @@ test_that("validates server function", {
 # bindings are considered `fields`.
 get_mocked_publics <- function(instance, generator) {
   publics <- ls(instance, all.names = TRUE)
-  actives <- names(generator$active) %OR% character(0)
+  actives <- names(generator$active) %||% character(0)
   # Active bindings are considered fields.
   methods_or_fields <- publics[!(publics %in% actives)]
   methods <- character(0)