R/enum.R

In shunsambongi/enum: Create enumerated values

new_enum <- function(vals, keys) {
  structure(vals, keys = keys, class = c("enum_enum", class(vals)))
}

validate_enum <- function(x) {
  keys <- enum_keys(x)
  assert_keys_unique(keys)
  x
}

#' @export
enum <- function(...) {
  c(vals, keys) %<-% enum_prepare(...)
  assert_vals_not_empty(vals)
  validate_enum(new_enum(vals, keys))
}

#' @export
print.enum_enum <- function(x, ...) {
  keys <- enum_keys(x)
  vals <- enum_vals(x)

  header <- enum_format_header(vals = vals)
  body <- enum_format_body(vals = vals, keys = keys)

  cat(header, "\n", sep = "")
  cat(body, sep = "\n")
  invisible(x)
}

enum_format_header <- function(x, vals = enum_vals(x)) {
  sprintf("<enum<%s>>", vctrs::vec_ptype_full(vals))
}

enum_format_body <- function(x, vals = enum_vals(x), keys = enum_keys(x)) {
  pattern <- paste0("%-", max(nchar(keys)), "s = %s")
  sprintf(pattern, keys, vals)
}

#' @export
enum_vals.enum_enum <- function(x, ...) {
  remove_class(remove_attr(x, "keys"), "enum_enum")
}

#' @export
enum_keys.enum_enum <- function(x, ...) {
  attr(x, "keys")
}

#' @export
enum_type.enum_enum <- function(x, ...) {
  vctrs::vec_ptype_full(enum_vals(x))
}

#' @export
enum_vec.enum_enum <- function(x, ...) {
  enum_proxy(x)
}

# helpers -----------------------------------------------------------------

enum_proxy <- function(x) {
  rlang::set_names(enum_vals(x), enum_keys(x))
}

enum_ptype <- function(x, proxy = enum_proxy(x)) {
  vctrs::vec_ptype(proxy)
}

enum_mask <- function(x, proxy = enum_proxy(x)) {
  rlang::as_data_mask(proxy)
}