Merge pull request #1828 from olivroy/str-catalogue

Lint tests + reduce pipe usage + use test helper to test common patterns

.Rbuildignore

@@ -180,4 +180,6 @@ tests/testthat/test-util_functions.R
 tests/testthat/test-utils_plots.R
 tests/testthat/test-utils_render_html.R
 tests/testthat/test-utils_units.R
+
+tests/testthat/_snaps/utils.md
 tests/testthat/test-utils.R

R/data_color.R

@@ -1493,7 +1493,7 @@ check_named_colors <- function(named_colors, call = rlang::caller_env()) {
       )
 
     cli::cli_abort(c(
-      "{one_several_invalid} used ({str_catalog(invalid_colors, conj = 'and')}).",
+      "{one_several_invalid} used ({.str {invalid_colors}}).",
       "*" = "Only R/X11 color names and CSS 3.0 color names can be used."
      ),
      call = call

R/modify_rows.R

@@ -100,7 +100,7 @@ row_group_order <- function(
     cli::cli_abort(c(
       "All values given as `groups` must correspond to `group_id` values.",
       "*" = "The following `group_id` values can be
-      used {str_catalog(arrange_groups)}."
+      used {.str {arrange_groups}}."
     ))
   }
 

R/text_transform.R

@@ -110,7 +110,7 @@ text_replace <- function(
     data = data,
     locations = locations,
     fn = function(x) {
-      str_complete_replace(x, pattern = pattern, replacement = replacement)
+      gsub(pattern = pattern, replacement = replacement, x, perl = TRUE)
     }
   )
 }

R/utils_general_str_formatting.R

@@ -329,48 +329,6 @@ is_adjacent_separate <- function(group_1, group_2) {
   TRUE
 }
 
