R/utils.R

In bones: Content-Shaped Loading Placeholders for 'shiny' Outputs

`%||%` <- function(x, y) if (is.null(x)) y else x

#' The names of the animations, in the order of the documentation
#' @keywords internal
#' @noRd
animation_types <- function() {
  c("wave", "pulse", "cascade", "sweep", "none")
}

#' Give NULL for NA, so that htmltools does not write the attribute
#' @keywords internal
#' @noRd
na_to_null <- function(x) {
  if (length(x) == 0L || is.na(x[1])) NULL else x[1]
}

#' Join CSS declarations into one style attribute
#'
#' @param declarations A character vector, such as `"height: 10px;"`.
#' @return A string, or `NULL` when there are no declarations, so that
#'   htmltools does not write an empty `style` attribute.
#' @keywords internal
#' @noRd
style_attr <- function(declarations) {
  if (length(declarations) == 0L) return(NULL)
  paste(declarations, collapse = " ")
}

#' Stop unless `x` is a single finite number
#'
#' Counts below one are not an error. The shape functions make them one, so
#' a count that comes from data with no rows still gives a placeholder.
#'
#' @param x The value to check.
#' @param name The name of the argument, for the message.
#' @return `x`, invisibly.
#' @keywords internal
#' @noRd
check_count <- function(x, name) {
  # is.finite() is FALSE for NA and for Inf. Inf would become NA in
  # as.integer(), and then fail inside seq_len() with an unclear message.
  if (!is.numeric(x) || length(x) != 1L || !is.finite(x)) {
    stop(sprintf("`%s` must be a single number.", name), call. = FALSE)
  }
  invisible(x)
}

#' Make `x` a CSS length, or stop
#'
#' Uses htmltools::validateCssUnit(), so a height works as it does in
#' Shiny: `300` becomes `"300px"`, and a string such as `"banana"` is an
#' error. That function lets NA through, so this one stops it first.
#'
#' @param x `NULL`, a number of pixels, or a CSS length as a string.
#' @param name The name of the argument, for the message.
#' @return `NULL`, or a CSS length as a string.
#' @keywords internal
#' @noRd
as_css_length <- function(x, name) {
  if (is.null(x)) return(NULL)
  if (length(x) != 1L || is.na(x)) {
    stop(sprintf("`%s` must be a single CSS length, such as \"300px\".", name),
         call. = FALSE)
  }
  htmltools::validateCssUnit(x)
}

#' Stop unless `x` is a single time in milliseconds
#'
#' @param x The value to check.
#' @param name The name of the argument, for the message.
#' @return `x`, invisibly.
#' @keywords internal
#' @noRd
check_ms <- function(x, name) {
  if (!is.numeric(x) || length(x) != 1L || !is.finite(x) || x < 0) {
    stop(sprintf("`%s` must be a single number of milliseconds, 0 or more.", name),
         call. = FALSE)
  }
  invisible(x)
}

#' Stop unless `x` is TRUE or FALSE
#'
#' @param x The value to check.
#' @param name The name of the argument, for the message.
#' @return `x`, invisibly.
#' @keywords internal
#' @noRd
check_flag <- function(x, name) {
  if (!is.logical(x) || length(x) != 1L || is.na(x)) {
    stop(sprintf("`%s` must be TRUE or FALSE.", name), call. = FALSE)
  }
  invisible(x)
}