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

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

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

R/zzz.R

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

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