Fix c.teal_card to append only new element (#345)

Ultimately closes
#339
#340

It is not just to append content of `y` into `x`. `y` could be created
from `x` and then add some NEW stuff. When merging back, it should not
append stuff which is already in `x`.


<details>
<summary>  Explaination with examples </summary>



#### Joining completely new one 
```r
a <- teal_card("Text 1", "Text 2")
b <- teal_card("Text 3")
c(a, b)
# should be: "Text 1", "Text 2", "Text 3"
```

#### Joining one which appends in the end

```r
a <- teal_card("Text 1", "Text 2")
b <- c(a, "Text 3")
c(a, b)
# should be: "Text 1", "Text 2", "Text 3"
```

#### Joining one which appends in the beginning

```r
a <- teal_card("Text 1", "Text 2")
b <- append(a, "Text 3", after = 0)
c(a, b)
# should be: "Text 3", "Text 1", "Text 2"
```

#### Joining one which modifies

```r
a <- teal_card("Text 1", "Text 2")
b <- a
b[[1]] <- "Text 11"
c(a, b)
# should be: "Text 11", "Text 2"
```

#### Joining one which removes

```r
a <- teal_card("Text 1", "Text 2")
b <- a[-1]
c(a, b)
# should be: "Text 2"
```

Given all above, it it narrows down to:
- replace entire `x` with `y` if they share some names (`y` is the one
which is modified so it has a precedence)
- otherwise just c(x, y)

<details>

---------

Signed-off-by: André Veríssimo <[email protected]>
Co-authored-by: André Veríssimo <[email protected]>

Author: gogonzo

R/teal_card.R

@@ -51,6 +51,11 @@ teal_card <- function(x, ...) {
     x@teal_card
   } else {
     objects <- list(x, ...)
+    names(objects) <- vapply(
+      sample.int(.Machine$integer.max, size = length(objects)),
+      function(x) substr(rlang::hash(list(Sys.time(), x)), 1, 8),
+      character(1)
+    )
     structure(objects, class = "teal_card")
   }
 }
