diff --git a/R/specify_chr.R b/R/specify_chr.R new file mode 100644 index 00000000..51ff4218 --- /dev/null +++ b/R/specify_chr.R @@ -0,0 +1,60 @@ +#' Create a specified character stabilizer function +#' +#' `specify_chr()` creates a function that will call [stabilize_chr()] with the +#' provided arguments. `specify_chr_scalar()` creates a function that will call +#' [stabilize_chr_scalar()] with the provided arguments. `specify_character()` +#' is a synonym of `specify_chr()`, and `specify_character_scalar()` is a +#' synonym of `specify_chr_scalar()`. +#' +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_chr()] or [stabilize_chr_scalar()] with the provided arguments. +#' The generated function will also accept `...` for additional arguments to +#' pass to [stabilize_chr()] or [stabilize_chr_scalar()]. You can copy/paste +#' the body of the resulting function if you want to provide additional +#' context or functionality. +#' @family character functions +#' @family specification functions +#' @export +#' +#' @examples +#' stabilize_email <- specify_chr(regex = "^[^@]+@[^@]+\\.[^@]+$") +#' stabilize_email("stbl@example.com") +#' try(stabilize_email("not-an-email-address")) +specify_chr <- function( + allow_null = TRUE, + allow_na = TRUE, + min_size = NULL, + max_size = NULL, + unique = FALSE, + min_characters = NULL, + max_characters = NULL, + regex = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("chr", factory_args) +} + +#' @export +#' @rdname specify_chr +specify_chr_scalar <- function( + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + min_characters = NULL, + max_characters = NULL, + regex = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("chr", factory_args, scalar = TRUE) +} + +#' @export +#' @rdname specify_chr +specify_character <- specify_chr + +#' @export +#' @rdname specify_chr +specify_character_scalar <- specify_chr_scalar diff --git a/R/specify_cls.R b/R/specify_cls.R index 4f582410..9f9f8558 100644 --- a/R/specify_cls.R +++ b/R/specify_cls.R @@ -142,643 +142,24 @@ # nocov end } -# chr ---- - -#' Create a specified character stabilizer function -#' -#' `specify_chr()` creates a function that will call [stabilize_chr()] with the -#' provided arguments. `specify_chr_scalar()` creates a function that will call -#' [stabilize_chr_scalar()] with the provided arguments. `specify_character()` -#' is a synonym of `specify_chr()`, and `specify_character_scalar()` is a -#' synonym of `specify_chr_scalar()`. -#' -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_chr()] or [stabilize_chr_scalar()] with the provided arguments. -#' The generated function will also accept `...` for additional arguments to -#' pass to [stabilize_chr()] or [stabilize_chr_scalar()]. You can copy/paste -#' the body of the resulting function if you want to provide additional -#' context or functionality. -#' @family character functions -#' @family specification functions -#' @export -#' -#' @examples -#' stabilize_email <- specify_chr(regex = "^[^@]+@[^@]+\\.[^@]+$") -#' stabilize_email("stbl@example.com") -#' try(stabilize_email("not-an-email-address")) -specify_chr <- function( - allow_null = TRUE, - allow_na = TRUE, - min_size = NULL, - max_size = NULL, - unique = FALSE, - min_characters = NULL, - max_characters = NULL, - regex = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("chr", factory_args) -} - -#' @export -#' @rdname specify_chr -specify_chr_scalar <- function( - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - min_characters = NULL, - max_characters = NULL, - regex = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("chr", factory_args, scalar = TRUE) -} - -#' @export -#' @rdname specify_chr -specify_character <- specify_chr - -#' @export -#' @rdname specify_chr -specify_character_scalar <- specify_chr_scalar - -# date ---- - -#' Create a specified date stabilizer function -#' -#' `specify_date()` creates a function that will call [stabilize_date()] with -#' the provided arguments. `specify_date_scalar()` creates a function that will -#' call [stabilize_date_scalar()] with the provided arguments. -#' -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_date()] or [stabilize_date_scalar()] with the provided -#' arguments. The generated function will also accept `...` for additional -#' arguments to pass to `stabilize_date()` or `stabilize_date_scalar()`. You -#' can copy/paste the body of the resulting function if you want to provide -#' additional context or functionality. -#' @family date functions -#' @family specification functions -#' @export -#' -#' @examples -#' stabilize_recent <- specify_date(min_value = "2000-01-01") -#' stabilize_recent("2024-01-01") -#' try(stabilize_recent("1999-12-31")) -specify_date <- function( - allow_null = TRUE, - allow_na = TRUE, - min_size = NULL, - max_size = NULL, - unique = FALSE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("date", factory_args) -} - -#' @export -#' @rdname specify_date -specify_date_scalar <- function( - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("date", factory_args, scalar = TRUE) -} - -# dttm ---- - -#' Create a specified datetime stabilizer function -#' -#' `specify_dttm()` creates a function that will call [stabilize_dttm()] with -#' the provided arguments. `specify_dttm_scalar()` creates a function that will -#' call [stabilize_dttm_scalar()] with the provided arguments. -#' `specify_datetime()` is a synonym of `specify_dttm()`, and -#' `specify_datetime_scalar()` is a synonym of `specify_dttm_scalar()`. -#' -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_dttm()] or [stabilize_dttm_scalar()] with the provided -#' arguments. The generated function will also accept `...` for additional -#' arguments to pass to `stabilize_dttm()` or `stabilize_dttm_scalar()`. You -#' can copy/paste the body of the resulting function if you want to provide -#' additional context or functionality. -#' @family datetime functions -#' @family specification functions -#' @export -#' -#' @examples -#' stabilize_recent <- specify_dttm(min_value = "2000-01-01T00:00:00Z") -#' stabilize_recent("2024-01-01T00:00:00Z") -#' try(stabilize_recent("1999-12-31T00:00:00Z")) -specify_dttm <- function( - tz = "UTC", - allow_null = TRUE, - allow_na = TRUE, - min_size = NULL, - max_size = NULL, - unique = FALSE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("dttm", factory_args) -} - -#' @export -#' @rdname specify_dttm -specify_dttm_scalar <- function( - tz = "UTC", - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("datetime", factory_args, scalar = TRUE) -} - -#' @export -#' @rdname specify_dttm -specify_datetime <- specify_dttm - -#' @export -#' @rdname specify_dttm -specify_datetime_scalar <- specify_dttm_scalar - -# dbl ---- - -#' Create a specified double stabilizer function -#' -#' `specify_dbl()` creates a function that will call [stabilize_dbl()] with the -#' provided arguments. `specify_dbl_scalar()` creates a function that will call -#' [stabilize_dbl_scalar()] with the provided arguments. `specify_double()` is a -#' synonym of `specify_dbl()`, and `specify_double_scalar()` is a synonym of -#' `specify_dbl_scalar()`. -#' -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_dbl()] or [stabilize_dbl_scalar()] with the provided arguments. -#' The generated function will also accept `...` for additional arguments to -#' pass to `stabilize_dbl()` or `stabilize_dbl_scalar()`. You can copy/paste -#' the body of the resulting function if you want to provide additional -#' context or functionality. -#' @family double functions -#' @family specification functions -#' @export -#' -#' @examples -#' stabilize_3_to_5 <- specify_dbl(min_value = 3, max_value = 5) -#' stabilize_3_to_5(c(3.3, 4.4, 5)) -#' try(stabilize_3_to_5(c(1:6))) -specify_dbl <- function( - allow_null = TRUE, - allow_na = TRUE, - coerce_character = TRUE, - coerce_factor = TRUE, - min_size = NULL, - max_size = NULL, - unique = FALSE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("dbl", factory_args) -} - -#' @export -#' @rdname specify_dbl -specify_dbl_scalar <- function( - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - coerce_character = TRUE, - coerce_factor = TRUE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("dbl", factory_args, scalar = TRUE) -} - -#' @export -#' @rdname specify_dbl -specify_double <- specify_dbl - -#' @export -#' @rdname specify_dbl -specify_double_scalar <- specify_dbl_scalar - -# dur ---- - -#' Create a specified duration stabilizer function -#' -#' `specify_dur()` creates a function that will call [stabilize_dur()] with the -#' provided arguments. `specify_dur_scalar()` creates a function that will call -#' [stabilize_dur_scalar()] with the provided arguments. `specify_duration()` is -#' a synonym of `specify_dur()`, and `specify_duration_scalar()` is a synonym of -#' `specify_dur_scalar()`. +#' Capture the non-missing arguments of the calling function #' -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_dur()] or [stabilize_dur_scalar()] with the provided arguments. -#' The generated function will also accept `...` for additional arguments to -#' pass to `stabilize_dur()` or `stabilize_dur_scalar()`. You can copy/paste -#' the body of the resulting function if you want to provide additional -#' context or functionality. -#' @family duration functions -#' @family specification functions -#' @export +#' Used inside `specify_*()` functions to build the `factory_args` list passed +#' to [.specify_cls()], keeping only the arguments that the caller of the +#' `specify_*()` function actually supplied (as opposed to those left at +#' their default value). #' -#' @examples -#' stabilize_short <- specify_dur(max_value = "P1D") -#' stabilize_short("PT12H") -#' try(stabilize_short("P2D")) -specify_dur <- function( - allow_null = TRUE, - allow_na = TRUE, - min_size = NULL, - max_size = NULL, - unique = FALSE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("dur", factory_args) -} - -#' @export -#' @rdname specify_dur -specify_dur_scalar <- function( - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("dur", factory_args, scalar = TRUE) -} - -#' @export -#' @rdname specify_dur -specify_duration <- specify_dur - -#' @export -#' @rdname specify_dur -specify_duration_scalar <- specify_dur_scalar - -# fct ---- - -#' Create a specified factor stabilizer function -#' -#' `specify_fct()` creates a function that will call [stabilize_fct()] with the -#' provided arguments. `specify_fct_scalar()` creates a function that will call -#' [stabilize_fct_scalar()] with the provided arguments. `specify_factor()` is a -#' synonym of `specify_fct()`, and `specify_factor_scalar()` is a synonym of -#' `specify_fct_scalar()`. -#' -#' @inheritParams stabilize_fct -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_fct()] or [stabilize_fct_scalar()] with the provided arguments. -#' The generated function will also accept `...` for additional arguments to -#' pass to `stabilize_fct()` or `stabilize_fct_scalar()`. You can copy/paste -#' the body of the resulting function if you want to provide additional -#' context or functionality. -#' @family factor functions -#' @family specification functions -#' @export -#' -#' @examples -#' stabilize_lowercase_letter <- specify_fct(levels = letters) -#' stabilize_lowercase_letter(c("s", "t", "b", "l")) -#' try(stabilize_lowercase_letter("A")) -specify_fct <- function( - allow_null = TRUE, - allow_na = TRUE, - min_size = NULL, - max_size = NULL, - levels = NULL, - to_na = character() -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("fct", factory_args) -} - -#' @export -#' @rdname specify_fct -specify_fct_scalar <- function( - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - levels = NULL, - to_na = character() -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("fct", factory_args, scalar = TRUE) -} - -#' @export -#' @rdname specify_fct -specify_factor <- specify_fct - -#' @export -#' @rdname specify_fct -specify_factor_scalar <- specify_fct_scalar - -# int ---- - -#' Create a specified integer stabilizer function -#' -#' `specify_int()` creates a function that will call [stabilize_int()] with the -#' provided arguments. `specify_int_scalar()` creates a function that will call -#' [stabilize_int_scalar()] with the provided arguments. `specify_integer()` is -#' a synonym of `specify_int()`, and `specify_integer_scalar()` is a synonym of -#' `specify_int_scalar()`. -#' -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_int()] or [stabilize_int_scalar()] with the provided arguments. -#' The generated function will also accept `...` for additional arguments to -#' pass to `stabilize_int()` or `stabilize_int_scalar()`. You can copy/paste -#' the body of the resulting function if you want to provide additional -#' context or functionality. -#' @family integer functions -#' @family specification functions -#' @export -#' -#' @examples -#' stabilize_3_to_5 <- specify_int(min_value = 3, max_value = 5) -#' stabilize_3_to_5(c(3:5)) -#' try(stabilize_3_to_5(c(1:6))) -specify_int <- function( - allow_null = TRUE, - allow_na = TRUE, - coerce_character = TRUE, - coerce_factor = TRUE, - min_size = NULL, - max_size = NULL, - unique = FALSE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("int", factory_args) -} - -#' @export -#' @rdname specify_int -specify_int_scalar <- function( - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - coerce_character = TRUE, - coerce_factor = TRUE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("int", factory_args, scalar = TRUE) -} - -#' @export -#' @rdname specify_int -specify_integer <- specify_int - -#' @export -#' @rdname specify_int -specify_integer_scalar <- specify_int_scalar - -# lgl ---- - -#' Create a specified logical stabilizer function -#' -#' `specify_lgl()` creates a function that will call [stabilize_lgl()] with the -#' provided arguments. `specify_lgl_scalar()` creates a function that will call -#' [stabilize_lgl_scalar()] with the provided arguments. `specify_logical()` is -#' a synonym of `specify_lgl()`, and `specify_logical_scalar()` is a synonym of -#' `specify_lgl_scalar()`. -#' -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_lgl()] or [stabilize_lgl_scalar()] with the provided arguments. -#' The generated function will also accept `...` for additional arguments to -#' pass to `stabilize_lgl()` or `stabilize_lgl_scalar()`. You can copy/paste -#' the body of the resulting function if you want to provide additional -#' context or functionality. -#' @family logical functions -#' @family specification functions -#' @export -#' @examples -#' stabilize_few_lgl <- specify_lgl(max_size = 5) -#' stabilize_few_lgl(c(TRUE, "False", TRUE)) -#' try(stabilize_few_lgl(rep(TRUE, 10))) -specify_lgl <- function( - allow_null = TRUE, - allow_na = TRUE, - min_size = NULL, - max_size = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("lgl", factory_args) -} - -#' @export -#' @rdname specify_lgl -specify_lgl_scalar <- function( - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("lgl", factory_args, scalar = TRUE) -} - -#' @export -#' @rdname specify_lgl -specify_logical <- specify_lgl - -#' @export -#' @rdname specify_lgl -specify_logical_scalar <- specify_lgl_scalar - -# time ---- - -#' Create a specified time-of-day stabilizer function -#' -#' `specify_time()` creates a function that will call [stabilize_time()] with -#' the provided arguments. `specify_time_scalar()` creates a function that will -#' call [stabilize_time_scalar()] with the provided arguments. -#' -#' @inheritParams .shared-params -#' @returns A function of class `"stbl_specified_fn"` that calls -#' [stabilize_time()] or [stabilize_time_scalar()] with the provided -#' arguments. The generated function will also accept `...` for additional -#' arguments to pass to `stabilize_time()` or `stabilize_time_scalar()`. You -#' can copy/paste the body of the resulting function if you want to provide -#' additional context or functionality. -#' @family time functions -#' @family specification functions -#' @export -#' -#' @examples -#' stabilize_afternoon <- specify_time(min_value = "12:00:00Z") -#' stabilize_afternoon("13:00:00Z") -#' try(stabilize_afternoon("06:00:00Z")) -specify_time <- function( - allow_null = TRUE, - allow_na = TRUE, - min_size = NULL, - max_size = NULL, - unique = FALSE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. - factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) - } - } - .specify_cls("time", factory_args) -} - -#' @export -#' @rdname specify_time -specify_time_scalar <- function( - allow_null = FALSE, - allow_zero_length = FALSE, - allow_na = TRUE, - min_value = NULL, - max_value = NULL, - allowed_values = NULL -) { - # Only pass arguments that aren't missing. +#' @returns A named list of the values of arguments that weren't left missing +#' in the function that called `.capture_factory_args()`. +#' @keywords internal +.capture_factory_args <- function() { + env <- parent.frame() + fn <- sys.function(sys.parent()) factory_args <- list() - for (arg in names(formals())) { - if (!rlang::inject(base::missing(!!arg))) { - factory_args[[arg]] <- get(arg) + for (arg in names(formals(fn))) { + if (!eval(call("missing", as.name(arg)), envir = env)) { + factory_args[[arg]] <- get(arg, envir = env) } } - .specify_cls("time", factory_args, scalar = TRUE) + factory_args } diff --git a/R/specify_date.R b/R/specify_date.R new file mode 100644 index 00000000..29d716ac --- /dev/null +++ b/R/specify_date.R @@ -0,0 +1,48 @@ +#' Create a specified date stabilizer function +#' +#' `specify_date()` creates a function that will call [stabilize_date()] with +#' the provided arguments. `specify_date_scalar()` creates a function that will +#' call [stabilize_date_scalar()] with the provided arguments. +#' +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_date()] or [stabilize_date_scalar()] with the provided +#' arguments. The generated function will also accept `...` for additional +#' arguments to pass to `stabilize_date()` or `stabilize_date_scalar()`. You +#' can copy/paste the body of the resulting function if you want to provide +#' additional context or functionality. +#' @family date functions +#' @family specification functions +#' @export +#' +#' @examples +#' stabilize_recent <- specify_date(min_value = "2000-01-01") +#' stabilize_recent("2024-01-01") +#' try(stabilize_recent("1999-12-31")) +specify_date <- function( + allow_null = TRUE, + allow_na = TRUE, + min_size = NULL, + max_size = NULL, + unique = FALSE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("date", factory_args) +} + +#' @export +#' @rdname specify_date +specify_date_scalar <- function( + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("date", factory_args, scalar = TRUE) +} diff --git a/R/specify_dbl.R b/R/specify_dbl.R new file mode 100644 index 00000000..0f6b2fd9 --- /dev/null +++ b/R/specify_dbl.R @@ -0,0 +1,62 @@ +#' Create a specified double stabilizer function +#' +#' `specify_dbl()` creates a function that will call [stabilize_dbl()] with the +#' provided arguments. `specify_dbl_scalar()` creates a function that will call +#' [stabilize_dbl_scalar()] with the provided arguments. `specify_double()` is a +#' synonym of `specify_dbl()`, and `specify_double_scalar()` is a synonym of +#' `specify_dbl_scalar()`. +#' +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_dbl()] or [stabilize_dbl_scalar()] with the provided arguments. +#' The generated function will also accept `...` for additional arguments to +#' pass to `stabilize_dbl()` or `stabilize_dbl_scalar()`. You can copy/paste +#' the body of the resulting function if you want to provide additional +#' context or functionality. +#' @family double functions +#' @family specification functions +#' @export +#' +#' @examples +#' stabilize_3_to_5 <- specify_dbl(min_value = 3, max_value = 5) +#' stabilize_3_to_5(c(3.3, 4.4, 5)) +#' try(stabilize_3_to_5(c(1:6))) +specify_dbl <- function( + allow_null = TRUE, + allow_na = TRUE, + coerce_character = TRUE, + coerce_factor = TRUE, + min_size = NULL, + max_size = NULL, + unique = FALSE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("dbl", factory_args) +} + +#' @export +#' @rdname specify_dbl +specify_dbl_scalar <- function( + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + coerce_character = TRUE, + coerce_factor = TRUE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("dbl", factory_args, scalar = TRUE) +} + +#' @export +#' @rdname specify_dbl +specify_double <- specify_dbl + +#' @export +#' @rdname specify_dbl +specify_double_scalar <- specify_dbl_scalar diff --git a/R/specify_dttm.R b/R/specify_dttm.R new file mode 100644 index 00000000..9793aa9b --- /dev/null +++ b/R/specify_dttm.R @@ -0,0 +1,60 @@ +#' Create a specified datetime stabilizer function +#' +#' `specify_dttm()` creates a function that will call [stabilize_dttm()] with +#' the provided arguments. `specify_dttm_scalar()` creates a function that will +#' call [stabilize_dttm_scalar()] with the provided arguments. +#' `specify_datetime()` is a synonym of `specify_dttm()`, and +#' `specify_datetime_scalar()` is a synonym of `specify_dttm_scalar()`. +#' +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_dttm()] or [stabilize_dttm_scalar()] with the provided +#' arguments. The generated function will also accept `...` for additional +#' arguments to pass to `stabilize_dttm()` or `stabilize_dttm_scalar()`. You +#' can copy/paste the body of the resulting function if you want to provide +#' additional context or functionality. +#' @family datetime functions +#' @family specification functions +#' @export +#' +#' @examples +#' stabilize_recent <- specify_dttm(min_value = "2000-01-01T00:00:00Z") +#' stabilize_recent("2024-01-01T00:00:00Z") +#' try(stabilize_recent("1999-12-31T00:00:00Z")) +specify_dttm <- function( + tz = "UTC", + allow_null = TRUE, + allow_na = TRUE, + min_size = NULL, + max_size = NULL, + unique = FALSE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("dttm", factory_args) +} + +#' @export +#' @rdname specify_dttm +specify_dttm_scalar <- function( + tz = "UTC", + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("datetime", factory_args, scalar = TRUE) +} + +#' @export +#' @rdname specify_dttm +specify_datetime <- specify_dttm + +#' @export +#' @rdname specify_dttm +specify_datetime_scalar <- specify_dttm_scalar diff --git a/R/specify_dur.R b/R/specify_dur.R new file mode 100644 index 00000000..879eb775 --- /dev/null +++ b/R/specify_dur.R @@ -0,0 +1,58 @@ +#' Create a specified duration stabilizer function +#' +#' `specify_dur()` creates a function that will call [stabilize_dur()] with the +#' provided arguments. `specify_dur_scalar()` creates a function that will call +#' [stabilize_dur_scalar()] with the provided arguments. `specify_duration()` is +#' a synonym of `specify_dur()`, and `specify_duration_scalar()` is a synonym of +#' `specify_dur_scalar()`. +#' +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_dur()] or [stabilize_dur_scalar()] with the provided arguments. +#' The generated function will also accept `...` for additional arguments to +#' pass to `stabilize_dur()` or `stabilize_dur_scalar()`. You can copy/paste +#' the body of the resulting function if you want to provide additional +#' context or functionality. +#' @family duration functions +#' @family specification functions +#' @export +#' +#' @examples +#' stabilize_short <- specify_dur(max_value = "P1D") +#' stabilize_short("PT12H") +#' try(stabilize_short("P2D")) +specify_dur <- function( + allow_null = TRUE, + allow_na = TRUE, + min_size = NULL, + max_size = NULL, + unique = FALSE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("dur", factory_args) +} + +#' @export +#' @rdname specify_dur +specify_dur_scalar <- function( + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("dur", factory_args, scalar = TRUE) +} + +#' @export +#' @rdname specify_dur +specify_duration <- specify_dur + +#' @export +#' @rdname specify_dur +specify_duration_scalar <- specify_dur_scalar diff --git a/R/specify_fct.R b/R/specify_fct.R new file mode 100644 index 00000000..8a450425 --- /dev/null +++ b/R/specify_fct.R @@ -0,0 +1,56 @@ +#' Create a specified factor stabilizer function +#' +#' `specify_fct()` creates a function that will call [stabilize_fct()] with the +#' provided arguments. `specify_fct_scalar()` creates a function that will call +#' [stabilize_fct_scalar()] with the provided arguments. `specify_factor()` is a +#' synonym of `specify_fct()`, and `specify_factor_scalar()` is a synonym of +#' `specify_fct_scalar()`. +#' +#' @inheritParams stabilize_fct +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_fct()] or [stabilize_fct_scalar()] with the provided arguments. +#' The generated function will also accept `...` for additional arguments to +#' pass to `stabilize_fct()` or `stabilize_fct_scalar()`. You can copy/paste +#' the body of the resulting function if you want to provide additional +#' context or functionality. +#' @family factor functions +#' @family specification functions +#' @export +#' +#' @examples +#' stabilize_lowercase_letter <- specify_fct(levels = letters) +#' stabilize_lowercase_letter(c("s", "t", "b", "l")) +#' try(stabilize_lowercase_letter("A")) +specify_fct <- function( + allow_null = TRUE, + allow_na = TRUE, + min_size = NULL, + max_size = NULL, + levels = NULL, + to_na = character() +) { + factory_args <- .capture_factory_args() + .specify_cls("fct", factory_args) +} + +#' @export +#' @rdname specify_fct +specify_fct_scalar <- function( + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + levels = NULL, + to_na = character() +) { + factory_args <- .capture_factory_args() + .specify_cls("fct", factory_args, scalar = TRUE) +} + +#' @export +#' @rdname specify_fct +specify_factor <- specify_fct + +#' @export +#' @rdname specify_fct +specify_factor_scalar <- specify_fct_scalar diff --git a/R/specify_int.R b/R/specify_int.R new file mode 100644 index 00000000..baefc016 --- /dev/null +++ b/R/specify_int.R @@ -0,0 +1,62 @@ +#' Create a specified integer stabilizer function +#' +#' `specify_int()` creates a function that will call [stabilize_int()] with the +#' provided arguments. `specify_int_scalar()` creates a function that will call +#' [stabilize_int_scalar()] with the provided arguments. `specify_integer()` is +#' a synonym of `specify_int()`, and `specify_integer_scalar()` is a synonym of +#' `specify_int_scalar()`. +#' +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_int()] or [stabilize_int_scalar()] with the provided arguments. +#' The generated function will also accept `...` for additional arguments to +#' pass to `stabilize_int()` or `stabilize_int_scalar()`. You can copy/paste +#' the body of the resulting function if you want to provide additional +#' context or functionality. +#' @family integer functions +#' @family specification functions +#' @export +#' +#' @examples +#' stabilize_3_to_5 <- specify_int(min_value = 3, max_value = 5) +#' stabilize_3_to_5(c(3:5)) +#' try(stabilize_3_to_5(c(1:6))) +specify_int <- function( + allow_null = TRUE, + allow_na = TRUE, + coerce_character = TRUE, + coerce_factor = TRUE, + min_size = NULL, + max_size = NULL, + unique = FALSE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("int", factory_args) +} + +#' @export +#' @rdname specify_int +specify_int_scalar <- function( + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + coerce_character = TRUE, + coerce_factor = TRUE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("int", factory_args, scalar = TRUE) +} + +#' @export +#' @rdname specify_int +specify_integer <- specify_int + +#' @export +#' @rdname specify_int +specify_integer_scalar <- specify_int_scalar diff --git a/R/specify_lgl.R b/R/specify_lgl.R new file mode 100644 index 00000000..4470ea4d --- /dev/null +++ b/R/specify_lgl.R @@ -0,0 +1,52 @@ +#' Create a specified logical stabilizer function +#' +#' `specify_lgl()` creates a function that will call [stabilize_lgl()] with the +#' provided arguments. `specify_lgl_scalar()` creates a function that will call +#' [stabilize_lgl_scalar()] with the provided arguments. `specify_logical()` is +#' a synonym of `specify_lgl()`, and `specify_logical_scalar()` is a synonym of +#' `specify_lgl_scalar()`. +#' +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_lgl()] or [stabilize_lgl_scalar()] with the provided arguments. +#' The generated function will also accept `...` for additional arguments to +#' pass to `stabilize_lgl()` or `stabilize_lgl_scalar()`. You can copy/paste +#' the body of the resulting function if you want to provide additional +#' context or functionality. +#' @family logical functions +#' @family specification functions +#' @export +#' @examples +#' stabilize_few_lgl <- specify_lgl(max_size = 5) +#' stabilize_few_lgl(c(TRUE, "False", TRUE)) +#' try(stabilize_few_lgl(rep(TRUE, 10))) +specify_lgl <- function( + allow_null = TRUE, + allow_na = TRUE, + min_size = NULL, + max_size = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("lgl", factory_args) +} + +#' @export +#' @rdname specify_lgl +specify_lgl_scalar <- function( + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("lgl", factory_args, scalar = TRUE) +} + +#' @export +#' @rdname specify_lgl +specify_logical <- specify_lgl + +#' @export +#' @rdname specify_lgl +specify_logical_scalar <- specify_lgl_scalar diff --git a/R/specify_time.R b/R/specify_time.R new file mode 100644 index 00000000..f99d8bba --- /dev/null +++ b/R/specify_time.R @@ -0,0 +1,48 @@ +#' Create a specified time-of-day stabilizer function +#' +#' `specify_time()` creates a function that will call [stabilize_time()] with +#' the provided arguments. `specify_time_scalar()` creates a function that will +#' call [stabilize_time_scalar()] with the provided arguments. +#' +#' @inheritParams .shared-params +#' @returns A function of class `"stbl_specified_fn"` that calls +#' [stabilize_time()] or [stabilize_time_scalar()] with the provided +#' arguments. The generated function will also accept `...` for additional +#' arguments to pass to `stabilize_time()` or `stabilize_time_scalar()`. You +#' can copy/paste the body of the resulting function if you want to provide +#' additional context or functionality. +#' @family time functions +#' @family specification functions +#' @export +#' +#' @examples +#' stabilize_afternoon <- specify_time(min_value = "12:00:00Z") +#' stabilize_afternoon("13:00:00Z") +#' try(stabilize_afternoon("06:00:00Z")) +specify_time <- function( + allow_null = TRUE, + allow_na = TRUE, + min_size = NULL, + max_size = NULL, + unique = FALSE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("time", factory_args) +} + +#' @export +#' @rdname specify_time +specify_time_scalar <- function( + allow_null = FALSE, + allow_zero_length = FALSE, + allow_na = TRUE, + min_value = NULL, + max_value = NULL, + allowed_values = NULL +) { + factory_args <- .capture_factory_args() + .specify_cls("time", factory_args, scalar = TRUE) +} diff --git a/man/dot-capture_factory_args.Rd b/man/dot-capture_factory_args.Rd new file mode 100644 index 00000000..6cd69f4c --- /dev/null +++ b/man/dot-capture_factory_args.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/specify_cls.R +\name{.capture_factory_args} +\alias{.capture_factory_args} +\title{Capture the non-missing arguments of the calling function} +\usage{ +.capture_factory_args() +} +\value{ +A named list of the values of arguments that weren't left missing +in the function that called \code{.capture_factory_args()}. +} +\description{ +Used inside \verb{specify_*()} functions to build the \code{factory_args} list passed +to \code{\link[=.specify_cls]{.specify_cls()}}, keeping only the arguments that the caller of the +\verb{specify_*()} function actually supplied (as opposed to those left at +their default value). +} +\keyword{internal} diff --git a/man/specify_chr.Rd b/man/specify_chr.Rd index de75ac13..b881227e 100644 --- a/man/specify_chr.Rd +++ b/man/specify_chr.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_chr.R \name{specify_chr} \alias{specify_chr} \alias{specify_chr_scalar} diff --git a/man/specify_date.Rd b/man/specify_date.Rd index ff200c05..e76fd46c 100644 --- a/man/specify_date.Rd +++ b/man/specify_date.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_date.R \name{specify_date} \alias{specify_date} \alias{specify_date_scalar} diff --git a/man/specify_dbl.Rd b/man/specify_dbl.Rd index 99e1f88a..f95a3888 100644 --- a/man/specify_dbl.Rd +++ b/man/specify_dbl.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_dbl.R \name{specify_dbl} \alias{specify_dbl} \alias{specify_dbl_scalar} diff --git a/man/specify_dttm.Rd b/man/specify_dttm.Rd index 94b8ef54..d4fbd79b 100644 --- a/man/specify_dttm.Rd +++ b/man/specify_dttm.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_dttm.R \name{specify_dttm} \alias{specify_dttm} \alias{specify_dttm_scalar} diff --git a/man/specify_dur.Rd b/man/specify_dur.Rd index aa36a0c5..0563f5a2 100644 --- a/man/specify_dur.Rd +++ b/man/specify_dur.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_dur.R \name{specify_dur} \alias{specify_dur} \alias{specify_dur_scalar} diff --git a/man/specify_fct.Rd b/man/specify_fct.Rd index 68dc02f9..7669a63a 100644 --- a/man/specify_fct.Rd +++ b/man/specify_fct.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_fct.R \name{specify_fct} \alias{specify_fct} \alias{specify_fct_scalar} diff --git a/man/specify_int.Rd b/man/specify_int.Rd index 9b44007c..b7987758 100644 --- a/man/specify_int.Rd +++ b/man/specify_int.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_int.R \name{specify_int} \alias{specify_int} \alias{specify_int_scalar} diff --git a/man/specify_lgl.Rd b/man/specify_lgl.Rd index 5d07de1c..391514c1 100644 --- a/man/specify_lgl.Rd +++ b/man/specify_lgl.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_lgl.R \name{specify_lgl} \alias{specify_lgl} \alias{specify_lgl_scalar} diff --git a/man/specify_time.Rd b/man/specify_time.Rd index a92a748b..31fe9690 100644 --- a/man/specify_time.Rd +++ b/man/specify_time.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/specify_cls.R +% Please edit documentation in R/specify_time.R \name{specify_time} \alias{specify_time} \alias{specify_time_scalar} diff --git a/tests/testthat/test-specify_chr.R b/tests/testthat/test-specify_chr.R new file mode 100644 index 00000000..1bed0b29 --- /dev/null +++ b/tests/testthat/test-specify_chr.R @@ -0,0 +1,66 @@ +test_that("specify_chr can build a regex checker (#147, #310, #325)", { + checker <- specify_chr(regex = r"(^\d{5}(?:[-\s]\d{4})?$)") + given <- "12345-6789" + expect_identical( + checker(given), + given + ) + expect_pkg_error_classes( + checker("invalid"), + "stbl", + "regex_mismatch" + ) +}) + +test_that("specify_chr can enforce unique elements (#280, #325)", { + checker <- specify_chr(unique = TRUE) + expect_identical(checker(c("a", "b")), c("a", "b")) + expect_pkg_error_classes( + checker(c("a", "b", "a")), + "stbl", + "duplicate_elements" + ) +}) + +test_that("specify_chr_scalar can build a regex checker (#147, #310, #325)", { + checker <- specify_chr_scalar(regex = r"(^\d{5}(?:[-\s]\d{4})?$)") + given <- "12345-6789" + expect_identical( + checker(given), + given + ) + expect_pkg_error_classes( + checker("invalid"), + "stbl", + "regex_mismatch" + ) +}) + +test_that("specify_chr_scalar defaults to allow_null = FALSE (#197, #325)", { + checker <- specify_chr_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_chr_scalar defaults to allow_zero_length = FALSE (#197, #325)", { + checker <- specify_chr_scalar() + expect_pkg_error_classes(checker(character(0)), "stbl", "bad_empty") + expect_identical( + checker(character(0), allow_zero_length = TRUE), + character(0) + ) +}) + +test_that("specify_character() exists (#164, #325)", { + expect_no_error(specify_character()) +}) + +test_that("stabilize_character_scalar() exists (#164, #325)", { + expect_no_error(specify_character_scalar()) +}) + +test_that("specify_chr can enforce allowed_values (#282, #325)", { + checker <- specify_chr(allowed_values = c("a", "b")) + expect_identical(checker("a"), "a") + expect_pkg_error_classes(checker("z"), "stbl", "allowed_values") +}) diff --git a/tests/testthat/test-specify_cls.R b/tests/testthat/test-specify_cls.R index f03197e8..72510f3e 100644 --- a/tests/testthat/test-specify_cls.R +++ b/tests/testthat/test-specify_cls.R @@ -66,623 +66,10 @@ test_that(".specify_cls builds the expected scalar function snapshot (#150)", { expect_snapshot(scalar_checker, transform = clean_function_snapshot) }) -# Class versions ---- - -test_that("specify_chr can build a regex checker (#147, #310)", { - checker <- specify_chr(regex = r"(^\d{5}(?:[-\s]\d{4})?$)") - given <- "12345-6789" - expect_identical( - checker(given), - given - ) - expect_pkg_error_classes( - checker("invalid"), - "stbl", - "regex_mismatch" - ) -}) - -test_that("specify_chr can enforce unique elements (#280)", { - checker <- specify_chr(unique = TRUE) - expect_identical(checker(c("a", "b")), c("a", "b")) - expect_pkg_error_classes( - checker(c("a", "b", "a")), - "stbl", - "duplicate_elements" - ) -}) - -test_that("specify_chr_scalar can build a regex checker (#147, #310)", { - checker <- specify_chr_scalar(regex = r"(^\d{5}(?:[-\s]\d{4})?$)") - given <- "12345-6789" - expect_identical( - checker(given), - given - ) - expect_pkg_error_classes( - checker("invalid"), - "stbl", - "regex_mismatch" - ) -}) - -test_that("specify_chr_scalar defaults to allow_null = FALSE (#197)", { - checker <- specify_chr_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_chr_scalar defaults to allow_zero_length = FALSE (#197)", { - checker <- specify_chr_scalar() - expect_pkg_error_classes(checker(character(0)), "stbl", "bad_empty") - expect_identical( - checker(character(0), allow_zero_length = TRUE), - character(0) - ) -}) - -test_that("specify_dbl can build a value checker (#148)", { - checker <- specify_dbl(min_value = 27.2) - expect_identical( - checker(30:40 + 0.1), - 30:40 + 0.1 - ) - expect_pkg_error_classes( - checker(19.2), - "stbl", - "outside_range" - ) -}) - -test_that("specify_dbl can enforce unique elements (#280)", { - checker <- specify_dbl(unique = TRUE) - expect_identical(checker(c(1.1, 2.2)), c(1.1, 2.2)) - expect_pkg_error_classes( - checker(c(1.1, 2.2, 1.1)), - "stbl", - "duplicate_elements" - ) -}) - -test_that("specify_dbl_scalar can build a value checker (#148)", { - checker <- specify_dbl_scalar(min_value = 27.2) - expect_identical( - checker(30.1), - 30.1 - ) - expect_pkg_error_classes( - checker(30:40 + 0.1), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_dbl_scalar defaults to allow_null = FALSE (#197)", { - checker <- specify_dbl_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_dbl_scalar defaults to allow_zero_length = FALSE (#197)", { - checker <- specify_dbl_scalar() - expect_pkg_error_classes(checker(double(0)), "stbl", "bad_empty") - expect_identical(checker(double(0), allow_zero_length = TRUE), double(0)) -}) - -test_that("specify_date can build a value checker (#104)", { - checker <- specify_date(min_value = "2000-01-01") - expect_identical(checker("2024-01-01"), as.Date("2024-01-01")) - expect_pkg_error_classes( - checker("1999-12-31"), - "stbl", - "outside_range" - ) -}) - -test_that("specify_date can enforce unique elements (#104)", { - checker <- specify_date(unique = TRUE) - given <- as.Date(c("2024-01-01", "2024-06-15")) - expect_identical(checker(given), given) - expect_pkg_error_classes( - checker(as.Date(c("2024-01-01", "2024-01-01"))), - "stbl", - "duplicate_elements" - ) -}) - -test_that("specify_date_scalar can build a value checker (#104)", { - checker <- specify_date_scalar(min_value = "2000-01-01") - expect_identical(checker("2024-01-01"), as.Date("2024-01-01")) - expect_pkg_error_classes( - checker(as.Date(c("2024-01-01", "2024-06-15"))), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_date_scalar defaults to allow_null = FALSE (#104)", { - checker <- specify_date_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_date_scalar defaults to allow_zero_length = FALSE (#104)", { - checker <- specify_date_scalar() - expect_pkg_error_classes( - checker(as.Date(character(0))), - "stbl", - "bad_empty" - ) - expect_identical( - checker(as.Date(character(0)), allow_zero_length = TRUE), - as.Date(character(0)) - ) -}) - -test_that("specify_date can enforce allowed_values (#104)", { - checker <- specify_date(allowed_values = c("2024-01-01", "2024-06-15")) - expect_identical(checker("2024-01-01"), as.Date("2024-01-01")) - expect_pkg_error_classes(checker("2024-07-01"), "stbl", "allowed_values") -}) - -test_that("specify_date() creates a working stabilizer (#104)", { - stabilize_recent <- specify_date(min_value = "2000-01-01") - expect_identical(stabilize_recent("2024-01-01"), as.Date("2024-01-01")) - expect_pkg_error_classes( - stabilize_recent("1999-12-31"), - "stbl", - "outside_range" - ) -}) - -test_that("specify_date_scalar() creates a working scalar stabilizer (#104)", { - stabilize_recent <- specify_date_scalar(min_value = "2000-01-01") - expect_identical(stabilize_recent("2024-01-01"), as.Date("2024-01-01")) - expect_pkg_error_classes( - stabilize_recent(c("2024-01-01", "2024-06-15")), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_dttm can build a value checker (#105)", { - checker <- specify_dttm(min_value = "2000-01-01T00:00:00Z") - expect_identical( - checker("2024-01-01T00:00:00Z"), - to_dttm("2024-01-01T00:00:00Z") - ) - expect_pkg_error_classes( - checker("1999-12-31T00:00:00Z"), - "stbl", - "outside_range" - ) -}) - -test_that("specify_dttm can enforce unique elements (#105)", { - checker <- specify_dttm(unique = TRUE) - given <- to_dttm(c("2024-01-01T00:00:00Z", "2024-06-15T00:00:00Z")) - expect_identical(checker(given), given) - expect_pkg_error_classes( - checker(to_dttm(c("2024-01-01T00:00:00Z", "2024-01-01T00:00:00Z"))), - "stbl", - "duplicate_elements" - ) -}) - -test_that("specify_dttm respects tz (#105)", { - checker <- specify_dttm(tz = "America/Chicago") - result <- checker("2024-01-01T00:00:00Z") - expect_identical(attr(result, "tzone"), "America/Chicago") -}) - -test_that("specify_dttm_scalar can build a value checker (#105)", { - checker <- specify_dttm_scalar(min_value = "2000-01-01T00:00:00Z") - expect_identical( - checker("2024-01-01T00:00:00Z"), - to_dttm("2024-01-01T00:00:00Z") - ) - expect_pkg_error_classes( - checker(to_dttm(c( - "2024-01-01T00:00:00Z", - "2024-06-15T00:00:00Z" - ))), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_dttm_scalar defaults to allow_null = FALSE (#105)", { - checker <- specify_dttm_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_dttm_scalar defaults to allow_zero_length = FALSE (#105)", { - checker <- specify_dttm_scalar() - empty <- to_dttm(character()) - expect_pkg_error_classes(checker(empty), "stbl", "bad_empty") - expect_identical( - checker(empty, allow_zero_length = TRUE), - empty - ) -}) - -test_that("specify_dttm can enforce allowed_values (#105)", { - checker <- specify_dttm( - allowed_values = c("2024-01-01T00:00:00Z", "2024-06-15T00:00:00Z") - ) - expect_identical( - checker("2024-01-01T00:00:00Z"), - to_dttm("2024-01-01T00:00:00Z") - ) - expect_pkg_error_classes( - checker("2024-07-01T00:00:00Z"), - "stbl", - "allowed_values" - ) -}) - -test_that("specify_dttm() creates a working stabilizer (#105)", { - stabilize_recent <- specify_dttm(min_value = "2000-01-01T00:00:00Z") - expect_identical( - stabilize_recent("2024-01-01T00:00:00Z"), - to_dttm("2024-01-01T00:00:00Z") - ) - expect_pkg_error_classes( - stabilize_recent("1999-12-31T00:00:00Z"), - "stbl", - "outside_range" - ) -}) - -test_that("specify_dttm_scalar() creates a working scalar stabilizer (#105)", { - stabilize_recent <- specify_dttm_scalar( - min_value = "2000-01-01T00:00:00Z" - ) - expect_identical( - stabilize_recent("2024-01-01T00:00:00Z"), - to_dttm("2024-01-01T00:00:00Z") - ) - expect_pkg_error_classes( - stabilize_recent(c("2024-01-01T00:00:00Z", "2024-06-15T00:00:00Z")), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_dur can build a value checker (#295)", { - checker <- specify_dur(max_value = "P1D") - expect_identical(checker("PT12H"), to_dur("PT12H")) - expect_pkg_error_classes( - checker("P2D"), - "stbl", - "outside_range" - ) -}) - -test_that("specify_dur can enforce unique elements (#295)", { - checker <- specify_dur(unique = TRUE) - given <- to_dur(c("P1D", "P2D")) - expect_identical(checker(given), given) - expect_pkg_error_classes( - checker(to_dur(c("P1D", "P1D"))), - "stbl", - "duplicate_elements" - ) -}) - -test_that("specify_dur_scalar can build a value checker (#295)", { - checker <- specify_dur_scalar(max_value = "P1D") - expect_identical(checker("PT12H"), to_dur("PT12H")) - expect_pkg_error_classes( - checker(to_dur(c("P1D", "P2D"))), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_dur_scalar defaults to allow_null = FALSE (#295)", { - checker <- specify_dur_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_dur_scalar defaults to allow_zero_length = FALSE (#295)", { - checker <- specify_dur_scalar() - empty <- to_dur(character()) - expect_pkg_error_classes(checker(empty), "stbl", "bad_empty") - expect_identical(checker(empty, allow_zero_length = TRUE), empty) -}) - -test_that("specify_dur can enforce allowed_values (#295)", { - checker <- specify_dur( - allowed_values = c("P1D", "P2D") - ) - expect_identical(checker("P1D"), to_dur("P1D")) - expect_pkg_error_classes(checker("P3D"), "stbl", "allowed_values") -}) - -test_that("specify_dur() creates a working stabilizer (#295)", { - stabilize_short <- specify_dur(max_value = "P1D") - expect_identical(stabilize_short("PT12H"), to_dur("PT12H")) - expect_pkg_error_classes( - stabilize_short("P2D"), - "stbl", - "outside_range" - ) -}) - -test_that("specify_dur_scalar() creates a working scalar stabilizer (#295)", { - stabilize_short <- specify_dur_scalar(max_value = "P1D") - expect_identical(stabilize_short("PT12H"), to_dur("PT12H")) - expect_pkg_error_classes( - stabilize_short(c("P1D", "P2D")), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_time can build a value checker (#294)", { - checker <- specify_time(min_value = "12:00:00Z") - expect_identical(checker("13:00:00Z"), to_time("13:00:00Z")) - expect_pkg_error_classes( - checker("06:00:00Z"), - "stbl", - "outside_range" - ) -}) - -test_that("specify_time can enforce unique elements (#294)", { - checker <- specify_time(unique = TRUE) - given <- to_time(c("06:00:00Z", "14:00:00Z")) - expect_identical(checker(given), given) - expect_pkg_error_classes( - checker(to_time(c("06:00:00Z", "06:00:00Z"))), - "stbl", - "duplicate_elements" - ) -}) - -test_that("specify_time_scalar can build a value checker (#294)", { - checker <- specify_time_scalar(min_value = "12:00:00Z") - expect_identical(checker("13:00:00Z"), to_time("13:00:00Z")) - expect_pkg_error_classes( - checker(to_time(c("13:00:00Z", "14:00:00Z"))), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_time_scalar defaults to allow_null = FALSE (#294)", { - checker <- specify_time_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_time_scalar defaults to allow_zero_length = FALSE (#294)", { - checker <- specify_time_scalar() - empty <- to_time(character()) - expect_pkg_error_classes(checker(empty), "stbl", "bad_empty") - expect_identical(checker(empty, allow_zero_length = TRUE), empty) -}) - -test_that("specify_time can enforce allowed_values (#294)", { - checker <- specify_time( - allowed_values = c("06:00:00Z", "14:00:00Z") - ) - expect_identical(checker("06:00:00Z"), to_time("06:00:00Z")) - expect_pkg_error_classes(checker("09:00:00Z"), "stbl", "allowed_values") -}) - -test_that("specify_time() creates a working stabilizer (#294)", { - stabilize_afternoon <- specify_time(min_value = "12:00:00Z") - expect_identical( - stabilize_afternoon("13:00:00Z"), - to_time("13:00:00Z") - ) - expect_pkg_error_classes( - stabilize_afternoon("06:00:00Z"), - "stbl", - "outside_range" - ) -}) - -test_that("specify_time_scalar() creates a working scalar stabilizer (#294)", { - stabilize_afternoon <- specify_time_scalar(min_value = "12:00:00Z") - expect_identical( - stabilize_afternoon("13:00:00Z"), - to_time("13:00:00Z") - ) - expect_pkg_error_classes( - stabilize_afternoon(c("13:00:00Z", "14:00:00Z")), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_fct can build a level checker (#150)", { - checker <- specify_fct(levels = c("a", "c"), to_na = "b") - expect_identical( - checker(c("a", "b", "c")), - factor(c("a", NA, "c"), levels = c("a", "c")) - ) - expect_pkg_error_classes( - checker("invalid"), - "stbl", - "fct_levels" - ) -}) - -test_that("specify_fct_scalar can build a level checker (#150)", { - checker <- specify_fct_scalar(levels = c("a", "c"), to_na = "b") - expect_identical( - checker("a"), - factor("a", levels = c("a", "c")) - ) - expect_pkg_error_classes( - checker(c("a", "c")), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_fct_scalar defaults to allow_null = FALSE (#197)", { - checker <- specify_fct_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_fct_scalar defaults to allow_zero_length = FALSE (#197)", { - checker <- specify_fct_scalar() - expect_pkg_error_classes(checker(character(0)), "stbl", "bad_empty") - expect_identical( - checker(character(0), allow_zero_length = TRUE), - factor(character(0)) - ) -}) - -test_that("specify_int can build a value checker (#149)", { - checker <- specify_int(min_value = 2) - expect_identical( - checker(2:10), - 2:10 - ) - expect_pkg_error_classes( - checker(1), - "stbl", - "outside_range" - ) -}) - -test_that("specify_int can enforce unique elements (#280)", { - checker <- specify_int(unique = TRUE) - expect_identical(checker(c(1L, 2L)), c(1L, 2L)) - expect_pkg_error_classes(checker(c(1L, 2L, 1L)), "stbl", "duplicate_elements") -}) - -test_that("specify_int_scalar can build a value checker (#149)", { - checker <- specify_int_scalar(min_value = 2) - expect_identical( - checker(2), - 2L - ) - expect_pkg_error_classes( - checker(2:10), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_int_scalar defaults to allow_null = FALSE (#197)", { - checker <- specify_int_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_int_scalar defaults to allow_zero_length = FALSE (#197)", { - checker <- specify_int_scalar() - expect_pkg_error_classes(checker(integer(0)), "stbl", "bad_empty") - expect_identical(checker(integer(0), allow_zero_length = TRUE), integer(0)) -}) - -test_that("specify_lgl can build a checker (#151)", { - checker <- specify_lgl(allow_na = FALSE) - expect_identical( - checker(c(TRUE, "False")), - c(TRUE, FALSE) - ) - expect_pkg_error_classes( - checker(NA), - "stbl", - "bad_na" - ) -}) - -test_that("specify_lgl_scalar can build a value checker (#151)", { - checker <- specify_lgl_scalar(allow_na = FALSE) - expect_identical( - checker("True"), - TRUE - ) - expect_pkg_error_classes( - checker(c(TRUE, FALSE)), - "stbl", - "non_scalar" - ) -}) - -test_that("specify_lgl_scalar defaults to allow_null = FALSE (#197)", { - checker <- specify_lgl_scalar() - expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") - expect_identical(checker(NULL, allow_null = TRUE), NULL) -}) - -test_that("specify_lgl_scalar defaults to allow_zero_length = FALSE (#197)", { - checker <- specify_lgl_scalar() - expect_pkg_error_classes(checker(logical(0)), "stbl", "bad_empty") - expect_identical(checker(logical(0), allow_zero_length = TRUE), logical(0)) -}) - -test_that("specify_character() exists (#164)", { - expect_no_error(specify_character()) -}) - -test_that("stabilize_character_scalar() exists (#164)", { - expect_no_error(specify_character_scalar()) -}) - -test_that("specify_double() exists (#164)", { - expect_no_error(specify_double()) -}) - -test_that("stabilize_double_scalar() exists (#164)", { - expect_no_error(specify_double_scalar()) -}) - -test_that("specify_factor() exists (#164)", { - expect_no_error(specify_factor()) -}) - -test_that("stabilize_factor_scalar() exists (#164)", { - expect_no_error(specify_factor_scalar()) -}) - -test_that("specify_integer() exists (#164)", { - expect_no_error(specify_integer()) -}) - -test_that("stabilize_integer_scalar() exists (#164)", { - expect_no_error(specify_integer_scalar()) -}) - -test_that("specify_logical() exists (#164)", { - expect_no_error(specify_logical()) -}) - -test_that("stabilize_logical_scalar() exists (#164)", { - expect_no_error(specify_logical_scalar()) -}) - -test_that("specify_chr can enforce allowed_values (#282)", { - checker <- specify_chr(allowed_values = c("a", "b")) - expect_identical(checker("a"), "a") - expect_pkg_error_classes(checker("z"), "stbl", "allowed_values") -}) - -test_that("specify_int can enforce allowed_values (#282)", { - checker <- specify_int(allowed_values = c(1L, 2L)) - expect_identical(checker(1L), 1L) - expect_pkg_error_classes(checker(5L), "stbl", "allowed_values") -}) - -test_that("specify_dbl can enforce allowed_values (#282)", { - checker <- specify_dbl(allowed_values = c(1.1, 2.2)) - expect_identical(checker(1.1), 1.1) - expect_pkg_error_classes(checker(3.3), "stbl", "allowed_values") -}) - -test_that("specify_lgl can enforce allowed_values (#282)", { - checker <- specify_lgl(allowed_values = TRUE) - expect_identical(checker(TRUE), TRUE) - expect_pkg_error_classes(checker(FALSE), "stbl", "allowed_values") +test_that(".capture_factory_args only includes non-missing arguments (#325)", { + spec <- function(a = 1, b = 2, c = 3) { + .capture_factory_args() + } + expect_identical(spec(a = 10, c = 30), list(a = 10, c = 30)) + expect_identical(spec(), list()) }) diff --git a/tests/testthat/test-specify_date.R b/tests/testthat/test-specify_date.R new file mode 100644 index 00000000..20d6ed6c --- /dev/null +++ b/tests/testthat/test-specify_date.R @@ -0,0 +1,75 @@ +test_that("specify_date can build a value checker (#104, #325)", { + checker <- specify_date(min_value = "2000-01-01") + expect_identical(checker("2024-01-01"), as.Date("2024-01-01")) + expect_pkg_error_classes( + checker("1999-12-31"), + "stbl", + "outside_range" + ) +}) + +test_that("specify_date can enforce unique elements (#104, #325)", { + checker <- specify_date(unique = TRUE) + given <- as.Date(c("2024-01-01", "2024-06-15")) + expect_identical(checker(given), given) + expect_pkg_error_classes( + checker(as.Date(c("2024-01-01", "2024-01-01"))), + "stbl", + "duplicate_elements" + ) +}) + +test_that("specify_date_scalar can build a value checker (#104, #325)", { + checker <- specify_date_scalar(min_value = "2000-01-01") + expect_identical(checker("2024-01-01"), as.Date("2024-01-01")) + expect_pkg_error_classes( + checker(as.Date(c("2024-01-01", "2024-06-15"))), + "stbl", + "non_scalar" + ) +}) + +test_that("specify_date_scalar defaults to allow_null = FALSE (#104, #325)", { + checker <- specify_date_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_date_scalar defaults to allow_zero_length = FALSE (#104, #325)", { + checker <- specify_date_scalar() + expect_pkg_error_classes( + checker(as.Date(character(0))), + "stbl", + "bad_empty" + ) + expect_identical( + checker(as.Date(character(0)), allow_zero_length = TRUE), + as.Date(character(0)) + ) +}) + +test_that("specify_date can enforce allowed_values (#104, #325)", { + checker <- specify_date(allowed_values = c("2024-01-01", "2024-06-15")) + expect_identical(checker("2024-01-01"), as.Date("2024-01-01")) + expect_pkg_error_classes(checker("2024-07-01"), "stbl", "allowed_values") +}) + +test_that("specify_date() creates a working stabilizer (#104, #325)", { + stabilize_recent <- specify_date(min_value = "2000-01-01") + expect_identical(stabilize_recent("2024-01-01"), as.Date("2024-01-01")) + expect_pkg_error_classes( + stabilize_recent("1999-12-31"), + "stbl", + "outside_range" + ) +}) + +test_that("specify_date_scalar() creates a working scalar stabilizer (#104, #325)", { + stabilize_recent <- specify_date_scalar(min_value = "2000-01-01") + expect_identical(stabilize_recent("2024-01-01"), as.Date("2024-01-01")) + expect_pkg_error_classes( + stabilize_recent(c("2024-01-01", "2024-06-15")), + "stbl", + "non_scalar" + ) +}) diff --git a/tests/testthat/test-specify_dbl.R b/tests/testthat/test-specify_dbl.R new file mode 100644 index 00000000..398122e5 --- /dev/null +++ b/tests/testthat/test-specify_dbl.R @@ -0,0 +1,61 @@ +test_that("specify_dbl can build a value checker (#148, #325)", { + checker <- specify_dbl(min_value = 27.2) + expect_identical( + checker(30:40 + 0.1), + 30:40 + 0.1 + ) + expect_pkg_error_classes( + checker(19.2), + "stbl", + "outside_range" + ) +}) + +test_that("specify_dbl can enforce unique elements (#280, #325)", { + checker <- specify_dbl(unique = TRUE) + expect_identical(checker(c(1.1, 2.2)), c(1.1, 2.2)) + expect_pkg_error_classes( + checker(c(1.1, 2.2, 1.1)), + "stbl", + "duplicate_elements" + ) +}) + +test_that("specify_dbl_scalar can build a value checker (#148, #325)", { + checker <- specify_dbl_scalar(min_value = 27.2) + expect_identical( + checker(30.1), + 30.1 + ) + expect_pkg_error_classes( + checker(30:40 + 0.1), + "stbl", + "non_scalar" + ) +}) + +test_that("specify_dbl_scalar defaults to allow_null = FALSE (#197, #325)", { + checker <- specify_dbl_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_dbl_scalar defaults to allow_zero_length = FALSE (#197, #325)", { + checker <- specify_dbl_scalar() + expect_pkg_error_classes(checker(double(0)), "stbl", "bad_empty") + expect_identical(checker(double(0), allow_zero_length = TRUE), double(0)) +}) + +test_that("specify_double() exists (#164, #325)", { + expect_no_error(specify_double()) +}) + +test_that("stabilize_double_scalar() exists (#164, #325)", { + expect_no_error(specify_double_scalar()) +}) + +test_that("specify_dbl can enforce allowed_values (#282, #325)", { + checker <- specify_dbl(allowed_values = c(1.1, 2.2)) + expect_identical(checker(1.1), 1.1) + expect_pkg_error_classes(checker(3.3), "stbl", "allowed_values") +}) diff --git a/tests/testthat/test-specify_dttm.R b/tests/testthat/test-specify_dttm.R new file mode 100644 index 00000000..ecbc4213 --- /dev/null +++ b/tests/testthat/test-specify_dttm.R @@ -0,0 +1,104 @@ +test_that("specify_dttm can build a value checker (#105, #325)", { + checker <- specify_dttm(min_value = "2000-01-01T00:00:00Z") + expect_identical( + checker("2024-01-01T00:00:00Z"), + to_dttm("2024-01-01T00:00:00Z") + ) + expect_pkg_error_classes( + checker("1999-12-31T00:00:00Z"), + "stbl", + "outside_range" + ) +}) + +test_that("specify_dttm can enforce unique elements (#105, #325)", { + checker <- specify_dttm(unique = TRUE) + given <- to_dttm(c("2024-01-01T00:00:00Z", "2024-06-15T00:00:00Z")) + expect_identical(checker(given), given) + expect_pkg_error_classes( + checker(to_dttm(c("2024-01-01T00:00:00Z", "2024-01-01T00:00:00Z"))), + "stbl", + "duplicate_elements" + ) +}) + +test_that("specify_dttm respects tz (#105, #325)", { + checker <- specify_dttm(tz = "America/Chicago") + result <- checker("2024-01-01T00:00:00Z") + expect_identical(attr(result, "tzone"), "America/Chicago") +}) + +test_that("specify_dttm_scalar can build a value checker (#105, #325)", { + checker <- specify_dttm_scalar(min_value = "2000-01-01T00:00:00Z") + expect_identical( + checker("2024-01-01T00:00:00Z"), + to_dttm("2024-01-01T00:00:00Z") + ) + expect_pkg_error_classes( + checker(to_dttm(c( + "2024-01-01T00:00:00Z", + "2024-06-15T00:00:00Z" + ))), + "stbl", + "non_scalar" + ) +}) + +test_that("specify_dttm_scalar defaults to allow_null = FALSE (#105, #325)", { + checker <- specify_dttm_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_dttm_scalar defaults to allow_zero_length = FALSE (#105, #325)", { + checker <- specify_dttm_scalar() + empty <- to_dttm(character()) + expect_pkg_error_classes(checker(empty), "stbl", "bad_empty") + expect_identical( + checker(empty, allow_zero_length = TRUE), + empty + ) +}) + +test_that("specify_dttm can enforce allowed_values (#105, #325)", { + checker <- specify_dttm( + allowed_values = c("2024-01-01T00:00:00Z", "2024-06-15T00:00:00Z") + ) + expect_identical( + checker("2024-01-01T00:00:00Z"), + to_dttm("2024-01-01T00:00:00Z") + ) + expect_pkg_error_classes( + checker("2024-07-01T00:00:00Z"), + "stbl", + "allowed_values" + ) +}) + +test_that("specify_dttm() creates a working stabilizer (#105, #325)", { + stabilize_recent <- specify_dttm(min_value = "2000-01-01T00:00:00Z") + expect_identical( + stabilize_recent("2024-01-01T00:00:00Z"), + to_dttm("2024-01-01T00:00:00Z") + ) + expect_pkg_error_classes( + stabilize_recent("1999-12-31T00:00:00Z"), + "stbl", + "outside_range" + ) +}) + +test_that("specify_dttm_scalar() creates a working scalar stabilizer (#105, #325)", { + stabilize_recent <- specify_dttm_scalar( + min_value = "2000-01-01T00:00:00Z" + ) + expect_identical( + stabilize_recent("2024-01-01T00:00:00Z"), + to_dttm("2024-01-01T00:00:00Z") + ) + expect_pkg_error_classes( + stabilize_recent(c("2024-01-01T00:00:00Z", "2024-06-15T00:00:00Z")), + "stbl", + "non_scalar" + ) +}) diff --git a/tests/testthat/test-specify_dur.R b/tests/testthat/test-specify_dur.R new file mode 100644 index 00000000..463a58f4 --- /dev/null +++ b/tests/testthat/test-specify_dur.R @@ -0,0 +1,71 @@ +test_that("specify_dur can build a value checker (#295, #325)", { + checker <- specify_dur(max_value = "P1D") + expect_identical(checker("PT12H"), to_dur("PT12H")) + expect_pkg_error_classes( + checker("P2D"), + "stbl", + "outside_range" + ) +}) + +test_that("specify_dur can enforce unique elements (#295, #325)", { + checker <- specify_dur(unique = TRUE) + given <- to_dur(c("P1D", "P2D")) + expect_identical(checker(given), given) + expect_pkg_error_classes( + checker(to_dur(c("P1D", "P1D"))), + "stbl", + "duplicate_elements" + ) +}) + +test_that("specify_dur_scalar can build a value checker (#295, #325)", { + checker <- specify_dur_scalar(max_value = "P1D") + expect_identical(checker("PT12H"), to_dur("PT12H")) + expect_pkg_error_classes( + checker(to_dur(c("P1D", "P2D"))), + "stbl", + "non_scalar" + ) +}) + +test_that("specify_dur_scalar defaults to allow_null = FALSE (#295, #325)", { + checker <- specify_dur_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_dur_scalar defaults to allow_zero_length = FALSE (#295, #325)", { + checker <- specify_dur_scalar() + empty <- to_dur(character()) + expect_pkg_error_classes(checker(empty), "stbl", "bad_empty") + expect_identical(checker(empty, allow_zero_length = TRUE), empty) +}) + +test_that("specify_dur can enforce allowed_values (#295, #325)", { + checker <- specify_dur( + allowed_values = c("P1D", "P2D") + ) + expect_identical(checker("P1D"), to_dur("P1D")) + expect_pkg_error_classes(checker("P3D"), "stbl", "allowed_values") +}) + +test_that("specify_dur() creates a working stabilizer (#295, #325)", { + stabilize_short <- specify_dur(max_value = "P1D") + expect_identical(stabilize_short("PT12H"), to_dur("PT12H")) + expect_pkg_error_classes( + stabilize_short("P2D"), + "stbl", + "outside_range" + ) +}) + +test_that("specify_dur_scalar() creates a working scalar stabilizer (#295, #325)", { + stabilize_short <- specify_dur_scalar(max_value = "P1D") + expect_identical(stabilize_short("PT12H"), to_dur("PT12H")) + expect_pkg_error_classes( + stabilize_short(c("P1D", "P2D")), + "stbl", + "non_scalar" + ) +}) diff --git a/tests/testthat/test-specify_fct.R b/tests/testthat/test-specify_fct.R new file mode 100644 index 00000000..b054c7a2 --- /dev/null +++ b/tests/testthat/test-specify_fct.R @@ -0,0 +1,48 @@ +test_that("specify_fct can build a level checker (#150, #325)", { + checker <- specify_fct(levels = c("a", "c"), to_na = "b") + expect_identical( + checker(c("a", "b", "c")), + factor(c("a", NA, "c"), levels = c("a", "c")) + ) + expect_pkg_error_classes( + checker("invalid"), + "stbl", + "fct_levels" + ) +}) + +test_that("specify_fct_scalar can build a level checker (#150, #325)", { + checker <- specify_fct_scalar(levels = c("a", "c"), to_na = "b") + expect_identical( + checker("a"), + factor("a", levels = c("a", "c")) + ) + expect_pkg_error_classes( + checker(c("a", "c")), + "stbl", + "non_scalar" + ) +}) + +test_that("specify_fct_scalar defaults to allow_null = FALSE (#197, #325)", { + checker <- specify_fct_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_fct_scalar defaults to allow_zero_length = FALSE (#197, #325)", { + checker <- specify_fct_scalar() + expect_pkg_error_classes(checker(character(0)), "stbl", "bad_empty") + expect_identical( + checker(character(0), allow_zero_length = TRUE), + factor(character(0)) + ) +}) + +test_that("specify_factor() exists (#164, #325)", { + expect_no_error(specify_factor()) +}) + +test_that("stabilize_factor_scalar() exists (#164, #325)", { + expect_no_error(specify_factor_scalar()) +}) diff --git a/tests/testthat/test-specify_int.R b/tests/testthat/test-specify_int.R new file mode 100644 index 00000000..cbfaab76 --- /dev/null +++ b/tests/testthat/test-specify_int.R @@ -0,0 +1,57 @@ +test_that("specify_int can build a value checker (#149, #325)", { + checker <- specify_int(min_value = 2) + expect_identical( + checker(2:10), + 2:10 + ) + expect_pkg_error_classes( + checker(1), + "stbl", + "outside_range" + ) +}) + +test_that("specify_int can enforce unique elements (#280, #325)", { + checker <- specify_int(unique = TRUE) + expect_identical(checker(c(1L, 2L)), c(1L, 2L)) + expect_pkg_error_classes(checker(c(1L, 2L, 1L)), "stbl", "duplicate_elements") +}) + +test_that("specify_int_scalar can build a value checker (#149, #325)", { + checker <- specify_int_scalar(min_value = 2) + expect_identical( + checker(2), + 2L + ) + expect_pkg_error_classes( + checker(2:10), + "stbl", + "non_scalar" + ) +}) + +test_that("specify_int_scalar defaults to allow_null = FALSE (#197, #325)", { + checker <- specify_int_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_int_scalar defaults to allow_zero_length = FALSE (#197, #325)", { + checker <- specify_int_scalar() + expect_pkg_error_classes(checker(integer(0)), "stbl", "bad_empty") + expect_identical(checker(integer(0), allow_zero_length = TRUE), integer(0)) +}) + +test_that("specify_integer() exists (#164, #325)", { + expect_no_error(specify_integer()) +}) + +test_that("stabilize_integer_scalar() exists (#164, #325)", { + expect_no_error(specify_integer_scalar()) +}) + +test_that("specify_int can enforce allowed_values (#282, #325)", { + checker <- specify_int(allowed_values = c(1L, 2L)) + expect_identical(checker(1L), 1L) + expect_pkg_error_classes(checker(5L), "stbl", "allowed_values") +}) diff --git a/tests/testthat/test-specify_lgl.R b/tests/testthat/test-specify_lgl.R new file mode 100644 index 00000000..a32d125d --- /dev/null +++ b/tests/testthat/test-specify_lgl.R @@ -0,0 +1,51 @@ +test_that("specify_lgl can build a checker (#151, #325)", { + checker <- specify_lgl(allow_na = FALSE) + expect_identical( + checker(c(TRUE, "False")), + c(TRUE, FALSE) + ) + expect_pkg_error_classes( + checker(NA), + "stbl", + "bad_na" + ) +}) + +test_that("specify_lgl_scalar can build a value checker (#151, #325)", { + checker <- specify_lgl_scalar(allow_na = FALSE) + expect_identical( + checker("True"), + TRUE + ) + expect_pkg_error_classes( + checker(c(TRUE, FALSE)), + "stbl", + "non_scalar" + ) +}) + +test_that("specify_lgl_scalar defaults to allow_null = FALSE (#197, #325)", { + checker <- specify_lgl_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_lgl_scalar defaults to allow_zero_length = FALSE (#197, #325)", { + checker <- specify_lgl_scalar() + expect_pkg_error_classes(checker(logical(0)), "stbl", "bad_empty") + expect_identical(checker(logical(0), allow_zero_length = TRUE), logical(0)) +}) + +test_that("specify_logical() exists (#164, #325)", { + expect_no_error(specify_logical()) +}) + +test_that("stabilize_logical_scalar() exists (#164, #325)", { + expect_no_error(specify_logical_scalar()) +}) + +test_that("specify_lgl can enforce allowed_values (#282, #325)", { + checker <- specify_lgl(allowed_values = TRUE) + expect_identical(checker(TRUE), TRUE) + expect_pkg_error_classes(checker(FALSE), "stbl", "allowed_values") +}) diff --git a/tests/testthat/test-specify_time.R b/tests/testthat/test-specify_time.R new file mode 100644 index 00000000..3647bdbd --- /dev/null +++ b/tests/testthat/test-specify_time.R @@ -0,0 +1,77 @@ +test_that("specify_time can build a value checker (#294, #325)", { + checker <- specify_time(min_value = "12:00:00Z") + expect_identical(checker("13:00:00Z"), to_time("13:00:00Z")) + expect_pkg_error_classes( + checker("06:00:00Z"), + "stbl", + "outside_range" + ) +}) + +test_that("specify_time can enforce unique elements (#294, #325)", { + checker <- specify_time(unique = TRUE) + given <- to_time(c("06:00:00Z", "14:00:00Z")) + expect_identical(checker(given), given) + expect_pkg_error_classes( + checker(to_time(c("06:00:00Z", "06:00:00Z"))), + "stbl", + "duplicate_elements" + ) +}) + +test_that("specify_time_scalar can build a value checker (#294, #325)", { + checker <- specify_time_scalar(min_value = "12:00:00Z") + expect_identical(checker("13:00:00Z"), to_time("13:00:00Z")) + expect_pkg_error_classes( + checker(to_time(c("13:00:00Z", "14:00:00Z"))), + "stbl", + "non_scalar" + ) +}) + +test_that("specify_time_scalar defaults to allow_null = FALSE (#294, #325)", { + checker <- specify_time_scalar() + expect_pkg_error_classes(checker(NULL), "stbl", "bad_null") + expect_identical(checker(NULL, allow_null = TRUE), NULL) +}) + +test_that("specify_time_scalar defaults to allow_zero_length = FALSE (#294, #325)", { + checker <- specify_time_scalar() + empty <- to_time(character()) + expect_pkg_error_classes(checker(empty), "stbl", "bad_empty") + expect_identical(checker(empty, allow_zero_length = TRUE), empty) +}) + +test_that("specify_time can enforce allowed_values (#294, #325)", { + checker <- specify_time( + allowed_values = c("06:00:00Z", "14:00:00Z") + ) + expect_identical(checker("06:00:00Z"), to_time("06:00:00Z")) + expect_pkg_error_classes(checker("09:00:00Z"), "stbl", "allowed_values") +}) + +test_that("specify_time() creates a working stabilizer (#294, #325)", { + stabilize_afternoon <- specify_time(min_value = "12:00:00Z") + expect_identical( + stabilize_afternoon("13:00:00Z"), + to_time("13:00:00Z") + ) + expect_pkg_error_classes( + stabilize_afternoon("06:00:00Z"), + "stbl", + "outside_range" + ) +}) + +test_that("specify_time_scalar() creates a working scalar stabilizer (#294, #325)", { + stabilize_afternoon <- specify_time_scalar(min_value = "12:00:00Z") + expect_identical( + stabilize_afternoon("13:00:00Z"), + to_time("13:00:00Z") + ) + expect_pkg_error_classes( + stabilize_afternoon(c("13:00:00Z", "14:00:00Z")), + "stbl", + "non_scalar" + ) +})