tagQuery(): Relocate html deps to child objects

NEWS.md

@@ -2,6 +2,8 @@
 
 ## Bug fixes
 
+* Closed #301: `tagQuery()` was failing to copy all `tagList()` html dependencies within nest child tag lists. (#302)
+
 * Closed #290: htmltools previously did not specify which version of fastmap to use, and would fail to install with an old version of fastmap. (#291)
 
 * `copyDependencyToDir()` no longer creates empty directories for dependencies that do not have any files. (@gadenbuie, #276)

R/tag_query.R

@@ -427,13 +427,27 @@ tagQueryAsTagErr <- function() {
 #' [`jQuery`](https://jquery.com/) inspired interface for querying and modifying
 #' [tag()] (and [tagList()]) objects.
 #'
+#' @section Altered Tag structure:
+#'
+#' For performance reasons, the input tag structure to `tagQuery()` will be
+#' altered into a consistently expected shape.
+#'
+#' Some alterations include:
+#' * tags flattening their `$children` fields into a single `list()`
+#' * tags relocating any attribute `html_dependency() to be located in `$children`
+#' * `tagList()`-like structures relocating any attribute html dependency to
+#'   be a entry in its list structure.
+#'
+#' While the resulting tag shape has possibly changed,
+#' `tagQuery()`'s' resulting tags will still render
+#' to the same HTML value (ex: [`renderTags()`]) and
+#' HTML dependencies (ex: [`findDependencies()`]).
+#'
 #' @param tags A [tag()], [tagList()], or [list()] of tags.
 #' @return A class with methods that are described below. This class can't be
 #'   used directly inside other [tag()] or a [renderTags()] context, but
 #'   underlying HTML tags may be extracted via `$allTags()` or
-#'   `$selectedTags()`. Note: The returned tags will have their `$children`
-#'   fields flattened to a single `list()`, which may not be the same shape
-#'   that was provided to `tagQuery()`.
+#'   `$selectedTags()`.
 #' @export
 tagQuery <- function(tags) {
 

R/tags.R

@@ -1280,20 +1280,38 @@ flattenTags <- function(x) {
 # By not calling `as.tags(x)`, tagFunctions are not evaluated and other items
 # are not converted.
 flattenTagsRaw <- function(x) {
-  if (isTag(x) || isTagEnv(x)) {
+  if (isTagEnv(x)) {
+    # For tags, wrap them into a list (which will be unwrapped by caller)
+    list(x)
+  } else if (isTag(x)) {
+    tagDeps <- htmlDependencies(x)
+    # Move the tag's html deps to its children
+    if (length(tagDeps) > 0) {
+      x$children <- c(x$children, tagDeps)
+      htmlDependencies(x) <- NULL
+    }
     # For tags, wrap them into a list (which will be unwrapped by caller)
     list(x)
   } else if (isTagList(x)) {
-    if (length(x) == 0) {
-      # Empty lists are simply returned
-      x
-    } else {
-      # For items that are lists (but not tags), recurse
-      ret <- unlist(lapply(x, flattenTagsRaw), recursive = FALSE)
-      # Copy over attributes put on the original list (ex: html deps)
-      mostattributes(ret) <- attributes(x)
-      ret
+    # For items that are lists (but not tags), recurse
+    ret <- unlist(lapply(x, flattenTagsRaw), recursive = FALSE)
+    # Copy over attributes put on the original list (ex: html deps)
+    mostattributes(ret) <- attributes(x)
+
+    # Append individual html deps into the final list from the flattened tags
+    # It does not work out well to add attributes to `ret`, as the html deps are not found by findDependencies()
+    # Instead, use the _newer_/stable approach of adding the html dep as a direct child
+    tagListDeps <- htmlDependencies(ret)
+    # Append the incoming tagList's html deps to its children
+    tagListDepsLen <- length(tagListDeps)
+    if (tagListDepsLen > 0) {
+      # Do position insert to not lose attrs on ret
+      retLen <- length(ret)
+      ret[(retLen + 1):(retLen + tagListDepsLen)] <- tagListDeps
+      # Remove html deps on ret, as they are now in the children
+      htmlDependencies(ret) <- NULL
     }
+    ret
   } else {
     # This will preserve attributes if x is a character with attribute,
     # like what HTML() produces

tests/testthat/test-tag-query.R

@@ -770,18 +770,6 @@ test_that("tagQuery() allows for tags with extra top level items and will preser
 })
 
 
-test_that("flattenTagsRaw() and flattenTags() do not drop html deps", {
-  testSpan <- span()
-  htmlDependencies(testSpan) <- list(fakeJqueryDep)
-  otherObj <- HTML("test")
-  html <- tagList(div(), testSpan, otherObj)
-  htmlDependencies(html) <- list(fakeJqueryDep)
-
-  expect_equal(flattenTags(html), html)
-  expect_equal(flattenTagsRaw(html), html)
-})
-
-
 test_that("tag methods do not unexpectedly alter tag envs", {
 
   expect_equal_tags(
@@ -844,6 +832,71 @@ test_that("adding a class does not reorder attribs", {
 
 
 
+test_that("flattenTagsRaw() and flattenTags() do not drop html deps", {
+  emptyDiv <- div()
+  emptySpan <- span()
+  testSpan <- span("test")
+  otherObj <- HTML("test")
+
+  fakeDep <- function(i) {
+    ret <- fakeJqueryDep
+    ret$i <- i
+    ret
+  }
+
+  # `flattenTagsRaw()` moves html deps on tag lists to children
+  htmlRaw <- tagList(
+    emptyDiv,
+    tagAppendChild(emptySpan, fakeDep(1)),
+    tagAppendChild(testSpan, fakeDep(2)),
+    otherObj,
+    fakeDep(3)
+  )
+
+  htmlDependencies(emptySpan) <- list(fakeDep(1))
+  htmlDependencies(testSpan) <- list(fakeDep(2))
+  html <- tagList(
+    emptyDiv,
+    emptySpan,
+    testSpan,
+    otherObj
+  )
+  htmlDependencies(html) <- list(fakeDep(3))
+
+  expect_equal(flattenTags(html), html)
+  expect_equal(flattenTagsRaw(html), htmlRaw)
+})
+
+test_that("flattenTagsRaw(): tag list html deps are not lost when tag children are squashed", {
+  # https://github.com/rstudio/htmltools/issues/301
+
+  a_dep <- htmlDependency(name = "A", version = 1, src = "a.js")
+  b_dep <- htmlDependency(name = "B", version = 2, src = "b.js")
+  c_dep <- htmlDependency(name = "C", version = 3, src = "c.js")
+  d_dep <- htmlDependency(name = "D", version = 4, src = "d.js")
+
+  z <- div("Z")
+  z$children <- list(attachDependencies(list("z1"), d_dep))
+
+  children <-
+    attachDependencies(
+      list(
+        attachDependencies(list("X", "Y"), a_dep),
+        z
+      ),
+      list(b_dep, c_dep)
+    )
+
+  html <- div("test", children)
+  tq_html <- tagQuery(html)$allTags()
+
+  tq_deps <- findDependencies(tq_html$children)
+  expect_length(tq_deps, 4)
+  expect_equal(tq_deps, list(a_dep, d_dep, b_dep, c_dep))
+})
+
+
+