@@ -91,10 +96,23 @@ c.teal_card <- function(...) {
     Reduce(
       f = function(u, v) {
         v <- as.teal_card(v)
-        attrs <- utils::modifyList(attributes(u) %||% list(), attributes(v))
-        result <- c(unclass(u), v)
-        attributes(result) <- attrs
-        result
+        if (length(names(u)) && length(names(v)) && any(names(u) %in% names(v))) { # when v stems from u
+          if (all(names(u) %in% names(v))) { # nothing from `u` is removed in `v`
+            v
+          } else {
+            warning(
+              "Appended `teal_card` doesn't remove some of the elements from previous `teal_card`.\n",
+              "Restoring original content and adding only new items to the end of the card."
+            )
+            modifyList(u, v)
+          }
+        } else {
+          attrs <- utils::modifyList(attributes(u) %||% list(), attributes(v))
+          attrs$names <- union(names(u), names(v))
+          result <- utils::modifyList(u, v)
+          attributes(result) <- attrs
+          result
+        }
       },
       x = dots,
       init = list()

tests/testthat/test-Reporter.R

@@ -59,12 +59,13 @@ testthat::test_that("get_cards returns the same cards which was added to reporte
 
 testthat::test_that("get_blocks returns the same blocks which was added to reporter, sep = NULL", {
   reporter <- test_reporter(card1 <- test_card1("A title"), card2 <- test_card2("Another title"))
-  testthat::expect_identical(
+  testthat::expect_equal(
     reporter$get_blocks(sep = NULL),
     append(
       c(sprintf("# %s", metadata(card1, "title")), card1),
       c(sprintf("# %s", metadata(card2, "title")), card2)
-    )
+    ),
+    ignore_attr = TRUE
   )
 })
 
@@ -79,7 +80,7 @@ testthat::test_that("get_blocks by default adds NewpageBlock$new() between cards
   reporter_blocks <- reporter$get_blocks()
   reporter_blocks2 <- append(reporter_1$get_blocks(), "\\newpage")
   reporter_blocks2 <- append(reporter_blocks2, reporter_2$get_blocks())
-  testthat::expect_equal(reporter$get_blocks(), reporter_blocks2)
+  testthat::expect_equal(reporter$get_blocks(), reporter_blocks2, ignore_attr = TRUE)
 })
 
 testthat::test_that("get_blocks and get_cards return empty list by default", {
@@ -99,7 +100,7 @@ testthat::test_that("The deep copy constructor copies the content files to new f
   testthat::expect_failure(
     testthat::expect_equal(rlang::obj_address(original_content_file), rlang::obj_address(copied_content_file))
   )
-  testthat::expect_identical(original_content_file, copied_content_file)
+  testthat::expect_equal(original_content_file, copied_content_file, ignore_attr = TRUE)
 })
 
 testthat::describe("metadata", {
@@ -188,6 +189,7 @@ testthat::describe("to_list", {
 
 testthat::describe("from_reporter", {
   it("returns same object from the same reporter", {
+    shiny::reactiveConsole(TRUE)
     reporter <- test_reporter(card1 <- test_card1(), card2 <- test_card2())
     testthat::expect_identical(reporter, (Reporter$new()$from_reporter(reporter)))
   })
@@ -206,9 +208,10 @@ testthat::describe("from_reporter", {
   it("from_reporter persists the cards structure", {
     reporter1 <- test_reporter(test_card1(), test_card2())
     reporter2 <- teal.reporter::Reporter$new()
-    testthat::expect_identical(
-      unname(reporter1$get_cards()),
-      unname(reporter2$from_reporter(reporter1)$get_cards())
+    testthat::expect_equal(
+      reporter1$get_cards(),
+      reporter2$from_reporter(reporter1)$get_cards(),
+      ignore_attr = TRUE
     )
   })
 })

tests/testthat/test-teal_card.R

@@ -4,18 +4,23 @@ testthat::describe("teal_card contructor creates", {
     testthat::expect_identical(doc, structure(list(), class = "teal_card"))
   })
 
+  testthat::it("teal_card appends arguments and sets them random unique names", {
+    doc <- teal_card("a", "b", "c", "d", "e", "f", "g", "h")
+    testthat::expect_true(all(!duplicated(names(doc))))
+  })
+
   testthat::it("teal_card doesn't ignore NULL", {
-    doc <- teal_card(NULL)
+    doc <- unname(teal_card(NULL))
     testthat::expect_identical(doc, structure(list(NULL), class = "teal_card"))
   })
 
   testthat::it("teal_card keeps conditions", {
-    doc <- teal_card(simpleCondition("test"))
+    doc <- unname(teal_card(simpleCondition("test")))
     testthat::expect_identical(doc, structure(list(simpleCondition("test")), class = "teal_card"))
   })
 
   testthat::it("teal_card appends each element asis (no list unwrapping)", {
-    doc <- teal_card("a", list(1, list(2)), code_chunk("print('hi')"))
+    doc <- unname(teal_card("a", list(1, list(2)), code_chunk("print('hi')")))
     testthat::expect_identical(
       doc,
       structure(
@@ -32,64 +37,87 @@ testthat::describe("c.teal_card combines", {
   })
 
   it("empty teal_card with non-empty", {
-    testthat::expect_identical(c(teal_card(), teal_card(TRUE)), teal_card(TRUE))
+    doc2 <- teal_card(TRUE)
+    testthat::expect_identical(c(teal_card(), doc2), doc2)
   })
 
-  it("with empty teal_card and remains the same", {
-    testthat::expect_identical(c(teal_card("a", "b"), teal_card()), teal_card("a", "b"))
+  it("with empty teal_card - remains the same", {
+    doc <- teal_card("a", "b")
+    testthat::expect_identical(c(doc, teal_card()), doc)
   })
 
-  it("with character, preserves class and append as a new element", {
+  it("with character - adds as a new element", {
     doc_result <- c(teal_card("a", "b"), "c")
-    testthat::expect_identical(doc_result, teal_card("a", "b", "c"))
+    testthat::expect_equal(doc_result, teal_card("a", "b", "c"), ignore_attr = TRUE)
   })
 
-  it("with list, preserves the class and adds each element separately (unwraps list)", {
+  it("with list - adds each list element separately (unwraps list)", {
     doc_result <- c(teal_card("a", "b"), list(1, 2))
-    testthat::expect_identical(doc_result, teal_card("a", "b", 1, 2))
+    testthat::expect_equal(doc_result, teal_card("a", "b", 1, 2), ignore_attr = TRUE)
   })
 
-  it("with teal_card containing a list and doesn't unwrap the list (asis)", {
+  it("with teal_card containing a list - append this list asis (doesn't unwrap list)", {
     doc_result <- c(teal_card("a", "b"), teal_card(list(1, 2)))
-    testthat::expect_identical(doc_result, teal_card("a", "b", list(1, 2)))
+    testthat::expect_equal(doc_result, teal_card("a", "b", list(1, 2)), ignore_attr = TRUE)
   })
 
-  it("with NULL and remains the same (ignores NULL)", {
+  it("with NULL - remains the same (ignores NULL)", {
     doc_result <- c(teal_card("a", "b"), NULL)
-    testthat::expect_identical(doc_result, teal_card("a", "b"))
+    testthat::expect_equal(doc_result, teal_card("a", "b"), ignore_attr = TRUE)
   })
 
-  it("with character(0) and appends as a new element", {
+  it("with character(0) - adds as a new element", {
     doc_result <- c(teal_card("a", "b"), character(0))
-    testthat::expect_identical(doc_result, teal_card("a", "b", character(0)))
-  })
-
-  it("with teal_card and appends new elements asis", {
-    doc_result <- c(teal_card("a", "b"), teal_card("c", "d"))
-    testthat::expect_identical(doc_result, teal_card("a", "b", "c", "d"))
+    testthat::expect_equal(doc_result, teal_card("a", "b", character(0)), ignore_attr = TRUE)
   })
 
-  it("with ggplot, preserves the class class and append as a new element", {
+  it("with ggplot - adds as a new element", {
     plot <- ggplot2::ggplot(iris)
     doc_result <- c(teal_card("a", "b"), plot)
-    testthat::expect_identical(doc_result, teal_card("a", "b", plot))
+    testthat::expect_equal(doc_result, teal_card("a", "b", plot), ignore_attr = TRUE)
   })
 
-  it("with teal_card containing ggplot and appends elements asis", {
+  it("with new teal_card - adds new elements asis", {
+    doc_result <- c(teal_card("a", "b"), teal_card("c", "d"))
+    testthat::expect_equal(doc_result, teal_card("a", "b", "c", "d"), ignore_attr = TRUE)
+  })
+
+  it("with new teal_card containing ggplot - adds new elements asis", {
     plot <- ggplot2::ggplot(iris) +
       ggplot2::geom_point(ggplot2::aes(x = Sepal.Length, y = Sepal.Width))
     doc_result <- c(teal_card("a", "b"), teal_card("# Plot", plot))
-    testthat::expect_identical(doc_result, teal_card("a", "b", "# Plot", plot))
+    testthat::expect_equal(doc_result, teal_card("a", "b", "# Plot", plot), ignore_attr = TRUE)
+  })
+
+  it("with teal_card containing new and old items - adds only new", {
+    doc1 <- teal_card("a", "b")
+    doc2 <- c(doc1, "c", "d")
+    testthat::expect_equal(c(doc1, doc2), teal_card("a", "b", "c", "d"), ignore_attr = TRUE)
+  })
+
+  it("with teal_card containing new and old items - adds even if their order is different", {
+    doc1 <- teal_card("a", "b")
+    doc2 <- c(doc1, "c", "d")
+    doc2 <- doc2[c(3, 1, 4, 2)]
+    testthat::expect_equal(c(doc1, doc2), teal_card("c", "a", "d", "b"), ignore_attr = TRUE)
+  })
+
+  it("with teal_card with new and missing old items - restores original items, adds new at the end and warn", {
+    doc1 <- teal_card("a", "b")
+    doc2 <- c(doc1, "c", "d")[c(4, 3, 2)]
+    testthat::expect_warning(
+      testthat::expect_equal(c(doc1, doc2), teal_card("a", "b", "d", "c"), ignore_attr = TRUE)
+    )
   })
 
-  it("with a `teal_card` and keeps original metadata", {
+  it("with a `teal_card` - keeps original metadata", {
     doc <- teal_card("a", "b")
     metadata(doc) <- list(title = "A Title", a = "test")
     doc_result <- c(doc, teal_card("new content"))
     testthat::expect_identical(metadata(doc_result), list(title = "A Title", a = "test"))
   })
 
-  it("new `teal_card` and combines metadata and overwrites original", {
+  it("new `teal_card` - combines metadata and overwrites original", {
     doc1 <- teal_card("a", "b")
     metadata(doc1) <- list(title = "A Title", a = "test")
     doc2 <- teal_card("new content")
@@ -118,22 +146,22 @@ testthat::describe("as.teal_card", {
   it("converts a simple list with each element being converted to a report content", {
     simple_list <- list("a", "b", "c")
     doc <- as.teal_card(simple_list)
-    testthat::expect_identical(doc, teal_card("a", "b", "c"))
+    testthat::expect_equal(doc, teal_card("a", "b", "c"), ignore_attr = TRUE)
   })
 
   it("converts a custom list class with many elements into single-element-teal_card", {
     custom_list <- list("a", "b", "c", "d")
     class(custom_list) <- "extra class"
     doc <- as.teal_card(custom_list)
-    testthat::expect_identical(doc, teal_card(custom_list))
+    testthat::expect_equal(doc, teal_card(custom_list), ignore_attr = TRUE)
   })
 
   it("converts a ggplot2 to a teal_card with only 1 report content", {
     testthat::skip_if_not_installed("ggplot2")
     plot <- ggplot2::ggplot(iris) +
       ggplot2::geom_point(ggplot2::aes(x = Sepal.Length, y = Sepal.Width))
     doc <- as.teal_card(plot)
-    testthat::expect_identical(doc, teal_card(plot))
+    testthat::expect_equal(doc, teal_card(plot), ignore_attr = TRUE)
   })
 })
 

tests/testthat/test-teal_report-c.R

@@ -6,20 +6,20 @@ testthat::describe("c.teal_report combines", {
   it("empty and non-empty teal_report by appending elements of teal_card", {
     treport1 <- teal_report()
     treport2 <- teal_report(teal_card = teal_card("Text 2"))
-
-    testthat::expect_identical(
+    testthat::expect_equal(
       teal_card(c(treport1, treport2)),
-      teal_card("Text 2")
+      teal_card("Text 2"),
+      ignore_attr = TRUE
     )
   })
 
   it("two teal_report by combining elements of teal_card", {
     treport1 <- teal_report(teal_card = teal_card("Text 1"))
     treport2 <- teal_report(teal_card = teal_card("Text 2"))
-
-    testthat::expect_identical(
+    testthat::expect_equal(
       teal_card(c(treport1, treport2)),
-      teal_card("Text 1", "Text 2")
+      teal_card("Text 1", "Text 2"),
+      ignore_attr = TRUE
     )
   })
 
@@ -29,9 +29,10 @@ testthat::describe("c.teal_report combines", {
     treport3 <- teal_report()
     treport4 <- teal_report(teal_card = teal_card("Text 2"))
 
-    testthat::expect_identical(
+    testthat::expect_equal(
       teal_card(c(treport1, treport2, treport3, treport4)),
-      teal_card("Text 1", "Text 2", "Text 2")
+      teal_card("Text 1", "Text 2", "Text 2"),
+      ignore_attr = TRUE
     )
   })
 })

tests/testthat/test-teal_report-eval_code.R

@@ -1,12 +1,13 @@
 testthat::describe("keep_output stores the objects in teal_card", {
   it("using eval_code and explicit reference", {
     q <- eval_code(teal_report(), "a <- 1L;b <- 2L;c <- 3L", keep_output = "b")
-    testthat::expect_identical(
+    testthat::expect_equal(
       teal_card(q),
       teal_card(
         code_chunk("a <- 1L;b <- 2L;c <- 3L"),
         structure(2L, class = c("chunk_output", "integer"))
-      )
+      ),
+      ignore_attr = TRUE
     )
   })
 
@@ -19,32 +20,35 @@ testthat::describe("keep_output stores the objects in teal_card", {
       },
       keep_output = "b"
     )
-    testthat::expect_identical(
+    testthat::expect_equal(
       teal_card(q),
       teal_card(
         code_chunk("a <- 1L\nb <- 2L\nc <- 3L"),
         structure(2L, class = c("chunk_output", "integer"))
-      )
+      ),
+      ignore_attr = TRUE
     )
   })
 
   it("with multiple explicit object references", {
     q <- eval_code(teal_report(), "a <- 1L;b <- 2L;c <- 3L", keep_output = c("a", "b"))
-    testthat::expect_identical(
+    testthat::expect_equal(
       teal_card(q),
       teal_card(
         code_chunk("a <- 1L;b <- 2L;c <- 3L"),
         structure(1L, class = c("chunk_output", "integer")),
         structure(2L, class = c("chunk_output", "integer"))
-      )
+      ),
+      ignore_attr = TRUE
     )
   })
 
   it("without explicit reference returing none", {
     q <- eval_code(teal_report(), "a <- 1L;b <- 2L;c <- 3L", keep_output = character(0L))
-    testthat::expect_identical(
+    testthat::expect_equal(
       teal_card(q),
-      teal_card(code_chunk("a <- 1L;b <- 2L;c <- 3L"))
+      teal_card(code_chunk("a <- 1L;b <- 2L;c <- 3L")),
+      ignore_attr = TRUE
     )
   })
 })