R/context-manager.R

Defines functions temp.options with.contextManager ContextManager

Documented in ContextManager temp.options with.contextManager

#' Context managers
#'
#' @param enter function to run before taking actions
#' @param exit function to run after taking actions
#' @param error optional function to run if an error is thrown
#' @param as character optional way to specify a default name for assigning
#' the return of the enter function.
#' @return an S3 class "contextManager" object
#' @seealso `with-context-manager`
#' @aliases contextManager
#' @export
ContextManager <- function(enter = function() {}, exit = function() {}, # nolint
                           error = NULL, as = NULL) {
    structure(list(enter = enter, exit = exit, error = error, as = as),
        class = "contextManager"
    )
}

#' Context manager's "with" method
#'
#' @param data [`contextManager`]
#' @param expr code to evaluate within that context
#' @param ... additional arguments. One additional supported argument is "as",
#' which lets you assign the return of your "enter" function to an object you
#' can access.
#' @return Nothing.
#' @name with-context-manager
#' @seealso [`ContextManager`]
#' @export
with.contextManager <- function(data, expr, ...) {
    env <- parent.frame()
    on.exit(data$exit())
    setup <- data$enter()
    dots <- list(...)
    as.name <- dots$as %||% data$as
    if (!is.null(as.name)) {
        assign(as.name, setup, envir = env)
        ## rm this after running? or add the rm step to the exit
    }
    if (is.function(data$error)) {
        tryCatch(eval(substitute(expr), envir = parent.frame()), error = data$error)
    } else {
        eval(substitute(expr), envir = parent.frame())
    }
}

#' Set some global options temporarily
#'
#' @param ... named options to set
#' @return an S3 class "contextManager" object
#' @seealso [`with-context-manager`] [`ContextManager`]
#' @export
temp.options <- function(...) {
    new <- list(...)
    old <- sapply(names(new), getOption, simplify = FALSE)
    return(ContextManager(
        function() do.call(options, new),
        function() do.call(options, old)
    ))
}

#' @rdname temp.options
#' @export
temp.option <- temp.options

Try the crunch package in your browser

Any scripts or data that you put into this service are public.

crunch documentation built on April 6, 2021, 1:05 a.m.