check_names() case study

[hadley]

# Use early returns to minimse code
check_names_1 <- function(names, x) {
  if (rlang::is_formula(names)) {
    names <- rlang::as_function(names)
  }
  if (is.function(names)) {
    names <- names(base::names(x))
  }

  vec_assert(names, ptype = character(), size = length(x))
  names
}


# Emphasise three types of input
check_names_2 <- function(names, x) {
  if (is.null(names)) {
    names
  } else if (is.function(names) || rlang::is_formula(names)) {
    fun <- rlang::as_function(names)
    names <- fun(base::names(x))
    vec_assert(names, ptype = character(), size = length(x))
  } else if (is.vector(names)) {
    vec_assert(names, ptype = character(), size = length(x))  
  } else {
    rlang::abort("`names` must be NULL, a function (or formula), or a vector")
  }
}


check_names_2.5 <- function(names, x) {
  if (is.null(names)) {
    names
  } else if (vec_is(names)) {
    vec_assert(names, ptype = character(), size = length(x))  
  } else if (rlang::is.formula(names)) {
    check_names_2(rlang::as_function(names), x)
  } else if (is.function(names)) {
    check_names_2(names(x), x)
  } else {
    rlang::abort("`names` must be NULL, a function or formula, or a vector")
  }
}

# Use a generic
check_names_3 <- function(names, x) UseMethod("check_names_3")
check_names_3.NULL <- function(names, x) NULL
check_names_3.character <- function(names, x) {
  if (length(names) != length(x)) {
    stop("`names` and `x` must be the same length", call. = FALSE)
  }
  names
}
check_names_3.formula <- function(names, x) check_names_3(rlang::as_function(names), x)
check_names_3.function <- function(names, x) check_names_3(names(base::names(x)), x)
check_names_3.default <- function(names, x) stop("Invalid input to names (", class(names)[[1]] ,")")