R/staticimports.R

In learnr: Interactive Tutorials for R

# Generated by staticimports; do not edit by hand.
# ======================================================================
# Imported from inst/staticexports/
# ======================================================================

is_AsIs <- function(x) {
  inherits(x, "AsIs")
}

is_html_any <- function(x) {
  is_html_tag(x) || is_html_chr(x)
}

is_html_chr <- function(x) {
  is.character(x) && inherits(x, "html")
}

is_html_tag <- function(x) {
  inherits(x, c("shiny.tag", "shiny.tag.list"))
}

knitr_engine_caption <- function(engine = NULL) {
  if (is.null(engine)) {
    engine <- "r"
  }

  switch(
    tolower(engine),
    "bash" = "Bash",
    "c" = "C",
    "coffee" = "CoffeeScript",
    "cc" = "C++",
    "css" = "CSS",
    "go" = "Go",
    "groovy" = "Groovy",
    "haskell" = "Haskell",
    "js" = "JavaScript",
    "mysql" = "MySQL",
    "node" = "Node.js",
    "octave" = "Octave",
    "psql" = "PostgreSQL",
    "python" = "Python",
    "r" = "R",
    "rcpp" = "Rcpp",
    "cpp11" = "cpp11",
    "rscript" = "Rscript",
    "ruby" = "Ruby",
    "perl" = "Perl",
    "sass" = "Sass",
    "scala" = "Scala",
    "scss" = "SCSS",
    "sql" = "SQL",
    # else, return as the user provided
    engine
  )
}

str_trim <- function(x, side = "both", character = "\\s") {
  if (side %in% c("both", "left", "start")) {
    rgx <- sprintf("^%s+", character)
    x <- sub(rgx, "", x)
  }
  if (side %in% c("both", "right", "end")) {
    rgx <- sprintf("%s+$", character)
    x <- sub(rgx, "", x)
  }
  x
}
# Generated by staticimports; do not edit by hand.
# ======================================================================
# Imported from pkg:staticimports
# ======================================================================

`%||%` <- function(a, b) {
  if (is.null(a)) b else a
}

compact <- function(.x) {
  .x[as.logical(vapply(.x, length, NA_integer_))]
}

get_package_version <- function(pkg) {
  # `utils::packageVersion()` can be slow, so first try the fast path of
  # checking if the package is already loaded.
  ns <- .getNamespace(pkg)
  if (is.null(ns)) {
    utils::packageVersion(pkg)
  } else {
    as.package_version(ns$.__NAMESPACE__.$spec[["version"]])
  }
}

imap_lgl <- function(.x, .f, ...) {
  map2_lgl(.x, vec_index(.x), .f, ...)
}

is_installed <- function(pkg, version = NULL) {
  installed <- isNamespaceLoaded(pkg) || nzchar(system_file_cached(package = pkg))
  if (is.null(version)) {
    return(installed)
  }
  installed && isTRUE(get_package_version(pkg) >= version)
}

is_linux   <- function() Sys.info()[['sysname']] == 'Linux'

is_mac     <- function() Sys.info()[['sysname']] == 'Darwin'

is_windows <- function() .Platform$OS.type == "windows"

map2 <- function(.x, .y, .f, ...) {
  res <- vector("list", length(.x))
  for (i in seq_along(.x)) {
    res[[i]] <- .f(.x[[i]], .y[[i]], ...)
  }
  names(res) <- names(.x)
  res
}

map2_lgl <- function(.x, .y, .f, ...) {
  res <- as.logical(map2(.x, .y, .f, ...))
  names(res) <- names(.x)
  res
}

os_name <- function() {
  if (is_windows()) {
    "win"
  } else if (is_mac()) {
    "mac"
  } else if (is_linux()) {
    "linux"
  } else if (.Platform$OS.type == "unix") {
    "unix"
  } else {
    "unknown"
  }
}

# A wrapper for `system.file()`, which caches the results, because
# `system.file()` can be slow. Note that because of caching, if
# `system_file_cached()` is called on a package that isn't installed, then the
# package is installed, and then `system_file_cached()` is called again, it will
# still return "".
system_file_cached <- local({
  pkg_dir_cache <- character()

  function(..., package = "base") {
    if (!is.null(names(list(...)))) {
      stop("All arguments other than `package` must be unnamed.")
    }

    not_cached <- is.na(match(package, names(pkg_dir_cache)))
    if (not_cached) {
      pkg_dir <- system.file(package = package)
      pkg_dir_cache[[package]] <<- pkg_dir
    } else {
      pkg_dir <- pkg_dir_cache[[package]]
    }

    file.path(pkg_dir, ...)
  }
})

vec_index <- function(x) {
  names(x) %||% seq_along(x)
}