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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.