R/pipe_helpers.R

Defines functions pipeline_on_exit pipeline_info pipe_autoexec

# from @smbache Stefan Milton Bache

#' Toggle Auto Execution On or Off for Pipelines
#'
#' A call to \code{pipe_autoexec} allows a function to toggle auto execution of
#' \code{http} on or off at the end of a pipeline.
#'
#' @param toggle logical: \code{TRUE} toggles auto execution on, \code{FALSE}
#'   toggles auto execution off.
#'
#' @details Once auto execution is turned on the \code{result} identifier inside
#' the pipeline is bound to an "Active Binding". This will not be changed on
#' toggling auto execution off, but rather the function to be executed is
#' changed to \code{identity}.
#'
#' @noRd
pipe_autoexec <- function(toggle, method = "GET") {
  if (!identical(toggle, TRUE) && !identical(toggle, FALSE)) {
    stop("Argument 'toggle' must be logical.")
  }

  info <- pipeline_info()

  if (isTRUE(info[["is_piped"]])) {
    pipeline_on_exit(info$env)
    info$env$.http_exitfun <- if (toggle) http else identity
    # info$env$.http_exitfun <- if (toggle) http2 else identity
  }

  invisible()
}

#' Information on Potential Pipeline
#'
#' This function figures out whether it is called from within a pipeline.
#' It does so by examining the parent evironment of the active system frames,
#' and whether any of these are the same as the enclosing environment of
#' \code{\%>\%}.
#'
#' @return A list with the values \code{is_piped} (logical) and \code{env}
#'   (an environment reference). The former is \code{TRUE} if a pipeline is
#'   identified as \code{FALSE} otherwise. The latter holds a reference to
#'   the \code{\%>\%} frame where the pipeline is created and evaluated.
#'
#' @noRd
pipeline_info <- function() {
  parents <- lapply(sys.frames(), parent.env)

  is_magrittr_env <-
    vapply(parents, identical, logical(1), y = environment(`%>%`))

  is_piped <- any(is_magrittr_env)

  list(is_piped = is_piped,
       env      = if (is_piped) sys.frames()[[min(which(is_magrittr_env))]])
}

#' Setup On-Exit Action for a Pipeline
#'
#' A call to \code{pipeline_on_exit} will setup the pipeline for auto execution by
#' making \code{result} inside \code{\%>\%} an active binding. The initial
#' call will register the \code{identity} function as the exit action,
#' but this can be changed to \code{jq} with a call to \code{pipe_autoexec}.
#' Subsequent calls to \code{pipeline_on_exit} has no effect.
#'
#' @param env A reference to the \code{\%>\%} environment, in which
#'   \code{result} is to be bound.
#'
#' @noRd
pipeline_on_exit <- function(env) {
  # Only activate the first time; after this the binding is already active.
  if (exists(".http_exitfun", envir = env, inherits = FALSE, mode = "function")) {
    return(invisible())
  }
  env$.http_exitfun <- identity

  res <- NULL

  http_result <- function(v) {
    if (missing(v)) {
      res
    }
    else {
      res <<- `$<-`(v, value, env$.http_exitfun(v$value))
    }
  }

  makeActiveBinding("result", http_result, env)
}
sckott/request documentation built on Sept. 5, 2017, 7:22 p.m.