Converted stringr_view to S7.

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,

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)

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

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)
 }

R/zzz.R

@@ -0,0 +1,10 @@
+.onLoad <- function(lib, pkg) {
+  S7::methods_register()
+}
+
+# Work around S7 buglet
+rm("[", "[<-", "print")
+
+# enable usage of <S7_object>@name in package code
+#' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@")
+NULL

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", {