diff --git a/DESCRIPTION b/DESCRIPTION index 5ebae5a..68a9f55 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,7 +14,8 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2.9000 Depends: R (>= 4.2.0) Imports: - R6 + R6, + S7 Suggests: testthat (>= 3.0.0) Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 691e1ee..c0d6c6d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,9 @@ export(LRUCache) export(get_dims) +export(list_of) export(seq_along0) export(seq_len0) importFrom(R6,R6Class) +importFrom(utils,getFromNamespace) importFrom(utils,hashtab) diff --git a/R/list_of.R b/R/list_of.R index 5fc2584..04f67de 100644 --- a/R/list_of.R +++ b/R/list_of.R @@ -1,73 +1,73 @@ -## copied from: https://github.com/lawremi/wizrd/blob/main/R/utils.R -# -##' @title Create a list property -##' @description -##' Create a list property. -##' @param class The class of the list. -##' @param ... The properties of the list. -##' @export -#list_of <- function(class, ...) { -# new_list_property(of = class, ...) -#} -# -#new_list_property <- function( -# ..., -# validator = NULL, -# default = if (isTRUE(named)) { -# quote(setNames(list(), character())) -# } else { -# quote(list()) -# }, -# of = S7::class_any, -# named = NA, -# min_length = 0L, -# max_length = Inf -#) { -# prop <- S7::new_property( -# S7::class_list, -# ..., -# validator = function(value) { -# c( -# if ( -# !identical(of, S7::class_any) && -# !all(vapply(value, S7:::class_inherits, logical(1L), of)) -# ) { -# paste("must only contain elements of class", S7:::class_desc(of)) -# }, -# if (!is.null(of_validator)) { -# msgs <- unlist(lapply(value, of_validator)) -# if (length(msgs) > 0L) { -# paste( -# "element(s) failed validation:", -# paste0("'", unique(msgs), "'", collapse = ", ") -# ) -# } -# }, -# if (isTRUE(named) && is.null(names(value))) { -# "must have names" -# }, -# if (identical(named, FALSE) && !is.null(names(value))) { -# "must not have names" -# }, -# if (length(value) < min_length || length(value) > max_length) { -# paste0("must have length in [", min_length, ", ", max_length, "]") -# }, -# if (!is.null(validator)) { -# validator(value) -# } -# ) -# }, -# default = default -# ) -# prop$of <- of -# if (inherits(of, "S7_property")) { -# of_validator <- of$validator -# of <- of$class -# } else { -# of_validator <- NULL -# } -# prop$named <- named -# class(prop) <- c("list_S7_property", class(prop)) -# prop -#} -# +# copied from: https://github.com/lawremi/wizrd/blob/main/R/utils.R + +#' @title Create a list property +#' @description +#' Create a list property. +#' @param class The class of the list. +#' @param ... The properties of the list. +#' @export +list_of <- function(class, ...) { + new_list_property(of = class, ...) +} + +new_list_property <- function( + ..., + validator = NULL, + default = if (isTRUE(named)) { + quote(setNames(list(), character())) + } else { + quote(list()) + }, + of = S7::class_any, + named = NA, + min_length = 0L, + max_length = Inf +) { + prop <- S7::new_property( + S7::class_list, + ..., + validator = function(value) { + c( + if ( + !identical(of, S7::class_any) && + !all(vapply(value, getFromNamespace("class_inherits", "S7"), logical(1L), of)) + ) { + paste("must only contain elements of class", getFromNamespace("class_desc", "S7")(of)) + }, + if (!is.null(of_validator)) { + msgs <- unlist(lapply(value, of_validator)) + if (length(msgs) > 0L) { + paste( + "element(s) failed validation:", + paste0("'", unique(msgs), "'", collapse = ", ") + ) + } + }, + if (isTRUE(named) && is.null(names(value))) { + "must have names" + }, + if (identical(named, FALSE) && !is.null(names(value))) { + "must not have names" + }, + if (length(value) < min_length || length(value) > max_length) { + paste0("must have length in [", min_length, ", ", max_length, "]") + }, + if (!is.null(validator)) { + validator(value) + } + ) + }, + default = default + ) + prop$of <- of + if (inherits(of, "S7_property")) { + of_validator <- of$validator + of <- of$class + } else { + of_validator <- NULL + } + prop$named <- named + class(prop) <- c("list_S7_property", class(prop)) + prop +} + diff --git a/R/xlamisc-package.R b/R/xlamisc-package.R index 20fa85c..a05c1ea 100644 --- a/R/xlamisc-package.R +++ b/R/xlamisc-package.R @@ -1,2 +1,3 @@ #' @importFrom R6 R6Class +#' @importFrom utils getFromNamespace "_PACKAGE" diff --git a/man/list_of.Rd b/man/list_of.Rd new file mode 100644 index 0000000..3868ac0 --- /dev/null +++ b/man/list_of.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_of.R +\name{list_of} +\alias{list_of} +\title{Create a list property} +\usage{ +list_of(class, ...) +} +\arguments{ +\item{class}{The class of the list.} + +\item{...}{The properties of the list.} +} +\description{ +Create a list property. +}