diff --git a/DESCRIPTION b/DESCRIPTION index 14164abe..75dbb773 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 acd9602a..6b8aa8d1 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) @@ -73,6 +71,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 e31a65c0..60fd7a7c 100644 --- a/R/view.R +++ b/R/view.R @@ -150,11 +150,18 @@ str_view_special <- function(x, html = TRUE) { str_replace_all(x, "[\\p{Whitespace}-- \n]+", replace) } +stringr_view <- new_class( + "stringr_view", + parent = class_character, + package = "stringr", + properties = list(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, id = which(filter)) } } @@ -183,8 +190,11 @@ str_view_widget <- function(lines) { ) } -#' @export -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)] @@ -197,7 +207,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("[", x@id, "] "), justify = "right") indent <- paste0(cli::col_grey(id, bar), " ") exdent <- paste0(strrep(" ", nchar(id[[1]])), cli::col_grey(bar), " ") @@ -214,6 +224,14 @@ print.stringr_view <- function(x, ..., n = getOption("stringr.view_n", 20)) { } #' @export -`[.stringr_view` <- function(x, i, ...) { - structure(NextMethod(), id = attr(x, "id")[i], class = "stringr_view") +method(`[`, stringr_view) <- function(x, 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 new file mode 100644 index 00000000..e93c5236 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,10 @@ +.onLoad <- function(lib, pkg) { + S7::methods_register() +} + +# Work around S7 buglet +rm("[", "[<-", "print") + +# 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 f8cc28bd..9cac82bf 100644 --- a/tests/testthat/test-view.R +++ b/tests/testthat/test-view.R @@ -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", {