R/type_check.R

In structenforcement: Struct-Like Data Type Checking and Enforcement

#' @title List Type Checking
#' @description
#' Given two named objects, go through both and make the types of the second
#' match the types of the first.
#' @param template - A named list to use as a template.
#' @param target - A named list to use as the output.
#' @param with_cast - If true, edits the target instead of just checking types.
#' @param log_items - Which debug info to print. Takes a character vector. By default, logs casts and excess fields (target fields not in template). We expect some missing for the moment.
#' @return The target object, with its types appropriately cast.
#' @examples
#' type_check(
#'   list("a" = character(0), "b" = integer(0)),
#'   data.frame("a" = c(1,2), "b" = c(3,4)),
#'   TRUE, NULL
#' )
#' @export
type_check <- function(template, target, with_cast = FALSE, log_items = c("casts", "missing", "excess", "debug")[c(1,3)]) {
  # Put together a bitfield of log flags for faster comparison in the function.
  log_levels <- as.integer(1 * ("casts" %in% log_items) + 2 * ("missing" %in% log_items) + 4 * ("excess" %in% log_items) + 8 * ("debug" %in% log_items))
  call_path <- deparse(sys.calls()[[sys.nframe()]])
  ld_ns <- getNamespace("lubridate")
  .Call('_c_type_check', template, target, with_cast, log_levels, call_path, ld_ns)
}

#' @title Bind as Struct
#' @description
#' Given a set of lists/dataframes, attempt to join them as a dataframe with field
#' types matching the specified template. The default and fastest approach simply
#' relies on `dplyr::bind_rows` to use all fields present in the lists to be
#' joined, while strict mode ensures that the template fields and only the template
#' fields are present.
#' @param template A named list to use as a template.
#' @param ... The lists to join
#' @param strict Use all and only the fields in the template. Default: FALSE
#' @return A dataframe containing the combined inputs.
#' @examples
#' bind_as_struct(list("a" = character(0)), list("a" = 1), list("a" = "a"))
#' @export
bind_as_struct <- function(template, ..., strict = FALSE) {
  # Parse the varargs.
  # rlang::list2 seems to be a somewhat idiomatic way to handle dots.
  va_args <- rlang::list2(...)
  # Now coerce the relevant fields of each entry in the varargs list to the template.
  typed_list <- lapply(va_args, function(item){type_check(template, item, TRUE, NULL)})
  # Finally, bind everything together.
  out <- if (strict) {
    tmp <- dplyr::bind_rows(template, typed_list)
    tmp <- tmp[,intersect(names(template), names(tmp))]
    tmp
  } else {
    dplyr::bind_rows(typed_list)
  }
  return(out)
}