From 80f7864a1fa3a4f22cebb77f97829db2ac8fa231 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 16:28:01 -0400 Subject: [PATCH 001/169] sets up use of cnd (#259) --- DESCRIPTION | 3 ++- NAMESPACE | 1 + R/aaa.R | 3 +++ R/mark-package.R | 1 + R/zzz.R | 3 +++ 5 files changed, 10 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4d09aa18..5ca48552 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,6 +23,7 @@ Depends: R (>= 3.6) Imports: cli, + cnd, fs (>= 1.6.2), fuj (>= 0.2.1), magrittr (>= 2.0.1), @@ -54,7 +55,7 @@ Suggests: arrow (>= 16.1.0), readMDTable (>= 0.2.0), clipr (>= 0.8.0) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 Config/testthat/parallel: true diff --git a/NAMESPACE b/NAMESPACE index 13f4a5ea..c44631ed 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -291,6 +291,7 @@ export(within_fun) export(write_clipboard) export(write_file_md5) export(wuffle) +import(cnd) import(fuj) importFrom(fuj,"%::%") importFrom(fuj,"%:::%") diff --git a/R/aaa.R b/R/aaa.R index eb7e300e..665c0419 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -11,3 +11,6 @@ na_list <- list( ) options(mark.na_list = na_list) + +cnd_create_registry() + diff --git a/R/mark-package.R b/R/mark-package.R index 2c798408..0123342e 100644 --- a/R/mark-package.R +++ b/R/mark-package.R @@ -3,6 +3,7 @@ #' Miscellaneous, Analytic R Kernels #' #' @import fuj +#' @import cnd #' @docType package #' @name mark "_PACKAGE" diff --git a/R/zzz.R b/R/zzz.R index 2db0120b..67e9dba9 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -5,3 +5,6 @@ .onDetach <- function(libpath) { invisible() } + +# FIXME include: +# cnd_document() From 087f463e10fb79d7a389b78269517616d8c62552 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 17:57:25 -0400 Subject: [PATCH 002/169] includes walrus operator (#259) --- R/aaa.R | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 665c0419..02468c07 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -1,16 +1,24 @@ -na_list <- list( - logical = logical(), - character = character(), - integer = integer(), - double = double(), - numeric = numeric(), - Date = as.Date(NA), - POSIXct = as.POSIXct(NA), - POSIXlt = as.POSIXlt(NA)[[1]] -) +cnd_create_registry() -options(mark.na_list = na_list) +# nolint next: line_length_linter. +# https://github.com/RConsortium/S7/blob/e430c9aab137cc6301d5e06922e4d8cf2c0a8270/tests/testthat/helper.R#L73-L79 +# modified from: +# https://github.com/RConsortium/S7/issues/466#issuecomment-2417642612 +walrus <- function(sym, val) { + sym <- substitute(sym) + sym <- as.character(sym) # `"sym" <- val` is fine -cnd_create_registry() + val <- substitute(val) + val <- as.list(val) + val <- as.call(c(val[[1L]], sym, val[-1L])) + + eval.parent(call("<-", sym, val)) +} +# https://adv-r.hadley.nz/quasiquotation.html +# := is like a vestigial organ: it’s recognised by R’s parser, but it doesn’t +# have any code associated with it. It looks like an = but allows expressions on +# either side, making it a more flexible alternative to =. It is used in +# data.table for similar reasons. +`:=` <- `%:=%` <- walrus From caec09f98647ce85e5b7412f178ff1738477b579 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 17:58:06 -0400 Subject: [PATCH 003/169] updates conditions for append (#259) --- R/append.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/append.R b/R/append.R index 76a7db80..5538901e 100644 --- a/R/append.R +++ b/R/append.R @@ -20,7 +20,7 @@ append0.list <- function(x, values, pos = NULL, expand = FALSE, ...) { n <- unique(lengths(x)) if (length(n) > 1) { - warning(cond_append_expand()) + warning(append_expand_warning()) n <- max(n) } @@ -64,6 +64,9 @@ append0.default <- function(x, values, pos = NULL, ...) { # conditions -------------------------------------------------------------- -cond_append_expand <- function() { - new_condition("expanding to the largest n", "append0", type = "warning") -} +append_expand_warning := condition( + message = "expanding to the largest n", + type = "warning", + package = "mark", + exports = "insert" +) From 8c49c713e205cce171e582d2f5e4b21cbb29d500 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 17:58:16 -0400 Subject: [PATCH 004/169] updates conditions for array (#259) --- R/array.R | 15 ++++++++------- tests/testthat/test-array.R | 2 +- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/R/array.R b/R/array.R index 7412f9f0..3d1964bb 100644 --- a/R/array.R +++ b/R/array.R @@ -22,7 +22,7 @@ array_extract <- function(.arr, ..., default = "1") { nm <- wuffle(as.integer(names(ls) %||% seq_along(ls))) if (anyNA(nm)) { - stop(cond_arary_extract_names()) + stop(array_extract_names()) } ds <- dim(.arr) @@ -54,9 +54,10 @@ array_extract <- function(.arr, ..., default = "1") { # conditions -------------------------------------------------------------- -cond_arary_extract_names <- function() { - new_condition( - "... must be fully named by integers or have no names", - "array_extract_names" - ) -} +array_extract_names := condition( + type = "error", + message = "... must be fully named by integers or have no names", + package = "mark", + exports = "array_extract" +) + diff --git a/tests/testthat/test-array.R b/tests/testthat/test-array.R index ccd7595e..3c9a01fd 100644 --- a/tests/testthat/test-array.R +++ b/tests/testthat/test-array.R @@ -18,5 +18,5 @@ test_that("array_extract() errors", { x <- array(1:9, dim = c(3, 3)) expect_error(array_extract(1), class = "simpleError") expect_error(array_extract(x, 2, 3), NA) - expect_error(array_extract(x, a = 2, b = 3), class = "arrayExtractNamesError") + expect_error(array_extract(x, a = 2, b = 3), class = "mark:array_extract_names") }) From 26a168fc5244bb7b88e66ecb4abbf08374c85199 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 17:58:30 -0400 Subject: [PATCH 005/169] updates conditions for base-conversion (#259) --- R/base-conversion.R | 100 +++++++++++++------------- tests/testthat/test-base-conversion.R | 14 ++-- 2 files changed, 58 insertions(+), 56 deletions(-) diff --git a/R/base-conversion.R b/R/base-conversion.R index 273c3336..cd6a5120 100644 --- a/R/base-conversion.R +++ b/R/base-conversion.R @@ -30,7 +30,7 @@ base_alpha_single <- function(x, base) { a <- match(a, letters[1:base], nomatch = NA_integer_) if (anyNA(a)) { - stop(cond_base_alpha_limit(base, x)) + stop(base_alpha_limit(base, x)) } n <- length(a) @@ -62,7 +62,7 @@ base_n <- function(x, from = 10, to = 10) { } if (to != 10) { - stop(cond_base_n_ten()) + stop(base_n_ten()) } check_base(from) @@ -73,7 +73,7 @@ base_n_single <- function(x, base) { ints <- as.integer(chr_split(x)) if (any(ints >= base, na.rm = TRUE)) { - stop(cond_base_n_single_limit(base, x)) + stop(base_n_single_limit(base, x)) } seqs <- (length(ints) - 1L):0L @@ -85,7 +85,7 @@ check_base_alpha <- function(b, high = 26) { b <- chr_split(b) if (length(b) != 1) { - stop(cond_check_base_alpha_length()) + stop(base_alpha_length()) } b <- match(tolower(b), letters) @@ -96,66 +96,68 @@ check_base_alpha <- function(b, high = 26) { check_base <- function(b, high = 9) { if (b %% 1 != 0) { - stop(cond_check_base_integer()) + stop(base_integer()) } if (b > high || b <= 1) { - stop(cond_check_base_limit(high)) + stop(base_limit(high)) } } # conditions -------------------------------------------------------------- -cond_base_alpha_limit <- function(base, x) { - new_condition( +base_alpha_limit := condition( + type = "error", + message = function(base, x) { sprintf( 'Cannot calculate alpha base "%s" for "%s" which has letters beyond "%s"', - base, x, x[base] - ), - "base_alpha_limit" - ) -} - -cond_base_n_ten <- function() { - new_condition( - "base_n() is currently only valid for conversions to base 10", - "base_n_ten" - ) -} - -cond_base_n_single_limit <- function(base, x) { - new_condition( + base, + x, + x[base] + ) + }, + exports = "base_alpha" +) + + +base_n_ten := condition( + type = "error", + message = "base_n() is currently only valid for conversions to base 10", + exports = "base_n" +) + +base_n_single_limit := condition( + type = "error", + message = function(base, x) { sprintf( paste0( "Cannot caluclate base \"%s\" for \"%s\" which has numbers greater", " than or equal to the base value" ), base, x - ), - "base_n_single_limit" - ) -} - -cond_check_base_alpha_length <- function() { - new_condition( - "base must be of length 1", - "check_base_alpha_length" - ) -} - -cond_check_base_integer <- function() { - new_condition( - "base must be an integer", - "check_base_integer" - ) -} - -cond_check_base_limit <- function(high) { - new_condition( - paste("base must be between 1 and", high), - "check_base_limit" - ) -} + ) + }, + exports = "base_n" +) + +base_alpha_length := condition( + type = "error", + message = "base must be of length 1", + exports = "base_alpha" +) + +base_integer := condition( + type = "error", + message = "base must be an integer", + exports = c("base_alpha", "base_n") +) + +base_limit := condition( + type = "error", + message = function(high) { + sprintf("base must be between 1 and %s", high) + }, + exports = c("base_alpha", "base_n") +) -# terminal line diff --git a/tests/testthat/test-base-conversion.R b/tests/testthat/test-base-conversion.R index fee3e249..f3ced084 100644 --- a/tests/testthat/test-base-conversion.R +++ b/tests/testthat/test-base-conversion.R @@ -6,7 +6,7 @@ test_that("base_alpha() works as expected", { letter_vec <- paste_combine(c("", letters), letters, collate = TRUE) expect_equal(base_alpha(letter_vec), 1:702) - expect_error(base_alpha(letters[1:10], 9), class = "baseAlphaLimitError") + expect_error(base_alpha(letters[1:10], 9), class = "mark:base_alpha_limit") expect_warning(alpha_base(letters), "deprecated") expect_identical(base_alpha_single("a", 26), 1L) @@ -17,7 +17,7 @@ test_that("base_alpha() works as expected", { test_that("base_n() works as expected", { expect_equal(base_n(120, 9), 99) - expect_error(base_n(62, 2), class = "baseNSingleLimitError") + expect_error(base_n(62, 2), class = "mark:base_n_single_limit") x <- c(2L, 1L, 3L, 3L, 6L, 5L, 1L, 4L, 4L, 2L, 2L, 6L, 7L, 4L, 4L, 3L, 1L, 1L) expect_identical(base_n(x, 5, 5), x) @@ -26,14 +26,14 @@ test_that("base_n() works as expected", { test_that("base_alpha(), base_n() fails", { expect_error(base_alpha(1), class = "simpleError") expect_error(base_n("a"), class = "simpleError") - expect_error(base_n(1, 10, 12), class = "baseNTenError") + expect_error(base_n(1, 10, 12), class = "mark:base_n_ten") }) test_that("check_base(), check_base_alpha() works", { - expect_error(check_base(1.1), class = "checkBaseIntegerError") - expect_error(check_base(-1, 9), class = "checkBaseLimitError") - expect_error(check_base(10, 9), class = "checkBaseLimitError") + expect_error(check_base(1.1), class = "mark:base_integer") + expect_error(check_base(-1, 9), class = "mark:base_limit") + expect_error(check_base(10, 9), class = "mark:base_limit") expect_null(check_base_alpha("j")) - expect_error(check_base_alpha("ab"), class = "checkBaseAlphaLengthError") + expect_error(check_base_alpha("ab"), class = "mark:base_alpha_length") }) From f88b7faee3c880e6c694c8ca2d764b279fd1dc3e Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 17:58:37 -0400 Subject: [PATCH 006/169] updates conditions for bib (#259) --- R/bib.R | 58 +++++++++++++++++++-------------------- tests/testthat/test-bib.R | 8 +++--- 2 files changed, 32 insertions(+), 34 deletions(-) diff --git a/R/bib.R b/R/bib.R index 21f20f23..dc9fd1f2 100644 --- a/R/bib.R +++ b/R/bib.R @@ -70,7 +70,7 @@ read_bib <- function(file, skip = 0L, max_lines = NULL, encoding = "UTF-8") { from <- grep("[@]", bib) if (!length(from)) { - stop(cond_read_bib_entries()) + stop(read_bib_entries()) } # shift over (may contain white space?) @@ -160,7 +160,7 @@ process_bib_dataframe <- function(categories, values, fields, keys) { bad <- lens > 1L if (any(bad)) { - stop(cond_process_bib_dataframe_dupe(key, names(lens)[bad])) + stop(process_bib_dataframe_dupe(key, names(lens)[bad])) } # Append vectors @@ -214,7 +214,7 @@ process_bib_list <- function(keys, fields, categories, values) { as_bib_list <- function(x, names = NULL) { if (!is.list(x)) { - stop(cond_as_bib_list_class()) + stop(as_bib_list_class()) } class(x) <- c("list", "mark_bib_list") @@ -223,7 +223,7 @@ as_bib_list <- function(x, names = NULL) { as_bib <- function(x, bib_list = NULL) { if (!is.data.frame(x)) { - stop(cond_as_bib_class()) + stop(as_bib_class()) } class(x) <- c("mark_bib_df", "data.frame") @@ -304,34 +304,32 @@ print.mark_bib_df <- function(x, list = FALSE, ...) { # conditions -------------------------------------------------------------- -cond_read_bib_entries <- function() { - new_condition( - "No entries detected", - "read_bib_entries" - ) -} +read_bib_entries := condition( + type = "error", + message = "No entries detected", + exports = "read_bib" +) -cond_process_bib_dataframe_dupe <- function(key, categories) { # nolint: object_length_linter, line_length_linter. - new_condition( +process_bib_dataframe_dupe := condition( + type = "error", + message = function(key, categories) { sprintf( "The key `%s` has duplicate categories of `%s`", key, categories - ), - "process_bib_dataframe_dupe" - ) -} - -cond_as_bib_list_class <- function() { - new_condition( - "`x` must be a list", - "as_bib_list_class" - ) -} - -cond_as_bib_class <- function() { - new_condition( - "`x` must be a data.frame", - "as_bib_class" - ) -} + ) + }, + exports = "read_bib" +) + +as_bib_list_class := condition( + type = "error", + message = "`x` must be a list", + exports = "read_bib" +) + +as_bib_class := condition( + type = "error", + message = "`x` must be a data.frame", + exports = "read_bib" +) diff --git a/tests/testthat/test-bib.R b/tests/testthat/test-bib.R index 6daad1d4..41ddc3cd 100644 --- a/tests/testthat/test-bib.R +++ b/tests/testthat/test-bib.R @@ -14,10 +14,10 @@ test_that("read_bib()", { temp <- tempfile() writeLines("bad", temp) - expect_error(read_bib(temp), class = "readBibEntriesError") + expect_error(read_bib(temp), class = "mark:read_bib_entries") - expect_error(as_bib(1:3), "data.frame", class = "asBibClassError") - expect_error(as_bib_list(1:3), "list", class = "asBibListClassError") + expect_error(as_bib(1:3), "data.frame", class = "mark:as_bib_class") + expect_error(as_bib_list(1:3), "list", class = "mark:as_bib_list_class") expect_error( process_bib_dataframe( @@ -26,7 +26,7 @@ test_that("read_bib()", { fields = "this", keys = "key" ), - class = "processBibDataframeDupeError" + class = "mark:process_bib_dataframe_dupe" ) }) From a5e05a58937349a33adfbf3831ec1ceaf283ab30 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 17:58:46 -0400 Subject: [PATCH 007/169] updates conditions for char2fact (#259) --- R/char2fact.R | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/R/char2fact.R b/R/char2fact.R index 3673d41c..1ce9cd39 100644 --- a/R/char2fact.R +++ b/R/char2fact.R @@ -14,7 +14,7 @@ char2fact <- function(x, n = 5) { #' @rdname char2fact #' @export char2fact.default <- function(x, n = 5) { - stop(cond_char2fact_class(x)) + stop(char2fact_class(x)) } #' @rdname char2fact @@ -66,9 +66,8 @@ fact2char <- function(data, threshold = 10) { # conditions -------------------------------------------------------------- -cond_char2fact_class <- function(x) { - new_condition( - paste("char2fact does not support class", toString(class(x))), - "char2fact_class" - ) -} +char2fact_class := condition( + function(x) paste("char2fact does not support class", toString(class(x))), + type = "error", + exports = "char2fact" +) From 1c099a778155031bff80b6160730ddd04615b3d7 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 17:59:27 -0400 Subject: [PATCH 008/169] updates conditions for dataframes and removes deprecated parameters (#259) --- R/dataframes.R | 108 +++++++++---------------------- man/list2df.Rd | 4 +- man/t_df.Rd | 4 +- man/vector2df.Rd | 4 +- tests/testthat/test-dataframes.R | 16 +---- 5 files changed, 38 insertions(+), 98 deletions(-) diff --git a/R/dataframes.R b/R/dataframes.R index 9f388c77..60d7085b 100644 --- a/R/dataframes.R +++ b/R/dataframes.R @@ -17,14 +17,10 @@ #' @export to_row_names <- function(data, row_names = 1L) { - col_to_rn(data, row_names = row_names) -} - -col_to_rn <- function(data, row_names = 1L) { row_names0 <- row_names if (length(row_names) != 1) { - stop(cond_col_to_rn_rownames()) + stop(to_row_names_single()) } if (is.character(row_names)) { @@ -32,7 +28,7 @@ col_to_rn <- function(data, row_names = 1L) { } if (is.na(row_names)) { - stop(cond_col_to_rn_rownames_na(row_names0)) + stop(to_row_names_na(row_names0)) } x <- data[[row_names]] @@ -51,17 +47,11 @@ col_to_rn <- function(data, row_names = 1L) { #' #' @param x A vector of values. #' @param name,value Character strings for the name and value columns -#' @param show_NA Ignored; will trigger a warning if set #' @return A `data.frame` with `name` (optional) and `value` columns #' @export -vector2df <- function(x, name = "name", value = "value", show_NA) { # nolint: object_name_linter, line_length_linter. - if (!missing(show_NA)) { - warning(cond_vector2df_show_na()) - } - +vector2df <- function(x, name = "name", value = "value") { stopifnot(!is.list(x)) - ls <- list(names(x) %||% rep(NA, length(x)), remove_names(x)) ls <- ls[!vap_lgl(list(name, value), is.null)] names(ls) <- c(name, value) @@ -79,7 +69,6 @@ vector2df <- function(x, name = "name", value = "value", show_NA) { # nolint: ob #' #' @param x A (preferably) named `list` with any number of values #' @param name,value Names of the new key and value columns, respectively -#' @param show_NA Ignored; if set will trigger a warning #' @param warn Logical; if TRUE will show a warning when #' #' @return a `data.frame` object with columns `"name"` and `"value"` for the @@ -98,18 +87,15 @@ vector2df <- function(x, name = "name", value = "value", show_NA) { # nolint: ob #' as.data.frame(x) #' } -list2df <- function(x, name = "name", value = "value", show_NA, warn = TRUE) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter. +list2df <- function(x, name = "name", value = "value", warn = TRUE) { stopifnot(is.list(x)) - if (!missing(show_NA)) { - warning(cond_list2df_show_na()) - } - cl <- lapply(x, class) n_cl <- length(unique(cl)) - if (n_cl > 1 && warn) { - warning(cond_list2df_classes(cl)) + if (n_cl > 1L && warn) { + warning(list2df_classes(cl)) } ulist <- unlist(x, use.names = FALSE) @@ -161,7 +147,6 @@ list2df2 <- function(x = list(), nrow = NULL) { #' the data.frame. #' #' @param x A data.frame -#' @param id No longer used #' @return A transposed `data.frame` with columns (`"colname"`, `"row_1"`, ..., #' for each row in `x`. #' @@ -170,11 +155,7 @@ list2df2 <- function(x = list(), nrow = NULL) { #' t_df(x) #' @export -t_df <- function(x, id = NULL) { - if (!is.null(id)) { - warning(cond_t_df_id()) - } - +t_df <- function(x) { stopifnot(is.data.frame(x)) out <- as.data.frame( @@ -225,7 +206,7 @@ complete_cases <- function(data, cols = NULL, invert = FALSE) { ds <- dim(data) if (ds[1L] == 0L || ds[2L] == 0L) { - stop(cond_complete_cases_rc()) + stop(complete_cases_dims()) } x <- data[, cols %||% 1:ds[2L], drop = FALSE] @@ -285,58 +266,33 @@ reset_rownames <- function(data, n = nrow(data)) { # conditions -------------------------------------------------------------- -cond_col_to_rn_rownames <- function() { - new_condition( - "`row_names` must be a single element vector", - "col_to_rn_rownames" - ) -} - -cond_col_to_rn_rownames_na <- function(x) { - new_condition( - sprintf("`row_names` of `%s` is invalid", x), - "col_to_rn_rownames_na" - ) -} +to_row_names_single := condition( + "row_names must be a single element vector", + type = "error", + exports = "to_row_names" +) -cond_vector2df_show_na <- function() { - new_condition( - "`show_NA` is no longer in use", - "vector2df_show_na", - type = "warning" - ) -} +to_row_names_na := condition( + function(x) sprintf("`row_names` of `%s` is invalid", x), + type = "error", + exports = "to_row_names" +) -cond_list2df_show_na <- function() { - new_condition( - "`show_NA` is no longer in use", "list2df_show_na", - type = "warning" - ) -} -cond_list2df_classes <- function(x) { - new_condition( +list2df_classes := condition( + function(x) { ngettext( any(c("character", "factor") %in% x), "Not all values are the same class: converting to character", "Not all values are the same class" - ), - "list2df_classes", - type = "warning" - ) -} - -cond_t_df_id <- function() { - new_condition( - "Argument `id` is no longer valid", - "t_df_id", - type = "warning" - ) -} - -cond_complete_cases_rc <- function() { - new_condition( - "`data` must have at least 1 row and 1 column", - "completed_cases_rc" - ) -} + ) + }, + type = "warning", + exports = "list2df" +) + +complete_cases_dims := condition( + "`data` must have at least 1 row and 1 column", + type = "error", + exports = "complete_cases" +) diff --git a/man/list2df.Rd b/man/list2df.Rd index a3575823..8bb03f5a 100644 --- a/man/list2df.Rd +++ b/man/list2df.Rd @@ -4,15 +4,13 @@ \alias{list2df} \title{List to data.frame} \usage{ -list2df(x, name = "name", value = "value", show_NA, warn = TRUE) +list2df(x, name = "name", value = "value", warn = TRUE) } \arguments{ \item{x}{A (preferably) named \code{list} with any number of values} \item{name, value}{Names of the new key and value columns, respectively} -\item{show_NA}{Ignored; if set will trigger a warning} - \item{warn}{Logical; if TRUE will show a warning when} } \value{ diff --git a/man/t_df.Rd b/man/t_df.Rd index 86d6a2f5..dfdf05e7 100644 --- a/man/t_df.Rd +++ b/man/t_df.Rd @@ -4,12 +4,10 @@ \alias{t_df} \title{Data frame transpose} \usage{ -t_df(x, id = NULL) +t_df(x) } \arguments{ \item{x}{A data.frame} - -\item{id}{No longer used} } \value{ A transposed \code{data.frame} with columns (\code{"colname"}, \code{"row_1"}, ..., diff --git a/man/vector2df.Rd b/man/vector2df.Rd index e6d3040a..bbf3c241 100644 --- a/man/vector2df.Rd +++ b/man/vector2df.Rd @@ -4,14 +4,12 @@ \alias{vector2df} \title{Vector to data.frame} \usage{ -vector2df(x, name = "name", value = "value", show_NA) +vector2df(x, name = "name", value = "value") } \arguments{ \item{x}{A vector of values.} \item{name, value}{Character strings for the name and value columns} - -\item{show_NA}{Ignored; will trigger a warning if set} } \value{ A \code{data.frame} with \code{name} (optional) and \code{value} columns diff --git a/tests/testthat/test-dataframes.R b/tests/testthat/test-dataframes.R index 09abc94d..357a791b 100644 --- a/tests/testthat/test-dataframes.R +++ b/tests/testthat/test-dataframes.R @@ -29,8 +29,8 @@ test_that("to_row_names()", { test_that("col_to_rn()", { - expect_error(col_to_rn(data.frame(), 1:2), class = "colToRnRownamesError") - expect_error(col_to_rn(data.frame(), NA), class = "colToRnRownamesNaError") + expect_error(to_row_names(data.frame(), 1:2), class = "mark:to_row_names_single") + expect_error(to_row_names(data.frame(), NA), class = "mark:to_row_names_na") }) test_that("vector2df()", { @@ -42,11 +42,6 @@ test_that("vector2df()", { expect_equal(vector2df(set_names(x)), df) expect_named(vector2df(x, "one", "two"), c("one", "two")) - expect_warning( - vector2df(x, show_NA = NULL), - class = "vector2dfShowNaWarning" - ) - expect_error(vector2df(list(a = 1)), class = "simpleError") }) @@ -57,7 +52,7 @@ test_that("list2df()", { value = c(1, 2:4, letters[10:20]) ) - expect_warning(list2df(x), class = "list2dfClassesWarning") + expect_warning(list2df(x), class = "mark:list2df_classes") expect_warning(list2df(x, warn = FALSE), NA) expect_equal(list2df(x, warn = FALSE), exp) @@ -67,10 +62,6 @@ test_that("list2df()", { expect_warning(list2df(x), NA) expect_equal(list2df(x), exp) expect_named(list2df(x, "hello", "world"), c("hello", "world")) - expect_warning( - list2df(x, show_NA = NULL), - class = "list2dfShowNaWarning" - ) # Unnamed x <- list(a = 1, 0, 2) @@ -109,7 +100,6 @@ test_that("t_df()", { ) expect_equal(t_df(x), y) - expect_warning(t_df(x, id = 1)) expect_error(t_df(1L)) }) From 5deb784641c80f2fc2a6ac8648eb4734760cf106 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 17:59:47 -0400 Subject: [PATCH 009/169] updates conditions for dates (#259) --- R/dates.R | 28 +++++++++++++--------------- tests/testthat/test-dates.R | 6 +++--- 2 files changed, 16 insertions(+), 18 deletions(-) diff --git a/R/dates.R b/R/dates.R index 7357de31..b723d642 100644 --- a/R/dates.R +++ b/R/dates.R @@ -71,11 +71,11 @@ verify_format <- function(format) { m <- match(c("y", "m", "d"), s) if (length(unique(s)) != 3L) { - stop(cond_verify_format_chrs()) + stop(verify_format_chrs()) } if (anyNA(m)) { - stop(cond_verify_format_ymd()) + stop(verify_format_ymd()) } s @@ -251,16 +251,14 @@ strp_format <- function(fmt) { # conditions -------------------------------------------------------------- -cond_verify_format_chrs <- function() { - new_condition( - "format must be 3 characters", - "verify_format_chrs" - ) -} - -cond_verify_format_ymd <- function() { - new_condition( - "format must contain \"y\", \"m\", and \"d\"", - "verify_format_ymd" - ) -} +verify_format_chrs := condition( + "format must be 3 characters", + type = "error", + exports = "date_from_partial" +) + +verify_format_ymd := condition( + 'format must contain "y", "m", and "d"', + type = "error", + exports = "date_from_partial" +) diff --git a/tests/testthat/test-dates.R b/tests/testthat/test-dates.R index a0e4587b..a7c9c407 100644 --- a/tests/testthat/test-dates.R +++ b/tests/testthat/test-dates.R @@ -87,9 +87,9 @@ test_that("'Empty' dates don't cause errors", { }) test_that("date errors", { - expect_error(verify_format("ymda"), class = "verifyFormatChrsError") - expect_error(verify_format("abc"), class = "verifyFormatYmdError") - expect_error(verify_format("aaa"), class = "verifyFormatChrsError") + expect_error(verify_format("ymda"), class = "mark:verify_format_chrs") + expect_error(verify_format("abc"), class = "mark:verify_format_ymd") + expect_error(verify_format("aaa"), class = "mark:verify_format_chrs") expect_error(verify_format("ymd"), NA) expect_error(verify_format("dmy"), NA) expect_error(verify_format("mdy"), NA) From 81f876d0510a7398aec428c0d99671df1c0b74d9 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 18:00:02 -0400 Subject: [PATCH 010/169] updates conditions for description (#259) --- R/description.R | 36 ++++++++++++++----------------- tests/testthat/test-description.R | 2 +- 2 files changed, 17 insertions(+), 21 deletions(-) diff --git a/R/description.R b/R/description.R index 7fa0527b..440c52dd 100644 --- a/R/description.R +++ b/R/description.R @@ -70,7 +70,7 @@ author_info_to_text <- function(x) { } find_author <- function() { - getOption("mark.author", stop(cond_find_author())) + getOption("mark.author", stop(no_author_found())) } # Version ----------------------------------------------------------------- @@ -101,7 +101,7 @@ get_version <- function() { line <- grep("^[Vv]ersion.*[[:punct:][:digit:]]+$", description) if (length(line) != 1L) { - stop(cond_version_lines()) + stop(multiple_versions_found()) } as.package_version(gsub("[Vv]ersion|[:]|[[:space:]]", "", description[line])) @@ -129,7 +129,7 @@ update_version <- function(version = NULL, date = FALSE) { line <- grep("^[Vv]ersion.*[[:punct:][:digit:]]+$", description) if (length(line) != 1L) { - stop(cond_version_lines()) + stop(multiple_versions_found()) } # Get the old version @@ -214,22 +214,18 @@ today_as_version <- function(zero = FALSE) { # conditions -------------------------------------------------------------- -cond_find_author <- function() { - new_condition( - paste0( - "Author information not found in options.\n", - "You can set the author information with options(mark.author = .)\n", - " probably within an .Rprofile" - ), - "find_author" +no_author_found := condition( + "Author information not found in options.", + type = "error", + exports = "use_author", + help = c( + "You can try to set the author information with options(mark.author = .)", + " probably within an .Rprofile" ) -} - -cond_version_lines <- function() { - new_condition( - "multiple versions found", - "get_version_lines" - ) -} +) -# terminal line +multiple_versions_found := condition( + "Multiple version lines found in DESCRIPTION", + type = "error", + exports = "get_version" +) diff --git a/tests/testthat/test-description.R b/tests/testthat/test-description.R index df26447a..a6a7737a 100644 --- a/tests/testthat/test-description.R +++ b/tests/testthat/test-description.R @@ -1,6 +1,6 @@ test_that("find_author() works", { withr::local_options(list(mark.author = NULL)) - expect_error(find_author(), class = "findAuthorError") + expect_error(find_author(), class = "mark:no_author_found") }) test_that("use_author() works", { From 5c7c1f81af36b561746ff0a4238eff9fc7016adf Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 18:00:19 -0400 Subject: [PATCH 011/169] updates conditions for detail (#259) --- R/detail.R | 13 ++++++------- tests/testthat/test-detail.R | 4 ++-- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/R/detail.R b/R/detail.R index b5a12764..879ba7fa 100644 --- a/R/detail.R +++ b/R/detail.R @@ -98,7 +98,7 @@ detail.data.frame <- function(x, factor_n = 5L, ...) { x <- x[, !vap_lgl(x, is.list), drop = FALSE] if (!ncol(x)) { - stop(cond_detail_data_frame_list()) + stop(no_non_list_columns()) } details <- lapply(x, detail, factor_n = factor_n) @@ -113,9 +113,8 @@ detail.data.frame <- function(x, factor_n = 5L, ...) { # conditions -------------------------------------------------------------- -cond_detail_data_frame_list <- function() { - new_condition( - "x does not have any non-list columns", - "detail_data_frame_list" - ) -} +no_non_list_columns := condition( + "x does not have any non-list columns", + type = "error", + exports = "detail.data.frame" +) diff --git a/tests/testthat/test-detail.R b/tests/testthat/test-detail.R index bfbc01cb..092c412b 100644 --- a/tests/testthat/test-detail.R +++ b/tests/testthat/test-detail.R @@ -7,7 +7,7 @@ test_that("details() works", { expect_error(detail(x), NA) expect_error(detail(df), NA) - expect_error(detail(data.frame()), class = "detailDataFrameListError") + expect_error(detail(data.frame()), class = "mark:no_non_list_columns") exp <- quick_dfl( class = "logical", @@ -38,7 +38,7 @@ test_that("details() and tibbles", { expect_error(detail(tibble::tibble(a = 1, b = list(1:3))), NA) expect_error( detail(tibble::tibble(a = NULL, b = list(1:3))), - class = "detailDataFrameListError" + class = "mark:no_non_list_columns" ) }) From 98f2f704fb3d513f2ede73ea0ed6aea9806eceed Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 18:03:06 -0400 Subject: [PATCH 012/169] cleans up list merging and na objects (#259) --- R/mark-package.R | 14 +++++++++++-- R/merge-list.R | 32 +++++++++++++++++++---------- R/not-available.R | 19 +++++++---------- tests/testthat/test-not-available.R | 2 +- 4 files changed, 41 insertions(+), 26 deletions(-) diff --git a/R/mark-package.R b/R/mark-package.R index 0123342e..1b3862d5 100644 --- a/R/mark-package.R +++ b/R/mark-package.R @@ -8,7 +8,8 @@ #' @name mark "_PACKAGE" -op.mark <- list( # nolint: object_name_linter. +# nolint next: object_name_linter. +op.mark <- list( mark.author = NULL, # control for check_interactive() to return interactive() or TRUE mark.check_interactive = TRUE, @@ -20,5 +21,14 @@ op.mark <- list( # nolint: object_name_linter. mark.days_in_year = 365, mark.weeks_inn_year = 52, mark.default_tz = "UTC", - mark.na_list = na_list + mark.na_list = list( + logical = logical(), + character = character(), + integer = integer(), + double = double(), + numeric = numeric(), + Date = as.Date(NA), + POSIXct = as.POSIXct(NA), + POSIXlt = as.POSIXlt(NA)[[1]] + ) ) diff --git a/R/merge-list.R b/R/merge-list.R index 94572194..84af824a 100644 --- a/R/merge-list.R +++ b/R/merge-list.R @@ -15,6 +15,8 @@ #' output. #' * `"keep"`: `NULL` values are retained in the output and can override other #' values. +#' @param sort When `TRUE` (default) will sort the output by names; otherwise +#' will retain the order of `x` and `y` with `x` values first. #' @examples #' x <- list(a = 1, b = 2, c = NULL, d = NULL) #' y <- list(a = 2, b = NULL, c = 3) @@ -28,30 +30,33 @@ #' merge_list(x, y, null = "drop") #' @export merge_list <- function( - x, - y, - keep = c("x", "y"), - null = c("ignore", "drop", "keep")[1:2] + x, + y, + keep = c("x", "y"), + null = c("ignore", "drop", "keep")[1:2], + sort = TRUE ) { if (length(null) == 1L) { null <- c(null, null) } - stopifnot(length(null) == 2) + stopifnot(length(null) == 2L) keep <- match_param(keep) x <- x %||% list() y <- y %||% list() - xx <- x + stopifnot(is.list(x), is.list(y)) + xx <- x + x <- switch( - null[1], + null[1L], keep = x, ignore = remove_null(x), drop = remove_null(x) ) y <- switch( - null[2], + null[2L], keep = y, ignore = remove_null(y), drop = remove_null(y) @@ -59,13 +64,18 @@ merge_list <- function( res <- c(x, y)[!duplicated(c(names(x), names(y)), fromLast = keep == "y")] - if (null[1] == "ignore") { + if (null[1L] == "ignore") { return(merge_list( x = xx[names(xx) %out% names(res)], y = res, - null = c("keep", "ignore") + null = c("keep", "ignore"), + sort = sort )) } - res[order(names(res))] + if (sort) { + res <- res[order(names(res))] + } + + res } diff --git a/R/not-available.R b/R/not-available.R index 3adc0877..5f28baff 100644 --- a/R/not-available.R +++ b/R/not-available.R @@ -33,7 +33,6 @@ set_not_available <- function(type, value) { } get_not_available <- function(type = NULL) { - if (is.null(type)) { return(get_na_list()) } @@ -52,27 +51,23 @@ get_not_available <- function(type = NULL) { } get_na_list <- function() { - ls <- getOption("mark.na_list", list()) - - if (identical(ls, list())) { - options(mark.na_list = na_list) - ls <- na_list - } - - ls + merge_list(op.mark$mark.na_list, getOption("mark.na_list"), sort = FALSE) } #' @export #' @rdname not_available -NA_Date_ <- not_available("Date", 1L) # nolint: object_name_linter. +NA_Date_ <- function() NULL # nolint: object_name_linter. +delayedAssign("NA_Date_", not_available("Date", 1L)) #' @export #' @rdname not_available -NA_POSIXct_ <- not_available("POSIXct", 1L) # nolint: object_name_linter. +NA_POSIXct_ <- function() NULL # nolint: object_name_linter. +delayedAssign("NA_POSIXct_", not_available("POSIXct", 1L)) #' @export #' @rdname not_available -NA_POSIXlt_ <- not_available("POSIXlt", 1L) # nolint: object_name_linter. +NA_POSIXlt_ <- function() NULL # nolint: object_name_linter. +delayedAssign("NA_POSIXlt_", not_available("POSIXlt", 1L)) # conditions -------------------------------------------------------------- diff --git a/tests/testthat/test-not-available.R b/tests/testthat/test-not-available.R index 4278247f..d65b7b9e 100644 --- a/tests/testthat/test-not-available.R +++ b/tests/testthat/test-not-available.R @@ -17,5 +17,5 @@ test_that("not_available() works", { # reset list options(mark.na_list = NULL) - expect_identical(get_na_list(), na_list) + expect_identical(get_na_list(), op.mark$mark.na_list) }) From 9d91a58a74cb9adb43e0f724e20d558a69729fa5 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 18:38:12 -0400 Subject: [PATCH 013/169] redocs (#259) --- man/merge_list.Rd | 11 ++++++++++- man/reexports.Rd | 2 +- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/man/merge_list.Rd b/man/merge_list.Rd index 51a5651c..32ded4b4 100644 --- a/man/merge_list.Rd +++ b/man/merge_list.Rd @@ -4,7 +4,13 @@ \alias{merge_list} \title{Merge lists} \usage{ -merge_list(x, y, keep = c("x", "y"), null = c("ignore", "drop", "keep")[1:2]) +merge_list( + x, + y, + keep = c("x", "y"), + null = c("ignore", "drop", "keep")[1:2], + sort = TRUE +) } \arguments{ \item{x, y}{Lists to merge} @@ -24,6 +30,9 @@ output. \item \code{"keep"}: \code{NULL} values are retained in the output and can override other values. }} + +\item{sort}{When \code{TRUE} (default) will sort the output by names; otherwise +will retain the order of \code{x} and \code{y} with \code{x} values first.} } \description{ Merge lists with different or intersecting names diff --git a/man/reexports.Rd b/man/reexports.Rd index eb1029f6..e31cd8b3 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From 8d8ea37aa266e878106e396c16cead16d0136462 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 18:38:20 -0400 Subject: [PATCH 014/169] updates conditions for diff-time (#259) --- R/diff-time.R | 108 +++++++++++++++++--------------- tests/testthat/test-diff-time.R | 7 +-- 2 files changed, 62 insertions(+), 53 deletions(-) diff --git a/R/diff-time.R b/R/diff-time.R index 9eb3508e..845ce526 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -1,5 +1,3 @@ -# nolint start: line_length_linter. - #' Diff time wrappers #' #' Wrappers for computing diff times @@ -45,15 +43,21 @@ #' #' @export #' @name diff_time - -# nolint end: lien_length_linter. - diff_time <- function( x, y, - method = c("secs", "mins", "hours", - "days", "weeks", "months", - "years", "dyears", "wyears", "myears"), + method = c( + "secs", + "mins", + "hours", + "days", + "weeks", + "months", + "years", + "dyears", + "wyears", + "myears" + ), tzx = NULL, tzy = tzx ) { @@ -92,7 +96,7 @@ extract_numeric_time <- function(x, tz) { if (is.null(tz)) { if (is.numeric(x)) { - stop(cond_extract_numeric_time_numeric()) + stop(numeric_datetime_tz()) } gmt <- NULL @@ -136,7 +140,7 @@ to_numeric_with_tz <- function(x, tz) { nas <- is.na(tz) if (any(nas)) { - warning(cond_to_numeric_with_tz_na()) + warning(na_timezone_found()) tz[nas] <- default_tz() } @@ -171,7 +175,7 @@ check_tz <- function(x) { bad <- ux %out% OlsonNames() if (any(bad)) { - stop(cond_check_tz_timezones(ux[bad])) + stop(timezone_not_found(ux[bad])) } invisible(NULL) @@ -309,7 +313,7 @@ default_tz <- function() { } if (!is.character(tz) || length(tz) != 1L) { - stop(cond_default_tz_tz()) + stop(default_tz_value()) } tz @@ -337,42 +341,48 @@ sys_tz <- function(method = 1) { # conditions -------------------------------------------------------------- -cond_extract_numeric_time_numeric <- function() { # nolint: object_length_linter, line_length_linter. - new_condition( - "Date times cannot be numeric when tz is NULL", - "extract_numeric_time_numeric" +numeric_datetime_tz := condition( + "Date times cannot be numeric when tz is NULL", + type = "error", + exports = "diff_time", + help = "```r +# Instead of this: +diff_time(100, 200, tz = NULL) + +# do this: +diff_time(100, 200, tz = 'America/New_York') + +# or: +diff_time(100, 200, tz = 0) +```" +) + +na_timezone_found := condition( + function() { + paste("NA found in timezones; setting to default timezone:", default_tz()) + }, + type = "warning", + exports = "diff_time" +) + +timezone_not_found := condition( + function(x) paste0("Timezone(s) not found: ", collapse(x, sep = ", "), "\n"), + type = "error", + exports = "diff_time", + help = c( + "When using a string for a timezone, this value must be found within", + " `OlsonNames()`" ) -} - -cond_to_numeric_with_tz_na <- function() { - new_condition( - paste("NA found in timezones; setting to", default_tz()), - "to_numeric_with_tz_na", - type = "warning" +) + +default_tz_value := condition( + "Invalid value for default timezone", + type = "error", + exports = "diff_time", + help = c( + "option(mark.default_tz) must be a character vector of length 1L,", + " a function that returns a character vector of length 1L,", + " NULL (defaults to UTC),", + ' or "system" to set to system timezone' ) -} - -cond_check_tz_timezones <- function(x) { - msg <- sprintf( - paste0( - "Timezone(s) not found: %s\n", - "Please check timezones in `OlsonNames()`" - ), - collapse(x, sep = ", ") - ) - - new_condition(msg, "check_tz_timezone_olson") -} - -cond_default_tz_tz <- function() { - new_condition( - paste0( - "option(mark.default_tz) must be", - " a character vector of length 1L,", - " a function that returns a character vector of length 1L,", - " NULL (defaults to UTC),", - ' or "system" to set to system timezone' - ), - "default_tz_tz" - ) -} +) diff --git a/tests/testthat/test-diff-time.R b/tests/testthat/test-diff-time.R index cb1b4ce7..9c99504b 100644 --- a/tests/testthat/test-diff-time.R +++ b/tests/testthat/test-diff-time.R @@ -59,7 +59,6 @@ test_that("diff_time_*() identical to difftime()", { }) test_that("Timezones", { - st <- as.POSIXct("2021-04-06 11:12:45", tz = "America/Chicago") dftz <- quick_dfl( @@ -160,12 +159,12 @@ test_that("Timezones", { test_that("Error checking", { expect_error( diff_time_secs(1:10, 1:10), - class = "extractNumericTimeNumericError" + class = "mark:numeric_datetime_tz" ) expect_error( diff_time_secs(st, st, "Not good"), - class = "checkTzTimezoneOlsonError" + class = "mark:timezone_not_found" ) # Don't throw error because of NA tz @@ -192,7 +191,7 @@ test_that("class coehersion", { expect_warning( to_numeric_with_tz("2021-01-01", NA), "NA found in timezones", - class = "toNumericWithTzNaWarning" + class = "mark:na_timezone_found" ) expect_identical(check_tz(NULL), NULL) From a7cdb96d6a86725d51ee02f0ecf80502c27e88cb Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 18:38:41 -0400 Subject: [PATCH 015/169] draft of news update (#259) --- NEWS.md | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/NEWS.md b/NEWS.md index eec0a187..eea76491 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,17 @@ # mark (development version) +* substantial changes to _conditions_ + * all _conditions_ previously created with [`fuj::new_condition()`](https://jmbarbone.github.io/fuj/reference/new_condition.html) have been rewritten with [`cnd::condition()`](https://jmbarbone.github.io/cnd/reference/condition.html) [#259] + * all of these condition now use different class names, generated through [`cnd::condition()`](https://jmbarbone.github.io/cnd/reference/condition.html) + * for more information, see https://jmbarbone.github.io/cnd + +* the following arguments were deprecated and unused, and have now been removed completely: + * `list2df(show_NA)` + * `vector2df(show_NA)` + * `t_df(id)` + +* `merge_list(sort)` included to toggle name sorting in result + * `make_sf()` now uses `substitute()` to provide more information inside the function body when viewing [#129](https://github.com/jmbarbone/mark/issues/129) * `round_to()` added to round values to a set [#142](https://github.com/jmbarbone/mark/issues/142) From 57a43e6761a9f066d3d6f2041932e4d4b02ed8db Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 20:30:54 -0400 Subject: [PATCH 016/169] updates conditions for directory (#259) --- R/directory.R | 61 +++++++++++++++----------- tests/testthat/test-directory.R | 76 ++++++++++++++------------------- 2 files changed, 69 insertions(+), 68 deletions(-) diff --git a/R/directory.R b/R/directory.R index 21bb8a0c..b0091374 100644 --- a/R/directory.R +++ b/R/directory.R @@ -92,7 +92,7 @@ get_recent_file <- function(x, exclude_temp = TRUE, ...) { } if (no_length(files)) { - stop(cond_get_recent_file_none()) + stop(no_recent_file_found()) } newest_file(files) @@ -122,7 +122,7 @@ norm_path <- function(x = ".", check = FALSE, remove = check) { ind <- !fs::file_exists(x) if (check && any(ind)) { - warning(cond_norm_path_found(x[ind])) + warning(path_not_found(x[ind])) } if (remove) { @@ -398,7 +398,7 @@ is_file <- function(x) { file_create <- function(x, overwrite = FALSE) { dirs <- is_dir(x) if (any(dirs)) { - warning(cond_file_create_dir(x[dirs])) + warning(paths_are_directories(x[dirs])) x <- x[!dirs] } @@ -475,27 +475,40 @@ add_file_timestamp <- function( # conditions -------------------------------------------------------------- -cond_get_recent_file_none <- function() { - new_condition("No files found", "get_recent_file_none") -} +no_recent_file_found := condition( + "No recent file found", + type = "error", + exports = "get_recent_file" +) -cond_norm_path_found <- function(paths) { - new_condition( - paste0("Paths not found:\n '", collapse(paths, sep = "'\n '"), "'"), - "norm_path_found", - type = "warning" - ) -} +path_not_found := condition( + function(x) { + ngettext( + length(x), + paste("Path not found:", norm_path(x)), + paste0( + "Paths not found:", + paste0("\n ", norm_path(x), collapse = "\n") + ) + ) + }, + type = "warning", + exports = "norm_path" +) -cond_file_create_dir <- function(x) { - new_condition( - paste0( - "Cannot create files that are directories:", - paste0("\n ", norm_path(x)) - ), - "file_create_dir", - type = "warning" +paths_are_directories := condition( + function(x) { + ngettext( + length(x), + paste("File is a directory:", norm_path(x)), + paste0( + "Files are directories:", + paste0("\n ", norm_path(x), collapse = "\n") + ) + ) + }, + type = "warning", + help = ( + "File creation cannot be performed when the path is an existing directory" ) -} - -# terminal line +) diff --git a/tests/testthat/test-directory.R b/tests/testthat/test-directory.R index d7bcee8a..2af09dad 100644 --- a/tests/testthat/test-directory.R +++ b/tests/testthat/test-directory.R @@ -11,50 +11,38 @@ test_that("tests with temp dir", { td <- tempdir(check = TRUE) skip_if_not(rn("withr")) - withr::with_tempdir({ - dates <- as.character(as.POSIXct("2021-01-02 15:57:25") + 1:3) - dates <- gsub(":", "", dates) - - dirs <- c( - dates, - c(0, 100, 300, Inf) - ) - - files <- c( - "no_ext" - ) - - invisible( - sapply(dirs, function(x) { - dir_create(file_path(td, x), overwrite = TRUE) - }) - ) - - # Add a second so times are unique - Sys.sleep(1) - most_recent_dir <- file_path(td, "most_recent_dir") - dir_create(most_recent_dir, overwrite = TRUE) - - invisible( - sapply(files, function(x) { - file_create(file_path(td, x), overwrite = TRUE) - }) - ) - - # Add a second so times are unique - Sys.sleep(1) - most_recent_file <- file_path(td, "most_recent_file") - # Should be able to create a file with the same name as a directory - file_create(most_recent_file) - - expect_equal_path(get_recent_dir(td), most_recent_dir) - expect_equal_path(get_dir_recent_date(td), file_path(td, dates[3])) - expect_equal_path(get_dir_max_number(td), file_path(td, 300)) - expect_false(is_dir(file_path(td, "no_ext"))) - expect_equal_path(get_recent_file(td), most_recent_file) - }, - tmpdir = td - ) + td <- withr::local_tempdir() + dates <- as.character(as.POSIXct("2021-01-02 15:57:25") + 1:3) + dates <- gsub(":", "", dates) + + dirs <- c(dates, c(0, 100, 300, Inf)) + + invisible(sapply( + dirs, + function(x) dir_create(file_path(td, x), overwrite = TRUE) + )) + + # Add a second so times are unique + Sys.sleep(1) + most_recent_dir <- file_path(td, "most_recent_dir") + dir_create(most_recent_dir, overwrite = TRUE) + + invisible(sapply( + "no_ext", + function(x) file_create(file_path(td, x), overwrite = TRUE) + )) + + # Add a second so times are unique + Sys.sleep(1) + most_recent_file <- file_path(td, "most_recent_file") + # Should be able to create a file with the same name as a directory + file_create(most_recent_file) + + expect_equal_path(get_recent_dir(td), most_recent_dir) + expect_equal_path(get_dir_recent_date(td), file_path(td, dates[3])) + expect_equal_path(get_dir_max_number(td), file_path(td, 300)) + expect_false(is_dir(file_path(td, "no_ext"))) + expect_equal_path(get_recent_file(td), most_recent_file) }) test_that("errors", { From be68e09ad6657e08b4bac13e72d0b0ae97e9be0e Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 21:48:42 -0400 Subject: [PATCH 017/169] updates conditions for expand (#259) --- R/expand.R | 67 +++++++++++++++++++++++++++++++++++------------- man/reexports.Rd | 2 +- 2 files changed, 50 insertions(+), 19 deletions(-) diff --git a/R/expand.R b/R/expand.R index 32dc4c9e..deab789f 100644 --- a/R/expand.R +++ b/R/expand.R @@ -127,11 +127,11 @@ reindex <- function( } if (anyNA(xi)) { - warning(cond_reindex_na()) + warning(reindex_na_index(which(is.na(xi)))) } if (is.null(xi)) { - stop(cond_reindex_index()) + stop(reindex_null_index()) } ro <- expand_by(xi, new_index, expand = expand, sort = sort) @@ -142,18 +142,20 @@ reindex <- function( out } -# FUNS -------------------------------------------------------------------- +# helpers ----------------------------------------------------------------- unique_name_check <- function(x) { # Checks that names are unique in the vector nm <- names(x) %||% x lens <- counts(nm) - int <- lens > 1 + int <- lens > 1L if (any(int)) { - warning("These names are duplicated: ", - collapse0(names(lens[int]), sep = ", "), - call. = FALSE) + warning( + "These names are duplicated: ", + collapse0(names(lens[int]), sep = ", "), + call. = FALSE + ) return(invisible(FALSE)) } @@ -162,16 +164,45 @@ unique_name_check <- function(x) { # conditions -------------------------------------------------------------- -cond_reindex_na <- function() { - new_condition( - "NA values detected in index this may cause errors with expansion", - "reindex_na", - type = "warning" - ) -} - -cond_reindex_index <- function() { - new_condition("x[[index]] returned `NULL`", "reindex_index") -} +reindex_na_index := condition( + function(x) { + paste( + ngettext( + length(x), + "NA value detected in index at position:", + "NA values detected in index at positions:" + ), + collapse(x, sep = ", ") + ) + }, + type = "warning", + exports = "reindex", + help = "NA values in index may cause errors with expansion + +`reindex()` will not match on NA values but instead will return a row of NAs + +```r +x <- data.frame(index = c(1:2, NA, 4:5), values = letters[1:5]) +reindex(x, 'index', c(1, 2, 5)) +#> index values +#> 1 1 a +#> 2 2 b +#> 5 5 e + +reindex(x, 'index', c(1, 2, 5, NA)) +#> index values +#> 1 1 a +#> 2 2 b +#> 5 5 e +#> NA +```` +" +) + +reindex_null_index := condition( + "x[[index]] returned `NULL`", + type = "error", + exports = "reindex" +) # terminal line diff --git a/man/reexports.Rd b/man/reexports.Rd index e31cd8b3..eb1029f6 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From fbe2c43010812bebd52d711cf1d314b73dc27b06 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 21:59:39 -0400 Subject: [PATCH 018/169] Update mark.Rproj (#259) --- mark.Rproj | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/mark.Rproj b/mark.Rproj index 64021161..1b223aa8 100644 --- a/mark.Rproj +++ b/mark.Rproj @@ -13,9 +13,15 @@ Encoding: UTF-8 RnwWeave: Sweave LaTeX: pdfLaTeX +AutoAppendNewline: Yes StripTrailingWhitespace: Yes +LineEndingConversion: Posix BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageRoxygenize: rd,collate,namespace + +UseNativePipeOperator: Yes + +QuitChildProcessesOnExit: Yes From 5132ebf92802dd60dcf6e3dc0e78221c03eebf9c Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 22:00:33 -0400 Subject: [PATCH 019/169] updates conditions for fct-expand-seq (#259) --- R/fct_expand_seq.R | 13 +++++++------ tests/testthat/test-fct-expand-seq.R | 29 ++++++++++++++++++---------- 2 files changed, 26 insertions(+), 16 deletions(-) diff --git a/R/fct_expand_seq.R b/R/fct_expand_seq.R index b0b5042d..f650d58a 100644 --- a/R/fct_expand_seq.R +++ b/R/fct_expand_seq.R @@ -42,11 +42,11 @@ fct_expand_seq <- function( } if (is.na(min_lvl)) { - stop(cond_fct_expand_seq_na("min_lvl")) + stop(fct_expand_seq_na("min_lvl")) } if (is.na(max_lvl)) { - stop(cond_fct_expand_seq_na("max_lvl")) + stop(fct_expand_seq_na("max_lvl")) } int <- seq(from = min_lvl, to = max_lvl, by = by) @@ -55,7 +55,8 @@ fct_expand_seq <- function( # condition --------------------------------------------------------------- -cond_fct_expand_seq_na <- function(x = c("min_lvl", "max_lvl")) { - x <- match_param(x) - new_condition(paste(x, "cannot be `NA`"), "fct_expand_seq_na") -} +fct_expand_seq_na := condition( + function(x = c("min_lvl", "max_lvl")) paste(match_param(x), "cannot be `NA`"), + type = "error", + exports = "fct_expand_seq" +) diff --git a/tests/testthat/test-fct-expand-seq.R b/tests/testthat/test-fct-expand-seq.R index 9de459f6..183f259e 100644 --- a/tests/testthat/test-fct-expand-seq.R +++ b/tests/testthat/test-fct-expand-seq.R @@ -1,16 +1,25 @@ x <- ordered(letters[c(5:15, 2)], levels = letters) test_that("Sequences correctly", { - expect_equal(fct_expand_seq(x), - ordered(letters[2:15], levels = letters)) + expect_identical( + fct_expand_seq(x), + ordered(letters[2:15], levels = letters) + ) - expect_equal(fct_expand_seq(x, "g", "s", 3L), - ordered(letters[seq(7, 19, 3)], levels = letters)) + expect_identical( + fct_expand_seq(x, "g", "s", 3L), + ordered(letters[seq(7, 19, 3)], levels = letters) + ) - expect_equal(fct_expand_seq(x, "g", "s", 3L), - fct_expand_seq(x, "g", "t", 3L)) - expect_equal(fct_expand_seq(x, 1), - ordered(letters[1:15], levels = letters)) + expect_identical( + fct_expand_seq(x, "g", "s", 3L), + fct_expand_seq(x, "g", "t", 3L) + ) + + expect_identical( + fct_expand_seq(x, 1), + ordered(letters[1:15], levels = letters) + ) }) test_that("fct_expand_seq() fails", { @@ -19,11 +28,11 @@ test_that("fct_expand_seq() fails", { expect_error( fct_expand_seq(as.ordered("a"), min_lvl = NA), - class = "fctExpandSeqNaError" + class = "mark:fct_expand_seq_na" ) expect_error( fct_expand_seq(as.ordered("a"), max_lvl = NA), - class = "fctExpandSeqNaError" + class = "mark:fct_expand_seq_na" ) }) From 2a1f5577a9fe4645f04986284b02d2b697816bc7 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 22 Sep 2025 22:00:52 -0400 Subject: [PATCH 020/169] renames file (#259) --- R/{fct_expand_seq.R => fct-expand-seq.R} | 0 man/fct_expand_seq.Rd | 2 +- man/reexports.Rd | 2 +- 3 files changed, 2 insertions(+), 2 deletions(-) rename R/{fct_expand_seq.R => fct-expand-seq.R} (100%) diff --git a/R/fct_expand_seq.R b/R/fct-expand-seq.R similarity index 100% rename from R/fct_expand_seq.R rename to R/fct-expand-seq.R diff --git a/man/fct_expand_seq.Rd b/man/fct_expand_seq.Rd index 9f3b538e..748de045 100644 --- a/man/fct_expand_seq.Rd +++ b/man/fct_expand_seq.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fct_expand_seq.R +% Please edit documentation in R/fct-expand-seq.R \name{fct_expand_seq} \alias{fct_expand_seq} \title{Factor Expand by Sequence} diff --git a/man/reexports.Rd b/man/reexports.Rd index eb1029f6..e31cd8b3 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From bc79538521291db8d3fb009aebc018959c09fe09 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Sep 2025 13:39:56 -0400 Subject: [PATCH 021/169] corrects space (#259) --- R/diff-time.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/diff-time.R b/R/diff-time.R index 845ce526..8bff6e6d 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -359,7 +359,7 @@ diff_time(100, 200, tz = 0) na_timezone_found := condition( function() { - paste("NA found in timezones; setting to default timezone:", default_tz()) + paste("NA found in timezones; setting to default timezone:", default_tz()) }, type = "warning", exports = "diff_time" From 72cf172cc43b517fafb62b19f4d4623c2de3596f Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Sep 2025 13:40:02 -0400 Subject: [PATCH 022/169] formatting (#259) --- R/directory.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/directory.R b/R/directory.R index b0091374..09ddd4b7 100644 --- a/R/directory.R +++ b/R/directory.R @@ -508,7 +508,7 @@ paths_are_directories := condition( ) }, type = "warning", - help = ( + help = { "File creation cannot be performed when the path is an existing directory" - ) + } ) From 2c10be349fc86885c5bc7bd9498c84dfe4fd9933 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Sep 2025 13:40:26 -0400 Subject: [PATCH 023/169] adds condition for files (#259) --- R/file.R | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/R/file.R b/R/file.R index 8f725a9c..6922cb70 100644 --- a/R/file.R +++ b/R/file.R @@ -15,9 +15,9 @@ file_copy_md5 <- function(path, new_path, overwrite = NA, quiet = FALSE) { msg <- if (quiet) { function(...) invisible() } else if (utils::packageVersion("fuj") < "0.2.2") { - function(...) message(...) + function(...) cat(..., "\n") } else { - function(...) message(cond_file_copy_md5(...)) + function(...) cnd(md5_status(.makeMessage(...))) } # not as pretty, but pretty reasonable @@ -48,10 +48,4 @@ file_copy_md5 <- function(path, new_path, overwrite = NA, quiet = FALSE) { invisible(new_path) } -cond_file_copy_md5 <- function(...) { - fuj::new_condition( - .makeMessage(...), - class = "file_copy_md5", - type = "message" - ) -} +md5_status := condition(function(x) x) From 776bfe907d44452d1d032375a7b5f31578f49ce2 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Sep 2025 13:40:33 -0400 Subject: [PATCH 024/169] adds conditions for identical (#259) --- R/identical.R | 38 ++++++++++++-------------------------- 1 file changed, 12 insertions(+), 26 deletions(-) diff --git a/R/identical.R b/R/identical.R index 36c5e295..c51c8354 100644 --- a/R/identical.R +++ b/R/identical.R @@ -23,16 +23,12 @@ are_identical <- function(..., params = NULL) { x <- rlang::list2(...) n <- length(x) - if (length(unique(lengths(x))) != 1L) { - stop(cond_are_identical_none()) - } - - if (n < 2L) { - stop(cond_are_identical_two()) + if (length(unique(lengths(x))) != 1L || n < 2L) { + stop(dots_specified_correctly()) } if (n == 2L) { - return(do_map_identical(x[[1]], x[[2]], params)) + return(do_map_identical(x[[1L]], x[[2L]], params)) } res <- list() @@ -41,16 +37,14 @@ are_identical <- function(..., params = NULL) { res[[i]] <- do_map_identical(x[[i]], x[[i + 1L]], params) } - apply(Reduce(cbind, res), 1, all) + apply(Reduce(cbind, res), 1L, all) } do_map_identical <- function(x, y, params = NULL) { mapply( - function(.x, .y) { - do.call(identical, c(list(x = .x, y = .y), params)) - }, - x, - y, + function(.x, .y) do.call(identical, c(list(x = .x, y = .y), params)), + .x = x, + .y = y, USE.NAMES = FALSE, SIMPLIFY = TRUE ) @@ -58,16 +52,8 @@ do_map_identical <- function(x, y, params = NULL) { # conditions -------------------------------------------------------------- -cond_are_identical_none <- function() { - new_condition( - "... must have equal length vectors", - "are_identical_none" - ) -} - -cond_are_identical_two <- function() { - new_condition( - "... must have length of 2 or more", - "are_identical_two" - ) -} +dots_specified_correctly := condition( + "... must have at least two arguments and be equal length vectors", + type = "error", + exports = "are_identical" +) From b79b809b0a2b6688e77388b966599d5072d03dcc Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Sep 2025 13:40:39 -0400 Subject: [PATCH 025/169] adds condition for import (#259) --- R/import.R | 35 +++++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 14 deletions(-) diff --git a/R/import.R b/R/import.R index 23366b1f..0fc24f3f 100644 --- a/R/import.R +++ b/R/import.R @@ -18,23 +18,30 @@ import <- function(pkg, fun, overwrite = FALSE) { require_namespace(pkg) if (!overwrite && fun %in% ls(envir = e)) { - stop(cond_import_assigned(fun)) + stop(import_already_assigned(fun)) } - assign(fun, pkg %colons% fun, envir = e) + assign(fun, pkg %::% fun, envir = e) } # conditions -------------------------------------------------------------- -cond_import_assigned <- function(fun) { - new_condition( - sprintf( - paste( - "`%s` has already been assigned.", - "Use `overwite = TRUE` to overwrite assignment." - ), - fun - ), - "import_assigned" - ) -} +import_already_assigned := condition( + message = function(fun) sprintf("'%s' has already been assigned", fun), + type = "error", + exports = "import", + help = " +The object you are trying to import has already been assigned in the environment you are importing to. Use the `overwrite` option to replace the object. + +For example: + +```r +# instead of +foo <- NULL +import('package', 'foo') + +# do this +foo <- NULL +import('package', 'foo', overwrite = TRUE) +``` +") From 46dcbf606395050f48d66c24863345d352399fa8 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 28 Sep 2025 23:11:36 -0400 Subject: [PATCH 026/169] updates difftime test (#259) --- tests/testthat/test-diff-time.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/testthat/test-diff-time.R b/tests/testthat/test-diff-time.R index 9c99504b..c27887af 100644 --- a/tests/testthat/test-diff-time.R +++ b/tests/testthat/test-diff-time.R @@ -152,7 +152,7 @@ test_that("Timezones", { expect_warning( diff_time(Sys.Date(), Sys.Date(), tzx = NA, tzy = "GMT"), - "NA found in timezones" + class = "mark:na_timezone_found" ) }) @@ -190,7 +190,6 @@ test_that("class coehersion", { expect_warning( to_numeric_with_tz("2021-01-01", NA), - "NA found in timezones", class = "mark:na_timezone_found" ) From af1c7313fda7c028de02695ac8d1a20c31433862 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 28 Sep 2025 23:11:49 -0400 Subject: [PATCH 027/169] updates inserts conditions (#259) --- R/insert.R | 27 ++++++++++----------------- tests/testthat/test-insert.R | 4 ++-- 2 files changed, 12 insertions(+), 19 deletions(-) diff --git a/R/insert.R b/R/insert.R index 476faf33..c266ec7f 100644 --- a/R/insert.R +++ b/R/insert.R @@ -15,14 +15,11 @@ insert <- function(x, positions, values) { stopifnot(!anyNA(positions)) positions <- as.integer(positions) + stopifnot(length(positions) >= 1) nval <- length(values) npos <- length(positions) - if (npos == 0L) { - stop(cond_insert_npos()) - } - if (nval == 1L && !is.list(values)) { values <- rep.int(values, npos) } else if (nval == npos) { @@ -30,7 +27,7 @@ insert <- function(x, positions, values) { positions <- positions[o] values <- values[o] } else { - stop(cond_insert_length()) + stop(unequal_lengths()) } seqs <- seq_along(positions) @@ -46,16 +43,12 @@ insert <- function(x, positions, values) { # conditions -------------------------------------------------------------- -cond_insert_npos <- function() { - new_condition( - "positions has no length", - "insert_npos" - ) -} - -cond_insert_length <- function() { - new_condition( - "length(values) must be equal to length(positions) or 1", - "insert_length" +unequal_lengths := condition( + "lengths of positions and values are unequal", + type = "error", + exports = "insert", + help = c( + "insert() requires that `positions` and `values` are the same length or", + " that `values` is length 1" ) -} +) diff --git a/tests/testthat/test-insert.R b/tests/testthat/test-insert.R index 7fc941ae..d1bcaeca 100644 --- a/tests/testthat/test-insert.R +++ b/tests/testthat/test-insert.R @@ -9,8 +9,8 @@ test_that("insert.default() works", { expect_identical(res, exp) expect_error(insert(1, NA, 1), class = "simpleError") - expect_error(insert(1, integer(), 1), class = "insertNposError") - expect_error(insert(1, 1, integer()), class = "insertLengthError") + expect_error(insert(1, integer(), 1), class = "simpleError") + expect_error(insert(1, 1, integer()), class = "mark:unequal_lengths") }) test_that("insert.data.frame() works", { From 9db2be6c2de346978b5e3adc5945cd2fb2bb3cbe Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 28 Sep 2025 23:12:22 -0400 Subject: [PATCH 028/169] updates tests for identical (#259) --- tests/testthat/test-identical.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-identical.R b/tests/testthat/test-identical.R index 58a8236e..09fb721e 100644 --- a/tests/testthat/test-identical.R +++ b/tests/testthat/test-identical.R @@ -14,8 +14,8 @@ test_that("are_identical() works", { }) test_that("are_identical() fails", { - expect_error(are_identical(1, 1:3), class = "areIdenticalNoneError") - expect_error(are_identical(NULL), class = "areIdenticalTwoError") + expect_error(are_identical(1, 1:3), class = "mark:dots_specified_correctly") + expect_error(are_identical(NULL), class = "mark:dots_specified_correctly") }) # lintr things there isn't a terminal line here? From 6198467635a40662099de5ad8796ae446a18d50e Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 28 Sep 2025 23:18:24 -0400 Subject: [PATCH 029/169] updates conditions for files and writes (#259) --- R/write.R | 64 +++++++++++++++++++++++++++--------- tests/testthat/helper.R | 9 ++--- tests/testthat/test-file.R | 25 +++++++------- tests/testthat/test-import.R | 2 +- tests/testthat/test-write.R | 32 +++++++++++------- 5 files changed, 89 insertions(+), 43 deletions(-) diff --git a/R/write.R b/R/write.R index 94c5edba..f46e4560 100644 --- a/R/write.R +++ b/R/write.R @@ -301,10 +301,7 @@ get_list_hook <- function(hook) { false = function(x) NA_character_, none = NULL, # nolint next: brace_linter. - na = function(x) stop(new_condition( - "options(mark.list.hook) is NA but list columns detected", - class = "writeFileMd5ListHook" - )), + na = function(x) stop(write_na_hook()), match.fun(hook) ) } @@ -351,17 +348,7 @@ mark_write_yaml <- function( unicode = unicode, precision = digits, indent.mapping.sequence = FALSE, - handlers = list( - boolean = function(x) { - # nocov start - if (x %in% c("n", "y")) { - x - } else { - tolower(x) == "true" - } - # nocov end - } - ) + handlers = list(logical = yaml::verbatim_logical) ) mark_write_lines(string, con) } @@ -423,6 +410,45 @@ mark_write_arrow <- function( write(x, sink = con, ...) } +mark_write_md <- function(x, con, ...) { + # TODO include: + # @align + # @pad + # @format "default", "compact" + m <- rbind(NA, NA, unname(as.matrix(x))) + numeric <- vap_lgl(x, is.numeric) + align <- rep("left", ncol(x)) + align[numeric] <- "right" + + for (i in seq_along(x)) { + m[, i] <- format(c(colnames(x)[i], "", m[-(1:2), i]), justify = align[i]) + } + + # for 'center', subtract 2 from the total + m[2L, ] <- strrep("-", nchar(m[1L, ]) - 1L) + m[2L, numeric] <- paste0(m[2L, numeric], ":") + m[2L, !numeric] <- paste0(":", m[2L, !numeric]) + + cat( + paste0( + "|", + apply(m, 1L, paste0, collapse = "|"), + "|", + collapse = "\n" + ), + file = con + ) +} + +mark_read_md <- function(file, text) { + if (!missing(text)) { + file <- textConnection(text) + } + + x <- readLines(file) + +} + # helpers ----------------------------------------------------------------- mark_to_json <- function(x) { @@ -570,3 +596,11 @@ safe_fs_delete <- function(x) { fs::file_delete(x) } } + + +# conditions -------------------------------------------------------------- + +write_na_hook := condition( + "options(mark.list.hook) is NA but list columns detected", + type = "error", +) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index df256dc0..227ddb20 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -1,5 +1,6 @@ -fuj_message <- function() { - if (packageVersion("fuj") >= "2.2.0") { - "mark:fileCopyMd5Message" - } +muffle_cnd_conditions <- function(expr) { + withCallingHandlers( + expr, + "cnd::condition" = function(cond) tryInvokeRestart("muffleCondition") + ) } diff --git a/tests/testthat/test-file.R b/tests/testthat/test-file.R index de41a66a..c661ac94 100644 --- a/tests/testthat/test-file.R +++ b/tests/testthat/test-file.R @@ -1,4 +1,6 @@ -test_that("file_copy_md5() works", { + + +muffle_cnd_conditions(test_that("file_copy_md5() works", { x <- c(tempfile("one"), tempfile("two"), tempfile("three")) y <- c(tempfile("one"), tempfile("two"), tempfile("three")) on.exit(fs::file_delete(c(x, y))) @@ -8,36 +10,37 @@ test_that("file_copy_md5() works", { writeLines("three", x[3L]) # none of y exists - expect_message( + expect_condition( file_copy_md5(x, y, overwrite = FALSE), - class = fuj_message() + class = "mark:md5_status" ) - expect_message( + + expect_condition( file_copy_md5(x, y, overwrite = FALSE), - class = fuj_message() + class = "mark:md5_status" ) # all of y exists - expect_message( + expect_condition( file_copy_md5(x, y, overwrite = TRUE), - class = fuj_message() + class = "mark:md5_status" ) # mix writeLines("twotwo", y[2L]) fs::file_delete(y[3L]) - expect_message( + expect_condition( expect_identical( attr(file_copy_md5(x, y), "changed"), c(FALSE, TRUE, NA) ), - class = fuj_message(), + class = "mark:md5_status", regexp = paste( "one", "md5 same", "two", "md5 change", "three", "new file", sep = ".*" ) ) - expect_message(file_copy_md5(x, y, quiet = TRUE), NA) -}) + expect_condition(file_copy_md5(x, y, quiet = TRUE), NA) +})) diff --git a/tests/testthat/test-import.R b/tests/testthat/test-import.R index 3b1c3c46..9636057f 100644 --- a/tests/testthat/test-import.R +++ b/tests/testthat/test-import.R @@ -1,6 +1,6 @@ test_that("import() works", { import("tools", "file_ext") expect_identical(file_ext, tools::file_ext) - expect_error(import("tools", "file_ext"), class = "importAssignedError") + expect_error(import("tools", "file_ext"), class = "mark:import_already_assigned") expect_error(import("tools", "file_ext", overwrite = TRUE), NA) }) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 350935a6..7c524ff3 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -2,8 +2,11 @@ test_that("write_file_md5() works", { df <- quick_dfl(a = 1, b = 2) temp <- withr::local_tempfile() expect_output(write_file_md5(df)) - expect_message(write_file_md5(df, temp), class = fuj_message()) - expect_message(write_file_md5(df, temp), class = fuj_message()) + muffle_cnd_conditions({ + expect_condition(write_file_md5(df, temp), class = "mark:md5_status") + expect_condition(write_file_md5(df, temp), class = "mark:md5_status") + + }) # atomic expect_output(write_file_md5("lines")) @@ -20,10 +23,13 @@ test_that("write_file_md5() types", { } else { quick_dfl(a = 1, b = "n", c = TRUE) } - expect_message( + + muffle_cnd_conditions( + expect_condition( write_file_md5(x, temp, method = !!method), - class = fuj_message() + class = "mark:md5_status" ) + ) } for (method in unlist0(mark_write_methods())) { @@ -34,13 +40,15 @@ test_that("write_file_md5() types", { test_that("path warning", { temp <- withr::local_tempfile() x <- structure(quick_dfl(a = 1), path = temp) - expect_message( - expect_warning( - write_file_md5(x, temp), - "attr(x, \"path\") is being overwritten", - fixed = TRUE - ), - class = fuj_message() + muffle_cnd_conditions( + expect_condition( + expect_warning( + write_file_md5(x, temp), + "attr(x, \"path\") is being overwritten", + fixed = TRUE + ), + class = "mark:md5_status" + ) ) }) @@ -104,7 +112,7 @@ test_that("list columns", { "unimplemented type 'list' in 'EncodeElement'", fixed = TRUE ) - expect_error(foo(NA), class = "writeFileMd5ListHookError") + expect_error(foo(NA), class = "mark:write_na_hook") }) test_that("arrow prints something to stdout()", { From 2f9e2c9cd3823ad330e390b94a17434ebd3d290d Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 28 Sep 2025 23:18:37 -0400 Subject: [PATCH 030/169] updates min versions (#259) --- DESCRIPTION | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5ca48552..6be589f3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,7 @@ Depends: R (>= 3.6) Imports: cli, - cnd, + cnd (>= 0.1.0.9001), fs (>= 1.6.2), fuj (>= 0.2.1), magrittr (>= 2.0.1), @@ -50,11 +50,13 @@ Suggests: waldo (>= 0.2.5), withr (>= 2.3.0), xopen, - yaml, + yaml (>= 2.3.9), jsonlite, arrow (>= 16.1.0), readMDTable (>= 0.2.0), clipr (>= 0.8.0) +Remotes: + github::jmbarbone/cnd@v0.1.0.9001 RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 From c07b49bb5326c21185b3f6868ba71e989cf64477 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Sep 2025 13:45:00 -0400 Subject: [PATCH 031/169] adds export (#259) --- R/zzz.R | 1 + man/reexports.Rd | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/R/zzz.R b/R/zzz.R index 67e9dba9..3bb5d8c8 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -7,4 +7,5 @@ } # FIXME include: +cnd_exports() # cnd_document() diff --git a/man/reexports.Rd b/man/reexports.Rd index e31cd8b3..eb1029f6 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From abc0d05d2cffae09a6df16ced9fcea4f0d430b25 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Sep 2025 13:45:45 -0400 Subject: [PATCH 032/169] updates conditions for labels (#259) --- R/labels.R | 190 ++++++++++++++++++++++------------- tests/testthat/test-labels.R | 44 ++++---- 2 files changed, 146 insertions(+), 88 deletions(-) diff --git a/R/labels.R b/R/labels.R index 9123e9f2..73d350a6 100644 --- a/R/labels.R +++ b/R/labels.R @@ -62,22 +62,23 @@ assign_labels.data.frame <- function( .missing = c("error", "warn", "skip"), .ls = rlang::list2(...) ) { - stopifnot(!identical(.ls, list())) - - if (...length() && !identical(rlang::list2(...), .ls)) { - stop(cond_assign_labels_dataframe_dots()) - } - .missing <- match_param(.missing) - if (is.null(.ls) || any(vap_lgl(.ls, is.null))) { - stop(cond_assign_labels_dataframe_names()) + if ( + identical(.ls, list()) || + (...length() && !identical(rlang::list2(...), .ls)) || + is.null(.ls) || + any(vap_lgl(.ls, is.null)) + ) { + stop(invalid_assign_labels(rlang::list2(...), .ls)) } - if (inherits(.ls[[1]], "data.frame")) { - lsx <- as.vector(.ls[[1]][[2]], "list") - names(lsx) <- .ls[[1]][[1]] - .ls <- lsx + if (inherits(.ls[[1L]], "data.frame")) { + .ls <- struct( + as.vector(.ls[[1L]][[2L]], "list"), + class = "list", + names = .ls[[1L]][[1L]] + ) } nm <- names(.ls) @@ -85,15 +86,15 @@ assign_labels.data.frame <- function( if (anyNA(ma)) { nas <- is.na(ma) - text <- paste0("Columns not found: ", collapse0(nm[nas], sep = ", ")) - if (.missing == "error") { - stop(cond_assign_labels_dataframe_missing(text, "error")) - } - - if (.missing == "warn") { - warning(cond_assign_labels_dataframe_missing(text, "warning")) - } + switch( + .missing, + error = stop, + warn = warning, + skip = function(cond) return() + )( + missing_labels_in_assign(nm[nas]) + ) nm <- nm[!nas] ma <- ma[!nas] @@ -135,14 +136,19 @@ view_labels <- function(x, title) { title <- paste0(cesx, " - Labels") } - pf <- parent.frame() - view_fun <- get0("View", envir = pf, ifnotfound = "utils" %colons% "View") - if (!is.function(view_fun)) { - stop(cond_view_labels_something(cesx, title)) - } + view <- + if ("tools:rstudio" %in% search()) { + get0("View", as.environment("tools:rstudio")) + } %||% + utils::View - view_fun(x = get_labels(x), title = title) + tryCatch( + view(x = get_labels(x), title = title), + error = function(cond) { + stop(cannot_view_labels()) + } + ) } #' @export @@ -164,15 +170,15 @@ remove_labels.data.frame <- function(x, cols, ...) { if (missing(cols)) { cols <- seq_along(x) } else { - bad <- cols %out% colnames(x) + bad <- cols %wo% colnames(x) - if (any(bad)) { - stop(cond_remove_labels_dataframe_bad(cols[bad])) + if (length(bad)) { + stop(column_not_found(bad)) } } for (i in cols) { - x[[i]] <- remove_labels(x[[i]]) + x[[i]] <- remove_labels(x[, i]) } x @@ -180,45 +186,91 @@ remove_labels.data.frame <- function(x, cols, ...) { # conditions -------------------------------------------------------------- -cond_assign_labels_dataframe_dots <- function() { # nolint: object_length_linter, line_length_linter. - new_condition( - "... was set separately from `.ls`. Only set one", - "assign_labels_dataframe_dots" - ) -} - -cond_assign_labels_dataframe_names <- function() { # nolint: object_length_linter, line_length_linter. - new_condition("... must not have NULLs", "assign_labels_dataframe_names") -} - -cond_assign_labels_dataframe_missing <- function( # nolint: object_length_linter, line_length_linter. - x, - type = c("error", "warning") -) { - type <- match_param(type) - new_condition( - x, - "assign_labels_dataframe_missing", - type = type - ) -} - -cond_view_labels_something <- function(x, title) { - new_condition( - paste0( - "Something went wrong trying to use `View()`", - "\nThis may be because you are using Rstudio :", - "\n https://community.rstudio.com/t/view-is-causing-an-error/75297/4", - "\nYou can try :\n ", - sprintf('`View(get_labels(%s), title = "%s")`', x, title) +invalid_assign_labels := condition( + message = function(dots, list) { + if (identical(dots, list)) { + paste0( + "labels provide are malformed: ", + toString(dots) + ) + } else { + paste0( + "`.ls` and `...` were both set and/or malformed", + "\n ... ", + toString(dots), + "\n .ls ", + toString(list) + ) + } + }, + type = "error", + exports = "assign_labels", + help = c( + "If passing labels as `.ls`, `...` must be empty.", + " Columns in `...` must be entered as `name = value`; `column = label`.", + "\n\n", + paste( + "```r", + "# instead of this:", + "assign_labels(df, a = 'AAA', .ls = list(b = 'BBB'))", + "", + "# do this:", + "assign_labels(df, a = 'AAA', b = 'BBB')", + "# or this:", + "assign_labels(df, .ls = list(a = 'AAA', b = 'BBB'))", + "```", + sep = "\n" ), - "view_labels_something" + "\n\n", + "Labels must not be null; to remove lavels, use `remove_labels()`.", + "\n\n", + paste( + "```r", + "# instead of this", + "assign_labels(df, a = 'AAA', b = NULL)", + "", + "# do this", + "df <- assign_labels(df, a = 'AAA')", + "df <- remove_labels(df, 'b')", + "```", + sep = "\n" + ) ) -} - -cond_remove_labels_dataframe_bad <- function(x) { # nolint: object_length_linter, line_length_linter. - new_condition( - paste0("Column not found in data.frame:\n ", toString(x)), - "remove_labels_dataframe_bad" +) + +missing_labels_in_assign := condition( + function(x) paste("Columns not found:", toString(x)), + type = "error", + exports = "assign_labels", + help = c( + "You can set `.missing` to `warn` to get a warning instead of an error,", + "or `skip` to silently skip those labels." ) -} +) + +cannot_view_labels := condition( + "Cannot use `View()`", + type = "error", + exports = "view_labels", + help = c( + "This may be because you are using Rstudio :", + " https://community.rstudio.com/t/view-is-causing-an-error/75297/4", + "You can try :", + ' `View(get_labels(x), title = "Labels")`' + ) +) + +column_not_found := condition( + function(x) { + sprintf( + ngettext( + length(x), + "Column not found in data.frame: %s", + "Columns not found in data.frame: %s" + ), + toString(x) + ) + }, + type = "error", + exports = "remove_labels" +) diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index d9d3e294..1afe959d 100644 --- a/tests/testthat/test-labels.R +++ b/tests/testthat/test-labels.R @@ -31,13 +31,12 @@ test_that("data.frame assignment", { expect_error( assign_labels(x0, a = "x", b = "y", `1` = 2), - "Columns not found: a, b, 1", - class = "assignLabelsDataframeMissingError" + class = "mark:missing_labels_in_assign" ) expect_error( assign_labels(x0, NULL), - class = "assignLabelsDataframeNamesError" + class = "mark:invalid_assign_labels" ) expect_true(is.null(attr(exp0[["Species"]], "label"))) @@ -45,18 +44,31 @@ test_that("data.frame assignment", { expect_equal(x0, exp2) expect_equal(exp1, exp2) - expect_error(assign_labels(x0, .ls = list()), class = "simpleError") + expect_error( + assign_labels(x0, .ls = list()), + class = "mark:invalid_assign_labels" + ) expect_error( assign_labels(x0, a = 1, .ls = list(b = 2)), - class = "assignLabelsDataframeDotsError" + class = "mark:invalid_assign_labels" ) df <- quick_dfl(a = 1, b = 2, c = 3) - # nolint start: line_length_linter. - expect_error(assign_labels(df, c = "c", d = "d", .missing = "error"), class = "assignLabelsDataframeMissingError") - expect_warning(assign_labels(df, c = "c", d = "d", .missing = "warn"), class = "assignLabelsDataframeMissingWarning") - expect_warning(assign_labels(df, c = "c", d = "d", .missing = "skip"), NA) - # nolint end: line_length_linter. + expect_error( + assign_labels(df, c = "c", d = "d", .missing = "error"), + class = "mark:missing_labels_in_assign" + ) + + # error is raised as a warning + expect_error( + assign_labels(df, c = "c", d = "d", .missing = "warn"), + class = "mark:missing_labels_in_assign" + ) + + expect_warning( + assign_labels(df, c = "c", d = "d", .missing = "skip"), + NA + ) }) test_that("data.frame assign with data.frame", { @@ -85,23 +97,17 @@ test_that("data.frame assign with data.frame", { expect_error( assign_labels(iris, bad_labels), - "Columns not found: a, b, 1", - class = "assignLabelsDataframeMissingError" + class = "mark:missing_labels_in_assign" ) options(op) }) test_that("view_labels() works", { + skip_if(interactive()) df <- data.frame(a = 1, b = 2) df <- assign_labels(df, a = "a", b = "b") - - # redefine "View" - View <- function(x, ...) identity(x) # nolint: object_name_linter. - expect_error(view_labels(df), NA) - - View <- NA # nolint: object_name_linter. - expect_error(view_labels(df), class = "viewLabelsSomethingError") + expect_error(view_labels(df), class = "mark:cannot_view_labels") }) test_that("exact match [141]", { From ec942e642170d2702bdf3110269d13d00c0aaa56 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 12 Oct 2025 01:15:29 -0400 Subject: [PATCH 033/169] cleanup (#259) --- R/write.R | 38 +++++++++++++++++++++++++++++--------- 1 file changed, 29 insertions(+), 9 deletions(-) diff --git a/R/write.R b/R/write.R index f46e4560..ec322283 100644 --- a/R/write.R +++ b/R/write.R @@ -410,25 +410,45 @@ mark_write_arrow <- function( write(x, sink = con, ...) } -mark_write_md <- function(x, con, ...) { - # TODO include: - # @align - # @pad - # @format "default", "compact" +mark_write_md <- function( + x, + con, + format = c("default", "compact"), + na = NA_character_, + ... + ) { + format <- match_param(format) m <- rbind(NA, NA, unname(as.matrix(x))) + n <- ncol(x) numeric <- vap_lgl(x, is.numeric) - align <- rep("left", ncol(x)) + align <- rep("left", n) align[numeric] <- "right" + m[is.na(m)] <- na for (i in seq_along(x)) { - m[, i] <- format(c(colnames(x)[i], "", m[-(1:2), i]), justify = align[i]) + m[, i] <- base::format( + c(colnames(x)[i], "", m[-(1:2), i]), + trim = format == "compact", + justify = align[i] + ) } - # for 'center', subtract 2 from the total - m[2L, ] <- strrep("-", nchar(m[1L, ]) - 1L) + m[2L, ] <- strrep( + "-", + switch( + format, + default = nchar(m[1L, ]) - 1L, + compact = rep(2L, n) + ) + ) + m[2L, numeric] <- paste0(m[2L, numeric], ":") m[2L, !numeric] <- paste0(":", m[2L, !numeric]) + if (format == "compact") { + m <- trimws(m) + } + cat( paste0( "|", From ec93433facb3d2ddcdc3c8361dc1bde8f9a3d496 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 15 Nov 2025 13:35:39 -0500 Subject: [PATCH 034/169] updates conditions for logic (#259) --- R/logic.R | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/R/logic.R b/R/logic.R index 7b6df66e..891b68dc 100644 --- a/R/logic.R +++ b/R/logic.R @@ -64,7 +64,7 @@ is_true <- function(x) { #' @export #' @rdname logic_ext is_true.default <- function(x) { - null_check(x) + check_null(x) out <- to_boolean(x) # TODO is !is_boolean(x) needed? @@ -93,7 +93,7 @@ is_false <- function(x) { #' @export #' @rdname logic_ext is_false.default <- function(x) { - null_check(x) + check_null(x) out <- to_boolean(x) # TODO is !is_boolean(x) needed? @@ -153,9 +153,9 @@ none <- function(..., na.rm = FALSE) { # nolint: object_name_linter. # FUNS -------------------------------------------------------------------- -null_check <- function(x) { +check_null <- function(x) { if (no_length(x)) { - stop(cond_null_check()) + stop(null_or_zero()) } invisible() @@ -196,9 +196,7 @@ apply_logical_matrix <- function(mat, FUN, na.rm) { # nolint: object_name_linter # conditions -------------------------------------------------------------- -cond_null_check <- function() { - new_condition( - "Cannot accept `NULL` or 0 length values", - "null_check" - ) -} +null_or_zero := condition( + message = "Cannot accept `NULL` or 0 length values", + type = "error" +) From 2997c88463ef9faa86775fd36afaedce09ae5da8 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 15 Nov 2025 13:36:58 -0500 Subject: [PATCH 035/169] updates conditions for percentile rank (#259) --- R/percentile-rank.R | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/R/percentile-rank.R b/R/percentile-rank.R index 25d116a7..3eb28695 100644 --- a/R/percentile-rank.R +++ b/R/percentile-rank.R @@ -79,7 +79,7 @@ do_percentile_rank <- function(u, w) { res <- (cumsum(p) - 0.5) / n } else { if (length(w) != length(u)) { - stop(cond_do_percentile_rank_weights()) + stop(percentile_rank_weights_length()) } ok <- stats::complete.cases(u, w) @@ -96,9 +96,7 @@ do_percentile_rank <- function(u, w) { # conditions -------------------------------------------------------------- -cond_do_percentile_rank_weights <- function() { # nolint: object_length_linter. - new_condition( - "length(weights) must be 1L or equal to length(x)", - "do_percentile_rank_weights" - ) -} +percentile_rank_weights_length := condition( + message = "length(weights) must be 1L or equal to length(x)", + type = "error" +) From deaf15b5552bf9d90cbf98e15a908c767083b41a Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 23 Nov 2025 23:57:21 -0500 Subject: [PATCH 036/169] updates conditions for recode (#259) --- R/recode.R | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/R/recode.R b/R/recode.R index 5b0de21f..ba74f90e 100644 --- a/R/recode.R +++ b/R/recode.R @@ -53,7 +53,7 @@ recode_by <- function(x, by, vals = NULL, mode = "any") { vals <- vals %||% names(by) if (is.null(vals)) { - stop(cond_recode_values()) + stop(recode_values_set_bad()) } if (length(vals) == 1) { @@ -79,7 +79,7 @@ recode_only <- function(x, by, vals = NULL) { vals <- vals %||% names(by) if (is.null(vals)) { - stop(cond_recode_values()) + stop(recode_values_set_bad()) } if (is.list(vals)) { @@ -125,9 +125,7 @@ clean_na_coercion <- function(expr) { # conditions -------------------------------------------------------------- -cond_recode_values <- function() { - new_condition( - "values to recode by were not properly set", - "recode_values" - ) -} +recode_values_set_bad := condition( + message = "values to recode by were not properly set", + type = "error" +) From 534a3bfac31f382e773a2b60730722462bddd7b1 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 23 Nov 2025 23:57:29 -0500 Subject: [PATCH 037/169] updates conditions for row-bind (#259) --- R/row-bind.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/row-bind.R b/R/row-bind.R index c780d096..6824e8d9 100644 --- a/R/row-bind.R +++ b/R/row-bind.R @@ -17,7 +17,7 @@ row_bind <- function(...) { } if (!all(vap_lgl(ls, is.data.frame))) { - stop(cond_row_bind_dataframes()) + stop(row_bind_object()) } names <- lapply(ls, names) @@ -63,6 +63,7 @@ rbind2 <- function(...) { # conditions -------------------------------------------------------------- -cond_row_bind_dataframes <- function() { - new_condition("... must only be data.frames", "row_bind_dataframes") -} +row_bind_object := condition( + message = "... must only be data.frames", + type = "error" +) From 54f54aa89b8b0ef69fd665ea1b7f9e94f1e219a0 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 24 Nov 2025 23:42:16 -0500 Subject: [PATCH 038/169] updates conditions for match-arg (#259) --- R/match-arg.R | 227 ++++++++++++++++---------------- tests/testthat/test-logic.R | 47 ++++--- tests/testthat/test-match-arg.R | 16 +-- tests/testthat/test-recode.R | 6 +- tests/testthat/test-write.R | 3 +- 5 files changed, 154 insertions(+), 145 deletions(-) diff --git a/R/match-arg.R b/R/match-arg.R index 00a3cafb..26d2afda 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -44,7 +44,7 @@ match_arg <- function(x, table) { if (!length(out)) { csx <- as.character(substitute(x)) - stop(cond_match_arg(csx, x, table)) + stop(match_arg_no_match(csx, x, table)) } out @@ -105,12 +105,12 @@ match_arg <- function(x, table) { #' sapply(0:5, match_param, choices = ls) #' @export match_param <- function( - param, - choices, - null = TRUE, - partial = getOption("mark.match_param.partial", FALSE), - multiple = FALSE, - simplify = TRUE + param, + choices, + null = TRUE, + partial = getOption("mark.match_param.partial", FALSE), + multiple = FALSE, + simplify = TRUE ) { param_c <- charexpr(substitute(param)) force(param) @@ -120,7 +120,7 @@ match_param <- function( return(NULL) } - stop(cond_match_param_null()) + stop(match_arg_null_param()) } missing_choices <- missing(choices) @@ -135,7 +135,7 @@ match_param <- function( if (anyDuplicated(unlist(mchoices$choices))) { # TODO implement cond_match_param_dupes() - stop(cond_match_param_dupes(choices)) + stop(match_param_duplicates(choices)) } fun <- if (partial) pmatch else match @@ -151,12 +151,7 @@ match_param <- function( param <- deparse(param) } - stop(cond_match_param_match( - input = param_c, - argument = ocall, - param = param, - choices = choices - )) + stop(match_arg_param_match(param_c, ocall, param, choices)) } res <- lapply(m, function(i) mchoices$values[[i]]) @@ -195,110 +190,116 @@ cleanup_param_list <- function(x) { # conditions -------------------------------------------------------------- -cond_match_arg <- function(csx, x, table) { - table <- collapse(table, sep = "\', \'") - new_condition( +match_arg_no_match := condition( + message = function(csx, x, table) { sprintf( "%s : '%s' did not match of of the following:\n '%s'", - csx, x, table - ), - "cond_match_arg" - ) -} - -cond_match_param_null <- function() { - new_condition( - "match_param() requires non-NULL params", - "cond_match_param_null" - ) -} - -cond_match_param_match <- function( - input, - argument, - param, - choices -) { - to_value <- function(x) { - if (all(names(x) == as.character(x))) { - return(toString(x)) + csx, + x, + table + ) + }, + type = "error" +) + +match_arg_null_param := condition( + message = "match_param() requires non-NULL params", + type = "error" +) + +match_arg_param_match := condition( + message = function(input, argument, param, choices) { + to_value <- function(x) { + if (all(names(x) == as.character(x))) { + return(toString(x)) + } + + nms <- names(x) + if (is.null(nms)) { + return(toString(x)) + } + + ok <- nzchar(nms) + nms[ok] <- paste(nms[ok], "= ") + toString(paste0(nms, x)) } - nms <- names(x) - if (is.null(nms)) { - return(toString(x)) - } - - ok <- nzchar(nms) - nms[ok] <- paste(nms[ok], "= ") - toString(paste0(nms, x)) - } - - to_options <- function(x) { - if (all(names(x) == as.character(x))) { - return(toString(x)) + to_options <- function(x) { + if (all(names(x) == as.character(x))) { + return(toString(x)) + } + + collapse( + mapply( + function(x, nm) { + if (nzchar(nm)) { + sprintf("%s = %s", nm, toString(x)) + } else { + toString(x) + } + }, + x = x, + nm = names(x), + USE.NAMES = FALSE + ), + sep = " | " + ) } - collapse(mapply( - function(x, nm) { - if (nzchar(nm)) { - sprintf("%s = %s", nm, toString(x)) - } else { - toString(x) - } - }, - x = x, - nm = names(x), - USE.NAMES = FALSE - ), sep = " | ") - } - - msg <- sprintf( - paste0( - "`match_param(%s)` failed in `%s`:\n", - " param %s\n", - " choices %s" - ), - input, - argument, - to_value(param), - to_options(choices) - ) - - new_condition(msg, "match_param_match") -} - -cond_match_param_dupes <- function(choices) { - to_choices <- function(x) { - if (all(names(x) == as.character(x))) { - dupe <- duplicated(x) - x[dupe] <- paste0(x[dupe], "*") - return(toString(x)) + msg <- sprintf( + paste0( + "`match_param(%s)` failed in `%s`:\n", + " param %s\n", + " choices %s" + ), + input, + argument, + to_value(param), + to_options(choices) + ) + + new_condition(msg, "match_param_match") + }, + type = "error" +) + +match_param_duplicates := condition( + message = function(choices) { + to_choices <- function(x) { + if (all(names(x) == as.character(x))) { + dupe <- duplicated(x) + x[dupe] <- paste0(x[dupe], "*") + return(toString(x)) + } + + collapse( + mapply( + function(x, nm, d) { + sprintf( + "%s = %s", + nm, + toString(paste0(x, ifelse(d, "*", ""))) + ) + }, + x = x, + nm = names(x), + d = split( + duplicated(unlist(x)), + rep(seq_along(x), lengths(x)) + ), + USE.NAMES = FALSE + ), + sep = "\n " + ) } - collapse(mapply( - function(x, nm, d) { - sprintf( - "%s = %s", - nm, - toString(paste0(x, ifelse(d, "*", ""))) - ) - }, - x = x, - nm = names(x), - d = split( - duplicated(unlist(x)), - rep(seq_along(x), lengths(x)) + new_condition( + msg = paste0( + "duplicate values found in `choices`:\n ", + to_choices(choices) ), - USE.NAMES = FALSE - ), sep = "\n ") - } - - new_condition( - msg = paste0( - "duplicate values found in `choices`:\n ", - to_choices(choices) - ), - class = "match_param_dupes" - ) -} + class = "match_param_dupes" + ) + }, + type = "error" +) diff --git a/tests/testthat/test-logic.R b/tests/testthat/test-logic.R index 5b2f1530..7d163af4 100644 --- a/tests/testthat/test-logic.R +++ b/tests/testthat/test-logic.R @@ -10,22 +10,22 @@ test_that("Logical extension work", { res_n <- logical(length(x)) - res_xy_and <- res_n - res_xy_and_na <- res_n - res_xy_or <- res_n - res_xy_or_na <- res_n + res_xy_and <- res_n + res_xy_and_na <- res_n + res_xy_or <- res_n + res_xy_or_na <- res_n - res_xyz_and <- res_n + res_xyz_and <- res_n res_xyz_and_na <- res_n - res_xyz_or <- res_n - res_xyz_or_na <- res_n + res_xyz_or <- res_n + res_xyz_or_na <- res_n for (i in seq_along(x)) { res_xy_and[i] <- x[i] & y[i] - res_xy_or[i] <- x[i] | y[i] + res_xy_or[i] <- x[i] | y[i] res_xyz_and[i] <- x[i] & y[i] & z[i] - res_xyz_or[i] <- x[i] | y[i] | z[i] + res_xyz_or[i] <- x[i] | y[i] | z[i] res_xy_and_na[i] <- all(x[i], y[i], na.rm = TRUE) res_xy_or_na[i] <- any(x[i], y[i], na.rm = TRUE) @@ -37,8 +37,8 @@ test_that("Logical extension work", { expect_equal(is_true(x), sapply(x, isTRUE, USE.NAMES = FALSE)) expect_equal(is_false(x), sapply(x, isFALSE, USE.NAMES = FALSE)) - expect_identical(is_true(c( TRUE, FALSE, NA)), c(TRUE, FALSE, FALSE)) # nolint: spaces_inside_linter, line_length_linter. - expect_identical(is_false(c(TRUE, FALSE, NA)), c(FALSE, TRUE, FALSE)) + expect_identical(is_true(c(TRUE, FALSE, NA)), c(TRUE, FALSE, FALSE)) # nolint: spaces_inside_linter, line_length_linter. + expect_identical(is_false(c(TRUE, FALSE, NA)), c(FALSE, TRUE, FALSE)) expect_true(is_boolean(x)) expect_true(is_boolean(xL)) @@ -58,12 +58,21 @@ test_that("Logical extension work", { }) test_that("logical helpers", { - expect_error(null_check(NULL), class = "nullCheckError") - expect_error(null_check(integer()), class = "nullCheckError") - - expect_error(apply_logical_matrix(1L, mean, TRUE), class = "simpleError") - # nolint start: line_length_linter. - expect_error(apply_logical_matrix(matrix("a"), mean, TRUE), class = "simpleError") - expect_error(apply_logical_matrix(matrix(3L), mean, TRUE), class = "simpleError") - # nolint end: line_length_linter. + expect_error(check_null(NULL), class = "mark:null_or_zero") + expect_error(check_null(integer()), class = "mark:null_or_zero") + + expect_error( + apply_logical_matrix(1L, mean, TRUE), + class = "simpleError" + ) + + expect_error( + apply_logical_matrix(matrix("a"), mean, TRUE), + class = "simpleError" + ) + + expect_error( + apply_logical_matrix(matrix(3L), mean, TRUE), + class = "simpleError" + ) }) diff --git a/tests/testthat/test-match-arg.R b/tests/testthat/test-match-arg.R index ccaa5ffb..8343c76b 100644 --- a/tests/testthat/test-match-arg.R +++ b/tests/testthat/test-match-arg.R @@ -15,7 +15,7 @@ test_that("match_param() works", { sep = "\n" ), fixed = TRUE, - class = "matchParamMatchError" + class = "mark:match_arg_param_match" ) foo2 <- function(y = 1:3) { @@ -38,7 +38,7 @@ test_that("match_param() works", { " choices a, b, c", sep = "\n" ), - class = "matchParamMatchError", + class = "mark:match_arg_param_match", fixed = TRUE ) @@ -46,7 +46,7 @@ test_that("match_param() works", { match_param(x, null = null) } - expect_error(foo(NULL), class = "condMatchParamNullError") + expect_error(foo(NULL), class = "mark:match_arg_null_param") expect_null(foo(NULL, null = TRUE)) }) @@ -56,7 +56,7 @@ test_that("match_param() can partialy match", { } expect_identical(fruits(), "apple") - expect_error(fruits("a"), class = "matchParamMatchError") + expect_error(fruits("a"), class = "mark:match_arg_param_match") expect_identical(fruits("app"), "apple") fruits <- function(x = list("apple" = 1:2, "apricot" = 3, "banana" = 4)) { @@ -64,7 +64,7 @@ test_that("match_param() can partialy match", { } expect_identical(fruits(), "apple") - expect_error(fruits(c(a = 0)), class = "matchParamMatchError") + expect_error(fruits(c(a = 0)), class = "mark:match_arg_param_match") expect_identical(fruits(1), "apple") }) @@ -84,7 +84,7 @@ test_that("match_arg() works", { expect_null(foo(NULL)) expect_identical(foo(), "a") expect_identical(foo(table = "a"), "a") - expect_error(foo(table = "c"), class = "condMatchArgError") + expect_error(foo(table = "c"), class = "mark:match_arg_no_match") }) test_that("match_param() accepts multiple [#104]", { @@ -115,11 +115,11 @@ test_that("match_param() accepts formula lists", { test_that("match_param() finds duplicate choices", { expect_error( match_param("a", c("a", "a")), - class = "matchParamDupesError" + class = "mark:match_param_duplicates" ) expect_error( match_param(1, c(a = 1:2, b = 3:4, c = c(1, 3))), - class = "matchParamDupesError" + class = "mark:match_param_duplicates" ) }) diff --git a/tests/testthat/test-recode.R b/tests/testthat/test-recode.R index 90a33850..74998a8c 100644 --- a/tests/testthat/test-recode.R +++ b/tests/testthat/test-recode.R @@ -4,7 +4,7 @@ test_that("recode_by() examples works", { expect_identical(res, exp) res <- recode_by(letters[1:3], c(`1` = "a", `2` = "b")) - exp <- c("1", "2", NA_character_) + exp <- c("1", "2", NA_character_) expect_identical(res, exp) res <- recode_by(letters[1:3], c(`1` = "a", `2` = "b"), mode = "integer") @@ -37,8 +37,8 @@ test_that("clean_na_coercion() works", { test_that("errors", { txt <- "values to recode by were not properly set" - expect_error(recode_by(1, 1), class = "recodeValuesError") - expect_error(recode_only(1, 1), class = "recodeValuesError") + expect_error(recode_by(1, 1), class = "mark:recode_values_set_bad") + expect_error(recode_only(1, 1), class = "mark:recode_values_set_bad") }) test_that("single value", { diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 7c524ff3..094fb4a1 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -5,7 +5,6 @@ test_that("write_file_md5() works", { muffle_cnd_conditions({ expect_condition(write_file_md5(df, temp), class = "mark:md5_status") expect_condition(write_file_md5(df, temp), class = "mark:md5_status") - }) # atomic @@ -56,7 +55,7 @@ test_that("write_file_md5() errors", { df <- quick_dfl(a = 1) expect_error( write_file_md5(df, method = "foo"), - class = "matchParamMatchError" + class = "mark:match_arg_param_match" ) }) From bf6815c4d9e27ddbb533fb2786685a82de487535 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 24 Nov 2025 23:43:53 -0500 Subject: [PATCH 039/169] corrects returns (#259) --- R/match-arg.R | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/R/match-arg.R b/R/match-arg.R index 26d2afda..bc9ad382 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -246,7 +246,7 @@ match_arg_param_match := condition( ) } - msg <- sprintf( + sprintf( paste0( "`match_param(%s)` failed in `%s`:\n", " param %s\n", @@ -257,8 +257,6 @@ match_arg_param_match := condition( to_value(param), to_options(choices) ) - - new_condition(msg, "match_param_match") }, type = "error" ) @@ -293,12 +291,9 @@ match_param_duplicates := condition( ) } - new_condition( - msg = paste0( - "duplicate values found in `choices`:\n ", - to_choices(choices) - ), - class = "match_param_dupes" + paste0( + "duplicate values found in `choices`:\n ", + to_choices(choices) ) }, type = "error" From 59f825b662d06ca02666ac409b584d7e55827fac Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 24 Nov 2025 23:49:14 -0500 Subject: [PATCH 040/169] updates na-assignment conditions (#259) --- R/na-assignment.R | 63 ++++++++++++++++------------- tests/testthat/test-na-assignment.R | 32 +++++++-------- 2 files changed, 52 insertions(+), 43 deletions(-) diff --git a/R/na-assignment.R b/R/na-assignment.R index 2a1fc324..274dfda7 100644 --- a/R/na-assignment.R +++ b/R/na-assignment.R @@ -33,7 +33,8 @@ NULL #' @rdname na_assignments #' @export -NA_at <- function(x, y, ...) { # nolint: object_name_linter. +NA_at <- function(x, y, ...) { + # nolint: object_name_linter. nx <- length(x) if (nx == 0L) { @@ -45,16 +46,17 @@ NA_at <- function(x, y, ...) { # nolint: object_name_linter. y <- FUN(x, ...) } + # FIXME replace with a single condition if (any(y %% 1 > 0, na.rm = TRUE)) { - stop(cond_na_at_integer()) + stop(na_at_integer()) } if (!isTRUE(max(y, na.rm = TRUE) <= nx)) { - stop(cond_na_at_max()) + stop(na_at_max()) } if (!isTRUE(length(y) <= nx)) { - stop(cond_na_at_length()) + stop(na_at_length()) } x[y] <- NA @@ -63,7 +65,8 @@ NA_at <- function(x, y, ...) { # nolint: object_name_linter. #' @rdname na_assignments #' @export -NA_if <- function(x, y, ...) { # nolint: object_name_linter. +NA_if <- function(x, y, ...) { + # nolint: object_name_linter. nx <- length(x) if (nx == 0L) { @@ -75,12 +78,13 @@ NA_if <- function(x, y, ...) { # nolint: object_name_linter. y <- FUN(x, ...) } + # FIXME replace with a single condition if (length(y) != nx) { - stop(cond_na_if_length()) + stop(na_if_length()) } if (!is.logical(y)) { - stop(cond_na_if_logical()) + stop(na_if_logical()) } x[y] <- NA @@ -89,7 +93,8 @@ NA_if <- function(x, y, ...) { # nolint: object_name_linter. #' @rdname na_assignments #' @export -NA_in <- function(x, y, ...) { # nolint: object_name_linter. +NA_in <- function(x, y, ...) { + # nolint: object_name_linter. if (length(x) == 0L) { return(x) } @@ -105,7 +110,8 @@ NA_in <- function(x, y, ...) { # nolint: object_name_linter. #' @rdname na_assignments #' @export -NA_out <- function(x, y, ...) { # nolint: object_name_linter. +NA_out <- function(x, y, ...) { + # nolint: object_name_linter. if (length(x) == 0L) { return(x) } @@ -122,27 +128,30 @@ NA_out <- function(x, y, ...) { # nolint: object_name_linter. # conditions -------------------------------------------------------------- -cond_na_at_integer <- function() { - new_condition("y must be a vector of integers", "na_at_integer") -} +na_at_integer := condition( + message = "y must be a vector of integers", + type = "error" +) -cond_na_at_max <- function() { - new_condition("values of y must not be greater than length of x", "na_at_max") -} -cond_na_at_length <- function() { - new_condition( - "length of y must not be greater than length of x", - "na_at_length" - ) -} +na_at_max := condition( + message = "length of y must not be greater than length of x", + type = "error" +) -cond_na_if_length <- function() { - new_condition("y must be the same length as x", "na_if_length") -} +na_at_length := condition( + message = "length of y must not be greater than length of x", + type = "error" +) -cond_na_if_logical <- function() { - new_condition("y must be logical", "na_if_logical") -} +na_if_length := condition( + message = "y must be the same length as x", + type = "error" +) + +cond_na_if_logical := condition( + message = "y must be logical", + type = "error" +) # terminal line diff --git a/tests/testthat/test-na-assignment.R b/tests/testthat/test-na-assignment.R index 7b2b19e3..3079b9ef 100644 --- a/tests/testthat/test-na-assignment.R +++ b/tests/testthat/test-na-assignment.R @@ -14,7 +14,7 @@ test_that("NA_at() and NA_if() work as expected", { expect_equal(NA_if(-1:3, foo), c(-1, 0, NA, NA, NA)) # y cannot be longer than x - expect_error(NA_at(x, 1:10), class = "naAtMaxError") + expect_error(NA_at(x, 1:10), class = "mark:na_at_max") res <- NA_at(1:4, function(i) which(i %% 2 == 0)) exp <- c(1L, NA, 3L, NA) @@ -36,10 +36,10 @@ test_that("NA_in() and NA_at() work as expected", { } # nolint start: commas_linter. - expect_equal(NA_in(x, foo), c(NA , NA , "c", NA , "d")) - expect_equal(NA_out(x, foo), c("a", "b", NA , "b", NA)) - expect_equal(NA_in(x, foo, d = TRUE), c("a", "b", NA , "b", NA)) - expect_equal(NA_out(x, foo, d = TRUE), c(NA , NA , "c", NA , "d")) + expect_equal(NA_in(x, foo), c(NA, NA, "c", NA, "d")) + expect_equal(NA_out(x, foo), c("a", "b", NA, "b", NA)) + expect_equal(NA_in(x, foo, d = TRUE), c("a", "b", NA, "b", NA)) + expect_equal(NA_out(x, foo, d = TRUE), c(NA, NA, "c", NA, "d")) # nolint end: commas_linter. # No error if y is longer @@ -48,16 +48,16 @@ test_that("NA_in() and NA_at() work as expected", { }) test_that("NA_*() 0 length", { - expect_identical(NA_at(integer()), integer()) - expect_identical(NA_at(double()), double()) - expect_identical(NA_at(character()), character()) - expect_identical(NA_if(integer()), integer()) - expect_identical(NA_if(double()), double()) - expect_identical(NA_if(character()), character()) - expect_identical(NA_in(integer()), integer()) - expect_identical(NA_in(double()), double()) - expect_identical(NA_in(character()), character()) - expect_identical(NA_out(integer()), integer()) - expect_identical(NA_out(double()), double()) + expect_identical(NA_at(integer()), integer()) + expect_identical(NA_at(double()), double()) + expect_identical(NA_at(character()), character()) + expect_identical(NA_if(integer()), integer()) + expect_identical(NA_if(double()), double()) + expect_identical(NA_if(character()), character()) + expect_identical(NA_in(integer()), integer()) + expect_identical(NA_in(double()), double()) + expect_identical(NA_in(character()), character()) + expect_identical(NA_out(integer()), integer()) + expect_identical(NA_out(double()), double()) expect_identical(NA_out(character()), character()) }) From 004b8e4060dde7ef36e172ec427b283d235d2401 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 24 Nov 2025 23:52:10 -0500 Subject: [PATCH 041/169] adds note in NEWS (#259) --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index eea76491..5470569d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * all _conditions_ previously created with [`fuj::new_condition()`](https://jmbarbone.github.io/fuj/reference/new_condition.html) have been rewritten with [`cnd::condition()`](https://jmbarbone.github.io/cnd/reference/condition.html) [#259] * all of these condition now use different class names, generated through [`cnd::condition()`](https://jmbarbone.github.io/cnd/reference/condition.html) * for more information, see https://jmbarbone.github.io/cnd + * FIXME: ensure names: `{rd_name}_{thing}` -- and see about switching messages around: (`message = function(type, params)`) * the following arguments were deprecated and unused, and have now been removed completely: * `list2df(show_NA)` From a2d7338732e61186b91731e7a5865bda03fe6772 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 25 Nov 2025 19:18:12 -0500 Subject: [PATCH 042/169] updates conditions for not-available (#259) --- R/not-available.R | 42 ++++++++++++++++------------- tests/testthat/test-not-available.R | 10 +++++-- 2 files changed, 32 insertions(+), 20 deletions(-) diff --git a/R/not-available.R b/R/not-available.R index 5f28baff..058694f0 100644 --- a/R/not-available.R +++ b/R/not-available.R @@ -40,18 +40,22 @@ get_not_available <- function(type = NULL) { out <- get_na_list()[[type]] if (is.null(out)) { - stop(cond_get_not_available(type)) + stop(not_available_not_found(type)) } if (is.function(out) || is.call(out)) { - stop(cond_get_not_available_type()) + stop(not_available_invalid_type()) } out } get_na_list <- function() { - merge_list(op.mark$mark.na_list, getOption("mark.na_list"), sort = FALSE) + merge_list( + op.mark$mark.na_list, + getOption("mark.na_list"), + sort = FALSE + ) } #' @export @@ -71,19 +75,21 @@ delayedAssign("NA_POSIXlt_", not_available("POSIXlt", 1L)) # conditions -------------------------------------------------------------- -cond_get_not_available <- function(x) { - msg <- sprintf( - paste0( - "\"%s\" not found\n", - "Can be set with `mark::set_not_available(%s, value = .)`" - ), - x, - x - ) +not_available_not_found := condition( + function(x) { + sprintf( + paste0( + "\"%s\" not found\n", + "Can be set with `mark::set_not_available(%s, value = .)`" + ), + x, + x + ) + }, + type = "error" +) - new_condition(msg, "get_not_available") -} - -cond_get_not_available_type <- function() { - new_condition("type is not valid", "get_not_available_type") -} +not_available_invalid_type := condition( + "type is not valid", + type = "error" +) diff --git a/tests/testthat/test-not-available.R b/tests/testthat/test-not-available.R index d65b7b9e..fdfb9bf0 100644 --- a/tests/testthat/test-not-available.R +++ b/tests/testthat/test-not-available.R @@ -1,6 +1,9 @@ test_that("not_available() works", { expect_error(get_not_available(), NA) - expect_error(get_not_available("foo"), class = "getNotAvailableError") + expect_error( + get_not_available("foo"), + class = "mark:not_available_not_found" + ) val <- struct(NA, "foo") set_not_available("foo", val) @@ -13,7 +16,10 @@ test_that("not_available() works", { set_not_available("foo", NULL) set_not_available("foo_fun", function() NULL) - expect_error(get_not_available("foo_fun"), class = "getNotAvailableTypeError") + expect_error( + get_not_available("foo_fun"), + class = "mark:not_available_invalid_type" + ) # reset list options(mark.na_list = NULL) From c8e64a2f73a042e6d393091699b25f6ec9d58e80 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 25 Nov 2025 20:04:17 -0500 Subject: [PATCH 043/169] corrects name (#259) --- R/na-assignment.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/na-assignment.R b/R/na-assignment.R index 274dfda7..f94ba3d1 100644 --- a/R/na-assignment.R +++ b/R/na-assignment.R @@ -149,7 +149,7 @@ na_if_length := condition( type = "error" ) -cond_na_if_logical := condition( +na_if_logical := condition( message = "y must be logical", type = "error" ) From 694aeb15ca40491edec1d4c8264158295bb57288 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 25 Nov 2025 20:04:29 -0500 Subject: [PATCH 044/169] updates conditions for note (#259) --- R/note.R | 9 +++++---- tests/testthat/test-note.R | 2 +- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/note.R b/R/note.R index b5db7cd3..31b3fbd4 100644 --- a/R/note.R +++ b/R/note.R @@ -87,7 +87,7 @@ print_note <- function(x, ...) { the_note <- note(x) if (!inherits(the_note, "note")) { - stop(cond_print_note_note()) + stop(note_not_note()) } if (!check_interactive()) { @@ -109,6 +109,7 @@ print.noted <- function(x, ...) { # conditions -------------------------------------------------------------- -cond_print_note_note <- function() { - new_condition("note(x) must be class note", "print_note_noted") -} +note_not_note := condition( + "note(x) must be class note", + type = "error" +) diff --git a/tests/testthat/test-note.R b/tests/testthat/test-note.R index 4d71cff5..6b79f917 100644 --- a/tests/testthat/test-note.R +++ b/tests/testthat/test-note.R @@ -81,7 +81,7 @@ test_that("note() errors", { withr::local_options(list(mark.check_interactive = NA)) expect_error(print_note(1L), class = "simpleError") x <- struct(1L, "noted", note = struct("hi", "note_a_note")) - expect_error(print_note(x), class = "printNoteNotedError") + expect_error(print_note(x), class = "mark:note_not_note") }) test_that("note() snapshots", { From 6f77b139806f5e4b1e48682439e3a9262d4f4150 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 25 Nov 2025 20:05:32 -0500 Subject: [PATCH 045/169] clean up clip helpers in testing (#259) --- DESCRIPTION | 1 + tests/testthat/helper.R | 51 ++++++++++++++++++++++ tests/testthat/test-clipboard.R | 77 ++++++++++----------------------- 3 files changed, 76 insertions(+), 53 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6be589f3..5eadbc8b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -61,4 +61,5 @@ RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 Config/testthat/parallel: true +Config/testthat/start-first: clipboard, sourcing, write, directory Language: en-US diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 227ddb20..800f81dc 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -4,3 +4,54 @@ muffle_cnd_conditions <- function(expr) { "cnd::condition" = function(cond) tryInvokeRestart("muffleCondition") ) } + +need_clipr <- function() { + testthat::skip_if_not_installed("clipr") + + # not sure if this is needed + withr::with_envvar(c(CLIPR_ALLOW = TRUE), { + testthat::skip_if_not(clipr::clipr_available()) + }) + + testthat::skip_on_cran() +} + +with_clip <- function(code) { + need_clipr() + withr::with_envvar( + c(CLIPR_ALLOW = TRUE), + (function() { + old <- clipr::read_clip() + clear_clipboard() + on.exit(clipr::write_clip(old), add = TRUE) + force(code) + })() + ) +} + +test_clipboard <- function(x, ...) { + with_clip({ + expect_error(write_clipboard(x), NA) + expect_equal(read_clipboard(), x, ...) + }) +} + +expect_clip <- function(input, method) { + with_clip({ + write_clipboard(input) + res <- if (package_available("tibble")) { + tibble::tibble(a = 1L, b = 2L, c = 3L) + } else { + fuj::quick_dfl(a = 1L, b = 2L, c = 3L) + } + expect_identical(read_clipboard(method), res) + }) +} + +simple_tbl <- function(delim) { + paste( + paste(letters[1:3], collapse = delim), + paste(1:3, collapse = delim), + sep = "\n" + ) +} diff --git a/tests/testthat/test-clipboard.R b/tests/testthat/test-clipboard.R index 401f1954..b865aee1 100644 --- a/tests/testthat/test-clipboard.R +++ b/tests/testthat/test-clipboard.R @@ -1,71 +1,42 @@ -need_clipr <- function() { - testthat::skip_if_not_installed("clipr") - - # not sure if this is needed - withr::with_envvar(c(CLIPR_ALLOW = TRUE), { - testthat::skip_if_not(clipr::clipr_available()) - }) - - testthat::skip_on_cran() -} - test_that("clipboard", { need_clipr() - clear_clipboard() - - test_clipboard <- function(x, ...) { - expect_error(write_clipboard(x), NA) - expect_equal(read_clipboard(), x, ...) - } - test_clipboard(c(TRUE, FALSE, NA)) test_clipboard(c(0.1234, -0.1586, 0.0001200)) test_clipboard(-1:4) test_clipboard(as.Date("2020-01-02") + 0:4) test_clipboard(runif(1e4)) - expect_error(clear_clipboard(), NA) - expect_equal(read_clipboard(), NULL) # previously "" + with_clip({ + expect_error(clear_clipboard(), NA) + expect_equal(read_clipboard(), NULL) # previously "" + }) + + with_clip({ + x <- quick_dfl( + var1 = 1:3, + var2 = letters[1:3], + var3 = as.Date("2020-01-03") + 1:3, + var4 = c(TRUE, FALSE, NA) + ) + + write_clipboard(x) - x <- quick_dfl( - var1 = 1:3, - var2 = letters[1:3], - var3 = as.Date("2020-01-03") + 1:3, - var4 = c(TRUE, FALSE, NA) - ) + res <- read_clipboard("data.frame") - expect_error(write_clipboard(x), NA) - res <- read_clipboard("data.frame") - expect_s3_class(res, "data.frame") - if (package_available("tibble")) - expect_equal(as.data.frame(res), x) + expect_s3_class(res, "data.frame") + if (package_available("tibble")) { + expect_equal(as.data.frame(res), x) + } - # finally test tibble - skip_if_not_installed("tibble") - expect_s3_class(res, "tbl_df") - expect_equal(read_clipboard("tibble"), tibble::as_tibble(x)) + # finally test tibble + skip_if_not_installed("tibble") + expect_s3_class(res, "tbl_df") + expect_equal(read_clipboard("tibble"), tibble::as_tibble(x)) + }) }) test_that("clipboard methods", { need_clipr() - expect_clip <- function(input, method) { - write_clipboard(input) - res <- if (package_available("tibble")) { - tibble::tibble(a = 1L, b = 2L, c = 3L) - } else { - fuj::quick_dfl(a = 1L, b = 2L, c = 3L) - } - expect_identical(read_clipboard(method), res) - } - - simple_tbl <- function(delim) { - paste( - paste(letters[1:3], collapse = delim), - paste(1:3, collapse = delim), - sep = "\n" - ) - } - expect_clip(simple_tbl("\t"), "data.frame") expect_clip(simple_tbl("\t"), "excel") expect_clip(simple_tbl("\t"), "calc") From 566ead5d359e1ffed77f5f53925fc8da7d5739fe Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 26 Nov 2025 22:51:34 -0500 Subject: [PATCH 046/169] update conditions for options (#259) --- R/options.R | 29 ++++++++++++++++------------- tests/testthat/test-options.R | 2 +- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/R/options.R b/R/options.R index 3f694972..96cf44ad 100644 --- a/R/options.R +++ b/R/options.R @@ -19,12 +19,13 @@ #' #' options(op) #' @export -checkOptions <- function(x) { # nolint: object_name_linter. +checkOptions <- function(x) { + # nolint: object_name_linter. stopifnot(is.list(x)) nm <- names(x) if (is.null(nm) || any(nm == "")) { - stop(cond_check_options_names()) + stop(unnamed_options()) } msg <- NULL @@ -41,12 +42,15 @@ checkOptions <- function(x) { # nolint: object_name_linter. msg <- "Option(s) updated :" } - msg <- c(msg, sprintf( - '\n "%s"\n old : %s\n new : %s', - nm[i], - go, - x[[i]] - )) + msg <- c( + msg, + sprintf( + '\n "%s"\n old : %s\n new : %s', + nm[i], + go, + x[[i]] + ) + ) } } @@ -59,8 +63,7 @@ checkOptions <- function(x) { # nolint: object_name_linter. # conditions -------------------------------------------------------------- -cond_check_options_names <- function() { - new_condition("All options must be named", "check_options_names") -} - -# terminal line +unnamed_options := condition( + "All options must be named", + type = "error" +) diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index 9e93002f..cae801e4 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -9,5 +9,5 @@ test_that("checkOptions() works", { expect_identical(getOption("mark.test.option2"), 2L) expect_error(checkOptions(1), info = "is.list(x)") - expect_error(checkOptions(list(1)), class = "checkOptionsNamesError") + expect_error(checkOptions(list(1)), class = "mark:unnamed_options") }) From 128dfac484e25d1f168815e0a088e7e98b9a08de Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 26 Nov 2025 22:51:40 -0500 Subject: [PATCH 047/169] updates conditions for paste (#259) --- R/paste.R | 11 +++++++---- tests/testthat/test-paste.R | 20 +++++++++++++------- 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/R/paste.R b/R/paste.R index 084f6e05..70e20fad 100644 --- a/R/paste.R +++ b/R/paste.R @@ -35,7 +35,7 @@ paste_combine <- function(..., collate = TRUE, sep = "") { n <- length(ls) if (n < 2) { - stop(cond_paste_combine_length()) + stop(paste_combined_dots_lenth()) } out <- do_paste_combine(ls[[1]], ls[[2]], collate = collate, sep = sep) @@ -81,6 +81,9 @@ do_paste_combine <- function(x, y, collate = TRUE, sep = "") { # conditions -------------------------------------------------------------- -cond_paste_combine_length <- function() { - new_condition("length of ... must be at least 2", "paste_combine_length") -} +paste_combined_dots_lenth := condition( + message = "length of ... must be at least 2", + type = "error", + package = "mark", + exports = "paste_combine" +) diff --git a/tests/testthat/test-paste.R b/tests/testthat/test-paste.R index b0e0d98b..fb62f66f 100644 --- a/tests/testthat/test-paste.R +++ b/tests/testthat/test-paste.R @@ -10,14 +10,21 @@ test_that("paste_combine() works", { expect_equal( paste_combine(x, y, z), - c("a1Jan", "a1Feb", "a2Jan", "a2Feb", - "b1Jan", "b1Feb", "b2Jan", "b2Feb") + c("a1Jan", "a1Feb", "a2Jan", "a2Feb", "b1Jan", "b1Feb", "b2Jan", "b2Feb") ) expect_equal( paste_combine(x, y, z, sep = "."), - c("a.1.Jan", "a.1.Feb", "a.2.Jan", "a.2.Feb", - "b.1.Jan", "b.1.Feb", "b.2.Jan", "b.2.Feb") + c( + "a.1.Jan", + "a.1.Feb", + "a.2.Jan", + "a.2.Feb", + "b.1.Jan", + "b.1.Feb", + "b.2.Jan", + "b.2.Feb" + ) ) expect_equal( @@ -32,13 +39,12 @@ test_that("paste_combine() works", { expect_equal( paste_combine(x, y, z, collate = FALSE), - c("a1Jan", "b1Jan", "a2Jan", "b2Jan", - "a1Feb", "b1Feb", "a2Feb", "b2Feb") + c("a1Jan", "b1Jan", "a2Jan", "b2Jan", "a1Feb", "b1Feb", "a2Feb", "b2Feb") ) }) test_that("paste_combine() fails", { - expect_error(paste_combine(1), class = "pasteCombineLengthError") + expect_error(paste_combine(1), class = "mark:paste_combined_dots_lenth") }) test_that("collapse0()", { From b96c2554b5566c7d6f252e6a292e6417c5c073cb Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Thu, 27 Nov 2025 23:58:13 -0500 Subject: [PATCH 048/169] update condition for sort-by (#259) --- R/sort-by.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/sort-by.R b/R/sort-by.R index 45a86a5b..48bb660e 100644 --- a/R/sort-by.R +++ b/R/sort-by.R @@ -18,12 +18,14 @@ #' @export sort_by <- function(x, by, ...) { if (!is_atomic0(x) || !is_atomic0(by)) { - stop(cond_sort_by_atomic()) + stop(sort_by_atomic()) } x[order(by, ...)] } -cond_sort_by_atomic <- function() { - new_condition("`x` and `by` must be atomic vectors", "sort_by_atomic") -} + +sort_by_atomic := condition( + "`x` and `by` must be atomic vectors", + type = "error" +) From 138e4c879ad4ce7af82c8374e1db6b85b5c4e5b1 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Thu, 27 Nov 2025 23:59:24 -0500 Subject: [PATCH 049/169] updates conditions for within (#259) --- R/within.R | 40 +++++++++++++++++----------------------- 1 file changed, 17 insertions(+), 23 deletions(-) diff --git a/R/within.R b/R/within.R index f26c4048..564c574d 100644 --- a/R/within.R +++ b/R/within.R @@ -42,15 +42,15 @@ between_more <- function(x, left, right, type = c("gele", "gel", "gle", "gl")) { type <- match_param(type) if (any(left > right, na.rm = TRUE)) { - warning(cond_between_more_lr()) + warning(between_more_lr()) } switch( type, gele = x >= left & x <= right, - gel = x >= left & x < right, - gle = x > left & x <= right, - gl = x > left & x < right + gel = x >= left & x < right, + gle = x > left & x <= right, + gl = x > left & x < right ) } @@ -58,10 +58,10 @@ between_more <- function(x, left, right, type = c("gele", "gel", "gle", "gl")) { #' @export #' @param bounds Boundaries for comparisons of `left` and `right` (see details) within <- function( - x, - left = NULL, - right = NULL, - bounds = c("[]", "[)", "(]", "()") + x, + left = NULL, + right = NULL, + bounds = c("[]", "[)", "(]", "()") ) { left_null <- is.null(left) right_null <- is.null(right) @@ -71,7 +71,7 @@ within <- function( } if (any(left > right, na.rm = TRUE)) { - warning(cond_within_lr()) + warning(within_lr()) } funs <- switch( @@ -99,18 +99,12 @@ within <- function( # conditions -------------------------------------------------------------- -cond_between_more_lr <- function() { - new_condition( - "`left` > `right`", - "between_more_lr", - type = "warning" - ) -} +between_more_lr := condition( + "`left` > `right`", + type = "warning" +) -cond_within_lr <- function() { - new_condition( - "`left` > `right`", - "within_lr", - type = "warning" - ) -} +with_lr := condition( + "`left` > `right`", + type = "warning" +) From bffaa051fa5d78b9c30c62ee925b48551a90e844 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Fri, 28 Nov 2025 00:00:34 -0500 Subject: [PATCH 050/169] typos (#259) --- R/within.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/within.R b/R/within.R index 564c574d..85d778ea 100644 --- a/R/within.R +++ b/R/within.R @@ -29,7 +29,7 @@ #' within(2:10, bounds = "(]") #' within(1:5, c(3, 3, 2, 2, 1), 5) #' @name within -#' @aliases between betwee_more +#' @aliases between between_more NULL # TODO consider deprecating `between_more()` in favor of `within()`` @@ -104,7 +104,7 @@ between_more_lr := condition( type = "warning" ) -with_lr := condition( +within_lr := condition( "`left` > `right`", type = "warning" ) From 593d87655e68b6b6a4d73091e4146a258f9a09d7 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Fri, 28 Nov 2025 00:00:37 -0500 Subject: [PATCH 051/169] updates tests (#259) --- tests/testthat/test-within.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test-within.R b/tests/testthat/test-within.R index db9d8dbc..dc1856d2 100644 --- a/tests/testthat/test-within.R +++ b/tests/testthat/test-within.R @@ -6,14 +6,14 @@ test_that("Examples are accurate", { test_that("between_more() works", { x <- 1:20 gele <- x >= 5 & x <= 10 - gel <- x >= 5 & x < 10 - gle <- x > 5 & x <= 10 - gl <- x > 5 & x < 10 + gel <- x >= 5 & x < 10 + gle <- x > 5 & x <= 10 + gl <- x > 5 & x < 10 expect_equal(between_more(x, 5, 10, "gele"), gele) - expect_equal(between_more(x, 5, 10, "gel"), gel) - expect_equal(between_more(x, 5, 10, "gle"), gle) - expect_equal(between_more(x, 5, 10, "gl"), gl) + expect_equal(between_more(x, 5, 10, "gel"), gel) + expect_equal(between_more(x, 5, 10, "gle"), gle) + expect_equal(between_more(x, 5, 10, "gl"), gl) # vectors for left or right @@ -33,7 +33,7 @@ test_that("between_more() works", { expect_warning( between_more(1:2, 3, 2), "`left` > `right`", - class = "betweenMoreLrWarning" + class = "mark:between_more_lr" ) }) @@ -41,9 +41,9 @@ test_that("between_more() works", { test_that("within()", { x <- 1:20 ss <- x >= 5 & x <= 10 - sr <- x >= 5 & x < 10 - rs <- x > 5 & x <= 10 - rr <- x > 5 & x < 10 + sr <- x >= 5 & x < 10 + rs <- x > 5 & x <= 10 + rr <- x > 5 & x < 10 expect_equal(within(x, 5, 10, "[]"), ss) expect_equal(within(x, 5, 10, "[)"), sr) @@ -70,6 +70,6 @@ test_that("within()", { expect_warning( within(1:2, 3, 2), "`left` > `right`", - class = "withinLrWarning" + class = "mark:within_lr" ) }) From d8acdf0bcccd1d8eee6d2756e2d9eeca9786c0ec Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 29 Nov 2025 20:15:19 -0500 Subject: [PATCH 052/169] updates conditions for sourcing (#259) --- R/sourcing.R | 132 +++++++++++++++++++-------------- tests/testthat/test-names.R | 2 +- tests/testthat/test-sourcing.R | 2 +- 3 files changed, 77 insertions(+), 59 deletions(-) diff --git a/R/sourcing.R b/R/sourcing.R index f20b29a6..d101ce12 100644 --- a/R/sourcing.R +++ b/R/sourcing.R @@ -45,7 +45,8 @@ try_source <- function(file, cd = FALSE, ...) { }, simpleWarning = function(e) { warning(e, call. = FALSE) - }) + } + ) } #' @rdname sourcing @@ -58,7 +59,8 @@ try_ksource <- function(file, ...) { }, simpleWarning = function(e) { warning(e, call. = FALSE) - }) + } + ) } # nolint start: commented_code_linter. @@ -105,14 +107,14 @@ try_ksource <- function(file, ...) { eval_named_chunk <- function(rmd_file, label_name) { if (!grepl("\\.[Rr][Mm][Dd]$", rmd_file)) { - stop(cond_eval_named_chunk_rmd()) + stop(source_error("rmd")) } lines <- readLines(rmd_file) label_line <- grep(paste0("\\{r ", label_name), lines)[1] if (is.na(label_line)) { - stop(cond_eval_named_chunk_label()) + stop(source_error("chunk")) } lines <- lines[(label_line + 1):length(lines)] @@ -145,7 +147,7 @@ source_r_dir <- function(dir, echo = FALSE, quiet = FALSE, ...) { #' @inheritParams source_files source_r_file <- function(path, echo = FALSE, quiet = FALSE, ...) { if (!grepl("\\.[rR]$", path)) { - stop(cond_source_r_file_r()) + stop(source_error("file")) } stopifnot(is_file(path)) @@ -161,7 +163,8 @@ source_r_file <- function(path, echo = FALSE, quiet = FALSE, ...) { if (!quiet) { message( - sprintf("Successfully sourced: %s [%s]", + sprintf( + "Successfully sourced: %s [%s]", basename(path), round(st[["elapsed"]], 2) ) @@ -188,9 +191,9 @@ source_r_file <- function(path, echo = FALSE, quiet = FALSE, ...) { #' @export source_to_env <- function(x, ops = NULL) { rds_file <- mark_temp("Rds") - r_temp <- mark_temp("R") - std_out <- mark_temp("md") - std_err <- mark_temp("md") + r_temp <- mark_temp("R") + std_out <- mark_temp("md") + std_err <- mark_temp("md") file.copy(x, r_temp) @@ -204,20 +207,26 @@ source_to_env <- function(x, ops = NULL) { rscript(r_temp, ops, wait = TRUE, stdout = std_out, stderr = std_err) if (!is_file(rds_file)) { - stop(cond_source_to_env_fail( - file = rds_file, - err = std_err, - out = std_out + stop(source_error( + "source", + list( + file = rds_file, + err = std_err, + out = std_out + ) )) } con <- file(rds_file) res <- readRDS(con) - on.exit({ - close(con) - file.remove(r_temp, rds_file, std_out, std_err) - }, add = TRUE) + on.exit( + { + close(con) + file.remove(r_temp, rds_file, std_out, std_err) + }, + add = TRUE + ) invisible(res) } @@ -241,7 +250,8 @@ rscript <- function(x, ops = NULL, args = NULL, ...) { } rs <- file_path( - R.home("bin"), if (is_windows()) "Rscript.exe" else "Rscript", + R.home("bin"), + if (is_windows()) "Rscript.exe" else "Rscript", check = TRUE ) @@ -260,9 +270,9 @@ rscript <- function(x, ops = NULL, args = NULL, ...) { #' #' @export save_source <- function( - env = parent.frame(), - file = mark_temp("Rds"), - name = NULL + env = parent.frame(), + file = mark_temp("Rds"), + name = NULL ) { ls <- ls(envir = env, all.name = TRUE) out <- lapply(ls, get, envir = env) @@ -270,17 +280,16 @@ save_source <- function( res <- struct( list2env(out, parent = baseenv()), - class = c("source_env", "environment"), + class = c("source_env", "environment"), sessionInfo = utils::sessionInfo(), - search = search(), - options = options(), - file = file, - env = env, - name = name %||% file_name(file) + search = search(), + options = options(), + file = file, + env = env, + name = name %||% file_name(file) ) if (!is.null(file)) { - if (!is_dir(dirname(file))) { dir.create(dirname(file), recursive = TRUE) } @@ -297,8 +306,14 @@ save_source <- function( print.source_env <- function(x, ...) { a <- attributes(x) cat( - "<", crayon_green("sourced env: "), a$name, ">\n", - "<", crayon_green("parent env: "), environmentName(a$env), ">\n", + "<", + crayon_green("sourced env: "), + a$name, + ">\n", + "<", + crayon_green("parent env: "), + environmentName(a$env), + ">\n", sep = "" ) invisible(x) @@ -306,34 +321,37 @@ print.source_env <- function(x, ...) { # conditions -------------------------------------------------------------- -cond_eval_named_chunk_rmd <- function() { - new_condition( - "rmd_file does not appear to be an rmd file", - "eval_named_chunk_rmd" - ) -} - -cond_eval_named_chunk_label <- function() { - new_condition("label not found in .Rmd file", "eval_named_chunk_label") -} - -cond_source_r_file_r <- function() { - new_condition("Must be a .R file", "source_r_file_r") -} - -cond_source_to_env_fail <- function(file, err, out) { - msg <- paste0( - "RDS file not succesfully saved here:\n ", file, - "\n", - "\nRscript stderr:\n", - collapse0(readLines(err), sep = "\n"), - "\n", - "\nRscript stdout:\n", - collapse0(readLines(out), sep = "\n"), - "\n" +source_error := condition( + function(x, params = NULL) { + switch( + x, + rmd = "rmd_file does not appear to be an rmd file", + label = "label not found in .Rmd file", + file = "Must be a .R file", + source = paste0( + "RDS file not succesfully saved here:\n ", + params$file, + "\n", + "\nRscript stderr:\n", + collapse0(readLines(params$err), sep = "\n"), + "\n", + "\nRscript stdout:\n", + collapse0(readLines(params$out), sep = "\n"), + "\n" + ), + stop("something went wrong; bad input: ", x) + ) + }, + type = "error", + package = "mark", + exports = c( + "source_r_dir", + "source_r_file", + "source_to_env", + "eval_named_chunk" ) - new_condition(msg, "source_to_env_fail") -} + # TODO include help +) # globalVariables --------------------------------------------------------- diff --git a/tests/testthat/test-names.R b/tests/testthat/test-names.R index 122a4748..237c6419 100644 --- a/tests/testthat/test-names.R +++ b/tests/testthat/test-names.R @@ -28,7 +28,7 @@ test_that("names_sort() works", { set_names(rep(NA, 3), c(-1, 2, 10)) ) - expect_error(sort_names(list(a = 1)), class = "sortByAtomicError") + expect_error(sort_names(list(a = 1)), class = "mark:sort_by_atomic") expect_error(sort_names(NA), class = "simpleError") }) diff --git a/tests/testthat/test-sourcing.R b/tests/testthat/test-sourcing.R index 16a8b344..2370722e 100644 --- a/tests/testthat/test-sourcing.R +++ b/tests/testthat/test-sourcing.R @@ -24,7 +24,7 @@ test_that("eval_named_chunk()", { ) file.remove(temp_rmd) - expect_error(eval_named_chunk(tempfile()), class = "evalNamedChunkRmdError") + expect_error(eval_named_chunk(tempfile()), class = "mark:source_error") file <- tempfile(fileext = ".Rmd") file.create(file) expect_error(eval_named_chunk(file), "\"label_name\" is missing") From b77cd2b97ea84d54cadf4170a4a7092febb45d45 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 29 Nov 2025 20:27:55 -0500 Subject: [PATCH 053/169] updates condition for utils (#259) --- R/utils.R | 86 ++++++++++++++++----------- air.toml | 14 +++++ tests/testthat/test-nas.R | 4 +- tests/testthat/test-percentile-rank.R | 2 +- 4 files changed, 67 insertions(+), 39 deletions(-) create mode 100644 air.toml diff --git a/R/utils.R b/R/utils.R index 83163099..1f55f754 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,9 +1,10 @@ - which0 <- function(x) { which(x) %len% 0L } + # isTRUE, isFALSE, ... -isNA <- function(x) { # nolint: object_name_linter. +# nolint next: object_name_linter. +isNA <- function(x) { is.logical(x) && length(x) == 1L && is.na(x) } @@ -47,7 +48,8 @@ print_no_attr <- function(x, ...) { #' #' @export #' @seealso [base::which()] -that <- function(x, arr.ind = FALSE, useNames = TRUE) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter. +that <- function(x, arr.ind = FALSE, useNames = TRUE) { # TODO consider that() as #seq_along(x)[x]? which(x, arr.ind = arr.ind, useNames = useNames) } @@ -92,11 +94,17 @@ is_atomic0 <- function(x) { is.atomic(x) && !is.null(x) } -# nolint start: brace_linter. -cat0 <- function(...) { cat(..., sep = "") } -catln <- function(...) { cat(..., sep = "\n") } -charexpr <- function(x) { as.character(as.expression(x)) } -# nolint end: brace_linter. +cat0 <- function(...) { + cat(..., sep = "") +} + +catln <- function(...) { + cat(..., sep = "\n") +} + +charexpr <- function(x) { + as.character(as.expression(x)) +} mark_temp <- function(ext = "") { if (!grepl("^[.]", ext) && !identical(ext, "") && !is.na(ext)) { @@ -116,23 +124,20 @@ mark_temp <- function(ext = "") { check_is_vector <- function(x, mode = "any") { if ( isS4(x) || - inherits(x, c("data.frame", "matrix", "array")) || - !is.vector(remove_attributes(x), mode) + inherits(x, c("data.frame", "matrix", "array")) || + !is.vector(remove_attributes(x), mode) ) { x <- deparse1(substitute(x)) - stop(cond_check_is_vector_mode(x, mode)) + stop(vector_required(x, mode)) } invisible() } -cond_check_is_vector_mode <- function(x, mode) { - new_condition( - paste(x, "must be a vector of mode", mode), - "check_is_vector_mode" - ) -} - +vector_required := condition( + function(x, mode) paste(x, "must be a vector of mode", mode), + type = "error" +) add_attributes <- function(x, ...) { attributes(x) <- c(attributes(x), rlang::list2(...)) @@ -178,15 +183,19 @@ check_interactive <- function() { return(FALSE) } - stop(cond_check_interactive()) + stop(options_error("interactive")) } -cond_check_interactive <- function() { - new_condition( - "mark.check_interactive must be TRUE, FALSE, or NA", - "check_interactive" - ) -} +options_error := condition( + function(x) { + switch( + x, + interaction = "mark.check_interactive must be TRUE, FALSE, or NA", + stop("something went wrong, bad value: ", x) + ) + }, + type = "error" +) try_formats <- function(date = FALSE) { x <- c( @@ -220,19 +229,24 @@ dupe_check <- function(x, n = getOption("mark.dupe.n", 5)) { dupes <- utils::head(dupes, n) if (n_dupes) { - stop(cond_dupe_check(x, dupes, n_dupes, n)) + stop(duplicate_error(x, dupes, n_dupes, n)) } invisible(NULL) } -cond_dupe_check <- function(x, dupes, n_dupes, n) { - msg <- paste0( - "Duplicate values found in ", n_dupes, " location(s) :\n", - if (n_dupes > n) sprintf("(first %i)\n", n), - paste0(" > ", sprintf("[%s] %s", format(dupes), format(x[dupes])), "\n"), - if (n_dupes > n) "... and ", n_dupes - n, " more" - ) - - new_condition(msg, "dupe_check") -} +duplicate_error := condition( + function(x, dupes, n_dupes, n) { + paste0( + "Duplicate values found in ", + n_dupes, + " location(s) :\n", + if (n_dupes > n) sprintf("(first %i)\n", n), + paste0(" > ", sprintf("[%s] %s", format(dupes), format(x[dupes])), "\n"), + if (n_dupes > n) "... and ", + n_dupes - n, + " more" + ) + }, + type = "error" +) diff --git a/air.toml b/air.toml new file mode 100644 index 00000000..76e090fc --- /dev/null +++ b/air.toml @@ -0,0 +1,14 @@ +line-width = 80 +indent-width = 2 +indent-style = "space" +line-ending = "lf" +persistent-line-breaks = true +exclude = [] +default-exclude = true +skip = [ + "crayon_blue", + "crayon_green", + "crayon_cyan", +] +table = [] +default-table = true diff --git a/tests/testthat/test-nas.R b/tests/testthat/test-nas.R index 81ee60ab..a7003d0b 100644 --- a/tests/testthat/test-nas.R +++ b/tests/testthat/test-nas.R @@ -2,7 +2,7 @@ test_that("remove_na()", { x <- c(1, 2, NA, 3, NaN) expect_equal(remove_na(x), c(1, 2, 3)) expect_equal(remove_na(as.list(x)), list(1, 2, numeric(), 3, numeric())) - expect_error(remove_na(quick_dfl(x = 1)), class = "checkIsVectorModeError") + expect_error(remove_na(quick_dfl(x = 1)), class = "mark:vector_required") res <- remove_na(fact(x)) exp <- struct( @@ -50,7 +50,7 @@ test_that("*_na_cols() works", { expect_equal( is_na_cols(x), c(first = FALSE, second = FALSE, all = TRUE, last = FALSE, all2 = TRUE) - ) + ) expect_error(select_na_cols(1), class = "simpleError") expect_error(remove_na_cols(1), class = "simpleError") diff --git a/tests/testthat/test-percentile-rank.R b/tests/testthat/test-percentile-rank.R index a4cb29fa..4fa28774 100644 --- a/tests/testthat/test-percentile-rank.R +++ b/tests/testthat/test-percentile-rank.R @@ -15,5 +15,5 @@ test_that("percentile_rank() works", { test_that("percentile_rank_weighted() handles decimals [92]", { x <- c(1, 3.120000000001, 3.120000000001, 4) w <- 1:4 - expect_error(percentile_rank(x, w), class = "dupeCheckError") + expect_error(percentile_rank(x, w), class = "mark:duplicate_error") }) From b2c66e1ea18309f423ad56494b222ee045a3f395 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 29 Nov 2025 20:31:54 -0500 Subject: [PATCH 054/169] updates conditions for todos (#259) --- R/todos.R | 20 ++++++++++++-------- man/reexports.Rd | 2 +- man/within.Rd | 1 - tests/testthat/test-todos.R | 4 ++-- 4 files changed, 15 insertions(+), 12 deletions(-) diff --git a/R/todos.R b/R/todos.R index 5f2d4c79..3a66aacf 100644 --- a/R/todos.R +++ b/R/todos.R @@ -98,7 +98,7 @@ do_todo <- function( length(path) != 1 || !is.character(path) ) { - stop(cond_do_todo_path()) + stop(todo_error("path")) } stopifnot(fs::file_exists(path)) @@ -250,10 +250,14 @@ string_dots <- function(x, width = getOption("width")) { # conditions -------------------------------------------------------------- -cond_do_todo_path <- function() { - new_condition("path must be a character vector of length 1L", "do_todo_path") -} - -cond_do_todo_path_r <- function() { - new_condition("path is not a .R or .Rmd file", "do_todo_path_r") -} +todo_error := condition( + function(x) { + switch( + x, + path = "path must be a character vector of length 1L", + stop("something went wrong") + ) + }, + type = "error", + exports = c("todos", "fixmes") +) diff --git a/man/reexports.Rd b/man/reexports.Rd index eb1029f6..e31cd8b3 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} diff --git a/man/within.Rd b/man/within.Rd index 002edd27..836784d2 100644 --- a/man/within.Rd +++ b/man/within.Rd @@ -3,7 +3,6 @@ \name{within} \alias{within} \alias{between} -\alias{betwee_more} \alias{between_more} \title{within boundaries} \usage{ diff --git a/tests/testthat/test-todos.R b/tests/testthat/test-todos.R index 4ce4ae69..fbfb2ba3 100644 --- a/tests/testthat/test-todos.R +++ b/tests/testthat/test-todos.R @@ -63,8 +63,8 @@ test_that("todos() errors and messages", { path <- test_path("scripts") err <- "path must be a character vector of length 1L" - expect_error(todos(path = 1), class = "doTodoPathError") - expect_error(todos(path = c("a", "b")), class = "doTodoPathError") + expect_error(todos(path = 1), class = "mark:todo_error") + expect_error(todos(path = c("a", "b")), class = "mark:todo_error") expect_error(todos(path = "zzz")) expect_error(do_todo(c("todo", "fixme"), path = "."), NA) From 6151c1e37e02bb0c4dd2a37c03026b0a683ff521 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 29 Nov 2025 20:39:54 -0500 Subject: [PATCH 055/169] updates conditions for switch (#259) --- R/switch.R | 77 +++++++++++++++++------------------------------------- 1 file changed, 24 insertions(+), 53 deletions(-) diff --git a/R/switch.R b/R/switch.R index 87aae98f..e7db4b3d 100644 --- a/R/switch.R +++ b/R/switch.R @@ -128,20 +128,20 @@ switch_in_case <- function(x, ..., .default = NULL, .envir = parent.frame()) { cres <- as.character(res) if (cres[1L] == ":") { if (!exists("xrange")) { - stop(cond_switch_in_case_numeric()) + stop(switch_error("numeric")) } cres[cres == "-Inf"] <- xrange[1L] cres[cres == "Inf"] <- xrange[2L] if (any(cres %in% c("-Inf", "inf"))) { - stop(cond_switch_in_case_ambiguous()) + stop(switch_error("ambiguous_infinity")) } } tryCatch( do.call(cres[1L], as.list(cres[-1L])), error = function(e) { - stop(cond_switch_in_case_evaluate(e$message)) + stop(switch_error("evaluate", e$message)) } ) }) @@ -233,7 +233,7 @@ switch_length_check <- function(ls) { return(ls), { if (u[1L] == 0L) { - stop(cond_switch_length_check_0()) + stop(switch_error("lengths_check_0")) } if (u[1L] == 1L) { @@ -245,11 +245,11 @@ switch_length_check <- function(ls) { return(ls) } - stop(cond_switch_length_check_2()) + stop(switch_error("lengths_check_2")) }, - stop(cond_switch_length_check_3()) + stop(switch_error("lengths_check_3")), ) - stop(cond_switch_length_check_bad()) + stop(switch_error("lengths_check_bad")) } switch_lengths_check <- function(lhs, rhs) { @@ -261,7 +261,7 @@ switch_lengths_check <- function(lhs, rhs) { } if (!identical(llens, rlens)) { - stop(cond_switch_lengths_check()) + stop(switch_errors("lengths_check")) } invisible(NULL) @@ -269,48 +269,19 @@ switch_lengths_check <- function(lhs, rhs) { # conditions -------------------------------------------------------------- -cond_switch_in_case_numeric <- function() { - new_condition( - "x did not appear to be numeric, cannot continue evaluating lhs", - "switch_in_case_numeric" - ) -} - -cond_switch_in_case_ambiguous <- function() { - new_condition( - "Ambiguous infinity, cannot calculate", - "switch_in_case_ambiguous" - ) -} - -cond_switch_in_case_evaluate <- function(x) { - new_condition( - paste0("Could not evaluate lhs\n", x), - "switch_in_case_evaluate" - ) -} - -cond_switch_lengths_check <- function() { - new_condition("statements have different lengths", "switch_lengths_check") -} - -cond_switch_length_check_0 <- function() { - new_condition("Cannot have 0 length rhs", "switch_length_check_0") -} - -cond_switch_length_check_2 <- function() { - new_condition( - "2 lengths found, one of which was not 1", - "switch_length_check_1" - ) -} - -cond_switch_length_check_3 <- function() { - new_condition("3 or more lengths found, stopping", "switch_length_check_3") -} - -cond_switch_length_check_bad <- function() { - new_condition("Something really went wrong", "switch_length_check_bad") -} - -# terminal line +switch_error := condition( + function(x, params = NULL) { + switch( + x, + numeric = "x did not appear to be numeric, cannot continue evaluating lhs", + ambiguous_infinity = "Ambiguous infinity, cannot calculate", + evaluate = paste0("Could not evaluate lhs\n", params), + lengths_check = "statements have different lengths", + lengths_check_0 = "Cannot have 0 length rhs", + lengths_check_2 = "2 lengths found, one of which was not 1", + lengths_check_3 = "3 or more lengths found, stopping", + lengths_check_bad = "Something really went wrong; please submit an issue at https://github.com/jmbarbone/mark/issues", + stop("something went wrong, bad input: ", x) + ) + } +) From 1c49db2a8ab326a3b0255c74f29b0299bfc2949c Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 7 Dec 2025 23:29:35 -0500 Subject: [PATCH 056/169] adds generic package errors (#259) --- R/aaa.R | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/R/aaa.R b/R/aaa.R index 02468c07..1621bd8f 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -22,3 +22,49 @@ walrus <- function(sym, val) { # either side, making it a more flexible alternative to =. It is used in # data.table for similar reasons. `:=` <- `%:=%` <- walrus + + +# standard conditions ----------------------------------------------------- + +input_error := condition( + function(x) collapse(x), + type = "error", + help = "Generic error to indicate a bad input value." +) + +type_error := condition( + function(expected, actual, object) { + sprintf( + ngettext( + length(actual), + "Expected %stype '%s' but got type '%s'", + "Expected %stype '%s' but got types '%s'" + ), + if (missing(object)) "" else sprintf("object '%s' to be ", object), + expected, + collapse(actual, sep = "', '") + ) + }, + type = "error", + help = "Generic error to indicate a type mismatch." +) + +conversion_error := condition( + function(x) collapse(x), + type = "error", + help = "Generic error to indicate a conversion failure." +) + +internal_error := condition( + function(x) c( + collapse(x), + "\nThis is an internal `{mark}` error. If you encounter this, please", + " report an issue at " + ), + type = "error", + help = c( + "Generic error to capture internal `{mark}` errors. If any of these are", + " encountered, please report an issue at", + " " + ) +) From e3e710b08186111b1668731a048368feb58df9b0 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 7 Dec 2025 23:29:51 -0500 Subject: [PATCH 057/169] replaces array condition with input error (#259) --- R/array.R | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/R/array.R b/R/array.R index 3d1964bb..757e6283 100644 --- a/R/array.R +++ b/R/array.R @@ -22,7 +22,7 @@ array_extract <- function(.arr, ..., default = "1") { nm <- wuffle(as.integer(names(ls) %||% seq_along(ls))) if (anyNA(nm)) { - stop(array_extract_names()) + stop(input_error("... must be fully named by integers or have no names")) } ds <- dim(.arr) @@ -51,13 +51,3 @@ array_extract <- function(.arr, ..., default = "1") { eval(str2expression(text), envir = parent.frame()) } - -# conditions -------------------------------------------------------------- - -array_extract_names := condition( - type = "error", - message = "... must be fully named by integers or have no names", - package = "mark", - exports = "array_extract" -) - From a44f0f568244658142cc1b3f51c82b2301da0d2e Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 7 Dec 2025 23:30:08 -0500 Subject: [PATCH 058/169] uses single base conversion error (#259) --- R/base-conversion.R | 83 ++++++++++++++++----------------------------- 1 file changed, 29 insertions(+), 54 deletions(-) diff --git a/R/base-conversion.R b/R/base-conversion.R index cd6a5120..e5aa0486 100644 --- a/R/base-conversion.R +++ b/R/base-conversion.R @@ -30,7 +30,7 @@ base_alpha_single <- function(x, base) { a <- match(a, letters[1:base], nomatch = NA_integer_) if (anyNA(a)) { - stop(base_alpha_limit(base, x)) + stop(base_conversion_error("alpha_limit", base = base, x = x)) } n <- length(a) @@ -62,7 +62,7 @@ base_n <- function(x, from = 10, to = 10) { } if (to != 10) { - stop(base_n_ten()) + stop(base_conversion_error("ten")) } check_base(from) @@ -73,7 +73,7 @@ base_n_single <- function(x, base) { ints <- as.integer(chr_split(x)) if (any(ints >= base, na.rm = TRUE)) { - stop(base_n_single_limit(base, x)) + stop(base_conversion_error("single_limit", base = base, x = x)) } seqs <- (length(ints) - 1L):0L @@ -85,7 +85,7 @@ check_base_alpha <- function(b, high = 26) { b <- chr_split(b) if (length(b) != 1) { - stop(base_alpha_length()) + stop(base_conversion_error("alpha_length")) } b <- match(tolower(b), letters) @@ -96,68 +96,43 @@ check_base_alpha <- function(b, high = 26) { check_base <- function(b, high = 9) { if (b %% 1 != 0) { - stop(base_integer()) + stop(base_conversion_error("integer")) } if (b > high || b <= 1) { - stop(base_limit(high)) + stop(base_conversion_error("limit", high = high)) } } # conditions -------------------------------------------------------------- -base_alpha_limit := condition( - type = "error", - message = function(base, x) { - sprintf( - 'Cannot calculate alpha base "%s" for "%s" which has letters beyond "%s"', - base, - x, - x[base] - ) - }, - exports = "base_alpha" -) - - -base_n_ten := condition( - type = "error", - message = "base_n() is currently only valid for conversions to base 10", - exports = "base_n" -) - -base_n_single_limit := condition( - type = "error", - message = function(base, x) { - sprintf( - paste0( - "Cannot caluclate base \"%s\" for \"%s\" which has numbers greater", - " than or equal to the base value" +base_conversion_error := condition( + function(type, base, x, high) { + switch( + type, + alpha_limit = sprintf( + 'Cannot calculate alpha base "%s" for "%s" which has letters beyond "%s"', + base, + x, + x[base] + ), + ten = "base_n() is currently only valid for conversions to base 10", + single_limit = sprintf( + paste0( + "Cannot caluclate base \"%s\" for \"%s\" which has numbers greater", + " than or equal to the base value" + ), + base, + x ), - base, x + alpha_length = "base must be of length 1", + integer = "base must be an integer", + limit = sprintf("base must be between 1 and %s", high), + stop(internal_error(c("Unknown base conversion error type: ", type))) ) }, - exports = "base_n" -) - -base_alpha_length := condition( - type = "error", - message = "base must be of length 1", - exports = "base_alpha" -) - -base_integer := condition( type = "error", - message = "base must be an integer", exports = c("base_alpha", "base_n") + # TODO include help ) - -base_limit := condition( - type = "error", - message = function(high) { - sprintf("base must be between 1 and %s", high) - }, - exports = c("base_alpha", "base_n") -) - From 4372b47a30c302a2296ab9e4a2049ec30e8ea90d Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 7 Dec 2025 23:30:15 -0500 Subject: [PATCH 059/169] uses single bib error (#259) --- R/bib.R | 46 +++++++++++++++++++--------------------------- 1 file changed, 19 insertions(+), 27 deletions(-) diff --git a/R/bib.R b/R/bib.R index dc9fd1f2..e256cd41 100644 --- a/R/bib.R +++ b/R/bib.R @@ -70,7 +70,7 @@ read_bib <- function(file, skip = 0L, max_lines = NULL, encoding = "UTF-8") { from <- grep("[@]", bib) if (!length(from)) { - stop(read_bib_entries()) + stop(bib_error("no_entries")) } # shift over (may contain white space?) @@ -160,7 +160,7 @@ process_bib_dataframe <- function(categories, values, fields, keys) { bad <- lens > 1L if (any(bad)) { - stop(process_bib_dataframe_dupe(key, names(lens)[bad])) + stop(bib_error("duplicate_categories", key, names(lens)[bad])) } # Append vectors @@ -214,7 +214,7 @@ process_bib_list <- function(keys, fields, categories, values) { as_bib_list <- function(x, names = NULL) { if (!is.list(x)) { - stop(as_bib_list_class()) + stop(type_error("list", class(x), "x")) } class(x) <- c("list", "mark_bib_list") @@ -223,7 +223,7 @@ as_bib_list <- function(x, names = NULL) { as_bib <- function(x, bib_list = NULL) { if (!is.data.frame(x)) { - stop(as_bib_class()) + stop(type_error("data.frame", class(x), "x")) } class(x) <- c("mark_bib_df", "data.frame") @@ -304,32 +304,24 @@ print.mark_bib_df <- function(x, list = FALSE, ...) { # conditions -------------------------------------------------------------- -read_bib_entries := condition( - type = "error", - message = "No entries detected", - exports = "read_bib" -) - -process_bib_dataframe_dupe := condition( - type = "error", - message = function(key, categories) { - sprintf( - "The key `%s` has duplicate categories of `%s`", - key, - categories +bib_error := condition( + function(type, key, categories) { + switch( + type, + no_entries = "No entries detected in bib file", + duplicate_categories = sprintf( + "The key `%s` has duplicate categories of `%s`", + key, + categories + ), + stop(internal_error(c( + "Unknown error error type: ", + type + ))) ) }, - exports = "read_bib" -) - -as_bib_list_class := condition( type = "error", - message = "`x` must be a list", exports = "read_bib" + # TODO include help ) -as_bib_class := condition( - type = "error", - message = "`x` must be a data.frame", - exports = "read_bib" -) From 2736d45b921ecce00eb2dc83a94bb454a44cd394 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 7 Dec 2025 23:30:34 -0500 Subject: [PATCH 060/169] uses internal errors for switches (#259) --- R/switch.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/switch.R b/R/switch.R index e7db4b3d..1a85ea38 100644 --- a/R/switch.R +++ b/R/switch.R @@ -249,7 +249,7 @@ switch_length_check <- function(ls) { }, stop(switch_error("lengths_check_3")), ) - stop(switch_error("lengths_check_bad")) + stop(internal_error("Unexpected lengths found")) } switch_lengths_check <- function(lhs, rhs) { @@ -261,7 +261,7 @@ switch_lengths_check <- function(lhs, rhs) { } if (!identical(llens, rlens)) { - stop(switch_errors("lengths_check")) + stop(switch_error("lengths_check")) } invisible(NULL) @@ -280,8 +280,7 @@ switch_error := condition( lengths_check_0 = "Cannot have 0 length rhs", lengths_check_2 = "2 lengths found, one of which was not 1", lengths_check_3 = "3 or more lengths found, stopping", - lengths_check_bad = "Something really went wrong; please submit an issue at https://github.com/jmbarbone/mark/issues", - stop("something went wrong, bad input: ", x) + stop(internal_error(c("Unexpected switch_error(type): ", x))), ) } ) From 3d4036511897fb9ec6f38f6c67ec0c8c45238ec6 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Dec 2025 13:03:42 -0500 Subject: [PATCH 061/169] makes array_extract() deprecated (#259) --- R/array.R | 7 +++++++ tests/testthat/helper.R | 4 ++++ tests/testthat/test-array.R | 26 ++++++++++++++++++-------- 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/R/array.R b/R/array.R index 757e6283..335cfb41 100644 --- a/R/array.R +++ b/R/array.R @@ -16,6 +16,13 @@ #' array_extract(x, `2` = 2, `3` = 3) array_extract <- function(.arr, ..., default = "1") { + # what was even the point of this? + .Deprecated( + msg = c( + "`array_extract()` is deprecated.", + " Please use standard R array indexing instead, e.g., `arr[1, 2, 3]`." + ) + ) stopifnot(is.array(.arr)) ls <- rlang::list2(...) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 800f81dc..04f1f943 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -55,3 +55,7 @@ simple_tbl <- function(delim) { sep = "\n" ) } + +expect_deprecated <- function(expr) { + expect_warning(expr, class = "deprecatedWarning") +} diff --git a/tests/testthat/test-array.R b/tests/testthat/test-array.R index 3c9a01fd..2c5477de 100644 --- a/tests/testthat/test-array.R +++ b/tests/testthat/test-array.R @@ -1,22 +1,32 @@ test_that("array_extract() works", { x <- array(rep(NA, 27), dim = c(3, 3, 3)) x[1, 2, 3] <- TRUE - expect_true(array_extract(x, `2` = 2, `3` = 3)) + expect_deprecated(expect_true(array_extract(x, `2` = 2, `3` = 3))) val <- x - expect_true(array_extract(val, `2` = 2, `3` = 3)) + expect_deprecated(expect_true(array_extract(val, `2` = 2, `3` = 3))) x <- array(1:9, dim = c(3, 3)) dimnames(x) <- list(one = LETTERS[1:3], two = letters[1:3]) - expect_identical(array_extract(x, 1, 2), x[1, 2]) - expect_identical(array_extract(x, "A", "b"), array_extract(x, 1, 2)) + expect_deprecated(expect_identical(array_extract(x, 1, 2), x[1, 2])) + expect_deprecated(expect_deprecated( + expect_identical(array_extract(x, "A", "b"), array_extract(x, 1, 2)) + )) y <- fact(c("A", "b")) - expect_identical(array_extract(x, y[1], y[2]), array_extract(x, 1, 2)) + expect_deprecated(expect_deprecated( + expect_identical( + array_extract(x, y[1], y[2]), + array_extract(x, 1, 2) + ) + )) }) test_that("array_extract() errors", { x <- array(1:9, dim = c(3, 3)) - expect_error(array_extract(1), class = "simpleError") - expect_error(array_extract(x, 2, 3), NA) - expect_error(array_extract(x, a = 2, b = 3), class = "mark:array_extract_names") + expect_deprecated(expect_error(array_extract(1), class = "simpleError")) + expect_deprecated(array_extract(x, 2, 3)) + expect_deprecated(expect_error( + array_extract(x, a = 2, b = 3), + class = "mark:input_error" + )) }) From 51512aa304590fda6477ec3d109a13fc8b00df2c Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Dec 2025 13:31:49 -0500 Subject: [PATCH 062/169] removes linting, testing, coverage from array and time report (#259) --- .lintr | 4 +++- R/array.R | 4 ++++ R/time-report.R | 7 +++++-- tests/testthat/test-array.R | 32 ------------------------------- tests/testthat/test-time-report.R | 15 --------------- 5 files changed, 12 insertions(+), 50 deletions(-) delete mode 100644 tests/testthat/test-array.R delete mode 100644 tests/testthat/test-time-report.R diff --git a/.lintr b/.lintr index 76531459..a88f564b 100644 --- a/.lintr +++ b/.lintr @@ -3,5 +3,7 @@ linters: linters_with_defaults( ) encoding: "UTF-8" exclusions: list( - "tests/spelling.R" + "tests/spelling.R", + "R/array.R", + "R/time-report.R" ) diff --git a/R/array.R b/R/array.R index 335cfb41..5d9389ff 100644 --- a/R/array.R +++ b/R/array.R @@ -1,3 +1,5 @@ +# nocov start + #' Array extract #' #' Extract dimensions from an array @@ -58,3 +60,5 @@ array_extract <- function(.arr, ..., default = "1") { eval(str2expression(text), envir = parent.frame()) } + +# nocov end diff --git a/R/time-report.R b/R/time-report.R index 8c0ae230..d3de7ccc 100644 --- a/R/time-report.R +++ b/R/time-report.R @@ -1,3 +1,5 @@ +# nocov start + #' Time reports #' #' Evaluate code and report on the time difference @@ -25,7 +27,6 @@ #' }) #' @export -# nolint next: object_name_linter. simpleTimeReport <- function(title = NULL, expr, envir = parent.frame()) { mc <- match.call() cat0(trimws(title), "\n", rep("-", getOption("width")), "\n") @@ -137,7 +138,7 @@ simpleTimeReport <- function(title = NULL, expr, envir = parent.frame()) { #' @param threshold A threshold for reporting the difference, if `stop - start` #' is less than this, a empty character vector (`""`) is returned #' @noRd -formatTimeDiff <- function(start, stop = Sys.time(), threshold = .1) { # nolint: object_name_linter, line_length_linter. +formatTimeDiff <- function(start, stop = Sys.time(), threshold = .1) { difference <- stop - start threshold <- as.difftime(threshold, units = "secs") @@ -186,3 +187,5 @@ split_expression <- function(expr) { x <- strsplit(x, "\\s{0,}\n\\s{0,}")[[1]] str2expression(x) } + +# nocov end diff --git a/tests/testthat/test-array.R b/tests/testthat/test-array.R deleted file mode 100644 index 2c5477de..00000000 --- a/tests/testthat/test-array.R +++ /dev/null @@ -1,32 +0,0 @@ -test_that("array_extract() works", { - x <- array(rep(NA, 27), dim = c(3, 3, 3)) - x[1, 2, 3] <- TRUE - expect_deprecated(expect_true(array_extract(x, `2` = 2, `3` = 3))) - val <- x - expect_deprecated(expect_true(array_extract(val, `2` = 2, `3` = 3))) - - x <- array(1:9, dim = c(3, 3)) - dimnames(x) <- list(one = LETTERS[1:3], two = letters[1:3]) - - expect_deprecated(expect_identical(array_extract(x, 1, 2), x[1, 2])) - expect_deprecated(expect_deprecated( - expect_identical(array_extract(x, "A", "b"), array_extract(x, 1, 2)) - )) - y <- fact(c("A", "b")) - expect_deprecated(expect_deprecated( - expect_identical( - array_extract(x, y[1], y[2]), - array_extract(x, 1, 2) - ) - )) -}) - -test_that("array_extract() errors", { - x <- array(1:9, dim = c(3, 3)) - expect_deprecated(expect_error(array_extract(1), class = "simpleError")) - expect_deprecated(array_extract(x, 2, 3)) - expect_deprecated(expect_error( - array_extract(x, a = 2, b = 3), - class = "mark:input_error" - )) -}) diff --git a/tests/testthat/test-time-report.R b/tests/testthat/test-time-report.R deleted file mode 100644 index 941913b0..00000000 --- a/tests/testthat/test-time-report.R +++ /dev/null @@ -1,15 +0,0 @@ -test_that("simpleTimeReport() works", { - expect_error( - expect_warning( - simpleTimeReport("title goes here", { - 1 + 2 - foo_warn <- function() warning("this is a warning") - foo_msg <- function() message("this is a message") - foo_warn() - foo_msg() - cat("this is a cat\n") - quick_dfl(a = 1, b = 2) - }) - ), - NA) -}) From cf8f296868efb2fd0c7e7ebe7550e81588c164be Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Dec 2025 13:34:03 -0500 Subject: [PATCH 063/169] updates bib errors (#259) --- tests/testthat/test-bib.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-bib.R b/tests/testthat/test-bib.R index 41ddc3cd..d1903179 100644 --- a/tests/testthat/test-bib.R +++ b/tests/testthat/test-bib.R @@ -14,10 +14,10 @@ test_that("read_bib()", { temp <- tempfile() writeLines("bad", temp) - expect_error(read_bib(temp), class = "mark:read_bib_entries") + expect_error(read_bib(temp), class = "mark:bib_error") - expect_error(as_bib(1:3), "data.frame", class = "mark:as_bib_class") - expect_error(as_bib_list(1:3), "list", class = "mark:as_bib_list_class") + expect_error(as_bib(1:3), "data.frame", class = "mark:type_error") + expect_error(as_bib_list(1:3), "list", class = "mark:type_error") expect_error( process_bib_dataframe( @@ -26,7 +26,7 @@ test_that("read_bib()", { fields = "this", keys = "key" ), - class = "mark:process_bib_dataframe_dupe" + class = "mark:bib_error" ) }) From 20f72ff90173149da26ba22b7d0a23357f88cbba Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Dec 2025 13:34:15 -0500 Subject: [PATCH 064/169] suppresses outputs (#259) --- tests/testthat/test-environments.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-environments.R b/tests/testthat/test-environments.R index 2a17cf30..f2824ac0 100644 --- a/tests/testthat/test-environments.R +++ b/tests/testthat/test-environments.R @@ -25,7 +25,7 @@ test_that("environments() and friends works", { }) test_that("snapshots", { - expect_error(print(environments()), NA) + expect_output(expect_error(print(environments()), NA)) skip("not static") expect_snapshot(environments()) }) From c464d410596a9909cbd543a63f39ea6f459c8f61 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Dec 2025 13:34:55 -0500 Subject: [PATCH 065/169] updates errors (#259) --- tests/testthat/test-base-conversion.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-base-conversion.R b/tests/testthat/test-base-conversion.R index f3ced084..5ca34213 100644 --- a/tests/testthat/test-base-conversion.R +++ b/tests/testthat/test-base-conversion.R @@ -6,7 +6,7 @@ test_that("base_alpha() works as expected", { letter_vec <- paste_combine(c("", letters), letters, collate = TRUE) expect_equal(base_alpha(letter_vec), 1:702) - expect_error(base_alpha(letters[1:10], 9), class = "mark:base_alpha_limit") + expect_error(base_alpha(letters[1:10], 9), class = "mark:base_conversion_error") expect_warning(alpha_base(letters), "deprecated") expect_identical(base_alpha_single("a", 26), 1L) @@ -17,7 +17,7 @@ test_that("base_alpha() works as expected", { test_that("base_n() works as expected", { expect_equal(base_n(120, 9), 99) - expect_error(base_n(62, 2), class = "mark:base_n_single_limit") + expect_error(base_n(62, 2), class = "mark:base_conversion_error") x <- c(2L, 1L, 3L, 3L, 6L, 5L, 1L, 4L, 4L, 2L, 2L, 6L, 7L, 4L, 4L, 3L, 1L, 1L) expect_identical(base_n(x, 5, 5), x) @@ -26,14 +26,14 @@ test_that("base_n() works as expected", { test_that("base_alpha(), base_n() fails", { expect_error(base_alpha(1), class = "simpleError") expect_error(base_n("a"), class = "simpleError") - expect_error(base_n(1, 10, 12), class = "mark:base_n_ten") + expect_error(base_n(1, 10, 12), class = "mark:base_conversion_error") }) test_that("check_base(), check_base_alpha() works", { - expect_error(check_base(1.1), class = "mark:base_integer") - expect_error(check_base(-1, 9), class = "mark:base_limit") - expect_error(check_base(10, 9), class = "mark:base_limit") + expect_error(check_base(1.1), class = "mark:base_conversion_error") + expect_error(check_base(-1, 9), class = "mark:base_conversion_error") + expect_error(check_base(10, 9), class = "mark:base_conversion_error") expect_null(check_base_alpha("j")) - expect_error(check_base_alpha("ab"), class = "mark:base_alpha_length") + expect_error(check_base_alpha("ab"), class = "mark:base_conversion_error") }) From 46ee258481e083d6801bf312af9a116e44dbae89 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 27 Dec 2025 13:49:19 -0500 Subject: [PATCH 066/169] simplies capply() (#259) --- R/apply.R | 45 +++-------------------------------- R/strings.R | 5 ++-- tests/testthat/test-apply.R | 29 ---------------------- tests/testthat/test-strings.R | 2 +- 4 files changed, 7 insertions(+), 74 deletions(-) diff --git a/R/apply.R b/R/apply.R index 5b132479..b0ca3ac4 100644 --- a/R/apply.R +++ b/R/apply.R @@ -1,4 +1,5 @@ +# TODO these will be deprecated by fuj::vap # vaps -------------------------------------------------------------------- @@ -70,46 +71,6 @@ do_vap <- function(.x, .f, .value, ..., .nm) { vapply(X = .x, FUN = .f, FUN.VALUE = .value, ..., USE.NAMES = .nm) } -# This can take multiple elements, so can be a little dangerous -capply <- function(.x, .f, ..., .nm = FALSE) { - res <- do.call("c", lapply(X = .x, FUN = .f, ...)) - if (.nm) { - set_names(res, names(.x) %||% res) - } else { - remove_names(res) - } -} - -# A simplier implementation of sapply? -slapply <- function(x, fun, ..., .simplify = TRUE, .names = TRUE) { - res <- lapply(x, fun, ...) - - if (.simplify) { - res <- simplify2array(res, higher = FALSE) - } - - names(res) <- if (.names) { - if (is.null(nm <- names(x))) x else nm - } else { - NULL - } - - res -} - -if (FALSE) { - x <- 1:10 - y <- setNames(x, x) - lapply(x, sqrt) - lapply(y, sqrt) - sapply(x, sqrt) - sapply(y, sqrt) - sapply(y, sqrt, USE.NAMES = FALSE) - sapply(x, sqrt, USE.NAMES = TRUE) - sapply(y, sqrt, USE.NAMES = TRUE) - slapply(x, sqrt) - slapply(y, sqrt) - slapply(y, sqrt, .names = FALSE) - - lapply(setNames(nm = 1:10), sqrt) +capply <- function(x, f) { + do.call(base::c, lapply(x, f)) } diff --git a/R/strings.R b/R/strings.R index 207282b1..e7536dd9 100644 --- a/R/strings.R +++ b/R/strings.R @@ -100,10 +100,11 @@ str_extract_date <- function(x, format = "%Y-%m-%d") { str_extract_datetime <- function(x, format = "%Y-%m-%d %H%M%S") { frex <- format_to_regex(format) text <- string_extract(x, frex, ignore.case = TRUE) - capply(text, strptime, format = format, tz = "") + capply(text, function(x) strptime(x, format = format, tz = "")) } -string_extract <- function(x, pattern, perl = FALSE, ignore.case = FALSE) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter. +string_extract <- function(x, pattern, perl = FALSE, ignore.case = FALSE) { re <- regexpr(pattern, x, perl = perl, ignore.case = ignore.case) starts <- as.vector(re, "integer") substr(x, starts, starts + attr(re, "match.length") - 1L) diff --git a/tests/testthat/test-apply.R b/tests/testthat/test-apply.R index b87b5ad6..b35baecf 100644 --- a/tests/testthat/test-apply.R +++ b/tests/testthat/test-apply.R @@ -146,37 +146,8 @@ test_that("capply()", { res1 <- set_names(res0, nm) foo <- function(x) x^2 - # Should appropriately set names - expect_equal(capply(x, foo, .nm = FALSE), res0) - expect_equal(capply(x, foo, .nm = TRUE), res1) - # Combines full lists x <- list(c(1:3), NA_real_, 4, 5, NULL, 6:7) res <- c(1, 4, 9, NA, 16, 25, 36, 49) expect_equal(capply(x, foo), res) }) - - -# slappy ------------------------------------------------------------------ - -test_that("slapply()", { - x <- 1:10 - foo <- function(i) i^i - - res <- slapply(x, foo, .names = FALSE) - exp <- foo(x) - expect_identical(res, exp) - - res <- slapply(x, foo) - exp <- set_names(x^x, x) - expect_identical(res, exp) - - res <- slapply(x, foo, .simplify = TRUE) - exp <- simplify2array(exp) - expect_identical(res, exp) - - x <- set_names(x) - res <- slapply(x, foo) - exp <- set_names(x^x, x) - expect_identical(res, exp) -}) diff --git a/tests/testthat/test-strings.R b/tests/testthat/test-strings.R index 50419d8f..4fd2c3a1 100644 --- a/tests/testthat/test-strings.R +++ b/tests/testthat/test-strings.R @@ -40,7 +40,7 @@ expect_my_date <- function(res, exp_char, ...) { expect_my_datetime <- function(res, exp_char, ...) { testthat::expect_equal( str_extract_datetime(res, ...), - capply(exp_char, strptime, format = "%Y-%m-%d %H%M%S", tz = ""), + capply(exp_char, \(ec) strptime(ec, format = "%Y-%m-%d %H%M%S", tz = "")), label = as.character(res), expected.label = exp_char ) From 853de18f1a3c35290d55ef3e760c3addcd97cdfc Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 28 Dec 2025 18:37:22 -0500 Subject: [PATCH 067/169] adds header (#259) --- air.toml | 1 + 1 file changed, 1 insertion(+) diff --git a/air.toml b/air.toml index 76e090fc..4ca6496b 100644 --- a/air.toml +++ b/air.toml @@ -1,3 +1,4 @@ +[format] line-width = 80 indent-width = 2 indent-style = "space" From d56fe13e07e7cadb3694365a3b107c4a77a97c9c Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 28 Dec 2025 18:38:10 -0500 Subject: [PATCH 068/169] updates generic package errors (#259) --- R/aaa.R | 48 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 42 insertions(+), 6 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 1621bd8f..1287430d 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -1,4 +1,3 @@ - cnd_create_registry() # nolint next: line_length_linter. @@ -26,12 +25,20 @@ walrus <- function(sym, val) { # standard conditions ----------------------------------------------------- +# caused by user inputs input_error := condition( function(x) collapse(x), type = "error", help = "Generic error to indicate a bad input value." ) +# caused by processing +value_error := condition( + function(x) collapse(x), + type = "error", + help = "Generic error to indicate a value mismatch." +) + type_error := condition( function(expected, actual, object) { sprintf( @@ -55,12 +62,41 @@ conversion_error := condition( help = "Generic error to indicate a conversion failure." ) +class_error := condition( + function(type, x, must) { + cls <- class(x) + switch( + type, + not_supported = ngettext( + length(cls), + "Class not supported: %s", + "Classes not supported: %s", + toString(cls) + ), + must_be = sprintf( + ngettext( + length(cls), + "Object must be of class '%s', not '%s'", + "Object must be of class '%s', not classes '%s'" + ), + toString(must), + toString(cls) + ), + stop(internal_error()) + ) + }, + type = "error", + help = "Generic error to indicate a class mismatch." +) + internal_error := condition( - function(x) c( - collapse(x), - "\nThis is an internal `{mark}` error. If you encounter this, please", - " report an issue at " - ), + function(x = character()) { + c( + collapse(x), + "\nThis is an internal `{mark}` error. If you encounter this, please", + " report an issue at " + ) + }, type = "error", help = c( "Generic error to capture internal `{mark}` errors. If any of these are", From ed3153414093f212bcb2c8057b45dd802d12eaa1 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 28 Dec 2025 18:44:58 -0500 Subject: [PATCH 069/169] uses generic conditions more; simplifies condition names starting to make custom conditions within functions less unique, switching condition messages (#259) --- R/char2fact.R | 10 +- R/dataframes.R | 33 ++----- R/dates.R | 18 +--- R/description.R | 28 +++--- R/detail.R | 10 +- R/diff-time.R | 28 +++++- R/directory.R | 59 ++++++------ R/expand.R | 28 +++--- R/fct-expand-seq.R | 7 +- R/identical.R | 12 +-- R/import.R | 7 +- R/insert.R | 5 +- R/labels.R | 137 +++++++++++++-------------- R/logic.R | 9 +- tests/testthat/test-dataframes.R | 6 +- tests/testthat/test-dates.R | 6 +- tests/testthat/test-description.R | 2 +- tests/testthat/test-detail.R | 4 +- tests/testthat/test-expand.R | 4 +- tests/testthat/test-fct-expand-seq.R | 4 +- tests/testthat/test-identical.R | 4 +- tests/testthat/test-import.R | 2 +- tests/testthat/test-insert.R | 2 +- tests/testthat/test-labels.R | 28 ++++-- tests/testthat/test-logic.R | 4 +- 25 files changed, 211 insertions(+), 246 deletions(-) diff --git a/R/char2fact.R b/R/char2fact.R index 1ce9cd39..c5e48819 100644 --- a/R/char2fact.R +++ b/R/char2fact.R @@ -14,7 +14,7 @@ char2fact <- function(x, n = 5) { #' @rdname char2fact #' @export char2fact.default <- function(x, n = 5) { - stop(char2fact_class(x)) + stop(class_error("not_supported", x)) } #' @rdname char2fact @@ -63,11 +63,3 @@ fact2char <- function(data, threshold = 10) { data[bad] <- lapply(data[bad], as.character) data } - -# conditions -------------------------------------------------------------- - -char2fact_class := condition( - function(x) paste("char2fact does not support class", toString(class(x))), - type = "error", - exports = "char2fact" -) diff --git a/R/dataframes.R b/R/dataframes.R index 60d7085b..b40989e2 100644 --- a/R/dataframes.R +++ b/R/dataframes.R @@ -20,7 +20,7 @@ to_row_names <- function(data, row_names = 1L) { row_names0 <- row_names if (length(row_names) != 1) { - stop(to_row_names_single()) + stop(input_error("row_names must be a single element vector")) } if (is.character(row_names)) { @@ -28,7 +28,7 @@ to_row_names <- function(data, row_names = 1L) { } if (is.na(row_names)) { - stop(to_row_names_na(row_names0)) + stop(input_error("`row_names` cannot be NA")) } x <- data[[row_names]] @@ -95,7 +95,7 @@ list2df <- function(x, name = "name", value = "value", warn = TRUE) { n_cl <- length(unique(cl)) if (n_cl > 1L && warn) { - warning(list2df_classes(cl)) + warning(list2df_warning(cl)) } ulist <- unlist(x, use.names = FALSE) @@ -104,8 +104,7 @@ list2df <- function(x, name = "name", value = "value", warn = TRUE) { nm[blanks] <- which(blanks) out <- quick_df( - list(name = rep(make.unique(nm), lengths(x)), - value = unname(ulist)) + list(name = rep(make.unique(nm), lengths(x)), value = unname(ulist)) ) names(out) <- c(name, value) @@ -206,7 +205,7 @@ complete_cases <- function(data, cols = NULL, invert = FALSE) { ds <- dim(data) if (ds[1L] == 0L || ds[2L] == 0L) { - stop(complete_cases_dims()) + stop(input_error("`data` must have at least 1 row and 1 column")) } x <- data[, cols %||% 1:ds[2L], drop = FALSE] @@ -263,23 +262,9 @@ reset_rownames <- function(data, n = nrow(data)) { data } - # conditions -------------------------------------------------------------- -to_row_names_single := condition( - "row_names must be a single element vector", - type = "error", - exports = "to_row_names" -) - -to_row_names_na := condition( - function(x) sprintf("`row_names` of `%s` is invalid", x), - type = "error", - exports = "to_row_names" -) - - -list2df_classes := condition( +list2df_warning := condition( function(x) { ngettext( any(c("character", "factor") %in% x), @@ -290,9 +275,3 @@ list2df_classes := condition( type = "warning", exports = "list2df" ) - -complete_cases_dims := condition( - "`data` must have at least 1 row and 1 column", - type = "error", - exports = "complete_cases" -) diff --git a/R/dates.R b/R/dates.R index b723d642..35e706fa 100644 --- a/R/dates.R +++ b/R/dates.R @@ -71,11 +71,11 @@ verify_format <- function(format) { m <- match(c("y", "m", "d"), s) if (length(unique(s)) != 3L) { - stop(verify_format_chrs()) + stop(input_error("format must be 3 characters")) } if (anyNA(m)) { - stop(verify_format_ymd()) + stop(input_error('format must contain "y", "m", and "d"')) } s @@ -248,17 +248,3 @@ strp_format <- function(fmt) { fmt[fmt == "y"] <- "Y" sprintf("%%%s-%%%s-%%%s", fmt[1], fmt[2], fmt[3]) } - -# conditions -------------------------------------------------------------- - -verify_format_chrs := condition( - "format must be 3 characters", - type = "error", - exports = "date_from_partial" -) - -verify_format_ymd := condition( - 'format must contain "y", "m", and "d"', - type = "error", - exports = "date_from_partial" -) diff --git a/R/description.R b/R/description.R index 440c52dd..066dd731 100644 --- a/R/description.R +++ b/R/description.R @@ -19,7 +19,10 @@ use_author <- function(author_info = find_author()) { start <- grep("^[Aa]uthor", lines) if (!length(start)) { - stop("Jordan needs to review this, sorry") + warning( + "No Author field found; adding Authors@R at the top of the file", + call. = FALSE + ) start <- grep("^[Vv]ersion", lines) lines <- c(lines[1:start], "Author: ", lines[(start + 1):length(lines)]) } @@ -70,7 +73,10 @@ author_info_to_text <- function(x) { } find_author <- function() { - getOption("mark.author", stop(no_author_found())) + getOption( + "mark.author", + stop(value_error("Author information not found in options.")) + ) } # Version ----------------------------------------------------------------- @@ -101,7 +107,7 @@ get_version <- function() { line <- grep("^[Vv]ersion.*[[:punct:][:digit:]]+$", description) if (length(line) != 1L) { - stop(multiple_versions_found()) + stop(description_version_error()) } as.package_version(gsub("[Vv]ersion|[:]|[[:space:]]", "", description[line])) @@ -129,7 +135,7 @@ update_version <- function(version = NULL, date = FALSE) { line <- grep("^[Vv]ersion.*[[:punct:][:digit:]]+$", description) if (length(line) != 1L) { - stop(multiple_versions_found()) + stop(description_version_error()) } # Get the old version @@ -214,18 +220,8 @@ today_as_version <- function(zero = FALSE) { # conditions -------------------------------------------------------------- -no_author_found := condition( - "Author information not found in options.", - type = "error", - exports = "use_author", - help = c( - "You can try to set the author information with options(mark.author = .)", - " probably within an .Rprofile" - ) -) - -multiple_versions_found := condition( +description_version_error := condition( "Multiple version lines found in DESCRIPTION", type = "error", - exports = "get_version" + exports = c("get_version", "update_version") ) diff --git a/R/detail.R b/R/detail.R index 879ba7fa..e04e3e11 100644 --- a/R/detail.R +++ b/R/detail.R @@ -98,7 +98,7 @@ detail.data.frame <- function(x, factor_n = 5L, ...) { x <- x[, !vap_lgl(x, is.list), drop = FALSE] if (!ncol(x)) { - stop(no_non_list_columns()) + stop(input_error("`x` does not have any non-list columns")) } details <- lapply(x, detail, factor_n = factor_n) @@ -110,11 +110,3 @@ detail.data.frame <- function(x, factor_n = 5L, ...) { Reduce(rbind, details) ) } - -# conditions -------------------------------------------------------------- - -no_non_list_columns := condition( - "x does not have any non-list columns", - type = "error", - exports = "detail.data.frame" -) diff --git a/R/diff-time.R b/R/diff-time.R index 8bff6e6d..a08d19e3 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -297,9 +297,9 @@ is_diff_time <- function(x) { default_tz <- function() { # op.mark contains default_tz - tz <- getOption("mark.default_tz", "UTC") + tz <- getOption("mark.default_tz") - if (identical(tz, "UTC")) { + if (is.null(tz) || identical(tz, "UTC")) { return("UTC") } @@ -313,7 +313,7 @@ default_tz <- function() { } if (!is.character(tz) || length(tz) != 1L) { - stop(default_tz_value()) + stop(value_error("Invalid value for options('mark.default_tz')")) } tz @@ -341,6 +341,28 @@ sys_tz <- function(method = 1) { # conditions -------------------------------------------------------------- +diff_time_error := condition( + function(type) { + switch( + type, + tz_null = "Date times cannot be numeric when tz is NULL", + ) + } +) + +diff_time_warning := condition( + function(type) { + switch( + type, + na_tz = paste( + "NA found in timezones; setting to default timezone:", + default_tz() + ), + stop(internal_error()) + ) + } +) + numeric_datetime_tz := condition( "Date times cannot be numeric when tz is NULL", type = "error", diff --git a/R/directory.R b/R/directory.R index 09ddd4b7..3ac02d86 100644 --- a/R/directory.R +++ b/R/directory.R @@ -92,7 +92,7 @@ get_recent_file <- function(x, exclude_temp = TRUE, ...) { } if (no_length(files)) { - stop(no_recent_file_found()) + stop(file_error()) } newest_file(files) @@ -122,7 +122,7 @@ norm_path <- function(x = ".", check = FALSE, remove = check) { ind <- !fs::file_exists(x) if (check && any(ind)) { - warning(path_not_found(x[ind])) + warning(file_warning("not_found", x[ind])) } if (remove) { @@ -395,10 +395,11 @@ is_file <- function(x) { !is.na(isdir) & !isdir } +# FIXME remove -- unused, unexported file_create <- function(x, overwrite = FALSE) { dirs <- is_dir(x) if (any(dirs)) { - warning(paths_are_directories(x[dirs])) + warning(file_warning("directories", x[dirs])) x <- x[!dirs] } @@ -475,39 +476,41 @@ add_file_timestamp <- function( # conditions -------------------------------------------------------------- -no_recent_file_found := condition( +path_error := condition( "No recent file found", type = "error", exports = "get_recent_file" ) -path_not_found := condition( - function(x) { - ngettext( - length(x), - paste("Path not found:", norm_path(x)), - paste0( - "Paths not found:", - paste0("\n ", norm_path(x), collapse = "\n") - ) - ) - }, - type = "warning", - exports = "norm_path" -) - -paths_are_directories := condition( - function(x) { - ngettext( - length(x), - paste("File is a directory:", norm_path(x)), - paste0( - "Files are directories:", - paste0("\n ", norm_path(x), collapse = "\n") - ) +path_warning := condition( + function(type, x) { + switch( + type, + not_found = function(x) { + ngettext( + length(x), + paste("Path not found:", norm_path(x)), + paste0( + "Paths not found:", + paste0("\n ", norm_path(x), collapse = "\n") + ) + ) + }, + directories = function(x) { + ngettext( + length(x), + paste("File is a directory:", norm_path(x)), + paste0( + "Files are directories:", + paste0("\n ", norm_path(x), collapse = "\n") + ) + ) + }, + stop(internal_error()) ) }, type = "warning", + exports = c("get_recent_file", "norm_path"), help = { "File creation cannot be performed when the path is an existing directory" } diff --git a/R/expand.R b/R/expand.R index deab789f..dee3f8f9 100644 --- a/R/expand.R +++ b/R/expand.R @@ -111,11 +111,11 @@ reindex <- function( expand <- match_param(expand) if (!inherits(x, "data.frame")) { - stop("`x` must be a data.frame", call. = FALSE) + stop(class_error("must_be", x, "data.frame")) } if (no_length(new_index)) { - stop("new_index must not be NULL or 0 length", call. = FALSE) + stop(input_error("`new_index` cannot be NULL or 0 length")) } xi <- if (is.null(index)) { @@ -127,11 +127,11 @@ reindex <- function( } if (anyNA(xi)) { - warning(reindex_na_index(which(is.na(xi)))) + warning(reindex_warning(which(is.na(xi)))) } if (is.null(xi)) { - stop(reindex_null_index()) + stop(reindex_error()) } ro <- expand_by(xi, new_index, expand = expand, sort = sort) @@ -151,12 +151,10 @@ unique_name_check <- function(x) { int <- lens > 1L if (any(int)) { - warning( - "These names are duplicated: ", - collapse0(names(lens[int]), sep = ", "), - call. = FALSE - ) - return(invisible(FALSE)) + warning(unique_name_check(names(lens[int]))) + FALSE + } else { + TRUE } invisible(TRUE) @@ -164,7 +162,13 @@ unique_name_check <- function(x) { # conditions -------------------------------------------------------------- -reindex_na_index := condition( +unique_name_warning := condition( + function(x) paste0("These names are duplicated:", toString(x)), + type = "warning", + exports = "expand_by" +) + +reindex_warning := condition( function(x) { paste( ngettext( @@ -199,7 +203,7 @@ reindex(x, 'index', c(1, 2, 5, NA)) " ) -reindex_null_index := condition( +reindex_error := condition( "x[[index]] returned `NULL`", type = "error", exports = "reindex" diff --git a/R/fct-expand-seq.R b/R/fct-expand-seq.R index f650d58a..e48a7142 100644 --- a/R/fct-expand-seq.R +++ b/R/fct-expand-seq.R @@ -43,10 +43,11 @@ fct_expand_seq <- function( if (is.na(min_lvl)) { stop(fct_expand_seq_na("min_lvl")) + stop(fct_expand_seq_error("min")) } if (is.na(max_lvl)) { - stop(fct_expand_seq_na("max_lvl")) + stop(fct_expand_seq_error("max")) } int <- seq(from = min_lvl, to = max_lvl, by = by) @@ -55,8 +56,8 @@ fct_expand_seq <- function( # condition --------------------------------------------------------------- -fct_expand_seq_na := condition( - function(x = c("min_lvl", "max_lvl")) paste(match_param(x), "cannot be `NA`"), +fct_expand_seq_error := condition( + function(x = c("min", "max")) paste0(match_param(x), "_lvl cannot be `NA`"), type = "error", exports = "fct_expand_seq" ) diff --git a/R/identical.R b/R/identical.R index c51c8354..31a6a78e 100644 --- a/R/identical.R +++ b/R/identical.R @@ -24,7 +24,9 @@ are_identical <- function(..., params = NULL) { n <- length(x) if (length(unique(lengths(x))) != 1L || n < 2L) { - stop(dots_specified_correctly()) + stop(input_error( + "... must have at least two arguments and be equal length vectors" + )) } if (n == 2L) { @@ -49,11 +51,3 @@ do_map_identical <- function(x, y, params = NULL) { SIMPLIFY = TRUE ) } - -# conditions -------------------------------------------------------------- - -dots_specified_correctly := condition( - "... must have at least two arguments and be equal length vectors", - type = "error", - exports = "are_identical" -) diff --git a/R/import.R b/R/import.R index 0fc24f3f..4075aa51 100644 --- a/R/import.R +++ b/R/import.R @@ -18,7 +18,7 @@ import <- function(pkg, fun, overwrite = FALSE) { require_namespace(pkg) if (!overwrite && fun %in% ls(envir = e)) { - stop(import_already_assigned(fun)) + stop(import_error(fun)) } assign(fun, pkg %::% fun, envir = e) @@ -26,7 +26,7 @@ import <- function(pkg, fun, overwrite = FALSE) { # conditions -------------------------------------------------------------- -import_already_assigned := condition( +import_error := condition( message = function(fun) sprintf("'%s' has already been assigned", fun), type = "error", exports = "import", @@ -44,4 +44,5 @@ import('package', 'foo') foo <- NULL import('package', 'foo', overwrite = TRUE) ``` -") +" +) diff --git a/R/insert.R b/R/insert.R index c266ec7f..aad0ed42 100644 --- a/R/insert.R +++ b/R/insert.R @@ -27,7 +27,7 @@ insert <- function(x, positions, values) { positions <- positions[o] values <- values[o] } else { - stop(unequal_lengths()) + stop(insert_error()) } seqs <- seq_along(positions) @@ -40,10 +40,9 @@ insert <- function(x, positions, values) { x } - # conditions -------------------------------------------------------------- -unequal_lengths := condition( +insert_error := condition( "lengths of positions and values are unequal", type = "error", exports = "insert", diff --git a/R/labels.R b/R/labels.R index 73d350a6..c3fdb06a 100644 --- a/R/labels.R +++ b/R/labels.R @@ -70,7 +70,7 @@ assign_labels.data.frame <- function( is.null(.ls) || any(vap_lgl(.ls, is.null)) ) { - stop(invalid_assign_labels(rlang::list2(...), .ls)) + stop(assign_labels_error("dots", dots = rlang::list2(...), ls = .ls)) } if (inherits(.ls[[1L]], "data.frame")) { @@ -93,7 +93,7 @@ assign_labels.data.frame <- function( warn = warning, skip = function(cond) return() )( - missing_labels_in_assign(nm[nas]) + assign_labels_error("columns", cols = nm[nas]) ) nm <- nm[!nas] @@ -136,17 +136,18 @@ view_labels <- function(x, title) { title <- paste0(cesx, " - Labels") } - - view <- - if ("tools:rstudio" %in% search()) { - get0("View", as.environment("tools:rstudio")) - } %||% - utils::View + if (!interactive()) { + view <- function(x, title) print(x) + } else if ("tools:rstudio" %in% search()) { + view <- get("View", as.environment("tools:rstudio")) + } else { + view <- utils::View + } tryCatch( view(x = get_labels(x), title = title), error = function(cond) { - stop(cannot_view_labels()) + stop(view_labels_error()) } ) } @@ -173,7 +174,7 @@ remove_labels.data.frame <- function(x, cols, ...) { bad <- cols %wo% colnames(x) if (length(bad)) { - stop(column_not_found(bad)) + stop(assign_labels_error(bad)) } } @@ -186,81 +187,73 @@ remove_labels.data.frame <- function(x, cols, ...) { # conditions -------------------------------------------------------------- -invalid_assign_labels := condition( - message = function(dots, list) { - if (identical(dots, list)) { - paste0( - "labels provide are malformed: ", - toString(dots) - ) - } else { - paste0( - "`.ls` and `...` were both set and/or malformed", - "\n ... ", - toString(dots), - "\n .ls ", - toString(list) - ) - } +assign_labels_error := condition( + function(type, ..., cols, dots, ls) { + switch( + type, + columns = sprintf( + ngettext( + length(cols), + "Columns not found: %s", + "Column not found: %s" + ), + toString(cols) + ), + dots = if (identical(dots, ls)) { + sprintf("labels provided are malformed: %s", toString(dots)) + } else { + sprintf( + "`.ls` and `...` were both set and/or malformed\n ... %s\n .ls %s", + toString(dots), + toString(ls) + ) + }, + stop(internal_error()) + ) }, type = "error", - exports = "assign_labels", - help = c( - "If passing labels as `.ls`, `...` must be empty.", - " Columns in `...` must be entered as `name = value`; `column = label`.", - "\n\n", - paste( - "```r", - "# instead of this:", - "assign_labels(df, a = 'AAA', .ls = list(b = 'BBB'))", - "", - "# do this:", - "assign_labels(df, a = 'AAA', b = 'BBB')", - "# or this:", - "assign_labels(df, .ls = list(a = 'AAA', b = 'BBB'))", - "```", - sep = "\n" - ), - "\n\n", - "Labels must not be null; to remove lavels, use `remove_labels()`.", - "\n\n", - paste( - "```r", - "# instead of this", - "assign_labels(df, a = 'AAA', b = NULL)", - "", - "# do this", - "df <- assign_labels(df, a = 'AAA')", - "df <- remove_labels(df, 'b')", - "```", - sep = "\n" - ) - ) -) + exports = c("assign_labels", "remove_labels"), + help = r"( +**Columns not found** +You can set `.missing` to `warn` to get a warning instead of an error, or `skip` to silently skip those labels. -missing_labels_in_assign := condition( - function(x) paste("Columns not found:", toString(x)), - type = "error", - exports = "assign_labels", - help = c( - "You can set `.missing` to `warn` to get a warning instead of an error,", - "or `skip` to silently skip those labels." - ) +**Malformed labels** +If passing labels as `.ls`, `...` must be empty. Columns in `...` must be entered as `name = value`; `column = label`. + +```r +# instead of this: +assign_labels(df, a = 'AAA', .ls = list(b = 'BBB')) + +# do this: +assign_labels(df, a = 'AAA', b = 'BBB') +# or this: +assign_labels(df, .ls = list(a = 'AAA', b = 'BBB')) +``` +Labels must not be null; to remove lavels, use `remove_labels()`. + +```r +# instead of this +assign_labels(df, a = 'AAA', b = NULL) + +# do this +df <- assign_labels(df, a = 'AAA') +df <- remove_labels(df, 'b') +```)" ) -cannot_view_labels := condition( +view_labels_error := condition( "Cannot use `View()`", type = "error", exports = "view_labels", help = c( - "This may be because you are using Rstudio :", - " https://community.rstudio.com/t/view-is-causing-an-error/75297/4", + "This may be because you are using RStudio :", + " https://community.rstudio.com/t/view-is-causing-an-error/75297/4 ", "You can try :", - ' `View(get_labels(x), title = "Labels")`' + ' `utils::View(get_labels(x), title = "Labels")`' ) ) -column_not_found := condition( +remove_labels_error := condition( function(x) { sprintf( ngettext( diff --git a/R/logic.R b/R/logic.R index 891b68dc..38cf4dfa 100644 --- a/R/logic.R +++ b/R/logic.R @@ -155,7 +155,7 @@ none <- function(..., na.rm = FALSE) { # nolint: object_name_linter. check_null <- function(x) { if (no_length(x)) { - stop(null_or_zero()) + stop(input_error("`x` cannot be `NULL` or 0 length values")) } invisible() @@ -193,10 +193,3 @@ apply_logical_matrix <- function(mat, FUN, na.rm) { # nolint: object_name_linter } ) } - -# conditions -------------------------------------------------------------- - -null_or_zero := condition( - message = "Cannot accept `NULL` or 0 length values", - type = "error" -) diff --git a/tests/testthat/test-dataframes.R b/tests/testthat/test-dataframes.R index 357a791b..d674a31c 100644 --- a/tests/testthat/test-dataframes.R +++ b/tests/testthat/test-dataframes.R @@ -29,8 +29,8 @@ test_that("to_row_names()", { test_that("col_to_rn()", { - expect_error(to_row_names(data.frame(), 1:2), class = "mark:to_row_names_single") - expect_error(to_row_names(data.frame(), NA), class = "mark:to_row_names_na") + expect_error(to_row_names(data.frame(), 1:2), class = "mark:input_error") + expect_error(to_row_names(data.frame(), NA), class = "mark:input_error") }) test_that("vector2df()", { @@ -52,7 +52,7 @@ test_that("list2df()", { value = c(1, 2:4, letters[10:20]) ) - expect_warning(list2df(x), class = "mark:list2df_classes") + expect_warning(list2df(x), class = "mark:list2df_warning") expect_warning(list2df(x, warn = FALSE), NA) expect_equal(list2df(x, warn = FALSE), exp) diff --git a/tests/testthat/test-dates.R b/tests/testthat/test-dates.R index a7c9c407..f3dee773 100644 --- a/tests/testthat/test-dates.R +++ b/tests/testthat/test-dates.R @@ -87,9 +87,9 @@ test_that("'Empty' dates don't cause errors", { }) test_that("date errors", { - expect_error(verify_format("ymda"), class = "mark:verify_format_chrs") - expect_error(verify_format("abc"), class = "mark:verify_format_ymd") - expect_error(verify_format("aaa"), class = "mark:verify_format_chrs") + expect_error(verify_format("ymda"), class = "mark:input_error") + expect_error(verify_format("abc"), class = "mark:input_error") + expect_error(verify_format("aaa"), class = "mark:input_error") expect_error(verify_format("ymd"), NA) expect_error(verify_format("dmy"), NA) expect_error(verify_format("mdy"), NA) diff --git a/tests/testthat/test-description.R b/tests/testthat/test-description.R index a6a7737a..8287a5ad 100644 --- a/tests/testthat/test-description.R +++ b/tests/testthat/test-description.R @@ -1,6 +1,6 @@ test_that("find_author() works", { withr::local_options(list(mark.author = NULL)) - expect_error(find_author(), class = "mark:no_author_found") + expect_error(find_author(), class = "mark:value_error") }) test_that("use_author() works", { diff --git a/tests/testthat/test-detail.R b/tests/testthat/test-detail.R index 092c412b..8fea894c 100644 --- a/tests/testthat/test-detail.R +++ b/tests/testthat/test-detail.R @@ -7,7 +7,7 @@ test_that("details() works", { expect_error(detail(x), NA) expect_error(detail(df), NA) - expect_error(detail(data.frame()), class = "mark:no_non_list_columns") + expect_error(detail(data.frame()), class = "mark:input_error") exp <- quick_dfl( class = "logical", @@ -38,7 +38,7 @@ test_that("details() and tibbles", { expect_error(detail(tibble::tibble(a = 1, b = list(1:3))), NA) expect_error( detail(tibble::tibble(a = NULL, b = list(1:3))), - class = "mark:no_non_list_columns" + class = "mark:input_error" ) }) diff --git a/tests/testthat/test-expand.R b/tests/testthat/test-expand.R index bbeb116b..6aa41fc1 100644 --- a/tests/testthat/test-expand.R +++ b/tests/testthat/test-expand.R @@ -50,10 +50,10 @@ test_that("reindex() work", { reindex(iris1, "index", seq(2, 8, 2)) reindex(iris1, "index", seq(2, 8, 2), expand = "both") - expect_error(reindex(1), "data.frame", class = "simpleError") + expect_error(reindex(1), class = "mark:class_error") expect_error( reindex(quick_dfl(a = 1), index = integer()), - "new_index" + class = if (getRversion() >= "4.5") "missingArgError" else "simpleError", ) }) diff --git a/tests/testthat/test-fct-expand-seq.R b/tests/testthat/test-fct-expand-seq.R index 183f259e..01da91be 100644 --- a/tests/testthat/test-fct-expand-seq.R +++ b/tests/testthat/test-fct-expand-seq.R @@ -28,11 +28,11 @@ test_that("fct_expand_seq() fails", { expect_error( fct_expand_seq(as.ordered("a"), min_lvl = NA), - class = "mark:fct_expand_seq_na" + class = "mark:fct_expand_seq_error" ) expect_error( fct_expand_seq(as.ordered("a"), max_lvl = NA), - class = "mark:fct_expand_seq_na" + class = "mark:fct_expand_seq_error" ) }) diff --git a/tests/testthat/test-identical.R b/tests/testthat/test-identical.R index 09fb721e..5b7fe3f8 100644 --- a/tests/testthat/test-identical.R +++ b/tests/testthat/test-identical.R @@ -14,8 +14,8 @@ test_that("are_identical() works", { }) test_that("are_identical() fails", { - expect_error(are_identical(1, 1:3), class = "mark:dots_specified_correctly") - expect_error(are_identical(NULL), class = "mark:dots_specified_correctly") + expect_error(are_identical(1, 1:3), class = "mark:input_error") + expect_error(are_identical(NULL), class = "mark:input_error") }) # lintr things there isn't a terminal line here? diff --git a/tests/testthat/test-import.R b/tests/testthat/test-import.R index 9636057f..df6db907 100644 --- a/tests/testthat/test-import.R +++ b/tests/testthat/test-import.R @@ -1,6 +1,6 @@ test_that("import() works", { import("tools", "file_ext") expect_identical(file_ext, tools::file_ext) - expect_error(import("tools", "file_ext"), class = "mark:import_already_assigned") + expect_error(import("tools", "file_ext"), class = "mark:import_error") expect_error(import("tools", "file_ext", overwrite = TRUE), NA) }) diff --git a/tests/testthat/test-insert.R b/tests/testthat/test-insert.R index d1bcaeca..5dca55df 100644 --- a/tests/testthat/test-insert.R +++ b/tests/testthat/test-insert.R @@ -10,7 +10,7 @@ test_that("insert.default() works", { expect_error(insert(1, NA, 1), class = "simpleError") expect_error(insert(1, integer(), 1), class = "simpleError") - expect_error(insert(1, 1, integer()), class = "mark:unequal_lengths") + expect_error(insert(1, 1, integer()), class = "mark:insert_error") }) test_that("insert.data.frame() works", { diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index 1afe959d..0f1ac4b1 100644 --- a/tests/testthat/test-labels.R +++ b/tests/testthat/test-labels.R @@ -31,12 +31,14 @@ test_that("data.frame assignment", { expect_error( assign_labels(x0, a = "x", b = "y", `1` = 2), - class = "mark:missing_labels_in_assign" + "not found", + class = "mark:assign_labels_error" ) expect_error( assign_labels(x0, NULL), - class = "mark:invalid_assign_labels" + "malformed", + class = "mark:assign_labels_error" ) expect_true(is.null(attr(exp0[["Species"]], "label"))) @@ -46,23 +48,27 @@ test_that("data.frame assignment", { expect_error( assign_labels(x0, .ls = list()), - class = "mark:invalid_assign_labels" + "malformed", + class = "mark:assign_labels_error" ) expect_error( assign_labels(x0, a = 1, .ls = list(b = 2)), - class = "mark:invalid_assign_labels" + "set", + class = "mark:assign_labels_error" ) df <- quick_dfl(a = 1, b = 2, c = 3) expect_error( assign_labels(df, c = "c", d = "d", .missing = "error"), - class = "mark:missing_labels_in_assign" + "not found", + class = "mark:assign_labels_error" ) # error is raised as a warning expect_error( assign_labels(df, c = "c", d = "d", .missing = "warn"), - class = "mark:missing_labels_in_assign" + "not found", + class = "mark:assign_labels_error" ) expect_warning( @@ -97,17 +103,21 @@ test_that("data.frame assign with data.frame", { expect_error( assign_labels(iris, bad_labels), - class = "mark:missing_labels_in_assign" + class = "mark:assign_labels_error" ) options(op) }) test_that("view_labels() works", { - skip_if(interactive()) df <- data.frame(a = 1, b = 2) df <- assign_labels(df, a = "a", b = "b") - expect_error(view_labels(df), class = "mark:cannot_view_labels") + if (interactive()) { + skip("interactive session open new view") + expect_no_error(view_labels(df)) # opens a viewer + } else { + expect_output(view_labels(df), "a", fixed = TRUE) + } }) test_that("exact match [141]", { diff --git a/tests/testthat/test-logic.R b/tests/testthat/test-logic.R index 7d163af4..1c9c335b 100644 --- a/tests/testthat/test-logic.R +++ b/tests/testthat/test-logic.R @@ -58,8 +58,8 @@ test_that("Logical extension work", { }) test_that("logical helpers", { - expect_error(check_null(NULL), class = "mark:null_or_zero") - expect_error(check_null(integer()), class = "mark:null_or_zero") + expect_error(check_null(NULL), class = "mark:input_error") + expect_error(check_null(integer()), class = "mark:input_error") expect_error( apply_logical_matrix(1L, mean, TRUE), From 34d142799cd85d8f5c284ffc550f1d5cd4ab7cc9 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Dec 2025 22:04:42 -0500 Subject: [PATCH 070/169] ignores air.toml (#259) --- .Rbuildignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.Rbuildignore b/.Rbuildignore index bb9be55f..5d5136cd 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -19,3 +19,4 @@ revdep ^CRAN-SUBMISSION$ ^\.lintr$ ^\.git$ +^air\.toml$ From c3fd3d1556e63c08ee7b8156374a0723c9563368 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Dec 2025 22:10:15 -0500 Subject: [PATCH 071/169] formatting (#259) --- R/aaa.R | 10 ++-- R/append.R | 1 + R/base-conversion.R | 4 +- R/blank.R | 11 ++-- R/counts.R | 11 +++- R/dates.R | 10 ++-- R/depth.R | 6 +- R/description.R | 31 ++++++---- R/detail.R | 7 ++- R/diff-time.R | 24 +++++--- R/directory.R | 59 +++++++++--------- R/expand.R | 22 +++---- R/fact.R | 32 +++++----- R/fct-expand-seq.R | 9 ++- R/import.R | 3 +- R/labels.R | 19 +++--- R/logic.R | 16 ++--- R/na-assignment.R | 8 +-- R/options.R | 2 +- R/strings.R | 4 +- R/switch.R | 6 +- R/write.R | 141 ++++++++++++++++++++------------------------ 22 files changed, 221 insertions(+), 215 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 1287430d..968da5cd 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -67,10 +67,12 @@ class_error := condition( cls <- class(x) switch( type, - not_supported = ngettext( - length(cls), - "Class not supported: %s", - "Classes not supported: %s", + not_supported = sprintf( + ngettext( + length(cls), + "Class not supported: %s", + "Classes not supported: %s", + ), toString(cls) ), must_be = sprintf( diff --git a/R/append.R b/R/append.R index 5538901e..c42b8d2d 100644 --- a/R/append.R +++ b/R/append.R @@ -64,6 +64,7 @@ append0.default <- function(x, values, pos = NULL, ...) { # conditions -------------------------------------------------------------- +# TODO does this need to be it's own condition? append_expand_warning := condition( message = "expanding to the largest n", type = "warning", diff --git a/R/base-conversion.R b/R/base-conversion.R index e5aa0486..e374be27 100644 --- a/R/base-conversion.R +++ b/R/base-conversion.R @@ -14,7 +14,7 @@ #' base_alpha(c("JMB", "Jordan Mark", "XKCD")) #' sum(base_alpha(c("x", "k", "c", "d"))) -base_alpha <- function(x, base = 26) { +base_alpha <- function(x, base = 26) { stopifnot(is.character(x)) check_base_alpha(base, high = 26) vap_int(x, base_alpha_single, base = base) @@ -112,7 +112,7 @@ base_conversion_error := condition( switch( type, alpha_limit = sprintf( - 'Cannot calculate alpha base "%s" for "%s" which has letters beyond "%s"', + 'Cannot calculate alpha base "%s" for "%s" which has letters beyond "%s"', # nolint: line_length_linter. base, x, x[base] diff --git a/R/blank.R b/R/blank.R index 3abf97a0..49ae6747 100644 --- a/R/blank.R +++ b/R/blank.R @@ -38,14 +38,15 @@ select_blank_cols <- function(x, na_blank = FALSE, ws = TRUE) { remove_blank_cols <- function(x, na_blank = FALSE, ws = TRUE) { x[, !is_blank_cols(x, na_blank = na_blank, ws = ws), drop = FALSE] } - #' @rdname blank_values #' @export is_blank_cols <- function(x, names = TRUE, na_blank = FALSE, ws = TRUE) { stopifnot(is.data.frame(x)) - vap_lgl(x, function(i) { - all(is_blank(i, na_blank = na_blank, ws = ws)) - }, - .nm = names + vap_lgl( + x, + function(i) { + all(is_blank(i, na_blank = na_blank, ws = ws)) + }, + .nm = names ) } diff --git a/R/counts.R b/R/counts.R index bd35e1b3..82854ad2 100644 --- a/R/counts.R +++ b/R/counts.R @@ -107,7 +107,12 @@ props <- function(x, ...) { #' @rdname counts #' @export #' @param na.rm If `TRUE` will remove NA values from proportions -props.default <- function(x, sort = FALSE, na.rm = FALSE, ...) { # nolint: object_name_linter, line_length_linter. +props.default <- function( + x, + sort = FALSE, + na.rm = FALSE, # nolint: object_name_linter. + ... +) { res <- counts(x, sort = sort) n <- length(res) @@ -141,7 +146,9 @@ props.data.frame <- function( props_n(values, sort = sort, name = .name, na_ind = na_ind) } else { vector2df( - props(x[[cols]], sort = sort, na.rm = na.rm), cols, .name %||% "prop" + x = props(x[[cols]], sort = sort, na.rm = na.rm), + name = cols, + value = .name %||% "prop" ) } diff --git a/R/dates.R b/R/dates.R index 35e706fa..eb30349c 100644 --- a/R/dates.R +++ b/R/dates.R @@ -30,10 +30,10 @@ #' @export date_from_partial <- function( - x, - format = "ymd", - method = c("min", "max"), - year_replacement = NA_integer_ + x, + format = "ymd", + method = c("min", "max"), + year_replacement = NA_integer_ ) { x <- as.character(x) fmt <- verify_format(format) @@ -154,7 +154,6 @@ parse_date_strings <- function(.x, fmt, method, year_replacement) { } if (method == "min") { - if (x["d"] == 0L) { x["d"] <- 1L } @@ -164,7 +163,6 @@ parse_date_strings <- function(.x, fmt, method, year_replacement) { } if (x["y"] == 0L) { - if (is.na(year_replacement)) { return(ints) } diff --git a/R/depth.R b/R/depth.R index 479ea308..cefa1fd1 100644 --- a/R/depth.R +++ b/R/depth.R @@ -26,11 +26,7 @@ depth <- function(x, ...) { #' @export #' @rdname depth depth.default <- function(x, ...) { - if (is.null(x)) { - 0L - } else { - 1L - } + if (is.null(x)) 0L else 1L } #' @export diff --git a/R/description.R b/R/description.R index 066dd731..8262a99b 100644 --- a/R/description.R +++ b/R/description.R @@ -8,7 +8,6 @@ #' @param author_info Author information as a named list #' @return None, called for side effects #' @export - use_author <- function(author_info = find_author()) { stopifnot( is.list(author_info), @@ -24,11 +23,11 @@ use_author <- function(author_info = find_author()) { call. = FALSE ) start <- grep("^[Vv]ersion", lines) - lines <- c(lines[1:start], "Author: ", lines[(start + 1):length(lines)]) + lines <- c(lines[1:start], "Author@R: ", lines[(start + 1L):length(lines)]) } spaces <- grepl("^\\s", lines) - end <- which.max(!spaces[-c(1:start)]) + start - 1 + end <- which.max(!spaces[-c(1:start)]) + start - 1L names(author_info) <- tolower(names(author_info)) valid_names <- c("given", "family", "middle", "email", "role", "comment") @@ -37,15 +36,20 @@ use_author <- function(author_info = find_author()) { body <- author_info_to_text(author_info) n <- length(body) - new_body <- c("Authors@R:", + + # TODO maybe some expression() handling here? + new_body <- c( + "Authors@R:", paste0(" person(", trimws(body[1], "left")), - if (n > 2) paste0(" ", body[2:(n - 1)]) else NULL, - paste0(" ", sub("[,]$", "", body[n]), ")")) + if (n > 2) paste0(" ", body[2:(n - 1L)]) else NULL, + paste0(" ", sub("[,]$", "", body[n]), ")") + ) - out <- c(lines[1:(start - 1)], + out <- c( + lines[1:(start - 1L)], new_body, - lines[(end + 1):length(lines)]) - + lines[(end + 1L):length(lines)] + ) writeLines(out, "DESCRIPTION") } @@ -62,11 +66,12 @@ author_info_to_text <- function(x) { ind <- !comment & len x[ind] <- paste0('"', x[ind], '"') - x[comment] <- paste0( + x[comment] <- paste0( "c(", names(x[comment][[1]]), " = ", - paste0('"', x[comment][1], '"'), ")" + paste0('"', x[comment][1], '"'), + ")" ) paste0(format(nm, width = width), " = ", x, ",") @@ -213,7 +218,9 @@ today_as_version <- function(zero = FALSE) { char <- if (zero) { paste(0, x[["year"]] + 1900, x[["mon"]] + 1, x[["mday"]], sep = ".") } else { - paste( x[["year"]] + 1900, x[["mon"]] + 1, x[["mday"]], sep = ".") # nolint: spaces_inside_linter, line_length_linter. + # fmt: skip + # nolint next: spaces_inside_linter. + paste( x[["year"]] + 1900, x[["mon"]] + 1, x[["mday"]], sep = ".") } as.package_version(char) } diff --git a/R/detail.R b/R/detail.R index e04e3e11..79a8ad1d 100644 --- a/R/detail.R +++ b/R/detail.R @@ -64,10 +64,10 @@ detail.default <- function(x, factor_n = 5L, ...) { res <- quick_dfl( class = collapse0(class(x), sep = "; "), - type = collapse0(typeof(x), sep = "; "), + type = collapse0(typeof(x), sep = "; "), label = exattr(x, "label") %||% NA_character_, - n = length(x2), - na = sum(nas), + n = length(x2), + na = sum(nas), # These are a little funky min_c = as.character(min(if (quants) x2 else nc)), max_c = as.character(max(if (quants) x2 else nc)) @@ -80,6 +80,7 @@ detail.default <- function(x, factor_n = 5L, ...) { res$level_n <- NA_integer_ } + # fmt: skip text <- quick_dfl( note = note(x) %||% NA_character_, comment = comment(x) %||% NA_character_ diff --git a/R/diff-time.R b/R/diff-time.R index a08d19e3..789bfdee 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -1,3 +1,5 @@ +# nolint start: line_length_linter. + #' Diff time wrappers #' #' Wrappers for computing diff times @@ -43,6 +45,7 @@ #' #' @export #' @name diff_time +# nolint end: line_length_linter. diff_time <- function( x, y, @@ -72,6 +75,7 @@ diff_time <- function( # NB: This is time from X to Y z <- uy - ux + # fmt: skip out <- switch( method, secs = z, @@ -79,11 +83,12 @@ diff_time <- function( hours = z / 3600, days = z / 86400, weeks = z / 604800, - months = z / getOption("mark.days_in_month", 30) / 86400, - years = z / getOption("mark.days_in_year", 365) / 86400, - dyears = z / getOption("mark.days_in_year", 365) / 86400, + months = z / getOption("mark.days_in_month", 30) / 86400, + years = z / getOption("mark.days_in_year", 365) / 86400, + dyears = z / getOption("mark.days_in_year", 365) / 86400, myears = z / getOption("mark.days_in_month", 30) / 1036800, - wyears = z / getOption("mark.weeks_in_year", 52) / 604800 + wyears = z / getOption("mark.weeks_in_year", 52) / 604800, + stop(internal_error()) # nocov ) struct(out, c("numeric", "diff_time"), units = method) @@ -184,10 +189,11 @@ check_tz <- function(x) { #' @export print.diff_time <- function(x, digits = getOption("digits"), ...) { xu <- attr(x, "units") + # fmt: skip u <- switch( xu, - secs = "seconds", - mins = "minutes", + secs = "seconds", + mins = "minutes", # nolint start: line_length_linter. months = sprintf("months (%s days)", getOption("mark.days_in_month", 30)), years = sprintf("years (%s days)", getOption("mark.days_in_year", 365)), @@ -277,13 +283,15 @@ diff_time_myears <- function(x, y, ...) { #' @seealso [mark::diff_time] #' @name time_inherits #' @noRd -is_POSIXlt <- function(x) { # nolint: object_name_linter. +# nolint next: object_name_linter. +is_POSIXlt <- function(x) { inherits(x, "POSIXlt") } #' @rdname time_inherits #' @noRd -is_POSIXct <- function(x) { # nolint: object_name_linter. +# nolint next: object_name_linter. +is_POSIXct <- function(x) { inherits(x, "POSIXct") } diff --git a/R/directory.R b/R/directory.R index 3ac02d86..7b87873f 100644 --- a/R/directory.R +++ b/R/directory.R @@ -6,8 +6,7 @@ #' @param ... Additional arguments passed to [mark::list_dirs()] #' @return The full path of the most recent directory #' @export - -get_recent_dir <- function(x = ".", ...) { +get_recent_dir <- function(x = ".", ...) { stopifnot(dir.exists(x)) dirs <- list_dirs(x, ...) newest_dir(dirs) @@ -23,12 +22,11 @@ get_recent_dir <- function(x = ".", ...) { #' @param all Logical, if `TRUE` will recursively search for directories #' @return A full path to a directory #' @export - get_dir_recent_date <- function( - x = ".", - dt_pattern = NULL, - dt_format = NULL, - all = FALSE + x = ".", + dt_pattern = NULL, + dt_format = NULL, + all = FALSE ) { dt_pattern <- dt_pattern %||% .default_dt_pattern dt_format <- dt_format %||% .default_dt_format @@ -54,7 +52,7 @@ get_dir_recent_date <- function( "%Y %m %d %H%M%S", "%Y%m%d %H %M %S", "%Y%m%d %H%M%S" - ) +) #' Get recent directory by number name #' @@ -81,7 +79,6 @@ get_dir_max_number <- function(x) { #' @return The full name of the most recent file from the stated directory #' #' @export - get_recent_file <- function(x, exclude_temp = TRUE, ...) { stopifnot(is_dir(x)) @@ -92,7 +89,7 @@ get_recent_file <- function(x, exclude_temp = TRUE, ...) { } if (no_length(files)) { - stop(file_error()) + stop(path_error()) } newest_file(files) @@ -114,7 +111,6 @@ remove_temp_files <- function(x) { #' @return A vector of full file paths #' #' @export - norm_path <- function(x = ".", check = FALSE, remove = check) { stopifnot(is.character(x)) @@ -122,7 +118,7 @@ norm_path <- function(x = ".", check = FALSE, remove = check) { ind <- !fs::file_exists(x) if (check && any(ind)) { - warning(file_warning("not_found", x[ind])) + warning(path_warning("not_found", x[ind])) } if (remove) { @@ -273,7 +269,6 @@ list_files <- function( negate = FALSE, basename = FALSE ) { - pattern <- force(pattern) %|||% NULL path <- norm_path(x, check = TRUE) @@ -285,21 +280,21 @@ list_files <- function( if (basename) { # default behavior fs::dir_ls( - path = path, - regexp = pattern, - all = all, - recurse = all, + path = path, + regexp = pattern, + all = all, + recurse = all, ignore.case = ignore_case, - invert = negate, - type = "file" + invert = negate, + type = "file" ) } else { # If we want the regular expression applied to the entire file fs::dir_ls( - path = path, - all = all, + path = path, + all = all, recurse = all, - type = "file" + type = "file" ) } @@ -331,12 +326,12 @@ list_files <- function( #' @rdname file_utils #' @export list_dirs <- function( - x = ".", - pattern = NULL, - ignore_case = FALSE, - all = FALSE, - basename = FALSE, - negate = FALSE + x = ".", + pattern = NULL, + ignore_case = FALSE, + all = FALSE, + basename = FALSE, + negate = FALSE ) { path <- norm_path(x, check = TRUE) @@ -455,10 +450,10 @@ file_name <- function(x, compression = FALSE) { #' #' file.remove(file1, file2) add_file_timestamp <- function( - x, - ts = Sys.time(), - format = "%Y-%m-%d %H%M%S", - sep = " " + x, + ts = Sys.time(), + format = "%Y-%m-%d %H%M%S", + sep = " " ) { if (!is.null(format)) { ts <- format(ts, format = format) diff --git a/R/expand.R b/R/expand.R index dee3f8f9..cf40cb34 100644 --- a/R/expand.R +++ b/R/expand.R @@ -18,13 +18,15 @@ #' expand_by(x, y, "both") #' @export expand_by <- function( - x, - y, - expand = c("x", "y", "intersect", "both"), - sort = FALSE + x, + y, + expand = c("x", "y", "intersect", "both"), + sort = FALSE ) { expand <- match_param(expand) + # fmt: skip if (!is_named(x)) names(x) <- x + # fmt: skip if (!is_named(y)) names(y) <- y nx <- names(x) @@ -102,11 +104,11 @@ expand_by <- function( #' reindex(iris1, "index", seq(2, 8, 2), expand = "both") #' @export reindex <- function( - x, - index = NULL, - new_index, - expand = c("intersect", "both"), - sort = FALSE + x, + index = NULL, + new_index, + expand = c("intersect", "both"), + sort = FALSE ) { expand <- match_param(expand) @@ -156,8 +158,6 @@ unique_name_check <- function(x) { } else { TRUE } - - invisible(TRUE) } # conditions -------------------------------------------------------------- diff --git a/R/fact.R b/R/fact.R index e0545a3a..93bb2f00 100644 --- a/R/fact.R +++ b/R/fact.R @@ -206,7 +206,7 @@ print.fact <- function( T0 <- "Levels: " # nolint: object_name_linter. if (is.logical(max_levels)) { max_levels <- { - width <- width - (nchar(T0, "w") + 3L + 1L + 3L) + width <- width - (nchar(T0, "w") + 3L + 1L + 3L) lenl <- cumsum(nchar(lev, "w") + nchar(colsep, "w")) if (n <= 1L || lenl[n] <= width) { @@ -222,7 +222,7 @@ print.fact <- function( T0, paste( if (drop) { - c(lev[1L:max(1, max_levels - 1)], "...", if (max_levels > 1) lev[n]) + c(lev[1:max(1L, max_levels - 1L)], "...", if (max_levels > 1L) lev[n]) } else { lev }, @@ -284,10 +284,10 @@ as_ordered.default <- function(x) { res <- fact_na(x, remove = TRUE) if (!is.ordered(x)) { - res <- add_class(res, "ordered", 2L) + add_class(res, "ordered", 2L) + } else { + res } - - res } @@ -361,7 +361,7 @@ fact_na <- function(x, remove = FALSE) { } if (remove) { - attr(x, "levels") <- attr(x, "levels")[-na] + attr(x, "levels") <- attr(x, "levels")[-na] attr(x, "uniques") <- attr(x, "uniques")[-na] } @@ -380,7 +380,7 @@ fact_na <- function(x, remove = FALSE) { #' Reverse the levels of a `fact` #' #' @param x A `fact` object (or passed to [fact()]) -fact_reverse <- function(x) { +fact_reverse <- function(x) { x <- fact(x) lvls <- flip(attr(x, "uniques")) seq <- flip(seq_along(lvls)) @@ -436,7 +436,7 @@ as.Date.fact <- function(x, ...) { } #' @export -`[.fact` <- function(x, ...) { +`[.fact` <- function(x, ...) { y <- NextMethod("[") attributes(y) <- attributes(x) y @@ -501,12 +501,11 @@ fact_coerce_levels <- function(x) { numbers <- as.numeric(x[!nas]) dates <- as.Date(x[!nas], optional = TRUE) posix <- as.POSIXct( - x = x[!nas], + x = x[!nas], tryFormats = try_formats(), - tz = tz, - optional = TRUE + tz = tz, + optional = TRUE ) - }) n <- length(x) @@ -519,9 +518,9 @@ fact_coerce_levels <- function(x) { stopifnot(all(!nas)) x[] <- as.double(posix) x <- as.POSIXct( - x = x, - origin = "1970-01-01", - tz = tz + x = x, + origin = "1970-01-01", + tz = tz ) } else if (!anyNA(numbers)) { x <- rep(NA_real_, n) @@ -538,6 +537,7 @@ fact_coerce_levels <- function(x) { new_fact(match(levels, value)[x], value, is.ordered(x)) } -is.fact <- function(x) { # nolint: object_name_linter. +# nolint next: object_name_linter. +is.fact <- function(x) { inherits(x, "fact") } diff --git a/R/fct-expand-seq.R b/R/fct-expand-seq.R index e48a7142..650b6bd2 100644 --- a/R/fct-expand-seq.R +++ b/R/fct-expand-seq.R @@ -20,12 +20,11 @@ #' # from the first inherit level to the last observed #' fct_expand_seq(x, min(levels(x))) #' @export - fct_expand_seq <- function( - x, - min_lvl = min(x, na.rm = TRUE), - max_lvl = max(x, na.rm = TRUE), - by = 1L + x, + min_lvl = min(x, na.rm = TRUE), + max_lvl = max(x, na.rm = TRUE), + by = 1L ) { stopifnot( inherits(x, "ordered"), diff --git a/R/import.R b/R/import.R index 4075aa51..ec34ad7c 100644 --- a/R/import.R +++ b/R/import.R @@ -12,7 +12,6 @@ #' @examples #' # assigns `add` -- test with caution #' import("magrittr", "add") - import <- function(pkg, fun, overwrite = FALSE) { e <- parent.frame() require_namespace(pkg) @@ -26,6 +25,7 @@ import <- function(pkg, fun, overwrite = FALSE) { # conditions -------------------------------------------------------------- +# nolint start: line_length_linter. import_error := condition( message = function(fun) sprintf("'%s' has already been assigned", fun), type = "error", @@ -46,3 +46,4 @@ import('package', 'foo', overwrite = TRUE) ``` " ) +# nolint end: line_length_linter. diff --git a/R/labels.R b/R/labels.R index c3fdb06a..6f2fe308 100644 --- a/R/labels.R +++ b/R/labels.R @@ -57,13 +57,14 @@ assign_labels.default <- function(x, label, ...) { #' `skip` to silently skip those labels. #' @param .ls A named list of columns and labels to be set if `...` is empty assign_labels.data.frame <- function( - x, - ..., - .missing = c("error", "warn", "skip"), - .ls = rlang::list2(...) + x, + ..., + .missing = c("error", "warn", "skip"), + .ls = rlang::list2(...) ) { .missing <- match_param(.missing) + # fmt: skip if ( identical(.ls, list()) || (...length() && !identical(rlang::list2(...), .ls)) || @@ -90,14 +91,14 @@ assign_labels.data.frame <- function( switch( .missing, error = stop, - warn = warning, - skip = function(cond) return() + warn = warning, + skip = function(cond) NULL )( assign_labels_error("columns", cols = nm[nas]) ) - nm <- nm[!nas] - ma <- ma[!nas] + nm <- nm[!nas] + ma <- ma[!nas] .ls <- .ls[!nas] } @@ -213,6 +214,7 @@ assign_labels_error := condition( }, type = "error", exports = c("assign_labels", "remove_labels"), + # nolint start: line_length_linter. help = r"( **Columns not found** You can set `.missing` to `warn` to get a warning instead of an error, or `skip` to silently skip those labels. @@ -240,6 +242,7 @@ df <- assign_labels(df, a = 'AAA') df <- remove_labels(df, 'b') ```)" ) +# nolint end: line_length_linter. view_labels_error := condition( "Cannot use `View()`", diff --git a/R/logic.R b/R/logic.R index 38cf4dfa..5142a0d6 100644 --- a/R/logic.R +++ b/R/logic.R @@ -121,13 +121,15 @@ is_false.logical <- function(x) { #' @export #' @rdname logic_ext -OR <- function(..., na.rm = FALSE) { # nolint: object_name_linter. +# nolint next: object_name_linter. +OR <- function(..., na.rm = FALSE) { apply_logical_matrix(cbind(...), "|", na.rm = na.rm) } #' @export #' @rdname logic_ext -AND <- function(..., na.rm = FALSE) { # nolint: object_name_linter. +# nolint next: object_name_linter. +AND <- function(..., na.rm = FALSE) { apply_logical_matrix(cbind(...), "&", na.rm = na.rm) } @@ -147,7 +149,8 @@ is_boolean <- function(x) { #' @export #' @rdname logic_ext -none <- function(..., na.rm = FALSE) { # nolint: object_name_linter. +# nolint next: object_name_linter. +none <- function(..., na.rm = FALSE) { !any(..., na.rm = na.rm) } @@ -157,12 +160,11 @@ check_null <- function(x) { if (no_length(x)) { stop(input_error("`x` cannot be `NULL` or 0 length values")) } - - invisible() } -apply_logical_matrix <- function(mat, FUN, na.rm) { # nolint: object_name_linter, line_length_linter. stopifnot(is.matrix(mat), is_boolean(mat)) +# nolint next: object_name_linter. +apply_logical_matrix <- function(mat, FUN, na.rm) { na_val <- if (na.rm) { @@ -175,7 +177,7 @@ apply_logical_matrix <- function(mat, FUN, na.rm) { # nolint: object_name_linter apply( mat, - 1, + 1L, function(x) { if (na.rm) { x <- remove_na(x) diff --git a/R/na-assignment.R b/R/na-assignment.R index f94ba3d1..ba7b078d 100644 --- a/R/na-assignment.R +++ b/R/na-assignment.R @@ -33,8 +33,8 @@ NULL #' @rdname na_assignments #' @export +# nolint next: object_name_linter. NA_at <- function(x, y, ...) { - # nolint: object_name_linter. nx <- length(x) if (nx == 0L) { @@ -65,8 +65,8 @@ NA_at <- function(x, y, ...) { #' @rdname na_assignments #' @export +# nolint next: object_name_linter. NA_if <- function(x, y, ...) { - # nolint: object_name_linter. nx <- length(x) if (nx == 0L) { @@ -93,8 +93,8 @@ NA_if <- function(x, y, ...) { #' @rdname na_assignments #' @export +# nolint next: object_name_linter. NA_in <- function(x, y, ...) { - # nolint: object_name_linter. if (length(x) == 0L) { return(x) } @@ -110,8 +110,8 @@ NA_in <- function(x, y, ...) { #' @rdname na_assignments #' @export +# nolint next: object_name_linter. NA_out <- function(x, y, ...) { - # nolint: object_name_linter. if (length(x) == 0L) { return(x) } diff --git a/R/options.R b/R/options.R index 96cf44ad..4604a0f7 100644 --- a/R/options.R +++ b/R/options.R @@ -19,8 +19,8 @@ #' #' options(op) #' @export +# nolint next: object_name_linter. checkOptions <- function(x) { - # nolint: object_name_linter. stopifnot(is.list(x)) nm <- names(x) diff --git a/R/strings.R b/R/strings.R index e7536dd9..496e1083 100644 --- a/R/strings.R +++ b/R/strings.R @@ -60,7 +60,6 @@ str_slice_by_word <- function(x, n = 80L) { starts <- c(starts, st) ends <- c(ends, end) st <- end + 2L - } mapply( @@ -143,7 +142,7 @@ format_to_regex <- function(x) { x } -month_abbr_regex <- sprintf("(%s)", paste(month.abb, collapse = "|")) +month_abbr_regex <- sprintf("(%s)", paste(month.abb, collapse = "|")) month_name_regex <- sprintf("(%s)", paste(month.name, collapse = "|")) #' Character split @@ -183,7 +182,6 @@ chr_split <- function(x) { #' @export print_c <- function(x = read_clipboard(), sorted = TRUE, null = TRUE) { check_is_vector(x) - x <- unique(unlist(x)) if (sorted) { diff --git a/R/switch.R b/R/switch.R index 1a85ea38..6231d298 100644 --- a/R/switch.R +++ b/R/switch.R @@ -114,7 +114,7 @@ switch_in_case <- function(x, ..., .default = NULL, .envir = parent.frame()) { ) } - rhs <- lapply(splits, function(i) { + rhs <- lapply(splits, function(i) { eval(parse(text = i[2L]), envir = parent.frame()) }) @@ -205,7 +205,7 @@ switch_case <- function(..., .default = NULL, .envir = parent.frame()) { rmat[inds] } else { rmat[inds[, 2, drop = FALSE]] - } + } out[rowSums(lmat) == 0L] <- res0 as.vector(out, mode(res0)) } @@ -273,7 +273,7 @@ switch_error := condition( function(x, params = NULL) { switch( x, - numeric = "x did not appear to be numeric, cannot continue evaluating lhs", + numeric = "x did not appear to be numeric, cannot continue evaluating lhs", # nolint: line_length_linter. ambiguous_infinity = "Ambiguous infinity, cannot calculate", evaluate = paste0("Could not evaluate lhs\n", params), lengths_check = "statements have different lengths", diff --git a/R/write.R b/R/write.R index ec322283..9d73c363 100644 --- a/R/write.R +++ b/R/write.R @@ -7,7 +7,6 @@ #' function is applied to each element of the list. The default `"auto"` #' uses `toJSON()` if the package `jsonlite` is available, otherwise #' -#' #' @param x An object to write to file #' @param path The file or connection to write to (dependent on part by method) #' @param method The method of saving the file. When `default`, the method is @@ -37,14 +36,14 @@ #' fs::file_delete(temp) #' @export write_file_md5 <- function( - x, - path = NULL, - method = mark_write_methods(), - overwrite = NA, - quiet = FALSE, - encoding = "UTF-8", - compression = getOption("mark.compress.method", mark_compress_methods()), - ... + x, + path = NULL, + method = mark_write_methods(), + overwrite = NA, + quiet = FALSE, + encoding = "UTF-8", + compression = getOption("mark.compress.method", mark_compress_methods()), + ... ) { compression <- match_param(compression, mark_compress_methods()) op <- options( @@ -54,10 +53,11 @@ write_file_md5 <- function( ) on.exit(options(op), add = TRUE) + # fmt: skip if ( !isTRUE(nzchar(path, keepNA = TRUE)) || inherits(path, "terminal") - ) { + ) { null_path <- TRUE ext <- "" } else { @@ -172,12 +172,12 @@ mark_write_rds <- function(x, con, version = 3) { } mark_write_csv <- function( - x, - con, - sep = ",", - dec = ".", - qmethod = "double", - ... + x, + con, + sep = ",", + dec = ".", + qmethod = "double", + ... ) { mark_write_table( x = x, @@ -190,12 +190,12 @@ mark_write_csv <- function( } mark_write_csv2 <- function( - x, - con, - sep = ";", - dec = ",", - qmethod = "double", - ... + x, + con, + sep = ";", + dec = ",", + qmethod = "double", + ... ) { mark_write_table( x = x, @@ -208,12 +208,12 @@ mark_write_csv2 <- function( } mark_write_csv3 <- function( - x, - con, - sep = "|", - dec = ".", - qmethod = "double", - ... + x, + con, + sep = "|", + dec = ".", + qmethod = "double", + ... ) { mark_write_table( x = x, @@ -234,19 +234,17 @@ mark_write_tsv2 <- function(x, con, sep = "|", qmethod = "double", ...) { } mark_write_table <- function( - x, - con = "", - quote = TRUE, - sep = " ", - eol = "\n", - na = "", - dec = ".", - # nolint next: object_name_linter. - row.names = FALSE, - # nolint next: object_name_linter. - col.names = NA, - qmethod = "escape", - list_hook = getOption("mark.list.hook", "auto") + x, + con = "", + quote = TRUE, + sep = " ", + eol = "\n", + na = "", + dec = ".", + row.names = FALSE, # nolint: object_name_linter. + col.names = NA, # nolint: object_name_linter. + qmethod = "escape", + list_hook = getOption("mark.list.hook", "auto") ) { if (isFALSE(row.names) && isNA(col.names)) { # nolint next: object_name_linter. @@ -307,14 +305,12 @@ get_list_hook <- function(hook) { } mark_write_dcf <- function( - x, - con = "", - # nolint next: object_name_linter. - useBytes = FALSE, - indent = 4, - width = Inf, - # nolint next: object_name_linter. - keep.white = NULL + x, + con = "", + useBytes = FALSE, # nolint: object_name_linter. + indent = 4, + width = Inf, + keep.white = NULL # nolint: object_name_linter. ) { write.dcf( x = x, @@ -332,11 +328,11 @@ mark_write_lines <- function(x, con, sep = "\n") { } mark_write_yaml <- function( - x, - con, - unicode = TRUE, - digits = getOption("digits"), - ordered_lists = TRUE + x, + con, + unicode = TRUE, + digits = getOption("digits"), + ordered_lists = TRUE ) { require_namespace("yaml") string <- yaml::as.yaml( @@ -368,10 +364,10 @@ mark_write_parquet <- function(x, con, ...) { } mark_write_arrow <- function( - x, - con, - ..., - .method = c("feather", "parquet") + x, + con, + ..., + .method = c("feather", "parquet") ) { require_namespace("arrow") .method <- mark::match_param(.method) @@ -411,12 +407,12 @@ mark_write_arrow <- function( } mark_write_md <- function( - x, - con, - format = c("default", "compact"), - na = NA_character_, - ... - ) { + x, + con, + format = c("default", "compact"), + na = NA_character_, + ... +) { format <- match_param(format) m <- rbind(NA, NA, unname(as.matrix(x))) n <- ncol(x) @@ -460,15 +456,6 @@ mark_write_md <- function( ) } -mark_read_md <- function(file, text) { - if (!missing(text)) { - file <- textConnection(text) - } - - x <- readLines(file) - -} - # helpers ----------------------------------------------------------------- mark_to_json <- function(x) { @@ -491,10 +478,10 @@ mark_to_json <- function(x) { } compress <- function( - x = "", - method = getOption("mark.compress.method", "default"), - encoding = getOption("mark.write_table.encoding", "UTF-8"), - ... + x = "", + method = getOption("mark.compress.method", "default"), + encoding = getOption("mark.write_table.encoding", "UTF-8"), + ... ) { op <- options(encoding = encoding) on.exit(options(op), add = TRUE) From 10e0cd83741f3469b5aecb962ab6d9fe3b79323b Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Dec 2025 22:10:24 -0500 Subject: [PATCH 072/169] adds note (#259) --- R/fact.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/fact.R b/R/fact.R index 93bb2f00..eed9e9f4 100644 --- a/R/fact.R +++ b/R/fact.R @@ -1,3 +1,4 @@ +# NOTE I'll eventually replace these with jmbarbone/facts (or jmbarbone/fctrs) # fact -------------------------------------------------------------------- From 1f99cb345fd1c59988fa0be38bdcf7cec0b030ce Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Dec 2025 22:10:48 -0500 Subject: [PATCH 073/169] uses substitute for make_do_ls function generator (#259) --- R/environments.R | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/R/environments.R b/R/environments.R index 7a759a97..166c7a86 100644 --- a/R/environments.R +++ b/R/environments.R @@ -47,13 +47,26 @@ objects_all <- ls_all #' @name ls_ext NULL -# nolint start: object_name_linter. -make_do_ls <- function(FUN) { - FUN <- match.fun(FUN) - function(pattern, all.names = FALSE, envir = parent.frame()) { - # nolint end: object_name_linter. - do_ls(FUN, pattern = pattern, all.names = all.names, envir = envir) - } +make_do_ls <- function(fun) { + fun <- substitute(fun) + # nolint next: object_usage_linter. False positive + expr <- substitute( + do_ls(..fun.., pattern = pattern, all.names = all.names, envir = envir), + list(..fun.. = fun) + ) + + eval( + substitute( + as.function( + alist( + pattern = , + all.names = FALSE, + envir = parent.frame(), + expr + ) + ) + ) + ) } #' @export From 7248ada8e777aca0d0df4c5d92c31ee006bbf386 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Dec 2025 22:11:04 -0500 Subject: [PATCH 074/169] updates conditions (#259) --- R/dataframes.R | 40 ++++++++++++++++++++++++++++------------ R/expand.R | 4 ++-- R/fct-expand-seq.R | 15 ++++++++++----- R/funs.R | 2 +- R/labels.R | 4 +++- R/logic.R | 6 ++++-- 6 files changed, 48 insertions(+), 23 deletions(-) diff --git a/R/dataframes.R b/R/dataframes.R index b40989e2..68df27c7 100644 --- a/R/dataframes.R +++ b/R/dataframes.R @@ -15,9 +15,10 @@ #' to_row_names(x) #' to_row_names(x, "b") #' @export - to_row_names <- function(data, row_names = 1L) { - row_names0 <- row_names + if (!is.data.frame(data)) { + stop(class_error("must_be", data, "data.frame")) + } if (length(row_names) != 1) { stop(input_error("row_names must be a single element vector")) @@ -49,9 +50,10 @@ to_row_names <- function(data, row_names = 1L) { #' @param name,value Character strings for the name and value columns #' @return A `data.frame` with `name` (optional) and `value` columns #' @export - vector2df <- function(x, name = "name", value = "value") { - stopifnot(!is.list(x)) + if (is.list(x)) { + stop(class_error("not_supported", x)) + } ls <- list(names(x) %||% rep(NA, length(x)), remove_names(x)) ls <- ls[!vap_lgl(list(name, value), is.null)] names(ls) <- c(name, value) @@ -89,7 +91,9 @@ vector2df <- function(x, name = "name", value = "value") { # nolint next: object_name_linter. list2df <- function(x, name = "name", value = "value", warn = TRUE) { - stopifnot(is.list(x)) + if (!is.list(x)) { + stop(class_error("must_be", x, "list")) + } cl <- lapply(x, class) n_cl <- length(unique(cl)) @@ -114,7 +118,13 @@ list2df <- function(x, name = "name", value = "value", warn = TRUE) { # base::list2DF() -- but this wasn't introduced until 4.0.0 # And an update prevents recycling list2df2 <- function(x = list(), nrow = NULL) { - stopifnot(is.list(x), is.null(nrow) || nrow >= 0L) + if (!is.list(x)) { + stop(class_error("must_be", x, "list")) + } + + if (!(is.null(nrow) || nrow >= 0L)) { + stop(input_error("`nrow` must be NULL or a non-negative integer")) + } if (n <- length(x)) { if (is.null(nrow)) { @@ -153,9 +163,10 @@ list2df2 <- function(x = list(), nrow = NULL) { #' x <- data.frame(col_a = Sys.Date() + 1:5, col_b = letters[1:5], col_c = 1:5) #' t_df(x) #' @export - t_df <- function(x) { - stopifnot(is.data.frame(x)) + if (!is.data.frame(x)) { + stop(class_error("must_be", x, "data.frame")) + } out <- as.data.frame( t(x), @@ -169,7 +180,9 @@ t_df <- function(x) { } rn_to_col <- function(data, name = "row.name") { - stopifnot(is.data.frame(data)) + if (!is.data.frame(data)) { + stop(class_error("must_be", data, "data.frame")) + } n <- length(data) + 1 data[[n]] <- attr(data, "row.names") data <- reset_rownames(data) @@ -201,7 +214,9 @@ rn_to_col <- function(data, name = "row.name") { #' complete_cases(x, "c") #' @export complete_cases <- function(data, cols = NULL, invert = FALSE) { - stopifnot(is.data.frame(data)) + if (!is.data.frame(data)) { + stop(class_error("must_be", data, "data.frame")) + } ds <- dim(data) if (ds[1L] == 0L || ds[2L] == 0L) { @@ -239,7 +254,9 @@ complete_cases <- function(data, cols = NULL, invert = FALSE) { #' unique_rows(df, c("a", "b"), from_last = TRUE, invert = TRUE) #' @export unique_rows <- function(data, cols = NULL, from_last = FALSE, invert = FALSE) { - stopifnot(is.data.frame(data)) + if (!is.data.frame(data)) { + stop(class_error("must_be", data, "data.frame")) + } cn <- names(data) cols <- cols %||% cn @@ -256,7 +273,6 @@ unique_rows <- function(data, cols = NULL, from_last = FALSE, invert = FALSE) { reset_rownames(data[keep, ]) } - reset_rownames <- function(data, n = nrow(data)) { attr(data, "row.names") <- .set_row_names(n) data diff --git a/R/expand.R b/R/expand.R index cf40cb34..d46e9f52 100644 --- a/R/expand.R +++ b/R/expand.R @@ -153,7 +153,7 @@ unique_name_check <- function(x) { int <- lens > 1L if (any(int)) { - warning(unique_name_check(names(lens[int]))) + warning(expand_by_warning(names(lens[int]))) FALSE } else { TRUE @@ -162,7 +162,7 @@ unique_name_check <- function(x) { # conditions -------------------------------------------------------------- -unique_name_warning := condition( +expand_by_warning := condition( function(x) paste0("These names are duplicated:", toString(x)), type = "warning", exports = "expand_by" diff --git a/R/fct-expand-seq.R b/R/fct-expand-seq.R index 650b6bd2..dacffe76 100644 --- a/R/fct-expand-seq.R +++ b/R/fct-expand-seq.R @@ -26,10 +26,16 @@ fct_expand_seq <- function( max_lvl = max(x, na.rm = TRUE), by = 1L ) { - stopifnot( - inherits(x, "ordered"), - is.integer(by) || by < 1L - ) + if (!inherits(x, "ordered")) { + stop(class_error("must_be", x, "ordered")) + } + + by <- as.integer(by) + + if (!isTRUE(by >= 0L)) { + stop(input_error("`by` must be a positive integer")) + } + lvls <- levels(x) if (is.character(min_lvl) || inherits(min_lvl, "factor")) { @@ -41,7 +47,6 @@ fct_expand_seq <- function( } if (is.na(min_lvl)) { - stop(fct_expand_seq_na("min_lvl")) stop(fct_expand_seq_error("min")) } diff --git a/R/funs.R b/R/funs.R index d50076ae..04d6ccd4 100644 --- a/R/funs.R +++ b/R/funs.R @@ -66,5 +66,5 @@ quiet_stop <- function() { op <- options() options(show.error.messages = FALSE) on.exit(options(op), add = TRUE) - stop() + stop(condition("quiet_stop", "quiet stop", type = "error")()) } diff --git a/R/labels.R b/R/labels.R index 6f2fe308..fb7cd2f5 100644 --- a/R/labels.R +++ b/R/labels.R @@ -45,7 +45,9 @@ assign_labels <- function(x, ...) { #' @export #' @rdname labels assign_labels.default <- function(x, label, ...) { - stopifnot(length(label) == 1) + if (length(label) != 1L) { + stop(input_error("`label` must be a single length vector")) + } attr(x, "label") <- label x } diff --git a/R/logic.R b/R/logic.R index 5142a0d6..869bb242 100644 --- a/R/logic.R +++ b/R/logic.R @@ -144,7 +144,7 @@ either <- function(x, y) { #' @export #' @rdname logic_ext is_boolean <- function(x) { - is.logical(x) | (is.numeric(x) & !anyNA(match(x, c(NA, 0, 1)))) + is.logical(x) || (is.numeric(x) && !anyNA(match(x, c(NA, 0, 1)))) } #' @export @@ -162,9 +162,11 @@ check_null <- function(x) { } } - stopifnot(is.matrix(mat), is_boolean(mat)) # nolint next: object_name_linter. apply_logical_matrix <- function(mat, FUN, na.rm) { + if (!(is.matrix(mat) && is_boolean(mat))) { + stop(input_error("`...` must be logical or logical-like matrix")) + } na_val <- if (na.rm) { From 809891764e9ab811591330e27794aada3275844a Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Dec 2025 22:11:36 -0500 Subject: [PATCH 075/169] formatting (#259) --- R/environments.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/environments.R b/R/environments.R index 166c7a86..a955e3c2 100644 --- a/R/environments.R +++ b/R/environments.R @@ -32,7 +32,8 @@ print.mark_environments <- function(x, ...) { #' @return #' * `ls_all()`, `objects_all()`: A named list for each of the environments #' the `search()` path with all the objects found in that environment -ls_all <- function(all.names = FALSE) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter. +ls_all <- function(all.names = FALSE) { sapply(search(), function(s) ls(as.environment(s), all.names = all.names)) } @@ -81,7 +82,8 @@ ls_function <- make_do_ls(is.function) #' @rdname ls_ext ls_object <- make_do_ls(is.object) -do_ls <- function(FUN, pattern, all.names = FALSE, envir = parent.frame()) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +do_ls <- function(FUN, pattern, all.names = FALSE, envir = parent.frame()) { .ls <- ls(envir = envir, pattern = pattern, all.names = all.names) .ls[vap_lgl(.ls, function(x) FUN(get0(x, envir = envir)))] } From 42bb94613b5a5950a2298dbc6bea20ad10b4804f Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 29 Dec 2025 22:11:47 -0500 Subject: [PATCH 076/169] updates conditions (#259) --- tests/testthat/test-base-conversion.R | 5 ++- tests/testthat/test-dataframes.R | 17 ++++---- tests/testthat/test-dates.R | 28 +++++++------ tests/testthat/test-detail.R | 18 ++++----- tests/testthat/test-environments.R | 19 ++++----- tests/testthat/test-expand.R | 10 ++++- tests/testthat/test-fct-expand-seq.R | 7 +++- tests/testthat/test-file.R | 9 +++-- tests/testthat/test-identical.R | 1 - tests/testthat/test-insert.R | 1 - tests/testthat/test-logic.R | 57 ++++++++++++++------------- 11 files changed, 95 insertions(+), 77 deletions(-) diff --git a/tests/testthat/test-base-conversion.R b/tests/testthat/test-base-conversion.R index 5ca34213..1c91225b 100644 --- a/tests/testthat/test-base-conversion.R +++ b/tests/testthat/test-base-conversion.R @@ -6,7 +6,10 @@ test_that("base_alpha() works as expected", { letter_vec <- paste_combine(c("", letters), letters, collate = TRUE) expect_equal(base_alpha(letter_vec), 1:702) - expect_error(base_alpha(letters[1:10], 9), class = "mark:base_conversion_error") + expect_error( + base_alpha(letters[1:10], 9), + class = "mark:base_conversion_error" + ) expect_warning(alpha_base(letters), "deprecated") expect_identical(base_alpha_single("a", 26), 1L) diff --git a/tests/testthat/test-dataframes.R b/tests/testthat/test-dataframes.R index d674a31c..6406ff1a 100644 --- a/tests/testthat/test-dataframes.R +++ b/tests/testthat/test-dataframes.R @@ -42,7 +42,7 @@ test_that("vector2df()", { expect_equal(vector2df(set_names(x)), df) expect_named(vector2df(x, "one", "two"), c("one", "two")) - expect_error(vector2df(list(a = 1)), class = "simpleError") + expect_error(vector2df(list(a = 1)), class = "mark:class_error") }) test_that("list2df()", { @@ -57,8 +57,7 @@ test_that("list2df()", { expect_equal(list2df(x, warn = FALSE), exp) x <- list(a = 1, b = seq(2, 9, 1.0), c = 20) - exp <- quick_df(list(name = c("a", rep("b", 8), "c"), - value = c(1:9, 20))) + exp <- quick_df(list(name = c("a", rep("b", 8), "c"), value = c(1:9, 20))) expect_warning(list2df(x), NA) expect_equal(list2df(x), exp) expect_named(list2df(x, "hello", "world"), c("hello", "world")) @@ -68,7 +67,7 @@ test_that("list2df()", { res <- quick_dfl(name = c("a", 2, 3), value = c(1, 0, 2)) expect_equal(list2df(x), res) - expect_error(list2df(1), class = "simpleError") + expect_error(list2df(1), class = "mark:class_error") # Not sure this will continue to be the case expect_identical(quick_df(NULL), data.frame()) @@ -91,11 +90,11 @@ test_that("t_df()", { y <- quick_dfl( colname = c("a", "b"), # nolint start: spaces_inside_linter. - row_1 = c( 1, "a"), - row_2 = c( 2, "b"), - row_3 = c( 3, "c"), - row_4 = c( 4, "d"), - row_5 = c( 5, "e") + row_1 = c(1, "a"), + row_2 = c(2, "b"), + row_3 = c(3, "c"), + row_4 = c(4, "d"), + row_5 = c(5, "e") # nolint end: spaces_inside_linter. ) diff --git a/tests/testthat/test-dates.R b/tests/testthat/test-dates.R index f3dee773..181da7f4 100644 --- a/tests/testthat/test-dates.R +++ b/tests/testthat/test-dates.R @@ -19,18 +19,18 @@ test_that("dates - utils", { test_that("leap years", { # nolint start: spaces_inside_linter. expect_false(is_leap_year(1500)) - expect_true( is_leap_year(1600)) + expect_true(is_leap_year(1600)) expect_false(is_leap_year(1700)) expect_false(is_leap_year(1800)) expect_false(is_leap_year(1900)) - expect_true( is_leap_year(2000)) - expect_true( is_leap_year(2400)) - expect_true( is_leap_year(4000)) - expect_true( is_leap_year(0)) + expect_true(is_leap_year(2000)) + expect_true(is_leap_year(2400)) + expect_true(is_leap_year(4000)) + expect_true(is_leap_year(0)) expect_false(is_leap_year(100)) expect_false(is_leap_year(102)) - expect_true( is_leap_year(400)) - expect_true( is_leap_year(as.POSIXct("2020-01-01"))) + expect_true(is_leap_year(400)) + expect_true(is_leap_year(as.POSIXct("2020-01-01"))) # nolint end: spaces_inside_litner. }) @@ -65,15 +65,21 @@ test_that("Some examples", { }) test_that("Bad date: Earliest", { - dates <- c("3 UNK 2019", "UN JUN 2004", "Feb 2000", "UK UNK UNKN") - exp <- c("2019-01-03", "2004-06-01", "2000-02-01", NA_character_) + dates <- c("3 UNK 2019", "UN JUN 2004", "Feb 2000", "UK UNK UNKN") + exp <- c("2019-01-03", "2004-06-01", "2000-02-01", NA_character_) expect_equal(foo(dates, format = "dmy"), exp) }) test_that("Bad date: Latest", { # nolint start: line_length_linter. - dates <- c("3 UNK 2019", "UN JUN 2004", "Feb 2000", "Feb 2100", "UK UNK UNKN") - exp <- c("2019-12-03", "2004-06-30", "2000-02-29", "2100-02-28", NA_character_) + dates <- c("3 UNK 2019", "UN JUN 2004", "Feb 2000", "Feb 2100", "UK UNK UNKN") + exp <- c( + "2019-12-03", + "2004-06-30", + "2000-02-29", + "2100-02-28", + NA_character_ + ) expect_equal(foo(dates, format = "dmy", method = "max"), exp) # nolint end: line_length_linter. }) diff --git a/tests/testthat/test-detail.R b/tests/testthat/test-detail.R index 8fea894c..641d032a 100644 --- a/tests/testthat/test-detail.R +++ b/tests/testthat/test-detail.R @@ -10,16 +10,16 @@ test_that("details() works", { expect_error(detail(data.frame()), class = "mark:input_error") exp <- quick_dfl( - class = "logical", - type = "logical", - label = NA_character_, - n = 0L, - na = 1L, - min_c = NA_character_, - max_c = NA_character_, - level = NA_character_, + class = "logical", + type = "logical", + label = NA_character_, + n = 0L, + na = 1L, + min_c = NA_character_, + max_c = NA_character_, + level = NA_character_, level_n = NA_integer_, - note = NA_character_, + note = NA_character_, comment = NA_character_ ) # also no warnings diff --git a/tests/testthat/test-environments.R b/tests/testthat/test-environments.R index f2824ac0..22d2821c 100644 --- a/tests/testthat/test-environments.R +++ b/tests/testthat/test-environments.R @@ -6,22 +6,19 @@ test_that("environments() and friends works", { ne <- new.env() - local({ - foo_obj <- structure(list(), class = "foo") - foo_fun <- function() NULL - foo_df <- quick_dfl(a = 1) - }, envir = ne) + local( + { + foo_obj <- structure(list(), class = "foo") + foo_fun <- function() NULL + foo_df <- quick_dfl(a = 1) + }, + envir = ne + ) # these are failing...? expect_identical(ls_function(envir = ne), "foo_fun") expect_identical(ls_object(envir = ne), c("foo_df", "foo_obj")) expect_identical(ls_dataframe(envir = ne), "foo_df") - - expect_identical( - make_do_ls("is.object"), - ls_object, - ignore_function_env = TRUE - ) }) test_that("snapshots", { diff --git a/tests/testthat/test-expand.R b/tests/testthat/test-expand.R index 6aa41fc1..f621f932 100644 --- a/tests/testthat/test-expand.R +++ b/tests/testthat/test-expand.R @@ -26,8 +26,14 @@ test_that("expand_by() work", { expect_equal(exp, res) # nolint start: line_length_linter. - expect_error(expect_warning(expand_by(c(a = 1, a = 1), c(a = 1))), class = "simpleError") - expect_error(expect_warning(expand_by(c(a = 1), c(a = 1, a = 1))), class = "simpleError") + expect_error( + expect_warning(expand_by(c(a = 1, a = 1), c(a = 1))), + class = "simpleError" + ) + expect_error( + expect_warning(expand_by(c(a = 1), c(a = 1, a = 1))), + class = "simpleError" + ) # nolint end: line_length_linter. }) diff --git a/tests/testthat/test-fct-expand-seq.R b/tests/testthat/test-fct-expand-seq.R index 01da91be..aa75850e 100644 --- a/tests/testthat/test-fct-expand-seq.R +++ b/tests/testthat/test-fct-expand-seq.R @@ -23,8 +23,11 @@ test_that("Sequences correctly", { }) test_that("fct_expand_seq() fails", { - expect_error(fct_expand_seq("a"), class = "simpleError") - expect_error(fct_expand_seq(as.ordered("a"), by = NA), class = "simpleError") + expect_error(fct_expand_seq("a"), class = "mark:class_error") + expect_error( + fct_expand_seq(as.ordered("a"), by = NA), + class = "mark:input_error" + ) expect_error( fct_expand_seq(as.ordered("a"), min_lvl = NA), diff --git a/tests/testthat/test-file.R b/tests/testthat/test-file.R index c661ac94..00ca9bb7 100644 --- a/tests/testthat/test-file.R +++ b/tests/testthat/test-file.R @@ -1,5 +1,3 @@ - - muffle_cnd_conditions(test_that("file_copy_md5() works", { x <- c(tempfile("one"), tempfile("two"), tempfile("three")) y <- c(tempfile("one"), tempfile("two"), tempfile("three")) @@ -37,7 +35,12 @@ muffle_cnd_conditions(test_that("file_copy_md5() works", { ), class = "mark:md5_status", regexp = paste( - "one", "md5 same", "two", "md5 change", "three", "new file", + "one", + "md5 same", + "two", + "md5 change", + "three", + "new file", sep = ".*" ) ) diff --git a/tests/testthat/test-identical.R b/tests/testthat/test-identical.R index 5b7fe3f8..3295cee0 100644 --- a/tests/testthat/test-identical.R +++ b/tests/testthat/test-identical.R @@ -3,7 +3,6 @@ test_that("are_identical() works", { y[2] <- 3L z[5] <- NA_integer_ - res <- are_identical(x, y) exp <- c(TRUE, FALSE, TRUE, TRUE, TRUE) expect_identical(res, exp) diff --git a/tests/testthat/test-insert.R b/tests/testthat/test-insert.R index 5dca55df..637a73ae 100644 --- a/tests/testthat/test-insert.R +++ b/tests/testthat/test-insert.R @@ -1,4 +1,3 @@ - test_that("insert.default() works", { res <- insert(letters[1:5], c(2, 4), c("X", "Y")) exp <- c("a", "X", "b", "c", "Y", "d", "e") diff --git a/tests/testthat/test-logic.R b/tests/testthat/test-logic.R index 1c9c335b..01880bb6 100644 --- a/tests/testthat/test-logic.R +++ b/tests/testthat/test-logic.R @@ -1,59 +1,60 @@ +# nolint start: spaces_inside_linter. + +# fmt: skip test_that("Logical extension work", { - x <- c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, NA, NA, NA) - y <- c(TRUE, FALSE, NA, TRUE, FALSE, NA, TRUE, FALSE, NA) - z <- c(TRUE, TRUE, FALSE, FALSE, NA, NA, TRUE, FALSE, NA) + x <- c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, NA, NA, NA) + y <- c(TRUE, FALSE, NA, TRUE, FALSE, NA, TRUE, FALSE, NA) + z <- c(TRUE, TRUE, FALSE, FALSE, NA, NA, TRUE, FALSE, NA) - # nolint start: object_name_linter. - xL <- as.integer(x) - xD <- as.double(x) - # nolint end: object_name_linter. + xL <- as.integer(x) # nolint: object_name_linter. + xD <- as.double(x) # nolint: object_name_linter. res_n <- logical(length(x)) - res_xy_and <- res_n + res_xy_and <- res_n res_xy_and_na <- res_n - res_xy_or <- res_n - res_xy_or_na <- res_n + res_xy_or <- res_n + res_xy_or_na <- res_n - res_xyz_and <- res_n + res_xyz_and <- res_n res_xyz_and_na <- res_n - res_xyz_or <- res_n - res_xyz_or_na <- res_n + res_xyz_or <- res_n + res_xyz_or_na <- res_n for (i in seq_along(x)) { res_xy_and[i] <- x[i] & y[i] - res_xy_or[i] <- x[i] | y[i] + res_xy_or[i] <- x[i] | y[i] res_xyz_and[i] <- x[i] & y[i] & z[i] - res_xyz_or[i] <- x[i] | y[i] | z[i] + res_xyz_or[i] <- x[i] | y[i] | z[i] res_xy_and_na[i] <- all(x[i], y[i], na.rm = TRUE) - res_xy_or_na[i] <- any(x[i], y[i], na.rm = TRUE) + res_xy_or_na[i] <- any(x[i], y[i], na.rm = TRUE) res_xyz_and_na[i] <- all(x[i], y[i], z[i], na.rm = TRUE) - res_xyz_or_na[i] <- any(x[i], y[i], z[i], na.rm = TRUE) + res_xyz_or_na[i] <- any(x[i], y[i], z[i], na.rm = TRUE) } - expect_equal(is_true(x), sapply(x, isTRUE, USE.NAMES = FALSE)) + expect_equal(is_true(x), sapply(x, isTRUE, USE.NAMES = FALSE)) expect_equal(is_false(x), sapply(x, isFALSE, USE.NAMES = FALSE)) - expect_identical(is_true(c(TRUE, FALSE, NA)), c(TRUE, FALSE, FALSE)) # nolint: spaces_inside_linter, line_length_linter. - expect_identical(is_false(c(TRUE, FALSE, NA)), c(FALSE, TRUE, FALSE)) + expect_identical(is_true( c(TRUE, FALSE, NA)), c(TRUE, FALSE, FALSE)) + expect_identical(is_false(c(TRUE, FALSE, NA)), c(FALSE, TRUE, FALSE)) expect_true(is_boolean(x)) expect_true(is_boolean(xL)) expect_true(is_boolean(xD)) - expect_equal(AND(x, y), res_xy_and) + expect_equal(AND(x, y), res_xy_and) expect_equal(AND(x, y, na.rm = TRUE), res_xy_and_na) - expect_equal(AND(x, y, z), res_xyz_and) + expect_equal(AND(x, y, z), res_xyz_and) expect_equal(AND(x, y, z, na.rm = TRUE), res_xyz_and_na) - expect_equal(OR(x, y), res_xy_or) + expect_equal(OR(x, y), res_xy_or) expect_equal(OR(x, y, na.rm = TRUE), res_xy_or_na) - expect_equal(OR(x, y, na.rm = TRUE), res_xy_or_na) + expect_equal(OR(x, y, na.rm = TRUE), res_xy_or_na) expect_equal(OR(x, y, z, na.rm = TRUE), res_xyz_or_na) }) @@ -63,16 +64,18 @@ test_that("logical helpers", { expect_error( apply_logical_matrix(1L, mean, TRUE), - class = "simpleError" + class = "mark:input_error" ) expect_error( apply_logical_matrix(matrix("a"), mean, TRUE), - class = "simpleError" + class = "mark:input_error" ) expect_error( apply_logical_matrix(matrix(3L), mean, TRUE), - class = "simpleError" + class = "mark:input_error" ) }) + +# nolint end: spaces_inside_linter. From 242b5a2c74778f4cff815e70399b6b1d82e09088 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 30 Dec 2025 23:14:37 -0500 Subject: [PATCH 077/169] reformats class error default text (#259) --- R/aaa.R | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 968da5cd..7235ae22 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -63,24 +63,38 @@ conversion_error := condition( ) class_error := condition( - function(type, x, must) { + function(type, x, must, name) { + if (missing(name)) { + name <- sprintf( + "`%s`", + deparse( + match.call( + sys.function(sys.parent(1L)), + sys.call(sys.parent(1L)), + envir = parent.frame(3L) + )$x + ) + ) + } cls <- class(x) switch( type, not_supported = sprintf( ngettext( length(cls), - "Class not supported: %s", - "Classes not supported: %s", + "%s cannot be of class: %s", + "%s cannot be of classes: %s", ), + name %||% "Object", toString(cls) ), must_be = sprintf( ngettext( length(cls), - "Object must be of class '%s', not '%s'", - "Object must be of class '%s', not classes '%s'" + "%s must be of class '%s', not '%s'", + "%s must be of class '%s', not classes '%s'" ), + name %||% "Object", toString(must), toString(cls) ), From 976b59ce6826ee478dc5e4f83ab27d086ca1d7c8 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 30 Dec 2025 23:14:56 -0500 Subject: [PATCH 078/169] improves conversion errors (#259) --- R/base-conversion.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/base-conversion.R b/R/base-conversion.R index e374be27..c4754292 100644 --- a/R/base-conversion.R +++ b/R/base-conversion.R @@ -15,7 +15,7 @@ #' sum(base_alpha(c("x", "k", "c", "d"))) base_alpha <- function(x, base = 26) { - stopifnot(is.character(x)) + x <- as.character(x) check_base_alpha(base, high = 26) vap_int(x, base_alpha_single, base = base) } @@ -55,7 +55,9 @@ base_alpha_single <- function(x, base) { #' @examples #' base_n(c(24, 22, 16), from = 7) base_n <- function(x, from = 10, to = 10) { - stopifnot(is.numeric(x)) + if (!is.numeric(x)) { + stop(class_error("must_be", x, "numeric")) + } if (from == to) { return(x) From a184982995103ec4ed2110e8dd07725ec266c7fc Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 30 Dec 2025 23:15:07 -0500 Subject: [PATCH 079/169] improves blank errors (#259) --- R/blank.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/blank.R b/R/blank.R index 49ae6747..06083218 100644 --- a/R/blank.R +++ b/R/blank.R @@ -41,12 +41,13 @@ remove_blank_cols <- function(x, na_blank = FALSE, ws = TRUE) { #' @rdname blank_values #' @export is_blank_cols <- function(x, names = TRUE, na_blank = FALSE, ws = TRUE) { - stopifnot(is.data.frame(x)) + if (!is.data.frame(x)) { + stop(class_error("must_be", x, "data.frame")) + } + vap_lgl( x, - function(i) { - all(is_blank(i, na_blank = na_blank, ws = ws)) - }, + function(i) all(is_blank(i, na_blank = na_blank, ws = ws)), .nm = names ) } From 9e09a4f689112c7e8bfe56e133722d20450805ec Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 30 Dec 2025 23:15:17 -0500 Subject: [PATCH 080/169] improves fact2char errors (#259) --- R/char2fact.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/char2fact.R b/R/char2fact.R index c5e48819..024c2437 100644 --- a/R/char2fact.R +++ b/R/char2fact.R @@ -57,7 +57,9 @@ char2fact.data.frame <- function(x, n = 5) { #' @family factors #' @export fact2char <- function(data, threshold = 10) { - stopifnot(is.data.frame(data)) + if (!is.data.frame(data)) { + stop(class_error("must_be", data, "data.frame")) + } # for factors with more than threshold levels, convert back to character bad <- lengths(lapply(data, levels)) >= threshold data[bad] <- lapply(data[bad], as.character) From 4c5115a315dbccf8393eaca1b58b109bd8351d3a Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 30 Dec 2025 23:15:25 -0500 Subject: [PATCH 081/169] improves counts errors (#259) --- R/counts.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/counts.R b/R/counts.R index 82854ad2..96b15aef 100644 --- a/R/counts.R +++ b/R/counts.R @@ -204,7 +204,13 @@ props_n <- function( } remake_df <- function(new, old) { - stopifnot(is.data.frame(new), is.data.frame(old)) + if (!is.data.frame(new)) { + stop(class_error("must_be", new, "data.frame")) + } + + if (!is.data.frame(old)) { + stop(class_error("must_be", old, "data.frame")) + } new_cn <- colnames(new) old_cn <- colnames(old) From df2f72dfad29e5974c0e0c84fd79560a0bda1b49 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 30 Dec 2025 23:15:32 -0500 Subject: [PATCH 082/169] formatting (#259) --- R/handlers.R | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/R/handlers.R b/R/handlers.R index 23e544c9..e9c664dc 100644 --- a/R/handlers.R +++ b/R/handlers.R @@ -45,41 +45,48 @@ NULL #' @export #' @rdname handlers -has_warning <- function(x, FUN, ...) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +has_warning <- function(x, FUN, ...) { has_catch(x, FUN, ..., type = "warning") } #' @export #' @rdname handlers -has_error <- function(x, FUN, ...) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +has_error <- function(x, FUN, ...) { has_catch(x, FUN, ..., type = "error") } #' @export #' @rdname handlers -has_message <- function(x, FUN, ...) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +has_message <- function(x, FUN, ...) { has_catch(x, FUN, ..., type = "message") } #' @export #' @rdname handlers -get_warning <- function(x, FUN, ..., .null = TRUE) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +get_warning <- function(x, FUN, ..., .null = TRUE) { get_catch(x, FUN, type = "warning", null = .null) } #' @export #' @rdname handlers -get_message <- function(x, FUN, ..., .null = TRUE) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +get_message <- function(x, FUN, ..., .null = TRUE) { get_catch(x, FUN, type = "message", null = .null) } #' @export #' @rdname handlers -get_error <- function(x, FUN, ..., .null = TRUE) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +get_error <- function(x, FUN, ..., .null = TRUE) { get_catch(x, FUN, type = "error", null = .null) } -has_catch <- function(x, FUN, ..., type = c("error", "warning", "message")) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +has_catch <- function(x, FUN, ..., type = c("error", "warning", "message")) { type <- match_param(type) FUN <- match.fun(FUN) # nolint: object_name_linter. res <- sapply(x, catch(FUN), ..., USE.NAMES = TRUE, simplify = FALSE) @@ -95,7 +102,8 @@ print.has_catch <- function(x, ...) { invisible(x) } -get_catch <- function(x, FUN, type, ..., null = TRUE) { # nolint: object_name_linter, line_length_linter. +# nolint next: object_name_linter +get_catch <- function(x, FUN, type, ..., null = TRUE) { res <- sapply(x, catch(FUN), ..., USE.NAMES = TRUE, simplify = FALSE) out <- sapply(res, function(i) i[[type]], USE.NAMES = TRUE, simplify = FALSE) out <- set_names(out, x) @@ -108,14 +116,14 @@ get_catch <- function(x, FUN, type, ..., null = TRUE) { # nolint: object_name_li } # Adapted from https://stackoverflow.com/a/4952908/12126576 -catch <- function(FUN) { # nolint: object_name_linter. - FUN <- match.fun(FUN) # nolint: object_name_linter. +catch <- function(fun) { + fun <- match.fun(fun) function(...) { env <- list2env(list(error = NULL, warning = NULL, message = NULL)) res <- withCallingHandlers( tryCatch( - FUN(...), + fun(...), error = function(e) { env$error <- c(env$error, e$message) NULL From f78d8cc3d050248b3fb519a32dde7507373b8e3f Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 30 Dec 2025 23:15:38 -0500 Subject: [PATCH 083/169] improves insert errors (#259) --- R/insert.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/insert.R b/R/insert.R index aad0ed42..85b31b5a 100644 --- a/R/insert.R +++ b/R/insert.R @@ -13,9 +13,15 @@ #' #' @export insert <- function(x, positions, values) { - stopifnot(!anyNA(positions)) + if (anyNA(positions)) { + stop(input_error("positions cannot contain NA values")) + } + positions <- as.integer(positions) - stopifnot(length(positions) >= 1) + + if (any(positions < 1L)) { + stop(input_error("positions must be positive integers")) + } nval <- length(values) npos <- length(positions) From de4a1dd731afc0874b756f221fc4edd91ea8b545 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 31 Dec 2025 16:27:04 -0500 Subject: [PATCH 084/169] cleans up base conversions conditions (#259) --- R/base-conversion.R | 35 +++++++++++++-------------- tests/testthat/test-base-conversion.R | 5 ++-- 2 files changed, 19 insertions(+), 21 deletions(-) diff --git a/R/base-conversion.R b/R/base-conversion.R index c4754292..c82d392d 100644 --- a/R/base-conversion.R +++ b/R/base-conversion.R @@ -13,18 +13,14 @@ #' base_alpha("XFD") #' base_alpha(c("JMB", "Jordan Mark", "XKCD")) #' sum(base_alpha(c("x", "k", "c", "d"))) - -base_alpha <- function(x, base = 26) { - x <- as.character(x) - check_base_alpha(base, high = 26) +base_alpha <- function(x, base = 26L) { + if (!is.character(x)) { + stop(class_error("must_be", x, "character")) + } + check_base_alpha(base, high = 26L) vap_int(x, base_alpha_single, base = base) } -alpha_base <- function(x, base = 26) { - .Deprecated("base_alpha") - base_alpha(x, base = base) -} - base_alpha_single <- function(x, base) { a <- chr_split(tolower(x)) %wi% letters a <- match(a, letters[1:base], nomatch = NA_integer_) @@ -35,11 +31,11 @@ base_alpha_single <- function(x, base) { n <- length(a) - if (n == 0) { + if (n == 0L) { return(NA_integer_) } - as.integer(sum(c(a[-n] * base^(1:(n - 1)), a[n]))) + as.integer(sum(c(a[-n] * base^(1:(n - 1L)), a[n]))) } #' Base N conversion @@ -54,16 +50,19 @@ base_alpha_single <- function(x, base) { #' @export #' @examples #' base_n(c(24, 22, 16), from = 7) -base_n <- function(x, from = 10, to = 10) { +base_n <- function(x, from = 10L, to = 10L) { if (!is.numeric(x)) { stop(class_error("must_be", x, "numeric")) } + from <- as.integer(from) + to <- as.integer(to) + if (from == to) { return(x) } - if (to != 10) { + if (to != 10L) { stop(base_conversion_error("ten")) } @@ -82,11 +81,11 @@ base_n_single <- function(x, base) { as.integer(sum(mapply(function(i, s) i * base^s, i = ints, s = seqs))) } -check_base_alpha <- function(b, high = 26) { +check_base_alpha <- function(b, high = 26L) { if (is.character(b)) { b <- chr_split(b) - if (length(b) != 1) { + if (length(b) != 1L) { stop(base_conversion_error("alpha_length")) } @@ -96,12 +95,12 @@ check_base_alpha <- function(b, high = 26) { check_base(b, high = high) } -check_base <- function(b, high = 9) { - if (b %% 1 != 0) { +check_base <- function(b, high = 9L) { + if (b %% 1L != 0L) { stop(base_conversion_error("integer")) } - if (b > high || b <= 1) { + if (b > high || b <= 1L) { stop(base_conversion_error("limit", high = high)) } } diff --git a/tests/testthat/test-base-conversion.R b/tests/testthat/test-base-conversion.R index 1c91225b..e355e8b8 100644 --- a/tests/testthat/test-base-conversion.R +++ b/tests/testthat/test-base-conversion.R @@ -10,7 +10,6 @@ test_that("base_alpha() works as expected", { base_alpha(letters[1:10], 9), class = "mark:base_conversion_error" ) - expect_warning(alpha_base(letters), "deprecated") expect_identical(base_alpha_single("a", 26), 1L) expect_identical(base_alpha_single("j", 26), 10L) @@ -27,8 +26,8 @@ test_that("base_n() works as expected", { }) test_that("base_alpha(), base_n() fails", { - expect_error(base_alpha(1), class = "simpleError") - expect_error(base_n("a"), class = "simpleError") + expect_error(base_alpha(1), class = "mark:class_error") + expect_error(base_n("a"), class = "mark:class_error") expect_error(base_n(1, 10, 12), class = "mark:base_conversion_error") }) From a4ca36f2b4492df776544b2412acb647aaa7c220 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 31 Dec 2025 16:27:14 -0500 Subject: [PATCH 085/169] corrects test (#259) --- tests/testthat/test-char2fact.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-char2fact.R b/tests/testthat/test-char2fact.R index 908543fa..0ecec32f 100644 --- a/tests/testthat/test-char2fact.R +++ b/tests/testthat/test-char2fact.R @@ -27,7 +27,7 @@ test_that("char2fact.data.frame() works", { }) test_that("fact2char() works", { - expect_error(fact2char(letters), class = "simpleError") + expect_error(fact2char(letters), class = "mark:class_error") df <- quick_dfl( a = 1:5, From 65b59268b1318b563e25f926717c5fa8fcad41a6 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 31 Dec 2025 16:28:19 -0500 Subject: [PATCH 086/169] corrects name (#259) --- R/directory.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/directory.R b/R/directory.R index 7b87873f..205466dc 100644 --- a/R/directory.R +++ b/R/directory.R @@ -394,7 +394,7 @@ is_file <- function(x) { file_create <- function(x, overwrite = FALSE) { dirs <- is_dir(x) if (any(dirs)) { - warning(file_warning("directories", x[dirs])) + warning(path_warning("directories", x[dirs])) x <- x[!dirs] } From 7e44ea77271959d86b4e7d62b5f8b269032e488b Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 31 Dec 2025 16:28:48 -0500 Subject: [PATCH 087/169] uses general error (#259) --- R/insert.R | 14 +------------- tests/testthat/test-insert.R | 7 ++++--- 2 files changed, 5 insertions(+), 16 deletions(-) diff --git a/R/insert.R b/R/insert.R index 85b31b5a..abf94fea 100644 --- a/R/insert.R +++ b/R/insert.R @@ -33,7 +33,7 @@ insert <- function(x, positions, values) { positions <- positions[o] values <- values[o] } else { - stop(insert_error()) + stop(input_error("lengths of positions and values are unequal")) } seqs <- seq_along(positions) @@ -45,15 +45,3 @@ insert <- function(x, positions, values) { x } - -# conditions -------------------------------------------------------------- - -insert_error := condition( - "lengths of positions and values are unequal", - type = "error", - exports = "insert", - help = c( - "insert() requires that `positions` and `values` are the same length or", - " that `values` is length 1" - ) -) diff --git a/tests/testthat/test-insert.R b/tests/testthat/test-insert.R index 637a73ae..c10c4c14 100644 --- a/tests/testthat/test-insert.R +++ b/tests/testthat/test-insert.R @@ -7,9 +7,10 @@ test_that("insert.default() works", { exp <- c("z", "a", "b", "z", "c", "d") expect_identical(res, exp) - expect_error(insert(1, NA, 1), class = "simpleError") - expect_error(insert(1, integer(), 1), class = "simpleError") - expect_error(insert(1, 1, integer()), class = "mark:insert_error") + expect_error(insert(1, NA, 1), class = "mark:input_error") + expect_error(insert(1, integer(), 1), NA) # this is actually fine + expect_error(insert(1, integer(), integer()), NA) # this is actually fine + expect_error(insert(1, 1, integer()), class = "mark:input_error") }) test_that("insert.data.frame() works", { From 9baa69207218a447780eb0c2043e94cb73a8372a Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 31 Dec 2025 17:11:29 -0500 Subject: [PATCH 088/169] formatting (#259) --- R/funs.R | 2 +- R/identical.R | 3 +-- R/import.R | 2 +- R/labels.R | 10 +++++----- R/lines-of-code.R | 5 ++--- R/logic.R | 22 +++++++++++----------- 6 files changed, 21 insertions(+), 23 deletions(-) diff --git a/R/funs.R b/R/funs.R index 04d6ccd4..a381c175 100644 --- a/R/funs.R +++ b/R/funs.R @@ -38,7 +38,7 @@ rn <- function(namespace) { #' Check if package is available #' -#' A wrapped requireNamespace +#' A wrapped [base::requireNamespace()] #' #' @param namespace One or more packages to to require. #' @export diff --git a/R/identical.R b/R/identical.R index 31a6a78e..96346330 100644 --- a/R/identical.R +++ b/R/identical.R @@ -1,6 +1,6 @@ #' Identical extensions #' -#' Extensions for the use of `base::identical()` +#' Extensions for the use of [base::identical()] #' #' @param ... Vectors of values to compare, element-wise of equal length #' @param params Additional params (as a named list of arguments for @@ -18,7 +18,6 @@ #' are_identical(x, y) # element-wise #' are_identical(x, y, z) # 3 or more vectors #' @export - are_identical <- function(..., params = NULL) { x <- rlang::list2(...) n <- length(x) diff --git a/R/import.R b/R/import.R index ec34ad7c..35c559d1 100644 --- a/R/import.R +++ b/R/import.R @@ -4,7 +4,7 @@ #' #' @param pkg String, name of the package #' @param fun String, fun name of the function -#' @param overwrite Logical, if TRUE and `fun` is also found in the current +#' @param overwrite Logical, if `TRUE` and `fun` is also found in the current #' environment, will overwrite assignment #' @return None, called for side effects #' @export diff --git a/R/labels.R b/R/labels.R index fb7cd2f5..b1061be7 100644 --- a/R/labels.R +++ b/R/labels.R @@ -4,14 +4,14 @@ #' #' @details #' When labels are assigned to a data.frame they can make viewing the object -#' (with `View()` inside Rstudio). The `view_labels()` has a call to `View()` +#' (with `View()` inside Rstudio). [view_labels()] has a call to `View()` #' inside and will retrieve the labels and show them in the viewer as a #' data.frame. #' #' @param x A vector of data.frame #' @param ... One or more unquoted expressed separated by commas. If assigning #' to a data.frame, `...` can be replaced with a `data.frame` where the first -#' column is the targeted colname and the second is the desired label. +#' column is the targeted column name and the second is the desired label. #' @param label A single length string of a label to be assigned #' @param cols A character vector of column names; if missing will remove the #' label attribute across all columns @@ -54,9 +54,9 @@ assign_labels.default <- function(x, label, ...) { #' @export #' @rdname labels -#' @param .missing A control setting for dealing missing columns in a list; -#' can be set to `error` to `stop()` the call, `warn` to provide a warning, or -#' `skip` to silently skip those labels. +#' @param .missing A control setting for dealing missing columns in a list; can +#' be set to `"error"` to [stop()] the call, `"warn"` to provide a warning, or +#' `"skip"` to silently skip those labels. #' @param .ls A named list of columns and labels to be set if `...` is empty assign_labels.data.frame <- function( x, diff --git a/R/lines-of-code.R b/R/lines-of-code.R index 349553a5..8d91f5ea 100644 --- a/R/lines-of-code.R +++ b/R/lines-of-code.R @@ -1,6 +1,6 @@ -#' Lines of R code +#' Lines of **R** code #' -#' Find the total number of lines of R code +#' Find the total number of lines of **R** code #' #' @details #' Tries to read each file in the directory that ends in .R or .r and sums @@ -18,7 +18,6 @@ #' lines_of_r_code(system.file()) #' lines_of_r_code(system.file(), skip_empty = FALSE) #' } - lines_of_r_code <- function(x = ".", skip_empty = TRUE) { if (dir.exists(x)) { x <- list_r_files(x) diff --git a/R/logic.R b/R/logic.R index 869bb242..e16b247a 100644 --- a/R/logic.R +++ b/R/logic.R @@ -1,20 +1,20 @@ -#' Logic - Extension' +#' Logic - Extensions #' #' Logical operations, extended #' -#' @description All functions take logical or logical-like (i.e., 1, 0, or NA as -#' integer or doubles) and return logical values. +#' @description All functions take logical or logical-like (i.e., `1`, `0`, or +#' `NA` as integer or doubles) and return logical values. #' -#' Extensions to the base logical operations to account for `NA` values. +#' Extensions to the base logical operations to account for `NA` values. #' -#' [base::isTRUE()] and [base::isFALSE()] will only return single length `TRUE` -#' or `FALSE` as it checks for valid lengths in the evaluation. When needing to -#' check over a vector for the presence of `TRUE` or `FALSE` and not being held -#' back by `NA` values, `is_true` and `is_false` will always provide a `TRUE` -#' `FALSE` when the vector is logical or return `NA` is the vector `x` is not -#' logical. +#' [base::isTRUE()] and [base::isFALSE()] will only return single length +#' `TRUE` or `FALSE` as it checks for valid lengths in the evaluation. When +#' needing to check over a vector for the presence of `TRUE` or `FALSE` and +#' not being held back by `NA` values, [is_true()] and [is_false()] will +#' always provide a `TRUE` `FALSE` when the vector is logical or return `NA` +#' is the vector `x` is not logical. #' -#' `%or%` is just a wrapper for [base::xor()] +#' `%or%` is just a wrapper for [base::xor()] #' #' @param x,y A vector of logical values. If `NULL` will generate a warning. #' If not a logical value, will return `NA` equal to the vector length From c28402560427985ad26de63552ebc74fd9d08174 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 31 Dec 2025 17:11:37 -0500 Subject: [PATCH 089/169] updates conditions for limit (#259) --- R/limit.R | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/R/limit.R b/R/limit.R index ea765e51..4a6ad97f 100644 --- a/R/limit.R +++ b/R/limit.R @@ -11,13 +11,15 @@ #' #' @export limit <- function(x, lower = min(x), upper = max(x)) { - stopifnot( - length(lower) == 1L, - length(upper) == 1L, - is.numeric(lower), - is.numeric(upper), - lower <= upper - ) + if (!(is.numeric(lower) && is.numeric(upper))) { + stop(class_error("must_be", c(lower, upper), "numeric")) + } + + if (!(length(lower) == 1L && length(upper) == 1L && lower <= upper)) { + stop(input_error( + "`lower` and `upper` must be single numeric values with `lower <= upper`" + )) + } x[x < lower] <- lower x[x > upper] <- upper From 48453d623dc8ffe6341d4a1462104982e2be4117 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 31 Dec 2025 17:12:10 -0500 Subject: [PATCH 090/169] updates tests (#259) --- tests/testthat/test-limit.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-limit.R b/tests/testthat/test-limit.R index 9543a0a4..a31b0d2e 100644 --- a/tests/testthat/test-limit.R +++ b/tests/testthat/test-limit.R @@ -4,9 +4,9 @@ test_that("limit() works", { }) test_that("limit() errors", { - expect_error(limit(1, "a", 1), class = "simpleError") - expect_error(limit(1, 1:2, 1), class = "simpleError") - expect_error(limit(1, 1, "a"), class = "simpleError") - expect_error(limit(1, 1, 1:2), class = "simpleError") - expect_error(limit(1, 2, 1), class = "simpleError") + expect_error(limit(1, "a", 1), class = "mark:class_error") + expect_error(limit(1, 1, "a"), class = "mark:class_error") + expect_error(limit(1, 1:2, 1), class = "mark:input_error") + expect_error(limit(1, 1, 1:2), class = "mark:input_error") + expect_error(limit(1, 2, 1), class = "mark:input_error") }) From df21718201d30e9a3e7135a7ec3d9c4f609e56b8 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Thu, 1 Jan 2026 21:45:08 -0500 Subject: [PATCH 091/169] clean up match param errors (#259) --- R/match-arg.R | 89 ++++++++++++++++++++++++--------------------------- 1 file changed, 42 insertions(+), 47 deletions(-) diff --git a/R/match-arg.R b/R/match-arg.R index bc9ad382..3152cd9e 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -30,6 +30,7 @@ #' try(foo(1, 0)) #' @export match_arg <- function(x, table) { + .Deprecated("match_param()") if (is.null(x)) { return(NULL) } @@ -120,7 +121,7 @@ match_param <- function( return(NULL) } - stop(match_arg_null_param()) + stop(input_error("match_param() requires non-NULL params")) } missing_choices <- missing(choices) @@ -135,7 +136,38 @@ match_param <- function( if (anyDuplicated(unlist(mchoices$choices))) { # TODO implement cond_match_param_dupes() - stop(match_param_duplicates(choices)) + to_choices <- function(x) { + if (all(names(x) == as.character(x))) { + dupe <- duplicated(x) + x[dupe] <- paste0(x[dupe], "*") + return(toString(x)) + } + + collapse( + mapply( + function(x, nm, d) { + sprintf( + "%s = %s", + nm, + toString(paste0(x, ifelse(d, "*", ""))) + ) + }, + x = x, + nm = names(x), + d = split( + duplicated(unlist(x)), + rep(seq_along(x), lengths(x)) + ), + USE.NAMES = FALSE + ), + sep = "\n " + ) + } + + stop(input_error(paste0( + "duplicate values found in `choices`:\n ", + to_choices(choices) + ))) } fun <- if (partial) pmatch else match @@ -151,7 +183,12 @@ match_param <- function( param <- deparse(param) } - stop(match_arg_param_match(param_c, ocall, param, choices)) + stop(match_param_error( + input = param_c, + argument = ocall, + param = param, + choices = choices + )) } res <- lapply(m, function(i) mchoices$values[[i]]) @@ -190,6 +227,7 @@ cleanup_param_list <- function(x) { # conditions -------------------------------------------------------------- +# TODO remove match_arg_no_match := condition( message = function(csx, x, table) { sprintf( @@ -202,12 +240,7 @@ match_arg_no_match := condition( type = "error" ) -match_arg_null_param := condition( - message = "match_param() requires non-NULL params", - type = "error" -) - -match_arg_param_match := condition( +match_param_error := condition( message = function(input, argument, param, choices) { to_value <- function(x) { if (all(names(x) == as.character(x))) { @@ -260,41 +293,3 @@ match_arg_param_match := condition( }, type = "error" ) - -match_param_duplicates := condition( - message = function(choices) { - to_choices <- function(x) { - if (all(names(x) == as.character(x))) { - dupe <- duplicated(x) - x[dupe] <- paste0(x[dupe], "*") - return(toString(x)) - } - - collapse( - mapply( - function(x, nm, d) { - sprintf( - "%s = %s", - nm, - toString(paste0(x, ifelse(d, "*", ""))) - ) - }, - x = x, - nm = names(x), - d = split( - duplicated(unlist(x)), - rep(seq_along(x), lengths(x)) - ), - USE.NAMES = FALSE - ), - sep = "\n " - ) - } - - paste0( - "duplicate values found in `choices`:\n ", - to_choices(choices) - ) - }, - type = "error" -) From 7b614a1857eeb0b9d33da459536d79c6ecb95481 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Thu, 1 Jan 2026 21:45:15 -0500 Subject: [PATCH 092/169] uses new error (#259) --- tests/testthat/test-write.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 094fb4a1..eb726f80 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -55,7 +55,7 @@ test_that("write_file_md5() errors", { df <- quick_dfl(a = 1) expect_error( write_file_md5(df, method = "foo"), - class = "mark:match_arg_param_match" + class = "mark:match_param_error" ) }) From 835d899089c2856ff711db38917e18edc186f214 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Thu, 1 Jan 2026 21:45:18 -0500 Subject: [PATCH 093/169] updates tests (#259) --- tests/testthat/test-match-arg.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test-match-arg.R b/tests/testthat/test-match-arg.R index 8343c76b..5ea67272 100644 --- a/tests/testthat/test-match-arg.R +++ b/tests/testthat/test-match-arg.R @@ -15,16 +15,16 @@ test_that("match_param() works", { sep = "\n" ), fixed = TRUE, - class = "mark:match_arg_param_match" + class = "mark:match_param_error" ) foo2 <- function(y = 1:3) { match_param(y) } - expect_equal(foo2(1), 1) - expect_equal(foo2(1L), 1L) - expect_equal(foo2("1"), 1) + expect_identical(foo2(1), 1L) + expect_identical(foo2(1L), 1L) + expect_identical(foo2("1"), 1L) foo <- function(x = NULL) { match_param(tolower(x), c("a", "b", "c")) @@ -38,7 +38,7 @@ test_that("match_param() works", { " choices a, b, c", sep = "\n" ), - class = "mark:match_arg_param_match", + class = "mark:match_param_error", fixed = TRUE ) @@ -46,7 +46,7 @@ test_that("match_param() works", { match_param(x, null = null) } - expect_error(foo(NULL), class = "mark:match_arg_null_param") + expect_error(foo(NULL), class = "mark:input_error") expect_null(foo(NULL, null = TRUE)) }) @@ -56,7 +56,7 @@ test_that("match_param() can partialy match", { } expect_identical(fruits(), "apple") - expect_error(fruits("a"), class = "mark:match_arg_param_match") + expect_error(fruits("a"), class = "mark:match_param_error") expect_identical(fruits("app"), "apple") fruits <- function(x = list("apple" = 1:2, "apricot" = 3, "banana" = 4)) { @@ -64,7 +64,7 @@ test_that("match_param() can partialy match", { } expect_identical(fruits(), "apple") - expect_error(fruits(c(a = 0)), class = "mark:match_arg_param_match") + expect_error(fruits(c(a = 0)), class = "mark:match_param_error") expect_identical(fruits(1), "apple") }) @@ -78,7 +78,7 @@ test_that("match_param() accepts can return multiple", { test_that("match_arg() works", { foo <- function(x = c("a", "b"), table) { - match_arg(x, table) + suppressWarnings(match_arg(x, table), "deprecatedWarning") } expect_null(foo(NULL)) @@ -115,11 +115,11 @@ test_that("match_param() accepts formula lists", { test_that("match_param() finds duplicate choices", { expect_error( match_param("a", c("a", "a")), - class = "mark:match_param_duplicates" + class = "mark:input_error" ) expect_error( match_param(1, c(a = 1:2, b = 3:4, c = c(1, 3))), - class = "mark:match_param_duplicates" + class = "mark:input_error" ) }) From 9a17333495dfe499cc668f4258d26158fe0de432 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Fri, 2 Jan 2026 23:57:49 -0500 Subject: [PATCH 094/169] clean up map (#259) --- R/map.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/map.R b/R/map.R index 98331142..511b0ec0 100644 --- a/R/map.R +++ b/R/map.R @@ -1,3 +1,5 @@ +# TODO just remove this; no longer needed + #' mapply with NULLs #' #' mapply (basically) but with NULLs @@ -17,19 +19,21 @@ #' x <- list(a = 1:2, b = NULL, c = 3) #' mark:::mapply0(foo, x) #' @noRd -mapply0 <- function(FUN, params = NULL, ...) { # nolint: object_name_linter. - params <- c(params, rlang::list2(...)) +# nolint next: object_name_linter. +mapply0 <- function(FUN, params = NULL, ...) { + params <- c(params, rlang::list2(...)) FUN <- match.fun(FUN) # nolint: object_name_linter. n <- max(lengths(params)) p_list <- lapply( params, - function(x) { + function(x) { lx <- as.list(x) names(lx) <- x rep_len(lx, n) - }) + } + ) result <- rep_len(list(), n) From 0732a00a33db09ddc0e31dc390e0011b80ef2d7f Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Fri, 2 Jan 2026 23:57:53 -0500 Subject: [PATCH 095/169] skip formatting (#259) --- R/mark-package.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/mark-package.R b/R/mark-package.R index 1b3862d5..75c5777e 100644 --- a/R/mark-package.R +++ b/R/mark-package.R @@ -9,6 +9,7 @@ "_PACKAGE" # nolint next: object_name_linter. +# fmt: skip op.mark <- list( mark.author = NULL, # control for check_interactive() to return interactive() or TRUE From 11c1b0e2cc44e1bb7cbdb3bbd2f9d89c38be51a9 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Fri, 2 Jan 2026 23:59:31 -0500 Subject: [PATCH 096/169] updates conditions for merge-list (#259) --- R/merge-list.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/merge-list.R b/R/merge-list.R index 84af824a..c07c6477 100644 --- a/R/merge-list.R +++ b/R/merge-list.R @@ -40,12 +40,19 @@ merge_list <- function( null <- c(null, null) } - stopifnot(length(null) == 2L) + if (!length(null) == 2L) { + stop(input_error("`null` must be length 1 or 2")) + } + keep <- match_param(keep) x <- x %||% list() y <- y %||% list() - stopifnot(is.list(x), is.list(y)) + # TODO report `x` vs `y` + if (!is.list(x) || !is.list(y)) { + stop(class_error("must_be", x = if (!is.list(x)) x else y, "list")) + } + xx <- x x <- switch( From ec7dafe05ee38cb252364dd5be0d5b0d04d99788 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 3 Jan 2026 14:08:16 -0500 Subject: [PATCH 097/169] simplifies na errors (#259) --- R/na-assignment.R | 47 ++++++++++++++++------------------------------- 1 file changed, 16 insertions(+), 31 deletions(-) diff --git a/R/na-assignment.R b/R/na-assignment.R index ba7b078d..6cdc4606 100644 --- a/R/na-assignment.R +++ b/R/na-assignment.R @@ -46,17 +46,16 @@ NA_at <- function(x, y, ...) { y <- FUN(x, ...) } - # FIXME replace with a single condition if (any(y %% 1 > 0, na.rm = TRUE)) { - stop(na_at_integer()) + stop(na_error("integer")) } if (!isTRUE(max(y, na.rm = TRUE) <= nx)) { - stop(na_at_max()) + stop(na_error("max")) } if (!isTRUE(length(y) <= nx)) { - stop(na_at_length()) + stop(na_error("length")) } x[y] <- NA @@ -80,11 +79,11 @@ NA_if <- function(x, y, ...) { # FIXME replace with a single condition if (length(y) != nx) { - stop(na_if_length()) + stop(na_error("length")) } if (!is.logical(y)) { - stop(na_if_logical()) + stop(na_error("logical")) } x[y] <- NA @@ -128,30 +127,16 @@ NA_out <- function(x, y, ...) { # conditions -------------------------------------------------------------- -na_at_integer := condition( - message = "y must be a vector of integers", - type = "error" -) - - -na_at_max := condition( - message = "length of y must not be greater than length of x", - type = "error" -) - -na_at_length := condition( - message = "length of y must not be greater than length of x", +na_error := condition( + function(type) { + switch( + type, + integer = "y must be a vector of integers", + max = "length of y must not be greater than length of x", + length = "length of y must not be greater than length of x", + logical = "y must be logical" + ) + }, type = "error" + # TODO include help ) - -na_if_length := condition( - message = "y must be the same length as x", - type = "error" -) - -na_if_logical := condition( - message = "y must be logical", - type = "error" -) - -# terminal line From fd5f657627d371c43f0f5c885b9a5228880dbec3 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 3 Jan 2026 14:08:20 -0500 Subject: [PATCH 098/169] updates test (#259) --- tests/testthat/test-na-assignment.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-na-assignment.R b/tests/testthat/test-na-assignment.R index 3079b9ef..1c75296e 100644 --- a/tests/testthat/test-na-assignment.R +++ b/tests/testthat/test-na-assignment.R @@ -14,7 +14,7 @@ test_that("NA_at() and NA_if() work as expected", { expect_equal(NA_if(-1:3, foo), c(-1, 0, NA, NA, NA)) # y cannot be longer than x - expect_error(NA_at(x, 1:10), class = "mark:na_at_max") + expect_error(NA_at(x, 1:10), class = "mark:na_error") res <- NA_at(1:4, function(i) which(i %% 2 == 0)) exp <- c(1L, NA, 3L, NA) From be6125544ff817dcc380ab1e691dd2d61e720e84 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 3 Jan 2026 14:21:01 -0500 Subject: [PATCH 099/169] adds internal error (#259) --- R/na-assignment.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/na-assignment.R b/R/na-assignment.R index 6cdc4606..4226d051 100644 --- a/R/na-assignment.R +++ b/R/na-assignment.R @@ -134,7 +134,8 @@ na_error := condition( integer = "y must be a vector of integers", max = "length of y must not be greater than length of x", length = "length of y must not be greater than length of x", - logical = "y must be logical" + logical = "y must be logical", + stop(internal_error()) ) }, type = "error" From 567f712ca9bcf58b93812188565f566b5f41c35c Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 13:17:12 -0500 Subject: [PATCH 100/169] simplifies na-assignment errors (#259) --- R/na-assignment.R | 42 +++++++---------------------- tests/testthat/test-na-assignment.R | 2 +- 2 files changed, 11 insertions(+), 33 deletions(-) diff --git a/R/na-assignment.R b/R/na-assignment.R index 4226d051..3bbbcf44 100644 --- a/R/na-assignment.R +++ b/R/na-assignment.R @@ -42,20 +42,19 @@ NA_at <- function(x, y, ...) { } if (is.function(y)) { - FUN <- match.fun(y) # nolint: object_name_linter. - y <- FUN(x, ...) + y <- y(x, ...) } - if (any(y %% 1 > 0, na.rm = TRUE)) { - stop(na_error("integer")) + if (any(y %% 1L > 0, na.rm = TRUE)) { + stop(value_error("`y` must be a vector of integers")) } if (!isTRUE(max(y, na.rm = TRUE) <= nx)) { - stop(na_error("max")) + stop(value_error("`max(y)` cannot be greater than `length(x)`")) } if (!isTRUE(length(y) <= nx)) { - stop(na_error("length")) + stop(value_error("`length(y)` cannot be greater than `length(x)`")) } x[y] <- NA @@ -73,17 +72,16 @@ NA_if <- function(x, y, ...) { } if (is.function(y)) { - FUN <- match.fun(y) # nolint: object_name_linter. - y <- FUN(x, ...) + y <- y(x, ...) } # FIXME replace with a single condition if (length(y) != nx) { - stop(na_error("length")) + stop(value_error("`length(y)` cannot be greater than `length(x)`")) } if (!is.logical(y)) { - stop(na_error("logical")) + stop(value_error("`y` must be logical")) } x[y] <- NA @@ -99,8 +97,7 @@ NA_in <- function(x, y, ...) { } if (is.function(y)) { - FUN <- match.fun(y) # nolint: object_name_linter. - y <- FUN(x, ...) + y <- y(x, ...) } x[x %in% y] <- NA @@ -116,28 +113,9 @@ NA_out <- function(x, y, ...) { } if (is.function(y)) { - FUN <- match.fun(y) # nolint: object_name_linter. - y <- FUN(x, ...) + y <- y(x, ...) } x[x %out% y] <- NA x } - - -# conditions -------------------------------------------------------------- - -na_error := condition( - function(type) { - switch( - type, - integer = "y must be a vector of integers", - max = "length of y must not be greater than length of x", - length = "length of y must not be greater than length of x", - logical = "y must be logical", - stop(internal_error()) - ) - }, - type = "error" - # TODO include help -) diff --git a/tests/testthat/test-na-assignment.R b/tests/testthat/test-na-assignment.R index 1c75296e..6f9be74f 100644 --- a/tests/testthat/test-na-assignment.R +++ b/tests/testthat/test-na-assignment.R @@ -14,7 +14,7 @@ test_that("NA_at() and NA_if() work as expected", { expect_equal(NA_if(-1:3, foo), c(-1, 0, NA, NA, NA)) # y cannot be longer than x - expect_error(NA_at(x, 1:10), class = "mark:na_error") + expect_error(NA_at(x, 1:10), class = "mark:value_error") res <- NA_at(1:4, function(i) which(i %% 2 == 0)) exp <- c(1L, NA, 3L, NA) From f4510c2bec6d9c963e22033ff9ee8ed45d1c422b Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 13:22:06 -0500 Subject: [PATCH 101/169] replaces stopifnot() for normalize() (#259) --- R/normalize.R | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/R/normalize.R b/R/normalize.R index c7ce0a05..8d76999d 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -7,7 +7,7 @@ #' minimum/maximum values and lower/upper bounds. This allows for a vector of #' more than two values to be passed. #' -#' The current implementation of `normalize.data.frame()` allows for `list` of +#' The current implementation of [normalize.data.frame()] allows for `list` of #' parameters passed for each column. However, it is probably best suited for #' default values. #' @@ -45,28 +45,32 @@ normalize <- function(x, ...) { #' @rdname normalize #' @export normalize.default <- function( - x, - range = base::range(x, na.rm = TRUE), - bounds = 0:1, - ... + x, + range = base::range(x, na.rm = TRUE), + bounds = 0:1, + ... ) { x[] <- as.double(x) range <- wuffle(base::range(range, na.rm = TRUE)) bounds <- wuffle(base::range(bounds, na.rm = TRUE)) - min <- range[1] - max <- range[2] - lower <- bounds[1] - upper <- bounds[2] + min <- range[1L] + max <- range[2L] + lower <- bounds[1L] + upper <- bounds[2L] - # these probably won't trigger unless there's a weird range method + # fmt: skip # nocov start - stopifnot( - length(range) == 2, - length(bounds) == 2, - min <= max, + # these probably won't trigger unless there's a weird range method + if (!( + length(range) == 2L && + length(bounds) == 2L && + min <= max && lower <= upper - ) + )) { + stop(value_error("invalid `range` or `bounds` supplied")) + } + # nocov end x[] <- lower + (x - min) * (upper - lower) / (max - min) From 28c2439da2e872dfe00d874c0ea45cb86d14bd17 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 13:40:46 -0500 Subject: [PATCH 102/169] suppresses deprecated warnings (#259) --- R/match-arg.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/match-arg.R b/R/match-arg.R index 3152cd9e..98c645bc 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -14,13 +14,13 @@ #' @seealso [match_param()] #' @examples #' x <- c("apple", "banana", "orange") -#' match_arg("b", x) +#' suppressWarnings(match_arg("b", x), "deprecatedWarning") #' #' # Produces error -#' try(match_arg("pear", x)) +#' suppressWarnings(try(match_arg("pear", x)), "deprecatedWarning") #' #' foo <- function(x, op = c(1, 2, 3)) { -#' op <- match_arg(op) +#' op <- suppressWarnings(match_arg(op), "deprecatedWarning") #' x / op #' } #' From b7b19e1dc1b5478f49c9309ae2637bf642c66699 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 13:41:33 -0500 Subject: [PATCH 103/169] updates checks in merge_list() (#259) --- R/merge-list.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/merge-list.R b/R/merge-list.R index c07c6477..cc824ba8 100644 --- a/R/merge-list.R +++ b/R/merge-list.R @@ -36,13 +36,12 @@ merge_list <- function( null = c("ignore", "drop", "keep")[1:2], sort = TRUE ) { - if (length(null) == 1L) { - null <- c(null, null) - } - - if (!length(null) == 2L) { - stop(input_error("`null` must be length 1 or 2")) - } + switch( + length(null), + null <- c(null, null), + null + ) %||% + stop(input_error("`length(null)` must be 1L or 2L")) keep <- match_param(keep) x <- x %||% list() @@ -59,14 +58,16 @@ merge_list <- function( null[1L], keep = x, ignore = remove_null(x), - drop = remove_null(x) + drop = remove_null(x), + stop(internal_error()) # nocov ) y <- switch( null[2L], keep = y, ignore = remove_null(y), - drop = remove_null(y) + drop = remove_null(y), + stop(internal_error()) # nocov ) res <- c(x, y)[!duplicated(c(names(x), names(y)), fromLast = keep == "y")] From d697ead19ed91bbdd3c5be6f9ecbffd89352b982 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 13:41:51 -0500 Subject: [PATCH 104/169] updates conditions for not-available (#259) --- R/not-available.R | 30 ++++++++++++++--------------- tests/testthat/test-not-available.R | 4 ++-- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/R/not-available.R b/R/not-available.R index 058694f0..ce6bfe8f 100644 --- a/R/not-available.R +++ b/R/not-available.R @@ -40,11 +40,11 @@ get_not_available <- function(type = NULL) { out <- get_na_list()[[type]] if (is.null(out)) { - stop(not_available_not_found(type)) + stop(not_available_error("not_found", type)) } if (is.function(out) || is.call(out)) { - stop(not_available_invalid_type()) + stop(not_available_error("invalid")) } out @@ -75,21 +75,21 @@ delayedAssign("NA_POSIXlt_", not_available("POSIXlt", 1L)) # conditions -------------------------------------------------------------- -not_available_not_found := condition( - function(x) { - sprintf( - paste0( - "\"%s\" not found\n", - "Can be set with `mark::set_not_available(%s, value = .)`" +not_available_error := condition( + function(type, x) { + switch( + type, + not_found = sprintf( + paste0( + "\"%s\" not found\n", + "Can be set with `mark::set_not_available(%s, value = .)`" + ), + x, + x ), - x, - x + invalid = "type is not valid", + stop(internal_error()) ) }, type = "error" ) - -not_available_invalid_type := condition( - "type is not valid", - type = "error" -) diff --git a/tests/testthat/test-not-available.R b/tests/testthat/test-not-available.R index fdfb9bf0..963f7578 100644 --- a/tests/testthat/test-not-available.R +++ b/tests/testthat/test-not-available.R @@ -2,7 +2,7 @@ test_that("not_available() works", { expect_error(get_not_available(), NA) expect_error( get_not_available("foo"), - class = "mark:not_available_not_found" + class = "mark:not_available_error" ) val <- struct(NA, "foo") @@ -18,7 +18,7 @@ test_that("not_available() works", { set_not_available("foo_fun", function() NULL) expect_error( get_not_available("foo_fun"), - class = "mark:not_available_invalid_type" + class = "mark:not_available_error" ) # reset list From a6e3ff8eed23a3b9a7ce974f3d9e75e3c458fc69 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 13:48:31 -0500 Subject: [PATCH 105/169] updates note error (#259) --- R/note.R | 9 +-------- tests/testthat/test-note.R | 2 +- 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/R/note.R b/R/note.R index 31b3fbd4..27829564 100644 --- a/R/note.R +++ b/R/note.R @@ -87,7 +87,7 @@ print_note <- function(x, ...) { the_note <- note(x) if (!inherits(the_note, "note")) { - stop(note_not_note()) + stop(class_error("must_be", the_note, "note", "x")) } if (!check_interactive()) { @@ -106,10 +106,3 @@ print.noted <- function(x, ...) { print(set_note(x, NULL), ...) invisible(x) } - -# conditions -------------------------------------------------------------- - -note_not_note := condition( - "note(x) must be class note", - type = "error" -) diff --git a/tests/testthat/test-note.R b/tests/testthat/test-note.R index 6b79f917..91a8e484 100644 --- a/tests/testthat/test-note.R +++ b/tests/testthat/test-note.R @@ -81,7 +81,7 @@ test_that("note() errors", { withr::local_options(list(mark.check_interactive = NA)) expect_error(print_note(1L), class = "simpleError") x <- struct(1L, "noted", note = struct("hi", "note_a_note")) - expect_error(print_note(x), class = "mark:note_not_note") + expect_error(print_note(x), class = "mark:class_error") }) test_that("note() snapshots", { From 33d40e96f7327ddad3d358f197fbb0caec8c671c Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 13:54:46 -0500 Subject: [PATCH 106/169] updates options conditions (#259) --- R/options.R | 9 +-------- tests/testthat/test-options.R | 2 +- 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/R/options.R b/R/options.R index 4604a0f7..ece7cdf8 100644 --- a/R/options.R +++ b/R/options.R @@ -25,7 +25,7 @@ checkOptions <- function(x) { nm <- names(x) if (is.null(nm) || any(nm == "")) { - stop(unnamed_options()) + stop(input_error("all values of `x` must be named")) } msg <- NULL @@ -60,10 +60,3 @@ checkOptions <- function(x) { invisible(op) } - -# conditions -------------------------------------------------------------- - -unnamed_options := condition( - "All options must be named", - type = "error" -) diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index cae801e4..a3afe76e 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -9,5 +9,5 @@ test_that("checkOptions() works", { expect_identical(getOption("mark.test.option2"), 2L) expect_error(checkOptions(1), info = "is.list(x)") - expect_error(checkOptions(list(1)), class = "mark:unnamed_options") + expect_error(checkOptions(list(1)), class = "mark:input_error") }) From 1abe6a2ed215404c575bf8fad7f78c033ec8b981 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 13:54:50 -0500 Subject: [PATCH 107/169] updates paste conditions (#259) --- R/paste.R | 11 +---------- tests/testthat/test-paste.R | 4 ++-- 2 files changed, 3 insertions(+), 12 deletions(-) diff --git a/R/paste.R b/R/paste.R index 70e20fad..0f8f8b00 100644 --- a/R/paste.R +++ b/R/paste.R @@ -35,7 +35,7 @@ paste_combine <- function(..., collate = TRUE, sep = "") { n <- length(ls) if (n < 2) { - stop(paste_combined_dots_lenth()) + stop(input_error("length(...) must be at least 2L")) } out <- do_paste_combine(ls[[1]], ls[[2]], collate = collate, sep = sep) @@ -78,12 +78,3 @@ do_paste_combine <- function(x, y, collate = TRUE, sep = "") { dim(out) <- c(xn, yn) as.vector(apply(out, 1, c), "character") } - -# conditions -------------------------------------------------------------- - -paste_combined_dots_lenth := condition( - message = "length of ... must be at least 2", - type = "error", - package = "mark", - exports = "paste_combine" -) diff --git a/tests/testthat/test-paste.R b/tests/testthat/test-paste.R index fb62f66f..0d0ff8b2 100644 --- a/tests/testthat/test-paste.R +++ b/tests/testthat/test-paste.R @@ -44,7 +44,7 @@ test_that("paste_combine() works", { }) test_that("paste_combine() fails", { - expect_error(paste_combine(1), class = "mark:paste_combined_dots_lenth") + expect_error(paste_combine(1), class = "mark:input_error") }) test_that("collapse0()", { @@ -60,5 +60,5 @@ test_that("collapse0()", { }) test_that("deprecated", { - expect_warning(paste_c(1, 2), "deprecated") + expect_warning(paste_c(1, 2), class = "deprecatedWarning") }) From e70774fcddce0a4c2a0a96a258b2aa03ef150da6 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 14:02:56 -0500 Subject: [PATCH 108/169] updates percentile rank error (#259) --- R/percentile-rank.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/percentile-rank.R b/R/percentile-rank.R index 3eb28695..b4183bd4 100644 --- a/R/percentile-rank.R +++ b/R/percentile-rank.R @@ -79,7 +79,7 @@ do_percentile_rank <- function(u, w) { res <- (cumsum(p) - 0.5) / n } else { if (length(w) != length(u)) { - stop(percentile_rank_weights_length()) + stop(input_error("length(weights) must be 1L or equal to length(x)")) } ok <- stats::complete.cases(u, w) From 15d71623ac78926f894663edc795c96472bac0ca Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 14:06:19 -0500 Subject: [PATCH 109/169] updates recode errors (#259) --- R/recode.R | 13 ++----------- tests/testthat/test-recode.R | 5 ++--- 2 files changed, 4 insertions(+), 14 deletions(-) diff --git a/R/recode.R b/R/recode.R index ba74f90e..e11fa999 100644 --- a/R/recode.R +++ b/R/recode.R @@ -53,7 +53,7 @@ recode_by <- function(x, by, vals = NULL, mode = "any") { vals <- vals %||% names(by) if (is.null(vals)) { - stop(recode_values_set_bad()) + stop(input_error("`vals` must be set if `by` has no names")) } if (length(vals) == 1) { @@ -66,7 +66,6 @@ recode_by <- function(x, by, vals = NULL, mode = "any") { #' @export #' @rdname recode_by recode_only <- function(x, by, vals = NULL) { - if (is.factor(x)) { levels(x) <- recode_only(levels(x), by = by, vals = vals) return(x) @@ -79,7 +78,7 @@ recode_only <- function(x, by, vals = NULL) { vals <- vals %||% names(by) if (is.null(vals)) { - stop(recode_values_set_bad()) + stop(input_error("`vals` must be set if `by` has no names")) } if (is.list(vals)) { @@ -121,11 +120,3 @@ clean_na_coercion <- function(expr) { res } - - -# conditions -------------------------------------------------------------- - -recode_values_set_bad := condition( - message = "values to recode by were not properly set", - type = "error" -) diff --git a/tests/testthat/test-recode.R b/tests/testthat/test-recode.R index 74998a8c..c780067d 100644 --- a/tests/testthat/test-recode.R +++ b/tests/testthat/test-recode.R @@ -36,9 +36,8 @@ test_that("clean_na_coercion() works", { }) test_that("errors", { - txt <- "values to recode by were not properly set" - expect_error(recode_by(1, 1), class = "mark:recode_values_set_bad") - expect_error(recode_only(1, 1), class = "mark:recode_values_set_bad") + expect_error(recode_by(1, 1), class = "mark:input_error") + expect_error(recode_only(1, 1), class = "mark:input_error") }) test_that("single value", { From eb65168b9c39f5edfb8a4cfcf5202fca76aa52be Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 14:07:57 -0500 Subject: [PATCH 110/169] updates error in row-bind (#259) --- R/row-bind.R | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/R/row-bind.R b/R/row-bind.R index 6824e8d9..02d34032 100644 --- a/R/row-bind.R +++ b/R/row-bind.R @@ -17,7 +17,7 @@ row_bind <- function(...) { } if (!all(vap_lgl(ls, is.data.frame))) { - stop(row_bind_object()) + stop(value_error("all elements of `...` must be of class data.frame")) } names <- lapply(ls, names) @@ -60,10 +60,3 @@ rbind2 <- function(...) { quick_df(set_names(res, names(ls[[1]]))) } - -# conditions -------------------------------------------------------------- - -row_bind_object := condition( - message = "... must only be data.frames", - type = "error" -) From 610fe9b02b8eed76a1f424b05088ca05383fc37f Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 14:18:36 -0500 Subject: [PATCH 111/169] updates sort error (#259) --- R/sort-by.R | 8 +------- tests/testthat/test-names.R | 2 +- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/R/sort-by.R b/R/sort-by.R index 48bb660e..f10a18b2 100644 --- a/R/sort-by.R +++ b/R/sort-by.R @@ -18,14 +18,8 @@ #' @export sort_by <- function(x, by, ...) { if (!is_atomic0(x) || !is_atomic0(by)) { - stop(sort_by_atomic()) + stop(input_error("`x` and `by` must be atomic vectors")) } x[order(by, ...)] } - - -sort_by_atomic := condition( - "`x` and `by` must be atomic vectors", - type = "error" -) diff --git a/tests/testthat/test-names.R b/tests/testthat/test-names.R index 237c6419..776ee4f0 100644 --- a/tests/testthat/test-names.R +++ b/tests/testthat/test-names.R @@ -28,7 +28,7 @@ test_that("names_sort() works", { set_names(rep(NA, 3), c(-1, 2, 10)) ) - expect_error(sort_names(list(a = 1)), class = "mark:sort_by_atomic") + expect_error(sort_names(list(a = 1)), class = "mark:input_error") expect_error(sort_names(NA), class = "simpleError") }) From 023641eab2a1237022f3505b6041138603147f85 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 14:35:47 -0500 Subject: [PATCH 112/169] updates sourcing errors (#259) --- R/sourcing.R | 49 ++++++++++++++++++++----------------------------- 1 file changed, 20 insertions(+), 29 deletions(-) diff --git a/R/sourcing.R b/R/sourcing.R index d101ce12..1ad3715b 100644 --- a/R/sourcing.R +++ b/R/sourcing.R @@ -6,14 +6,14 @@ #' #' @param file An R or Rmd file. #' @param quiet Logical; Determines whether to apply silence to [knitr::purl()] -#' @param cd Logical; if TRUE, the R working directory is temporarily +#' @param cd Logical; if `TRUE`, the **R** working directory is temporarily #' changed to the directory containing file for evaluating #' @param env An environment determining where the parsed expressions are #' evaluated #' @param ... Additional arguments passed to [base::source()] #' #' @details -#' `try_source()` will output an error message rather than completely preventing +#' [try_source()] will output an error message rather than completely preventing #' the execution. #' This can be useful for when a script calls on multiple, independent files to #' be sourced and a single failure shouldn't prevent the entire run to fail as @@ -21,15 +21,17 @@ #' #' @name sourcing #' @return -#' * `ksource()`: Invisibly, the result of calling `source()` on the `.R` file conversion of `file` -#' * `try_source()`, `try_ksource()`: attempts of `source()` and `ksource()` but converts errors to warnings +#' * [ksource()]: Invisibly, the result of calling [base::source()] on the `.R` file conversion of `file` +#' * [try_source()], [try_ksource()]: attempts of [base::source()] and [ksource()] but converts errors to warnings #' @export # nolint end: line_length_linter. ksource <- function(file, ..., quiet = TRUE, cd = FALSE, env = parent.frame()) { require_namespace("knitr") - stopifnot(is.environment(env)) + if (!is.environment(env)) { + stop(class_error("must_be", env, "environment")) + } o <- mark_temp("R") on.exit(fs::file_delete(o), add = TRUE) source(knitr::purl(file, output = o, quiet = quiet), chdir = cd, local = env) @@ -40,12 +42,8 @@ ksource <- function(file, ..., quiet = TRUE, cd = FALSE, env = parent.frame()) { try_source <- function(file, cd = FALSE, ...) { tryCatch( source(file, chdir = cd), - error = function(e) { - warning(e, call. = FALSE) - }, - simpleWarning = function(e) { - warning(e, call. = FALSE) - } + error = function(e) warning(e, call. = FALSE), + simpleWarning = function(e) warning(e, call. = FALSE) ) } @@ -54,12 +52,8 @@ try_source <- function(file, cd = FALSE, ...) { try_ksource <- function(file, ...) { tryCatch( ksource(file = file, ...), - error = function(e) { - warning(e, call. = FALSE) - }, - simpleWarning = function(e) { - warning(e, call. = FALSE) - } + error = function(e) warning(e, call. = FALSE), + simpleWarning = function(e) warning(e, call. = FALSE) ) } @@ -147,17 +141,17 @@ source_r_dir <- function(dir, echo = FALSE, quiet = FALSE, ...) { #' @inheritParams source_files source_r_file <- function(path, echo = FALSE, quiet = FALSE, ...) { if (!grepl("\\.[rR]$", path)) { - stop(source_error("file")) + stop(input_error("`path` must be an R script with .R extension")) } - stopifnot(is_file(path)) + if (!is_file(path)) { + stop(input_error("`path` must be a valid file location")) + } st <- system.time( tryCatch( source(path, echo = echo, ..., chdir = FALSE), - error = function(e) { - stop("Error in ", path, "\n", e, call. = FALSE) - } + error = function(e) stop("Error in ", path, "\n", e, call. = FALSE) ) ) @@ -185,7 +179,7 @@ source_r_file <- function(path, echo = FALSE, quiet = FALSE, ...) { #' Source an R script to an environment #' #' @param x An R script -#' @param ops Options to be passed to [mark::rscript] +#' @param ops Options to be passed to [mark::rscript()] #' @return Invisibly, and environment variable of the objects/results created #' from `x` #' @export @@ -233,12 +227,12 @@ source_to_env <- function(x, ops = NULL) { #' Rscript #' -#' Implements `Rscript` with `system2` +#' Implements `Rscript` with [base::system2()] #' #' @param x An R file to run #' @param ops A character vector of options (`"--"` is added to each) #' @param args A character vector of other arguments to pass -#' @param ... Additional arguments passed to `system2` +#' @param ... Additional arguments passed to [base::system2()] #' @return A `character` vector of the result from calling `Rscript` via #' `system2()` #' @@ -327,7 +321,6 @@ source_error := condition( x, rmd = "rmd_file does not appear to be an rmd file", label = "label not found in .Rmd file", - file = "Must be a .R file", source = paste0( "RDS file not succesfully saved here:\n ", params$file, @@ -339,14 +332,12 @@ source_error := condition( collapse0(readLines(params$out), sep = "\n"), "\n" ), - stop("something went wrong; bad input: ", x) + stop(internal_error()) ) }, type = "error", package = "mark", exports = c( - "source_r_dir", - "source_r_file", "source_to_env", "eval_named_chunk" ) From a3f433de4faeb99cd4e5b3dfcf670f03965c9a18 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 4 Jan 2026 15:04:39 -0500 Subject: [PATCH 113/169] updates errors in todos (#259) --- R/todos.R | 66 +++++++++++++++---------------------- man/median2.Rd | 2 +- man/print_c.Rd | 13 ++++---- man/switch-ext.Rd | 16 +++++---- tests/testthat/test-todos.R | 4 +-- 5 files changed, 46 insertions(+), 55 deletions(-) diff --git a/R/todos.R b/R/todos.R index 3a66aacf..efbb1d9c 100644 --- a/R/todos.R +++ b/R/todos.R @@ -44,12 +44,12 @@ NULL #' @rdname todos #' @export todos <- function( - pattern = NULL, - path = ".", - force = getOption("mark.todos.force"), - ext = getOption("mark.todos.ext"), - ignore = NULL, - ... + pattern = NULL, + path = ".", + force = getOption("mark.todos.force"), + ext = getOption("mark.todos.ext"), + ignore = NULL, + ... ) { do_todo( "todo", @@ -65,12 +65,12 @@ todos <- function( #' @rdname todos #' @export fixmes <- function( - pattern = NULL, - path = ".", - force = getOption("mark.todos.force"), - ext = getOption("mark.todos.ext"), - ignore = NULL, - ... + pattern = NULL, + path = ".", + force = getOption("mark.todos.force"), + ext = getOption("mark.todos.ext"), + ignore = NULL, + ... ) { do_todo( "fixme", @@ -84,21 +84,22 @@ fixmes <- function( } do_todo <- function( - text = c("todo", "fixme"), - pattern = NULL, - path = ".", - force = getOption("mark.todos.force"), - ext = getOption("mark.todos.ext"), - ignore = NULL, - ... + text = c("todo", "fixme"), + pattern = NULL, + path = ".", + force = getOption("mark.todos.force"), + ext = getOption("mark.todos.ext"), + ignore = NULL, + ... ) { text <- match_param(text) + # fmt: skip if ( missing(path) || length(path) != 1 || !is.character(path) ) { - stop(todo_error("path")) + stop(input_error("`path` must be a character vector of length 1L")) } stopifnot(fs::file_exists(path)) @@ -207,11 +208,12 @@ print.todos_df <- function(x, ...) { if (!isFALSE(getOption("mark.todos..norm_path"))) { # perform action on chunks as not to modify x - for (i in seq_along(chunks)) - chunks <- lapply(chunks, function(chunk) { - chunk[["file"]] <- norm_path(chunk[["file"]]) - chunk - }) + for (i in seq_along(chunks)) { + chunks <- lapply(chunks, function(chunk) { + chunk[["file"]] <- norm_path(chunk[["file"]]) + chunk + }) + } } for (i in seq_along(nms)) { @@ -247,17 +249,3 @@ string_dots <- function(x, width = getOption("width")) { x[long] <- paste(strtrim(x[long], width - 5), "[...]") x } - -# conditions -------------------------------------------------------------- - -todo_error := condition( - function(x) { - switch( - x, - path = "path must be a character vector of length 1L", - stop("something went wrong") - ) - }, - type = "error", - exports = c("todos", "fixmes") -) diff --git a/man/median2.Rd b/man/median2.Rd index e6015cc8..90ebddfb 100644 --- a/man/median2.Rd +++ b/man/median2.Rd @@ -22,7 +22,7 @@ q50(x, type = 7, na.rm = FALSE) are removed from \code{x} before the quantiles are computed.} } \value{ -See \code{stats::quantile()} +See \code{\link[stats:quantile]{stats::quantile()}} } \description{ Median as the 50th quantile with an option to select quantile algorithm diff --git a/man/print_c.Rd b/man/print_c.Rd index 8077d92b..72301bb0 100644 --- a/man/print_c.Rd +++ b/man/print_c.Rd @@ -9,9 +9,10 @@ print_c(x = read_clipboard(), sorted = TRUE, null = TRUE) \arguments{ \item{x}{A vector (defaults to reading the clipboard)} -\item{sorted}{If \code{TRUE} (default) applies \code{sort()} to \code{x}} +\item{sorted}{If \code{TRUE} (default) applies \code{\link[base:sort]{base::sort()}} to \code{x}} -\item{null}{If \code{TRUE} (default) adds \code{NULL} at the end of the \code{c()} print} +\item{null}{If \code{TRUE} (default) adds \code{NULL} at the end of the \code{\link[base:c]{base::c()}} +print} } \value{ Invisibly, as a \code{character} vector, the object printed to the console @@ -20,10 +21,10 @@ Invisibly, as a \code{character} vector, the object printed to the console Prints a vector to paste into an R script } \details{ -This sorts (if set) and provides unique values for each element in \code{x} and -prints then as a call to \code{c}. This can be useful for copying data that you -want to save as a vector in an R script. -The result is both called in \code{cat()} as well as copied to the clipboard. +This sorts (if set) and provides unique values for each element in +\code{x} and prints then as a call to \code{\link[base:c]{base::c()}}. This can be useful for +copying data that you want to save as a vector in an \strong{R} script. The +result is both called in \code{\link[base:cat]{base::cat()}} as well as copied to the clipboard. } \examples{ print_c(1:10) diff --git a/man/switch-ext.Rd b/man/switch-ext.Rd index 3777c041..52437167 100644 --- a/man/switch-ext.Rd +++ b/man/switch-ext.Rd @@ -16,17 +16,17 @@ switch_case(..., .default = NULL, .envir = parent.frame()) \arguments{ \item{x}{A vector of values} -\item{...}{Case evaluations (named for \code{switch_params})} +\item{...}{Case evaluations (named for \code{\link[=switch_params]{switch_params()}})} \item{.default}{The default value if no matches are found in \code{...} (default: \code{NULL} produces an \code{NA} value derived from \code{...})} \item{.envir}{The environment in which to evaluate the LHS of \code{...} (default: -\code{parent.frame()})} +\code{\link[base:sys.parent]{base::parent.frame()}})} } \value{ -A named vector of values of same length \code{x}; or for \code{switch_case}, -an unnamed vector of values matching the rhs of \code{...} +A named vector of values of same length \code{x}; or for \code{\link[=switch_case]{switch_case()}}, an +unnamed vector of values matching the rhs of \code{...} Inspired from: \itemize{ @@ -35,10 +35,12 @@ Inspired from: } } \description{ -\code{switch_params()} is a vectorized version of \code{switch} -\code{switch_case()} uses a formula syntax to return the value to the right of the +\code{\link[=switch_params]{switch_params()}} is a vectorized version of \code{\link[base:switch]{base::switch()}} + +\code{\link[=switch_case]{switch_case()}} uses a formula syntax to return the value to the right of the tilde (\code{~}) when \code{x} is \code{TRUE} -\code{switch_in_case()} is a special case of \code{switch_case()} for \code{match()}-ing \code{x} + +\code{\link[=switch_in_case]{switch_in_case()}} is a special case of \code{\link[=switch_case]{switch_case()}} for \code{\link[base:match]{base::match()}}-ing \code{x} in the values on the left to return the value on the right. } \details{ diff --git a/tests/testthat/test-todos.R b/tests/testthat/test-todos.R index fbfb2ba3..ce62f696 100644 --- a/tests/testthat/test-todos.R +++ b/tests/testthat/test-todos.R @@ -63,8 +63,8 @@ test_that("todos() errors and messages", { path <- test_path("scripts") err <- "path must be a character vector of length 1L" - expect_error(todos(path = 1), class = "mark:todo_error") - expect_error(todos(path = c("a", "b")), class = "mark:todo_error") + expect_error(todos(path = 1), class = "mark:input_error") + expect_error(todos(path = c("a", "b")), class = "mark:input_error") expect_error(todos(path = "zzz")) expect_error(do_todo(c("todo", "fixme"), path = "."), NA) From db70f523bab0c205fdaec31d7d731266bb60acd7 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 14:38:28 -0500 Subject: [PATCH 114/169] simplifies is_atomic0() for R version 4.4 (#259) --- R/utils.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 1f55f754..d76d0abd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -90,8 +90,11 @@ is_unique <- function(x) { anyDuplicated(x) == 0L } -is_atomic0 <- function(x) { - is.atomic(x) && !is.null(x) +# since 4.4.0 is.atomic(NULL) returns FALSE +is_atomic0 <- if (getRversion() < "4.4.0") { + function(x) is.atomic(x) && !is.null(x) +} else { + base::is.atomic } cat0 <- function(...) { From 0014de9c0e7e93d235664449ad20c4be351dc50b Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 14:38:53 -0500 Subject: [PATCH 115/169] replaces vector_required error with input_error (#259) --- R/utils.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/utils.R b/R/utils.R index d76d0abd..ca11dd52 100644 --- a/R/utils.R +++ b/R/utils.R @@ -125,23 +125,23 @@ mark_temp <- function(ext = "") { } check_is_vector <- function(x, mode = "any") { + # fmt: skip if ( isS4(x) || - inherits(x, c("data.frame", "matrix", "array")) || - !is.vector(remove_attributes(x), mode) + inherits(x, c("data.frame", "matrix", "array")) || + !is.vector(remove_attributes(x), mode) ) { x <- deparse1(substitute(x)) - stop(vector_required(x, mode)) + stop( + input_error( + sprintf("`%s` must be of mode `%s`", as.character(match.call()$x), mode) + ) + ) } invisible() } -vector_required := condition( - function(x, mode) paste(x, "must be a vector of mode", mode), - type = "error" -) - add_attributes <- function(x, ...) { attributes(x) <- c(attributes(x), rlang::list2(...)) x From edc118974ac3829cf3712eb13ae1e3d1eff41a62 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 14:39:00 -0500 Subject: [PATCH 116/169] typo for options error (#259) --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index ca11dd52..46c68944 100644 --- a/R/utils.R +++ b/R/utils.R @@ -193,7 +193,7 @@ options_error := condition( function(x) { switch( x, - interaction = "mark.check_interactive must be TRUE, FALSE, or NA", + interactive = "mark.check_interactive must be TRUE, FALSE, or NA", stop("something went wrong, bad value: ", x) ) }, From 31b235d78db4e0646a600fac640c6a67ac1a57f0 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 14:39:11 -0500 Subject: [PATCH 117/169] simplifies within errors (#259) --- R/within.R | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/R/within.R b/R/within.R index 85d778ea..47414878 100644 --- a/R/within.R +++ b/R/within.R @@ -42,7 +42,7 @@ between_more <- function(x, left, right, type = c("gele", "gel", "gle", "gl")) { type <- match_param(type) if (any(left > right, na.rm = TRUE)) { - warning(between_more_lr()) + warning(input_warning("`left` should be less than or equal to `right`")) } switch( @@ -71,7 +71,7 @@ within <- function( } if (any(left > right, na.rm = TRUE)) { - warning(within_lr()) + warning(input_warning("`left` should be less than or equal to `right`")) } funs <- switch( @@ -96,15 +96,3 @@ within <- function( left & right } - -# conditions -------------------------------------------------------------- - -between_more_lr := condition( - "`left` > `right`", - type = "warning" -) - -within_lr := condition( - "`left` > `right`", - type = "warning" -) From 21eebd7c1ced9dcbde261bf20500ea873e2bdc9e Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 14:39:29 -0500 Subject: [PATCH 118/169] simplifies write errors (#259) --- R/write.R | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/R/write.R b/R/write.R index 9d73c363..6d9398fe 100644 --- a/R/write.R +++ b/R/write.R @@ -121,6 +121,7 @@ write_file_md5 <- function( temp <- hook(temp) %||% temp if (!is.null(attr(x, "path"))) { + # NOTE this should be fairly rare, right? warning("attr(x, \"path\") is being overwritten") } @@ -299,7 +300,11 @@ get_list_hook <- function(hook) { false = function(x) NA_character_, none = NULL, # nolint next: brace_linter. - na = function(x) stop(write_na_hook()), + na = function(x) { + stop(value_error( + "options(mark.list.hook) is NA but list columns detected" + )) + }, match.fun(hook) ) } @@ -499,10 +504,9 @@ compress <- function( if (identical(attr(path, "extra"), "tar")) { if (method == "zip") { - stop( - "'zip' is not a valid method when writing to a tar archive", - call. = FALSE - ) + stop(input_error( + "'zip' is not a valid method when writing to a tar archive" + )) } # tar() can do the compression for us, so we move this to a temporary # option. this is always cleaned up because it shouldn't be set manually @@ -603,11 +607,3 @@ safe_fs_delete <- function(x) { fs::file_delete(x) } } - - -# conditions -------------------------------------------------------------- - -write_na_hook := condition( - "options(mark.list.hook) is NA but list columns detected", - type = "error", -) From c30e28393b9ee5231a42a56008589c7e70e7d721 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 14:39:57 -0500 Subject: [PATCH 119/169] formatting (#259) --- R/match-arg.R | 1 + R/names.R | 1 - R/reexports-magrittr.R | 2 ++ R/round-by.R | 8 ++++---- R/stats.R | 8 +++++--- R/strings.R | 16 ++++++++-------- R/switch.R | 43 +++++++++++++++++++++--------------------- R/unlist.R | 4 ++-- R/utils.R | 5 +++++ 9 files changed, 49 insertions(+), 39 deletions(-) diff --git a/R/match-arg.R b/R/match-arg.R index 98c645bc..67d45852 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -164,6 +164,7 @@ match_param <- function( ) } + # TODO use duplicate_error() stop(input_error(paste0( "duplicate values found in `choices`:\n ", to_choices(choices) diff --git a/R/names.R b/R/names.R index d6c7503b..7394d5b5 100644 --- a/R/names.R +++ b/R/names.R @@ -1,4 +1,3 @@ - is_named <- function(x) { !is.null(names(x)) } diff --git a/R/reexports-magrittr.R b/R/reexports-magrittr.R index ce0b79ed..6195b9bf 100644 --- a/R/reexports-magrittr.R +++ b/R/reexports-magrittr.R @@ -1,3 +1,5 @@ +# TODO remove + #' @importFrom magrittr %>% #' @export magrittr::`%>%` diff --git a/R/round-by.R b/R/round-by.R index 89b30743..710c8357 100644 --- a/R/round-by.R +++ b/R/round-by.R @@ -22,10 +22,10 @@ #' ) round_by <- function( - x, - by = 1, - method = c("round", "ceiling", "floor"), - include0 = TRUE + x, + by = 1, + method = c("round", "ceiling", "floor"), + include0 = TRUE ) { res <- do.call(match_param(method), list(x / by)) * by diff --git a/R/stats.R b/R/stats.R index ccff35d6..5e1cb226 100644 --- a/R/stats.R +++ b/R/stats.R @@ -6,7 +6,7 @@ #' `q50` is an alias for `median2` #' #' @inheritParams stats::quantile -#' @return See `stats::quantile()` +#' @return See [stats::quantile()] #' #' @examples #' set.seed(42) @@ -18,7 +18,8 @@ #' @export #' @seealso [stats::quantile()] -median2 <- function(x, type = 7, na.rm = FALSE) { # nolint: object_name_linter. +# nolint next: object_name_linter. +median2 <- function(x, type = 7, na.rm = FALSE) { stats::quantile(x, probs = .5, type = type, na.rm = na.rm, names = FALSE) } @@ -47,6 +48,7 @@ q50 <- median2 #' system.time(rep(range2(x, na.rm = TRUE), 100)) #' } #' @export -range2 <- function(x, na.rm = FALSE) { # nolint: object_name_linter. +# nolint next: object_name_linter. +range2 <- function(x, na.rm = FALSE) { c(min(x, na.rm = na.rm), max(x, na.rm = na.rm)) } diff --git a/R/strings.R b/R/strings.R index 496e1083..8f4bb7e1 100644 --- a/R/strings.R +++ b/R/strings.R @@ -112,7 +112,7 @@ string_extract <- function(x, pattern, perl = FALSE, ignore.case = FALSE) { #' Format string to a regular expression #' #' @param x A date or datetime format, assuming that entries follow the formats -#' described in [base::strptime] +#' described in [base::strptime()] #' #' @examples #' mark:::format_to_regex("%Y-%m-%d") @@ -164,15 +164,15 @@ chr_split <- function(x) { #' #' Prints a vector to paste into an R script #' -#' @details -#' This sorts (if set) and provides unique values for each element in `x` and -#' prints then as a call to `c`. This can be useful for copying data that you -#' want to save as a vector in an R script. -#' The result is both called in `cat()` as well as copied to the clipboard. +#' @details This sorts (if set) and provides unique values for each element in +#' `x` and prints then as a call to [base::c()]. This can be useful for +#' copying data that you want to save as a vector in an **R** script. The +#' result is both called in [base::cat()] as well as copied to the clipboard. #' #' @param x A vector (defaults to reading the clipboard) -#' @param sorted If `TRUE` (default) applies `sort()` to `x` -#' @param null If `TRUE` (default) adds `NULL` at the end of the `c()` print +#' @param sorted If `TRUE` (default) applies [base::sort()] to `x` +#' @param null If `TRUE` (default) adds `NULL` at the end of the [base::c()] +#' print #' @return Invisibly, as a `character` vector, the object printed to the console #' @examples #' print_c(1:10) diff --git a/R/switch.R b/R/switch.R index 6231d298..59127ede 100644 --- a/R/switch.R +++ b/R/switch.R @@ -2,17 +2,18 @@ #' #' Switch with a list of params #' -#' @description -#' `switch_params()` is a vectorized version of `switch` -#' `switch_case()` uses a formula syntax to return the value to the right of the -#' tilde (`~`) when `x` is `TRUE` -#' `switch_in_case()` is a special case of `switch_case()` for `match()`-ing `x` -#' in the values on the left to return the value on the right. +#' @description [switch_params()] is a vectorized version of [base::switch()] #' -#' @return A named vector of values of same length `x`; or for `switch_case`, -#' an unnamed vector of values matching the rhs of `...` +#' [switch_case()] uses a formula syntax to return the value to the right of the +#' tilde (`~`) when `x` is `TRUE` #' -#' Inspired from: +#' [switch_in_case()] is a special case of [switch_case()] for [base::match()]-ing `x` +#' in the values on the left to return the value on the right. +#' +#' @return A named vector of values of same length `x`; or for [switch_case()], an +#' unnamed vector of values matching the rhs of `...` +#' +#' Inspired from: #' * https://stackoverflow.com/a/32835930/12126576 #' * https://github.com/tidyverse/dplyr/issues/5811 #' @@ -82,7 +83,7 @@ NULL #' @param x A vector of values -#' @param ... Case evaluations (named for `switch_params`) +#' @param ... Case evaluations (named for [switch_params()]) #' @rdname switch-ext #' @export switch_params <- function(x, ...) { @@ -96,7 +97,7 @@ switch_params <- function(x, ...) { #' @param .default The default value if no matches are found in `...` #' (default: `NULL` produces an `NA` value derived from `...`) #' @param .envir The environment in which to evaluate the LHS of `...` (default: -#' `parent.frame()`) +#' [base::parent.frame()]) #' @rdname switch-ext #' @export switch_in_case <- function(x, ..., .default = NULL, .envir = parent.frame()) { @@ -231,12 +232,10 @@ switch_length_check <- function(ls) { switch( length(u), return(ls), - { - if (u[1L] == 0L) { - stop(switch_error("lengths_check_0")) - } - - if (u[1L] == 1L) { + switch( + u[1L] + 1L, + stop(switch_error("lengths_check_0")), + { ind <- which(lens == 1L) for (i in ind) { @@ -245,9 +244,10 @@ switch_length_check <- function(ls) { return(ls) } - stop(switch_error("lengths_check_2")) - }, + ), + stop(switch_error("lengths_check_2")), stop(switch_error("lengths_check_3")), + NULL ) stop(internal_error("Unexpected lengths found")) } @@ -269,18 +269,19 @@ switch_lengths_check <- function(lhs, rhs) { # conditions -------------------------------------------------------------- +# TODO review of these can be simplified switch_error := condition( function(x, params = NULL) { switch( x, - numeric = "x did not appear to be numeric, cannot continue evaluating lhs", # nolint: line_length_linter. + numeric = "`x` did not appear to be numeric, cannot continue evaluating lhs", # nolint: line_length_linter. ambiguous_infinity = "Ambiguous infinity, cannot calculate", evaluate = paste0("Could not evaluate lhs\n", params), lengths_check = "statements have different lengths", lengths_check_0 = "Cannot have 0 length rhs", lengths_check_2 = "2 lengths found, one of which was not 1", lengths_check_3 = "3 or more lengths found, stopping", - stop(internal_error(c("Unexpected switch_error(type): ", x))), + stop(internal_error()), ) } ) diff --git a/R/unlist.R b/R/unlist.R index e6b386e7..4f35a724 100644 --- a/R/unlist.R +++ b/R/unlist.R @@ -3,8 +3,8 @@ #' Unlist without unique names; combine names for unique values #' #' @details -#' * [unlist0()] is much like [unlist()] expect that name are not made to be -#' unique. +#' * [unlist0()] is much like [base::unlist()] expect that name are not made to +#' be unique. #' * [squash_vec()] works differently #' #' @param x A vector of values diff --git a/R/utils.R b/R/utils.R index 46c68944..f36c8d37 100644 --- a/R/utils.R +++ b/R/utils.R @@ -14,8 +14,11 @@ use_color <- function() { } # nolint start: brace_linter. +# fmt: skip crayon_blue <- function(x) { if (use_color()) crayon::blue(x) else x } +# fmt: skip crayon_green <- function(x) { if (use_color()) crayon::green(x) else x } +# fmt: skip crayon_cyan <- function(x) { if (use_color()) crayon::cyan(x) else x } # nolint end: brace_linter. @@ -189,6 +192,7 @@ check_interactive <- function() { stop(options_error("interactive")) } +# TODO is this even needed? Maybe if options were active bindings options_error := condition( function(x) { switch( @@ -238,6 +242,7 @@ dupe_check <- function(x, n = getOption("mark.dupe.n", 5)) { invisible(NULL) } +# TODO maybe as a subclass of value_error? duplicate_error := condition( function(x, dupes, n_dupes, n) { paste0( From 2b084e3a1192e30958c81dd74fdfb12c4f386d5b Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 14:40:03 -0500 Subject: [PATCH 120/169] includes warnings (#259) --- R/aaa.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/aaa.R b/R/aaa.R index 7235ae22..16b04a67 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -32,6 +32,12 @@ input_error := condition( help = "Generic error to indicate a bad input value." ) +input_warning := condition( + function(x) collapse(x), + type = "warning", + help = "Generic warning to indicate a bad input value." +) + # caused by processing value_error := condition( function(x) collapse(x), @@ -39,6 +45,12 @@ value_error := condition( help = "Generic error to indicate a value mismatch." ) +value_warning := condition( + function(x) collapse(x), + type = "warning", + help = "Generic warning to indicate a value mismatch." +) + type_error := condition( function(expected, actual, object) { sprintf( From db922421e8269619a34e3b6fd789861aaafaf583 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 14:54:06 -0500 Subject: [PATCH 121/169] improves check_is_vector() error (#259) --- R/utils.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/utils.R b/R/utils.R index f36c8d37..64988a91 100644 --- a/R/utils.R +++ b/R/utils.R @@ -128,21 +128,23 @@ mark_temp <- function(ext = "") { } check_is_vector <- function(x, mode = "any") { + nm <- deparse1(substitute(x)) # fmt: skip if ( isS4(x) || inherits(x, c("data.frame", "matrix", "array")) || !is.vector(remove_attributes(x), mode) ) { - x <- deparse1(substitute(x)) stop( input_error( - sprintf("`%s` must be of mode `%s`", as.character(match.call()$x), mode) + switch( + mode, + any = sprintf("`%s` must be a vector", nm), + sprintf("`%s` must be a vector of mode '%s'", nm, mode) + ) ) ) } - - invisible() } add_attributes <- function(x, ...) { From 6dca3c549a6bc7057fa42d79995e2511f32e4492 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 16:33:54 -0500 Subject: [PATCH 122/169] formatting (#259) --- R/append.R | 4 +-- R/apply.R | 13 ++++---- R/bib.R | 4 +-- R/blank.R | 10 +++--- R/boolean.R | 4 +-- R/char2fact.R | 4 +-- R/clipboard.R | 81 ++++++++++++++++++++++++----------------------- R/counts.R | 13 ++++---- R/dataframes.R | 28 ++++++++-------- R/depth.R | 5 ++- R/description.R | 18 +++++------ R/diff-time.R | 13 ++++---- R/directory.R | 33 +++++++++++-------- R/environments.R | 18 ++++++----- R/expand.R | 2 +- R/fact.R | 32 +++++++++---------- R/file.R | 1 - R/fizzbuzz.R | 9 +++--- R/funs.R | 6 ++-- R/glob.R | 5 +-- R/labels.R | 13 ++++---- R/lines-of-code.R | 7 ++-- R/logic.R | 17 +++++----- R/match-arg.R | 6 ++-- R/normalize.R | 6 ++-- R/pseudo-id.R | 4 +-- R/sourcing.R | 16 +++++----- R/stats.R | 4 +-- R/switch.R | 19 ++++++----- R/system-file.R | 4 +-- R/unlist.R | 10 +++--- R/within.R | 16 +++++----- R/write.R | 21 ++++++------ 33 files changed, 225 insertions(+), 221 deletions(-) diff --git a/R/append.R b/R/append.R index c42b8d2d..a85fe995 100644 --- a/R/append.R +++ b/R/append.R @@ -20,7 +20,7 @@ append0.list <- function(x, values, pos = NULL, expand = FALSE, ...) { n <- unique(lengths(x)) if (length(n) > 1) { - warning(append_expand_warning()) + warning(append_warning()) n <- max(n) } @@ -65,7 +65,7 @@ append0.default <- function(x, values, pos = NULL, ...) { # conditions -------------------------------------------------------------- # TODO does this need to be it's own condition? -append_expand_warning := condition( +append_warning := condition( message = "expanding to the largest n", type = "warning", package = "mark", diff --git a/R/apply.R b/R/apply.R index b0ca3ac4..4f9ee616 100644 --- a/R/apply.R +++ b/R/apply.R @@ -1,4 +1,3 @@ - # TODO these will be deprecated by fuj::vap # vaps -------------------------------------------------------------------- @@ -13,12 +12,12 @@ #' Each function is designed to use specific vector types: #' #' \describe{ -#' \item{vap_int}{integer} -#' \item{vap_dbl}{double} -#' \item{vap_chr}{character} -#' \item{vap_lgl}{logical} -#' \item{vap_cplx}{complex} -#' \item{vap_date}{Date} +#' \item{[mark::vap_int()]}{integer} +#' \item{[mark::vap_dbl()]}{double} +#' \item{[mark::vap_chr]()}{character} +#' \item{[mark::vap_lgl]()}{logical} +#' \item{[mark::vap_cplx]()}{complex} +#' \item{[mark::vap_date]()}{Date} #' } #' #' @param .x A vector of values diff --git a/R/bib.R b/R/bib.R index e256cd41..fbd02ee2 100644 --- a/R/bib.R +++ b/R/bib.R @@ -14,7 +14,7 @@ #' @param file File or connection #' @param skip The lines to skip #' @param max_lines The maximum number of lines to read -#' @param encoding Assumed encoding of file (passed to [readLines()] +#' @param encoding Assumed encoding of file (passed to [base::readLines()] #' #' @return A `data.frame` with each row as a bib entry and each column as a #' field @@ -200,7 +200,6 @@ process_bib_list <- function(keys, fields, categories, values) { class = c("character", "mark_bib_entry"), names = c("key", "field", cats) ) - }, key = keys[valid], field = fields[valid], @@ -324,4 +323,3 @@ bib_error := condition( exports = "read_bib" # TODO include help ) - diff --git a/R/blank.R b/R/blank.R index 06083218..b653a832 100644 --- a/R/blank.R +++ b/R/blank.R @@ -12,11 +12,11 @@ #' as blanks #' #' @returns -#' * `is_blank()` a `logical` vector indicating _blank_ elements in `x` -#' * `select_blank_cols()` `x` with only columns that are all _blank_ -#' * `remove_blank_cols()` `x` without columns of only _blank_ -#' * `is_blank_cols()` a logical vector: `TRUE` all rows of column are _blank_, -#' otherwise `FALSE` +#' - [mark::is_blank()] a `logical` vector indicating _blank_ elements in `x` +#' - [mark::select_blank_cols()] `x` with only columns that are all _blank_ +#' - [mark::remove_blank_cols()] `x` without columns of only _blank_ +#' - [mark::is_blank_cols()] a logical vector: `TRUE` all rows of column are +#' _blank_, otherwise `FALSE` #' @name blank_values NULL diff --git a/R/boolean.R b/R/boolean.R index c45170fe..6d5ced87 100644 --- a/R/boolean.R +++ b/R/boolean.R @@ -31,7 +31,7 @@ to_boolean.character <- function(x, true = NULL, false = NULL, ...) { return(to_boolean_default(x)) } - stop("Not yet finished") + stop(internal_error("Not yet finished")) } #' @rdname to_boolean @@ -41,7 +41,7 @@ to_boolean.factor <- function(x, true = NULL, false = NULL, ...) { return(to_boolean_default(x)) } - stop("Not yet finished") + stop(internal_error("Not yet finished")) } to_boolean_default <- function(x) { diff --git a/R/char2fact.R b/R/char2fact.R index 024c2437..eee4bacd 100644 --- a/R/char2fact.R +++ b/R/char2fact.R @@ -4,7 +4,7 @@ #' #' @param x A vector of characters #' @param n The limit to the number of unique values for the factor -#' @seealso [fact2char()] +#' @seealso [mark::fact2char()] #' @family factors #' @export char2fact <- function(x, n = 5) { @@ -53,7 +53,7 @@ char2fact.data.frame <- function(x, n = 5) { #' @param threshold A threshold for the number of levels to be met/exceeded for #' transforming into a character #' @returns The `data.frame` `data` with factors converted by the rule above -#' @seealso [char2fact()] +#' @seealso [mark::char2fact()] #' @family factors #' @export fact2char <- function(data, threshold = 10) { diff --git a/R/clipboard.R b/R/clipboard.R index 4d50c2ef..41caeaf0 100644 --- a/R/clipboard.R +++ b/R/clipboard.R @@ -3,17 +3,18 @@ #' Wrappers for working with the clipboard #' #' @details As these functions rely on [clipr::read_clip()] and -#' [utils::writeClipboard()] they are only available for Windows 10. For copying -#' and pasting floats, there may be some rounding that can occur. +#' [utils::writeClipboard()] they are only available for Windows 10. For +#' copying and pasting floats, there may be some rounding that can occur. #' #' @param x An object #' @param method Method switch for loading the clipboard #' @param ... Additional arguments sent to methods or to [utils::write.table()] #' -#' @return `write_clipboard()` None, called for side effects `read_clipboard()` -#' Either a vector, `data.frame`, or `tibble` depending on the `method` chosen. -#' Unlike [utils::readClipboard()], an empty clipboard value returns `NA` rather -#' than `""` +#' @return +#' - [mark::write_clipboard()] None, called for side effects +#' - [mark::read_clipboard()] Either a vector, `data.frame`, or `tibble` +#' depending on the `method` chosen. Unlike [utils::readClipboard()], an +#' empty clipboard value returns `NA` rather than `""` #' #' @name clipboard #' @examples @@ -118,11 +119,13 @@ clipr_read_clip <- function(...) { res <- withCallingHandlers( clipr::read_clip(...), simpleWarning = function(e) { - if (grepl( - "System clipboard contained no readable text", - conditionMessage(e), - fixed = TRUE - )) { + if ( + grepl( + "System clipboard contained no readable text", + conditionMessage(e), + fixed = TRUE + ) + ) { tryInvokeRestart("muffleWarning") } } @@ -163,39 +166,39 @@ read_clipboard_methods <- function() { #' @inheritParams utils::read.table #' @noRd do_read_table_clipboard <- function( - header = TRUE, - # Copying form Excel produces tab separations - sep = "\t", - # nolint next: object_name_linter. - row.names = NULL, - # Excel formula for NA produces #N/A -- sometimes people use N/A... - # nolint next: object_name_linter. - na.strings = c("", "NA", "N/A", "#N/A"), - # nolint next: object_name_linter. - check.names = FALSE, - # nolint next: object_name_linter. - stringsAsFactors = FALSE, - encoding = "UTF-8", - # occasionally "#' is used as a column name -- may cause issues - # nolint next: object_name_linter. - comment.char = "", - # nolint next: object_name_linter. - blank.lines.skip = FALSE, - fill = TRUE, - ... + header = TRUE, + # Copying form Excel produces tab separations + sep = "\t", + # nolint next: object_name_linter. + row.names = NULL, + # Excel formula for NA produces #N/A -- sometimes people use N/A... + # nolint next: object_name_linter. + na.strings = c("", "NA", "N/A", "#N/A"), + # nolint next: object_name_linter. + check.names = FALSE, + # nolint next: object_name_linter. + stringsAsFactors = FALSE, + encoding = "UTF-8", + # occasionally "#' is used as a column name -- may cause issues + # nolint next: object_name_linter. + comment.char = "", + # nolint next: object_name_linter. + blank.lines.skip = FALSE, + fill = TRUE, + ... ) { res <- utils::read.table( file = textConnection(clipr_read_clip(TRUE)), - header = header, - sep = sep, - row.names = row.names, - na.strings = na.strings, - check.names = check.names, + header = header, + sep = sep, + row.names = row.names, + na.strings = na.strings, + check.names = check.names, stringsAsFactors = stringsAsFactors, - encoding = encoding, - comment.char = comment.char, + encoding = encoding, + comment.char = comment.char, blank.lines.skip = blank.lines.skip, - fill = fill, + fill = fill, ... ) diff --git a/R/counts.R b/R/counts.R index 96b15aef..8a58fd8d 100644 --- a/R/counts.R +++ b/R/counts.R @@ -1,16 +1,15 @@ #' Count observations by unique values #' #' Get counts or proportions of unique observations in a vector or columns in a -#' `data.frame` +#' `data.frame` #' -#' @description -#' Variables will be return by the order in which they appear. Even factors are -#' shown by their order of appearance in the vector. +#' @description Variables will be return by the order in which they appear. +#' Even factors are shown by their order of appearance in the vector. #' #' There are 2 methods for counting vectors. The `default` method uses -#' `base::tabulate()` (the workhorse for `base::table()` with a call to -#' `pseudo_id()` to transform all inputs into integers. The `logical` method -#' counts `TRUE`, `FALSE` and `NA` values, which is much quicker. +#' [base::tabulate()] (the workhorse for [base::table()] with a call to +#' [mark::pseudo_id()] to transform all inputs into integers. The `logical` +#' method counts `TRUE`, `FALSE` and `NA` values, which is much quicker. #' #' @param x A vector or `data.frame` #' @param ... Arguments passed to other methods diff --git a/R/dataframes.R b/R/dataframes.R index 68df27c7..4a896107 100644 --- a/R/dataframes.R +++ b/R/dataframes.R @@ -62,16 +62,15 @@ vector2df <- function(x, name = "name", value = "value") { #' List to data.frame #' -#' Converts a list object into a data.frame +#' Converts a list object into a `data.frame` #' -#' @details -#' Unlike `base::list2DF()`, `list2df()` tries to format the data.frame by using -#' the names of the list as values rather than variables. This creates a -#' longer form list that may be more tidy. +#' @details Unlike [base::list2DF()], [mark::list2df()] tries to format the +#' `data.frame` by using the names of the list as values rather than +#' variables. This creates a longer form list that may be more tidy. #' #' @param x A (preferably) named `list` with any number of values #' @param name,value Names of the new key and value columns, respectively -#' @param warn Logical; if TRUE will show a warning when +#' @param warn Logical; if `TRUE` will show a warning when #' #' @return a `data.frame` object with columns `"name"` and `"value"` for the #' names of the `list` and the values in each @@ -147,17 +146,16 @@ list2df2 <- function(x = list(), nrow = NULL) { #' Data frame transpose #' -#' Transposes a data.frame as a data.frame +#' Transposes a `data.frame` as a `data.frame` #' -#' @description -#' This transposes a data.frame with `t()` but transforms back into a data.frame -#' with column and row names cleaned up. Because the data types may be mixed -#' and reduced to characters, this may only be useful for a visual viewing of -#' the data.frame. +#' @description This transposes a data.frame with [base::t()] but transforms +#' back into a data.frame with column and row names cleaned up. Because the +#' data types may be mixed and reduced to characters, this may only be useful +#' for a visual viewing of the data.frame. #' #' @param x A data.frame -#' @return A transposed `data.frame` with columns (`"colname"`, `"row_1"`, ..., -#' for each row in `x`. +#' @return A transposed `data.frame` with columns (`"colname"`, `"row_1"`, +#' `...`, for each row in `x`. #' #' @examples #' x <- data.frame(col_a = Sys.Date() + 1:5, col_b = letters[1:5], col_c = 1:5) @@ -194,7 +192,7 @@ rn_to_col <- function(data, name = "row.name") { #' #' Return completed cases of a data.frame #' -#' @param data A data.frame +#' @param data A `data.frame` #' @param cols Colnames or numbers to remove `NA` values from; `NULL` (default) #' will use all columns #' @param invert Logical, if `TRUE` will return incomplete cases diff --git a/R/depth.R b/R/depth.R index cefa1fd1..be2b1063 100644 --- a/R/depth.R +++ b/R/depth.R @@ -2,9 +2,8 @@ #' #' Functions to extract the 'depth' of an object #' -#' @details -#' This function does not count an empty lists (`list()`) as a level or `NULL` -#' objects. +#' @details This function does not count an empty lists ([base::list()]) as a +#' level or `NULL` objects. #' #' @param x An object #' @param ... Possible additional arguments passed to methods (not in use) diff --git a/R/description.R b/R/description.R index 8262a99b..6acf779a 100644 --- a/R/description.R +++ b/R/description.R @@ -1,4 +1,4 @@ -#' Add author to DESCRIPTION +#' Add author to `DESCRIPTION` #' #' Adds author to description #' @@ -91,20 +91,20 @@ find_author <- function() { #' Get and bump package version for dates #' #' @description Will read the `DESCRIPTION` file and to get and adjust the -#' version +#' version #' -#' `bump_date_version()` will not check if the version is actually a date. When -#' the current version is the same as today's date(equal by character strings) -#' it will append a `.1`. +#' [mark::bump_date_version()] will not check if the version is actually a +#' date. When the current version is the same as today's date (equal by +#' character strings) it will append a `.1`. #' #' @param version A new version to be added; default of `NULL` will #' automatically update. #' @param date If `TRUE` will use a date as a version. #' @return -#' * `get_version()`: A package_version -#' * `bump_version()`: None, called for its side-effects -#' * `bump_date_version()`: None, called for its side-effects -#' * `update_version()`: None, called for its side-effects +#' - [mark::get_version()]: A package_version +#' - [mark::bump_version()]: None, called for its side-effects +#' - [mark::bump_date_version()]: None, called for its side-effects +#' - [mark::update_version()]`: None, called for its side-effects #' #' @export get_version <- function() { diff --git a/R/diff-time.R b/R/diff-time.R index 789bfdee..a5ed20b6 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -14,12 +14,11 @@ #' passed to the `tz` parameter as a character vector #' #' @section Units: Units can be used beyond those available in -#' `base::difftime()`. Some of these use assumptions in how units of time +#' [base::difftime()]. Some of these use assumptions in how units of time #' should be standardized and can be changed in the corresponding options. Any -#' of these can be calculated with `base::difftime()` through using `units = -#' "days"` but the `dtime` class will print out with these specifications into -#' the console for less potential confusion. -#' +#' of these can be calculated with [base::difftime()] through using +#' `units = "days"` but the `dtime` class will print out with these +#' specifications into the console for less potential confusion. #' #' \describe{ #' \item{months}{Months by number of days `mark.days_in_month` (defaults: `30`)} @@ -31,7 +30,7 @@ #' #' @section Time zones: Time zones can be passed as either a numeric vector of #' GMT/UTC offsets (the number of seconds from GMT) or as a character vector. -#' If the letter, these need to conform with values from `base::OlsonNames()`. +#' If the letter, these need to conform with values from [base::OlsonNames()]. #' #' A default timezone can be set with `options(mark.default_tz = .)`. The #' value can either be a numeric @@ -40,7 +39,7 @@ #' @param method A method to report the difference in units of time (see #' **Units** section) #' @param tzx,tzy time zones (see **Time zones** section) -#' @param ... Additional arguments passed to `diff_time()` +#' @param ... Additional arguments passed to [mark::diff_time()] #' @return A `diff_time` vector, object #' #' @export diff --git a/R/directory.R b/R/directory.R index 205466dc..e72088b5 100644 --- a/R/directory.R +++ b/R/directory.R @@ -104,9 +104,9 @@ remove_temp_files <- function(x) { #' Normalize and check a vector of paths #' #' @param x A character vector of paths -#' @param check Logical, if TRUE will check if the path exists and output a +#' @param check Logical, if `TRUE` will check if the path exists and output a #' warning if it does not. -#' @param remove Logical, if TRUE will remove paths that are not found +#' @param remove Logical, if `TRUE` will remove paths that are not found #' @param ... Character vectors for creating a path #' @return A vector of full file paths #' @@ -195,34 +195,37 @@ smallest_file <- function(x) { x[which.min(file.size(x))] } +# NOTE Using link for [base::shell.exec()] will fail on non-Windows + #' Open a file using windows file associations #' #' Opens the given files(s) #' -#' @details `open_file` is an alternative to `shell.exec()` that can take take -#' multiple files. `list_files` and `list_dirs` are mostly wrappers for -#' [fs::dir_ls()] with preferred defaults and pattern searching on the full file -#' path. +#' @details [mark::open_file()] is an alternative to `base::shell.exec()` that +#' can take take multiple files. [mark::list_files()] and [mark::list_dirs()] +#' are mostly wrappers for [fs::dir_ls()] with preferred defaults and pattern +#' searching on the full file path. #' -#' `file_open` is simply an alias. +#' [mark::file_open()] is simply an alias. #' #' @inheritParams norm_path #' @inheritParams fs::dir_ls #' @param pattern,glob Pattern to search for files. `glob` is absorbed into #' `pattern`, through [utils::glob2rx()]. #' @param ignore_case logical. Should pattern-matching be case-insensitive? -#' @param all a logical value. If FALSE, only the names of visible files are +#' @param all a logical value. If `FALSE`, only the names of visible files are #' returned (following Unix-style visibility, that is files whose name does -#' not start with a dot). If TRUE, all file names will be returned. +#' not start with a dot). If `TRUE`, all file names will be returned. #' @param basename If `TRUE` only searches pattern on the basename, otherwise on #' the entire path #' @param negate Logical, if `TRUE` will inversely select files that do not #' match the provided pattern #' #' @return -#' * `open_file()`, `shell_exec()`: A logical vector where `TRUE` successfully -#' opened, `FALSE` did not and `NA` did not try to open (file not found) -#' * `list_files()`, `list_dirs()`: A vector of full paths +#' - [mark::open_file()], [mark::shell_exec()]: A logical vector where `TRUE` +#' successfully opened, `FALSE` did not and `NA` did not try to open (file not +#' found) +#' - [mark::list_files()], [mark::list_dirs()]: A vector of full paths #' @name file_utils NULL @@ -243,7 +246,8 @@ file_open <- open_file #' @export shell_exec <- function(x) { if (is_windows()) { - open_fun <- function(path) shell.exec(file = path) # nolint: object_usage_linter, line_length_linter. + # nolint next: object_usage_linter. + open_fun <- function(path) shell.exec(file = path) } else { require_namespace("xopen") open_fun <- function(path) xopen::xopen(target = path) @@ -434,7 +438,8 @@ file_name <- function(x, compression = FALSE) { #' Adds a timestamp to a file #' #' @param x A vector of files -#' @param ts A single timestamp or vector of timestamps (default: `Sys.time()`) +#' @param ts A single timestamp or vector of timestamps (default: +#' [base::Sys.time()]) #' @param format A format to be applied to the times; set to `NULL` to skip #' formatting #' @param sep A `character` vector of length 1 to separate the timestamp from diff --git a/R/environments.R b/R/environments.R index a955e3c2..2cb7018c 100644 --- a/R/environments.R +++ b/R/environments.R @@ -2,18 +2,19 @@ #' #' Functions to list out all environments and objects #' -#' @details -#' `environments()` is basically a printing wrapper for `base::search()` +#' @details [mark::environments()] is basically a printing wrapper for +#' [base::search()] #' -#' `ls_all()` and `objects_all()` can be used retrieved all objects from all -#' environments in the `search()` path, which may print out a large result -#' into the console. +#' [mark::ls_all()] and [mark::objects_all()] can be used retrieved all +#' objects from all environments in the [base::search()] path, which may print +#' out a large result into the console. #' #' @inheritParams base::ls #' #' @export #' @return -#' * `environments()`: Invisibly, a `character` vector of environment names +#' - [mark::environments()]: Invisibly, a `character` vector of environment +#' names #' @name list_environments environments <- function() { struct(search(), c("character", "mark_environments")) @@ -30,8 +31,9 @@ print.mark_environments <- function(x, ...) { #' @export #' @rdname list_environments #' @return -#' * `ls_all()`, `objects_all()`: A named list for each of the environments -#' the `search()` path with all the objects found in that environment +#' - [mark::ls_all()], [mark::objects_all()]: A named list for each of the +#' environments the [base::search()] path with all the objects found in that +#' environment # nolint next: object_name_linter. ls_all <- function(all.names = FALSE) { sapply(search(), function(s) ls(as.environment(s), all.names = all.names)) diff --git a/R/expand.R b/R/expand.R index d46e9f52..e774c7e3 100644 --- a/R/expand.R +++ b/R/expand.R @@ -4,7 +4,7 @@ #' #' @param x,y Vectors #' @param expand Character switch to expand or keep only the values that -#' intersect, all values in x or y, or retain all values found. +#' intersect, all values in `x` or `y`, or retain all values found. #' @param sort Logical, if `TRUE` will sort by names in output #' #' @return A vector with expanded diff --git a/R/fact.R b/R/fact.R index eed9e9f4..7589f68e 100644 --- a/R/fact.R +++ b/R/fact.R @@ -6,19 +6,19 @@ #' #' Quickly create a factor #' -#' @details `fact()` can be about 5 times quicker than `factor()` or -#' `as.factor()` as it doesn't bother sorting the levels for non-numeric data -#' or have other checks or features. It simply converts a vector to a factor -#' with all unique values as levels with `NA`s included. +#' @details [mark::fact()] can be about 5 times quicker than [base::factor()] or +#' [base::as.factor()] as it doesn't bother sorting the levels for non-numeric +#' data or have other checks or features. It simply converts a vector to a +#' factor with all unique values as levels with `NA`s included. #' -#' `fact.factor()` will perform several checks on a factor to include `NA` -#' levels and to check if the levels should be reordered to conform with the -#' other methods. The `fact.fact()` method simple returns `x`. +#' [mark::fact.factor()] will perform several checks on a factor to include +#' `NA` levels and to check if the levels should be reordered to conform with +#' the other methods. The [mark::fact.fact()] method simple returns `x`. #' #' @section level orders: #' -#' The order of the levels may be adjusted to these rules depending on the class -#' of `x`: +#' The order of the levels may be adjusted to these rules depending on the +#' class of `x`: #' \describe{ #' \item{`character`}{The order of appearance} #' \item{`numeric`/`integer`/`Date`/`POSIXt`}{By the numeric order} @@ -31,7 +31,7 @@ #' @return A vector of equal length of `x` with class `fact` and `factor`. If #' `x` was `ordered`, that class is added in between. #' -#' @seealso [as_ordered()] +#' @seealso [mark::as_ordered()] #' @family factors #' @export fact <- function(x) { @@ -250,13 +250,13 @@ print.fact <- function( #' As ordered #' #' @details Simple implementation of `ordered`. If `x` is `ordered` it is -#' simply returned. If `x` is a `factor` the `ordered` class is added. -#' Otherwise, `x` is made into a `factor` with [mark::fact()] and then the -#' `ordered` class is added. Unlike just `fact`, `ordered` will replace the `NA` -#' levels with `NA_integer_` to work appropriately with other functions. +#' simply returned. If `x` is a `factor` the `ordered` class is added. +#' Otherwise, `x` is made into a `factor` with [mark::fact()] and then the +#' `ordered` class is added. Unlike just `fact`, `ordered` will replace the +#' `NA` levels with `NA_integer_` to work appropriately with other functions. #' #' @inheritParams fact -#' @seealso [fact()] +#' @seealso [mark::fact()] #' @family factors #' @export #' @returns An `ordered` vector @@ -380,7 +380,7 @@ fact_na <- function(x, remove = FALSE) { #' #' Reverse the levels of a `fact` #' -#' @param x A `fact` object (or passed to [fact()]) +#' @param x A `fact` object (or passed to [mark::fact()]) fact_reverse <- function(x) { x <- fact(x) lvls <- flip(attr(x, "uniques")) diff --git a/R/file.R b/R/file.R index 6922cb70..677a47d9 100644 --- a/R/file.R +++ b/R/file.R @@ -1,4 +1,3 @@ - #' File copy with md5 hash check #' #' @inheritParams fs::file_copy diff --git a/R/fizzbuzz.R b/R/fizzbuzz.R index 073abe2d..2ba5aafb 100644 --- a/R/fizzbuzz.R +++ b/R/fizzbuzz.R @@ -4,11 +4,10 @@ #' that the quickest way to do it is to just take the work someone else did and #' utilize that. No reason to reinvent the wheel. #' -#' @details -#' Multiples of `3` are shown as `"Fizz"`; multiples of `5` as `"Buzz"`; -#' multiple of both (i.e., `15`) are `"FizzBuzz"`. -#' `fizzbuzz_lazy()` subsets the `.fizzbuzz_vector` object, which is a solution -#' with default parameters up to `1e6` +#' @details Multiples of `3` are shown as `"Fizz"`; multiples of `5` as +#' `"Buzz"`; multiple of both (i.e., `15`) are `"FizzBuzz"`. +#' [mark::fizzbuzz_lazy()] subsets the `.fizzbuzz_vector` object, which is a +#' solution with default parameters up to `1e6` #' #' @param n The number of numbers #' @param show_numbers If `TRUE` shows no diff --git a/R/funs.R b/R/funs.R index a381c175..9d223b00 100644 --- a/R/funs.R +++ b/R/funs.R @@ -43,8 +43,8 @@ rn <- function(namespace) { #' @param namespace One or more packages to to require. #' @export #' @return -#' * `require_namespace()`: None, called for side effects -#' * `package_available()`: Visibly, `TRUE` or `FALSE` +#' - [mark::require_namespace()]: None, called for side effects +#' - [mark::package_available()]: Visibly, `TRUE` or `FALSE` #' @export package_available <- function(namespace) { vap_lgl(namespace, requireNamespace, quietly = TRUE) @@ -58,7 +58,7 @@ rn_soft <- function(namespace) { #' Quiet stop #' -#' Quietly calls stop +#' Quietly calls [base::stop()] #' #' @return None, called for side effects #' @export diff --git a/R/glob.R b/R/glob.R index b7555191..7d66d30c 100644 --- a/R/glob.R +++ b/R/glob.R @@ -4,8 +4,9 @@ #' #' @param x A vector of characters #' @param pattern Wildcard globbing pattern -#' @param value,... Additional parameters passed to `grep`. Note: `value` is by -#' default `TRUE`; when `NA`, `...` is passed to `grepl`. +#' @param value,... Additional parameters passed to [base::grep()]. Note: +#' `value` is by default `TRUE`; when `NA`, `...` is passed to +#' [base::grep()]`. #' @examples #' x <- c("apple", "banana", "peach", "pear", "orange") #' glob(x, "*e") diff --git a/R/labels.R b/R/labels.R index b1061be7..c5a40718 100644 --- a/R/labels.R +++ b/R/labels.R @@ -2,11 +2,10 @@ #' #' Assign labels to a vector or data.frame. #' -#' @details -#' When labels are assigned to a data.frame they can make viewing the object -#' (with `View()` inside Rstudio). [view_labels()] has a call to `View()` -#' inside and will retrieve the labels and show them in the viewer as a -#' data.frame. +#' @details When labels are assigned to a data.frame they can make viewing the +#' object (with `View()` inside Rstudio). [mark::view_labels()] has a call to +#' `View()` inside and will retrieve the labels and show them in the viewer as a +#' data.frame. #' #' @param x A vector of data.frame #' @param ... One or more unquoted expressed separated by commas. If assigning @@ -55,8 +54,8 @@ assign_labels.default <- function(x, label, ...) { #' @export #' @rdname labels #' @param .missing A control setting for dealing missing columns in a list; can -#' be set to `"error"` to [stop()] the call, `"warn"` to provide a warning, or -#' `"skip"` to silently skip those labels. +#' be set to `"error"` to [base::stop()] the call, `"warn"` to provide a +#' warning, or `"skip"` to silently skip those labels. #' @param .ls A named list of columns and labels to be set if `...` is empty assign_labels.data.frame <- function( x, diff --git a/R/lines-of-code.R b/R/lines-of-code.R index 8d91f5ea..7241f2ad 100644 --- a/R/lines-of-code.R +++ b/R/lines-of-code.R @@ -2,12 +2,11 @@ #' #' Find the total number of lines of **R** code #' -#' @details -#' Tries to read each file in the directory that ends in .R or .r and sums -#' together. Files that fail to read are not counted. +#' @details Tries to read each file in the directory that ends in `.R` or `.r` +#' and sums together. Files that fail to read are not counted. #' #' @param x Directory to search for files -#' @param skip_empty Logical, if TRUE will not count lines that are empty or +#' @param skip_empty Logical, if `TRUE` will not count lines that are empty or #' only contain a bracket or quotation mark. #' #' @returns An `integer` for the number of lines in all applicable files diff --git a/R/logic.R b/R/logic.R index e16b247a..201acde9 100644 --- a/R/logic.R +++ b/R/logic.R @@ -10,11 +10,11 @@ #' [base::isTRUE()] and [base::isFALSE()] will only return single length #' `TRUE` or `FALSE` as it checks for valid lengths in the evaluation. When #' needing to check over a vector for the presence of `TRUE` or `FALSE` and -#' not being held back by `NA` values, [is_true()] and [is_false()] will -#' always provide a `TRUE` `FALSE` when the vector is logical or return `NA` -#' is the vector `x` is not logical. +#' not being held back by `NA` values, [mark::is_true()] and +#' [mark::is_false()] will always provide a `TRUE` `FALSE` when the vector is +#' logical or return `NA` is the vector `x` is not logical. #' -#' `%or%` is just a wrapper for [base::xor()] +#' [mark::%or%] is just a wrapper for [base::xor()] #' #' @param x,y A vector of logical values. If `NULL` will generate a warning. #' If not a logical value, will return `NA` equal to the vector length @@ -47,10 +47,11 @@ #' is_boolean(c(1L, NA_integer_, 0L)) #' is_boolean(c(1.01, 0, -1)) #' @return -#' * `is_true()`, `is_false()`, `either()`, `%or%`, `AND()`, `OR()`: A `logical` -#' vector, equal length of `x` (or `y` or of all `...` lengths) -#' * `is_boolean()`: `TRUE` or `FALSE` -#' * `none()`: `TRUE`, `FALSE`, or `NA` +#' - [mark::is_true()], [mark::is_false()], [mark::either()], [mark::%or%], +#' [mark::AND()], [mark::OR()]: A `logical` vector, equal length of `x` (or `y` +#' or of all `...` lengths) +#' - [mark::is_boolean()]: `TRUE` or `FALSE` +#' - [mark::none()]: `TRUE`, `FALSE`, or `NA` #' #' @name logic_ext NULL diff --git a/R/match-arg.R b/R/match-arg.R index 67d45852..93941e5c 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -11,7 +11,7 @@ #' @param table A table of choices #' @return A single value from `x` matched on `table` #' -#' @seealso [match_param()] +#' @seealso [mark::match_param()] #' @examples #' x <- c("apple", "banana", "orange") #' suppressWarnings(match_arg("b", x), "deprecatedWarning") @@ -65,12 +65,12 @@ match_arg <- function(x, table) { #' of formula objects (preferred) retains the LHS of the formula as the return #' value when matched to the RHS of the formula. #' @param null If `TRUE` allows `NULL` to be passed a `param` -#' @param partial If `TRUE` allows partial matching via [pmatch()] +#' @param partial If `TRUE` allows partial matching via [base::pmatch()] #' @param multiple If `TRUE` allows multiple values to be returned #' @param simplify If `TRUE` will simplify the output to a single value #' @return A single value from `param` matched on `choices` #' -#' @seealso [match_arg()] +#' @seealso [mark::match_arg()] #' @examples #' fruits <- function(x = c("apple", "banana", "orange")) { #' match_param(x) diff --git a/R/normalize.R b/R/normalize.R index 8d76999d..b82cba96 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -7,9 +7,9 @@ #' minimum/maximum values and lower/upper bounds. This allows for a vector of #' more than two values to be passed. #' -#' The current implementation of [normalize.data.frame()] allows for `list` of -#' parameters passed for each column. However, it is probably best suited for -#' default values. +#' The current implementation of [mark::normalize.data.frame()] allows for +#' `list` of parameters passed for each column. However, it is probably best +#' suited for default values. #' #' @param x An object that is (coercible to) `double`; `data.frames` are #' transformed diff --git a/R/pseudo-id.R b/R/pseudo-id.R index 576878ed..c1f4e40c 100644 --- a/R/pseudo-id.R +++ b/R/pseudo-id.R @@ -46,12 +46,12 @@ pseudo_id.factor <- function(x, ...) { #' Print `pseudo_id` #' @export -#' @param x An object of class [pseudo_id] +#' @param x An object of class `pseudo_id` #' @param ... Not implemented #' @param all if `TRUE` will print all uniques. This is not recommend for many #' uniques as it will crowd the console output #' @returns `x`, invisibly. Called for its side effects. -#' @seealso [pseudo_id()] +#' @seealso [mark::pseudo_id()] print.pseudo_id <- function(x, ..., all = FALSE) { print(as.integer(x)) out <- collapse0("Uniques: ", paste0(attr(x, "uniques"), sep = " "), sep = "") diff --git a/R/sourcing.R b/R/sourcing.R index 1ad3715b..d051c807 100644 --- a/R/sourcing.R +++ b/R/sourcing.R @@ -12,17 +12,17 @@ #' evaluated #' @param ... Additional arguments passed to [base::source()] #' -#' @details -#' [try_source()] will output an error message rather than completely preventing -#' the execution. -#' This can be useful for when a script calls on multiple, independent files to -#' be sourced and a single failure shouldn't prevent the entire run to fail as -#' well. +#' @details [mark::try_source()] will output an error message rather than +#' completely preventing the execution. This can be useful for when a script +#' calls on multiple, independent files to be sourced and a single failure +#' shouldn't prevent the entire run to fail as well. #' #' @name sourcing #' @return -#' * [ksource()]: Invisibly, the result of calling [base::source()] on the `.R` file conversion of `file` -#' * [try_source()], [try_ksource()]: attempts of [base::source()] and [ksource()] but converts errors to warnings +#' - [mark::ksource()]: Invisibly, the result of calling [base::source()] on +#' the `.R` file conversion of `file` +#' - [mark::try_source()], [mark::try_ksource()]: attempts of [base::source()] +#' and [mark::ksource()] but converts errors to warnings #' @export # nolint end: line_length_linter. diff --git a/R/stats.R b/R/stats.R index 5e1cb226..efe55a67 100644 --- a/R/stats.R +++ b/R/stats.R @@ -29,8 +29,8 @@ q50 <- median2 #' Range 2 #' -#' Employs `min()` and `max()`. However, [base::range()], there is no argument -#' for removing `Inf` values. +#' Employs [base::min()] and [base::max()]. However, [base::range()], there is +#' no argument for removing `Inf` values. #' #' @param x A numeric (or character) vector (see Note in [base::min]) #' @param na.rm Logical, if `TRUE` removes missing values diff --git a/R/switch.R b/R/switch.R index 59127ede..acb986b8 100644 --- a/R/switch.R +++ b/R/switch.R @@ -2,16 +2,19 @@ #' #' Switch with a list of params #' -#' @description [switch_params()] is a vectorized version of [base::switch()] +#' @description [mark::switch_params()] is a vectorized version of +#' [base::switch()] #' -#' [switch_case()] uses a formula syntax to return the value to the right of the -#' tilde (`~`) when `x` is `TRUE` +#' [mark::switch_case()] uses a formula syntax to return the value to the +#' right of the tilde (`~`) when `x` is `TRUE` #' -#' [switch_in_case()] is a special case of [switch_case()] for [base::match()]-ing `x` -#' in the values on the left to return the value on the right. +#' [mark::switch_in_case()] is a special case of [mark::switch_case()] for +#' [base::match()]-ing `x` in the values on the left to return the value on +#' the right. #' -#' @return A named vector of values of same length `x`; or for [switch_case()], an -#' unnamed vector of values matching the rhs of `...` +#' @return A named vector of values of same length `x`; or for +#' [mark::switch_case()], an unnamed vector of values matching the rhs of +#' `...` #' #' Inspired from: #' * https://stackoverflow.com/a/32835930/12126576 @@ -83,7 +86,7 @@ NULL #' @param x A vector of values -#' @param ... Case evaluations (named for [switch_params()]) +#' @param ... Case evaluations (named for [mark::switch_params()]) #' @rdname switch-ext #' @export switch_params <- function(x, ...) { diff --git a/R/system-file.R b/R/system-file.R index eca0f027..9c8dfd1c 100644 --- a/R/system-file.R +++ b/R/system-file.R @@ -4,13 +4,13 @@ #' #' @param package The name of the package #' -#' @returns A `function` wrapping [system.file()] which will always use the +#' @returns A `function` wrapping `system.file()` which will always use the #' package name provided in `package` #' @export #' @examples #' make_sf("mark")() make_sf <- function(package) { - fun <- function(..., check = FALSE) { } + fun <- function(..., check = FALSE) {} body(fun) <- substitute( match.fun("system.file")(..., package = package, mustWork = check) ) diff --git a/R/unlist.R b/R/unlist.R index 4f35a724..4ffee60d 100644 --- a/R/unlist.R +++ b/R/unlist.R @@ -3,9 +3,9 @@ #' Unlist without unique names; combine names for unique values #' #' @details -#' * [unlist0()] is much like [base::unlist()] expect that name are not made to -#' be unique. -#' * [squash_vec()] works differently +#' - [mark::unlist0()] is much like [base::unlist()] expect that name are not +#' made to be unique. +#' - [mark::squash_vec()] works differently #' #' @param x A vector of values #' @examples @@ -22,8 +22,8 @@ #' squash_vec(y) #' @export #' @returns -#' * [unlist0()]: a vector with the possibility of non-unique names -#' * [squash_vec()]: A vector of unique values and names +#' * [mark::unlist0()]: a vector with the possibility of non-unique names +#' * [mark::squash_vec()]: A vector of unique values and names unlist0 <- function(x) { if (!is.list(x)) { return(x) diff --git a/R/within.R b/R/within.R index 47414878..3691ce16 100644 --- a/R/within.R +++ b/R/within.R @@ -3,21 +3,21 @@ #' Compare a vector within (between) other values #' #' @param x A numeric vector of values -#' @param left,right Boundary values. For [within()], when `NULL` no +#' @param left,right Boundary values. For [mark::within()], when `NULL` no #' comparison is made for that boundary. When both are `NULL`, `x` is just #' returned. #' -#' @details `type``, `bounds`` can be one of the below: +#' @details `type`, `bounds` can be one of the below: #' #' \describe{ -#' \item{g,(}{is greater than (>)} -#' \item{ge,[}{greater than or equal to (>=)} -#' \item{l,))}{less than (<)} -#' \item{le,[]}{less than or equal to (<=)} +#' \item{`"g"`, `(`}{is greater than (`>`)} +#' \item{`"ge"`, `[`}{greater than or equal to (`>=`)} +#' \item{`"l"`, `)`}{less than (`<`)} +#' \item{`"le"`, `]`}{less than or equal to (`<=`)} #' } #' -#' Note: [between_more()] may be deprecated in the future in favor of just -#' [within()] +#' Note: [mark::between_more()] may be deprecated in the future in favor of +#' just [mark::within()] #' #' @returns A logical vector #' diff --git a/R/write.R b/R/write.R index 6d9398fe..346bbebe 100644 --- a/R/write.R +++ b/R/write.R @@ -1,28 +1,29 @@ #' Write file with md5 hash check #' -#' @section `options()`: +#' @section [base::options()]: #' #' - `mark.compress.method`: compression method to use when writing files #' - `mark.list.hook`: when a `data.frame` contains a `list` column, this -#' function is applied to each element of the list. The default `"auto"` -#' uses `toJSON()` if the package `jsonlite` is available, otherwise +#' function is applied to each element of the list. The default `"auto"` uses +#' `jsonlite::toJSON()` if the package `jsonlite` is available, otherwise #' #' @param x An object to write to file #' @param path The file or connection to write to (dependent on part by method) #' @param method The method of saving the file. When `default`, the method is #' determined by file extension of `path`, if present, otherwise by the type #' of object of `x`. -#' @inheritParams file_copy_md5 #' @param encoding The encoding to use when writing the file. #' @param compression The compression method to use when writing the file. #' @param ... Additional arguments passed to the write function. +#' @inheritParams file_copy_md5 #' @returns -#' - [write_file_md5()]: `x`, invisibly. When `path` is not the `stdout()`, `x` -#' is returned with the attribute `"path"` set to the result of -#' [file_copy_md5()]. -#' - [mark_write_methods()]: A list of applicable methods and their aliases -#' - [mark_compress_methods()]: A character vector of applicable compression -#' methods +#' - [mark::write_file_md5()]: `x`, invisibly. When `path` is not the +#' [base::stdout()], `x` is returned with the attribute `"path"` set to the +#' result of [mark::file_copy_md5()]. +#' - [mark::mark_write_methods()]: A list of applicable methods and their +#' aliases +#' - [mark::mark_compress_methods()]: A character vector of applicable +#' compression methods #' @examples #' # just writes to stdout() #' df <- data.frame(a = 1, b = 2) From 9c07a1aed67e176282ecc4ca1c32882c7137a4fb Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 16:34:12 -0500 Subject: [PATCH 123/169] updates tests (#259) --- tests/testthat/test-nas.R | 2 +- tests/testthat/test-within.R | 12 ++---------- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test-nas.R b/tests/testthat/test-nas.R index a7003d0b..9e50c900 100644 --- a/tests/testthat/test-nas.R +++ b/tests/testthat/test-nas.R @@ -2,7 +2,7 @@ test_that("remove_na()", { x <- c(1, 2, NA, 3, NaN) expect_equal(remove_na(x), c(1, 2, 3)) expect_equal(remove_na(as.list(x)), list(1, 2, numeric(), 3, numeric())) - expect_error(remove_na(quick_dfl(x = 1)), class = "mark:vector_required") + expect_error(remove_na(quick_dfl(x = 1)), class = "mark:input_error") res <- remove_na(fact(x)) exp <- struct( diff --git a/tests/testthat/test-within.R b/tests/testthat/test-within.R index dc1856d2..1075c499 100644 --- a/tests/testthat/test-within.R +++ b/tests/testthat/test-within.R @@ -30,11 +30,7 @@ test_that("between_more() works", { res <- c(FALSE, TRUE, TRUE, FALSE, FALSE) expect_identical(between_more(x, left, right), res) - expect_warning( - between_more(1:2, 3, 2), - "`left` > `right`", - class = "mark:between_more_lr" - ) + expect_warning(between_more(1:2, 3, 2), class = "mark:input_warning") }) @@ -67,9 +63,5 @@ test_that("within()", { expect_identical(within(x), x) - expect_warning( - within(1:2, 3, 2), - "`left` > `right`", - class = "mark:within_lr" - ) + expect_warning(within(1:2, 3, 2), class = "mark:input_warning") }) From 3171fd36fba82970049f8164fdb172c3b8503ce1 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 5 Jan 2026 16:34:18 -0500 Subject: [PATCH 124/169] redocs (#259) --- man/add_file_timestamp.Rd | 3 ++- man/are_identical.Rd | 2 +- man/as_ordered.Rd | 4 ++-- man/base_alpha.Rd | 2 +- man/base_n.Rd | 2 +- man/blank_values.Rd | 10 +++++----- man/clipboard.Rd | 14 ++++++++------ man/complete_cases.Rd | 2 +- man/counts.Rd | 10 +++++----- man/depth.Rd | 4 ++-- man/diff_time.Rd | 11 ++++++----- man/expand_by.Rd | 2 +- man/fact.Rd | 20 ++++++++++---------- man/file_utils.Rd | 21 +++++++++++---------- man/fizzbuzz.Rd | 8 ++++---- man/get_version.Rd | 14 +++++++------- man/glob.Rd | 5 +++-- man/import.Rd | 2 +- man/labels.Rd | 14 +++++++------- man/lines_of_r_code.Rd | 10 +++++----- man/list2df.Rd | 10 +++++----- man/list_environments.Rd | 17 ++++++++++------- man/logic_ext.Rd | 29 +++++++++++++++-------------- man/make_sf.Rd | 2 +- man/match_arg.Rd | 6 +++--- man/match_param.Rd | 2 +- man/norm_path.Rd | 4 ++-- man/normalize.Rd | 6 +++--- man/package_available.Rd | 6 +++--- man/print.pseudo_id.Rd | 2 +- man/quiet_stop.Rd | 2 +- man/range2.Rd | 4 ++-- man/read_bib.Rd | 2 +- man/rscript.Rd | 4 ++-- man/source_to_env.Rd | 2 +- man/sourcing.Rd | 17 +++++++++-------- man/switch-ext.Rd | 17 ++++++++++------- man/t_df.Rd | 14 +++++++------- man/unlist0.Rd | 4 ++-- man/use_author.Rd | 2 +- man/vap.Rd | 12 ++++++------ man/within.Rd | 18 +++++++++++------- man/write_file_md5.Rd | 21 +++++++++++---------- 43 files changed, 191 insertions(+), 172 deletions(-) diff --git a/man/add_file_timestamp.Rd b/man/add_file_timestamp.Rd index 4d5a1b84..20149f3c 100644 --- a/man/add_file_timestamp.Rd +++ b/man/add_file_timestamp.Rd @@ -14,7 +14,8 @@ add_file_timestamp( \arguments{ \item{x}{A vector of files} -\item{ts}{A single timestamp or vector of timestamps (default: \code{Sys.time()})} +\item{ts}{A single timestamp or vector of timestamps (default: +\code{\link[base:Sys.time]{base::Sys.time()}})} \item{format}{A format to be applied to the times; set to \code{NULL} to skip formatting} diff --git a/man/are_identical.Rd b/man/are_identical.Rd index c5896686..7637065f 100644 --- a/man/are_identical.Rd +++ b/man/are_identical.Rd @@ -17,7 +17,7 @@ A \code{logical} vector of \code{TRUE}/\code{FALSE} of equal length of each \cod vector } \description{ -Extensions for the use of \code{base::identical()} +Extensions for the use of \code{\link[base:identical]{base::identical()}} } \examples{ x <- y <- z <- 1:5 diff --git a/man/as_ordered.Rd b/man/as_ordered.Rd index 97b65ad0..69707684 100644 --- a/man/as_ordered.Rd +++ b/man/as_ordered.Rd @@ -22,8 +22,8 @@ As ordered Simple implementation of \code{ordered}. If \code{x} is \code{ordered} it is simply returned. If \code{x} is a \code{factor} the \code{ordered} class is added. Otherwise, \code{x} is made into a \code{factor} with \code{\link[=fact]{fact()}} and then the -\code{ordered} class is added. Unlike just \code{fact}, \code{ordered} will replace the \code{NA} -levels with \code{NA_integer_} to work appropriately with other functions. +\code{ordered} class is added. Unlike just \code{fact}, \code{ordered} will replace the +\code{NA} levels with \code{NA_integer_} to work appropriately with other functions. } \examples{ x <- c("a", NA, "b") diff --git a/man/base_alpha.Rd b/man/base_alpha.Rd index a6e5d0f2..305ed0d6 100644 --- a/man/base_alpha.Rd +++ b/man/base_alpha.Rd @@ -4,7 +4,7 @@ \alias{base_alpha} \title{Alpha base} \usage{ -base_alpha(x, base = 26) +base_alpha(x, base = 26L) } \arguments{ \item{x}{A string of letters. Non characters are removed.} diff --git a/man/base_n.Rd b/man/base_n.Rd index db3607c5..1b3c2a10 100644 --- a/man/base_n.Rd +++ b/man/base_n.Rd @@ -4,7 +4,7 @@ \alias{base_n} \title{Base N conversion} \usage{ -base_n(x, from = 10, to = 10) +base_n(x, from = 10L, to = 10L) } \arguments{ \item{x}{A vector of integers} diff --git a/man/blank_values.Rd b/man/blank_values.Rd index 546b435c..91f320aa 100644 --- a/man/blank_values.Rd +++ b/man/blank_values.Rd @@ -29,11 +29,11 @@ of vector} } \value{ \itemize{ -\item \code{is_blank()} a \code{logical} vector indicating \emph{blank} elements in \code{x} -\item \code{select_blank_cols()} \code{x} with only columns that are all \emph{blank} -\item \code{remove_blank_cols()} \code{x} without columns of only \emph{blank} -\item \code{is_blank_cols()} a logical vector: \code{TRUE} all rows of column are \emph{blank}, -otherwise \code{FALSE} +\item \code{\link[=is_blank]{is_blank()}} a \code{logical} vector indicating \emph{blank} elements in \code{x} +\item \code{\link[=select_blank_cols]{select_blank_cols()}} \code{x} with only columns that are all \emph{blank} +\item \code{\link[=remove_blank_cols]{remove_blank_cols()}} \code{x} without columns of only \emph{blank} +\item \code{\link[=is_blank_cols]{is_blank_cols()}} a logical vector: \code{TRUE} all rows of column are +\emph{blank}, otherwise \code{FALSE} } } \description{ diff --git a/man/clipboard.Rd b/man/clipboard.Rd index ef583434..fea3d491 100644 --- a/man/clipboard.Rd +++ b/man/clipboard.Rd @@ -40,18 +40,20 @@ read_clipboard_methods() \item{method}{Method switch for loading the clipboard} } \value{ -\code{write_clipboard()} None, called for side effects \code{read_clipboard()} -Either a vector, \code{data.frame}, or \code{tibble} depending on the \code{method} chosen. -Unlike \code{\link[utils:clipboard]{utils::readClipboard()}}, an empty clipboard value returns \code{NA} rather -than \code{""} +\itemize{ +\item \code{\link[=write_clipboard]{write_clipboard()}} None, called for side effects +\item \code{\link[=read_clipboard]{read_clipboard()}} Either a vector, \code{data.frame}, or \code{tibble} +depending on the \code{method} chosen. Unlike \code{\link[utils:clipboard]{utils::readClipboard()}}, an +empty clipboard value returns \code{NA} rather than \code{""} +} } \description{ Wrappers for working with the clipboard } \details{ As these functions rely on \code{\link[clipr:read_clip]{clipr::read_clip()}} and -\code{\link[utils:clipboard]{utils::writeClipboard()}} they are only available for Windows 10. For copying -and pasting floats, there may be some rounding that can occur. +\code{\link[utils:clipboard]{utils::writeClipboard()}} they are only available for Windows 10. For +copying and pasting floats, there may be some rounding that can occur. } \examples{ # Will only run on windows diff --git a/man/complete_cases.Rd b/man/complete_cases.Rd index 10d0dc35..adbe2581 100644 --- a/man/complete_cases.Rd +++ b/man/complete_cases.Rd @@ -7,7 +7,7 @@ complete_cases(data, cols = NULL, invert = FALSE) } \arguments{ -\item{data}{A data.frame} +\item{data}{A \code{data.frame}} \item{cols}{Colnames or numbers to remove \code{NA} values from; \code{NULL} (default) will use all columns} diff --git a/man/counts.Rd b/man/counts.Rd index 8aeb4291..39dbff02 100644 --- a/man/counts.Rd +++ b/man/counts.Rd @@ -40,13 +40,13 @@ respectively) or \code{data.frame} with columns for each column chosen and the \code{.name} chosen for the summary } \description{ -Variables will be return by the order in which they appear. Even factors are -shown by their order of appearance in the vector. +Variables will be return by the order in which they appear. +Even factors are shown by their order of appearance in the vector. There are 2 methods for counting vectors. The \code{default} method uses -\code{base::tabulate()} (the workhorse for \code{base::table()} with a call to -\code{pseudo_id()} to transform all inputs into integers. The \code{logical} method -counts \code{TRUE}, \code{FALSE} and \code{NA} values, which is much quicker. +\code{\link[base:tabulate]{base::tabulate()}} (the workhorse for \code{\link[base:table]{base::table()}} with a call to +\code{\link[=pseudo_id]{pseudo_id()}} to transform all inputs into integers. The \code{logical} +method counts \code{TRUE}, \code{FALSE} and \code{NA} values, which is much quicker. } \details{ Get counts or proportions of unique observations in a vector or columns in a diff --git a/man/depth.Rd b/man/depth.Rd index 79a733ff..42fc5da8 100644 --- a/man/depth.Rd +++ b/man/depth.Rd @@ -24,8 +24,8 @@ A single \code{integer} Functions to extract the 'depth' of an object } \details{ -This function does not count an empty lists (\code{list()}) as a level or \code{NULL} -objects. +This function does not count an empty lists (\code{\link[base:list]{base::list()}}) as a +level or \code{NULL} objects. } \examples{ a <- c(1, 2, 3) diff --git a/man/diff_time.Rd b/man/diff_time.Rd index 42876979..d99e284f 100644 --- a/man/diff_time.Rd +++ b/man/diff_time.Rd @@ -51,7 +51,7 @@ diff_time_myears(x, y, ...) \item{tzx, tzy}{time zones (see \strong{Time zones} section)} -\item{...}{Additional arguments passed to \code{diff_time()}} +\item{...}{Additional arguments passed to \code{\link[=diff_time]{diff_time()}}} } \value{ A \code{diff_time} vector, object @@ -71,10 +71,11 @@ passed to the \code{tz} parameter as a character vector } \section{Units}{ Units can be used beyond those available in -\code{base::difftime()}. Some of these use assumptions in how units of time +\code{\link[base:difftime]{base::difftime()}}. Some of these use assumptions in how units of time should be standardized and can be changed in the corresponding options. Any -of these can be calculated with \code{base::difftime()} through using \code{units = "days"} but the \code{dtime} class will print out with these specifications into -the console for less potential confusion. +of these can be calculated with \code{\link[base:difftime]{base::difftime()}} through using +\code{units = "days"} but the \code{dtime} class will print out with these +specifications into the console for less potential confusion. \describe{ \item{months}{Months by number of days \code{mark.days_in_month} (defaults: \code{30})} @@ -88,7 +89,7 @@ the console for less potential confusion. \section{Time zones}{ Time zones can be passed as either a numeric vector of GMT/UTC offsets (the number of seconds from GMT) or as a character vector. -If the letter, these need to conform with values from \code{base::OlsonNames()}. +If the letter, these need to conform with values from \code{\link[base:timezones]{base::OlsonNames()}}. A default timezone can be set with \code{options(mark.default_tz = .)}. The value can either be a numeric diff --git a/man/expand_by.Rd b/man/expand_by.Rd index dd753dfd..4db0c329 100644 --- a/man/expand_by.Rd +++ b/man/expand_by.Rd @@ -10,7 +10,7 @@ expand_by(x, y, expand = c("x", "y", "intersect", "both"), sort = FALSE) \item{x, y}{Vectors} \item{expand}{Character switch to expand or keep only the values that -intersect, all values in x or y, or retain all values found.} +intersect, all values in \code{x} or \code{y}, or retain all values found.} \item{sort}{Logical, if \code{TRUE} will sort by names in output} } diff --git a/man/fact.Rd b/man/fact.Rd index 241a2370..3567df6c 100644 --- a/man/fact.Rd +++ b/man/fact.Rd @@ -50,20 +50,20 @@ A vector of equal length of \code{x} with class \code{fact} and \code{factor}. Quickly create a factor } \details{ -\code{fact()} can be about 5 times quicker than \code{factor()} or -\code{as.factor()} as it doesn't bother sorting the levels for non-numeric data -or have other checks or features. It simply converts a vector to a factor -with all unique values as levels with \code{NA}s included. - -\code{fact.factor()} will perform several checks on a factor to include \code{NA} -levels and to check if the levels should be reordered to conform with the -other methods. The \code{fact.fact()} method simple returns \code{x}. +\code{\link[=fact]{fact()}} can be about 5 times quicker than \code{\link[base:factor]{base::factor()}} or +\code{\link[base:factor]{base::as.factor()}} as it doesn't bother sorting the levels for non-numeric +data or have other checks or features. It simply converts a vector to a +factor with all unique values as levels with \code{NA}s included. + +\code{\link[=fact.factor]{fact.factor()}} will perform several checks on a factor to include +\code{NA} levels and to check if the levels should be reordered to conform with +the other methods. The \code{\link[=fact.fact]{fact.fact()}} method simple returns \code{x}. } \section{level orders}{ -The order of the levels may be adjusted to these rules depending on the class -of \code{x}: +The order of the levels may be adjusted to these rules depending on the +class of \code{x}: \describe{ \item{\code{character}}{The order of appearance} \item{\code{numeric}/\code{integer}/\code{Date}/\code{POSIXt}}{By the numeric order} diff --git a/man/file_utils.Rd b/man/file_utils.Rd index f9b60d6e..f70a2925 100644 --- a/man/file_utils.Rd +++ b/man/file_utils.Rd @@ -42,9 +42,9 @@ list_dirs( \item{ignore_case}{logical. Should pattern-matching be case-insensitive?} -\item{all}{a logical value. If FALSE, only the names of visible files are +\item{all}{a logical value. If \code{FALSE}, only the names of visible files are returned (following Unix-style visibility, that is files whose name does -not start with a dot). If TRUE, all file names will be returned.} +not start with a dot). If \code{TRUE}, all file names will be returned.} \item{negate}{Logical, if \code{TRUE} will inversely select files that do not match the provided pattern} @@ -54,19 +54,20 @@ the entire path} } \value{ \itemize{ -\item \code{open_file()}, \code{shell_exec()}: A logical vector where \code{TRUE} successfully -opened, \code{FALSE} did not and \code{NA} did not try to open (file not found) -\item \code{list_files()}, \code{list_dirs()}: A vector of full paths +\item \code{\link[=open_file]{open_file()}}, \code{\link[=shell_exec]{shell_exec()}}: A logical vector where \code{TRUE} +successfully opened, \code{FALSE} did not and \code{NA} did not try to open (file not +found) +\item \code{\link[=list_files]{list_files()}}, \code{\link[=list_dirs]{list_dirs()}}: A vector of full paths } } \description{ Opens the given files(s) } \details{ -\code{open_file} is an alternative to \code{shell.exec()} that can take take -multiple files. \code{list_files} and \code{list_dirs} are mostly wrappers for -\code{\link[fs:dir_ls]{fs::dir_ls()}} with preferred defaults and pattern searching on the full file -path. +\code{\link[=open_file]{open_file()}} is an alternative to \code{base::shell.exec()} that +can take take multiple files. \code{\link[=list_files]{list_files()}} and \code{\link[=list_dirs]{list_dirs()}} +are mostly wrappers for \code{\link[fs:dir_ls]{fs::dir_ls()}} with preferred defaults and pattern +searching on the full file path. -\code{file_open} is simply an alias. +\code{\link[=file_open]{file_open()}} is simply an alias. } diff --git a/man/fizzbuzz.Rd b/man/fizzbuzz.Rd index 3e4fd656..60f9da16 100644 --- a/man/fizzbuzz.Rd +++ b/man/fizzbuzz.Rd @@ -30,10 +30,10 @@ that the quickest way to do it is to just take the work someone else did and utilize that. No reason to reinvent the wheel. } \details{ -Multiples of \code{3} are shown as \code{"Fizz"}; multiples of \code{5} as \code{"Buzz"}; -multiple of both (i.e., \code{15}) are \code{"FizzBuzz"}. -\code{fizzbuzz_lazy()} subsets the \code{.fizzbuzz_vector} object, which is a solution -with default parameters up to \code{1e6} +Multiples of \code{3} are shown as \code{"Fizz"}; multiples of \code{5} as +\code{"Buzz"}; multiple of both (i.e., \code{15}) are \code{"FizzBuzz"}. +\code{\link[=fizzbuzz_lazy]{fizzbuzz_lazy()}} subsets the \code{.fizzbuzz_vector} object, which is a +solution with default parameters up to \code{1e6} } \examples{ fizzbuzz(15) diff --git a/man/get_version.Rd b/man/get_version.Rd index 8c8e7179..06de5122 100644 --- a/man/get_version.Rd +++ b/man/get_version.Rd @@ -23,19 +23,19 @@ automatically update.} } \value{ \itemize{ -\item \code{get_version()}: A package_version -\item \code{bump_version()}: None, called for its side-effects -\item \code{bump_date_version()}: None, called for its side-effects -\item \code{update_version()}: None, called for its side-effects +\item \code{\link[=get_version]{get_version()}}: A package_version +\item \code{\link[=bump_version]{bump_version()}}: None, called for its side-effects +\item \code{\link[=bump_date_version]{bump_date_version()}}: None, called for its side-effects +\item \code{\link[=update_version]{update_version()}}`: None, called for its side-effects } } \description{ Will read the \code{DESCRIPTION} file and to get and adjust the version -\code{bump_date_version()} will not check if the version is actually a date. When -the current version is the same as today's date(equal by character strings) -it will append a \code{.1}. +\code{\link[=bump_date_version]{bump_date_version()}} will not check if the version is actually a +date. When the current version is the same as today's date (equal by +character strings) it will append a \code{.1}. } \details{ Get and bump package version for dates diff --git a/man/glob.Rd b/man/glob.Rd index 565eac8d..8a5c9f61 100644 --- a/man/glob.Rd +++ b/man/glob.Rd @@ -11,8 +11,9 @@ glob(x, pattern = NULL, value = TRUE, ...) \item{pattern}{Wildcard globbing pattern} -\item{value, ...}{Additional parameters passed to \code{grep}. Note: \code{value} is by -default \code{TRUE}; when \code{NA}, \code{...} is passed to \code{grepl}.} +\item{value, ...}{Additional parameters passed to \code{\link[base:grep]{base::grep()}}. Note: +\code{value} is by default \code{TRUE}; when \code{NA}, \code{...} is passed to +\code{\link[base:grep]{base::grep()}}`.} } \description{ Helper function for globbing character vectors diff --git a/man/import.Rd b/man/import.Rd index a0608245..cb07384a 100644 --- a/man/import.Rd +++ b/man/import.Rd @@ -11,7 +11,7 @@ import(pkg, fun, overwrite = FALSE) \item{fun}{String, fun name of the function} -\item{overwrite}{Logical, if TRUE and \code{fun} is also found in the current +\item{overwrite}{Logical, if \code{TRUE} and \code{fun} is also found in the current environment, will overwrite assignment} } \value{ diff --git a/man/labels.Rd b/man/labels.Rd index df4a0e0c..30c3ff7d 100644 --- a/man/labels.Rd +++ b/man/labels.Rd @@ -44,13 +44,13 @@ remove_labels(x, ...) \item{...}{One or more unquoted expressed separated by commas. If assigning to a data.frame, \code{...} can be replaced with a \code{data.frame} where the first -column is the targeted colname and the second is the desired label.} +column is the targeted column name and the second is the desired label.} \item{label}{A single length string of a label to be assigned} -\item{.missing}{A control setting for dealing missing columns in a list; -can be set to \code{error} to \code{stop()} the call, \code{warn} to provide a warning, or -\code{skip} to silently skip those labels.} +\item{.missing}{A control setting for dealing missing columns in a list; can +be set to \code{"error"} to \code{\link[base:stop]{base::stop()}} the call, \code{"warn"} to provide a +warning, or \code{"skip"} to silently skip those labels.} \item{.ls}{A named list of columns and labels to be set if \code{...} is empty} @@ -67,9 +67,9 @@ A labelled vector or \code{data.frame} Assign labels to a vector or data.frame. } \details{ -When labels are assigned to a data.frame they can make viewing the object -(with \code{View()} inside Rstudio). The \code{view_labels()} has a call to \code{View()} -inside and will retrieve the labels and show them in the viewer as a +When labels are assigned to a data.frame they can make viewing the +object (with \code{View()} inside Rstudio). \code{\link[=view_labels]{view_labels()}} has a call to +\code{View()} inside and will retrieve the labels and show them in the viewer as a data.frame. } \examples{ diff --git a/man/lines_of_r_code.Rd b/man/lines_of_r_code.Rd index dfd5576f..9baa5238 100644 --- a/man/lines_of_r_code.Rd +++ b/man/lines_of_r_code.Rd @@ -2,25 +2,25 @@ % Please edit documentation in R/lines-of-code.R \name{lines_of_r_code} \alias{lines_of_r_code} -\title{Lines of R code} +\title{Lines of \strong{R} code} \usage{ lines_of_r_code(x = ".", skip_empty = TRUE) } \arguments{ \item{x}{Directory to search for files} -\item{skip_empty}{Logical, if TRUE will not count lines that are empty or +\item{skip_empty}{Logical, if \code{TRUE} will not count lines that are empty or only contain a bracket or quotation mark.} } \value{ An \code{integer} for the number of lines in all applicable files } \description{ -Find the total number of lines of R code +Find the total number of lines of \strong{R} code } \details{ -Tries to read each file in the directory that ends in .R or .r and sums -together. Files that fail to read are not counted. +Tries to read each file in the directory that ends in \code{.R} or \code{.r} +and sums together. Files that fail to read are not counted. } \examples{ \donttest{ diff --git a/man/list2df.Rd b/man/list2df.Rd index 8bb03f5a..923555bb 100644 --- a/man/list2df.Rd +++ b/man/list2df.Rd @@ -11,19 +11,19 @@ list2df(x, name = "name", value = "value", warn = TRUE) \item{name, value}{Names of the new key and value columns, respectively} -\item{warn}{Logical; if TRUE will show a warning when} +\item{warn}{Logical; if \code{TRUE} will show a warning when} } \value{ a \code{data.frame} object with columns \code{"name"} and \code{"value"} for the names of the \code{list} and the values in each } \description{ -Converts a list object into a data.frame +Converts a list object into a \code{data.frame} } \details{ -Unlike \code{base::list2DF()}, \code{list2df()} tries to format the data.frame by using -the names of the list as values rather than variables. This creates a -longer form list that may be more tidy. +Unlike \code{\link[base:list2DF]{base::list2DF()}}, \code{\link[=list2df]{list2df()}} tries to format the +\code{data.frame} by using the names of the list as values rather than +variables. This creates a longer form list that may be more tidy. } \examples{ x <- list(a = 1, b = 2:4, c = letters[10:20], "unnamed", "unnamed2") diff --git a/man/list_environments.Rd b/man/list_environments.Rd index fe061c91..83eae7b3 100644 --- a/man/list_environments.Rd +++ b/man/list_environments.Rd @@ -20,21 +20,24 @@ objects_all(all.names = FALSE) } \value{ \itemize{ -\item \code{environments()}: Invisibly, a \code{character} vector of environment names +\item \code{\link[=environments]{environments()}}: Invisibly, a \code{character} vector of environment +names } \itemize{ -\item \code{ls_all()}, \code{objects_all()}: A named list for each of the environments -the \code{search()} path with all the objects found in that environment +\item \code{\link[=ls_all]{ls_all()}}, \code{\link[=objects_all]{objects_all()}}: A named list for each of the +environments the \code{\link[base:search]{base::search()}} path with all the objects found in that +environment } } \description{ Functions to list out all environments and objects } \details{ -\code{environments()} is basically a printing wrapper for \code{base::search()} +\code{\link[=environments]{environments()}} is basically a printing wrapper for +\code{\link[base:search]{base::search()}} -\code{ls_all()} and \code{objects_all()} can be used retrieved all objects from all -environments in the \code{search()} path, which may print out a large result -into the console. +\code{\link[=ls_all]{ls_all()}} and \code{\link[=objects_all]{objects_all()}} can be used retrieved all +objects from all environments in the \code{\link[base:search]{base::search()}} path, which may print +out a large result into the console. } diff --git a/man/logic_ext.Rd b/man/logic_ext.Rd index a6c9c0e7..b4a42c2b 100644 --- a/man/logic_ext.Rd +++ b/man/logic_ext.Rd @@ -14,7 +14,7 @@ \alias{either} \alias{is_boolean} \alias{none} -\title{Logic - Extension'} +\title{Logic - Extensions} \usage{ is_true(x) @@ -50,26 +50,27 @@ If not a logical value, will return \code{NA} equal to the vector length} } \value{ \itemize{ -\item \code{is_true()}, \code{is_false()}, \code{either()}, \verb{\%or\%}, \code{AND()}, \code{OR()}: A \code{logical} -vector, equal length of \code{x} (or \code{y} or of all \code{...} lengths) -\item \code{is_boolean()}: \code{TRUE} or \code{FALSE} -\item \code{none()}: \code{TRUE}, \code{FALSE}, or \code{NA} +\item \code{\link[=is_true]{is_true()}}, \code{\link[=is_false]{is_false()}}, \code{\link[=either]{either()}}, \link{\%or\%}, +\code{\link[=AND]{AND()}}, \code{\link[=OR]{OR()}}: A \code{logical} vector, equal length of \code{x} (or \code{y} +or of all \code{...} lengths) +\item \code{\link[=is_boolean]{is_boolean()}}: \code{TRUE} or \code{FALSE} +\item \code{\link[=none]{none()}}: \code{TRUE}, \code{FALSE}, or \code{NA} } } \description{ -All functions take logical or logical-like (i.e., 1, 0, or NA as -integer or doubles) and return logical values. +All functions take logical or logical-like (i.e., \code{1}, \code{0}, or +\code{NA} as integer or doubles) and return logical values. Extensions to the base logical operations to account for \code{NA} values. -\code{\link[base:Logic]{base::isTRUE()}} and \code{\link[base:Logic]{base::isFALSE()}} will only return single length \code{TRUE} -or \code{FALSE} as it checks for valid lengths in the evaluation. When needing to -check over a vector for the presence of \code{TRUE} or \code{FALSE} and not being held -back by \code{NA} values, \code{is_true} and \code{is_false} will always provide a \code{TRUE} -\code{FALSE} when the vector is logical or return \code{NA} is the vector \code{x} is not -logical. +\code{\link[base:Logic]{base::isTRUE()}} and \code{\link[base:Logic]{base::isFALSE()}} will only return single length +\code{TRUE} or \code{FALSE} as it checks for valid lengths in the evaluation. When +needing to check over a vector for the presence of \code{TRUE} or \code{FALSE} and +not being held back by \code{NA} values, \code{\link[=is_true]{is_true()}} and +\code{\link[=is_false]{is_false()}} will always provide a \code{TRUE} \code{FALSE} when the vector is +logical or return \code{NA} is the vector \code{x} is not logical. -\verb{\%or\%} is just a wrapper for \code{\link[base:Logic]{base::xor()}} +\link{\%or\%} is just a wrapper for \code{\link[base:Logic]{base::xor()}} } \details{ Logical operations, extended diff --git a/man/make_sf.Rd b/man/make_sf.Rd index bf2940bc..b5b452e8 100644 --- a/man/make_sf.Rd +++ b/man/make_sf.Rd @@ -10,7 +10,7 @@ make_sf(package) \item{package}{The name of the package} } \value{ -A \code{function} wrapping \code{\link[=system.file]{system.file()}} which will always use the +A \code{function} wrapping \code{system.file()} which will always use the package name provided in \code{package} } \description{ diff --git a/man/match_arg.Rd b/man/match_arg.Rd index 7f9ea93b..07e82600 100644 --- a/man/match_arg.Rd +++ b/man/match_arg.Rd @@ -24,13 +24,13 @@ Match arguments } \examples{ x <- c("apple", "banana", "orange") -match_arg("b", x) +suppressWarnings(match_arg("b", x), "deprecatedWarning") # Produces error -try(match_arg("pear", x)) +suppressWarnings(try(match_arg("pear", x)), "deprecatedWarning") foo <- function(x, op = c(1, 2, 3)) { - op <- match_arg(op) + op <- suppressWarnings(match_arg(op), "deprecatedWarning") x / op } diff --git a/man/match_param.Rd b/man/match_param.Rd index 7d27a355..5a0e6ced 100644 --- a/man/match_param.Rd +++ b/man/match_param.Rd @@ -23,7 +23,7 @@ value when matched to the RHS of the formula.} \item{null}{If \code{TRUE} allows \code{NULL} to be passed a \code{param}} -\item{partial}{If \code{TRUE} allows partial matching via \code{\link[=pmatch]{pmatch()}}} +\item{partial}{If \code{TRUE} allows partial matching via \code{\link[base:pmatch]{base::pmatch()}}} \item{multiple}{If \code{TRUE} allows multiple values to be returned} diff --git a/man/norm_path.Rd b/man/norm_path.Rd index 034c6ce7..ea47ce50 100644 --- a/man/norm_path.Rd +++ b/man/norm_path.Rd @@ -15,10 +15,10 @@ user_file(..., check = FALSE, remove = check) \arguments{ \item{x}{A character vector of paths} -\item{check}{Logical, if TRUE will check if the path exists and output a +\item{check}{Logical, if \code{TRUE} will check if the path exists and output a warning if it does not.} -\item{remove}{Logical, if TRUE will remove paths that are not found} +\item{remove}{Logical, if \code{TRUE} will remove paths that are not found} \item{...}{Character vectors for creating a path} } diff --git a/man/normalize.Rd b/man/normalize.Rd index 06039cbe..dc7c091e 100644 --- a/man/normalize.Rd +++ b/man/normalize.Rd @@ -37,9 +37,9 @@ The largest and smallest values are then used to determine the minimum/maximum values and lower/upper bounds. This allows for a vector of more than two values to be passed. -The current implementation of \code{normalize.data.frame()} allows for \code{list} of -parameters passed for each column. However, it is probably best suited for -default values. +The current implementation of \code{\link[=normalize.data.frame]{normalize.data.frame()}} allows for +\code{list} of parameters passed for each column. However, it is probably best +suited for default values. } \examples{ x <- c(0.23, 0.32, 0.12, 0.61, 0.26, 0.24, 0.23, 0.32, 0.29, 0.27) diff --git a/man/package_available.Rd b/man/package_available.Rd index dda89bb7..08243da1 100644 --- a/man/package_available.Rd +++ b/man/package_available.Rd @@ -11,10 +11,10 @@ package_available(namespace) } \value{ \itemize{ -\item \code{require_namespace()}: None, called for side effects -\item \code{package_available()}: Visibly, \code{TRUE} or \code{FALSE} +\item \code{\link[=require_namespace]{require_namespace()}}: None, called for side effects +\item \code{\link[=package_available]{package_available()}}: Visibly, \code{TRUE} or \code{FALSE} } } \description{ -A wrapped requireNamespace +A wrapped \code{\link[base:ns-load]{base::requireNamespace()}} } diff --git a/man/print.pseudo_id.Rd b/man/print.pseudo_id.Rd index d1ee9912..c88d6df6 100644 --- a/man/print.pseudo_id.Rd +++ b/man/print.pseudo_id.Rd @@ -7,7 +7,7 @@ \method{print}{pseudo_id}(x, ..., all = FALSE) } \arguments{ -\item{x}{An object of class \link{pseudo_id}} +\item{x}{An object of class \code{pseudo_id}} \item{...}{Not implemented} diff --git a/man/quiet_stop.Rd b/man/quiet_stop.Rd index bdfa6d8e..c2dc7ac8 100644 --- a/man/quiet_stop.Rd +++ b/man/quiet_stop.Rd @@ -10,5 +10,5 @@ quiet_stop() None, called for side effects } \description{ -Quietly calls stop +Quietly calls \code{\link[base:stop]{base::stop()}} } diff --git a/man/range2.Rd b/man/range2.Rd index 40f42444..49060112 100644 --- a/man/range2.Rd +++ b/man/range2.Rd @@ -16,8 +16,8 @@ A \code{numeric} vector of length 2 of the minimum and maximum values, respectively } \description{ -Employs \code{min()} and \code{max()}. However, \code{\link[base:range]{base::range()}}, there is no argument -for removing \code{Inf} values. +Employs \code{\link[base:Extremes]{base::min()}} and \code{\link[base:Extremes]{base::max()}}. However, \code{\link[base:range]{base::range()}}, there is +no argument for removing \code{Inf} values. } \examples{ \donttest{ diff --git a/man/read_bib.Rd b/man/read_bib.Rd index c4dca3ab..edb684e1 100644 --- a/man/read_bib.Rd +++ b/man/read_bib.Rd @@ -13,7 +13,7 @@ read_bib(file, skip = 0L, max_lines = NULL, encoding = "UTF-8") \item{max_lines}{The maximum number of lines to read} -\item{encoding}{Assumed encoding of file (passed to \code{\link[=readLines]{readLines()}}} +\item{encoding}{Assumed encoding of file (passed to \code{\link[base:readLines]{base::readLines()}}} } \value{ A \code{data.frame} with each row as a bib entry and each column as a diff --git a/man/rscript.Rd b/man/rscript.Rd index 64a4a9e3..620b1bb0 100644 --- a/man/rscript.Rd +++ b/man/rscript.Rd @@ -13,14 +13,14 @@ rscript(x, ops = NULL, args = NULL, ...) \item{args}{A character vector of other arguments to pass} -\item{...}{Additional arguments passed to \code{system2}} +\item{...}{Additional arguments passed to \code{\link[base:system2]{base::system2()}}} } \value{ A \code{character} vector of the result from calling \code{Rscript} via \code{system2()} } \description{ -Implements \code{Rscript} with \code{system2} +Implements \code{Rscript} with \code{\link[base:system2]{base::system2()}} } \seealso{ \link{source_to_env} diff --git a/man/source_to_env.Rd b/man/source_to_env.Rd index daeb20e4..d8a655dc 100644 --- a/man/source_to_env.Rd +++ b/man/source_to_env.Rd @@ -9,7 +9,7 @@ source_to_env(x, ops = NULL) \arguments{ \item{x}{An R script} -\item{ops}{Options to be passed to \link{rscript}} +\item{ops}{Options to be passed to \code{\link[=rscript]{rscript()}}} } \value{ Invisibly, and environment variable of the objects/results created diff --git a/man/sourcing.Rd b/man/sourcing.Rd index 9d474f78..bce399b6 100644 --- a/man/sourcing.Rd +++ b/man/sourcing.Rd @@ -20,7 +20,7 @@ try_ksource(file, ...) \item{quiet}{Logical; Determines whether to apply silence to \code{\link[knitr:knit]{knitr::purl()}}} -\item{cd}{Logical; if TRUE, the R working directory is temporarily +\item{cd}{Logical; if \code{TRUE}, the \strong{R} working directory is temporarily changed to the directory containing file for evaluating} \item{env}{An environment determining where the parsed expressions are @@ -28,17 +28,18 @@ evaluated} } \value{ \itemize{ -\item \code{ksource()}: Invisibly, the result of calling \code{source()} on the \code{.R} file conversion of \code{file} -\item \code{try_source()}, \code{try_ksource()}: attempts of \code{source()} and \code{ksource()} but converts errors to warnings +\item \code{\link[=ksource]{ksource()}}: Invisibly, the result of calling \code{\link[base:source]{base::source()}} on +the \code{.R} file conversion of \code{file} +\item \code{\link[=try_source]{try_source()}}, \code{\link[=try_ksource]{try_ksource()}}: attempts of \code{\link[base:source]{base::source()}} +and \code{\link[=ksource]{ksource()}} but converts errors to warnings } } \description{ Functions for extending sourcing features } \details{ -\code{try_source()} will output an error message rather than completely preventing -the execution. -This can be useful for when a script calls on multiple, independent files to -be sourced and a single failure shouldn't prevent the entire run to fail as -well. +\code{\link[=try_source]{try_source()}} will output an error message rather than +completely preventing the execution. This can be useful for when a script +calls on multiple, independent files to be sourced and a single failure +shouldn't prevent the entire run to fail as well. } diff --git a/man/switch-ext.Rd b/man/switch-ext.Rd index 52437167..5a9e182a 100644 --- a/man/switch-ext.Rd +++ b/man/switch-ext.Rd @@ -25,8 +25,9 @@ switch_case(..., .default = NULL, .envir = parent.frame()) \code{\link[base:sys.parent]{base::parent.frame()}})} } \value{ -A named vector of values of same length \code{x}; or for \code{\link[=switch_case]{switch_case()}}, an -unnamed vector of values matching the rhs of \code{...} +A named vector of values of same length \code{x}; or for +\code{\link[=switch_case]{switch_case()}}, an unnamed vector of values matching the rhs of +\code{...} Inspired from: \itemize{ @@ -35,13 +36,15 @@ Inspired from: } } \description{ -\code{\link[=switch_params]{switch_params()}} is a vectorized version of \code{\link[base:switch]{base::switch()}} +\code{\link[=switch_params]{switch_params()}} is a vectorized version of +\code{\link[base:switch]{base::switch()}} -\code{\link[=switch_case]{switch_case()}} uses a formula syntax to return the value to the right of the -tilde (\code{~}) when \code{x} is \code{TRUE} +\code{\link[=switch_case]{switch_case()}} uses a formula syntax to return the value to the +right of the tilde (\code{~}) when \code{x} is \code{TRUE} -\code{\link[=switch_in_case]{switch_in_case()}} is a special case of \code{\link[=switch_case]{switch_case()}} for \code{\link[base:match]{base::match()}}-ing \code{x} -in the values on the left to return the value on the right. +\code{\link[=switch_in_case]{switch_in_case()}} is a special case of \code{\link[=switch_case]{switch_case()}} for +\code{\link[base:match]{base::match()}}-ing \code{x} in the values on the left to return the value on +the right. } \details{ Switch with a list of params diff --git a/man/t_df.Rd b/man/t_df.Rd index dfdf05e7..f512acd9 100644 --- a/man/t_df.Rd +++ b/man/t_df.Rd @@ -10,17 +10,17 @@ t_df(x) \item{x}{A data.frame} } \value{ -A transposed \code{data.frame} with columns (\code{"colname"}, \code{"row_1"}, ..., -for each row in \code{x}. +A transposed \code{data.frame} with columns (\code{"colname"}, \code{"row_1"}, +\code{...}, for each row in \code{x}. } \description{ -This transposes a data.frame with \code{t()} but transforms back into a data.frame -with column and row names cleaned up. Because the data types may be mixed -and reduced to characters, this may only be useful for a visual viewing of -the data.frame. +This transposes a data.frame with \code{\link[base:t]{base::t()}} but transforms +back into a data.frame with column and row names cleaned up. Because the +data types may be mixed and reduced to characters, this may only be useful +for a visual viewing of the data.frame. } \details{ -Transposes a data.frame as a data.frame +Transposes a \code{data.frame} as a \code{data.frame} } \examples{ x <- data.frame(col_a = Sys.Date() + 1:5, col_b = letters[1:5], col_c = 1:5) diff --git a/man/unlist0.Rd b/man/unlist0.Rd index 7d3ad22b..6f220d3b 100644 --- a/man/unlist0.Rd +++ b/man/unlist0.Rd @@ -25,8 +25,8 @@ Unlist without unique names; combine names for unique values } \details{ \itemize{ -\item \code{\link[=unlist0]{unlist0()}} is much like \code{\link[=unlist]{unlist()}} expect that name are not made to be -unique. +\item \code{\link[=unlist0]{unlist0()}} is much like \code{\link[base:unlist]{base::unlist()}} expect that name are not +made to be unique. \item \code{\link[=squash_vec]{squash_vec()}} works differently } } diff --git a/man/use_author.Rd b/man/use_author.Rd index 4a03a550..485b5bc9 100644 --- a/man/use_author.Rd +++ b/man/use_author.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/description.R \name{use_author} \alias{use_author} -\title{Add author to DESCRIPTION} +\title{Add author to \code{DESCRIPTION}} \usage{ use_author(author_info = find_author()) } diff --git a/man/vap.Rd b/man/vap.Rd index b03eddc8..362be220 100644 --- a/man/vap.Rd +++ b/man/vap.Rd @@ -44,12 +44,12 @@ These are simply wrappers for \code{\link[base:lapply]{base::vapply()}} to short Each function is designed to use specific vector types: \describe{ -\item{vap_int}{integer} -\item{vap_dbl}{double} -\item{vap_chr}{character} -\item{vap_lgl}{logical} -\item{vap_cplx}{complex} -\item{vap_date}{Date} +\item{\code{\link[=vap_int]{vap_int()}}}{integer} +\item{\code{\link[=vap_dbl]{vap_dbl()}}}{double} +\item{\url{mark::vap_chr}}{character} +\item{\url{mark::vap_lgl}}{logical} +\item{\url{mark::vap_cplx}}{complex} +\item{\url{mark::vap_date}}{Date} } } \seealso{ diff --git a/man/within.Rd b/man/within.Rd index 836784d2..7e59fc5a 100644 --- a/man/within.Rd +++ b/man/within.Rd @@ -29,17 +29,21 @@ A logical vector Compare a vector within (between) other values } \details{ -\verb{type``, }bounds`` can be one of the below: +\code{type}, \code{bounds} can be one of the below: \describe{ -\item{g,(}{is greater than (>)} -\item{ge,[}{greater than or equal to (>=)} -\item{l,))}{less than (<)} -\item{le,[]}{less than or equal to (<=)} +\item{\code{"g"}, \code{(}}{is greater than (\code{>})} +\item{\code{"ge"}, \code{[}}{greater than or equal to (\code{>=})} +\item{\code{"l"}, \verb{)}}{less than (\code{<})} +\item{\code{"le"}, \verb{]}}{less than or equal to (\code{<=})} } -Note: \code{\link[=between_more]{between_more()}} may be deprecated in the future in favor of just -\code{\link[=within]{within()}} +Note: [mark::between_more()] may be deprecated in the future in favor of +just [mark::within()] + +[\verb{\}\{greater than or equal to (}>=\verb{)\} \\item\{}"l"\verb{, })\verb{\}\{less than (}<\verb{)\} \\item\{}"le"\verb{, }]: R:\%60\%7D\%7Bgreater\%20than\%20or\%20equal\%20to\%20(\%60\%3E=\%60)\%7D\%0A\%20\%5C\%5Citem\%7B\%60\%22l\%22\%60,\%20\%60)\%60\%7D\%7Bless\%20than\%20(\%60\%3C\%60)\%7D\%0A\%20\%5C\%5Citem\%7B\%60\%22le\%22\%60,\%20\%60 +[mark::between_more()]: R:mark::between_more() +[mark::within()]: R:mark::within() } \examples{ diff --git a/man/write_file_md5.Rd b/man/write_file_md5.Rd index 66355b9c..cdc7e160 100644 --- a/man/write_file_md5.Rd +++ b/man/write_file_md5.Rd @@ -43,24 +43,25 @@ Otherwise, see \code{\link[fs:copy]{fs::file_copy()}}.} } \value{ \itemize{ -\item \code{\link[=write_file_md5]{write_file_md5()}}: \code{x}, invisibly. When \code{path} is not the \code{stdout()}, \code{x} -is returned with the attribute \code{"path"} set to the result of -\code{\link[=file_copy_md5]{file_copy_md5()}}. -\item \code{\link[=mark_write_methods]{mark_write_methods()}}: A list of applicable methods and their aliases -\item \code{\link[=mark_compress_methods]{mark_compress_methods()}}: A character vector of applicable compression -methods +\item \code{\link[=write_file_md5]{write_file_md5()}}: \code{x}, invisibly. When \code{path} is not the +\code{\link[base:showConnections]{base::stdout()}}, \code{x} is returned with the attribute \code{"path"} set to the +result of \code{\link[=file_copy_md5]{file_copy_md5()}}. +\item \code{\link[=mark_write_methods]{mark_write_methods()}}: A list of applicable methods and their +aliases +\item \code{\link[=mark_compress_methods]{mark_compress_methods()}}: A character vector of applicable +compression methods } } \description{ Write file with md5 hash check } -\section{\code{options()}}{ - +\section{\code{\link[base}{ +options]{base::options()}}: \itemize{ \item \code{mark.compress.method}: compression method to use when writing files \item \code{mark.list.hook}: when a \code{data.frame} contains a \code{list} column, this -function is applied to each element of the list. The default \code{"auto"} -uses \code{toJSON()} if the package \code{jsonlite} is available, otherwise +function is applied to each element of the list. The default \code{"auto"} uses +\code{jsonlite::toJSON()} if the package \code{jsonlite} is available, otherwise } } From 1d3d1e02ff86ddd2d98e22a542c8828e08d99173 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 6 Jan 2026 22:00:26 -0500 Subject: [PATCH 125/169] set parallel ncpus (#259) --- .Renviron | 1 + .Rprofile | 4 ---- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/.Renviron b/.Renviron index dbb75028..3072645d 100644 --- a/.Renviron +++ b/.Renviron @@ -8,3 +8,4 @@ _R_CHECK_RD_EXAMPLES_T_AND_F_=TRUE _R_CHECK_INSTALL_DEPENDS_=TRUE _R_CHECK_DEPRECATED_DEFUNCT_=TRUE _R_CHECK_DONTTEST_EXAMPLES_=TRUE +TESTTHAT_CPUS=4 diff --git a/.Rprofile b/.Rprofile index cb190a25..f461b14d 100644 --- a/.Rprofile +++ b/.Rprofile @@ -2,10 +2,6 @@ if (file.exists(".Renviron")) { readRenviron(".Renviron") } -# Don't need anymore -Sys.setenv(TESTTHAT_CPUS = 4) -options(Ncpus = 4) - # Some issue where this was failing in tests Sys.setenv(TESTTHAT_PARALLEL = if (getRversion() < "4") "FALSE" else "TRUE") From 0873358c8bb0840e2faaa607cf4654798437d55e Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 6 Jan 2026 22:01:06 -0500 Subject: [PATCH 126/169] updates class_error, type_error (#259) --- R/aaa.R | 70 +++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 48 insertions(+), 22 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 16b04a67..92814b96 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -52,16 +52,38 @@ value_warning := condition( ) type_error := condition( - function(expected, actual, object) { - sprintf( - ngettext( - length(actual), - "Expected %stype '%s' but got type '%s'", - "Expected %stype '%s' but got types '%s'" + function(type, x, expected, actual, name) { + if (missing(actual)) { + actual <- typeof(x) + } + + if (missing(name)) { + name <- sprintf( + "`%s`", + deparse( + match.call( + sys.function(sys.parent(1L)), + sys.call(sys.parent(1L)), + envir = parent.frame(3L) + )$x + ) + ) + } + + switch( + type, + not_supported = sprintf( + "Object `%s` cannot be of type: %s", + name, + actual ), - if (missing(object)) "" else sprintf("object '%s' to be ", object), - expected, - collapse(actual, sep = "', '") + must_be = sprintf( + "Object `%s` must be of type '%s', not '%s'", + name, + expected, + actual + ), + stop(internal_error()) ) }, type = "error", @@ -75,7 +97,11 @@ conversion_error := condition( ) class_error := condition( - function(type, x, must, name) { + function(type, x, expected, actual, name) { + if (missing(actual)) { + actual <- class(x) + } + if (missing(name)) { name <- sprintf( "`%s`", @@ -88,27 +114,27 @@ class_error := condition( ) ) } - cls <- class(x) + switch( type, not_supported = sprintf( ngettext( - length(cls), - "%s cannot be of class: %s", - "%s cannot be of classes: %s", + length(actual), + "Object `%s` cannot be of class: %s", + "Object `%s` cannot be of classes: %s" ), - name %||% "Object", - toString(cls) + name, + toString(actual) ), must_be = sprintf( ngettext( - length(cls), - "%s must be of class '%s', not '%s'", - "%s must be of class '%s', not classes '%s'" + length(actual), + "Object `%s` must be of class '%s', not '%s'", + "Object `%s` must be of class '%s', not classes '%s'" ), - name %||% "Object", - toString(must), - toString(cls) + name, + toString(expected), + toString(actual) ), stop(internal_error()) ) From f037ea7ce0a6636d1bba318803e0d7816b3606dd Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 6 Jan 2026 22:02:33 -0500 Subject: [PATCH 127/169] updates bib errors (#259) --- R/bib.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/bib.R b/R/bib.R index fbd02ee2..c7dd160d 100644 --- a/R/bib.R +++ b/R/bib.R @@ -213,7 +213,7 @@ process_bib_list <- function(keys, fields, categories, values) { as_bib_list <- function(x, names = NULL) { if (!is.list(x)) { - stop(type_error("list", class(x), "x")) + stop(type_error("must_be", x, "list")) } class(x) <- c("list", "mark_bib_list") @@ -222,7 +222,7 @@ as_bib_list <- function(x, names = NULL) { as_bib <- function(x, bib_list = NULL) { if (!is.data.frame(x)) { - stop(type_error("data.frame", class(x), "x")) + stop(class_error("must_be", x, "data.frame")) } class(x) <- c("mark_bib_df", "data.frame") From 80714fab227ad9406db06f03f2bc21e9b7f48ccd Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 6 Jan 2026 22:05:54 -0500 Subject: [PATCH 128/169] replaces stopifnot() (#259) --- R/description.R | 10 +++++++--- R/detail.R | 4 +++- R/directory.R | 20 +++++++++++++++----- R/fact.R | 4 +++- R/file.R | 5 ++++- R/nas.R | 11 ++++++++--- R/note.R | 4 +++- R/options.R | 4 +++- R/strings.R | 6 ++++-- R/switch.R | 5 ++++- R/todos.R | 4 +++- 11 files changed, 57 insertions(+), 20 deletions(-) diff --git a/R/description.R b/R/description.R index 6acf779a..0571f020 100644 --- a/R/description.R +++ b/R/description.R @@ -9,10 +9,14 @@ #' @return None, called for side effects #' @export use_author <- function(author_info = find_author()) { - stopifnot( - is.list(author_info), + # TODO allow for `person()` class? + # fmt: skip + if (!( + is.list(author_info) && !inherits(author_info, "person") - ) + )) { + stop(type_error("must_be", author_info, "list")) + } lines <- readLines("DESCRIPTION") start <- grep("^[Aa]uthor", lines) diff --git a/R/detail.R b/R/detail.R index 79a8ad1d..56274572 100644 --- a/R/detail.R +++ b/R/detail.R @@ -27,7 +27,9 @@ detail <- function(x, ...) { #' setting as `NA` will ignore this #' @export detail.default <- function(x, factor_n = 5L, ...) { - stopifnot(!is.list(x)) + if (is.list(x)) { + stop(type_error("not_supported", x)) + } op <- options(stringsAsFactors = FALSE) on.exit(options(op), add = TRUE) diff --git a/R/directory.R b/R/directory.R index e72088b5..177fbef4 100644 --- a/R/directory.R +++ b/R/directory.R @@ -7,7 +7,9 @@ #' @return The full path of the most recent directory #' @export get_recent_dir <- function(x = ".", ...) { - stopifnot(dir.exists(x)) + if (!dir.exists(x)) { + stop(input_error("`x` must be an existing directory")) + } dirs <- list_dirs(x, ...) newest_dir(dirs) } @@ -80,7 +82,9 @@ get_dir_max_number <- function(x) { #' #' @export get_recent_file <- function(x, exclude_temp = TRUE, ...) { - stopifnot(is_dir(x)) + if (!is_dir(x)) { + stop(input_error("`x` must be a directory")) + } files <- list_files(x, ...) @@ -112,7 +116,9 @@ remove_temp_files <- function(x) { #' #' @export norm_path <- function(x = ".", check = FALSE, remove = check) { - stopifnot(is.character(x)) + if (!is.character(x)) { + stop(type_error("must_be", x, "character")) + } x <- fs::path_abs(x) ind <- !fs::file_exists(x) @@ -381,7 +387,9 @@ list_dirs <- function( #' @export is_dir <- function(x) { - stopifnot(!no_length(x), is.character(x)) + if (no_length(x) || !is.character(x)) { + stop(input_error("`x` must be a non-zero length character vector")) + } dir.exists(x) } @@ -389,7 +397,9 @@ is_dir <- function(x) { #' @rdname is_dir #' @export is_file <- function(x) { - stopifnot(!no_length(x), is.character(x)) + if (no_length(x) || !is.character(x)) { + stop(input_error("`x` must be a non-zero length character vector")) + } isdir <- file.info(x, extra_cols = FALSE)[["isdir"]] !is.na(isdir) & !isdir } diff --git a/R/fact.R b/R/fact.R index 7589f68e..d41b622c 100644 --- a/R/fact.R +++ b/R/fact.R @@ -516,7 +516,9 @@ fact_coerce_levels <- function(x) { x[!nas] <- dates } else if (!anyNA(posix)) { x <- rep(NA_real_, n) - stopifnot(all(!nas)) + if (any(nas)) { + stop() + } x[] <- as.double(posix) x <- as.POSIXct( x = x, diff --git a/R/file.R b/R/file.R index 677a47d9..27955b56 100644 --- a/R/file.R +++ b/R/file.R @@ -20,7 +20,10 @@ file_copy_md5 <- function(path, new_path, overwrite = NA, quiet = FALSE) { } # not as pretty, but pretty reasonable - stopifnot(length(path) == length(new_path)) + if (length(path) != length(new_path)) { + stop(input_error("`length(path)` must be equal to `length(new_path)`")) + } + # md5sum(nonexisting_file) produces NA md_old <- unname(tools::md5sum(path)) md_new <- unname(tools::md5sum(new_path)) diff --git a/R/nas.R b/R/nas.R index 2b2223c3..b4562c72 100644 --- a/R/nas.R +++ b/R/nas.R @@ -92,7 +92,9 @@ omit_na <- function(x) { #' remove_null(x) #' @export remove_null <- function(x) { - stopifnot(inherits(x, "list")) + if (!inherits(x, "list")) { + stop(type_error("must_be", x, "list")) + } x[!vap_lgl(x, is.null)] } @@ -127,7 +129,9 @@ remove_na_cols <- function(x) { #' @rdname na_cols #' @export is_na_cols <- function(x, names = TRUE) { - stopifnot(is.data.frame(x)) + if (!is.data.frame(x)) { + stop(class_error("must_be", x, "data.frame")) + } vap_lgl(x, function(xx) all(is.na(xx)), .nm = names) } @@ -153,7 +157,8 @@ is_na_cols <- function(x, names = TRUE) { #' tableNA(x[1], x[2]) #' tableNA(x[1], x[2], x[3]) # equivalent ot tableNA(x, .list = TRUE) -tableNA <- function(..., .list = FALSE) { # nolint: object_name_linter +# nolint next: object_name_linter. +tableNA <- function(..., .list = FALSE) { ls <- if (.list) { as.list(...) } else { diff --git a/R/note.R b/R/note.R index 27829564..5aab0bab 100644 --- a/R/note.R +++ b/R/note.R @@ -82,7 +82,9 @@ print.note <- function(x, ...) { } print_note <- function(x, ...) { - stopifnot(inherits(x, "noted")) + if (!inherits(x, "noted")) { + stop(class_error("must_be", x, "noted")) + } the_note <- note(x) diff --git a/R/options.R b/R/options.R index ece7cdf8..ce6c9517 100644 --- a/R/options.R +++ b/R/options.R @@ -21,7 +21,9 @@ #' @export # nolint next: object_name_linter. checkOptions <- function(x) { - stopifnot(is.list(x)) + if (!is.list(x)) { + stop(type_error("must_be", x, "list")) + } nm <- names(x) if (is.null(nm) || any(nm == "")) { diff --git a/R/strings.R b/R/strings.R index 8f4bb7e1..10c41911 100644 --- a/R/strings.R +++ b/R/strings.R @@ -156,8 +156,10 @@ month_name_regex <- sprintf("(%s)", paste(month.name, collapse = "|")) #' chr_split("split this") #' @export chr_split <- function(x) { - stopifnot(length(x) == 1L) - strsplit(as.character(x), "")[[1]] + if (length(x) != 1L) { + stop(input_error("`x` must be a single length character")) + } + strsplit(as.character(x), "")[[1L]] } #' Print as c diff --git a/R/switch.R b/R/switch.R index acb986b8..6ffd90c0 100644 --- a/R/switch.R +++ b/R/switch.R @@ -174,7 +174,9 @@ switch_in_case <- function(x, ..., .default = NULL, .envir = parent.frame()) { } res <- lapply(x, do_switches) - stopifnot(lengths(res) == 1L) + if (all(lengths(res) != 1L)) { + stop(switch_error("result")) + } res <- unlist(res) mode(res) <- mode(res[[1]]) class(res) <- class(res[[1]]) @@ -284,6 +286,7 @@ switch_error := condition( lengths_check_0 = "Cannot have 0 length rhs", lengths_check_2 = "2 lengths found, one of which was not 1", lengths_check_3 = "3 or more lengths found, stopping", + result = "results must be of length 1L", stop(internal_error()), ) } diff --git a/R/todos.R b/R/todos.R index efbb1d9c..29e832df 100644 --- a/R/todos.R +++ b/R/todos.R @@ -102,7 +102,9 @@ do_todo <- function( stop(input_error("`path` must be a character vector of length 1L")) } - stopifnot(fs::file_exists(path)) + if (!fs::file_exists(path)) { + stop(input_error("`path` does not exist: ", path)) + } ls <- rlang::list2(...) From b4c948d2bbb6b00ce1ac5ca03c975e8860a7c348 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 6 Jan 2026 22:06:00 -0500 Subject: [PATCH 129/169] formatting (#259) --- R/apply.R | 8 ++++---- R/dataframes.R | 10 ++++------ R/logic.R | 4 ++-- R/write.R | 2 +- 4 files changed, 11 insertions(+), 13 deletions(-) diff --git a/R/apply.R b/R/apply.R index 4f9ee616..bad6ea4b 100644 --- a/R/apply.R +++ b/R/apply.R @@ -14,10 +14,10 @@ #' \describe{ #' \item{[mark::vap_int()]}{integer} #' \item{[mark::vap_dbl()]}{double} -#' \item{[mark::vap_chr]()}{character} -#' \item{[mark::vap_lgl]()}{logical} -#' \item{[mark::vap_cplx]()}{complex} -#' \item{[mark::vap_date]()}{Date} +#' \item{[mark::vap_chr()]}{character} +#' \item{[mark::vap_lgl()]}{logical} +#' \item{[mark::vap_cplx()]}{complex} +#' \item{[mark::vap_date()]}{Date} #' } #' #' @param .x A vector of values diff --git a/R/dataframes.R b/R/dataframes.R index 4a896107..2587e0b3 100644 --- a/R/dataframes.R +++ b/R/dataframes.R @@ -80,13 +80,11 @@ vector2df <- function(x, name = "name", value = "value") { #' x <- list(a = 1, b = 2:4, c = letters[10:20], "unnamed", "unnamed2") #' list2df(x, "col1", "col2", warn = FALSE) #' -#' if (getRversion() >= as.package_version('4.0')) { #' # contrast with `base::list2DF()` and `base::as.data.frame()` -#' x <- list(a = 1:3, b = 2:4, c = letters[10:12]) -#' list2df(x, warn = FALSE) -#' list2DF(x) -#' as.data.frame(x) -#' } +#' x <- list(a = 1:3, b = 2:4, c = letters[10:12]) +#' list2df(x, warn = FALSE) +#' list2DF(x) +#' as.data.frame(x) # nolint next: object_name_linter. list2df <- function(x, name = "name", value = "value", warn = TRUE) { diff --git a/R/logic.R b/R/logic.R index 201acde9..5a03c570 100644 --- a/R/logic.R +++ b/R/logic.R @@ -14,7 +14,7 @@ #' [mark::is_false()] will always provide a `TRUE` `FALSE` when the vector is #' logical or return `NA` is the vector `x` is not logical. #' -#' [mark::%or%] is just a wrapper for [base::xor()] +#' [mark::%xor%] is just a wrapper for [base::xor()] #' #' @param x,y A vector of logical values. If `NULL` will generate a warning. #' If not a logical value, will return `NA` equal to the vector length @@ -47,7 +47,7 @@ #' is_boolean(c(1L, NA_integer_, 0L)) #' is_boolean(c(1.01, 0, -1)) #' @return -#' - [mark::is_true()], [mark::is_false()], [mark::either()], [mark::%or%], +#' - [mark::is_true()], [mark::is_false()], [mark::either()], [mark::%xor%], #' [mark::AND()], [mark::OR()]: A `logical` vector, equal length of `x` (or `y` #' or of all `...` lengths) #' - [mark::is_boolean()]: `TRUE` or `FALSE` diff --git a/R/write.R b/R/write.R index 346bbebe..46b62ae4 100644 --- a/R/write.R +++ b/R/write.R @@ -1,6 +1,6 @@ #' Write file with md5 hash check #' -#' @section [base::options()]: +#' @section Options: #' #' - `mark.compress.method`: compression method to use when writing files #' - `mark.list.hook`: when a `data.frame` contains a `list` column, this From 718a8a149d5e15ca93a506213edbf2f5436bd742 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 7 Jan 2026 22:24:32 -0500 Subject: [PATCH 130/169] corrects for current name conflicts (#259) --- R/aaa.R | 29 +++++++++++++++++------------ R/base-conversion.R | 6 +++--- R/bib.R | 9 +++------ R/diff-time.R | 8 ++++---- R/directory.R | 4 ++-- R/labels.R | 4 ++-- R/not-available.R | 4 ++-- 7 files changed, 33 insertions(+), 31 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 92814b96..5a68510c 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -27,32 +27,37 @@ walrus <- function(sym, val) { # caused by user inputs input_error := condition( - function(x) collapse(x), + function(x) x, type = "error", help = "Generic error to indicate a bad input value." ) input_warning := condition( - function(x) collapse(x), + function(x) x, type = "warning", help = "Generic warning to indicate a bad input value." ) # caused by processing value_error := condition( - function(x) collapse(x), + function(x) x, type = "error", help = "Generic error to indicate a value mismatch." ) value_warning := condition( - function(x) collapse(x), + function(x) x, type = "warning", help = "Generic warning to indicate a value mismatch." ) +# FIXME for now, we can't use colliding variable names in condition(message), +# but I'd rather use `type` instead of `s` +# +# https://github.com/jmbarbone/cnd/issues/23 + type_error := condition( - function(type, x, expected, actual, name) { + function(s, x, expected, actual, name) { if (missing(actual)) { actual <- typeof(x) } @@ -71,7 +76,7 @@ type_error := condition( } switch( - type, + s, not_supported = sprintf( "Object `%s` cannot be of type: %s", name, @@ -91,20 +96,20 @@ type_error := condition( ) conversion_error := condition( - function(x) collapse(x), + function(x) x, type = "error", help = "Generic error to indicate a conversion failure." ) class_error := condition( - function(type, x, expected, actual, name) { + function(s, x, expected, actual, name) { if (missing(actual)) { actual <- class(x) } if (missing(name)) { name <- sprintf( - "`%s`", + "%s", deparse( match.call( sys.function(sys.parent(1L)), @@ -116,7 +121,7 @@ class_error := condition( } switch( - type, + s, not_supported = sprintf( ngettext( length(actual), @@ -144,9 +149,9 @@ class_error := condition( ) internal_error := condition( - function(x = character()) { + function(x) { c( - collapse(x), + x, "\nThis is an internal `{mark}` error. If you encounter this, please", " report an issue at " ) diff --git a/R/base-conversion.R b/R/base-conversion.R index c82d392d..1934c12f 100644 --- a/R/base-conversion.R +++ b/R/base-conversion.R @@ -109,9 +109,9 @@ check_base <- function(b, high = 9L) { # conditions -------------------------------------------------------------- base_conversion_error := condition( - function(type, base, x, high) { + function(s, base, x, high) { switch( - type, + s, alpha_limit = sprintf( 'Cannot calculate alpha base "%s" for "%s" which has letters beyond "%s"', # nolint: line_length_linter. base, @@ -130,7 +130,7 @@ base_conversion_error := condition( alpha_length = "base must be of length 1", integer = "base must be an integer", limit = sprintf("base must be between 1 and %s", high), - stop(internal_error(c("Unknown base conversion error type: ", type))) + stop(internal_error("Unknown base conversion error type: ", type)) ) }, type = "error", diff --git a/R/bib.R b/R/bib.R index c7dd160d..23025419 100644 --- a/R/bib.R +++ b/R/bib.R @@ -304,19 +304,16 @@ print.mark_bib_df <- function(x, list = FALSE, ...) { # conditions -------------------------------------------------------------- bib_error := condition( - function(type, key, categories) { + function(s, key, categories) { switch( - type, + s, no_entries = "No entries detected in bib file", duplicate_categories = sprintf( "The key `%s` has duplicate categories of `%s`", key, categories ), - stop(internal_error(c( - "Unknown error error type: ", - type - ))) + stop(internal_error()) ) }, type = "error", diff --git a/R/diff-time.R b/R/diff-time.R index a5ed20b6..d78630fc 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -349,18 +349,18 @@ sys_tz <- function(method = 1) { # conditions -------------------------------------------------------------- diff_time_error := condition( - function(type) { + function(s) { switch( - type, + s, tz_null = "Date times cannot be numeric when tz is NULL", ) } ) diff_time_warning := condition( - function(type) { + function(s) { switch( - type, + s, na_tz = paste( "NA found in timezones; setting to default timezone:", default_tz() diff --git a/R/directory.R b/R/directory.R index 177fbef4..b2a3b30a 100644 --- a/R/directory.R +++ b/R/directory.R @@ -493,9 +493,9 @@ path_error := condition( ) path_warning := condition( - function(type, x) { + function(s, x) { switch( - type, + s, not_found = function(x) { ngettext( length(x), diff --git a/R/labels.R b/R/labels.R index c5a40718..f631ba81 100644 --- a/R/labels.R +++ b/R/labels.R @@ -190,9 +190,9 @@ remove_labels.data.frame <- function(x, cols, ...) { # conditions -------------------------------------------------------------- assign_labels_error := condition( - function(type, ..., cols, dots, ls) { + function(s, ..., cols, dots, ls) { switch( - type, + s, columns = sprintf( ngettext( length(cols), diff --git a/R/not-available.R b/R/not-available.R index ce6bfe8f..c86aabfd 100644 --- a/R/not-available.R +++ b/R/not-available.R @@ -76,9 +76,9 @@ delayedAssign("NA_POSIXlt_", not_available("POSIXlt", 1L)) # conditions -------------------------------------------------------------- not_available_error := condition( - function(type, x) { + function(s, x) { switch( - type, + s, not_found = sprintf( paste0( "\"%s\" not found\n", From 736d284cbe15c392105f7a651ade3e8cf5618583 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 7 Jan 2026 22:24:44 -0500 Subject: [PATCH 131/169] updates tests (#259) --- tests/testthat/test-bib.R | 12 +++++++----- tests/testthat/test-description.R | 4 ++-- tests/testthat/test-directory.R | 14 +++++++------- tests/testthat/test-nas.R | 10 +++++----- tests/testthat/test-note.R | 2 +- tests/testthat/test-strings.R | 11 +++++++---- tests/testthat/test-write.R | 2 +- 7 files changed, 30 insertions(+), 25 deletions(-) diff --git a/tests/testthat/test-bib.R b/tests/testthat/test-bib.R index d1903179..25e64151 100644 --- a/tests/testthat/test-bib.R +++ b/tests/testthat/test-bib.R @@ -12,12 +12,12 @@ test_that("read_bib()", { exp <- utils::head(exp, -1L) expect_identical(res, exp, ignore_attr = TRUE) - temp <- tempfile() + temp <- withr::local_tempfile() writeLines("bad", temp) expect_error(read_bib(temp), class = "mark:bib_error") - expect_error(as_bib(1:3), "data.frame", class = "mark:type_error") - expect_error(as_bib_list(1:3), "list", class = "mark:type_error") + expect_error(as_bib(1:3), class = "mark:class_error") + expect_error(as_bib_list(1:3), class = "mark:type_error") expect_error( process_bib_dataframe( @@ -41,14 +41,16 @@ test_that("snapshots()", { }) test_that("= inside text [#117]", { - res <- read_bib(textConnection(" + res <- read_bib(textConnection( + " @article{key, author = {Barbone, Jordan Mark}, title = {I wrote a cool article}, year = {2020}, month = {Mar}, note = {This has an = and it's bad}, - }")) + }" + )) exp <- structure( list( diff --git a/tests/testthat/test-description.R b/tests/testthat/test-description.R index 8287a5ad..c2d5ed5b 100644 --- a/tests/testthat/test-description.R +++ b/tests/testthat/test-description.R @@ -46,6 +46,6 @@ test_that("use_author() works", { writeLines(original, "DESCRIPTION") - expect_error(use_author(NULL), "list", class = "simpleError") - expect_error(use_author(person()), "person", class = "simpleError") + expect_error(use_author(NULL), class = "mark:type_error") + expect_error(use_author(person()), class = "mark:type_error") }) diff --git a/tests/testthat/test-directory.R b/tests/testthat/test-directory.R index 2af09dad..94865f95 100644 --- a/tests/testthat/test-directory.R +++ b/tests/testthat/test-directory.R @@ -1,4 +1,3 @@ - test_that("tests with temp dir", { expect_equal_path <- function(x, y) { x_short <- fs::path(basename(dirname(x)), basename(x)) @@ -45,11 +44,12 @@ test_that("tests with temp dir", { expect_equal_path(get_recent_file(td), most_recent_file) }) +# fmt: skip test_that("errors", { - expect_error(is_file(NULL), class = "simpleError") - expect_error(is_file(character()), class = "simpleError") - expect_error(is_file(TRUE), class = "simpleError") - expect_error(is_dir(NULL), class = "simpleError") - expect_error(is_dir(character()), class = "simpleError") - expect_error(is_dir(TRUE), class = "simpleError") + expect_error(is_file(NULL), class = "mark:input_error") + expect_error(is_file(character()), class = "mark:input_error") + expect_error(is_file(TRUE), class = "mark:input_error") + expect_error(is_dir(NULL), class = "mark:input_error") + expect_error(is_dir(character()), class = "mark:input_error") + expect_error(is_dir(TRUE), class = "mark:input_error") }) diff --git a/tests/testthat/test-nas.R b/tests/testthat/test-nas.R index 9e50c900..e4eae37b 100644 --- a/tests/testthat/test-nas.R +++ b/tests/testthat/test-nas.R @@ -24,8 +24,8 @@ test_that("remove_null()", { x <- list(a = 1, b = NULL, c = 1) expect_equal(remove_null(x), list(a = 1, c = 1)) - expect_error(remove_null(c(1, 2)), class = "simpleError") - expect_error(remove_null(quick_dfl(x = NULL)), class = "simpleError") + expect_error(remove_null(c(1, 2)), class = "mark:type_error") + expect_error(remove_null(quick_dfl(x = NULL)), class = "mark:type_error") }) test_that("*_na_cols() works", { @@ -52,9 +52,9 @@ test_that("*_na_cols() works", { c(first = FALSE, second = FALSE, all = TRUE, last = FALSE, all2 = TRUE) ) - expect_error(select_na_cols(1), class = "simpleError") - expect_error(remove_na_cols(1), class = "simpleError") - expect_error(is_na_cols(1), class = "simpleError") + expect_error(select_na_cols(1), class = "mark:class_error") + expect_error(remove_na_cols(1), class = "mark:class_error") + expect_error(is_na_cols(1), class = "mark:class_error") }) test_that("tableNA() works", { diff --git a/tests/testthat/test-note.R b/tests/testthat/test-note.R index 91a8e484..30f5d095 100644 --- a/tests/testthat/test-note.R +++ b/tests/testthat/test-note.R @@ -79,7 +79,7 @@ test_that("print_note() works with data.frame", { test_that("note() errors", { withr::local_options(list(mark.check_interactive = NA)) - expect_error(print_note(1L), class = "simpleError") + expect_error(print_note(1L), class = "mark:class_error") x <- struct(1L, "noted", note = struct("hi", "note_a_note")) expect_error(print_note(x), class = "mark:class_error") }) diff --git a/tests/testthat/test-strings.R b/tests/testthat/test-strings.R index 4fd2c3a1..4a5d11e4 100644 --- a/tests/testthat/test-strings.R +++ b/tests/testthat/test-strings.R @@ -24,7 +24,7 @@ test_that("string slices", { ) xx <- c(x, x) - expect_error(str_slice_by_word(xx, 80), class = "simpleError") + expect_error(str_slice_by_word(xx, 80), class = "mark:input_error") }) # Better outputs @@ -57,14 +57,17 @@ test_that("Extract dates", { c("2020-02-21", NA, "2014-09-15") ) expect_my_date( - "Last saved 17 December 2019", "2019-12-17", + "Last saved 17 December 2019", + "2019-12-17", format = "%d %B %Y" ) expect_my_datetime( - c("file date ending 2020-05-09 121212.xlsasdf", + c( + "file date ending 2020-05-09 121212.xlsasdf", "1960-04-07 233044 is the time", - "aaa 1984-12-14 001000"), + "aaa 1984-12-14 001000" + ), c("2020-05-09 121212", "1960-04-07 233044", "1984-12-14 001000") ) }) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index eb726f80..45cbb514 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -111,7 +111,7 @@ test_that("list columns", { "unimplemented type 'list' in 'EncodeElement'", fixed = TRUE ) - expect_error(foo(NA), class = "mark:write_na_hook") + expect_error(foo(NA), class = "mark:value_error") }) test_that("arrow prints something to stdout()", { From 3c2987fe86645fb2be5d47acad88121b1290ad83 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 7 Jan 2026 22:24:56 -0500 Subject: [PATCH 132/169] redocs (#259) --- man/list2df.Rd | 10 ++++------ man/logic_ext.Rd | 4 ++-- man/reexports.Rd | 2 +- man/vap.Rd | 8 ++++---- man/write_file_md5.Rd | 4 ++-- 5 files changed, 13 insertions(+), 15 deletions(-) diff --git a/man/list2df.Rd b/man/list2df.Rd index 923555bb..b83251d1 100644 --- a/man/list2df.Rd +++ b/man/list2df.Rd @@ -29,11 +29,9 @@ variables. This creates a longer form list that may be more tidy. x <- list(a = 1, b = 2:4, c = letters[10:20], "unnamed", "unnamed2") list2df(x, "col1", "col2", warn = FALSE) -if (getRversion() >= as.package_version('4.0')) { # contrast with `base::list2DF()` and `base::as.data.frame()` - x <- list(a = 1:3, b = 2:4, c = letters[10:12]) - list2df(x, warn = FALSE) - list2DF(x) - as.data.frame(x) -} +x <- list(a = 1:3, b = 2:4, c = letters[10:12]) +list2df(x, warn = FALSE) +list2DF(x) +as.data.frame(x) } diff --git a/man/logic_ext.Rd b/man/logic_ext.Rd index b4a42c2b..669cd319 100644 --- a/man/logic_ext.Rd +++ b/man/logic_ext.Rd @@ -50,7 +50,7 @@ If not a logical value, will return \code{NA} equal to the vector length} } \value{ \itemize{ -\item \code{\link[=is_true]{is_true()}}, \code{\link[=is_false]{is_false()}}, \code{\link[=either]{either()}}, \link{\%or\%}, +\item \code{\link[=is_true]{is_true()}}, \code{\link[=is_false]{is_false()}}, \code{\link[=either]{either()}}, \link{\%xor\%}, \code{\link[=AND]{AND()}}, \code{\link[=OR]{OR()}}: A \code{logical} vector, equal length of \code{x} (or \code{y} or of all \code{...} lengths) \item \code{\link[=is_boolean]{is_boolean()}}: \code{TRUE} or \code{FALSE} @@ -70,7 +70,7 @@ not being held back by \code{NA} values, \code{\link[=is_true]{is_true()}} and \code{\link[=is_false]{is_false()}} will always provide a \code{TRUE} \code{FALSE} when the vector is logical or return \code{NA} is the vector \code{x} is not logical. -\link{\%or\%} is just a wrapper for \code{\link[base:Logic]{base::xor()}} +\link{\%xor\%} is just a wrapper for \code{\link[base:Logic]{base::xor()}} } \details{ Logical operations, extended diff --git a/man/reexports.Rd b/man/reexports.Rd index e31cd8b3..eb1029f6 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} diff --git a/man/vap.Rd b/man/vap.Rd index 362be220..3b6ffaad 100644 --- a/man/vap.Rd +++ b/man/vap.Rd @@ -46,10 +46,10 @@ Each function is designed to use specific vector types: \describe{ \item{\code{\link[=vap_int]{vap_int()}}}{integer} \item{\code{\link[=vap_dbl]{vap_dbl()}}}{double} -\item{\url{mark::vap_chr}}{character} -\item{\url{mark::vap_lgl}}{logical} -\item{\url{mark::vap_cplx}}{complex} -\item{\url{mark::vap_date}}{Date} +\item{\code{\link[=vap_chr]{vap_chr()}}}{character} +\item{\code{\link[=vap_lgl]{vap_lgl()}}}{logical} +\item{\code{\link[=vap_cplx]{vap_cplx()}}}{complex} +\item{\code{\link[=vap_date]{vap_date()}}}{Date} } } \seealso{ diff --git a/man/write_file_md5.Rd b/man/write_file_md5.Rd index cdc7e160..c4230055 100644 --- a/man/write_file_md5.Rd +++ b/man/write_file_md5.Rd @@ -55,8 +55,8 @@ compression methods \description{ Write file with md5 hash check } -\section{\code{\link[base}{ -options]{base::options()}}: +\section{Options}{ + \itemize{ \item \code{mark.compress.method}: compression method to use when writing files \item \code{mark.list.hook}: when a \code{data.frame} contains a \code{list} column, this From 7b31ee349cd9306739c1fc45564c04ead1573292 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 7 Jan 2026 22:25:01 -0500 Subject: [PATCH 133/169] updates R version (#259) --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5eadbc8b..4a01ba08 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ BugReports: https://github.com/jmbarbone/mark/issues Encoding: UTF-8 LazyData: true Depends: - R (>= 3.6) + R (>= 4.1.0) Imports: cli, cnd (>= 0.1.0.9001), From 6a662487c3bf2033fa0ac71d6277fd37adbae3ad Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 10 Feb 2026 23:56:47 -0500 Subject: [PATCH 134/169] adds todo notes (#259) --- R/bib.R | 1 - R/diff-time.R | 2 ++ R/directory.R | 2 ++ R/expand.R | 2 +- 4 files changed, 5 insertions(+), 2 deletions(-) diff --git a/R/bib.R b/R/bib.R index 23025419..6b162fcf 100644 --- a/R/bib.R +++ b/R/bib.R @@ -318,5 +318,4 @@ bib_error := condition( }, type = "error", exports = "read_bib" - # TODO include help ) diff --git a/R/diff-time.R b/R/diff-time.R index d78630fc..3d7bde8a 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -348,6 +348,8 @@ sys_tz <- function(method = 1) { # conditions -------------------------------------------------------------- +# TODO too many different condititons -- simplify + diff_time_error := condition( function(s) { switch( diff --git a/R/directory.R b/R/directory.R index b2a3b30a..45b8d942 100644 --- a/R/directory.R +++ b/R/directory.R @@ -486,6 +486,8 @@ add_file_timestamp <- function( # conditions -------------------------------------------------------------- +# TODO use value_error() + path_error := condition( "No recent file found", type = "error", diff --git a/R/expand.R b/R/expand.R index e774c7e3..82e35492 100644 --- a/R/expand.R +++ b/R/expand.R @@ -199,7 +199,7 @@ reindex(x, 'index', c(1, 2, 5, NA)) #> 2 2 b #> 5 5 e #> NA -```` +``` " ) From 3786659f1755d4ead5c310a4d5eb5ed87286cc07 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 10 Feb 2026 23:57:45 -0500 Subject: [PATCH 135/169] adds exports and type (#259) --- R/diff-time.R | 8 ++++++-- R/file.R | 5 ++++- R/labels.R | 2 ++ R/match-arg.R | 6 +++++- 4 files changed, 17 insertions(+), 4 deletions(-) diff --git a/R/diff-time.R b/R/diff-time.R index 3d7bde8a..ad81f446 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -356,7 +356,9 @@ diff_time_error := condition( s, tz_null = "Date times cannot be numeric when tz is NULL", ) - } + }, + type = "error", + exports = "diff_time" ) diff_time_warning := condition( @@ -369,7 +371,9 @@ diff_time_warning := condition( ), stop(internal_error()) ) - } + }, + type = "warning", + exports = "diff_time" ) numeric_datetime_tz := condition( diff --git a/R/file.R b/R/file.R index 27955b56..a6e04170 100644 --- a/R/file.R +++ b/R/file.R @@ -50,4 +50,7 @@ file_copy_md5 <- function(path, new_path, overwrite = NA, quiet = FALSE) { invisible(new_path) } -md5_status := condition(function(x) x) +md5_status := condition( + function(x) x, + exports = "file_copy_md5" +) diff --git a/R/labels.R b/R/labels.R index f631ba81..7a5dcb04 100644 --- a/R/labels.R +++ b/R/labels.R @@ -217,6 +217,8 @@ assign_labels_error := condition( exports = c("assign_labels", "remove_labels"), # nolint start: line_length_linter. help = r"( +`assign_labels_error` + **Columns not found** You can set `.missing` to `warn` to get a warning instead of an error, or `skip` to silently skip those labels. diff --git a/R/match-arg.R b/R/match-arg.R index 93941e5c..46200984 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -70,6 +70,9 @@ match_arg <- function(x, table) { #' @param simplify If `TRUE` will simplify the output to a single value #' @return A single value from `param` matched on `choices` #' +#' @section Conditions: +#' `r cnd::cnd_section("match_param")` +#' #' @seealso [mark::match_arg()] #' @examples #' fruits <- function(x = c("apple", "banana", "orange")) { @@ -292,5 +295,6 @@ match_param_error := condition( to_options(choices) ) }, - type = "error" + type = "error", + exports = "match_param" ) From 8de5dc83fa38100ea3ab630b97cd095e3df6d4b6 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 10 Feb 2026 23:57:50 -0500 Subject: [PATCH 136/169] removes unused condition (#259) --- R/aaa.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 5a68510c..61994037 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -95,12 +95,6 @@ type_error := condition( help = "Generic error to indicate a type mismatch." ) -conversion_error := condition( - function(x) x, - type = "error", - help = "Generic error to indicate a conversion failure." -) - class_error := condition( function(s, x, expected, actual, name) { if (missing(actual)) { From 9593878b05cf9392e312445e2ea713dedf4a80d0 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 10 Feb 2026 23:58:49 -0500 Subject: [PATCH 137/169] documents tests (#259) --- R/mark-cnd-conditions.R | 381 ++++++++++++++++++++++++++++ R/zzz.R | 2 +- man/mark-cnd-conditions.Rd | 499 +++++++++++++++++++++++++++++++++++++ man/match_param.Rd | 17 ++ man/reexports.Rd | 2 +- 5 files changed, 899 insertions(+), 2 deletions(-) create mode 100644 R/mark-cnd-conditions.R create mode 100644 man/mark-cnd-conditions.Rd diff --git a/R/mark-cnd-conditions.R b/R/mark-cnd-conditions.R new file mode 100644 index 00000000..20942cb2 --- /dev/null +++ b/R/mark-cnd-conditions.R @@ -0,0 +1,381 @@ +# % Generated by cnd: do not edit by hand + +#' @name mark-cnd-conditions +#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:bib_error mark:class_error mark:default_tz_value mark:description_version_error mark:diff_time_error mark:diff_time_warning mark:duplicate_error mark:expand_by_warning mark:fct_expand_seq_error mark:import_error mark:input_error mark:input_warning mark:internal_error mark:list2df_warning mark:match_arg_no_match mark:match_param_error mark:md5_status mark:na_timezone_found mark:not_available_error mark:numeric_datetime_tz mark:options_error mark:path_error mark:path_warning mark:percentile_rank_weights_length mark:reindex_error mark:reindex_warning mark:remove_labels_error mark:source_error mark:switch_error mark:timezone_not_found mark:type_error mark:value_error mark:value_warning mark:view_labels_error append_warning assign_labels_error base_conversion_error bib_error class_error default_tz_value description_version_error diff_time_error diff_time_warning duplicate_error expand_by_warning fct_expand_seq_error import_error input_error input_warning internal_error list2df_warning match_arg_no_match match_param_error md5_status na_timezone_found not_available_error numeric_datetime_tz options_error path_error path_warning percentile_rank_weights_length reindex_error reindex_warning remove_labels_error source_error switch_error timezone_not_found type_error value_error value_warning view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:bib_error/error mark:class_error/error mark:default_tz_value/error mark:description_version_error/error mark:diff_time_error/error mark:diff_time_warning/warning mark:duplicate_error/error mark:expand_by_warning/warning mark:fct_expand_seq_error/error mark:import_error/error mark:input_error/error mark:input_warning/warning mark:internal_error/error mark:list2df_warning/warning mark:match_arg_no_match/error mark:match_param_error/error mark:md5_status/condition mark:na_timezone_found/warning mark:not_available_error/error mark:numeric_datetime_tz/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:percentile_rank_weights_length/error mark:reindex_error/error mark:reindex_warning/warning mark:remove_labels_error/error mark:source_error/error mark:switch_error/condition mark:timezone_not_found/error mark:type_error/error mark:value_error/error mark:value_warning/warning mark:view_labels_error/error +#' @title Conditions for `mark` +#' +#' @details +#' The following conditions are defined in the `{mark}` package. +#' +#' @section `{cnd}`: +#' These conditions are made with the [`{cnd}`][cnd-package] package though the +#' use of [cnd::condition()]. +#' +#' @section `{mark}` conditions: +#' +#' \subsection{`mark:append_warning/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:append_warning`} +#' \item{type}{**warning**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:assign_labels_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:assign_labels_error`} +#' \item{type}{**error**} +#' } +#' `assign_labels_error` +#' +#' **Columns not found** +#' You can set `.missing` to `warn` to get a warning instead of an error, or `skip` to silently skip those labels. +#' +#' **Malformed labels** +#' If passing labels as `.ls`, `...` must be empty. Columns in `...` must be entered as `name = value`; `column = label`. +#' +#' ```r +#' # instead of this: +#' assign_labels(df, a = 'AAA', .ls = list(b = 'BBB')) +#' +#' # do this: +#' assign_labels(df, a = 'AAA', b = 'BBB') +#' # or this: +#' assign_labels(df, .ls = list(a = 'AAA', b = 'BBB')) +#' ``` +#' Labels must not be null; to remove lavels, use `remove_labels()`. +#' +#' ```r +#' # instead of this +#' assign_labels(df, a = 'AAA', b = NULL) +#' +#' # do this +#' df <- assign_labels(df, a = 'AAA') +#' df <- remove_labels(df, 'b') +#' ``` +#' } +#' \subsection{`mark:base_conversion_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:base_conversion_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:bib_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:bib_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:class_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:class_error`} +#' \item{type}{**error**} +#' } +#' Generic error to indicate a class mismatch. +#' } +#' \subsection{`mark:default_tz_value/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:default_tz_value`} +#' \item{type}{**error**} +#' } +#' option(mark.default_tz) must be a character vector of length 1L, a function that returns a character vector of length 1L, NULL (defaults to UTC), or "system" to set to system timezone +#' } +#' \subsection{`mark:description_version_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:description_version_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:diff_time_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:diff_time_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:diff_time_warning/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:diff_time_warning`} +#' \item{type}{**warning**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:duplicate_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:duplicate_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:expand_by_warning/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:expand_by_warning`} +#' \item{type}{**warning**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:fct_expand_seq_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:fct_expand_seq_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:import_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:import_error`} +#' \item{type}{**error**} +#' } +#' The object you are trying to import has already been assigned in the environment you are importing to. Use the `overwrite` option to replace the object. +#' +#' For example: +#' +#' ```r +#' # instead of +#' foo <- NULL +#' import('package', 'foo') +#' +#' # do this +#' foo <- NULL +#' import('package', 'foo', overwrite = TRUE) +#' ``` +#' } +#' \subsection{`mark:input_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:input_error`} +#' \item{type}{**error**} +#' } +#' Generic error to indicate a bad input value. +#' } +#' \subsection{`mark:input_warning/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:input_warning`} +#' \item{type}{**warning**} +#' } +#' Generic warning to indicate a bad input value. +#' } +#' \subsection{`mark:internal_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:internal_error`} +#' \item{type}{**error**} +#' } +#' Generic error to capture internal `{mark}` errors. If any of these are encountered, please report an issue at +#' } +#' \subsection{`mark:list2df_warning/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:list2df_warning`} +#' \item{type}{**warning**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:match_arg_no_match/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:match_arg_no_match`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:match_param_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:match_param_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:md5_status/condition`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:md5_status`} +#' \item{type}{**condition**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:na_timezone_found/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:na_timezone_found`} +#' \item{type}{**warning**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:not_available_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:not_available_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:numeric_datetime_tz/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:numeric_datetime_tz`} +#' \item{type}{**error**} +#' } +#' ```r +#' # Instead of this: +#' diff_time(100, 200, tz = NULL) +#' +#' # do this: +#' diff_time(100, 200, tz = 'America/New_York') +#' +#' # or: +#' diff_time(100, 200, tz = 0) +#' ``` +#' } +#' \subsection{`mark:options_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:options_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:path_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:path_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:path_warning/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:path_warning`} +#' \item{type}{**warning**} +#' } +#' File creation cannot be performed when the path is an existing directory +#' } +#' \subsection{`mark:percentile_rank_weights_length/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:percentile_rank_weights_length`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:reindex_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:reindex_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:reindex_warning/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:reindex_warning`} +#' \item{type}{**warning**} +#' } +#' NA values in index may cause errors with expansion +#' +#' `reindex()` will not match on NA values but instead will return a row of NAs +#' +#' ```r +#' x <- data.frame(index = c(1:2, NA, 4:5), values = letters[1:5]) +#' reindex(x, 'index', c(1, 2, 5)) +#' #> index values +#' #> 1 1 a +#' #> 2 2 b +#' #> 5 5 e +#' +#' reindex(x, 'index', c(1, 2, 5, NA)) +#' #> index values +#' #> 1 1 a +#' #> 2 2 b +#' #> 5 5 e +#' #> NA +#' ``` +#' } +#' \subsection{`mark:remove_labels_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:remove_labels_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:source_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:source_error`} +#' \item{type}{**error**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:switch_error/condition`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:switch_error`} +#' \item{type}{**condition**} +#' } +#' _no help documentation provided_ +#' } +#' \subsection{`mark:timezone_not_found/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:timezone_not_found`} +#' \item{type}{**error**} +#' } +#' When using a string for a timezone, this value must be found within `OlsonNames()` +#' } +#' \subsection{`mark:type_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:type_error`} +#' \item{type}{**error**} +#' } +#' Generic error to indicate a type mismatch. +#' } +#' \subsection{`mark:value_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:value_error`} +#' \item{type}{**error**} +#' } +#' Generic error to indicate a value mismatch. +#' } +#' \subsection{`mark:value_warning/warning`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:value_warning`} +#' \item{type}{**warning**} +#' } +#' Generic warning to indicate a value mismatch. +#' } +#' \subsection{`mark:view_labels_error/error`}{ +#' \describe{ +#' \item{package}{`{mark}`} +#' \item{class}{`mark:view_labels_error`} +#' \item{type}{**error**} +#' } +#' This may be because you are using RStudio : https://community.rstudio.com/t/view-is-causing-an-error/75297/4 You can try : `utils::View(get_labels(x), title = "Labels")` +#' } +#' +#' @seealso [cnd::cnd-package] [cnd::condition] +#' @keywords internal +#' +NULL diff --git a/R/zzz.R b/R/zzz.R index 3bb5d8c8..fa824add 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -8,4 +8,4 @@ # FIXME include: cnd_exports() -# cnd_document() +cnd_document() diff --git a/man/mark-cnd-conditions.Rd b/man/mark-cnd-conditions.Rd new file mode 100644 index 00000000..60a15e5c --- /dev/null +++ b/man/mark-cnd-conditions.Rd @@ -0,0 +1,499 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mark-cnd-conditions.R +\name{mark-cnd-conditions} +\alias{mark-cnd-conditions} +\alias{mark:append_warning} +\alias{mark:assign_labels_error} +\alias{mark:base_conversion_error} +\alias{mark:bib_error} +\alias{mark:class_error} +\alias{mark:default_tz_value} +\alias{mark:description_version_error} +\alias{mark:diff_time_error} +\alias{mark:diff_time_warning} +\alias{mark:duplicate_error} +\alias{mark:expand_by_warning} +\alias{mark:fct_expand_seq_error} +\alias{mark:import_error} +\alias{mark:input_error} +\alias{mark:input_warning} +\alias{mark:internal_error} +\alias{mark:list2df_warning} +\alias{mark:match_arg_no_match} +\alias{mark:match_param_error} +\alias{mark:md5_status} +\alias{mark:na_timezone_found} +\alias{mark:not_available_error} +\alias{mark:numeric_datetime_tz} +\alias{mark:options_error} +\alias{mark:path_error} +\alias{mark:path_warning} +\alias{mark:percentile_rank_weights_length} +\alias{mark:reindex_error} +\alias{mark:reindex_warning} +\alias{mark:remove_labels_error} +\alias{mark:source_error} +\alias{mark:switch_error} +\alias{mark:timezone_not_found} +\alias{mark:type_error} +\alias{mark:value_error} +\alias{mark:value_warning} +\alias{mark:view_labels_error} +\alias{append_warning} +\alias{assign_labels_error} +\alias{base_conversion_error} +\alias{bib_error} +\alias{class_error} +\alias{default_tz_value} +\alias{description_version_error} +\alias{diff_time_error} +\alias{diff_time_warning} +\alias{duplicate_error} +\alias{expand_by_warning} +\alias{fct_expand_seq_error} +\alias{import_error} +\alias{input_error} +\alias{input_warning} +\alias{internal_error} +\alias{list2df_warning} +\alias{match_arg_no_match} +\alias{match_param_error} +\alias{md5_status} +\alias{na_timezone_found} +\alias{not_available_error} +\alias{numeric_datetime_tz} +\alias{options_error} +\alias{path_error} +\alias{path_warning} +\alias{percentile_rank_weights_length} +\alias{reindex_error} +\alias{reindex_warning} +\alias{remove_labels_error} +\alias{source_error} +\alias{switch_error} +\alias{timezone_not_found} +\alias{type_error} +\alias{value_error} +\alias{value_warning} +\alias{view_labels_error} +\alias{mark:append_warning/warning} +\alias{mark:assign_labels_error/error} +\alias{mark:base_conversion_error/error} +\alias{mark:bib_error/error} +\alias{mark:class_error/error} +\alias{mark:default_tz_value/error} +\alias{mark:description_version_error/error} +\alias{mark:diff_time_error/error} +\alias{mark:diff_time_warning/warning} +\alias{mark:duplicate_error/error} +\alias{mark:expand_by_warning/warning} +\alias{mark:fct_expand_seq_error/error} +\alias{mark:import_error/error} +\alias{mark:input_error/error} +\alias{mark:input_warning/warning} +\alias{mark:internal_error/error} +\alias{mark:list2df_warning/warning} +\alias{mark:match_arg_no_match/error} +\alias{mark:match_param_error/error} +\alias{mark:md5_status/condition} +\alias{mark:na_timezone_found/warning} +\alias{mark:not_available_error/error} +\alias{mark:numeric_datetime_tz/error} +\alias{mark:options_error/error} +\alias{mark:path_error/error} +\alias{mark:path_warning/warning} +\alias{mark:percentile_rank_weights_length/error} +\alias{mark:reindex_error/error} +\alias{mark:reindex_warning/warning} +\alias{mark:remove_labels_error/error} +\alias{mark:source_error/error} +\alias{mark:switch_error/condition} +\alias{mark:timezone_not_found/error} +\alias{mark:type_error/error} +\alias{mark:value_error/error} +\alias{mark:value_warning/warning} +\alias{mark:view_labels_error/error} +\title{Conditions for \code{mark}} +\description{ +Conditions for \code{mark} +} +\details{ +The following conditions are defined in the \code{{mark}} package. +} +\section{\code{{cnd}}}{ + +These conditions are made with the \code{\link[cnd:cnd-package]{\{cnd\}}} package though the +use of \code{\link[cnd:condition]{cnd::condition()}}. +} + +\section{\code{{mark}} conditions}{ + + +\subsection{\code{mark:append_warning/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:append_warning}} +\item{type}{\strong{warning}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:assign_labels_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:assign_labels_error}} +\item{type}{\strong{error}} +} +\code{assign_labels_error} + +\strong{Columns not found} +You can set \code{.missing} to \code{warn} to get a warning instead of an error, or \code{skip} to silently skip those labels. + +\strong{Malformed labels} +If passing labels as \code{.ls}, \code{...} must be empty. Columns in \code{...} must be entered as \code{name = value}; \code{column = label}. + +\if{html}{\out{
}}\preformatted{# instead of this: +assign_labels(df, a = 'AAA', .ls = list(b = 'BBB')) + +# do this: +assign_labels(df, a = 'AAA', b = 'BBB') +# or this: +assign_labels(df, .ls = list(a = 'AAA', b = 'BBB')) +}\if{html}{\out{
}} + +Labels must not be null; to remove lavels, use \code{remove_labels()}. + +\if{html}{\out{
}}\preformatted{# instead of this +assign_labels(df, a = 'AAA', b = NULL) + +# do this +df <- assign_labels(df, a = 'AAA') +df <- remove_labels(df, 'b') +}\if{html}{\out{
}} + +} +\subsection{\code{mark:base_conversion_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:base_conversion_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:bib_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:bib_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:class_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:class_error}} +\item{type}{\strong{error}} +} +Generic error to indicate a class mismatch. +} +\subsection{\code{mark:default_tz_value/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:default_tz_value}} +\item{type}{\strong{error}} +} +option(mark.default_tz) must be a character vector of length 1L, a function that returns a character vector of length 1L, NULL (defaults to UTC), or "system" to set to system timezone +} +\subsection{\code{mark:description_version_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:description_version_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:diff_time_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:diff_time_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:diff_time_warning/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:diff_time_warning}} +\item{type}{\strong{warning}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:duplicate_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:duplicate_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:expand_by_warning/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:expand_by_warning}} +\item{type}{\strong{warning}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:fct_expand_seq_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:fct_expand_seq_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:import_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:import_error}} +\item{type}{\strong{error}} +} +The object you are trying to import has already been assigned in the environment you are importing to. Use the \code{overwrite} option to replace the object. + +For example: + +\if{html}{\out{
}}\preformatted{# instead of +foo <- NULL +import('package', 'foo') + +# do this +foo <- NULL +import('package', 'foo', overwrite = TRUE) +}\if{html}{\out{
}} + +} +\subsection{\code{mark:input_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:input_error}} +\item{type}{\strong{error}} +} +Generic error to indicate a bad input value. +} +\subsection{\code{mark:input_warning/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:input_warning}} +\item{type}{\strong{warning}} +} +Generic warning to indicate a bad input value. +} +\subsection{\code{mark:internal_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:internal_error}} +\item{type}{\strong{error}} +} +Generic error to capture internal \code{{mark}} errors. If any of these are encountered, please report an issue at \url{https://github.com/jmbarbone/mark/issues} +} +\subsection{\code{mark:list2df_warning/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:list2df_warning}} +\item{type}{\strong{warning}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:match_arg_no_match/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:match_arg_no_match}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:match_param_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:match_param_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:md5_status/condition}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:md5_status}} +\item{type}{\strong{condition}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:na_timezone_found/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:na_timezone_found}} +\item{type}{\strong{warning}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:not_available_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:not_available_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:numeric_datetime_tz/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:numeric_datetime_tz}} +\item{type}{\strong{error}} +} + +\if{html}{\out{
}}\preformatted{# Instead of this: +diff_time(100, 200, tz = NULL) + +# do this: +diff_time(100, 200, tz = 'America/New_York') + +# or: +diff_time(100, 200, tz = 0) +}\if{html}{\out{
}} + +} +\subsection{\code{mark:options_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:options_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:path_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:path_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:path_warning/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:path_warning}} +\item{type}{\strong{warning}} +} +File creation cannot be performed when the path is an existing directory +} +\subsection{\code{mark:percentile_rank_weights_length/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:percentile_rank_weights_length}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:reindex_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:reindex_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:reindex_warning/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:reindex_warning}} +\item{type}{\strong{warning}} +} +NA values in index may cause errors with expansion + +\code{reindex()} will not match on NA values but instead will return a row of NAs + +\if{html}{\out{
}}\preformatted{x <- data.frame(index = c(1:2, NA, 4:5), values = letters[1:5]) +reindex(x, 'index', c(1, 2, 5)) +#> index values +#> 1 1 a +#> 2 2 b +#> 5 5 e + +reindex(x, 'index', c(1, 2, 5, NA)) +#> index values +#> 1 1 a +#> 2 2 b +#> 5 5 e +#> NA +}\if{html}{\out{
}} + +} +\subsection{\code{mark:remove_labels_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:remove_labels_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:source_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:source_error}} +\item{type}{\strong{error}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:switch_error/condition}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:switch_error}} +\item{type}{\strong{condition}} +} +\emph{no help documentation provided} +} +\subsection{\code{mark:timezone_not_found/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:timezone_not_found}} +\item{type}{\strong{error}} +} +When using a string for a timezone, this value must be found within \code{OlsonNames()} +} +\subsection{\code{mark:type_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:type_error}} +\item{type}{\strong{error}} +} +Generic error to indicate a type mismatch. +} +\subsection{\code{mark:value_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:value_error}} +\item{type}{\strong{error}} +} +Generic error to indicate a value mismatch. +} +\subsection{\code{mark:value_warning/warning}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:value_warning}} +\item{type}{\strong{warning}} +} +Generic warning to indicate a value mismatch. +} +\subsection{\code{mark:view_labels_error/error}}{ +\describe{ +\item{package}{\code{{mark}}} +\item{class}{\code{mark:view_labels_error}} +\item{type}{\strong{error}} +} +This may be because you are using RStudio : https://community.rstudio.com/t/view-is-causing-an-error/75297/4 You can try : \code{utils::View(get_labels(x), title = "Labels")} +} +} + +\seealso{ +\link[cnd:cnd-package]{cnd::cnd-package} \link[cnd:condition]{cnd::condition} +} +\keyword{internal} diff --git a/man/match_param.Rd b/man/match_param.Rd index 5a0e6ced..674b8f19 100644 --- a/man/match_param.Rd +++ b/man/match_param.Rd @@ -42,6 +42,23 @@ Much like \code{\link[base:match.arg]{base::match.arg()}} with a few key differe \details{ Param matching for an argument } +\section{Conditions}{ + + +Conditions are generated through the \code{\link[cnd:cnd-package]{\{cnd\}}} package. +The following conditions are associated with this function: + +\describe{ + +\item{\code{\link[=mark-cnd-conditions]{mark:match_param_error/error}}}{ + +} + +} + +For more conditions, see: \link{mark-cnd-conditions} +} + \examples{ fruits <- function(x = c("apple", "banana", "orange")) { match_param(x) diff --git a/man/reexports.Rd b/man/reexports.Rd index eb1029f6..e31cd8b3 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From 88d042eed6c36f084e1bd307a0f3bd3d24632be2 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 16 Feb 2026 10:59:39 -0500 Subject: [PATCH 138/169] bumps cnd versino (#259) --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4a01ba08..bc246c71 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,7 @@ Depends: R (>= 4.1.0) Imports: cli, - cnd (>= 0.1.0.9001), + cnd (>= 0.1.1.9001), fs (>= 1.6.2), fuj (>= 0.2.1), magrittr (>= 2.0.1), @@ -56,7 +56,7 @@ Suggests: readMDTable (>= 0.2.0), clipr (>= 0.8.0) Remotes: - github::jmbarbone/cnd@v0.1.0.9001 + github::jmbarbone/cnd@v0.1.1.9001 RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 From c1f8ef5d79470d6f59c20bc04f1087ccb6266a5b Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 21 Feb 2026 18:17:47 -0500 Subject: [PATCH 139/169] redocs (#259) --- man/reexports.Rd | 2 +- man/to_boolean.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/man/reexports.Rd b/man/reexports.Rd index e31cd8b3..eb1029f6 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} diff --git a/man/to_boolean.Rd b/man/to_boolean.Rd index 0d4c7822..2a153be9 100644 --- a/man/to_boolean.Rd +++ b/man/to_boolean.Rd @@ -15,7 +15,7 @@ to_boolean(x, ...) \method{to_boolean}{numeric}(x, true = 1, false = 0, na = NULL, ...) -\method{to_boolean}{integer}(x, true = 1L, false = 0L, ...) +\method{to_boolean}{integer}(x, true = 1L, false = 0L, na = NULL, ...) \method{to_boolean}{character}( x, From 875d022bb74ca1815162c0294f5cb2b20330f026 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 22 Feb 2026 23:50:33 -0500 Subject: [PATCH 140/169] uses default cnd conditions (#259) --- R/aaa.R | 117 +------------------------------------------------------- 1 file changed, 1 insertion(+), 116 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 61994037..19016e46 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -25,122 +25,7 @@ walrus <- function(sym, val) { # standard conditions ----------------------------------------------------- -# caused by user inputs -input_error := condition( - function(x) x, - type = "error", - help = "Generic error to indicate a bad input value." -) - -input_warning := condition( - function(x) x, - type = "warning", - help = "Generic warning to indicate a bad input value." -) - -# caused by processing -value_error := condition( - function(x) x, - type = "error", - help = "Generic error to indicate a value mismatch." -) - -value_warning := condition( - function(x) x, - type = "warning", - help = "Generic warning to indicate a value mismatch." -) - -# FIXME for now, we can't use colliding variable names in condition(message), -# but I'd rather use `type` instead of `s` -# -# https://github.com/jmbarbone/cnd/issues/23 - -type_error := condition( - function(s, x, expected, actual, name) { - if (missing(actual)) { - actual <- typeof(x) - } - - if (missing(name)) { - name <- sprintf( - "`%s`", - deparse( - match.call( - sys.function(sys.parent(1L)), - sys.call(sys.parent(1L)), - envir = parent.frame(3L) - )$x - ) - ) - } - - switch( - s, - not_supported = sprintf( - "Object `%s` cannot be of type: %s", - name, - actual - ), - must_be = sprintf( - "Object `%s` must be of type '%s', not '%s'", - name, - expected, - actual - ), - stop(internal_error()) - ) - }, - type = "error", - help = "Generic error to indicate a type mismatch." -) - -class_error := condition( - function(s, x, expected, actual, name) { - if (missing(actual)) { - actual <- class(x) - } - - if (missing(name)) { - name <- sprintf( - "%s", - deparse( - match.call( - sys.function(sys.parent(1L)), - sys.call(sys.parent(1L)), - envir = parent.frame(3L) - )$x - ) - ) - } - - switch( - s, - not_supported = sprintf( - ngettext( - length(actual), - "Object `%s` cannot be of class: %s", - "Object `%s` cannot be of classes: %s" - ), - name, - toString(actual) - ), - must_be = sprintf( - ngettext( - length(actual), - "Object `%s` must be of class '%s', not '%s'", - "Object `%s` must be of class '%s', not classes '%s'" - ), - name, - toString(expected), - toString(actual) - ), - stop(internal_error()) - ) - }, - type = "error", - help = "Generic error to indicate a class mismatch." -) +#' @importFrom cnd input_error input_warning value_error type_error class_error internal_error := condition( function(x) { From 775cccdf5874971e426538ce3ffd6284533284c2 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 22 Feb 2026 23:50:49 -0500 Subject: [PATCH 141/169] redocs (#259) --- NAMESPACE | 5 +++ R/mark-cnd-conditions.R | 50 +---------------------------- man/mark-cnd-conditions.Rd | 66 -------------------------------------- 3 files changed, 6 insertions(+), 115 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 1102679d..4c88d97b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -298,6 +298,11 @@ export(wuffle) export(xnandr) import(cnd) import(fuj) +importFrom(cnd,class_error) +importFrom(cnd,input_error) +importFrom(cnd,input_warning) +importFrom(cnd,type_error) +importFrom(cnd,value_error) importFrom(fuj,"%::%") importFrom(fuj,"%:::%") importFrom(fuj,"%colons%") diff --git a/R/mark-cnd-conditions.R b/R/mark-cnd-conditions.R index 20942cb2..92c05441 100644 --- a/R/mark-cnd-conditions.R +++ b/R/mark-cnd-conditions.R @@ -1,7 +1,7 @@ # % Generated by cnd: do not edit by hand #' @name mark-cnd-conditions -#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:bib_error mark:class_error mark:default_tz_value mark:description_version_error mark:diff_time_error mark:diff_time_warning mark:duplicate_error mark:expand_by_warning mark:fct_expand_seq_error mark:import_error mark:input_error mark:input_warning mark:internal_error mark:list2df_warning mark:match_arg_no_match mark:match_param_error mark:md5_status mark:na_timezone_found mark:not_available_error mark:numeric_datetime_tz mark:options_error mark:path_error mark:path_warning mark:percentile_rank_weights_length mark:reindex_error mark:reindex_warning mark:remove_labels_error mark:source_error mark:switch_error mark:timezone_not_found mark:type_error mark:value_error mark:value_warning mark:view_labels_error append_warning assign_labels_error base_conversion_error bib_error class_error default_tz_value description_version_error diff_time_error diff_time_warning duplicate_error expand_by_warning fct_expand_seq_error import_error input_error input_warning internal_error list2df_warning match_arg_no_match match_param_error md5_status na_timezone_found not_available_error numeric_datetime_tz options_error path_error path_warning percentile_rank_weights_length reindex_error reindex_warning remove_labels_error source_error switch_error timezone_not_found type_error value_error value_warning view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:bib_error/error mark:class_error/error mark:default_tz_value/error mark:description_version_error/error mark:diff_time_error/error mark:diff_time_warning/warning mark:duplicate_error/error mark:expand_by_warning/warning mark:fct_expand_seq_error/error mark:import_error/error mark:input_error/error mark:input_warning/warning mark:internal_error/error mark:list2df_warning/warning mark:match_arg_no_match/error mark:match_param_error/error mark:md5_status/condition mark:na_timezone_found/warning mark:not_available_error/error mark:numeric_datetime_tz/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:percentile_rank_weights_length/error mark:reindex_error/error mark:reindex_warning/warning mark:remove_labels_error/error mark:source_error/error mark:switch_error/condition mark:timezone_not_found/error mark:type_error/error mark:value_error/error mark:value_warning/warning mark:view_labels_error/error +#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:bib_error mark:default_tz_value mark:description_version_error mark:diff_time_error mark:diff_time_warning mark:duplicate_error mark:expand_by_warning mark:fct_expand_seq_error mark:import_error mark:internal_error mark:list2df_warning mark:match_arg_no_match mark:match_param_error mark:md5_status mark:na_timezone_found mark:not_available_error mark:numeric_datetime_tz mark:options_error mark:path_error mark:path_warning mark:percentile_rank_weights_length mark:reindex_error mark:reindex_warning mark:remove_labels_error mark:source_error mark:switch_error mark:timezone_not_found mark:view_labels_error append_warning assign_labels_error base_conversion_error bib_error default_tz_value description_version_error diff_time_error diff_time_warning duplicate_error expand_by_warning fct_expand_seq_error import_error internal_error list2df_warning match_arg_no_match match_param_error md5_status na_timezone_found not_available_error numeric_datetime_tz options_error path_error path_warning percentile_rank_weights_length reindex_error reindex_warning remove_labels_error source_error switch_error timezone_not_found view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:bib_error/error mark:default_tz_value/error mark:description_version_error/error mark:diff_time_error/error mark:diff_time_warning/warning mark:duplicate_error/error mark:expand_by_warning/warning mark:fct_expand_seq_error/error mark:import_error/error mark:internal_error/error mark:list2df_warning/warning mark:match_arg_no_match/error mark:match_param_error/error mark:md5_status/condition mark:na_timezone_found/warning mark:not_available_error/error mark:numeric_datetime_tz/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:percentile_rank_weights_length/error mark:reindex_error/error mark:reindex_warning/warning mark:remove_labels_error/error mark:source_error/error mark:switch_error/condition mark:timezone_not_found/error mark:view_labels_error/error #' @title Conditions for `mark` #' #' @details @@ -71,14 +71,6 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:class_error/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:class_error`} -#' \item{type}{**error**} -#' } -#' Generic error to indicate a class mismatch. -#' } #' \subsection{`mark:default_tz_value/error`}{ #' \describe{ #' \item{package}{`{mark}`} @@ -155,22 +147,6 @@ #' import('package', 'foo', overwrite = TRUE) #' ``` #' } -#' \subsection{`mark:input_error/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:input_error`} -#' \item{type}{**error**} -#' } -#' Generic error to indicate a bad input value. -#' } -#' \subsection{`mark:input_warning/warning`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:input_warning`} -#' \item{type}{**warning**} -#' } -#' Generic warning to indicate a bad input value. -#' } #' \subsection{`mark:internal_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} @@ -342,30 +318,6 @@ #' } #' When using a string for a timezone, this value must be found within `OlsonNames()` #' } -#' \subsection{`mark:type_error/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:type_error`} -#' \item{type}{**error**} -#' } -#' Generic error to indicate a type mismatch. -#' } -#' \subsection{`mark:value_error/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:value_error`} -#' \item{type}{**error**} -#' } -#' Generic error to indicate a value mismatch. -#' } -#' \subsection{`mark:value_warning/warning`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:value_warning`} -#' \item{type}{**warning**} -#' } -#' Generic warning to indicate a value mismatch. -#' } #' \subsection{`mark:view_labels_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} diff --git a/man/mark-cnd-conditions.Rd b/man/mark-cnd-conditions.Rd index 60a15e5c..7e157b34 100644 --- a/man/mark-cnd-conditions.Rd +++ b/man/mark-cnd-conditions.Rd @@ -6,7 +6,6 @@ \alias{mark:assign_labels_error} \alias{mark:base_conversion_error} \alias{mark:bib_error} -\alias{mark:class_error} \alias{mark:default_tz_value} \alias{mark:description_version_error} \alias{mark:diff_time_error} @@ -15,8 +14,6 @@ \alias{mark:expand_by_warning} \alias{mark:fct_expand_seq_error} \alias{mark:import_error} -\alias{mark:input_error} -\alias{mark:input_warning} \alias{mark:internal_error} \alias{mark:list2df_warning} \alias{mark:match_arg_no_match} @@ -35,15 +32,11 @@ \alias{mark:source_error} \alias{mark:switch_error} \alias{mark:timezone_not_found} -\alias{mark:type_error} -\alias{mark:value_error} -\alias{mark:value_warning} \alias{mark:view_labels_error} \alias{append_warning} \alias{assign_labels_error} \alias{base_conversion_error} \alias{bib_error} -\alias{class_error} \alias{default_tz_value} \alias{description_version_error} \alias{diff_time_error} @@ -52,8 +45,6 @@ \alias{expand_by_warning} \alias{fct_expand_seq_error} \alias{import_error} -\alias{input_error} -\alias{input_warning} \alias{internal_error} \alias{list2df_warning} \alias{match_arg_no_match} @@ -72,15 +63,11 @@ \alias{source_error} \alias{switch_error} \alias{timezone_not_found} -\alias{type_error} -\alias{value_error} -\alias{value_warning} \alias{view_labels_error} \alias{mark:append_warning/warning} \alias{mark:assign_labels_error/error} \alias{mark:base_conversion_error/error} \alias{mark:bib_error/error} -\alias{mark:class_error/error} \alias{mark:default_tz_value/error} \alias{mark:description_version_error/error} \alias{mark:diff_time_error/error} @@ -89,8 +76,6 @@ \alias{mark:expand_by_warning/warning} \alias{mark:fct_expand_seq_error/error} \alias{mark:import_error/error} -\alias{mark:input_error/error} -\alias{mark:input_warning/warning} \alias{mark:internal_error/error} \alias{mark:list2df_warning/warning} \alias{mark:match_arg_no_match/error} @@ -109,9 +94,6 @@ \alias{mark:source_error/error} \alias{mark:switch_error/condition} \alias{mark:timezone_not_found/error} -\alias{mark:type_error/error} -\alias{mark:value_error/error} -\alias{mark:value_warning/warning} \alias{mark:view_labels_error/error} \title{Conditions for \code{mark}} \description{ @@ -187,14 +169,6 @@ df <- remove_labels(df, 'b') } \emph{no help documentation provided} } -\subsection{\code{mark:class_error/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:class_error}} -\item{type}{\strong{error}} -} -Generic error to indicate a class mismatch. -} \subsection{\code{mark:default_tz_value/error}}{ \describe{ \item{package}{\code{{mark}}} @@ -270,22 +244,6 @@ foo <- NULL import('package', 'foo', overwrite = TRUE) }\if{html}{\out{}} -} -\subsection{\code{mark:input_error/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:input_error}} -\item{type}{\strong{error}} -} -Generic error to indicate a bad input value. -} -\subsection{\code{mark:input_warning/warning}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:input_warning}} -\item{type}{\strong{warning}} -} -Generic warning to indicate a bad input value. } \subsection{\code{mark:internal_error/error}}{ \describe{ @@ -459,30 +417,6 @@ reindex(x, 'index', c(1, 2, 5, NA)) } When using a string for a timezone, this value must be found within \code{OlsonNames()} } -\subsection{\code{mark:type_error/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:type_error}} -\item{type}{\strong{error}} -} -Generic error to indicate a type mismatch. -} -\subsection{\code{mark:value_error/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:value_error}} -\item{type}{\strong{error}} -} -Generic error to indicate a value mismatch. -} -\subsection{\code{mark:value_warning/warning}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:value_warning}} -\item{type}{\strong{warning}} -} -Generic warning to indicate a value mismatch. -} \subsection{\code{mark:view_labels_error/error}}{ \describe{ \item{package}{\code{{mark}}} From c270d16b9b7df235587f57a9eae9435ac177b0d9 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 22 Feb 2026 23:50:58 -0500 Subject: [PATCH 142/169] updates tests (#259) --- tests/testthat/test-base-conversion.R | 4 ++-- tests/testthat/test-bib.R | 4 ++-- tests/testthat/test-char2fact.R | 2 +- tests/testthat/test-dataframes.R | 8 ++++---- tests/testthat/test-dates.R | 6 +++--- tests/testthat/test-description.R | 6 +++--- tests/testthat/test-detail.R | 4 ++-- tests/testthat/test-directory.R | 12 ++++++------ tests/testthat/test-expand.R | 2 +- tests/testthat/test-fct-expand-seq.R | 4 ++-- tests/testthat/test-identical.R | 4 ++-- tests/testthat/test-insert.R | 4 ++-- tests/testthat/test-limit.R | 10 +++++----- tests/testthat/test-logic.R | 16 ++++++++-------- tests/testthat/test-match-arg.R | 6 +++--- tests/testthat/test-na-assignment.R | 2 +- tests/testthat/test-names.R | 2 +- tests/testthat/test-nas.R | 12 ++++++------ tests/testthat/test-note.R | 4 ++-- tests/testthat/test-options.R | 2 +- tests/testthat/test-paste.R | 2 +- tests/testthat/test-recode.R | 4 ++-- tests/testthat/test-strings.R | 2 +- tests/testthat/test-todos.R | 4 ++-- tests/testthat/test-within.R | 4 ++-- tests/testthat/test-write.R | 2 +- 26 files changed, 66 insertions(+), 66 deletions(-) diff --git a/tests/testthat/test-base-conversion.R b/tests/testthat/test-base-conversion.R index e355e8b8..57e31068 100644 --- a/tests/testthat/test-base-conversion.R +++ b/tests/testthat/test-base-conversion.R @@ -26,8 +26,8 @@ test_that("base_n() works as expected", { }) test_that("base_alpha(), base_n() fails", { - expect_error(base_alpha(1), class = "mark:class_error") - expect_error(base_n("a"), class = "mark:class_error") + expect_error(base_alpha(1), class = "class_error") + expect_error(base_n("a"), class = "class_error") expect_error(base_n(1, 10, 12), class = "mark:base_conversion_error") }) diff --git a/tests/testthat/test-bib.R b/tests/testthat/test-bib.R index 25e64151..802f9e2f 100644 --- a/tests/testthat/test-bib.R +++ b/tests/testthat/test-bib.R @@ -16,8 +16,8 @@ test_that("read_bib()", { writeLines("bad", temp) expect_error(read_bib(temp), class = "mark:bib_error") - expect_error(as_bib(1:3), class = "mark:class_error") - expect_error(as_bib_list(1:3), class = "mark:type_error") + expect_error(as_bib(1:3), class = "class_error") + expect_error(as_bib_list(1:3), class = "type_error") expect_error( process_bib_dataframe( diff --git a/tests/testthat/test-char2fact.R b/tests/testthat/test-char2fact.R index 0ecec32f..2f707576 100644 --- a/tests/testthat/test-char2fact.R +++ b/tests/testthat/test-char2fact.R @@ -27,7 +27,7 @@ test_that("char2fact.data.frame() works", { }) test_that("fact2char() works", { - expect_error(fact2char(letters), class = "mark:class_error") + expect_error(fact2char(letters), class = "class_error") df <- quick_dfl( a = 1:5, diff --git a/tests/testthat/test-dataframes.R b/tests/testthat/test-dataframes.R index aeab408a..e25c03bb 100644 --- a/tests/testthat/test-dataframes.R +++ b/tests/testthat/test-dataframes.R @@ -29,8 +29,8 @@ test_that("to_row_names()", { test_that("col_to_rn()", { - expect_error(to_row_names(data.frame(), 1:2), class = "mark:input_error") - expect_error(to_row_names(data.frame(), NA), class = "mark:input_error") + expect_error(to_row_names(data.frame(), 1:2), class = "input_error") + expect_error(to_row_names(data.frame(), NA), class = "input_error") }) test_that("vector2df()", { @@ -42,7 +42,7 @@ test_that("vector2df()", { expect_equal(vector2df(set_names(x)), df) expect_named(vector2df(x, "one", "two"), c("one", "two")) - expect_error(vector2df(list(a = 1)), class = "mark:class_error") + expect_error(vector2df(list(a = 1)), class = "class_error") }) test_that("list2df()", { @@ -67,7 +67,7 @@ test_that("list2df()", { res <- quick_dfl(name = c("a", 2, 3), value = c(1, 0, 2)) expect_equal(list2df(x), res) - expect_error(list2df(1), class = "mark:class_error") + expect_error(list2df(1), class = "class_error") # Not sure this will continue to be the case expect_identical(quick_df(NULL), data.frame()) diff --git a/tests/testthat/test-dates.R b/tests/testthat/test-dates.R index 181da7f4..993bc0fe 100644 --- a/tests/testthat/test-dates.R +++ b/tests/testthat/test-dates.R @@ -93,9 +93,9 @@ test_that("'Empty' dates don't cause errors", { }) test_that("date errors", { - expect_error(verify_format("ymda"), class = "mark:input_error") - expect_error(verify_format("abc"), class = "mark:input_error") - expect_error(verify_format("aaa"), class = "mark:input_error") + expect_error(verify_format("ymda"), class = "input_error") + expect_error(verify_format("abc"), class = "input_error") + expect_error(verify_format("aaa"), class = "input_error") expect_error(verify_format("ymd"), NA) expect_error(verify_format("dmy"), NA) expect_error(verify_format("mdy"), NA) diff --git a/tests/testthat/test-description.R b/tests/testthat/test-description.R index c2d5ed5b..c5d7260f 100644 --- a/tests/testthat/test-description.R +++ b/tests/testthat/test-description.R @@ -1,6 +1,6 @@ test_that("find_author() works", { withr::local_options(list(mark.author = NULL)) - expect_error(find_author(), class = "mark:value_error") + expect_error(find_author(), class = "value_error") }) test_that("use_author() works", { @@ -46,6 +46,6 @@ test_that("use_author() works", { writeLines(original, "DESCRIPTION") - expect_error(use_author(NULL), class = "mark:type_error") - expect_error(use_author(person()), class = "mark:type_error") + expect_error(use_author(NULL), class = "type_error") + expect_error(use_author(person()), class = "type_error") }) diff --git a/tests/testthat/test-detail.R b/tests/testthat/test-detail.R index 641d032a..d83f449d 100644 --- a/tests/testthat/test-detail.R +++ b/tests/testthat/test-detail.R @@ -7,7 +7,7 @@ test_that("details() works", { expect_error(detail(x), NA) expect_error(detail(df), NA) - expect_error(detail(data.frame()), class = "mark:input_error") + expect_error(detail(data.frame()), class = "input_error") exp <- quick_dfl( class = "logical", @@ -38,7 +38,7 @@ test_that("details() and tibbles", { expect_error(detail(tibble::tibble(a = 1, b = list(1:3))), NA) expect_error( detail(tibble::tibble(a = NULL, b = list(1:3))), - class = "mark:input_error" + class = "input_error" ) }) diff --git a/tests/testthat/test-directory.R b/tests/testthat/test-directory.R index 94865f95..ec44604f 100644 --- a/tests/testthat/test-directory.R +++ b/tests/testthat/test-directory.R @@ -46,10 +46,10 @@ test_that("tests with temp dir", { # fmt: skip test_that("errors", { - expect_error(is_file(NULL), class = "mark:input_error") - expect_error(is_file(character()), class = "mark:input_error") - expect_error(is_file(TRUE), class = "mark:input_error") - expect_error(is_dir(NULL), class = "mark:input_error") - expect_error(is_dir(character()), class = "mark:input_error") - expect_error(is_dir(TRUE), class = "mark:input_error") + expect_error(is_file(NULL), class = "input_error") + expect_error(is_file(character()), class = "input_error") + expect_error(is_file(TRUE), class = "input_error") + expect_error(is_dir(NULL), class = "input_error") + expect_error(is_dir(character()), class = "input_error") + expect_error(is_dir(TRUE), class = "input_error") }) diff --git a/tests/testthat/test-expand.R b/tests/testthat/test-expand.R index f621f932..8b54a09c 100644 --- a/tests/testthat/test-expand.R +++ b/tests/testthat/test-expand.R @@ -56,7 +56,7 @@ test_that("reindex() work", { reindex(iris1, "index", seq(2, 8, 2)) reindex(iris1, "index", seq(2, 8, 2), expand = "both") - expect_error(reindex(1), class = "mark:class_error") + expect_error(reindex(1), class = "class_error") expect_error( reindex(quick_dfl(a = 1), index = integer()), class = if (getRversion() >= "4.5") "missingArgError" else "simpleError", diff --git a/tests/testthat/test-fct-expand-seq.R b/tests/testthat/test-fct-expand-seq.R index aa75850e..d8cf35de 100644 --- a/tests/testthat/test-fct-expand-seq.R +++ b/tests/testthat/test-fct-expand-seq.R @@ -23,10 +23,10 @@ test_that("Sequences correctly", { }) test_that("fct_expand_seq() fails", { - expect_error(fct_expand_seq("a"), class = "mark:class_error") + expect_error(fct_expand_seq("a"), class = "class_error") expect_error( fct_expand_seq(as.ordered("a"), by = NA), - class = "mark:input_error" + class = "input_error" ) expect_error( diff --git a/tests/testthat/test-identical.R b/tests/testthat/test-identical.R index 3295cee0..0cd826bc 100644 --- a/tests/testthat/test-identical.R +++ b/tests/testthat/test-identical.R @@ -13,8 +13,8 @@ test_that("are_identical() works", { }) test_that("are_identical() fails", { - expect_error(are_identical(1, 1:3), class = "mark:input_error") - expect_error(are_identical(NULL), class = "mark:input_error") + expect_error(are_identical(1, 1:3), class = "input_error") + expect_error(are_identical(NULL), class = "input_error") }) # lintr things there isn't a terminal line here? diff --git a/tests/testthat/test-insert.R b/tests/testthat/test-insert.R index c10c4c14..2caff674 100644 --- a/tests/testthat/test-insert.R +++ b/tests/testthat/test-insert.R @@ -7,10 +7,10 @@ test_that("insert.default() works", { exp <- c("z", "a", "b", "z", "c", "d") expect_identical(res, exp) - expect_error(insert(1, NA, 1), class = "mark:input_error") + expect_error(insert(1, NA, 1), class = "input_error") expect_error(insert(1, integer(), 1), NA) # this is actually fine expect_error(insert(1, integer(), integer()), NA) # this is actually fine - expect_error(insert(1, 1, integer()), class = "mark:input_error") + expect_error(insert(1, 1, integer()), class = "input_error") }) test_that("insert.data.frame() works", { diff --git a/tests/testthat/test-limit.R b/tests/testthat/test-limit.R index a31b0d2e..58930c90 100644 --- a/tests/testthat/test-limit.R +++ b/tests/testthat/test-limit.R @@ -4,9 +4,9 @@ test_that("limit() works", { }) test_that("limit() errors", { - expect_error(limit(1, "a", 1), class = "mark:class_error") - expect_error(limit(1, 1, "a"), class = "mark:class_error") - expect_error(limit(1, 1:2, 1), class = "mark:input_error") - expect_error(limit(1, 1, 1:2), class = "mark:input_error") - expect_error(limit(1, 2, 1), class = "mark:input_error") + expect_error(limit(1, "a", 1), class = "class_error") + expect_error(limit(1, 1, "a"), class = "class_error") + expect_error(limit(1, 1:2, 1), class = "input_error") + expect_error(limit(1, 1, 1:2), class = "input_error") + expect_error(limit(1, 2, 1), class = "input_error") }) diff --git a/tests/testthat/test-logic.R b/tests/testthat/test-logic.R index adf17fd6..0198bc22 100644 --- a/tests/testthat/test-logic.R +++ b/tests/testthat/test-logic.R @@ -59,22 +59,22 @@ test_that("Logical extension work", { }) test_that("logical helpers", { - expect_error(check_null(NULL), class = "mark:input_error") - expect_error(check_null(integer()), class = "mark:input_error") + expect_error(check_null(NULL), class = "input_error") + expect_error(check_null(integer()), class = "input_error") expect_error( apply_logical_matrix(1L, mean, TRUE), - class = "mark:input_error" + class = "input_error" ) expect_error( apply_logical_matrix(matrix("a"), mean, TRUE), - class = "mark:input_error" + class = "input_error" ) expect_error( apply_logical_matrix(matrix(3L), mean, TRUE), - class = "mark:input_error" + class = "input_error" ) }) @@ -133,13 +133,13 @@ test_that("none() works", { }) test_that("logical helpers", { - expect_error(apply_logical_matrix(1L, mean, TRUE), class = "mark:input_error") + expect_error(apply_logical_matrix(1L, mean, TRUE), class = "input_error") expect_error( apply_logical_matrix(matrix("a"), mean, TRUE), - class = "mark:input_error" + class = "input_error" ) expect_error( apply_logical_matrix(matrix(3L), mean, TRUE), - class = "mark:input_error" + class = "input_error" ) }) diff --git a/tests/testthat/test-match-arg.R b/tests/testthat/test-match-arg.R index 5ea67272..8bd66c4b 100644 --- a/tests/testthat/test-match-arg.R +++ b/tests/testthat/test-match-arg.R @@ -46,7 +46,7 @@ test_that("match_param() works", { match_param(x, null = null) } - expect_error(foo(NULL), class = "mark:input_error") + expect_error(foo(NULL), class = "input_error") expect_null(foo(NULL, null = TRUE)) }) @@ -115,11 +115,11 @@ test_that("match_param() accepts formula lists", { test_that("match_param() finds duplicate choices", { expect_error( match_param("a", c("a", "a")), - class = "mark:input_error" + class = "input_error" ) expect_error( match_param(1, c(a = 1:2, b = 3:4, c = c(1, 3))), - class = "mark:input_error" + class = "input_error" ) }) diff --git a/tests/testthat/test-na-assignment.R b/tests/testthat/test-na-assignment.R index 6f9be74f..e8c4bfb6 100644 --- a/tests/testthat/test-na-assignment.R +++ b/tests/testthat/test-na-assignment.R @@ -14,7 +14,7 @@ test_that("NA_at() and NA_if() work as expected", { expect_equal(NA_if(-1:3, foo), c(-1, 0, NA, NA, NA)) # y cannot be longer than x - expect_error(NA_at(x, 1:10), class = "mark:value_error") + expect_error(NA_at(x, 1:10), class = "value_error") res <- NA_at(1:4, function(i) which(i %% 2 == 0)) exp <- c(1L, NA, 3L, NA) diff --git a/tests/testthat/test-names.R b/tests/testthat/test-names.R index 776ee4f0..2fc35792 100644 --- a/tests/testthat/test-names.R +++ b/tests/testthat/test-names.R @@ -28,7 +28,7 @@ test_that("names_sort() works", { set_names(rep(NA, 3), c(-1, 2, 10)) ) - expect_error(sort_names(list(a = 1)), class = "mark:input_error") + expect_error(sort_names(list(a = 1)), class = "input_error") expect_error(sort_names(NA), class = "simpleError") }) diff --git a/tests/testthat/test-nas.R b/tests/testthat/test-nas.R index e4eae37b..c544984e 100644 --- a/tests/testthat/test-nas.R +++ b/tests/testthat/test-nas.R @@ -2,7 +2,7 @@ test_that("remove_na()", { x <- c(1, 2, NA, 3, NaN) expect_equal(remove_na(x), c(1, 2, 3)) expect_equal(remove_na(as.list(x)), list(1, 2, numeric(), 3, numeric())) - expect_error(remove_na(quick_dfl(x = 1)), class = "mark:input_error") + expect_error(remove_na(quick_dfl(x = 1)), class = "input_error") res <- remove_na(fact(x)) exp <- struct( @@ -24,8 +24,8 @@ test_that("remove_null()", { x <- list(a = 1, b = NULL, c = 1) expect_equal(remove_null(x), list(a = 1, c = 1)) - expect_error(remove_null(c(1, 2)), class = "mark:type_error") - expect_error(remove_null(quick_dfl(x = NULL)), class = "mark:type_error") + expect_error(remove_null(c(1, 2)), class = "type_error") + expect_error(remove_null(quick_dfl(x = NULL)), class = "type_error") }) test_that("*_na_cols() works", { @@ -52,9 +52,9 @@ test_that("*_na_cols() works", { c(first = FALSE, second = FALSE, all = TRUE, last = FALSE, all2 = TRUE) ) - expect_error(select_na_cols(1), class = "mark:class_error") - expect_error(remove_na_cols(1), class = "mark:class_error") - expect_error(is_na_cols(1), class = "mark:class_error") + expect_error(select_na_cols(1), class = "class_error") + expect_error(remove_na_cols(1), class = "class_error") + expect_error(is_na_cols(1), class = "class_error") }) test_that("tableNA() works", { diff --git a/tests/testthat/test-note.R b/tests/testthat/test-note.R index 30f5d095..e0c3cfcf 100644 --- a/tests/testthat/test-note.R +++ b/tests/testthat/test-note.R @@ -79,9 +79,9 @@ test_that("print_note() works with data.frame", { test_that("note() errors", { withr::local_options(list(mark.check_interactive = NA)) - expect_error(print_note(1L), class = "mark:class_error") + expect_error(print_note(1L), class = "class_error") x <- struct(1L, "noted", note = struct("hi", "note_a_note")) - expect_error(print_note(x), class = "mark:class_error") + expect_error(print_note(x), class = "class_error") }) test_that("note() snapshots", { diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index a3afe76e..17f53a0d 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -9,5 +9,5 @@ test_that("checkOptions() works", { expect_identical(getOption("mark.test.option2"), 2L) expect_error(checkOptions(1), info = "is.list(x)") - expect_error(checkOptions(list(1)), class = "mark:input_error") + expect_error(checkOptions(list(1)), class = "input_error") }) diff --git a/tests/testthat/test-paste.R b/tests/testthat/test-paste.R index 0d0ff8b2..15bec2fe 100644 --- a/tests/testthat/test-paste.R +++ b/tests/testthat/test-paste.R @@ -44,7 +44,7 @@ test_that("paste_combine() works", { }) test_that("paste_combine() fails", { - expect_error(paste_combine(1), class = "mark:input_error") + expect_error(paste_combine(1), class = "input_error") }) test_that("collapse0()", { diff --git a/tests/testthat/test-recode.R b/tests/testthat/test-recode.R index c780067d..56d51492 100644 --- a/tests/testthat/test-recode.R +++ b/tests/testthat/test-recode.R @@ -36,8 +36,8 @@ test_that("clean_na_coercion() works", { }) test_that("errors", { - expect_error(recode_by(1, 1), class = "mark:input_error") - expect_error(recode_only(1, 1), class = "mark:input_error") + expect_error(recode_by(1, 1), class = "input_error") + expect_error(recode_only(1, 1), class = "input_error") }) test_that("single value", { diff --git a/tests/testthat/test-strings.R b/tests/testthat/test-strings.R index 4a5d11e4..e09adbd6 100644 --- a/tests/testthat/test-strings.R +++ b/tests/testthat/test-strings.R @@ -24,7 +24,7 @@ test_that("string slices", { ) xx <- c(x, x) - expect_error(str_slice_by_word(xx, 80), class = "mark:input_error") + expect_error(str_slice_by_word(xx, 80), class = "input_error") }) # Better outputs diff --git a/tests/testthat/test-todos.R b/tests/testthat/test-todos.R index ce62f696..1bd78658 100644 --- a/tests/testthat/test-todos.R +++ b/tests/testthat/test-todos.R @@ -63,8 +63,8 @@ test_that("todos() errors and messages", { path <- test_path("scripts") err <- "path must be a character vector of length 1L" - expect_error(todos(path = 1), class = "mark:input_error") - expect_error(todos(path = c("a", "b")), class = "mark:input_error") + expect_error(todos(path = 1), class = "input_error") + expect_error(todos(path = c("a", "b")), class = "input_error") expect_error(todos(path = "zzz")) expect_error(do_todo(c("todo", "fixme"), path = "."), NA) diff --git a/tests/testthat/test-within.R b/tests/testthat/test-within.R index 1075c499..e6361fd0 100644 --- a/tests/testthat/test-within.R +++ b/tests/testthat/test-within.R @@ -30,7 +30,7 @@ test_that("between_more() works", { res <- c(FALSE, TRUE, TRUE, FALSE, FALSE) expect_identical(between_more(x, left, right), res) - expect_warning(between_more(1:2, 3, 2), class = "mark:input_warning") + expect_warning(between_more(1:2, 3, 2), class = "input_warning") }) @@ -63,5 +63,5 @@ test_that("within()", { expect_identical(within(x), x) - expect_warning(within(1:2, 3, 2), class = "mark:input_warning") + expect_warning(within(1:2, 3, 2), class = "input_warning") }) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 2ba41bf2..1d814a53 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -111,7 +111,7 @@ test_that("list columns", { "unimplemented type 'list' in 'EncodeElement'", fixed = TRUE ) - expect_error(foo(NA), class = "mark:value_error") + expect_error(foo(NA), class = "value_error") }) test_that("arrow prints something to stdout()", { From e960466e65faefceac18699d6f57300fa54558ae Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 23 Feb 2026 23:40:03 -0500 Subject: [PATCH 143/169] delints (#259) --- .lintr | 3 ++- tests/testthat/test-logic.R | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.lintr b/.lintr index a88f564b..1f0227e4 100644 --- a/.lintr +++ b/.lintr @@ -5,5 +5,6 @@ encoding: "UTF-8" exclusions: list( "tests/spelling.R", "R/array.R", - "R/time-report.R" + "R/time-report.R", + "R/mark-cnd-conditions.R" ) diff --git a/tests/testthat/test-logic.R b/tests/testthat/test-logic.R index 0198bc22..df46dc6c 100644 --- a/tests/testthat/test-logic.R +++ b/tests/testthat/test-logic.R @@ -1,7 +1,6 @@ -# nolint start: spaces_inside_linter. - # fmt: skip test_that("Logical extension work", { + # nolint start: spaces_inside_linter. x <- c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, NA, NA, NA) y <- c(TRUE, FALSE, NA, TRUE, FALSE, NA, TRUE, FALSE, NA) z <- c(TRUE, TRUE, FALSE, FALSE, NA, NA, TRUE, FALSE, NA) @@ -56,6 +55,7 @@ test_that("Logical extension work", { expect_equal(OR(x, y, na.rm = TRUE), res_xy_or_na) expect_equal(OR(x, y, z, na.rm = TRUE), res_xyz_or_na) + # nolint end: spaces_inside_linter. }) test_that("logical helpers", { From 1107f75b1c20097d0762ea17710f136105239518 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 24 Feb 2026 23:44:13 -0500 Subject: [PATCH 144/169] adds additional classes to conditions (#259) --- R/bib.R | 1 + R/diff-time.R | 6 ++++++ R/directory.R | 2 ++ R/expand.R | 1 + R/sourcing.R | 1 + R/switch.R | 3 ++- R/utils.R | 4 +++- 7 files changed, 16 insertions(+), 2 deletions(-) diff --git a/R/bib.R b/R/bib.R index 6b162fcf..2569b41f 100644 --- a/R/bib.R +++ b/R/bib.R @@ -317,5 +317,6 @@ bib_error := condition( ) }, type = "error", + classes = "value_error", exports = "read_bib" ) diff --git a/R/diff-time.R b/R/diff-time.R index ad81f446..3a3b94b2 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -358,6 +358,7 @@ diff_time_error := condition( ) }, type = "error", + classes = "type_error", exports = "diff_time" ) @@ -373,6 +374,7 @@ diff_time_warning := condition( ) }, type = "warning", + classes = "value_warning", exports = "diff_time" ) @@ -380,6 +382,7 @@ numeric_datetime_tz := condition( "Date times cannot be numeric when tz is NULL", type = "error", exports = "diff_time", + classes = "type_error", help = "```r # Instead of this: diff_time(100, 200, tz = NULL) @@ -397,6 +400,7 @@ na_timezone_found := condition( paste("NA found in timezones; setting to default timezone:", default_tz()) }, type = "warning", + classes = "value_warning", exports = "diff_time" ) @@ -404,6 +408,7 @@ timezone_not_found := condition( function(x) paste0("Timezone(s) not found: ", collapse(x, sep = ", "), "\n"), type = "error", exports = "diff_time", + classes = "value_error", help = c( "When using a string for a timezone, this value must be found within", " `OlsonNames()`" @@ -413,6 +418,7 @@ timezone_not_found := condition( default_tz_value := condition( "Invalid value for default timezone", type = "error", + classes = "value_error", exports = "diff_time", help = c( "option(mark.default_tz) must be a character vector of length 1L,", diff --git a/R/directory.R b/R/directory.R index 45b8d942..e89b4f90 100644 --- a/R/directory.R +++ b/R/directory.R @@ -491,6 +491,7 @@ add_file_timestamp <- function( path_error := condition( "No recent file found", type = "error", + classes = "value_error", exports = "get_recent_file" ) @@ -522,6 +523,7 @@ path_warning := condition( ) }, type = "warning", + classes = "value_warning", exports = c("get_recent_file", "norm_path"), help = { "File creation cannot be performed when the path is an existing directory" diff --git a/R/expand.R b/R/expand.R index 82e35492..44bc7ddf 100644 --- a/R/expand.R +++ b/R/expand.R @@ -206,6 +206,7 @@ reindex(x, 'index', c(1, 2, 5, NA)) reindex_error := condition( "x[[index]] returned `NULL`", type = "error", + classes = "value_error", exports = "reindex" ) diff --git a/R/sourcing.R b/R/sourcing.R index d051c807..3b302595 100644 --- a/R/sourcing.R +++ b/R/sourcing.R @@ -336,6 +336,7 @@ source_error := condition( ) }, type = "error", + classes = "type_error", package = "mark", exports = c( "source_to_env", diff --git a/R/switch.R b/R/switch.R index 6ffd90c0..b7ec6620 100644 --- a/R/switch.R +++ b/R/switch.R @@ -289,5 +289,6 @@ switch_error := condition( result = "results must be of length 1L", stop(internal_error()), ) - } + }, + classes = "input_error" ) diff --git a/R/utils.R b/R/utils.R index 64988a91..5d8bd242 100644 --- a/R/utils.R +++ b/R/utils.R @@ -200,9 +200,10 @@ options_error := condition( switch( x, interactive = "mark.check_interactive must be TRUE, FALSE, or NA", - stop("something went wrong, bad value: ", x) + stop(internal_error(paste("bad value:", x))) ) }, + classes = "value_error", type = "error" ) @@ -258,5 +259,6 @@ duplicate_error := condition( " more" ) }, + classes = "value_error", type = "error" ) From f59ede4ce80a974cdfaaf9a250832a07fb0b2405 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 24 Feb 2026 23:47:02 -0500 Subject: [PATCH 145/169] renames and removes some conditions (#259) --- R/diff-time.R | 53 +++++------------------------------------ R/mark-cnd-conditions.R | 38 ++++++----------------------- 2 files changed, 13 insertions(+), 78 deletions(-) diff --git a/R/diff-time.R b/R/diff-time.R index 3a3b94b2..fcb553c1 100644 --- a/R/diff-time.R +++ b/R/diff-time.R @@ -100,7 +100,7 @@ extract_numeric_time <- function(x, tz) { if (is.null(tz)) { if (is.numeric(x)) { - stop(numeric_datetime_tz()) + stop(numeric_datetime_tz_error()) } gmt <- NULL @@ -144,7 +144,7 @@ to_numeric_with_tz <- function(x, tz) { nas <- is.na(tz) if (any(nas)) { - warning(na_timezone_found()) + warning(na_timezone_found_warning()) tz[nas] <- default_tz() } @@ -179,7 +179,7 @@ check_tz <- function(x) { bad <- ux %out% OlsonNames() if (any(bad)) { - stop(timezone_not_found(ux[bad])) + stop(timezone_not_found_error(ux[bad])) } invisible(NULL) @@ -350,35 +350,7 @@ sys_tz <- function(method = 1) { # TODO too many different condititons -- simplify -diff_time_error := condition( - function(s) { - switch( - s, - tz_null = "Date times cannot be numeric when tz is NULL", - ) - }, - type = "error", - classes = "type_error", - exports = "diff_time" -) - -diff_time_warning := condition( - function(s) { - switch( - s, - na_tz = paste( - "NA found in timezones; setting to default timezone:", - default_tz() - ), - stop(internal_error()) - ) - }, - type = "warning", - classes = "value_warning", - exports = "diff_time" -) - -numeric_datetime_tz := condition( +numeric_datetime_tz_error := condition( "Date times cannot be numeric when tz is NULL", type = "error", exports = "diff_time", @@ -395,7 +367,7 @@ diff_time(100, 200, tz = 0) ```" ) -na_timezone_found := condition( +na_timezone_found_warning := condition( function() { paste("NA found in timezones; setting to default timezone:", default_tz()) }, @@ -404,7 +376,7 @@ na_timezone_found := condition( exports = "diff_time" ) -timezone_not_found := condition( +timezone_not_found_error := condition( function(x) paste0("Timezone(s) not found: ", collapse(x, sep = ", "), "\n"), type = "error", exports = "diff_time", @@ -414,16 +386,3 @@ timezone_not_found := condition( " `OlsonNames()`" ) ) - -default_tz_value := condition( - "Invalid value for default timezone", - type = "error", - classes = "value_error", - exports = "diff_time", - help = c( - "option(mark.default_tz) must be a character vector of length 1L,", - " a function that returns a character vector of length 1L,", - " NULL (defaults to UTC),", - ' or "system" to set to system timezone' - ) -) diff --git a/R/mark-cnd-conditions.R b/R/mark-cnd-conditions.R index 92c05441..50f2b282 100644 --- a/R/mark-cnd-conditions.R +++ b/R/mark-cnd-conditions.R @@ -1,7 +1,7 @@ # % Generated by cnd: do not edit by hand #' @name mark-cnd-conditions -#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:bib_error mark:default_tz_value mark:description_version_error mark:diff_time_error mark:diff_time_warning mark:duplicate_error mark:expand_by_warning mark:fct_expand_seq_error mark:import_error mark:internal_error mark:list2df_warning mark:match_arg_no_match mark:match_param_error mark:md5_status mark:na_timezone_found mark:not_available_error mark:numeric_datetime_tz mark:options_error mark:path_error mark:path_warning mark:percentile_rank_weights_length mark:reindex_error mark:reindex_warning mark:remove_labels_error mark:source_error mark:switch_error mark:timezone_not_found mark:view_labels_error append_warning assign_labels_error base_conversion_error bib_error default_tz_value description_version_error diff_time_error diff_time_warning duplicate_error expand_by_warning fct_expand_seq_error import_error internal_error list2df_warning match_arg_no_match match_param_error md5_status na_timezone_found not_available_error numeric_datetime_tz options_error path_error path_warning percentile_rank_weights_length reindex_error reindex_warning remove_labels_error source_error switch_error timezone_not_found view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:bib_error/error mark:default_tz_value/error mark:description_version_error/error mark:diff_time_error/error mark:diff_time_warning/warning mark:duplicate_error/error mark:expand_by_warning/warning mark:fct_expand_seq_error/error mark:import_error/error mark:internal_error/error mark:list2df_warning/warning mark:match_arg_no_match/error mark:match_param_error/error mark:md5_status/condition mark:na_timezone_found/warning mark:not_available_error/error mark:numeric_datetime_tz/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:percentile_rank_weights_length/error mark:reindex_error/error mark:reindex_warning/warning mark:remove_labels_error/error mark:source_error/error mark:switch_error/condition mark:timezone_not_found/error mark:view_labels_error/error +#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:bib_error mark:description_version_error mark:duplicate_error mark:expand_by_warning mark:fct_expand_seq_error mark:import_error mark:internal_error mark:list2df_warning mark:match_arg_no_match mark:match_param_error mark:md5_status mark:na_timezone_found_warning mark:not_available_error mark:numeric_datetime_tz_error mark:options_error mark:path_error mark:path_warning mark:percentile_rank_weights_length mark:reindex_error mark:reindex_warning mark:remove_labels_error mark:source_error mark:switch_error mark:timezone_not_found_error mark:view_labels_error append_warning assign_labels_error base_conversion_error bib_error description_version_error duplicate_error expand_by_warning fct_expand_seq_error import_error internal_error list2df_warning match_arg_no_match match_param_error md5_status na_timezone_found_warning not_available_error numeric_datetime_tz_error options_error path_error path_warning percentile_rank_weights_length reindex_error reindex_warning remove_labels_error source_error switch_error timezone_not_found_error view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:bib_error/error mark:description_version_error/error mark:duplicate_error/error mark:expand_by_warning/warning mark:fct_expand_seq_error/error mark:import_error/error mark:internal_error/error mark:list2df_warning/warning mark:match_arg_no_match/error mark:match_param_error/error mark:md5_status/condition mark:na_timezone_found_warning/warning mark:not_available_error/error mark:numeric_datetime_tz_error/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:percentile_rank_weights_length/error mark:reindex_error/error mark:reindex_warning/warning mark:remove_labels_error/error mark:source_error/error mark:switch_error/condition mark:timezone_not_found_error/error mark:view_labels_error/error #' @title Conditions for `mark` #' #' @details @@ -71,14 +71,6 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:default_tz_value/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:default_tz_value`} -#' \item{type}{**error**} -#' } -#' option(mark.default_tz) must be a character vector of length 1L, a function that returns a character vector of length 1L, NULL (defaults to UTC), or "system" to set to system timezone -#' } #' \subsection{`mark:description_version_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} @@ -87,22 +79,6 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:diff_time_error/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:diff_time_error`} -#' \item{type}{**error**} -#' } -#' _no help documentation provided_ -#' } -#' \subsection{`mark:diff_time_warning/warning`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:diff_time_warning`} -#' \item{type}{**warning**} -#' } -#' _no help documentation provided_ -#' } #' \subsection{`mark:duplicate_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} @@ -187,10 +163,10 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:na_timezone_found/warning`}{ +#' \subsection{`mark:na_timezone_found_warning/warning`}{ #' \describe{ #' \item{package}{`{mark}`} -#' \item{class}{`mark:na_timezone_found`} +#' \item{class}{`mark:na_timezone_found_warning`} #' \item{type}{**warning**} #' } #' _no help documentation provided_ @@ -203,10 +179,10 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:numeric_datetime_tz/error`}{ +#' \subsection{`mark:numeric_datetime_tz_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} -#' \item{class}{`mark:numeric_datetime_tz`} +#' \item{class}{`mark:numeric_datetime_tz_error`} #' \item{type}{**error**} #' } #' ```r @@ -310,10 +286,10 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:timezone_not_found/error`}{ +#' \subsection{`mark:timezone_not_found_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} -#' \item{class}{`mark:timezone_not_found`} +#' \item{class}{`mark:timezone_not_found_error`} #' \item{type}{**error**} #' } #' When using a string for a timezone, this value must be found within `OlsonNames()` From 4eb6f545f7d19b7821b3636a55ea5617eac70b94 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Fri, 27 Feb 2026 21:46:39 -0500 Subject: [PATCH 146/169] corrects condition classes (#259) --- man/mark-cnd-conditions.Rd | 63 ++++++++------------------------- tests/testthat/test-diff-time.R | 12 +++---- 2 files changed, 21 insertions(+), 54 deletions(-) diff --git a/man/mark-cnd-conditions.Rd b/man/mark-cnd-conditions.Rd index 7e157b34..47c22e50 100644 --- a/man/mark-cnd-conditions.Rd +++ b/man/mark-cnd-conditions.Rd @@ -6,10 +6,7 @@ \alias{mark:assign_labels_error} \alias{mark:base_conversion_error} \alias{mark:bib_error} -\alias{mark:default_tz_value} \alias{mark:description_version_error} -\alias{mark:diff_time_error} -\alias{mark:diff_time_warning} \alias{mark:duplicate_error} \alias{mark:expand_by_warning} \alias{mark:fct_expand_seq_error} @@ -19,9 +16,9 @@ \alias{mark:match_arg_no_match} \alias{mark:match_param_error} \alias{mark:md5_status} -\alias{mark:na_timezone_found} +\alias{mark:na_timezone_found_warning} \alias{mark:not_available_error} -\alias{mark:numeric_datetime_tz} +\alias{mark:numeric_datetime_tz_error} \alias{mark:options_error} \alias{mark:path_error} \alias{mark:path_warning} @@ -31,16 +28,13 @@ \alias{mark:remove_labels_error} \alias{mark:source_error} \alias{mark:switch_error} -\alias{mark:timezone_not_found} +\alias{mark:timezone_not_found_error} \alias{mark:view_labels_error} \alias{append_warning} \alias{assign_labels_error} \alias{base_conversion_error} \alias{bib_error} -\alias{default_tz_value} \alias{description_version_error} -\alias{diff_time_error} -\alias{diff_time_warning} \alias{duplicate_error} \alias{expand_by_warning} \alias{fct_expand_seq_error} @@ -50,9 +44,9 @@ \alias{match_arg_no_match} \alias{match_param_error} \alias{md5_status} -\alias{na_timezone_found} +\alias{na_timezone_found_warning} \alias{not_available_error} -\alias{numeric_datetime_tz} +\alias{numeric_datetime_tz_error} \alias{options_error} \alias{path_error} \alias{path_warning} @@ -62,16 +56,13 @@ \alias{remove_labels_error} \alias{source_error} \alias{switch_error} -\alias{timezone_not_found} +\alias{timezone_not_found_error} \alias{view_labels_error} \alias{mark:append_warning/warning} \alias{mark:assign_labels_error/error} \alias{mark:base_conversion_error/error} \alias{mark:bib_error/error} -\alias{mark:default_tz_value/error} \alias{mark:description_version_error/error} -\alias{mark:diff_time_error/error} -\alias{mark:diff_time_warning/warning} \alias{mark:duplicate_error/error} \alias{mark:expand_by_warning/warning} \alias{mark:fct_expand_seq_error/error} @@ -81,9 +72,9 @@ \alias{mark:match_arg_no_match/error} \alias{mark:match_param_error/error} \alias{mark:md5_status/condition} -\alias{mark:na_timezone_found/warning} +\alias{mark:na_timezone_found_warning/warning} \alias{mark:not_available_error/error} -\alias{mark:numeric_datetime_tz/error} +\alias{mark:numeric_datetime_tz_error/error} \alias{mark:options_error/error} \alias{mark:path_error/error} \alias{mark:path_warning/warning} @@ -93,7 +84,7 @@ \alias{mark:remove_labels_error/error} \alias{mark:source_error/error} \alias{mark:switch_error/condition} -\alias{mark:timezone_not_found/error} +\alias{mark:timezone_not_found_error/error} \alias{mark:view_labels_error/error} \title{Conditions for \code{mark}} \description{ @@ -169,14 +160,6 @@ df <- remove_labels(df, 'b') } \emph{no help documentation provided} } -\subsection{\code{mark:default_tz_value/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:default_tz_value}} -\item{type}{\strong{error}} -} -option(mark.default_tz) must be a character vector of length 1L, a function that returns a character vector of length 1L, NULL (defaults to UTC), or "system" to set to system timezone -} \subsection{\code{mark:description_version_error/error}}{ \describe{ \item{package}{\code{{mark}}} @@ -185,22 +168,6 @@ option(mark.default_tz) must be a character vector of length 1L, a function that } \emph{no help documentation provided} } -\subsection{\code{mark:diff_time_error/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:diff_time_error}} -\item{type}{\strong{error}} -} -\emph{no help documentation provided} -} -\subsection{\code{mark:diff_time_warning/warning}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:diff_time_warning}} -\item{type}{\strong{warning}} -} -\emph{no help documentation provided} -} \subsection{\code{mark:duplicate_error/error}}{ \describe{ \item{package}{\code{{mark}}} @@ -285,10 +252,10 @@ Generic error to capture internal \code{{mark}} errors. If any of these are enc } \emph{no help documentation provided} } -\subsection{\code{mark:na_timezone_found/warning}}{ +\subsection{\code{mark:na_timezone_found_warning/warning}}{ \describe{ \item{package}{\code{{mark}}} -\item{class}{\code{mark:na_timezone_found}} +\item{class}{\code{mark:na_timezone_found_warning}} \item{type}{\strong{warning}} } \emph{no help documentation provided} @@ -301,10 +268,10 @@ Generic error to capture internal \code{{mark}} errors. If any of these are enc } \emph{no help documentation provided} } -\subsection{\code{mark:numeric_datetime_tz/error}}{ +\subsection{\code{mark:numeric_datetime_tz_error/error}}{ \describe{ \item{package}{\code{{mark}}} -\item{class}{\code{mark:numeric_datetime_tz}} +\item{class}{\code{mark:numeric_datetime_tz_error}} \item{type}{\strong{error}} } @@ -409,10 +376,10 @@ reindex(x, 'index', c(1, 2, 5, NA)) } \emph{no help documentation provided} } -\subsection{\code{mark:timezone_not_found/error}}{ +\subsection{\code{mark:timezone_not_found_error/error}}{ \describe{ \item{package}{\code{{mark}}} -\item{class}{\code{mark:timezone_not_found}} +\item{class}{\code{mark:timezone_not_found_error}} \item{type}{\strong{error}} } When using a string for a timezone, this value must be found within \code{OlsonNames()} diff --git a/tests/testthat/test-diff-time.R b/tests/testthat/test-diff-time.R index c27887af..83e65569 100644 --- a/tests/testthat/test-diff-time.R +++ b/tests/testthat/test-diff-time.R @@ -71,7 +71,8 @@ test_that("Timezones", { # No difference expect_identical( - with(dftz, diff_time_hours(a, b)), rep(0, 4), + with(dftz, diff_time_hours(a, b)), + rep(0, 4), ignore_attr = TRUE ) @@ -152,19 +153,19 @@ test_that("Timezones", { expect_warning( diff_time(Sys.Date(), Sys.Date(), tzx = NA, tzy = "GMT"), - class = "mark:na_timezone_found" + class = "mark:na_timezone_found_warning" ) }) test_that("Error checking", { expect_error( diff_time_secs(1:10, 1:10), - class = "mark:numeric_datetime_tz" + class = "mark:numeric_datetime_tz_error" ) expect_error( diff_time_secs(st, st, "Not good"), - class = "mark:timezone_not_found" + class = "mark:timezone_not_found_error" ) # Don't throw error because of NA tz @@ -176,7 +177,6 @@ test_that("Error checking", { }) test_that("class coehersion", { - expect_identical( diff_time(as.Date("2021-07-26"), "2021-07-26"), diff_time(as.Date("2021-07-26"), as.Date("2021-07-26")) @@ -190,7 +190,7 @@ test_that("class coehersion", { expect_warning( to_numeric_with_tz("2021-01-01", NA), - class = "mark:na_timezone_found" + class = "mark:na_timezone_found_warning" ) expect_identical(check_tz(NULL), NULL) From 0c5b4fa01fdfe0ef02d32b603276eebbfb15526f Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Fri, 27 Feb 2026 21:52:38 -0500 Subject: [PATCH 147/169] updates match errors (#259) --- R/match-arg.R | 11 ++++++++--- tests/testthat/test-match-arg.R | 4 ++-- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/R/match-arg.R b/R/match-arg.R index 46200984..5e637734 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -30,7 +30,12 @@ #' try(foo(1, 0)) #' @export match_arg <- function(x, table) { - .Deprecated("match_param()") + warning(deprecated_warning( + deprecated = "mark::match_arg()", + replacement = "mark::match_param()", + version = "0.10.0" + )) + if (is.null(x)) { return(NULL) } @@ -45,7 +50,7 @@ match_arg <- function(x, table) { if (!length(out)) { csx <- as.character(substitute(x)) - stop(match_arg_no_match(csx, x, table)) + stop(match_arg_error(csx, x, table)) } out @@ -232,7 +237,7 @@ cleanup_param_list <- function(x) { # conditions -------------------------------------------------------------- # TODO remove -match_arg_no_match := condition( +match_arg_error := condition( message = function(csx, x, table) { sprintf( "%s : '%s' did not match of of the following:\n '%s'", diff --git a/tests/testthat/test-match-arg.R b/tests/testthat/test-match-arg.R index 8bd66c4b..533e0314 100644 --- a/tests/testthat/test-match-arg.R +++ b/tests/testthat/test-match-arg.R @@ -78,13 +78,13 @@ test_that("match_param() accepts can return multiple", { test_that("match_arg() works", { foo <- function(x = c("a", "b"), table) { - suppressWarnings(match_arg(x, table), "deprecatedWarning") + suppressWarnings(match_arg(x, table), "deprecated_warning") } expect_null(foo(NULL)) expect_identical(foo(), "a") expect_identical(foo(table = "a"), "a") - expect_error(foo(table = "c"), class = "mark:match_arg_no_match") + expect_error(foo(table = "c"), class = "mark:match_arg_error") }) test_that("match_param() accepts multiple [#104]", { From cc4c73ed2773b37742923d669ce28ec520816f73 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Fri, 27 Feb 2026 21:52:44 -0500 Subject: [PATCH 148/169] removes unused conditions (#259) --- R/percentile-rank.R | 7 ------- 1 file changed, 7 deletions(-) diff --git a/R/percentile-rank.R b/R/percentile-rank.R index b4183bd4..3a7ad5b6 100644 --- a/R/percentile-rank.R +++ b/R/percentile-rank.R @@ -93,10 +93,3 @@ do_percentile_rank <- function(u, w) { out[ok] <- res out } - -# conditions -------------------------------------------------------------- - -percentile_rank_weights_length := condition( - message = "length(weights) must be 1L or equal to length(x)", - type = "error" -) From ae58ead0ad528b48b8ceaa0878b0427e9fb98b7c Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 28 Feb 2026 11:19:01 -0500 Subject: [PATCH 149/169] updates md5 condition (#259) --- R/file.R | 6 +++--- R/mark-cnd-conditions.R | 18 +++++------------- man/mark-cnd-conditions.Rd | 31 ++++++++++--------------------- man/reexports.Rd | 2 +- tests/testthat/test-file.R | 8 ++++---- 5 files changed, 23 insertions(+), 42 deletions(-) diff --git a/R/file.R b/R/file.R index a6e04170..2008555a 100644 --- a/R/file.R +++ b/R/file.R @@ -16,7 +16,7 @@ file_copy_md5 <- function(path, new_path, overwrite = NA, quiet = FALSE) { } else if (utils::packageVersion("fuj") < "0.2.2") { function(...) cat(..., "\n") } else { - function(...) cnd(md5_status(.makeMessage(...))) + function(...) cnd(md5_condition(...)) } # not as pretty, but pretty reasonable @@ -50,7 +50,7 @@ file_copy_md5 <- function(path, new_path, overwrite = NA, quiet = FALSE) { invisible(new_path) } -md5_status := condition( - function(x) x, +md5_condition := condition( + function(...) paste(..., collapse = ""), exports = "file_copy_md5" ) diff --git a/R/mark-cnd-conditions.R b/R/mark-cnd-conditions.R index 50f2b282..55d94a91 100644 --- a/R/mark-cnd-conditions.R +++ b/R/mark-cnd-conditions.R @@ -1,7 +1,7 @@ # % Generated by cnd: do not edit by hand #' @name mark-cnd-conditions -#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:bib_error mark:description_version_error mark:duplicate_error mark:expand_by_warning mark:fct_expand_seq_error mark:import_error mark:internal_error mark:list2df_warning mark:match_arg_no_match mark:match_param_error mark:md5_status mark:na_timezone_found_warning mark:not_available_error mark:numeric_datetime_tz_error mark:options_error mark:path_error mark:path_warning mark:percentile_rank_weights_length mark:reindex_error mark:reindex_warning mark:remove_labels_error mark:source_error mark:switch_error mark:timezone_not_found_error mark:view_labels_error append_warning assign_labels_error base_conversion_error bib_error description_version_error duplicate_error expand_by_warning fct_expand_seq_error import_error internal_error list2df_warning match_arg_no_match match_param_error md5_status na_timezone_found_warning not_available_error numeric_datetime_tz_error options_error path_error path_warning percentile_rank_weights_length reindex_error reindex_warning remove_labels_error source_error switch_error timezone_not_found_error view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:bib_error/error mark:description_version_error/error mark:duplicate_error/error mark:expand_by_warning/warning mark:fct_expand_seq_error/error mark:import_error/error mark:internal_error/error mark:list2df_warning/warning mark:match_arg_no_match/error mark:match_param_error/error mark:md5_status/condition mark:na_timezone_found_warning/warning mark:not_available_error/error mark:numeric_datetime_tz_error/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:percentile_rank_weights_length/error mark:reindex_error/error mark:reindex_warning/warning mark:remove_labels_error/error mark:source_error/error mark:switch_error/condition mark:timezone_not_found_error/error mark:view_labels_error/error +#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:bib_error mark:description_version_error mark:duplicate_error mark:expand_by_warning mark:fct_expand_seq_error mark:import_error mark:internal_error mark:list2df_warning mark:match_arg_error mark:match_param_error mark:md5_condition mark:na_timezone_found_warning mark:not_available_error mark:numeric_datetime_tz_error mark:options_error mark:path_error mark:path_warning mark:reindex_error mark:reindex_warning mark:remove_labels_error mark:source_error mark:switch_error mark:timezone_not_found_error mark:view_labels_error append_warning assign_labels_error base_conversion_error bib_error description_version_error duplicate_error expand_by_warning fct_expand_seq_error import_error internal_error list2df_warning match_arg_error match_param_error md5_condition na_timezone_found_warning not_available_error numeric_datetime_tz_error options_error path_error path_warning reindex_error reindex_warning remove_labels_error source_error switch_error timezone_not_found_error view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:bib_error/error mark:description_version_error/error mark:duplicate_error/error mark:expand_by_warning/warning mark:fct_expand_seq_error/error mark:import_error/error mark:internal_error/error mark:list2df_warning/warning mark:match_arg_error/error mark:match_param_error/error mark:md5_condition/condition mark:na_timezone_found_warning/warning mark:not_available_error/error mark:numeric_datetime_tz_error/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:reindex_error/error mark:reindex_warning/warning mark:remove_labels_error/error mark:source_error/error mark:switch_error/condition mark:timezone_not_found_error/error mark:view_labels_error/error #' @title Conditions for `mark` #' #' @details @@ -139,10 +139,10 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:match_arg_no_match/error`}{ +#' \subsection{`mark:match_arg_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} -#' \item{class}{`mark:match_arg_no_match`} +#' \item{class}{`mark:match_arg_error`} #' \item{type}{**error**} #' } #' _no help documentation provided_ @@ -155,10 +155,10 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:md5_status/condition`}{ +#' \subsection{`mark:md5_condition/condition`}{ #' \describe{ #' \item{package}{`{mark}`} -#' \item{class}{`mark:md5_status`} +#' \item{class}{`mark:md5_condition`} #' \item{type}{**condition**} #' } #' _no help documentation provided_ @@ -220,14 +220,6 @@ #' } #' File creation cannot be performed when the path is an existing directory #' } -#' \subsection{`mark:percentile_rank_weights_length/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:percentile_rank_weights_length`} -#' \item{type}{**error**} -#' } -#' _no help documentation provided_ -#' } #' \subsection{`mark:reindex_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} diff --git a/man/mark-cnd-conditions.Rd b/man/mark-cnd-conditions.Rd index 47c22e50..28ccb572 100644 --- a/man/mark-cnd-conditions.Rd +++ b/man/mark-cnd-conditions.Rd @@ -13,16 +13,15 @@ \alias{mark:import_error} \alias{mark:internal_error} \alias{mark:list2df_warning} -\alias{mark:match_arg_no_match} +\alias{mark:match_arg_error} \alias{mark:match_param_error} -\alias{mark:md5_status} +\alias{mark:md5_condition} \alias{mark:na_timezone_found_warning} \alias{mark:not_available_error} \alias{mark:numeric_datetime_tz_error} \alias{mark:options_error} \alias{mark:path_error} \alias{mark:path_warning} -\alias{mark:percentile_rank_weights_length} \alias{mark:reindex_error} \alias{mark:reindex_warning} \alias{mark:remove_labels_error} @@ -41,16 +40,15 @@ \alias{import_error} \alias{internal_error} \alias{list2df_warning} -\alias{match_arg_no_match} +\alias{match_arg_error} \alias{match_param_error} -\alias{md5_status} +\alias{md5_condition} \alias{na_timezone_found_warning} \alias{not_available_error} \alias{numeric_datetime_tz_error} \alias{options_error} \alias{path_error} \alias{path_warning} -\alias{percentile_rank_weights_length} \alias{reindex_error} \alias{reindex_warning} \alias{remove_labels_error} @@ -69,16 +67,15 @@ \alias{mark:import_error/error} \alias{mark:internal_error/error} \alias{mark:list2df_warning/warning} -\alias{mark:match_arg_no_match/error} +\alias{mark:match_arg_error/error} \alias{mark:match_param_error/error} -\alias{mark:md5_status/condition} +\alias{mark:md5_condition/condition} \alias{mark:na_timezone_found_warning/warning} \alias{mark:not_available_error/error} \alias{mark:numeric_datetime_tz_error/error} \alias{mark:options_error/error} \alias{mark:path_error/error} \alias{mark:path_warning/warning} -\alias{mark:percentile_rank_weights_length/error} \alias{mark:reindex_error/error} \alias{mark:reindex_warning/warning} \alias{mark:remove_labels_error/error} @@ -228,10 +225,10 @@ Generic error to capture internal \code{{mark}} errors. If any of these are enc } \emph{no help documentation provided} } -\subsection{\code{mark:match_arg_no_match/error}}{ +\subsection{\code{mark:match_arg_error/error}}{ \describe{ \item{package}{\code{{mark}}} -\item{class}{\code{mark:match_arg_no_match}} +\item{class}{\code{mark:match_arg_error}} \item{type}{\strong{error}} } \emph{no help documentation provided} @@ -244,10 +241,10 @@ Generic error to capture internal \code{{mark}} errors. If any of these are enc } \emph{no help documentation provided} } -\subsection{\code{mark:md5_status/condition}}{ +\subsection{\code{mark:md5_condition/condition}}{ \describe{ \item{package}{\code{{mark}}} -\item{class}{\code{mark:md5_status}} +\item{class}{\code{mark:md5_condition}} \item{type}{\strong{condition}} } \emph{no help documentation provided} @@ -310,14 +307,6 @@ diff_time(100, 200, tz = 0) } File creation cannot be performed when the path is an existing directory } -\subsection{\code{mark:percentile_rank_weights_length/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:percentile_rank_weights_length}} -\item{type}{\strong{error}} -} -\emph{no help documentation provided} -} \subsection{\code{mark:reindex_error/error}}{ \describe{ \item{package}{\code{{mark}}} diff --git a/man/reexports.Rd b/man/reexports.Rd index eb1029f6..e31cd8b3 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} diff --git a/tests/testthat/test-file.R b/tests/testthat/test-file.R index 00ca9bb7..3c64210d 100644 --- a/tests/testthat/test-file.R +++ b/tests/testthat/test-file.R @@ -10,18 +10,18 @@ muffle_cnd_conditions(test_that("file_copy_md5() works", { # none of y exists expect_condition( file_copy_md5(x, y, overwrite = FALSE), - class = "mark:md5_status" + class = "mark:md5_condition" ) expect_condition( file_copy_md5(x, y, overwrite = FALSE), - class = "mark:md5_status" + class = "mark:md5_condition" ) # all of y exists expect_condition( file_copy_md5(x, y, overwrite = TRUE), - class = "mark:md5_status" + class = "mark:md5_condition" ) # mix @@ -33,7 +33,7 @@ muffle_cnd_conditions(test_that("file_copy_md5() works", { attr(file_copy_md5(x, y), "changed"), c(FALSE, TRUE, NA) ), - class = "mark:md5_status", + class = "mark:md5_condition", regexp = paste( "one", "md5 same", From 62fb704c4680a3a7aa591337a2572f67e910eb15 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 4 Mar 2026 22:38:36 -0500 Subject: [PATCH 150/169] adds classes (#259) --- R/dataframes.R | 1 + R/description.R | 1 + R/fct-expand-seq.R | 2 ++ R/file.R | 8 +++++++- R/import.R | 1 + R/labels.R | 1 + R/match-arg.R | 4 +++- R/not-available.R | 3 ++- R/sourcing.R | 2 +- R/switch.R | 2 +- R/utils.R | 2 +- 11 files changed, 21 insertions(+), 6 deletions(-) diff --git a/R/dataframes.R b/R/dataframes.R index 2587e0b3..7bdc6fc2 100644 --- a/R/dataframes.R +++ b/R/dataframes.R @@ -285,5 +285,6 @@ list2df_warning := condition( ) }, type = "warning", + classes = "class_warning", exports = "list2df" ) diff --git a/R/description.R b/R/description.R index 0571f020..ca8c0f1f 100644 --- a/R/description.R +++ b/R/description.R @@ -234,5 +234,6 @@ today_as_version <- function(zero = FALSE) { description_version_error := condition( "Multiple version lines found in DESCRIPTION", type = "error", + classes = "value_error", exports = c("get_version", "update_version") ) diff --git a/R/fct-expand-seq.R b/R/fct-expand-seq.R index dacffe76..c4c5bbf8 100644 --- a/R/fct-expand-seq.R +++ b/R/fct-expand-seq.R @@ -60,8 +60,10 @@ fct_expand_seq <- function( # condition --------------------------------------------------------------- +# TODO use na_error() fct_expand_seq_error := condition( function(x = c("min", "max")) paste0(match_param(x), "_lvl cannot be `NA`"), type = "error", + classes = "na_error", exports = "fct_expand_seq" ) diff --git a/R/file.R b/R/file.R index 2008555a..8a672712 100644 --- a/R/file.R +++ b/R/file.R @@ -52,5 +52,11 @@ file_copy_md5 <- function(path, new_path, overwrite = NA, quiet = FALSE) { md5_condition := condition( function(...) paste(..., collapse = ""), - exports = "file_copy_md5" + type = "condition", + exports = "file_copy_md5", + help = " +Produces messages on md5 checks when `file_copy_md5(quiet = FALSE)`. +The message will indicate whether the file was new, or if the md5 hash was the same or different. +When `quiet = TRUE`, no messages will be produced. +" ) diff --git a/R/import.R b/R/import.R index 35c559d1..15284834 100644 --- a/R/import.R +++ b/R/import.R @@ -30,6 +30,7 @@ import_error := condition( message = function(fun) sprintf("'%s' has already been assigned", fun), type = "error", exports = "import", + classes = "value_error", # NOTE maybe assign_error()? help = " The object you are trying to import has already been assigned in the environment you are importing to. Use the `overwrite` option to replace the object. diff --git a/R/labels.R b/R/labels.R index 7a5dcb04..0b01beb4 100644 --- a/R/labels.R +++ b/R/labels.R @@ -215,6 +215,7 @@ assign_labels_error := condition( }, type = "error", exports = c("assign_labels", "remove_labels"), + classes = "value_error", # NOTE maybe assign_error()? # nolint start: line_length_linter. help = r"( `assign_labels_error` diff --git a/R/match-arg.R b/R/match-arg.R index 5e637734..87c813b8 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -246,7 +246,8 @@ match_arg_error := condition( table ) }, - type = "error" + type = "error", + classes = "input_error" ) match_param_error := condition( @@ -301,5 +302,6 @@ match_param_error := condition( ) }, type = "error", + classes = "input_error", exports = "match_param" ) diff --git a/R/not-available.R b/R/not-available.R index 5a1a4540..99b70ada 100644 --- a/R/not-available.R +++ b/R/not-available.R @@ -92,5 +92,6 @@ not_available_error := condition( stop(internal_error()) ) }, - type = "error" + type = "error", + classes = "value_error" ) diff --git a/R/sourcing.R b/R/sourcing.R index 3b302595..6b7db91b 100644 --- a/R/sourcing.R +++ b/R/sourcing.R @@ -336,7 +336,7 @@ source_error := condition( ) }, type = "error", - classes = "type_error", + classes = "value_error", package = "mark", exports = c( "source_to_env", diff --git a/R/switch.R b/R/switch.R index b7ec6620..dc8ce03a 100644 --- a/R/switch.R +++ b/R/switch.R @@ -290,5 +290,5 @@ switch_error := condition( stop(internal_error()), ) }, - classes = "input_error" + classes = "value_error" ) diff --git a/R/utils.R b/R/utils.R index 5d8bd242..ba04fd0f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -203,7 +203,7 @@ options_error := condition( stop(internal_error(paste("bad value:", x))) ) }, - classes = "value_error", + classes = "input_error", type = "error" ) From 5a46bcb2c93686af38fac80188cafe1d84290456 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 4 Mar 2026 22:38:42 -0500 Subject: [PATCH 151/169] simplifies errors (#259) --- R/bib.R | 31 ++++++++----------------------- R/expand.R | 14 ++++---------- R/labels.R | 15 --------------- R/mark-cnd-conditions.R | 38 ++++---------------------------------- R/match-arg.R | 6 +----- R/not-available.R | 25 +++++++++++-------------- R/sourcing.R | 4 ++-- R/utils.R | 27 +++------------------------ 8 files changed, 33 insertions(+), 127 deletions(-) diff --git a/R/bib.R b/R/bib.R index 2569b41f..5fb50e86 100644 --- a/R/bib.R +++ b/R/bib.R @@ -70,7 +70,7 @@ read_bib <- function(file, skip = 0L, max_lines = NULL, encoding = "UTF-8") { from <- grep("[@]", bib) if (!length(from)) { - stop(bib_error("no_entries")) + stop(value_error("No entries detected in bib file")) } # shift over (may contain white space?) @@ -160,7 +160,13 @@ process_bib_dataframe <- function(categories, values, fields, keys) { bad <- lens > 1L if (any(bad)) { - stop(bib_error("duplicate_categories", key, names(lens)[bad])) + stop(duplicate_error( + sprintf( + "The key `%s` has duplicate categories of `%s`", + key, + names(lens)[bad] + ) + )) } # Append vectors @@ -299,24 +305,3 @@ print.mark_bib_df <- function(x, list = FALSE, ...) { invisible(x) } - - -# conditions -------------------------------------------------------------- - -bib_error := condition( - function(s, key, categories) { - switch( - s, - no_entries = "No entries detected in bib file", - duplicate_categories = sprintf( - "The key `%s` has duplicate categories of `%s`", - key, - categories - ), - stop(internal_error()) - ) - }, - type = "error", - classes = "value_error", - exports = "read_bib" -) diff --git a/R/expand.R b/R/expand.R index 44bc7ddf..970ae869 100644 --- a/R/expand.R +++ b/R/expand.R @@ -149,11 +149,10 @@ reindex <- function( unique_name_check <- function(x) { # Checks that names are unique in the vector nm <- names(x) %||% x - lens <- counts(nm) - int <- lens > 1L + dupes <- duplicated(nm) - if (any(int)) { - warning(expand_by_warning(names(lens[int]))) + if (any(dupes)) { + warning(duplicate_warning(x = nm, name = "names")) FALSE } else { TRUE @@ -162,12 +161,7 @@ unique_name_check <- function(x) { # conditions -------------------------------------------------------------- -expand_by_warning := condition( - function(x) paste0("These names are duplicated:", toString(x)), - type = "warning", - exports = "expand_by" -) - +# TODO use na_warning(); move information to function docs reindex_warning := condition( function(x) { paste( diff --git a/R/labels.R b/R/labels.R index 0b01beb4..0631df7a 100644 --- a/R/labels.R +++ b/R/labels.R @@ -259,18 +259,3 @@ view_labels_error := condition( ' `utils::View(get_labels(x), title = "Labels")`' ) ) - -remove_labels_error := condition( - function(x) { - sprintf( - ngettext( - length(x), - "Column not found in data.frame: %s", - "Columns not found in data.frame: %s" - ), - toString(x) - ) - }, - type = "error", - exports = "remove_labels" -) diff --git a/R/mark-cnd-conditions.R b/R/mark-cnd-conditions.R index 55d94a91..540bda6d 100644 --- a/R/mark-cnd-conditions.R +++ b/R/mark-cnd-conditions.R @@ -1,7 +1,7 @@ # % Generated by cnd: do not edit by hand #' @name mark-cnd-conditions -#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:bib_error mark:description_version_error mark:duplicate_error mark:expand_by_warning mark:fct_expand_seq_error mark:import_error mark:internal_error mark:list2df_warning mark:match_arg_error mark:match_param_error mark:md5_condition mark:na_timezone_found_warning mark:not_available_error mark:numeric_datetime_tz_error mark:options_error mark:path_error mark:path_warning mark:reindex_error mark:reindex_warning mark:remove_labels_error mark:source_error mark:switch_error mark:timezone_not_found_error mark:view_labels_error append_warning assign_labels_error base_conversion_error bib_error description_version_error duplicate_error expand_by_warning fct_expand_seq_error import_error internal_error list2df_warning match_arg_error match_param_error md5_condition na_timezone_found_warning not_available_error numeric_datetime_tz_error options_error path_error path_warning reindex_error reindex_warning remove_labels_error source_error switch_error timezone_not_found_error view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:bib_error/error mark:description_version_error/error mark:duplicate_error/error mark:expand_by_warning/warning mark:fct_expand_seq_error/error mark:import_error/error mark:internal_error/error mark:list2df_warning/warning mark:match_arg_error/error mark:match_param_error/error mark:md5_condition/condition mark:na_timezone_found_warning/warning mark:not_available_error/error mark:numeric_datetime_tz_error/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:reindex_error/error mark:reindex_warning/warning mark:remove_labels_error/error mark:source_error/error mark:switch_error/condition mark:timezone_not_found_error/error mark:view_labels_error/error +#' @aliases mark-cnd-conditions mark:append_warning mark:assign_labels_error mark:base_conversion_error mark:description_version_error mark:fct_expand_seq_error mark:import_error mark:internal_error mark:list2df_warning mark:match_arg_error mark:match_param_error mark:md5_condition mark:na_timezone_found_warning mark:not_available_error mark:numeric_datetime_tz_error mark:options_error mark:path_error mark:path_warning mark:reindex_error mark:reindex_warning mark:source_error mark:switch_error mark:timezone_not_found_error mark:view_labels_error append_warning assign_labels_error base_conversion_error description_version_error fct_expand_seq_error import_error internal_error list2df_warning match_arg_error match_param_error md5_condition na_timezone_found_warning not_available_error numeric_datetime_tz_error options_error path_error path_warning reindex_error reindex_warning source_error switch_error timezone_not_found_error view_labels_error mark:append_warning/warning mark:assign_labels_error/error mark:base_conversion_error/error mark:description_version_error/error mark:fct_expand_seq_error/error mark:import_error/error mark:internal_error/error mark:list2df_warning/warning mark:match_arg_error/error mark:match_param_error/error mark:md5_condition/condition mark:na_timezone_found_warning/warning mark:not_available_error/error mark:numeric_datetime_tz_error/error mark:options_error/error mark:path_error/error mark:path_warning/warning mark:reindex_error/error mark:reindex_warning/warning mark:source_error/error mark:switch_error/condition mark:timezone_not_found_error/error mark:view_labels_error/error #' @title Conditions for `mark` #' #' @details @@ -63,14 +63,6 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:bib_error/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:bib_error`} -#' \item{type}{**error**} -#' } -#' _no help documentation provided_ -#' } #' \subsection{`mark:description_version_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} @@ -79,22 +71,6 @@ #' } #' _no help documentation provided_ #' } -#' \subsection{`mark:duplicate_error/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:duplicate_error`} -#' \item{type}{**error**} -#' } -#' _no help documentation provided_ -#' } -#' \subsection{`mark:expand_by_warning/warning`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:expand_by_warning`} -#' \item{type}{**warning**} -#' } -#' _no help documentation provided_ -#' } #' \subsection{`mark:fct_expand_seq_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} @@ -161,7 +137,9 @@ #' \item{class}{`mark:md5_condition`} #' \item{type}{**condition**} #' } -#' _no help documentation provided_ +#' Produces messages on md5 checks when `file_copy_md5(quiet = FALSE)`. +#' The message will indicate whether the file was new, or if the md5 hash was the same or different. +#' When `quiet = TRUE`, no messages will be produced. #' } #' \subsection{`mark:na_timezone_found_warning/warning`}{ #' \describe{ @@ -254,14 +232,6 @@ #' #> NA #' ``` #' } -#' \subsection{`mark:remove_labels_error/error`}{ -#' \describe{ -#' \item{package}{`{mark}`} -#' \item{class}{`mark:remove_labels_error`} -#' \item{type}{**error**} -#' } -#' _no help documentation provided_ -#' } #' \subsection{`mark:source_error/error`}{ #' \describe{ #' \item{package}{`{mark}`} diff --git a/R/match-arg.R b/R/match-arg.R index 87c813b8..85952336 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -172,11 +172,7 @@ match_param <- function( ) } - # TODO use duplicate_error() - stop(input_error(paste0( - "duplicate values found in `choices`:\n ", - to_choices(choices) - ))) + stop(duplicate_error(x = choices)) } fun <- if (partial) pmatch else match diff --git a/R/not-available.R b/R/not-available.R index 99b70ada..d58b6d55 100644 --- a/R/not-available.R +++ b/R/not-available.R @@ -40,11 +40,14 @@ get_not_available <- function(type = NULL) { out <- get_na_list()[[type]] if (is.null(out)) { - stop(not_available_error("not_found", type)) + stop(not_available_error(type)) } if (is.function(out) || is.call(out)) { - stop(not_available_error("invalid")) + stop(class_error(sprintf( + "Type '%s' cannot be set to class 'function' or 'call'", + type + ))) } out @@ -77,19 +80,13 @@ delayedAssign("NA_POSIXlt_", not_available("logical", 1L)) # conditions -------------------------------------------------------------- not_available_error := condition( - function(s, x) { - switch( - s, - not_found = sprintf( - paste0( - "\"%s\" not found\n", - "Can be set with `mark::set_not_available(%s, value = .)`" - ), - x, - x + function(x) { + sprintf( + paste0( + "\"%1$s\" not found\n", + "Can be set with `mark::set_not_available(%1$s, value = .)`" ), - invalid = "type is not valid", - stop(internal_error()) + x ) }, type = "error", diff --git a/R/sourcing.R b/R/sourcing.R index 6b7db91b..82017bc7 100644 --- a/R/sourcing.R +++ b/R/sourcing.R @@ -101,7 +101,7 @@ try_ksource <- function(file, ...) { eval_named_chunk <- function(rmd_file, label_name) { if (!grepl("\\.[Rr][Mm][Dd]$", rmd_file)) { - stop(source_error("rmd")) + stop(input_error("rmd_file does not appear to be an rmd file: ", rmd_file)) } lines <- readLines(rmd_file) @@ -319,8 +319,8 @@ source_error := condition( function(x, params = NULL) { switch( x, - rmd = "rmd_file does not appear to be an rmd file", label = "label not found in .Rmd file", + # NOTE maybe 'source' is a different type of error source = paste0( "RDS file not succesfully saved here:\n ", params$file, diff --git a/R/utils.R b/R/utils.R index ba04fd0f..12c419ff 100644 --- a/R/utils.R +++ b/R/utils.R @@ -233,32 +233,11 @@ has_char <- function(x) { dupe_check <- function(x, n = getOption("mark.dupe.n", 5)) { n <- as.integer(n) + dupes <- duplicated(x) - dupes <- which(duplicated(x)) - n_dupes <- length(dupes) - dupes <- utils::head(dupes, n) - - if (n_dupes) { - stop(duplicate_error(x, dupes, n_dupes, n)) + if (any(dupes)) { + stop(duplicate_error(x = x, positions = which(dupes))) } invisible(NULL) } - -# TODO maybe as a subclass of value_error? -duplicate_error := condition( - function(x, dupes, n_dupes, n) { - paste0( - "Duplicate values found in ", - n_dupes, - " location(s) :\n", - if (n_dupes > n) sprintf("(first %i)\n", n), - paste0(" > ", sprintf("[%s] %s", format(dupes), format(x[dupes])), "\n"), - if (n_dupes > n) "... and ", - n_dupes - n, - " more" - ) - }, - classes = "value_error", - type = "error" -) From 08c267d31032ed017ec4c4a2def770d277224aba Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 4 Mar 2026 22:38:47 -0500 Subject: [PATCH 152/169] redocs (#259) --- man/mark-cnd-conditions.Rd | 48 +++----------------------------------- man/reexports.Rd | 2 +- 2 files changed, 4 insertions(+), 46 deletions(-) diff --git a/man/mark-cnd-conditions.Rd b/man/mark-cnd-conditions.Rd index 28ccb572..491f3c29 100644 --- a/man/mark-cnd-conditions.Rd +++ b/man/mark-cnd-conditions.Rd @@ -5,10 +5,7 @@ \alias{mark:append_warning} \alias{mark:assign_labels_error} \alias{mark:base_conversion_error} -\alias{mark:bib_error} \alias{mark:description_version_error} -\alias{mark:duplicate_error} -\alias{mark:expand_by_warning} \alias{mark:fct_expand_seq_error} \alias{mark:import_error} \alias{mark:internal_error} @@ -24,7 +21,6 @@ \alias{mark:path_warning} \alias{mark:reindex_error} \alias{mark:reindex_warning} -\alias{mark:remove_labels_error} \alias{mark:source_error} \alias{mark:switch_error} \alias{mark:timezone_not_found_error} @@ -32,10 +28,7 @@ \alias{append_warning} \alias{assign_labels_error} \alias{base_conversion_error} -\alias{bib_error} \alias{description_version_error} -\alias{duplicate_error} -\alias{expand_by_warning} \alias{fct_expand_seq_error} \alias{import_error} \alias{internal_error} @@ -51,7 +44,6 @@ \alias{path_warning} \alias{reindex_error} \alias{reindex_warning} -\alias{remove_labels_error} \alias{source_error} \alias{switch_error} \alias{timezone_not_found_error} @@ -59,10 +51,7 @@ \alias{mark:append_warning/warning} \alias{mark:assign_labels_error/error} \alias{mark:base_conversion_error/error} -\alias{mark:bib_error/error} \alias{mark:description_version_error/error} -\alias{mark:duplicate_error/error} -\alias{mark:expand_by_warning/warning} \alias{mark:fct_expand_seq_error/error} \alias{mark:import_error/error} \alias{mark:internal_error/error} @@ -78,7 +67,6 @@ \alias{mark:path_warning/warning} \alias{mark:reindex_error/error} \alias{mark:reindex_warning/warning} -\alias{mark:remove_labels_error/error} \alias{mark:source_error/error} \alias{mark:switch_error/condition} \alias{mark:timezone_not_found_error/error} @@ -149,14 +137,6 @@ df <- remove_labels(df, 'b') } \emph{no help documentation provided} } -\subsection{\code{mark:bib_error/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:bib_error}} -\item{type}{\strong{error}} -} -\emph{no help documentation provided} -} \subsection{\code{mark:description_version_error/error}}{ \describe{ \item{package}{\code{{mark}}} @@ -165,22 +145,6 @@ df <- remove_labels(df, 'b') } \emph{no help documentation provided} } -\subsection{\code{mark:duplicate_error/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:duplicate_error}} -\item{type}{\strong{error}} -} -\emph{no help documentation provided} -} -\subsection{\code{mark:expand_by_warning/warning}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:expand_by_warning}} -\item{type}{\strong{warning}} -} -\emph{no help documentation provided} -} \subsection{\code{mark:fct_expand_seq_error/error}}{ \describe{ \item{package}{\code{{mark}}} @@ -247,7 +211,9 @@ Generic error to capture internal \code{{mark}} errors. If any of these are enc \item{class}{\code{mark:md5_condition}} \item{type}{\strong{condition}} } -\emph{no help documentation provided} +Produces messages on md5 checks when \code{file_copy_md5(quiet = FALSE)}. +The message will indicate whether the file was new, or if the md5 hash was the same or different. +When \code{quiet = TRUE}, no messages will be produced. } \subsection{\code{mark:na_timezone_found_warning/warning}}{ \describe{ @@ -340,14 +306,6 @@ reindex(x, 'index', c(1, 2, 5, NA)) #> NA }\if{html}{\out{}} -} -\subsection{\code{mark:remove_labels_error/error}}{ -\describe{ -\item{package}{\code{{mark}}} -\item{class}{\code{mark:remove_labels_error}} -\item{type}{\strong{error}} -} -\emph{no help documentation provided} } \subsection{\code{mark:source_error/error}}{ \describe{ diff --git a/man/reexports.Rd b/man/reexports.Rd index e31cd8b3..eb1029f6 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From fddd5afbb3c90d9a1a93fe429b2d037cc99817f9 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Wed, 4 Mar 2026 22:38:51 -0500 Subject: [PATCH 153/169] updates tests (#259) --- tests/testthat/test-bib.R | 4 ++-- tests/testthat/test-expand.R | 5 ++++- tests/testthat/test-match-arg.R | 4 ++-- tests/testthat/test-not-available.R | 2 +- tests/testthat/test-percentile-rank.R | 2 +- tests/testthat/test-sourcing.R | 2 +- tests/testthat/test-write.R | 8 ++++---- 7 files changed, 15 insertions(+), 12 deletions(-) diff --git a/tests/testthat/test-bib.R b/tests/testthat/test-bib.R index 802f9e2f..8b734ac3 100644 --- a/tests/testthat/test-bib.R +++ b/tests/testthat/test-bib.R @@ -14,7 +14,7 @@ test_that("read_bib()", { temp <- withr::local_tempfile() writeLines("bad", temp) - expect_error(read_bib(temp), class = "mark:bib_error") + expect_error(read_bib(temp), class = "value_error") expect_error(as_bib(1:3), class = "class_error") expect_error(as_bib_list(1:3), class = "type_error") @@ -26,7 +26,7 @@ test_that("read_bib()", { fields = "this", keys = "key" ), - class = "mark:bib_error" + class = "duplicate_error" ) }) diff --git a/tests/testthat/test-expand.R b/tests/testthat/test-expand.R index 8b54a09c..780532cf 100644 --- a/tests/testthat/test-expand.R +++ b/tests/testthat/test-expand.R @@ -64,5 +64,8 @@ test_that("reindex() work", { }) test_that("expand helpers work", { - expect_warning(unique_name_check(c(a = 1, a = 2))) + expect_warning( + unique_name_check(c(a = 1, a = 2)), + class = "duplicate_warning" + ) }) diff --git a/tests/testthat/test-match-arg.R b/tests/testthat/test-match-arg.R index 533e0314..76c6b1b9 100644 --- a/tests/testthat/test-match-arg.R +++ b/tests/testthat/test-match-arg.R @@ -115,11 +115,11 @@ test_that("match_param() accepts formula lists", { test_that("match_param() finds duplicate choices", { expect_error( match_param("a", c("a", "a")), - class = "input_error" + class = "duplicate_error" ) expect_error( match_param(1, c(a = 1:2, b = 3:4, c = c(1, 3))), - class = "input_error" + class = "duplicate_error" ) }) diff --git a/tests/testthat/test-not-available.R b/tests/testthat/test-not-available.R index 963f7578..1f45d30c 100644 --- a/tests/testthat/test-not-available.R +++ b/tests/testthat/test-not-available.R @@ -18,7 +18,7 @@ test_that("not_available() works", { set_not_available("foo_fun", function() NULL) expect_error( get_not_available("foo_fun"), - class = "mark:not_available_error" + class = "class_error" ) # reset list diff --git a/tests/testthat/test-percentile-rank.R b/tests/testthat/test-percentile-rank.R index 4fa28774..76f6b6d3 100644 --- a/tests/testthat/test-percentile-rank.R +++ b/tests/testthat/test-percentile-rank.R @@ -15,5 +15,5 @@ test_that("percentile_rank() works", { test_that("percentile_rank_weighted() handles decimals [92]", { x <- c(1, 3.120000000001, 3.120000000001, 4) w <- 1:4 - expect_error(percentile_rank(x, w), class = "mark:duplicate_error") + expect_error(percentile_rank(x, w), class = "duplicate_error") }) diff --git a/tests/testthat/test-sourcing.R b/tests/testthat/test-sourcing.R index 2370722e..301a61c3 100644 --- a/tests/testthat/test-sourcing.R +++ b/tests/testthat/test-sourcing.R @@ -24,7 +24,7 @@ test_that("eval_named_chunk()", { ) file.remove(temp_rmd) - expect_error(eval_named_chunk(tempfile()), class = "mark:source_error") + expect_error(eval_named_chunk(tempfile()), class = "input_error") file <- tempfile(fileext = ".Rmd") file.create(file) expect_error(eval_named_chunk(file), "\"label_name\" is missing") diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 1d814a53..b0a17ccf 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -3,8 +3,8 @@ test_that("write_file_md5() works", { temp <- withr::local_tempfile() expect_output(write_file_md5(df)) muffle_cnd_conditions({ - expect_condition(write_file_md5(df, temp), class = "mark:md5_status") - expect_condition(write_file_md5(df, temp), class = "mark:md5_status") + expect_condition(write_file_md5(df, temp), class = "mark:md5_condition") + expect_condition(write_file_md5(df, temp), class = "mark:md5_condition") }) # atomic @@ -26,7 +26,7 @@ test_that("write_file_md5() types", { muffle_cnd_conditions( expect_condition( write_file_md5(x, temp, method = !!method), - class = "mark:md5_status" + class = "mark:md5_condition" ) ) } @@ -46,7 +46,7 @@ test_that("path warning", { "attr(x, \"path\") is being overwritten", fixed = TRUE ), - class = "mark:md5_status" + class = "mark:md5_condition" ) ) }) From 994234a0eb5caaef7ae2e6891fd39f568772f51a Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 30 Mar 2026 13:35:53 -0400 Subject: [PATCH 154/169] adds lint skips (#259) --- R/file.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/file.R b/R/file.R index 8a672712..fccc76c7 100644 --- a/R/file.R +++ b/R/file.R @@ -54,9 +54,11 @@ md5_condition := condition( function(...) paste(..., collapse = ""), type = "condition", exports = "file_copy_md5", + # nolint start: line_length_linter. help = " Produces messages on md5 checks when `file_copy_md5(quiet = FALSE)`. The message will indicate whether the file was new, or if the md5 hash was the same or different. When `quiet = TRUE`, no messages will be produced. " + # nolint ends: line_length_linter. ) From 68bb9e0694e0ac32e6a7c671edc1cde0a30f781c Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 30 Mar 2026 13:36:12 -0400 Subject: [PATCH 155/169] removes unused formatting (#259) --- R/match-arg.R | 29 ----------------------------- 1 file changed, 29 deletions(-) diff --git a/R/match-arg.R b/R/match-arg.R index 85952336..878d5837 100644 --- a/R/match-arg.R +++ b/R/match-arg.R @@ -143,35 +143,6 @@ match_param <- function( mchoices <- cleanup_param_list(choices) if (anyDuplicated(unlist(mchoices$choices))) { - # TODO implement cond_match_param_dupes() - to_choices <- function(x) { - if (all(names(x) == as.character(x))) { - dupe <- duplicated(x) - x[dupe] <- paste0(x[dupe], "*") - return(toString(x)) - } - - collapse( - mapply( - function(x, nm, d) { - sprintf( - "%s = %s", - nm, - toString(paste0(x, ifelse(d, "*", ""))) - ) - }, - x = x, - nm = names(x), - d = split( - duplicated(unlist(x)), - rep(seq_along(x), lengths(x)) - ), - USE.NAMES = FALSE - ), - sep = "\n " - ) - } - stop(duplicate_error(x = choices)) } From 6a58745d30a9aa6b777c6cca4ab83611ff3633e0 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 30 Mar 2026 13:36:32 -0400 Subject: [PATCH 156/169] bumps fuj, cnd; replaced quick_dfl() (#259) --- DESCRIPTION | 7 ++++--- R/bib.R | 4 ++-- R/counts.R | 4 ++-- R/dataframes.R | 6 +++--- R/detail.R | 12 ++++++------ R/todos.R | 2 +- R/utils.R | 4 ++++ bench/bench-counts.R | 2 +- tests/testthat/_snaps/md5.md | 2 +- tests/testthat/_snaps/md5.new.md | 21 +++++++++++++++++++++ tests/testthat/_snaps/write.md | 4 ++-- tests/testthat/_snaps/write.new.md | 22 ++++++++++++++++++++++ tests/testthat/helper.R | 2 +- tests/testthat/test-append.R | 6 +++--- tests/testthat/test-blank.R | 2 +- tests/testthat/test-char2fact.R | 4 ++-- tests/testthat/test-clipboard.R | 2 +- tests/testthat/test-counts.R | 22 +++++++++++----------- tests/testthat/test-dataframes.R | 24 ++++++++++++------------ tests/testthat/test-depth.R | 2 +- tests/testthat/test-detail.R | 6 +++--- tests/testthat/test-diff-time.R | 2 +- tests/testthat/test-environments.R | 2 +- tests/testthat/test-expand.R | 2 +- tests/testthat/test-fact.R | 4 ++-- tests/testthat/test-insert.R | 4 ++-- tests/testthat/test-labels.R | 10 +++++----- tests/testthat/test-md5.R | 4 ++-- tests/testthat/test-nas.R | 6 +++--- tests/testthat/test-note.R | 10 +++++----- tests/testthat/test-plot.R | 2 +- tests/testthat/test-row-bind.R | 10 +++++----- tests/testthat/test-write.R | 16 ++++++++-------- 33 files changed, 140 insertions(+), 92 deletions(-) create mode 100644 tests/testthat/_snaps/md5.new.md create mode 100644 tests/testthat/_snaps/write.new.md diff --git a/DESCRIPTION b/DESCRIPTION index 9af826c1..b0201dbf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,8 +23,8 @@ Depends: R (>= 4.1.0) Imports: cli, - cnd (>= 0.1.1.9001), - fs (>= 1.6.2), + cnd (>= 0.1.1.9002), + fs (>= 0.2.2.9009), fuj (>= 0.2.1), magrittr (>= 2.0.1), rlang, @@ -60,7 +60,8 @@ Suggests: readMDTable (>= 0.2.0), clipr (>= 0.8.0) Remotes: - github::jmbarbone/cnd@v0.1.1.9001 + github::jmbarbone/cnd@v0.1.1.9002, + github::jmbarbone/fuj@v0.2.2.9009 RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 diff --git a/R/bib.R b/R/bib.R index 5fb50e86..171a0e76 100644 --- a/R/bib.R +++ b/R/bib.R @@ -143,7 +143,7 @@ parse_bib_val <- function(x) { process_bib_dataframe <- function(categories, values, fields, keys) { # Determine all categories for missing values inside Map ucats <- unique(remove_na(unlist(categories))) - ucats_df <- quick_dfl( + ucats_df <- dataframe( category = ucats, value = rep(NA_character_, length(ucats)) ) @@ -174,7 +174,7 @@ process_bib_dataframe <- function(categories, values, fields, keys) { vals <- c(key, field, vals) # Create data.frame - data <- quick_dfl(category = cats, value = vals) + data <- dataframe(category = cats, value = vals) # Check for missing categories toadd <- ucats %out% cats diff --git a/R/counts.R b/R/counts.R index 8a58fd8d..5ede7a0c 100644 --- a/R/counts.R +++ b/R/counts.R @@ -28,11 +28,11 @@ #' counts(x) #' props(x) #' -#' x <- quick_df(list( +#' x <- dataframe( #' a = c("a", "c", "a", "c", "d", "b"), #' b = c("a", "a", "a", "c", "c", "b"), #' c = c("a", "a", "a", "c", "b", "b") -#' )) +#' ) #' #' counts(x, "a") #' counts(x, c("a", "b", "c")) diff --git a/R/dataframes.R b/R/dataframes.R index 7bdc6fc2..7abad588 100644 --- a/R/dataframes.R +++ b/R/dataframes.R @@ -240,11 +240,11 @@ complete_cases <- function(data, cols = NULL, invert = FALSE) { #' @param invert If `TRUE` returns the duplicated rows #' @returns `data` will duplicates removes #' @examples -#' df <- quick_dfl( +#' df <- dataframe( #' i = 1:4, #' a = rep(1:2, 2L), -#' b = rep("a", 4L), -#' ) +#' b = rep("a", 4L) +#' )) #' #' unique_rows(df, 2:3) #' unique_rows(df, c("a", "b"), from_last = TRUE, invert = TRUE) diff --git a/R/detail.R b/R/detail.R index 56274572..798f029f 100644 --- a/R/detail.R +++ b/R/detail.R @@ -8,11 +8,11 @@ #' x <- sample(letters[1:4], 10, TRUE) #' detail(x) #' -#' df <- quick_df(list( +#' df <- dataframe( #' x = x, #' y = round(runif(10), 2), #' z = Sys.Date() + runif(10) * 100 -#' )) +#' ) #' #' detail(df) #' @export @@ -64,7 +64,7 @@ detail.default <- function(x, factor_n = 5L, ...) { facts <- TRUE } - res <- quick_dfl( + res <- dataframe( class = collapse0(class(x), sep = "; "), type = collapse0(typeof(x), sep = "; "), label = exattr(x, "label") %||% NA_character_, @@ -83,7 +83,7 @@ detail.default <- function(x, factor_n = 5L, ...) { } # fmt: skip - text <- quick_dfl( + text <- dataframe( note = note(x) %||% NA_character_, comment = comment(x) %||% NA_character_ ) @@ -108,8 +108,8 @@ detail.data.frame <- function(x, factor_n = 5L, ...) { reps <- vap_int(details, nrow) cbind( - quick_dfl(i = rep(seq_along(x), reps)), - quick_dfl(col = rep(names(x), reps)), + dataframe(i = rep(seq_along(x), reps)), + dataframe(col = rep(names(x), reps)), Reduce(rbind, details) ) } diff --git a/R/todos.R b/R/todos.R index 29e832df..bd3c2a90 100644 --- a/R/todos.R +++ b/R/todos.R @@ -147,7 +147,7 @@ do_todo <- function( function(x, regex) { x <- enc2utf8(x) ind <- grep(pattern = regex, x = x) - quick_dfl(ind = ind, todo = x[ind]) + dataframe(ind = ind, todo = x[ind]) }, regex = sprintf("[#]\\s+%s[:]?\\s+", toupper(text)) ) diff --git a/R/utils.R b/R/utils.R index 12c419ff..4f05034e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -241,3 +241,7 @@ dupe_check <- function(x, n = getOption("mark.dupe.n", 5)) { invisible(NULL) } + +dataframe <- function(...) { + fuj::quick_df(list(...)) +} diff --git a/bench/bench-counts.R b/bench/bench-counts.R index 3f8c3230..100617bf 100644 --- a/bench/bench-counts.R +++ b/bench/bench-counts.R @@ -3,7 +3,7 @@ library(mark, warn.conflicts = TRUE) n <- 1e4 -x <- quick_df(list( +x <- dataframe( a = sample(letters, n, TRUE), b = sample(letters, n, TRUE), c = sample(letters, n, TRUE) diff --git a/tests/testthat/_snaps/md5.md b/tests/testthat/_snaps/md5.md index d1b5985e..f7e2886a 100644 --- a/tests/testthat/_snaps/md5.md +++ b/tests/testthat/_snaps/md5.md @@ -15,7 +15,7 @@ --- Code - md5(quick_dfl(a = 1)) + md5(dataframe(a = 1)) Output 34e2f3ac0f1ba4794d0cd0160fe80c6e diff --git a/tests/testthat/_snaps/md5.new.md b/tests/testthat/_snaps/md5.new.md new file mode 100644 index 00000000..22764696 --- /dev/null +++ b/tests/testthat/_snaps/md5.new.md @@ -0,0 +1,21 @@ +# snapshots + + Code + md5(letters) + Output + efdb4b76073d1962b351692972a8d9e3 + +--- + + Code + md5(1:100) + Output + e7d409fa912dd31c9a9da6cb9eb21b32 + +--- + + Code + md5(dataframe(a = 1)) + Output + f16311aa3f99060be519c8e9b38101e6 + diff --git a/tests/testthat/_snaps/write.md b/tests/testthat/_snaps/write.md index 3e13f938..6b3add41 100644 --- a/tests/testthat/_snaps/write.md +++ b/tests/testthat/_snaps/write.md @@ -1,7 +1,7 @@ # arrow prints something to stdout() Code - write_file_md5(quick_dfl(a = 1), method = "feather") + write_file_md5(dataframe(a = 1), method = "feather") Output Table 1 rows x 1 columns @@ -10,7 +10,7 @@ --- Code - write_file_md5(quick_dfl(a = 1), method = "parquet") + write_file_md5(dataframe(a = 1), method = "parquet") Output # A data frame: 2 x 12 file_name name r_type type type_length repetition_type converted_type diff --git a/tests/testthat/_snaps/write.new.md b/tests/testthat/_snaps/write.new.md new file mode 100644 index 00000000..6b3add41 --- /dev/null +++ b/tests/testthat/_snaps/write.new.md @@ -0,0 +1,22 @@ +# arrow prints something to stdout() + + Code + write_file_md5(dataframe(a = 1), method = "feather") + Output + Table + 1 rows x 1 columns + $a + +--- + + Code + write_file_md5(dataframe(a = 1), method = "parquet") + Output + # A data frame: 2 x 12 + file_name name r_type type type_length repetition_type converted_type + + 1 /tmp/ sche~ NA + 2 /tmp/ a double DOUB~ NA REQUIRED + # i 5 more variables: logical_type >, num_children , scale , + # precision , field_id + diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 04f1f943..cf64474a 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -42,7 +42,7 @@ expect_clip <- function(input, method) { res <- if (package_available("tibble")) { tibble::tibble(a = 1L, b = 2L, c = 3L) } else { - fuj::quick_dfl(a = 1L, b = 2L, c = 3L) + fuj::dataframe(a = 1L, b = 2L, c = 3L) } expect_identical(read_clipboard(method), res) }) diff --git a/tests/testthat/test-append.R b/tests/testthat/test-append.R index f2d2b3a8..94ba302a 100644 --- a/tests/testthat/test-append.R +++ b/tests/testthat/test-append.R @@ -25,12 +25,12 @@ test_that("append0.list() works", { }) test_that("append.data.frame() works", { - x <- quick_dfl(a = 1:2, b = 0:1) + x <- dataframe(a = 1:2, b = 0:1) res <- append0(x, list(c = c(TRUE, FALSE))) - exp <- quick_dfl(a = 1:2, b = 0:1, c = c(TRUE, FALSE)) + exp <- dataframe(a = 1:2, b = 0:1, c = c(TRUE, FALSE)) expect_identical(res, exp) res <- append0(x, list(c = c(TRUE, FALSE)), 2) - exp <- quick_dfl(a = 1:2, c = c(TRUE, FALSE), b = 0:1) + exp <- dataframe(a = 1:2, c = c(TRUE, FALSE), b = 0:1) expect_identical(res, exp) }) diff --git a/tests/testthat/test-blank.R b/tests/testthat/test-blank.R index 60831d54..0948ffd1 100644 --- a/tests/testthat/test-blank.R +++ b/tests/testthat/test-blank.R @@ -12,7 +12,7 @@ test_that("is_blank() works", { exp <- c(TRUE, FALSE, FALSE, FALSE) expect_identical(obj, exp) - df <- quick_dfl( + df <- dataframe( x = x, i = 1:4, na = rep(NA, 4L), diff --git a/tests/testthat/test-char2fact.R b/tests/testthat/test-char2fact.R index 2f707576..d0542684 100644 --- a/tests/testthat/test-char2fact.R +++ b/tests/testthat/test-char2fact.R @@ -15,7 +15,7 @@ test_that("char2fact() works", { }) test_that("char2fact.data.frame() works", { - x <- quick_dfl( + x <- dataframe( a = letters[c(1, 2, 2, 2, 3, 4, 4, 5, 5)], b = letters[c(1, 2, 3, 4, 5, 6, 7, 8, 9)] ) @@ -29,7 +29,7 @@ test_that("char2fact.data.frame() works", { test_that("fact2char() works", { expect_error(fact2char(letters), class = "class_error") - df <- quick_dfl( + df <- dataframe( a = 1:5, b = factor(1:5), c = letters[1:5], diff --git a/tests/testthat/test-clipboard.R b/tests/testthat/test-clipboard.R index 58b34ef2..ee489b0a 100644 --- a/tests/testthat/test-clipboard.R +++ b/tests/testthat/test-clipboard.R @@ -12,7 +12,7 @@ test_that("clipboard", { }) with_clip({ - x <- quick_dfl( + x <- dataframe( var1 = 1:3, var2 = letters[1:3], var3 = as.Date("2020-01-03") + 1:3, diff --git a/tests/testthat/test-counts.R b/tests/testthat/test-counts.R index 768282d5..83bf6905 100644 --- a/tests/testthat/test-counts.R +++ b/tests/testthat/test-counts.R @@ -36,7 +36,7 @@ test_that("counts() works with NAs", { test_that("counts.data.frame() adds new name", { - df <- quick_dfl(a = 1, b = 2) + df <- dataframe(a = 1, b = 2) res <- counts(df, 1) expect_equal(colnames(res), c("a", "freq")) @@ -81,23 +81,23 @@ test_that("counts() NAs are last", { }) test_that("counts.data.frame() works", { - df <- quick_dfl(a = rep("x", 3), b = fact(c("a", "a", "b"))) + df <- dataframe(a = rep("x", 3), b = fact(c("a", "a", "b"))) res <- counts(df, 1) - exp <- quick_dfl(a = "x", freq = 3) + exp <- dataframe(a = "x", freq = 3) expect_equal(res, exp) res <- counts(df, 2) - exp <- quick_dfl(b = fact(c("a", "b")), freq = 2:1) + exp <- dataframe(b = fact(c("a", "b")), freq = 2:1) expect_equal(res, exp) res <- counts(df, 1:2) - exp <- quick_dfl(a = rep("x", 2), b = fact(c("a", "b")), freq = 2:1) + exp <- dataframe(a = rep("x", 2), b = fact(c("a", "b")), freq = 2:1) expect_equal(res, exp) df[["b"]] <- as_ordered(df[["b"]]) res <- counts(df, 1:2) - exp <- quick_dfl(a = rep("x", 2), b = as_ordered(c("a", "b")), freq = 2:1) + exp <- dataframe(a = rep("x", 2), b = as_ordered(c("a", "b")), freq = 2:1) expect_equal(res, exp) }) @@ -120,19 +120,19 @@ test_that("props() handles NA", { # data frame x <- c(1, 2, 2, 3, NA) y <- flip(x) - df <- quick_dfl(x = x, y = y) + df <- dataframe(x = x, y = y) - res_x1 <- quick_dfl(x = c(1, 2, 3, NA), prop = c(.20, .40, .20, .20)) - res_x2 <- quick_dfl(x = c(1, 2, 3, NA), prop = c(.25, .50, .25, NA)) + res_x1 <- dataframe(x = c(1, 2, 3, NA), prop = c(.20, .40, .20, .20)) + res_x2 <- dataframe(x = c(1, 2, 3, NA), prop = c(.25, .50, .25, NA)) expect_identical(props(df, "x"), res_x1) expect_identical(props(df, "x", na.rm = TRUE), res_x2) - res_xy1 <- quick_dfl( + res_xy1 <- dataframe( x = c(1, 2, 2, 3, NA), y = c(NA, 3, 2, 2, 1), prop = rep(.2, 5) ) - res_xy2 <- quick_dfl( + res_xy2 <- dataframe( x = c(1, 2, 2, 3, NA), y = c(NA, 3, 2, 2, 1), prop = c(NA, 1, 1, 1, NA) / 3 diff --git a/tests/testthat/test-dataframes.R b/tests/testthat/test-dataframes.R index e25c03bb..96e42267 100644 --- a/tests/testthat/test-dataframes.R +++ b/tests/testthat/test-dataframes.R @@ -1,9 +1,9 @@ test_that("to_row_names()", { - x <- quick_dfl(a = 1:4, b = letters[1:4]) + x <- dataframe(a = 1:4, b = letters[1:4]) expect_equal( to_row_names(x), - quick_dfl(b = letters[1:4]) + dataframe(b = letters[1:4]) ) expect_equal( @@ -18,7 +18,7 @@ test_that("to_row_names()", { # non-integers to character foo <- function(x) { - out <- to_row_names(quick_dfl(a = 1, b = x), "b") + out <- to_row_names(dataframe(a = 1, b = x), "b") class(attr(out, "row.names")) } @@ -35,7 +35,7 @@ test_that("col_to_rn()", { test_that("vector2df()", { x <- c(1.0, 3.1, 8.2) - df <- quick_dfl(name = c(NA, NA, NA), value = x) + df <- dataframe(name = c(NA, NA, NA), value = x) expect_equal(vector2df(x), df) df$name <- as.character(x) @@ -47,7 +47,7 @@ test_that("vector2df()", { test_that("list2df()", { x <- list(a = 1, b = 2:4, c = letters[10:20]) - exp <- quick_dfl( + exp <- dataframe( name = letters[c(1, rep(2, 3), rep(3, 11))], value = c(1, 2:4, letters[10:20]) ) @@ -64,7 +64,7 @@ test_that("list2df()", { # Unnamed x <- list(a = 1, 0, 2) - res <- quick_dfl(name = c("a", 2, 3), value = c(1, 0, 2)) + res <- dataframe(name = c("a", 2, 3), value = c(1, 0, 2)) expect_equal(list2df(x), res) expect_error(list2df(1), class = "class_error") @@ -85,9 +85,9 @@ test_that("list2df2()", { }) test_that("t_df()", { - x <- quick_dfl(a = 1:5, b = letters[1:5]) + x <- dataframe(a = 1:5, b = letters[1:5]) - y <- quick_dfl( + y <- dataframe( colname = c("a", "b"), # nolint start: spaces_inside_linter. row_1 = c(1, "a"), @@ -112,9 +112,9 @@ test_that("complete_cases()", { expect_error(complete_cases(1L)) expect_error(complete_cases(quick_df(NULL))) - df <- quick_dfl(a = c(1, 2, NA, 4), b = c(NA, 2, 3, NA)) - res1 <- quick_dfl(a = c(1, 2, 4), b = c(NA, 2, NA)) - res2 <- quick_dfl(a = 2, b = 2) + df <- dataframe(a = c(1, 2, NA, 4), b = c(NA, 2, 3, NA)) + res1 <- dataframe(a = c(1, 2, 4), b = c(NA, 2, NA)) + res2 <- dataframe(a = 2, b = 2) expect_identical(complete_cases(df, "a"), res1) expect_identical(complete_cases(df), res2) @@ -123,7 +123,7 @@ test_that("complete_cases()", { test_that("unique_rows()", { expect_error(unique_rows(1L)) - df <- quick_dfl( + df <- dataframe( id = 1:4, a = rep(1:2, 2L), b = rep("a", 4L) diff --git a/tests/testthat/test-depth.R b/tests/testthat/test-depth.R index 1130afa2..3efe3ebb 100644 --- a/tests/testthat/test-depth.R +++ b/tests/testthat/test-depth.R @@ -1,6 +1,6 @@ test_that("depth", { expect_equal(depth(NA), 1L) - expect_equal(depth(quick_dfl(a = 1)), 1L) + expect_equal(depth(dataframe(a = 1)), 1L) expect_equal(depth(list()), 0L) expect_equal(depth(NULL), 0L) expect_equal(depth(list(1)), 1L) diff --git a/tests/testthat/test-detail.R b/tests/testthat/test-detail.R index d83f449d..b74a38c7 100644 --- a/tests/testthat/test-detail.R +++ b/tests/testthat/test-detail.R @@ -3,13 +3,13 @@ test_that("details() works", { y <- factor(letters[1:3]) z <- c("x", NA_character_, "z") attr(z, "label") <- "information" - df <- quick_dfl(x = x, y = factor(letters[1:3])) + df <- dataframe(x = x, y = factor(letters[1:3])) expect_error(detail(x), NA) expect_error(detail(df), NA) expect_error(detail(data.frame()), class = "input_error") - exp <- quick_dfl( + exp <- dataframe( class = "logical", type = "logical", label = NA_character_, @@ -43,5 +43,5 @@ test_that("details() and tibbles", { }) test_that("details.data.frame() passes with single column [48]", { - expect_error(quick_dfl(a = 1), NA) + expect_error(dataframe(a = 1), NA) }) diff --git a/tests/testthat/test-diff-time.R b/tests/testthat/test-diff-time.R index 83e65569..1de6fb6e 100644 --- a/tests/testthat/test-diff-time.R +++ b/tests/testthat/test-diff-time.R @@ -61,7 +61,7 @@ test_that("diff_time_*() identical to difftime()", { test_that("Timezones", { st <- as.POSIXct("2021-04-06 11:12:45", tz = "America/Chicago") - dftz <- quick_dfl( + dftz <- dataframe( a = rep(st, 4), b = rep(st, 4), tza = c("GMT", "UTC", "America/New_York", "Pacific/Auckland"), diff --git a/tests/testthat/test-environments.R b/tests/testthat/test-environments.R index 22d2821c..a75d60e6 100644 --- a/tests/testthat/test-environments.R +++ b/tests/testthat/test-environments.R @@ -10,7 +10,7 @@ test_that("environments() and friends works", { { foo_obj <- structure(list(), class = "foo") foo_fun <- function() NULL - foo_df <- quick_dfl(a = 1) + foo_df <- dataframe(a = 1) }, envir = ne ) diff --git a/tests/testthat/test-expand.R b/tests/testthat/test-expand.R index 780532cf..2b25a522 100644 --- a/tests/testthat/test-expand.R +++ b/tests/testthat/test-expand.R @@ -58,7 +58,7 @@ test_that("reindex() work", { expect_error(reindex(1), class = "class_error") expect_error( - reindex(quick_dfl(a = 1), index = integer()), + reindex(dataframe(a = 1), index = integer()), class = if (getRversion() >= "4.5") "missingArgError" else "simpleError", ) }) diff --git a/tests/testthat/test-fact.R b/tests/testthat/test-fact.R index 6221242e..4e720445 100644 --- a/tests/testthat/test-fact.R +++ b/tests/testthat/test-fact.R @@ -260,8 +260,8 @@ test_that("drop_levels() works", { exp <- factor(1, 1) expect_equal(drop_levels(x), exp) - df <- quick_dfl(x = x, y = 1) - df_exp <- quick_dfl(x = exp, y = 1) + df <- dataframe(x = x, y = 1) + df_exp <- dataframe(x = exp, y = 1) expect_equal(drop_levels(df), df_exp) # facts and ordered diff --git a/tests/testthat/test-insert.R b/tests/testthat/test-insert.R index 2caff674..6fe41962 100644 --- a/tests/testthat/test-insert.R +++ b/tests/testthat/test-insert.R @@ -14,13 +14,13 @@ test_that("insert.default() works", { }) test_that("insert.data.frame() works", { - x <- quick_dfl( + x <- dataframe( a = c(1, 2, 3), b = c("a", "b", "c"), c = c(-1.5, 0, 1.5) ) - exp <- quick_dfl( + exp <- dataframe( a = c(1, 2, 3), x = 1:3, b = c("a", "b", "c"), diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index 0f1ac4b1..e02c4710 100644 --- a/tests/testthat/test-labels.R +++ b/tests/testthat/test-labels.R @@ -17,7 +17,7 @@ test_that("data.frame assignment", { x0 <- head(iris) x <- assign_labels(x0, Sepal.Length = "a", Species = "b") - exp <- quick_dfl( + exp <- dataframe( column = colnames(x0), label = c("a", NA, NA, NA, "b") ) @@ -57,7 +57,7 @@ test_that("data.frame assignment", { class = "mark:assign_labels_error" ) - df <- quick_dfl(a = 1, b = 2, c = 3) + df <- dataframe(a = 1, b = 2, c = 3) expect_error( assign_labels(df, c = "c", d = "d", .missing = "error"), "not found", @@ -82,21 +82,21 @@ test_that("data.frame assign with data.frame", { x <- assign_labels(iris, Sepal.Length = "a", Species = "b") - labels <- quick_dfl( + labels <- dataframe( name = c("Sepal.Length", "Species"), label = c("a", "b") ) y <- assign_labels(iris, labels) - exp <- quick_dfl( + exp <- dataframe( column = colnames(iris), label = c("a", NA, NA, NA, "b") ) expect_equal(get_labels(y), get_labels(y)) - bad_labels <- quick_dfl( + bad_labels <- dataframe( v1 = c("a", "b", 1), v2 = c("x", "y", 2) ) diff --git a/tests/testthat/test-md5.R b/tests/testthat/test-md5.R index 0584d8fb..0388f0cc 100644 --- a/tests/testthat/test-md5.R +++ b/tests/testthat/test-md5.R @@ -12,7 +12,7 @@ test_that("md5() works", { ) expect_identical( - md5(quick_dfl(a = 1)), + md5(dataframe(a = 1)), "34e2f3ac0f1ba4794d0cd0160fe80c6e", ignore_attr = "class" ) @@ -29,5 +29,5 @@ test_that("md5(btyes) return the same", { test_that("snapshots", { expect_snapshot(md5(letters)) expect_snapshot(md5(1:100)) - expect_snapshot(md5(quick_dfl(a = 1))) + expect_snapshot(md5(dataframe(a = 1))) }) diff --git a/tests/testthat/test-nas.R b/tests/testthat/test-nas.R index c544984e..c90f39a2 100644 --- a/tests/testthat/test-nas.R +++ b/tests/testthat/test-nas.R @@ -2,7 +2,7 @@ test_that("remove_na()", { x <- c(1, 2, NA, 3, NaN) expect_equal(remove_na(x), c(1, 2, 3)) expect_equal(remove_na(as.list(x)), list(1, 2, numeric(), 3, numeric())) - expect_error(remove_na(quick_dfl(x = 1)), class = "input_error") + expect_error(remove_na(dataframe(x = 1)), class = "input_error") res <- remove_na(fact(x)) exp <- struct( @@ -25,11 +25,11 @@ test_that("remove_null()", { expect_equal(remove_null(x), list(a = 1, c = 1)) expect_error(remove_null(c(1, 2)), class = "type_error") - expect_error(remove_null(quick_dfl(x = NULL)), class = "type_error") + expect_error(remove_null(dataframe(x = NULL)), class = "type_error") }) test_that("*_na_cols() works", { - x <- quick_dfl( + x <- dataframe( first = c(NA, 2, 3, 4), second = c(1, NA, 3, 4), all = not_available(length = 4), diff --git a/tests/testthat/test-note.R b/tests/testthat/test-note.R index e0c3cfcf..269bd518 100644 --- a/tests/testthat/test-note.R +++ b/tests/testthat/test-note.R @@ -36,7 +36,7 @@ test_that("note() work", { }) test_that("print.noted() passes to next methods [67] (data.frame)", { - x <- quick_dfl(a = 1:50) + x <- dataframe(a = 1:50) original <- capture.output(print(x, max = 5)) note(x) <- "note" @@ -68,11 +68,11 @@ test_that("print.noted() passes to next methods [67] (tibble)", { test_that("print_note() works with data.frame", { withr::local_options(list(mark.check_interactive = NA)) - x <- quick_dfl(a = 1:2, b = 1:2) + x <- dataframe(a = 1:2, b = 1:2) note(x) <- "This should work" expect_identical(print_note(x), x) - x <- list(a = 1:3, b = 2, c = quick_dfl(a = 1)) + x <- list(a = 1:3, b = 2, c = dataframe(a = 1)) note(x) <- "This is a list" expect_identical(print_note(x), x) }) @@ -91,11 +91,11 @@ test_that("note() snapshots", { note(x) <- "snapshot vector" expect_snapshot(x) - x <- quick_dfl(a = 1:2, b = 1:2) + x <- dataframe(a = 1:2, b = 1:2) note(x) <- "snapshot data.frame" expect_snapshot(x) - x <- list(a = 1:2, b = 1:2, c = quick_dfl(a = 1, b = 2)) + x <- list(a = 1:2, b = 1:2, c = dataframe(a = 1, b = 2)) note(x) <- "snapshot list" expect_snapshot(x) diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index fe7c999f..c2d4b8b9 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -4,7 +4,7 @@ test_that("with_par() works", { par0 <- graphics::par("mfrow") set.seed(42) - df <- quick_dfl(a = stats::rnorm(100), b = stats::rnorm(100)) + df <- dataframe(a = stats::rnorm(100), b = stats::rnorm(100)) # not testing for plot grDevices::dev.off() wuffle(with_par( diff --git a/tests/testthat/test-row-bind.R b/tests/testthat/test-row-bind.R index 42bfc2c1..50cb5d51 100644 --- a/tests/testthat/test-row-bind.R +++ b/tests/testthat/test-row-bind.R @@ -1,7 +1,7 @@ test_that("row_bind() works", { - res1 <- row_bind(quick_dfl(a = 1, b = 2), quick_dfl(b = 2, c = 3)) - res2 <- row_bind(list(quick_dfl(a = 1, b = 2), quick_dfl(b = 2, c = 3))) - exp <- quick_dfl(a = c(1L, NA), b = c(2L, 2L), c = c(NA, 3L)) + res1 <- row_bind(dataframe(a = 1, b = 2), dataframe(b = 2, c = 3)) + res2 <- row_bind(list(dataframe(a = 1, b = 2), dataframe(b = 2, c = 3))) + exp <- dataframe(a = c(1L, NA), b = c(2L, 2L), c = c(NA, 3L)) expect_identical(res1, exp) expect_identical(res2, exp) @@ -10,8 +10,8 @@ test_that("row_bind() works", { }) test_that("row_bind() actually works [66]", { - x <- list(quick_dfl(a = 1:2, b = 1:2), quick_dfl(b = 3, c = 4)) + x <- list(dataframe(a = 1:2, b = 1:2), dataframe(b = 3, c = 4)) res <- row_bind(x) - exp <- quick_dfl(a = c(1:2, NA), b = 1:3, c = c(NA, NA, 4L)) + exp <- dataframe(a = c(1:2, NA), b = 1:3, c = c(NA, NA, 4L)) expect_identical(res, exp) }) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index b0a17ccf..ffa1364e 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,5 +1,5 @@ test_that("write_file_md5() works", { - df <- quick_dfl(a = 1, b = 2) + df <- dataframe(a = 1, b = 2) temp <- withr::local_tempfile() expect_output(write_file_md5(df)) muffle_cnd_conditions({ @@ -20,7 +20,7 @@ test_that("write_file_md5() types", { if (method %in% c(mark_write_methods()$lines, "write")) { letters } else { - quick_dfl(a = 1, b = "n", c = TRUE) + dataframe(a = 1, b = "n", c = TRUE) } muffle_cnd_conditions( @@ -38,7 +38,7 @@ test_that("write_file_md5() types", { test_that("path warning", { temp <- withr::local_tempfile() - x <- structure(quick_dfl(a = 1), path = temp) + x <- structure(dataframe(a = 1), path = temp) muffle_cnd_conditions( expect_condition( expect_warning( @@ -52,7 +52,7 @@ test_that("path warning", { }) test_that("write_file_md5() errors", { - df <- quick_dfl(a = 1) + df <- dataframe(a = 1) expect_error( write_file_md5(df, method = "foo"), class = "mark:match_param_error" @@ -63,7 +63,7 @@ test_that("compression works", { foo <- function(ext = "") { file <- tempfile(fileext = ext) on.exit(unlink(file, recursive = TRUE)) - df <- quick_dfl(a = 1) + df <- dataframe(a = 1) write_file_md5(df, file, quiet = TRUE) } @@ -89,7 +89,7 @@ test_that("list columns", { op <- options(mark.list.hook = method) on.exit(options(op)) - df <- quick_dfl(x = c("a", "b")) + df <- dataframe(x = c("a", "b")) df$y <- list(1:2, 2) write_file_md5(df, temp, quiet = TRUE) @@ -123,11 +123,11 @@ test_that("arrow prints something to stdout()", { } expect_snapshot( - write_file_md5(quick_dfl(a = 1), method = "feather"), + write_file_md5(dataframe(a = 1), method = "feather"), transform = function(x) censor(x) ) expect_snapshot( - write_file_md5(quick_dfl(a = 1), method = "parquet"), + write_file_md5(dataframe(a = 1), method = "parquet"), transform = function(x) censor(x) ) }) From c8926cdf60b468585fd97465583aac4b62b4ece3 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 30 Mar 2026 13:38:22 -0400 Subject: [PATCH 157/169] updates tests (#259) --- tests/testthat/_snaps/md5.md | 2 +- tests/testthat/_snaps/md5.new.md | 21 --------------------- tests/testthat/_snaps/write.new.md | 22 ---------------------- tests/testthat/test-funs.R | 22 ++++++++++------------ tests/testthat/test-md5.R | 4 ++-- 5 files changed, 13 insertions(+), 58 deletions(-) delete mode 100644 tests/testthat/_snaps/md5.new.md delete mode 100644 tests/testthat/_snaps/write.new.md diff --git a/tests/testthat/_snaps/md5.md b/tests/testthat/_snaps/md5.md index f7e2886a..22764696 100644 --- a/tests/testthat/_snaps/md5.md +++ b/tests/testthat/_snaps/md5.md @@ -17,5 +17,5 @@ Code md5(dataframe(a = 1)) Output - 34e2f3ac0f1ba4794d0cd0160fe80c6e + f16311aa3f99060be519c8e9b38101e6 diff --git a/tests/testthat/_snaps/md5.new.md b/tests/testthat/_snaps/md5.new.md deleted file mode 100644 index 22764696..00000000 --- a/tests/testthat/_snaps/md5.new.md +++ /dev/null @@ -1,21 +0,0 @@ -# snapshots - - Code - md5(letters) - Output - efdb4b76073d1962b351692972a8d9e3 - ---- - - Code - md5(1:100) - Output - e7d409fa912dd31c9a9da6cb9eb21b32 - ---- - - Code - md5(dataframe(a = 1)) - Output - f16311aa3f99060be519c8e9b38101e6 - diff --git a/tests/testthat/_snaps/write.new.md b/tests/testthat/_snaps/write.new.md deleted file mode 100644 index 6b3add41..00000000 --- a/tests/testthat/_snaps/write.new.md +++ /dev/null @@ -1,22 +0,0 @@ -# arrow prints something to stdout() - - Code - write_file_md5(dataframe(a = 1), method = "feather") - Output - Table - 1 rows x 1 columns - $a - ---- - - Code - write_file_md5(dataframe(a = 1), method = "parquet") - Output - # A data frame: 2 x 12 - file_name name r_type type type_length repetition_type converted_type - - 1 /tmp/ sche~ NA - 2 /tmp/ a double DOUB~ NA REQUIRED - # i 5 more variables: logical_type >, num_children , scale , - # precision , field_id - diff --git a/tests/testthat/test-funs.R b/tests/testthat/test-funs.R index 0cf03d00..b82f0e7a 100644 --- a/tests/testthat/test-funs.R +++ b/tests/testthat/test-funs.R @@ -26,7 +26,7 @@ test_that("outer_*()", { test_that("require_namespace()", { expect_error( require_namespace("impossible package"), - class = "namespaceError" + class = "packageNotFoundError" ) foo <- function() { @@ -37,12 +37,12 @@ test_that("require_namespace()", { foo() } - expect_error(foo(), class = "namespaceError") - expect_error(bar(), class = "namespaceError") + expect_error(foo(), class = "packageNotFoundError") + expect_error(bar(), class = "packageNotFoundError") expect_error( require_namespace("this_one", "that_thing"), - class = "namespaceError" + class = "packageNotFoundError" ) }) @@ -50,17 +50,15 @@ test_that("quiet_stop()", { expect_error(quiet_stop(), NULL) foo <- function(x) { - tryCatch(quiet_stop(), - error = function(e) { - !is.null(e$message) - }) + tryCatch(quiet_stop(), error = function(e) { + !is.null(e$message) + }) } bar <- function(x) { - tryCatch(quiet_stop(), - error = function(e) { - warning(e$message) - }) + tryCatch(quiet_stop(), error = function(e) { + warning(e$message) + }) } # Message exists diff --git a/tests/testthat/test-md5.R b/tests/testthat/test-md5.R index 0388f0cc..11622e5e 100644 --- a/tests/testthat/test-md5.R +++ b/tests/testthat/test-md5.R @@ -12,8 +12,8 @@ test_that("md5() works", { ) expect_identical( - md5(dataframe(a = 1)), - "34e2f3ac0f1ba4794d0cd0160fe80c6e", + md5(quick_df(list(a = 1))), + "f16311aa3f99060be519c8e9b38101e6", ignore_attr = "class" ) }) From 2ede42c9f9e42b8c5c0c01756c0716ccdbeea3ba Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 30 Mar 2026 23:58:21 -0400 Subject: [PATCH 158/169] correct dataframe() usage (#259) --- R/counts.R | 2 +- R/dataframes.R | 4 ++-- R/detail.R | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/counts.R b/R/counts.R index 5ede7a0c..185bf740 100644 --- a/R/counts.R +++ b/R/counts.R @@ -28,7 +28,7 @@ #' counts(x) #' props(x) #' -#' x <- dataframe( +#' x <- data.frame( #' a = c("a", "c", "a", "c", "d", "b"), #' b = c("a", "a", "a", "c", "c", "b"), #' c = c("a", "a", "a", "c", "b", "b") diff --git a/R/dataframes.R b/R/dataframes.R index 7abad588..d8d24492 100644 --- a/R/dataframes.R +++ b/R/dataframes.R @@ -240,11 +240,11 @@ complete_cases <- function(data, cols = NULL, invert = FALSE) { #' @param invert If `TRUE` returns the duplicated rows #' @returns `data` will duplicates removes #' @examples -#' df <- dataframe( +#' df <- data.frame( #' i = 1:4, #' a = rep(1:2, 2L), #' b = rep("a", 4L) -#' )) +#' ) #' #' unique_rows(df, 2:3) #' unique_rows(df, c("a", "b"), from_last = TRUE, invert = TRUE) diff --git a/R/detail.R b/R/detail.R index 798f029f..5a687993 100644 --- a/R/detail.R +++ b/R/detail.R @@ -8,7 +8,7 @@ #' x <- sample(letters[1:4], 10, TRUE) #' detail(x) #' -#' df <- dataframe( +#' df <- data.frame( #' x = x, #' y = round(runif(10), 2), #' z = Sys.Date() + runif(10) * 100 From 5c38f071d3f943c1df9dbdb37d4992105eb89bec Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Mon, 30 Mar 2026 23:58:25 -0400 Subject: [PATCH 159/169] redocs (#259) --- man/counts.Rd | 4 ++-- man/detail.Rd | 4 ++-- man/unique_rows.Rd | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/man/counts.Rd b/man/counts.Rd index 39dbff02..e3dcdca6 100644 --- a/man/counts.Rd +++ b/man/counts.Rd @@ -57,11 +57,11 @@ x <- sample(1:5, 10, TRUE) counts(x) props(x) -x <- quick_df(list( +x <- data.frame( a = c("a", "c", "a", "c", "d", "b"), b = c("a", "a", "a", "c", "c", "b"), c = c("a", "a", "a", "c", "b", "b") -)) +) counts(x, "a") counts(x, c("a", "b", "c")) diff --git a/man/detail.Rd b/man/detail.Rd index fc0f5af0..983f69d4 100644 --- a/man/detail.Rd +++ b/man/detail.Rd @@ -28,11 +28,11 @@ Provides details about an object x <- sample(letters[1:4], 10, TRUE) detail(x) -df <- quick_df(list( +df <- data.frame( x = x, y = round(runif(10), 2), z = Sys.Date() + runif(10) * 100 -)) +) detail(df) } diff --git a/man/unique_rows.Rd b/man/unique_rows.Rd index 7f4d9b78..c73a390b 100644 --- a/man/unique_rows.Rd +++ b/man/unique_rows.Rd @@ -23,10 +23,10 @@ rather than the first} Drops duplicated rows } \examples{ -df <- quick_dfl( +df <- data.frame( i = 1:4, a = rep(1:2, 2L), - b = rep("a", 4L), + b = rep("a", 4L) ) unique_rows(df, 2:3) From b432e83448169590338952315f4e0ff65bb43808 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 11 Apr 2026 10:40:35 -0400 Subject: [PATCH 160/169] removes extra hooks (#259) --- R/zzz.R | 8 -------- 1 file changed, 8 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index fa824add..1ad4b8d1 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,11 +1,3 @@ -.onAttach <- function(libname, pkgname) { - options(op.mark[!names(op.mark) %in% names(options())]) -} - -.onDetach <- function(libpath) { - invisible() -} - # FIXME include: cnd_exports() cnd_document() From a6f083646ced0a8d32277ba8e8972ed819d89904 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 11 Apr 2026 10:43:48 -0400 Subject: [PATCH 161/169] updates hook (#259) --- R/mark-package.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/mark-package.R b/R/mark-package.R index 10219402..6ba74655 100644 --- a/R/mark-package.R +++ b/R/mark-package.R @@ -39,9 +39,5 @@ op.mark <- list( ) .onLoad <- function(libname, pkgname) { - options(op.mark[!names(op.mark) %in% names(options())]) -} - -.onDetach <- function(libpath) { - invisible() + options(op.mark[!names(op.mark) %in% names(options())]) # nocov } From c470aafec896b490b8663959f9baa75913703076 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 12 Apr 2026 23:12:00 -0400 Subject: [PATCH 162/169] redocs (#259) --- man/reexports.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/reexports.Rd b/man/reexports.Rd index eb1029f6..e31cd8b3 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From e6e139a54e84280bbe02e5c89a2c8552af842f60 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 12 Apr 2026 23:12:02 -0400 Subject: [PATCH 163/169] Update DESCRIPTION (#259) --- DESCRIPTION | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b0201dbf..6d4082e2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,15 +23,16 @@ Depends: R (>= 4.1.0) Imports: cli, - cnd (>= 0.1.1.9002), - fs (>= 0.2.2.9009), - fuj (>= 0.2.1), + cnd, + fs (>= 0.2.0), + fuj, magrittr (>= 2.0.1), rlang, stats (>= 3.6), tools (>= 3.6), utils (>= 3.6) Suggests: + arrow (>= 16.1.0), bench (>= 1.1.1), bib2df (>= 1.1.1), clipr (>= 0.8.0), @@ -55,13 +56,9 @@ Suggests: withr (>= 2.3.0), xopen, yaml (>= 2.3.9), - jsonlite, - arrow (>= 16.1.0), - readMDTable (>= 0.2.0), - clipr (>= 0.8.0) Remotes: github::jmbarbone/cnd@v0.1.1.9002, - github::jmbarbone/fuj@v0.2.2.9009 + github::jmbarbone/fuj@v0.2.2.9010 RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 From 526d1923e253411efb7073287cd217c3b1169e72 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 12 Apr 2026 23:26:03 -0400 Subject: [PATCH 164/169] typo (#259) --- R/labels.R | 2 +- R/mark-cnd-conditions.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/labels.R b/R/labels.R index 0631df7a..280951b3 100644 --- a/R/labels.R +++ b/R/labels.R @@ -235,7 +235,7 @@ assign_labels(df, a = 'AAA', b = 'BBB') # or this: assign_labels(df, .ls = list(a = 'AAA', b = 'BBB')) ``` -Labels must not be null; to remove lavels, use `remove_labels()`. +Labels must not be null; to remove labels, use `remove_labels()`. ```r # instead of this diff --git a/R/mark-cnd-conditions.R b/R/mark-cnd-conditions.R index 540bda6d..a0fe0d7c 100644 --- a/R/mark-cnd-conditions.R +++ b/R/mark-cnd-conditions.R @@ -44,7 +44,7 @@ #' # or this: #' assign_labels(df, .ls = list(a = 'AAA', b = 'BBB')) #' ``` -#' Labels must not be null; to remove lavels, use `remove_labels()`. +#' Labels must not be null; to remove labels, use `remove_labels()`. #' #' ```r #' # instead of this From 5dff59a58faf6705c3b9ec4c01b8d53a63a70a6b Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 18 Apr 2026 12:17:17 -0400 Subject: [PATCH 165/169] redocs (#259) --- man/mark-cnd-conditions.Rd | 2 +- man/reexports.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/man/mark-cnd-conditions.Rd b/man/mark-cnd-conditions.Rd index 491f3c29..e201fb29 100644 --- a/man/mark-cnd-conditions.Rd +++ b/man/mark-cnd-conditions.Rd @@ -118,7 +118,7 @@ assign_labels(df, a = 'AAA', b = 'BBB') assign_labels(df, .ls = list(a = 'AAA', b = 'BBB')) }\if{html}{\out{}} -Labels must not be null; to remove lavels, use \code{remove_labels()}. +Labels must not be null; to remove labels, use \code{remove_labels()}. \if{html}{\out{
}}\preformatted{# instead of this assign_labels(df, a = 'AAA', b = NULL) diff --git a/man/reexports.Rd b/man/reexports.Rd index e31cd8b3..eb1029f6 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From f362a5da783c7606d3cb70973f83d84ab2e0f8a9 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sat, 18 Apr 2026 12:17:20 -0400 Subject: [PATCH 166/169] version bump (#259) --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6d4082e2..22bbc8ea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: mark Type: Package Title: Multipurpose Aids for R Kit -Version: 0.8.3.9007 +Version: 0.8.3.9008 Authors@R: person(given = "Jordan Mark", family = "Barbone", From cc21d56dee5b0b4903d8e1bcc3dce44afd71b630 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 19 Apr 2026 11:02:44 -0400 Subject: [PATCH 167/169] formatting (#259) --- tests/spelling.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/tests/spelling.R b/tests/spelling.R index 6713838f..d60e024c 100644 --- a/tests/spelling.R +++ b/tests/spelling.R @@ -1,3 +1,7 @@ -if(requireNamespace('spelling', quietly = TRUE)) - spelling::spell_check_test(vignettes = TRUE, error = FALSE, - skip_on_cran = TRUE) +if (requireNamespace("spelling", quietly = TRUE)) { + spelling::spell_check_test( + vignettes = TRUE, + error = FALSE, + skip_on_cran = TRUE + ) +} From 389b7e0498a03212c3a432f040c789053636dcd7 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 19 Apr 2026 11:02:48 -0400 Subject: [PATCH 168/169] redocs (#259) --- man/reexports.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/reexports.Rd b/man/reexports.Rd index eb1029f6..e31cd8b3 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -36,7 +36,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} From 33a2380574238c99110183df79952e4b62df4160 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Sun, 19 Apr 2026 11:03:01 -0400 Subject: [PATCH 169/169] attach testthat for helpers (#259) --- tests/testthat/helper.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index cf64474a..9ba020e5 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -1,3 +1,5 @@ +library(testthat) + muffle_cnd_conditions <- function(expr) { withCallingHandlers( expr,