R/utils.R

In tjpalanca/webtools: Web Server Tools

#' @title Stop all applications
#'
#' @description Stops all `{httpuv}`-based applications.
#'
#' @export
stop_all <- function() {
  stopAllServers()
}

match_arg <- function(arg, assert = TRUE) {

  if (is.null(arg)) return(NULL)
  sys_parent <- sys.parent()
  formal_args <- formals(sys.function(sys_parent))
  choices <- eval(formal_args[[as.character(substitute(arg))]],
                  envir = sys.frame(sys_parent))

  if (length(arg) > 1 || identical(arg, choices)) {
    NULL
  } else {
    if (assert) assert_choice(arg, choices)
    arg
  }

}

#' @title Assert Route Handler
#' @param fun (fun) to check
#' @export
assert_route_handler <- function(fun) {

  assert_function(fun, c("request", "response", "keys", "..."))

}

#' @title Assert tags
#' @param tag (tag) to check
#' @export
assert_tags <- function(tag) {

  assert_multi_class(tag, c("shiny.tag.list", "shiny.tag"))

}

when <- function(x, flag, value) {

  assert_flag(flag)
  if (flag) value else x

}

add_attr <- function(obj, ...) {

  set_attributes(obj, modifyList(attributes(obj) %||% list(), list(...)))

}