-str_catalog <- function(
-    item_vector,
-    conj = "and",
-    surround = c("\"", "`"),
-    sep = ",",
-    oxford = TRUE
-) {
-
-  item_count <- length(item_vector)
-
-  surround_str_1 <- paste(rev(surround), collapse = "")
-  surround_str_2 <- paste(surround, collapse = "")
-
-  cat_str <- paste0(surround_str_1, item_vector, surround_str_2)
-
-  if (item_count == 1) {
-
-    return(cat_str)
-
-  } else if (item_count == 2) {
-
-    return(paste(cat_str[1], conj, cat_str[2]))
-
-  } else {
-
-    separators <- rep(paste_right(sep, " "), item_count - 1)
-
-    if (!oxford) {
-      separators[length(separators)] <- ""
-    }
-
-    separators[length(separators)] <-
-      paste_right(paste_right(separators[length(separators)], conj), " ")
-
-    separators[length(separators) + 1] <- ""
-
-    cat_str <- paste(paste0(cat_str, separators), collapse = "")
-
-    return(cat_str)
-  }
-}
-
 str_title_case <- function(x) {
 
   title_case_i <- function(y) {
@@ -393,30 +351,17 @@ str_substitute <- function(string, start = 1L, end = -1L) {
     end <- start[, 2L]
     start <- start[, 1L]
   }
-
-  start <- recycler(start, string)
-  end <- recycler(end, string)
-
+  # Error if start or end is incorrect.
+  vec <- vctrs::vec_recycle_common(start = start, end = end, .size = length(string))
+  start <- vec$start
+  end <- vec$end
   n <- nchar(string)
   start <- ifelse(start < 0, start + n + 1, start)
   end <- ifelse(end < 0, end + n + 1, end)
 
   substr(string, start, end)
 }
 
-recycler <- function(x, to, arg = deparse(substitute(x))) {
-
-  if (length(x) == length(to)) {
-    return(x)
-  }
-
-  if (length(x) != 1) {
-    stop("Can't recycle `", arg, "` to length ", length(to), call. = FALSE)
-  }
-
-  rep(x, length(to))
-}
-
 str_complete_locate <- function(string, pattern) {
   out <- gregexpr(pattern, string, perl = TRUE)
   lapply(out, location, all = TRUE)
@@ -427,14 +372,6 @@ str_single_locate <- function(string, pattern) {
   location(out)
 }
 
-str_complete_replace <- function(string, pattern, replacement) {
-  gsub(pattern, replacement, string, perl = TRUE)
-}
-
-str_single_replace <- function(string, pattern, replacement) {
-  sub(pattern, replacement, string, perl = TRUE)
-}
-
 location <- function(x, all = FALSE) {
 
   start <- as.vector(x)

R/utils_render_grid.R

@@ -949,9 +949,12 @@ render_grid_svg <- function(label, style, margin) {
 
   # Try if any height is declared in style attribute
   if (any(grepl("^height:", svg_style))) {
-    height <- gsub("^height:", "", svg_style[grep("^height:", svg_style)]) %>%
-      parse_fontsize(style$text_gp$fontsize) %>%
-      grid::unit(.grid_unit)
+    height <- gsub("^height:", "", svg_style[grep("^height:", svg_style)])
+    height <-
+      grid::unit(
+        parse_fontsize(height, style$text_gp$fontsize),
+        .grid_unit
+      )
   }
 
   # Try if any width is declared in style attribute
@@ -1022,9 +1025,8 @@ render_grid_svg <- function(label, style, margin) {
 
   raster <- try_fetch(
     {
-      svg_string %>%
         # charToRaw("") return character(0)
-        charToRaw() %>%
+        charToRaw(svg_string) %>%
         rsvg::rsvg_nativeraster(width = w) %>%
         grid::rasterGrob(
           width = width, height = height,

R/utils_render_rtf.R

@@ -403,8 +403,7 @@ parse_length_str <- function(
 
     cli::cli_abort(c(
       "Some of the values supplied cannot be interpreted.",
-      "*" = "Problem values are:
-      {str_catalog(bad_values, surround = c('\"'))}.",
+      "*" = "Problem values are: {.str {bad_values}}",
       "*" = "Use either of: `px`, `pt`, `in`, `cm`, `mm`, or `tw`
       (e.g., \"12px\")"
     ))
@@ -1019,8 +1018,7 @@ create_heading_component_rtf <- function(data) {
 
   # Obtain widths for each visible column label
   col_widths <-
-    boxh %>%
-    dplyr::filter(type %in% c("default", "stub")) %>%
+    dplyr::filter(boxh, type %in% c("default", "stub")) %>%
     dplyr::arrange(dplyr::desc(type)) %>%
     dplyr::pull(column_width) %>%
     unlist()

R/z_utils_render_footnotes.R

@@ -144,8 +144,9 @@ resolve_footnotes_styles <- function(data, tbl_type) {
     cond <- tbl$locname != "row_groups"
     tbl_not_row_groups <- tbl[cond, ]
 
-    tbl_row_groups <- tbl[!cond, ] %>%
+    tbl_row_groups <-
       dplyr::inner_join(
+        tbl[!cond, ],
         groups_rows_df,
         by = c("grpname" = "group_id")
       )
@@ -411,9 +412,16 @@ set_footnote_marks_columns <- function(data, context = "html") {
     if (nrow(footnotes_columns_groups_tbl) > 0) {
 
       footnotes_columns_group_marks <-
-        footnotes_columns_groups_tbl %>%
-        dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "grpname") %>%
-        dplyr::distinct(grpname, fs_id_coalesced)
+        dplyr::mutate(
+          footnotes_columns_groups_tbl,
+          fs_id_coalesced = paste(fs_id, collapse = ","),
+          .by = "grpname"
+        )
+      footnotes_columns_group_marks <-
+        dplyr::distinct(
+          footnotes_columns_group_marks,
+          grpname, fs_id_coalesced
+        )
 
       for (i in seq_len(nrow(footnotes_columns_group_marks))) {
 
@@ -464,10 +472,21 @@ set_footnote_marks_columns <- function(data, context = "html") {
     if (nrow(footnotes_columns_columns_tbl) > 0) {
 
       footnotes_columns_column_marks <-
-        footnotes_columns_columns_tbl %>%
-        dplyr::filter(locname == "columns_columns") %>%
-        dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "colname") %>%
-        dplyr::distinct(colname, fs_id_coalesced)
+        vctrs::vec_slice(
+          footnotes_columns_columns_tbl,
+          !is.na(footnotes_columns_columns_tbl$locname) &
+            footnotes_columns_columns_tbl$locname == "columns_columns"
+        )
+      footnotes_columns_column_marks <-
+        dplyr::mutate(
+          footnotes_columns_column_marks,
+          fs_id_coalesced = paste(fs_id, collapse = ","),
+          .by = "colname"
+        )
+      footnotes_columns_column_marks <-
+        dplyr::distinct(
+          footnotes_columns_column_marks, colname, fs_id_coalesced
+        )
 
       for (i in seq_len(nrow(footnotes_columns_column_marks))) {
 
@@ -515,11 +534,14 @@ set_footnote_marks_stubhead <- function(data, context = "html") {
     if (nrow(footnotes_tbl) > 0) {
 
       footnotes_stubhead_marks <-
-        footnotes_tbl %>%
-        dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "grpname") %>%
-        dplyr::distinct(grpname, fs_id_coalesced) %>%
-        dplyr::pull(fs_id_coalesced)
-
+        dplyr::mutate(
+          footnotes_tbl,
+          fs_id_coalesced = paste(fs_id, collapse = ","),
+          .by = "grpname"
+        )
+      footnotes_stubhead_marks <-
+        dplyr::distinct(footnotes_stubhead_marks, grpname, fs_id_coalesced)
+      footnotes_stubhead_marks <- footnotes_stubhead_marks$fs_id_coalesced
 
       label <-
         paste0(

tests/testthat/_snaps/utils.md

@@ -0,0 +1,18 @@
+# str_substitute() works well
+
+    Code
+      str_substitute(c("223", "223", "224"), c(1, 2), 2)
+    Condition
+      Error in `str_substitute()`:
+      ! Can't recycle `start` (size 2) to size 3.
+    Code
+      str_substitute(c("223", "223", "224"), c(1), c(2, 3))
+    Condition
+      Error in `str_substitute()`:
+      ! Can't recycle `end` (size 2) to size 3.
+    Code
+      str_substitute(c("223", "223", "224", "225"), c(1, 2, 3, 4), c(2, 3))
+    Condition
+      Error in `str_substitute()`:
+      ! Can't recycle `end` (size 2) to size 4.
+