R/utils_assert.R

Defines functions tar_assert_meta tar_warn_meta tar_message_meta tar_warn_prefix tar_deprecate_seconds_interval tar_assert_allow_meta tar_assert_watch_packages tar_assert_unique_targets tar_assert_unique tar_assert_true tar_assert_objects_files tar_assert_script tar_assert_target_list tar_assert_target tar_assert_store tar_assert_scalar tar_assert_resources tar_assert_positive tar_assert_nonmissing tar_assert_match tar_assert_path tar_assert_package tar_assert_nzchar tar_assert_not_expr tar_assert_none_na tar_assert_all_na tar_assert_nonempty tar_assert_names tar_assert_named tar_assert_name tar_assert_lgl tar_assert_list tar_assert_le tar_assert_lang tar_assert_internet tar_assert_int tar_assert_inherits tar_assert_not_in tar_assert_not_dir tar_assert_not_dirs tar_assert_in tar_assert_identical_chr tar_assert_identical tar_assert_ge tar_assert_function_arguments tar_assert_function tar_assert_finite tar_assert_file tar_assert_repository tar_assert_format tar_assert_flag tar_assert_expr tar_assert_envir tar_assert_equal_lengths tar_assert_df tar_assert_dbl tar_assert_target_dag tar_assert_correct_fields tar_assert_chr_no_delim tar_assert_chr tar_assert_callr_function

Documented in tar_assert_chr tar_assert_dbl tar_assert_df tar_assert_envir tar_assert_equal_lengths tar_assert_expr tar_assert_file tar_assert_finite tar_assert_flag tar_assert_function tar_assert_function_arguments tar_assert_ge tar_assert_identical tar_assert_in tar_assert_inherits tar_assert_int tar_assert_internet tar_assert_lang tar_assert_le tar_assert_lgl tar_assert_list tar_assert_match tar_assert_name tar_assert_named tar_assert_names tar_assert_nonempty tar_assert_nonmissing tar_assert_not_dir tar_assert_not_dirs tar_assert_not_expr tar_assert_not_in tar_assert_nzchar tar_assert_package tar_assert_path tar_assert_positive tar_assert_scalar tar_assert_store tar_assert_target tar_assert_target_list tar_assert_true tar_assert_unique tar_assert_unique_targets

#' @title Assertions
#' @name tar_assert
#' @family utilities to extend targets
#' @description These functions assert the correctness of user inputs
#'   and generate custom error conditions as needed. Useful
#'   for writing packages built on top of `targets`.
#' @param x R object, input to be validated. The kind of object depends on the
#'   specific assertion function called.
#' @param msg Character of length 1, a message to be printed to the console
#'   if `x` is invalid.
#' @param choices Character vector of choices of `x` for certain assertions.
#' @param threshold Numeric of length 1, lower/upper bound for
#'   assertions like `tar_assert_le()`/`tar_assert_ge()`.
#' @param y R object, value to compare against `x`.
#' @param class Character vector of expected class names.
#' @param package Character of length 1, name of an R package.
#' @param path Character, file path.
#' @param pattern Character of length 1, a `grep` pattern for certain
#'   assertions.
#' @param args Character vector of expected function argument names.
#'   Order matters.
#' @examples
#' tar_assert_chr("123")
#' try(tar_assert_chr(123))
NULL

tar_assert_callr_function <- function(callr_function) {
  if (!is.null(callr_function)) {
    tar_assert_function(
      callr_function,
      "callr_function must be a function or NULL."
    )
  }
}

#' @export
#' @rdname tar_assert
tar_assert_chr <- function(x, msg = NULL) {
  if (!is.character(x)) {
    default <- paste(tar_deparse_safe(substitute(x)), "must be a character.")
    tar_throw_validate(msg %|||% default)
  }
}

tar_assert_chr_no_delim <- function(x, msg = NULL) {
  tar_assert_chr(
    x,
    paste(tar_deparse_safe(substitute(x)), "must be a character")
  )
  if (any(grepl("|", x, fixed = TRUE) | grepl("*", x, fixed = TRUE))) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "must not contain | or *"
    )
    tar_throw_validate(msg %|||% default)
  }
}

