Nothing
#' Check if R package can be loaded and fails loudly otherwise
#' @param pkg string
#' @param min_version optional minimum version needed
#' @export
#' @importFrom utils packageVersion compareVersion
#' @examples \dontrun{
#' f <- function() fail_on_missing_package('foobar')
#' f()
#' g <- function() fail_on_missing_package('stats')
#' g()
#' }
fail_on_missing_package <- function(pkg, min_version) {
pc <- sys.call(which = 1)
if (!requireNamespace(pkg, quietly = TRUE)) {
stop(sprintf(
'Please install the %s package to use %s',
shQuote(pkg),
deparse(pc[[1]])),
call. = FALSE)
}
if (!missing(min_version)) {
if (compareVersion(min_version, as.character(packageVersion(pkg))) == 1) {
stop(sprintf(
'Please install min. %s version of %s to use %s',
min_version,
pkg,
deparse(pc[[1]])),
call. = FALSE)
}
}
}
#' Returns the name of the top level environment from which the logger was called
#' @return string
#' @keywords internal
#' @param .topenv call environment
top_env_name <- function(.topenv = parent.frame()) {
environmentName(topenv(.topenv))
}
#' Deparse and join all lines into a single line
#'
#' Calling \code{deparse} and joining all the returned lines into a
#' single line, separated by whitespace, and then cleaning up all the
#' duplicated whitespace (except for excessive whitespace in strings
#' between single or double quotes).
#' @param x object to \code{deparse}
#' @return string
#' @export
deparse_to_one_line <- function(x) {
gsub('\\s+(?=(?:[^\\\'"]*[\\\'"][^\\\'"]*[\\\'"])*[^\\\'"]*$)', ' ',
paste(deparse(x), collapse = ' '),
perl = TRUE)
}
#' Catch the log header
#' @return string
#' @keywords internal
#' @param level see \code{\link{log_levels}}
#' @param namespace string
#' @examples
#' \dontrun{
#' catch_base_log(INFO, NA_character_)
#' logger <- layout_glue_generator(format = '{node}/{pid}/{namespace}/{fn} {time} {level}: {msg}')
#' log_layout(logger)
#' catch_base_log(INFO, NA_character_)
#' fun <- function() catch_base_log(INFO, NA_character_)
#' fun()
#' catch_base_log(INFO, NA_character_, .topcall = call('funLONG'))
#' }
catch_base_log <- function(
level,
namespace,
.topcall = sys.call(-1),
.topenv = parent.frame()
) {
namespace <- fallback_namespace(namespace)
orginal_appender <- log_appender(namespace = namespace)
log_appender(appender_console, namespace = namespace)
# catch error, warning or message
res <- capture.output(
log_level(level = level,
"",
namespace = namespace,
.topcall = .topcall,
.topenv = .topenv),
type = 'message'
)
log_appender(orginal_appender, namespace = namespace)
res
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.