R/macros.R

Defines functions flatten_deps_search_stack source_call_check target_call_check translate_macros eval_ast is_source_ast is_meta_ast is_blueprint_ast is_target_ast is_any_macro_ast is_macro_ast can_run_macros_interactively handle_macro mark_source .SOURCE .META .BLUEPRINT .TARGET

Documented in .BLUEPRINT mark_source .META .SOURCE .TARGET

#' Macros for blueprint authoring
#'
#' `blueprintr` uses code inspection to identify and trace dataset dependencies.
#' These macro functions signal a dependency to `blueprintr` and evaluate to
#' symbols to be analyzed in the `drake` plan.
#'
#' @param bp_name Character string of blueprint's name
#' @param dat_name Character string of an object's name, used exclusively
#'   for marking "sources"
#' @param dat A data.frame-like object
#' @param .env The environment in which to evaluate the macro. For internal
#'   use only!
#'
#' @details # When to use
#' Generally speaking, the `.BLUEPRINT` and `.META` macros should be used for
#' check functions, which frequently require context, e.g. in the form of
#' configuration from the blueprint or coding expectations from the metadata.
#' `.TARGET` is primarily used in blueprint commands, but there could be
#' situations where a check depends on the content of another dataset.
#'
#' It is important to note that the symbols generated by these macros are only
#' understood in the context of a `drake` plan. The targets associated with the
#' symbols are generated when blueprints are attached to a plan.
#'
#' # Sources
#' Sources are an ability to add variable UUIDs to objects that are not constructed
#' using blueprints. This is often the case if the sourced table derives from some
#' intermittent HTTP query or a file from disk. Blueprints have limited capability
#' of configuring the underlying target behavior during the `_initial` phase, so often
#' it is easier to do that sort of fetching and pre-processing before using blueprints.
#' However, you lose the benefit of variable lineage when you don't use blueprints.
#' "Sources" are simply data.frame-like objects that have the ".uuid" attribute for each
#' variable so that variable lineage can cover the full data lifetime. Use `blueprintr::mark_source()`
#' to add the UUID attributes, and then use `.SOURCE()` in the blueprints so lineage
#' can be captured
#'
#' @name blueprint_macros
#' @examples
#' .TARGET("example_dataset")
#' .BLUEPRINT("example_dataset")
#' .META("example_dataset")
#'
#' blueprint(
#'   "test_bp",
#'   description = "Blueprint with dependencies",
#'   command =
#'     .TARGET("parent1") %>%
#'       left_join(.TARGET("parent2"), by = "id") %>%
#'       filter(!is.na(id))
#' )
NULL

#' @describeIn blueprint_macros Gets symbol of built and checked data
#' @export
.TARGET <- function(bp_name, .env = parent.frame()) {
  handle_macro(blueprint_final_name(bp_name, .env = .env))
}

#' @describeIn blueprint_macros Gets symbol of blueprint reference in plan
#' @export
.BLUEPRINT <- function(bp_name, .env = parent.frame()) {
  handle_macro(blueprint_reference_name(bp_name, .env = .env))
}

#' @describeIn blueprint_macros Gets symbol of metadata reference in plan
#' @export
.META <- function(bp_name, .env = parent.frame()) {
  handle_macro(metadata_target_name(bp_name, .env = .env))
}

#' @describeIn blueprint_macros Gets a symbol for an object intended to be a
#'   "data source"
#' @export
.SOURCE <- function(dat_name) {
  handle_macro(dat_name)
}

#' @describeIn blueprint_macros Mark an data.frame-like object as a source table
#' @export
mark_source <- function(dat) {
  bp_assert(
    is.data.frame(dat),
    "Source objects must be tabular data"
  )

  add_variable_uuids(dat)
}

handle_macro <- function(macro_name) {
  if (interactive() && can_run_macros_interactively()) {
    if (!isTRUE(getOption("blueprintr.interactive_always_reload", default = TRUE))) {
      if (exists(macro_name, envir = globalenv())) {
        if (isTRUE(getOption("blueprintr.interactive_reload_warn", default = TRUE))) {
          message(
            "Using '", macro_name, "' in global environment. ",
            "Reload with targets::tar_load(). ",
            "(This message only displays once per session)."
          )

          options(blueprintr.interactive_reload_warn = FALSE)
        }

        return(get(macro_name, envir = globalenv()))
      }
    }

    # Only supports targets since targets supersedes drake now
    if (!requireNamespace("targets", quietly = TRUE)) {
      bp_err(c(
        "Interactive evaluation of blueprintr macros is only supported by targets. ",
        "If you'd like to use this feature, consider migrating to targets."
      ))
    }

    targets::tar_load_raw(macro_name, envir = globalenv())
    return(get(macro_name, envir = globalenv()))
  }

  as.name(macro_name)
}

can_run_macros_interactively <- function() {
  getOption("blueprintr.interactive_eval_macros", default = FALSE) &&
    !getOption("blueprintr.attach_state", default = FALSE)
}

is_macro_ast <- function(ast, .macro = ".TARGET") {
  if (!is_ast(ast)) {
    return(FALSE)
  }

  ast$head %in% .macro
}

is_any_macro_ast <- function(ast) {
  is_macro_ast(
    ast,
    .macro = c(".TARGET", ".BLUEPRINT", ".META", ".SOURCE")
  )
}

is_target_ast <- function(ast) {
  is_macro_ast(ast)
}

is_blueprint_ast <- function(ast) {
  is_macro_ast(ast, ".BLUEPRINT")
}

is_meta_ast <- function(ast) {
  is_macro_ast(ast, ".META")
}

is_source_ast <- function(ast) {
  is_macro_ast(ast, ".SOURCE")
}

eval_ast <- function(ast, env = parent.frame()) {
  collapsed <- collapse_ast(ast)

  rlang::eval_tidy(collapsed, env = env)
}

translate_macros <- function(command) {
  command_ast <- extract_ast(command)
  command_ast <- modify_ast_if(command_ast, is_any_macro_ast, eval_ast)
  collapse_ast(command_ast)
}

target_call_check <- function(ast) {
  if (is_ast(ast)) {
    identical(ast$head, ".TARGET")
  } else {
    FALSE
  }
}

source_call_check <- function(ast) {
  if (is_ast(ast)) {
    identical(ast$head, ".SOURCE")
  } else {
    FALSE
  }
}

flatten_deps_search_stack <- function(list_str) {
  if (!is.list(list_str)) {
    return(list_str)
  }

  list_els <- vlapply(list_str, is.list)

  list_str[list_els] <- lapply(list_str[list_els], flatten_deps_search_stack)
  unlist(list_str)
}
nyuglobalties/blueprintr documentation built on July 16, 2024, 10:27 a.m.