From 9f8dca5d9e491c7e72b1a20c8f14d7b551aa1b5d Mon Sep 17 00:00:00 2001 From: Vishwarrior26 <67435125+VisruthSK@users.noreply.github.com> Date: Tue, 10 Dec 2024 12:51:05 -0800 Subject: [PATCH 1/3] Converted stringr_view to S7. --- DESCRIPTION | 3 ++- NAMESPACE | 4 ++-- R/stringr-package.R | 1 + R/view.R | 29 +++++++++++++++++++++++------ R/zzz.R | 7 +++++++ tests/testthat/test-view.R | 4 ++-- 6 files changed, 37 insertions(+), 11 deletions(-) create mode 100644 R/zzz.R diff --git a/DESCRIPTION b/DESCRIPTION index 71261533..8620ee50 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,8 @@ Imports: magrittr, rlang (>= 1.0.0), stringi (>= 1.5.3), - vctrs (>= 0.4.0) + vctrs (>= 0.4.0), + S7 (>= 0.2.0) Suggests: covr, dplyr, diff --git a/NAMESPACE b/NAMESPACE index da483518..587ec263 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,7 @@ # Generated by roxygen2: do not edit by hand S3method("[",stringr_pattern) -S3method("[",stringr_view) S3method("[[",stringr_pattern) -S3method(print,stringr_view) S3method(type,character) S3method(type,default) S3method(type,stringr_boundary) @@ -70,6 +68,8 @@ export(str_which) export(str_width) export(str_wrap) export(word) +if (getRversion() < "4.3.0") importFrom("S7", "@") +import(S7) import(rlang) import(stringi) importFrom(glue,glue) diff --git a/R/stringr-package.R b/R/stringr-package.R index 0aab7515..907f0870 100644 --- a/R/stringr-package.R +++ b/R/stringr-package.R @@ -4,6 +4,7 @@ ## usethis namespace: start #' @import stringi #' @import rlang +#' @import S7 #' @importFrom glue glue #' @importFrom lifecycle deprecated ## usethis namespace: end diff --git a/R/view.R b/R/view.R index 80ee5622..bcf85df0 100644 --- a/R/view.R +++ b/R/view.R @@ -138,11 +138,20 @@ str_view_special <- function(x, html = TRUE) { str_replace_all(x, "[\\p{Whitespace}-- \n]+", replace) } +stringr_view <- new_class( + "stringr_view", + package = "stringr", + properties = list( + x = class_character, + id = class_numeric + ) +) + str_view_print <- function(x, filter, html = TRUE) { if (html) { str_view_widget(x) } else { - structure(x, id = which(filter), class = "stringr_view") + stringr_view(x, which(filter)) } } @@ -171,12 +180,19 @@ str_view_widget <- function(lines) { ) } -#' @export -print.stringr_view <- function(x, ..., n = getOption("stringr.view_n", 20)) { +base_length <- new_external_generic("base", "length", "x") +method(base_length, stringr_view) <- function(x) { + length(x@x) +} + +base_print <- new_external_generic("base", "print", "x") +method(base_print, stringr_view) <- function(x, ..., n = getOption("stringr.view_n", 20)) { n_extra <- length(x) - n if (n_extra > 0) { x <- x[seq_len(n)] } + id <- x@id + x <- x@x # extracting the character vector `x` from the S7 object `x` to use in the rest of the function. if (length(x) == 0) { cli::cli_inform(c(x = "Empty `string` provided.\n")) @@ -185,7 +201,7 @@ print.stringr_view <- function(x, ..., n = getOption("stringr.view_n", 20)) { bar <- if (cli::is_utf8_output()) "\u2502" else "|" - id <- format(paste0("[", attr(x, "id"), "] "), justify = "right") + id <- format(paste0("[", id, "] "), justify = "right") indent <- paste0(cli::col_grey(id, bar), " ") exdent <- paste0(strrep(" ", nchar(id[[1]])), cli::col_grey(bar), " ") @@ -201,7 +217,8 @@ print.stringr_view <- function(x, ..., n = getOption("stringr.view_n", 20)) { invisible(x) } +`base_[` <- new_external_generic("base", "[", "x") #' @export -`[.stringr_view` <- function(x, i, ...) { - structure(NextMethod(), id = attr(x, "id")[i], class = "stringr_view") +method(`base_[`, stringr_view) <- function(x, i, ...) { + stringr_view(x@x[i], x@id[i]) } diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 00000000..4eda1e5e --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,7 @@ +.onLoad <- function(lib, pkg) { + S7::methods_register() +} + +# enable usage of @name in package code +#' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@") +NULL diff --git a/tests/testthat/test-view.R b/tests/testthat/test-view.R index 333f989d..9cac82bf 100644 --- a/tests/testthat/test-view.R +++ b/tests/testthat/test-view.R @@ -29,7 +29,7 @@ test_that("view highlights whitespace (except a space/nl)", { }) }) -test_that("view displays message for empty vectors",{ +test_that("view displays message for empty vectors", { expect_snapshot(str_view(character())) }) @@ -57,7 +57,7 @@ test_that("vectorised over pattern", { test_that("[ preserves class", { x <- str_view(letters) - expect_s3_class(x[], "stringr_view") + expect_true(S7_inherits(x[], stringr_view)) }) test_that("str_view_all() is deprecated", { From bceb89062139a01cc9f8f2434692e5c30d9f8c0d Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 22 Sep 2025 15:32:43 -0500 Subject: [PATCH 2/3] Drop use of external generics --- R/view.R | 13 +++++++------ R/zzz.R | 3 +++ 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/R/view.R b/R/view.R index 5618095b..84cdef41 100644 --- a/R/view.R +++ b/R/view.R @@ -192,13 +192,15 @@ str_view_widget <- function(lines) { ) } -base_length <- new_external_generic("base", "length", "x") -method(base_length, stringr_view) <- function(x) { +method(length, stringr_view) <- function(x) { length(x@x) } -base_print <- new_external_generic("base", "print", "x") -method(base_print, stringr_view) <- function(x, ..., n = getOption("stringr.view_n", 20)) { +method(print, stringr_view) <- function( + x, + ..., + n = getOption("stringr.view_n", 20) +) { n_extra <- length(x) - n if (n_extra > 0) { x <- x[seq_len(n)] @@ -229,8 +231,7 @@ method(base_print, stringr_view) <- function(x, ..., n = getOption("stringr.view invisible(x) } -`base_[` <- new_external_generic("base", "[", "x") #' @export -method(`base_[`, stringr_view) <- function(x, i, ...) { +method(`[`, stringr_view) <- function(x, i, ...) { stringr_view(x@x[i], x@id[i]) } diff --git a/R/zzz.R b/R/zzz.R index 4eda1e5e..6c219df5 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -2,6 +2,9 @@ S7::methods_register() } +# Work around S7 buglet +rm("[", "print", "length") + # enable usage of @name in package code #' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@") NULL From 6140c6d8b6fb17176e64e1fb0fb7bacfd8893c1a Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 22 Sep 2025 15:42:55 -0500 Subject: [PATCH 3/3] Keep object as a character vector --- R/view.R | 26 +++++++++++++------------- R/zzz.R | 2 +- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/view.R b/R/view.R index 84cdef41..60fd7a7c 100644 --- a/R/view.R +++ b/R/view.R @@ -152,18 +152,16 @@ str_view_special <- function(x, html = TRUE) { stringr_view <- new_class( "stringr_view", + parent = class_character, package = "stringr", - properties = list( - x = class_character, - id = class_numeric - ) + properties = list(id = class_numeric) ) str_view_print <- function(x, filter, html = TRUE) { if (html) { str_view_widget(x) } else { - stringr_view(x, which(filter)) + stringr_view(x, id = which(filter)) } } @@ -192,10 +190,6 @@ str_view_widget <- function(lines) { ) } -method(length, stringr_view) <- function(x) { - length(x@x) -} - method(print, stringr_view) <- function( x, ..., @@ -205,8 +199,6 @@ method(print, stringr_view) <- function( if (n_extra > 0) { x <- x[seq_len(n)] } - id <- x@id - x <- x@x # extracting the character vector `x` from the S7 object `x` to use in the rest of the function. if (length(x) == 0) { cli::cli_inform(c(x = "Empty `string` provided.\n")) @@ -215,7 +207,7 @@ method(print, stringr_view) <- function( bar <- if (cli::is_utf8_output()) "\u2502" else "|" - id <- format(paste0("[", id, "] "), justify = "right") + id <- format(paste0("[", x@id, "] "), justify = "right") indent <- paste0(cli::col_grey(id, bar), " ") exdent <- paste0(strrep(" ", nchar(id[[1]])), cli::col_grey(bar), " ") @@ -233,5 +225,13 @@ method(print, stringr_view) <- function( #' @export method(`[`, stringr_view) <- function(x, i, ...) { - stringr_view(x@x[i], x@id[i]) + stringr_view(S7_data(x)[i], id = x@id[i]) +} + +#' @export +method(`[<-`, stringr_view) <- function(x, i, ..., value) { + data <- S7_data(x) + data[i, ...] <- value + + stringr_view(data, id = x@id) } diff --git a/R/zzz.R b/R/zzz.R index 6c219df5..e93c5236 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -3,7 +3,7 @@ } # Work around S7 buglet -rm("[", "print", "length") +rm("[", "[<-", "print") # enable usage of @name in package code #' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@")