R/lost_tags_action.R

In epiverse-trace/linelist: Tagging and Validating Epidemiological Data

#' Check and set behaviour for lost tags
#'
#' This function determines the behaviour to adopt when tagged variables of a
#' `linelist` are lost e.g. through subsetting. This is achieved using `options`
#' defined for the `linelist` package.
#'
#' @param action a `character` indicating the behaviour to adopt when tagged
#'   variables have been lost: "error" (default) will issue an error; "warning"
#'   will issue a warning; "none" will do nothing
#'
#' @param quiet a `logical` indicating if a message should be displayed; only
#'   used outside pipelines
#'
#' @param x deprecated
#'
#' @return returns `NULL`; the option itself is set in `options("linelist")`
#'
#' @details The errors or warnings generated by linelist in case of tagged
#' variable loss has a custom class of `linelist_error` and `linelist_warning`
#' respectively.
#'
#' @export
#'
#' @rdname lost_tags_action
#'
#' @aliases lost_tags_action get_lost_tags_action
#'
#' @examples
#' # reset default - done automatically at package loading
#' lost_tags_action()
#'
#' # check current value
#' get_lost_tags_action()
#'
#' # change to issue errors when tags are lost
#' lost_tags_action("error")
#' get_lost_tags_action()
#'
#' # change to ignore when tags are lost
#' lost_tags_action("none")
#' get_lost_tags_action()
#'
#' # reset to default: warning
#' lost_tags_action()
#'
lost_tags_action <- function(action = c("warning", "error", "none"),
                             quiet = FALSE,
                             x) {

  if (!missing(x) || inherits(action, "linelist")) {
    stop(
      "Using `lost_tags_action()` in a pipeline is deprecated", call. = FALSE
    )
  }

  linelist_options <- options("linelist")$linelist

  action <- match.arg(action)
  linelist_options$lost_tags_action <- action
  options(linelist = linelist_options)
  if (!quiet) {
    if (action == "warning") msg <- "Lost tags will now issue a warning."
    if (action == "error") msg <- "Lost tags will now issue an error."
    if (action == "none") msg <- "Lost tags will now be ignored."
    message(msg)
  }
  return(invisible(NULL))

}



#' @export
#'
#' @rdname lost_tags_action

get_lost_tags_action <- function() {
  options("linelist")$linelist$lost_tags_action
}