tar_assert_correct_fields <- function(object, constructor) {
  tar_assert_identical_chr(
    sort_chr(names(object)),
    sort_chr(names(formals(constructor)))
  )
}

tar_assert_target_dag <- function(x, msg = NULL) {
  if (!inherits(x, "igraph") || !igraph::is_dag(x)) {
    default <- paste(
      "dependency graph contains a cycle.",
      "If target x depends on target y, then",
      "target y must not depend on target x,",
      "either directly or indirectly."
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_dbl <- function(x, msg = NULL) {
  if (!is.numeric(x)) {
    default <- paste(tar_deparse_safe(substitute(x)), "must be numeric.")
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_df <- function(x, msg = NULL) {
  if (!is.data.frame(x)) {
    default <- paste(tar_deparse_safe(substitute(x)), "must be a data frame.")
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_equal_lengths <- function(x, msg = NULL) {
  lengths <- map_int(x, length)
  if (length(unique(lengths)) > 1L) {
    targets::tar_throw_validate(msg %|||% "x must have equal-length elements.")
  }
}

#' @export
#' @rdname tar_assert
tar_assert_envir <- function(x, msg = NULL) {
  if (!is.environment(x)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "must be an environment."
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_expr <- function(x, msg = NULL) {
  if (!is.expression(x)) {
    default <- paste(tar_deparse_safe(substitute(x)), "must be an expression.")
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_flag <- function(x, choices, msg = NULL) {
  tar_assert_chr(
    x,
    msg %|||% paste(tar_deparse_safe(substitute(x)), "must be a character")
  )
  tar_assert_scalar(
    x,
    msg %|||% paste(tar_deparse_safe(substitute(x)), "must have length 1")
  )
  if (!all(x %in% choices)) {
    msg <- msg %|||% paste(
      tar_deparse_safe(substitute(x)),
      "equals",
      tar_deparse_safe(x),
      "but must be in",
      tar_deparse_safe(choices)
    )
    tar_throw_validate(msg)
  }
}

tar_assert_format <- function(format) {
  tar_assert_scalar(format)
  tar_assert_chr(format)
  tar_assert_nzchar(format)
  format <- gsub("\\&.*$", "", format)
  if (any(grepl("^aws_", format))) {
    tar_warn_deprecate(
      sprintf("detected target storage format %s. ", format),
      "Effective 2022-02-13 (targets version > 0.10.0), ",
      "the \"aws_*\" formats are deprecated. Instead, use the ",
      "repository argument: for example, instead of ",
      "tar_target(..., format = \"aws_qs\"), write ",
      "tar_target(..., format = \"qs\", repository = \"aws\"). ",
      "Automatically setting repository to \"aws\" for back-compatibility."
    )
    format <- gsub("^aws_", "", format)
  }
  store_assert_format_setting(store_format_dispatch(format))
}

tar_assert_repository <- function(repository) {
  tar_assert_scalar(repository)
  tar_assert_chr(repository)
  tar_assert_nzchar(repository)
  store_assert_repository_setting(enclass(repository, repository))
}

#' @export
#' @rdname tar_assert
tar_assert_file <- function(x) {
  name <- tar_deparse_safe(substitute(x))
  targets::tar_assert_chr(x, paste(name, "must be a character string."))
  targets::tar_assert_scalar(x, paste(name, "must have length 1."))
  targets::tar_assert_path(x)
}

#' @export
#' @rdname tar_assert
tar_assert_finite <- function(x, msg = NULL) {
  name <- tar_deparse_safe(substitute(x))
  default <- paste("all of", name, "must be finite")
  if (!all(is.finite(x))) {
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_function <- function(x, msg = NULL) {
  if (!is.function(x)) {
    tar_throw_validate(msg %|||% "input must be a function.")
  }
}

#' @export
#' @rdname tar_assert
tar_assert_function_arguments <- function(x, args, msg = NULL) {
  exp <- as.character(names(formals(x)))
  equal <- identical(exp, as.character(args))
  msg <- paste(
    "function",
    tar_deparse_safe(substitute(x)),
    "must have these exact arguments in this exact order:",
    paste(exp, collapse = ", ")
  )
  if (!equal) {
    tar_throw_validate(msg %|||% "input must be a function.")
  }
}

#' @export
#' @rdname tar_assert
tar_assert_ge <- function(x, threshold, msg = NULL) {
  if (any(x < threshold)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "must be less than or equal to",
      threshold
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_identical <- function(x, y, msg = NULL) {
  if (!identical(x, y)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "and",
      tar_deparse_safe(substitute(y)),
      "must be identical."
    )
    tar_throw_validate(msg %|||% default)
  }
}

tar_assert_identical_chr <- function(x, y, msg = NULL) {
  if (!identical(x, y)) {
    msg_x <- paste0(tar_deparse_safe(x), collapse = "")
    msg_y <- paste0(tar_deparse_safe(y), collapse = "")
    tar_throw_validate(msg %|||% paste(msg_x, "and", msg_y, "not identical."))
  }
}

#' @export
#' @rdname tar_assert
tar_assert_in <- function(x, choices, msg = NULL) {
  if (!all(x %in% choices)) {
    msg <- msg %|||% paste(
      tar_deparse_safe(substitute(x)),
      "equals",
      tar_deparse_safe(x),
      "but must be in",
      tar_deparse_safe(choices)
    )
    tar_throw_validate(msg)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_not_dirs <- function(x, msg = NULL) {
  lapply(x, tar_assert_not_dir, msg = msg)
}

#' @export
#' @rdname tar_assert
tar_assert_not_dir <- function(x, msg = NULL) {
  if (any(dir.exists(x))) {
    tar_throw_validate(
      msg %|||% paste(tar_deparse_safe(x), "must not be a directory.")
    )
  }
}

#' @export
#' @rdname tar_assert
tar_assert_not_in <- function(x, choices, msg = NULL) {
  if (any(x %in% choices)) {
    tar_throw_validate(
      msg %|||% paste(tar_deparse_safe(x), "is in", tar_deparse_safe(choices))
    )
  }
}

#' @export
#' @rdname tar_assert
tar_assert_inherits <- function(x, class, msg = NULL) {
  if (!inherits(x, class)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "x does not inherit from",
      class
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_int <- function(x, msg = NULL) {
  if (!is.integer(x)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "must have mode integer."
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_internet <- function(msg = NULL) {
  tar_assert_package("curl")
  if (!curl::has_internet()) {
    # This line cannot be covered in automated tests
    # because internet is usually on.
    tar_throw_run("no internet") # nocov
  }
}

#' @export
#' @rdname tar_assert
tar_assert_lang <- function(x, msg = NULL) {
  if (!is.language(x)) {
    tar_throw_validate(msg %|||% "x must be a language object")
  }
}

#' @export
#' @rdname tar_assert
tar_assert_le <- function(x, threshold, msg = NULL) {
  if (any(x > threshold)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "must be less than or equal to",
      threshold
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_list <- function(x, msg = NULL) {
  if (!is.list(x)) {
    default <- paste(tar_deparse_safe(substitute(x)), "must be a list.")
    tar_throw_validate(msg %|||% "x must be a list.")
  }
}

#' @export
#' @rdname tar_assert
tar_assert_lgl <- function(x, msg = NULL) {
  if (!is.logical(x)) {
    default <- paste(tar_deparse_safe(substitute(x)), "must be logical.")
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_name <- function(x) {
  tar_assert_chr(x)
  tar_assert_scalar(x)
  tar_assert_nzchar(x)
  if (!identical(as.character(x), make.names(x))) {
    tar_throw_validate(x, " is not a valid symbol name.")
  }
  if (grepl("^\\.", x)) {
    tar_throw_validate("a target name cannot begin with a dot. Found: ", x)
  }
  if (grepl("\\.$", x)) {
    tar_throw_validate("a target name cannot end with a dot. Found: ", x)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_named <- function(x, msg = NULL) {
  msg <- msg %|||% paste(
    "names of",
    tar_deparse_safe(substitute(x)),
    "must have a complete set of unique nonempty names."
  )
  if (!length(x)) {
    return()
  }
  names <- names(x)
  tar_assert_ge(length(x), length(names), msg = msg)
  tar_assert_le(length(x), length(names), msg = msg)
  tar_assert_unique(names, msg = msg)
  tar_assert_nonempty(names, msg = msg)
  tar_assert_chr(names, msg = msg)
  tar_assert_nzchar(names, msg = msg)
}

#' @export
#' @rdname tar_assert
tar_assert_names <- function(x, msg = NULL) {
  if (any(x != make.names(x, unique = FALSE))) {
    tar_throw_validate(msg %|||% "x must legal symbol names.")
  }
}

#' @export
#' @rdname tar_assert
tar_assert_nonempty <- function(x, msg = NULL) {
  if (!length(x)) {
    default <- paste(tar_deparse_safe(substitute(x)), "must be nonempty.")
    tar_throw_validate(msg %|||% default)
  }
}

tar_assert_all_na <- function(x, msg = NULL) {
  if (!all(is.na(x))) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "must have all missing values."
    )
    tar_throw_validate(msg %|||% default)
  }
}

tar_assert_none_na <- function(x, msg = NULL) {
  if (anyNA(x)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "must have no missing values."
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_not_expr <- function(x, msg = NULL) {
  if (is.expression(x)) {
    tar_throw_validate(msg %|||% "x must not be an expression object")
  }
}

#' @export
#' @rdname tar_assert
tar_assert_nzchar <- function(x, msg = NULL) {
  if (any(!nzchar(x))) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "has empty character strings."
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_package <- function(package) {
  tryCatch(
    rlang::check_installed(package),
    error = function(e) {
      tar_throw_validate(conditionMessage(e))
    }
  )
}

#' @export
#' @rdname tar_assert
tar_assert_path <- function(path, msg = NULL) {
  missing <- !file.exists(path)
  if (any(missing)) {
    tar_throw_validate(
      msg %|||% paste0(
        "missing files: ",
        paste(path[missing], collapse = ", ")
      )
    )
  }
}

#' @export
#' @rdname tar_assert
tar_assert_match <- function(x, pattern, msg = NULL) {
  if (!grepl(pattern = pattern, x = x)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "does not match pattern",
      pattern
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_nonmissing <- function(x, msg = NULL) {
  if (rlang::is_missing(x)) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "is missing with no default."
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_positive <- function(x, msg = NULL) {
  if (any(x <= 0)) {
    default <- paste(tar_deparse_safe(substitute(x)), "is not all positive.")
    tar_throw_validate(msg %|||% default)
  }
}

tar_assert_resources <- function(resources) {
  tar_assert_list(resources, "resources must be list. Use tar_resources().")
  if (length(resources)) {
    tar_assert_nonempty(names(resources), "resources list must have names.")
    tar_assert_nzchar(names(resources), "resources names must be nonempty")
    tar_assert_unique(names(resources), "resources names must be unique.")
  }
  for (name in names(resources)) {
    if (!(name %in% names(formals(tar_resources)))) {
      tar_warn_deprecate(
        "found non-standard resource group ",
        name,
        " in resources list. Unstructrued resources list are deprecated ",
        "in targets >= 0.5.0.9000 (2021-06-07). Use tar_resources() ",
        "and various tar_resources_*() helper functions to create the ",
        "resources argument to tar_target() and tar_option_set()."
      )
    } else if (!inherits(resources[[name]], "tar_resources")) {
      tar_warn_deprecate(
        "found incorrectly formatted resource group ",
        name,
        " in resources list. Unstructrued resources list are deprecated ",
        "in targets >= 0.5.0.9000 (2021-06-07). Use tar_resources_clustermq()",
        " and various other tar_resources_*() helper functions to create ",
        "arguments to tar_resources()."
      )
    }
  }
}

#' @export
#' @rdname tar_assert
tar_assert_scalar <- function(x, msg = NULL) {
  if (length(x) != 1) {
    default <- paste(tar_deparse_safe(substitute(x)), "must have length 1.")
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
#' @param store Character of length 1, path to the data store of the pipeline.
tar_assert_store <- function(store) {
  tar_assert_scalar(store)
  tar_assert_chr(store)
  tar_assert_nzchar(store)
  tar_assert_path(
    store,
    paste(
      "targets data store", store, "not found.",
      "Utility functions like tar_read() and tar_load() require a",
      "pre-existing targets data store (default: _targets/)",
      "created by tar_make(), tar_make_clustermq(), or tar_make_future().",
      "Details: https://books.ropensci.org/targets/data.html"
    )
  )
}

#' @export
#' @rdname tar_assert
tar_assert_target <- function(x, msg = NULL) {
  msg <- msg %|||% paste(
    "Found a non-target object in the target list.",
    "The target script file (default: _targets.R)",
    "must end with a list of tar_target() objects (recommended)",
    "or a tar_pipeline() object (deprecated)."
  )
  tar_assert_inherits(x = x, class = "tar_target", msg = msg)
}

#' @export
#' @rdname tar_assert
tar_assert_target_list <- function(x) {
  msg <- paste(
    "Expected a list of target objects, but the object is not a list.",
    "Are you missing a target list at the end of your target script file?",
    "The target script file (e.g. _targets.R)",
    "must end with a list of tar_target() objects."
  )
  tar_assert_list(x, msg = msg)
  map(x, tar_assert_target)
}

tar_assert_script <- function(script) {
  tar_assert_scalar(script)
  tar_assert_chr(script)
  tar_assert_nzchar(script)
  msg <- paste0(
    "could not find file ",
    script,
    ". Main functions like tar_make() require a target script file ",
    "(default: _targets.R) to define the pipeline. ",
    "Functions tar_edit() and tar_script() can help. "
  )
  tar_assert_path(script, msg)
  vars <- all.vars(parse(file = script), functions = TRUE)
  exclude <- c(
    "glimpse",
    "make",
    "manifest",
    "network",
    "outdated",
    "prune",
    "renv",
    "sitrep",
    "validate",
    "visnetwork"
  )
  pattern <- paste(paste0("^tar_", exclude), collapse = "|")
  choices <- grep(pattern, getNamespaceExports("targets"), value = TRUE)
  msg <- paste(
    "The target script file",
    script,
    "must not call tar_make() or similar functions",
    "that would source the target script again and cause infinite recursion."
  )
  tar_assert_not_in(vars, choices, msg)
  msg <- paste(
    "Do not use %s() from {devtools} or {pkgload} to load",
    "packages or custom functions/globals for `targets`. If you do,",
    "custom functions will go to a package environment where `targets`",
    "may not track them, and the loaded data will not be available in",
    "parallel workers created by tar_make_clustermq() or tar_make_future().",
    "Read https://books.ropensci.org/targets/packages.html#loading-and-configuring-r-packages", # nolint
    "and https://books.ropensci.org/targets/packages.html#package-based-invalidation", # nolint
    "for the correct way to load packages for `targets` pipelines.",
    "Warnings like this one are important, but if you must suppress them, ",
    "you can do so with Sys.setenv(TAR_WARN = \"false\")."
  )
  for (loader in c("load_all", "load_code", "load_data", "load_dll")) {
    if (!identical(Sys.getenv("TAR_WARN"), "false") && loader %in% vars) {
      tar_warn_validate(sprintf(msg, loader))
    }
  }
}

tar_assert_objects_files <- function(store) {
  objects <- path_objects_dir(store)
  files <- list.files(
    objects,
    full.names = TRUE,
    all.files = TRUE,
    include.dirs = TRUE,
    no.. = TRUE
  )
  directories <- files[dir.exists(files)]
  if (length(directories) > 0L) {
    tar_throw_run(
      "the write() function in tar_format() ",
      "must not create a directory. ",
      "Found directories inside the data store ",
      "where there should only be files: ",
      paste(directories, collapse = ", ")
    )
  }
}

#' @export
#' @rdname tar_assert
tar_assert_true <- function(x, msg = NULL) {
  if (!x) {
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "does not evaluate not TRUE."
    )
    tar_throw_validate(msg %|||% default)
  }
}

#' @export
#' @rdname tar_assert
tar_assert_unique <- function(x, msg = NULL) {
  if (anyDuplicated(x)) {
    dups <- paste(unique(x[duplicated(x)]), collapse = ", ")
    default <- paste(
      tar_deparse_safe(substitute(x)),
      "has duplicated entries:",
      dups
    )
    tar_throw_validate(paste(msg %|||% default))
  }
}

#' @export
#' @rdname tar_assert
tar_assert_unique_targets <- function(x) {
  if (anyDuplicated(x)) {
    dups <- paste(unique(x[duplicated(x)]), collapse = ", ")
    message <- paste("duplicated target names:", dups)
    tar_throw_validate(message)
  }
}

# nocov start
# tested in tests/interactive/test-tar_watch.R
tar_assert_watch_packages <- function() {
  pkgs <- c(
    "bs4Dash",
    "DT",
    "gt",
    "markdown",
    "pingr",
    "shiny",
    "shinybusy",
    "shinyWidgets",
    "visNetwork"
  )
  tar_assert_package(pkgs)
}
# nocov end

tar_assert_allow_meta <- function(fun, store) {
  target <- tar_runtime$target
  safe <- is.null(target) ||
    is.null(tar_runtime$store) ||
    !identical(
      normalizePath(as.character(store), mustWork = FALSE),
      normalizePath(as.character(tar_runtime$store), mustWork = FALSE)
    )
  if (safe) {
    return()
  }
  if (!target_allow_meta(target)) {
    message <- paste0(
      "target ",
      target$settings$name,
      " attempted to run targets::",
      fun,
      "() to during a pipeline, which is unsupported ",
      "except when format %in% c(\"file\", \"file_fast\") and ",
      "repository == \"local\", or if you are reading from a data store ",
      "that does not belong to the current pipeline. ",
      "This is because functions like ",
      fun,
      "() attempt to access or modify the local data store, ",
      "which may not exist or be properly synced in certain situations. ",
      "Also, please be aware that some functions like ",
      "tar_make() and tar_destroy() ",
      "should never run inside a target. ",
      "Please find a different workaround ",
      "for your use case."
    )
    tar_throw_validate(message)
  }
}

tar_deprecate_seconds_interval <- function(seconds_interval) {
  if (!is.null(seconds_interval)) {
    tar_warn_deprecate(
      "The seconds_interval argument of tar_make() and tar_config_set() ",
      "is deprecated (2023-08-24, version 1.2.2.9001). Instead, use arguments",
      "seconds_meta_append, seconds_meta_upload, and seconds_reporter."
    )
  }
}

tar_warn_prefix <- function() {
  tar_warn_deprecate(
    "Please supply an explicit prefix for you target object data ",
    "and metadata. The prefix should be unique to your `targets` project. ",
    "In the future, `targets` will begin requiring explicitly ",
    "user-supplied prefixes. This warning was added on 2023-08-24 ",
    "(`targets` version 1.2.2.9000)."
  )
}

tar_message_meta <- function(store) {
  message <- paste(
    "No local metadata. Did you remember to run tar_meta_download()?",
    "Details: https://books.ropensci.org/targets/cloud-storage.html.",
    "(Or maybe you need to run the pipeline with tar_make()?)",
    "Silence this message with Sys.setenv(TAR_WARN = \"false\").",
    sep = "\n"
  )
  show_message <- !identical(Sys.getenv("TAR_WARN"), "false") &&
    (length(store) < 1L || !all(file.exists(path_meta(store))))
  if (show_message) {
    rlang::inform(
      message = message,
      class = c("tar_condition_validate", "tar_condition_targets")
    )
  }
}

tar_warn_meta <- function(store) {
  message <- paste(
    "No local metadata. Did you remember to run tar_meta_download()?",
    "Details: https://books.ropensci.org/targets/cloud-storage.html.",
    "(Or maybe you need to run the pipeline with tar_make()?)",
    "Silence this warning with Sys.setenv(TAR_WARN = \"false\").",
    sep = "\n"
  )
  throw_warning <- !identical(Sys.getenv("TAR_WARN"), "false") &&
    (length(store) < 1L || !all(file.exists(path_meta(store))))
  if (throw_warning) {
    tar_warning(
      message = message,
      class = c("tar_condition_validate", "tar_condition_targets")
    )
  }
}

tar_assert_meta <- function(store) {
  message <- paste(
    "No local metadata. Did you remember to run tar_meta_download()?",
    "Details: https://books.ropensci.org/targets/cloud-storage.html.",
    "(Or maybe you need to run the pipeline with tar_make()?)",
    sep = "\n"
  )
  if ((length(store) < 1L || !all(file.exists(path_meta(store))))) {
    tar_throw_validate(message = message)
  }
}

Try the targets package in your browser

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

targets documentation built on Oct. 12, 2023, 5:07 p.m.