From 041c3273e5c5a57162c2111262ba8e7672edb25b Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Fri, 21 May 2021 17:13:38 -0500
Subject: [PATCH 01/11] Implement post render hooks; add hooks to tagList()

---
 R/tags.R                          | 104 ++++++++++++++++++------------
 man/builder.Rd                    |  42 ++++++------
 man/tagAddRenderHook.Rd           |  20 ++++--
 man/tagList.Rd                    |   2 +-
 tests/testthat/_snaps/tags.new.md |  89 +++++++++++++++++++++++++
 tests/testthat/test-tags.r        |   7 --
 6 files changed, 191 insertions(+), 73 deletions(-)
 create mode 100644 tests/testthat/_snaps/tags.new.md

diff --git a/R/tags.R b/R/tags.R
index 3e448785..54311f74 100644
--- a/R/tags.R
+++ b/R/tags.R
@@ -273,10 +273,19 @@ normalizeText <- function(text) {
 #'   h2("Header text"),
 #'   p("Text here")
 #' )
-tagList <- function(...) {
+tagList <- function(..., .renderHook = NULL, .postRenderHook = NULL) {
   lst <- dots_list(...)
   class(lst) <- c("shiny.tag.list", "list")
-  return(lst)
+
+  if (!is.null(.renderHook)) {
+    lst <- tagAddRenderHook(lst, func = .renderHook)
+  }
+
+  if (!is.null(.postRenderHook)) {
+    lst <- tagAddRenderHook(lst, func = .postRenderHook, post = TRUE)
+  }
+
+  lst
 }
 
 #' Tag function
@@ -312,8 +321,9 @@ tagFunction <- function(func) {
 
 #' Modify a tag prior to rendering
 #'
-#' Adds a hook to call on a [tag()] object when it is is rendered as HTML (with,
-#' for example, [print()], [renderTags()], [as.tags()], etc).
+#' Adds a hook to call on a [tag()] (or [tagList()]) object when it is is
+#' rendered as HTML (with, for example, [print()], [renderTags()], [as.tags()],
+#' etc).
 #'
 #' The primary motivation for [tagAddRenderHook()] is to create tags that can
 #' change their attributes (e.g., change CSS classes) depending upon the context
@@ -323,10 +333,13 @@ tagFunction <- function(func) {
 #' "black box" in the sense that you don't know anything about the tag structure
 #' until it's rendered.
 #'
-#' @param tag A [`tag()`] object.
-#' @param func A function (_hook_) to call when the `tag` is rendered. This function
-#'   should have at least one argument (the `tag`) and return anything that can
-#'   be converted into tags via [as.tags()].
+#' @param tag A [tag()] or [tagList()].
+#' @param func A function (_hook_) to call when the `tag` is rendered. This
+#'   function should have at least one argument (the `tag`) and it's return
+#'   value should be 'resolved' in the sense that it shouldn't return:
+#'   * A [tagFunction()].
+#'   * A [tag()] or [tagList()] with render hooks.
+#'   * Any object that requires a [as.tags()] call to be written to HTML.
 #' @param replace If `TRUE`, the previous hooks will be removed. If `FALSE`,
 #'   `func` is appended to the previous hooks.
 #' @return A [tag()] object with a `.renderHooks` field containing a list of functions
@@ -382,22 +395,24 @@ tagFunction <- function(func) {
 #'   tags$p("Something else")
 #' })
 #' newObj
-tagAddRenderHook <- function(tag, func, replace = FALSE) {
+tagAddRenderHook <- function(tag, func, replace = FALSE, post = FALSE) {
   if (!is.function(func) || length(formals(func)) == 0) {
     stop("`func` must be a function that accepts at least 1 argument")
   }
 
-  tag$.renderHooks <-
-    if (isTRUE(replace)) {
-      list(func)
-    } else {
-      append(tag$.renderHooks, list(func))
-    }
+  if (!(isTag(tag) || isTagList(tag))) {
+    stop("Can't set a renderHook on non tag/tagList objects", call. = FALSE)
+  }
 
+  name <- if (isTRUE(post)) "postRenderHooks" else "renderHooks"
+  hooks <- list(func)
+  if (!isTRUE(replace)) {
+    hooks <- append(attr(tag, name), hooks)
+  }
+  attr(tag, name) <- hooks
   tag
 }
 
-
 #' Append tag attributes
 #'
 #' Append (`tagAppendAttributes()`), check existence (`tagHasAttribute()`),
@@ -652,11 +667,11 @@ NULL
 tags <- lapply(known_tags, function(tagname) {
   # Overwrite the body with the `tagname` value injected into the body
   new_function(
-    args = exprs(... = , .noWS = NULL, .renderHook = NULL),
+    args = exprs(... = , .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL),
     expr({
       validateNoWS(.noWS)
       contents <- dots_list(...)
-      tag(!!tagname, contents, .noWS = .noWS, .renderHook = .renderHook)
+      tag(!!tagname, contents, .noWS = .noWS, .renderHook = .renderHook, .postRenderHook = .postRenderHook)
     }),
     env = asNamespace("htmltools")
   )
@@ -747,7 +762,7 @@ hr <- tags$hr
 #'   that can be converted into tags via [as.tags()]. Additional hooks may also be
 #'   added to a particular `tag` via [tagAddRenderHook()].
 #' @export
-tag <- function(`_tag_name`, varArgs, .noWS = NULL, .renderHook = NULL) {
+tag <- function(`_tag_name`, varArgs, .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL) {
   validateNoWS(.noWS)
   # Get arg names; if not a named list, use vector of empty strings
   varArgsNames <- names2(varArgs)
@@ -773,10 +788,10 @@ tag <- function(`_tag_name`, varArgs, .noWS = NULL, .renderHook = NULL) {
   # Conditionally include the `.renderHooks` field.
   # We do this to avoid breaking the hashes of existing tags that weren't leveraging .renderHooks.
   if (!is.null(.renderHook)) {
-    if (!is.list(.renderHook)) {
-      .renderHook <- list(.renderHook)
-    }
-    st$.renderHooks <- .renderHook
+    st <- tagAddRenderHook(st, .renderHook)
+  }
+  if (!is.null(.postRenderHook)) {
+    st <- tagAddRenderHook(st, .postRenderHook, post = TRUE)
   }
 
   # Return tag data structure
@@ -1203,12 +1218,31 @@ withTags <- function(code, .noWS = NULL) {
 
 # Make sure any objects in the tree that can be converted to tags, have been
 tagify <- function(x) {
-  rewriteTags(x, function(uiObj) {
-    if (isResolvedTag(uiObj) || isTagList(uiObj) || is.character(uiObj))
-      return(uiObj)
-    else
-      tagify(as.tags(uiObj))
-  }, FALSE)
+  rewriteTags(x, tagify_node, FALSE)
+}
+
+tagify_node <- function(ui) {
+  if (isTag(ui) || isTagList(ui)) {
+    pre <- attr(ui, "renderHooks")
+    post <- attr(ui, "postRenderHooks")
+    attr(ui, "renderHooks") <- NULL
+    attr(ui, "postRenderHooks") <- NULL
+
+    for (hook in pre) {
+      ui <- hook(ui)
+    }
+    for (hook in post) {
+      on.exit(return(hook(ui)), add = TRUE)
+    }
+    # Hooks must return a "writable" tag (TODO: throw if they don't?)
+    return(ui)
+  }
+
+  if (is.character(ui)) {
+    return(ui)
+  }
+
+  tagify(as.tags(ui))
 }
 
 # Given a list of tags, lists, and other items, return a flat list, where the
@@ -1324,17 +1358,7 @@ as.tags.html <- function(x, ...) {
 
 #' @export
 as.tags.shiny.tag <- function(x, ...) {
-  if (isResolvedTag(x)) {
-    return(x)
-  }
-
-  hook <- x$.renderHooks[[1]]
-  # remove first hook
-  x$.renderHooks[[1]] <- NULL
-  # Recursively call as.tags on the updated object
-  # (Perform in two lines to avoid lazy arg evaluation issues)
-  y <- hook(x)
-  as.tags(y)
+  x
 }
 
 #' @export
diff --git a/man/builder.Rd b/man/builder.Rd
index fe0515fd..0cd5f0ed 100644
--- a/man/builder.Rd
+++ b/man/builder.Rd
@@ -25,41 +25,47 @@
 \usage{
 tags
 
-p(..., .noWS = NULL, .renderHook = NULL)
+p(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-h1(..., .noWS = NULL, .renderHook = NULL)
+h1(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-h2(..., .noWS = NULL, .renderHook = NULL)
+h2(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-h3(..., .noWS = NULL, .renderHook = NULL)
+h3(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-h4(..., .noWS = NULL, .renderHook = NULL)
+h4(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-h5(..., .noWS = NULL, .renderHook = NULL)
+h5(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-h6(..., .noWS = NULL, .renderHook = NULL)
+h6(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-a(..., .noWS = NULL, .renderHook = NULL)
+a(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-br(..., .noWS = NULL, .renderHook = NULL)
+br(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-div(..., .noWS = NULL, .renderHook = NULL)
+div(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-span(..., .noWS = NULL, .renderHook = NULL)
+span(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-pre(..., .noWS = NULL, .renderHook = NULL)
+pre(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-code(..., .noWS = NULL, .renderHook = NULL)
+code(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-img(..., .noWS = NULL, .renderHook = NULL)
+img(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-strong(..., .noWS = NULL, .renderHook = NULL)
+strong(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-em(..., .noWS = NULL, .renderHook = NULL)
+em(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-hr(..., .noWS = NULL, .renderHook = NULL)
+hr(..., .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL)
 
-tag(`_tag_name`, varArgs, .noWS = NULL, .renderHook = NULL)
+tag(
+  `_tag_name`,
+  varArgs,
+  .noWS = NULL,
+  .renderHook = NULL,
+  .postRenderHook = NULL
+)
 }
 \arguments{
 \item{...}{Tag attributes (named arguments) and children (unnamed arguments).
diff --git a/man/tagAddRenderHook.Rd b/man/tagAddRenderHook.Rd
index baeb3647..917412b9 100644
--- a/man/tagAddRenderHook.Rd
+++ b/man/tagAddRenderHook.Rd
@@ -4,14 +4,19 @@
 \alias{tagAddRenderHook}
 \title{Modify a tag prior to rendering}
 \usage{
-tagAddRenderHook(tag, func, replace = FALSE)
+tagAddRenderHook(tag, func, replace = FALSE, post = FALSE)
 }
 \arguments{
-\item{tag}{A \code{\link[=tag]{tag()}} object.}
+\item{tag}{A \code{\link[=tag]{tag()}} or \code{\link[=tagList]{tagList()}}.}
 
-\item{func}{A function (\emph{hook}) to call when the \code{tag} is rendered. This function
-should have at least one argument (the \code{tag}) and return anything that can
-be converted into tags via \code{\link[=as.tags]{as.tags()}}.}
+\item{func}{A function (\emph{hook}) to call when the \code{tag} is rendered. This
+function should have at least one argument (the \code{tag}) and it's return
+value should be 'resolved' in the sense that it shouldn't return:
+\itemize{
+\item A \code{\link[=tagFunction]{tagFunction()}}.
+\item A \code{\link[=tag]{tag()}} or \code{\link[=tagList]{tagList()}} with render hooks.
+\item Any object that requires a \code{\link[=as.tags]{as.tags()}} call to be written to HTML.
+}}
 
 \item{replace}{If \code{TRUE}, the previous hooks will be removed. If \code{FALSE},
 \code{func} is appended to the previous hooks.}
@@ -22,8 +27,9 @@ A \code{\link[=tag]{tag()}} object with a \code{.renderHooks} field containing a
 these functions will be called just prior to writing the HTML.
 }
 \description{
-Adds a hook to call on a \code{\link[=tag]{tag()}} object when it is is rendered as HTML (with,
-for example, \code{\link[=print]{print()}}, \code{\link[=renderTags]{renderTags()}}, \code{\link[=as.tags]{as.tags()}}, etc).
+Adds a hook to call on a \code{\link[=tag]{tag()}} (or \code{\link[=tagList]{tagList()}}) object when it is is
+rendered as HTML (with, for example, \code{\link[=print]{print()}}, \code{\link[=renderTags]{renderTags()}}, \code{\link[=as.tags]{as.tags()}},
+etc).
 }
 \details{
 The primary motivation for \code{\link[=tagAddRenderHook]{tagAddRenderHook()}} is to create tags that can
diff --git a/man/tagList.Rd b/man/tagList.Rd
index 71e4ed69..0c6b6aeb 100644
--- a/man/tagList.Rd
+++ b/man/tagList.Rd
@@ -4,7 +4,7 @@
 \alias{tagList}
 \title{Create a list of tags}
 \usage{
-tagList(...)
+tagList(..., .renderHook = NULL, .postRenderHook = NULL)
 }
 \arguments{
 \item{...}{A collection of \link{tag}s.}
diff --git a/tests/testthat/_snaps/tags.new.md b/tests/testthat/_snaps/tags.new.md
new file mode 100644
index 00000000..1f6156c3
--- /dev/null
+++ b/tests/testthat/_snaps/tags.new.md
@@ -0,0 +1,89 @@
+# html render method
+
+    Code
+      as.character(obj)
+    Output
+      [1] "<span>example</span>"
+
+---
+
+    Code
+      as.character(spanExtra)
+    Output
+      [1] "<span class=\"extra\">example</span>"
+
+---
+
+    Code
+      as.character(divExtra)
+    Output
+      [1] "<div class=\"extra\">example</div>"
+
+---
+
+    Code
+      as.character(spanExtended)
+    Output
+      [1] "<span>\n  example\n  <strong>bold text</strong>\n</span>"
+
+---
+
+    Code
+      as.character(tagFuncExt)
+    Error <simpleError>
+      object of type 'closure' is not subsettable
+
+---
+
+    Code
+      renderTags(newDep)
+    Output
+      $head
+      
+      
+      $singletons
+      character(0)
+      
+      $dependencies
+      $dependencies[[1]]
+      List of 10
+       $ name      : chr "jqueryui"
+       $ version   : chr "1.11.4"
+       $ src       :List of 1
+        ..$ href: chr "shared/jqueryui"
+       $ meta      : NULL
+       $ script    : chr "jquery-ui.min.js"
+       $ stylesheet: NULL
+       $ head      : NULL
+       $ attachment: NULL
+       $ package   : NULL
+       $ all_files : logi TRUE
+       - attr(*, "class")= chr "html_dependency"
+      
+      $dependencies[[2]]
+      List of 10
+       $ name      : chr "font-awesome"
+       $ version   : chr "4.5.0"
+       $ src       :List of 1
+        ..$ href: chr "shared/font-awesome"
+       $ meta      : NULL
+       $ script    : NULL
+       $ stylesheet: chr "css/font-awesome.min.css"
+       $ head      : NULL
+       $ attachment: NULL
+       $ package   : NULL
+       $ all_files : logi TRUE
+       - attr(*, "class")= chr "html_dependency"
+      
+      
+      $html
+      <span>example</span>
+      
+
+---
+
+    Code
+      as.character(newObj)
+    Output
+      [1] "<p>Something else</p>"
+
diff --git a/tests/testthat/test-tags.r b/tests/testthat/test-tags.r
index 9c3283d4..d6d80b83 100644
--- a/tests/testthat/test-tags.r
+++ b/tests/testthat/test-tags.r
@@ -1014,13 +1014,6 @@ test_that("html render method", {
   expect_equal(spanExtended$children, obj$children)
   expect_snapshot(as.character(spanExtended))
 
-  tagFuncExt <- tagAddRenderHook(obj, function(x) {
-    tagFunction(function() tagList(x, tags$p("test")) )
-  })
-  expect_equal(tagFuncExt$name, "div")
-  expect_equal(tagFuncExt$children, obj$children)
-  expect_snapshot(as.character(tagFuncExt))
-
   # Add a new html dependency
   newDep <- tagAddRenderHook(obj, function(x) {
     fa <- htmlDependency(

From 85be9b4305360671997666316b3bd9e2d1b57bdb Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Fri, 21 May 2021 17:48:27 -0500
Subject: [PATCH 02/11] accept the snapshot removal

---
 tests/testthat/_snaps/tags.md     |  7 ---
 tests/testthat/_snaps/tags.new.md | 89 -------------------------------
 2 files changed, 96 deletions(-)
 delete mode 100644 tests/testthat/_snaps/tags.new.md

diff --git a/tests/testthat/_snaps/tags.md b/tests/testthat/_snaps/tags.md
index 9908eb21..e672c962 100644
--- a/tests/testthat/_snaps/tags.md
+++ b/tests/testthat/_snaps/tags.md
@@ -26,13 +26,6 @@
     Output
       [1] "<span>\n  example\n  <strong>bold text</strong>\n</span>"
 
----
-
-    Code
-      as.character(tagFuncExt)
-    Output
-      [1] "<span>example</span>\n<p>test</p>"
-
 ---
 
     Code
diff --git a/tests/testthat/_snaps/tags.new.md b/tests/testthat/_snaps/tags.new.md
deleted file mode 100644
index 1f6156c3..00000000
--- a/tests/testthat/_snaps/tags.new.md
+++ /dev/null
@@ -1,89 +0,0 @@
-# html render method
-
-    Code
-      as.character(obj)
-    Output
-      [1] "<span>example</span>"
-
----
-
-    Code
-      as.character(spanExtra)
-    Output
-      [1] "<span class=\"extra\">example</span>"
-
----
-
-    Code
-      as.character(divExtra)
-    Output
-      [1] "<div class=\"extra\">example</div>"
-
----
-
-    Code
-      as.character(spanExtended)
-    Output
-      [1] "<span>\n  example\n  <strong>bold text</strong>\n</span>"
-
----
-
-    Code
-      as.character(tagFuncExt)
-    Error <simpleError>
-      object of type 'closure' is not subsettable
-
----
-
-    Code
-      renderTags(newDep)
-    Output
-      $head
-      
-      
-      $singletons
-      character(0)
-      
-      $dependencies
-      $dependencies[[1]]
-      List of 10
-       $ name      : chr "jqueryui"
-       $ version   : chr "1.11.4"
-       $ src       :List of 1
-        ..$ href: chr "shared/jqueryui"
-       $ meta      : NULL
-       $ script    : chr "jquery-ui.min.js"
-       $ stylesheet: NULL
-       $ head      : NULL
-       $ attachment: NULL
-       $ package   : NULL
-       $ all_files : logi TRUE
-       - attr(*, "class")= chr "html_dependency"
-      
-      $dependencies[[2]]
-      List of 10
-       $ name      : chr "font-awesome"
-       $ version   : chr "4.5.0"
-       $ src       :List of 1
-        ..$ href: chr "shared/font-awesome"
-       $ meta      : NULL
-       $ script    : NULL
-       $ stylesheet: chr "css/font-awesome.min.css"
-       $ head      : NULL
-       $ attachment: NULL
-       $ package   : NULL
-       $ all_files : logi TRUE
-       - attr(*, "class")= chr "html_dependency"
-      
-      
-      $html
-      <span>example</span>
-      
-
----
-
-    Code
-      as.character(newObj)
-    Output
-      [1] "<p>Something else</p>"
-

From ac9739d1baff57fdf64e5e1238450cb22f55782e Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Fri, 21 May 2021 17:51:46 -0500
Subject: [PATCH 03/11] bump version

---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index eb4f7b1e..92b7f793 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: htmltools
 Type: Package
 Title: Tools for HTML
-Version: 0.5.1.9005
+Version: 0.5.1.9006
 Authors@R: c(
   person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
   person("Carson", "Sievert", role = c("aut", "cre"), email = "carson@rstudio.com", comment = c(ORCID = "0000-0002-4958-2844")),

From 3d6d58fb47f3a2b7c19381d4c0259624242a88a4 Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Tue, 25 May 2021 17:30:43 -0500
Subject: [PATCH 04/11] Properly schedule postRenderHook and require it to have
 no formal arguments

---
 R/tags.R | 65 +++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 38 insertions(+), 27 deletions(-)

diff --git a/R/tags.R b/R/tags.R
index 54311f74..3c3c4665 100644
--- a/R/tags.R
+++ b/R/tags.R
@@ -175,10 +175,6 @@ dropNullsOrEmpty <- function(x) {
   x[!vapply(x, nullOrEmpty, FUN.VALUE=logical(1))]
 }
 
-isResolvedTag <- function(x) {
-  inherits(x, "shiny.tag") && length(x$.renderHooks) == 0
-}
-
 isTag <- function(x) {
   inherits(x, "shiny.tag")
 }
@@ -282,7 +278,7 @@ tagList <- function(..., .renderHook = NULL, .postRenderHook = NULL) {
   }
 
   if (!is.null(.postRenderHook)) {
-    lst <- tagAddRenderHook(lst, func = .postRenderHook, post = TRUE)
+    lst <- tagAddPostRenderHook(lst, func = .postRenderHook)
   }
 
   lst
@@ -395,16 +391,27 @@ tagFunction <- function(func) {
 #'   tags$p("Something else")
 #' })
 #' newObj
-tagAddRenderHook <- function(tag, func, replace = FALSE, post = FALSE) {
+tagAddRenderHook <- function(tag, func, replace = FALSE) {
   if (!is.function(func) || length(formals(func)) == 0) {
     stop("`func` must be a function that accepts at least 1 argument")
   }
+  addRenderHook(tag, func, replace, post = FALSE)
+}
+
+#' @export
+#' @rdname tagAddRenderHook
+tagAddPostRenderHook <- function(tag, func, replace = FALSE) {
+  if (!is.function(func) || length(formals(func)) != 0) {
+    stop("`func` must be a function that accepts 0 arguments")
+  }
+  addRenderHook(tag, func, replace, post = TRUE)
+}
 
+addRenderHook <- function(tag, func, replace, post = FALSE) {
   if (!(isTag(tag) || isTagList(tag))) {
     stop("Can't set a renderHook on non tag/tagList objects", call. = FALSE)
   }
-
-  name <- if (isTRUE(post)) "postRenderHooks" else "renderHooks"
+  name <- if (isTRUE(post)) "renderHook" else "postRenderHooks"
   hooks <- list(func)
   if (!isTRUE(replace)) {
     hooks <- append(attr(tag, name), hooks)
@@ -791,7 +798,7 @@ tag <- function(`_tag_name`, varArgs, .noWS = NULL, .renderHook = NULL, .postRen
     st <- tagAddRenderHook(st, .renderHook)
   }
   if (!is.null(.postRenderHook)) {
-    st <- tagAddRenderHook(st, .postRenderHook, post = TRUE)
+    st <- tagAddPostRenderHook(st, .postRenderHook)
   }
 
   # Return tag data structure
@@ -1218,31 +1225,35 @@ withTags <- function(code, .noWS = NULL) {
 
 # Make sure any objects in the tree that can be converted to tags, have been
 tagify <- function(x) {
-  rewriteTags(x, tagify_node, FALSE)
-}
 
-tagify_node <- function(ui) {
-  if (isTag(ui) || isTagList(ui)) {
-    pre <- attr(ui, "renderHooks")
-    post <- attr(ui, "postRenderHooks")
-    attr(ui, "renderHooks") <- NULL
-    attr(ui, "postRenderHooks") <- NULL
+  # Schedule .postRenderHook(s) to run _after_ converting to tags
+  postHooks <- list()
+  on.exit({
+    for (hook in postHooks) tryWarn(hook())
+  })
+
+  rewriteTags(x, function(ui) {
+    if (is.character(ui)) return(ui)
 
+    pre <- attr(ui, "renderHooks")
     for (hook in pre) {
-      ui <- hook(ui)
+      tryWarn(ui <- as.tags(hook(ui)))
     }
-    for (hook in post) {
-      on.exit(return(hook(ui)), add = TRUE)
+    attr(ui, "renderHooks") <- NULL
+
+    post <- attr(ui, "postRenderHooks")
+    if (length(post)) {
+      postHooks <<- c(postHooks, post)
+      attr(ui, "postRenderHooks") <- NULL
     }
-    # Hooks must return a "writable" tag (TODO: throw if they don't?)
-    return(ui)
-  }
 
-  if (is.character(ui)) {
-    return(ui)
-  }
+    if (isTag(ui) || isTagList(ui)) ui else tagify(as.tags(ui))
+
+  }, FALSE)
+}
 
-  tagify(as.tags(ui))
+tryWarn <- function(expr) {
+  tryCatch(expr, error = function(e) warning(conditionMessage(e)))
 }
 
 # Given a list of tags, lists, and other items, return a flat list, where the

From 3f6f3620af628d6f9cb17c4bfb7270c34fce52db Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Wed, 26 May 2021 12:01:46 -0500
Subject: [PATCH 05/11] Fix bug

---
 R/tags.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/tags.R b/R/tags.R
index 3c3c4665..1a77a68f 100644
--- a/R/tags.R
+++ b/R/tags.R
@@ -411,7 +411,7 @@ addRenderHook <- function(tag, func, replace, post = FALSE) {
   if (!(isTag(tag) || isTagList(tag))) {
     stop("Can't set a renderHook on non tag/tagList objects", call. = FALSE)
   }
-  name <- if (isTRUE(post)) "renderHook" else "postRenderHooks"
+  name <- if (isTRUE(post)) "postRenderHook" else "renderHooks"
   hooks <- list(func)
   if (!isTRUE(replace)) {
     hooks <- append(attr(tag, name), hooks)

From 101a4741b9fec4d88171c569ba39e55382373c8b Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Thu, 27 May 2021 10:26:03 -0500
Subject: [PATCH 06/11] Handle hooks prior to the rewriteTags() call

---
 NAMESPACE               |  1 +
 R/tags.R                | 55 +++++++++++++++++++++++------------------
 man/tagAddRenderHook.Rd |  5 +++-
 3 files changed, 36 insertions(+), 25 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 65f3724a..39d230d2 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -90,6 +90,7 @@ export(subtractDependencies)
 export(suppressDependencies)
 export(surroundSingletons)
 export(tag)
+export(tagAddPostRenderHook)
 export(tagAddRenderHook)
 export(tagAppendAttributes)
 export(tagAppendChild)
diff --git a/R/tags.R b/R/tags.R
index 1a77a68f..ee40e8d6 100644
--- a/R/tags.R
+++ b/R/tags.R
@@ -1226,36 +1226,43 @@ withTags <- function(code, .noWS = NULL) {
 # Make sure any objects in the tree that can be converted to tags, have been
 tagify <- function(x) {
 
-  # Schedule .postRenderHook(s) to run _after_ converting to tags
-  postHooks <- list()
-  on.exit({
-    for (hook in postHooks) tryWarn(hook())
-  })
-
-  rewriteTags(x, function(ui) {
-    if (is.character(ui)) return(ui)
-
-    pre <- attr(ui, "renderHooks")
-    for (hook in pre) {
-      tryWarn(ui <- as.tags(hook(ui)))
-    }
-    attr(ui, "renderHooks") <- NULL
-
-    post <- attr(ui, "postRenderHooks")
-    if (length(post)) {
-      postHooks <<- c(postHooks, post)
-      attr(ui, "postRenderHooks") <- NULL
-    }
-
-    if (isTag(ui) || isTagList(ui)) ui else tagify(as.tags(ui))
+  # Run pre-render hooks now, post-render after tag conversion (if relevant)
+  if (!isResolvedTag(x)) {
+    pre <- attr(x, "renderHooks")
+    post <- attr(x, "postRenderHooks")
+    attr(x, "renderHooks") <- NULL
+    attr(x, "postRenderHooks") <- NULL
+    for (hook in pre) x <- tryHook(x, hook)
+    on.exit(for (hook in post) x <- tryHook(x, hook), add = TRUE)
+  }
 
+  rewriteTags(x, function(uiObj) {
+    if (isResolvedTag(uiObj) || is.character(uiObj))
+      uiObj
+    else
+      tagify(as.tags(uiObj))
   }, FALSE)
 }
 
-tryWarn <- function(expr) {
-  tryCatch(expr, error = function(e) warning(conditionMessage(e)))
+isResolvedTag <- function(x) {
+  (isTag(x) || isTagList(x)) &&
+    is.null(attr(x, "renderHooks")) &&
+    is.null(attr(x, "postRenderHooks"))
+}
+
+tryHook <- function(x, hook) {
+  msg <- NULL
+  x <- tryCatch({ hook(x) }, error = function(e) {
+    msg <<- conditionMessage(e)
+  })
+  if (length(msg)) {
+    warning(msg, call. = FALSE)
+  }
+  x
 }
 
+
+
 # Given a list of tags, lists, and other items, return a flat list, where the
 # items from the inner, nested lists are pulled to the top level, recursively.
 # Be sure to check for tagEnvLike objects and not allow them
diff --git a/man/tagAddRenderHook.Rd b/man/tagAddRenderHook.Rd
index 917412b9..1f516230 100644
--- a/man/tagAddRenderHook.Rd
+++ b/man/tagAddRenderHook.Rd
@@ -2,9 +2,12 @@
 % Please edit documentation in R/tags.R
 \name{tagAddRenderHook}
 \alias{tagAddRenderHook}
+\alias{tagAddPostRenderHook}
 \title{Modify a tag prior to rendering}
 \usage{
-tagAddRenderHook(tag, func, replace = FALSE, post = FALSE)
+tagAddRenderHook(tag, func, replace = FALSE)
+
+tagAddPostRenderHook(tag, func, replace = FALSE)
 }
 \arguments{
 \item{tag}{A \code{\link[=tag]{tag()}} or \code{\link[=tagList]{tagList()}}.}

From 67986daad96121860882d768f64e65cfd812b099 Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Thu, 27 May 2021 11:05:20 -0500
Subject: [PATCH 07/11] Resolve tags prior to rewriteTags(); allow hooks to
 return un-resolved tags; get checks passing

---
 R/tags.R                | 71 +++++++++++++++++++++--------------------
 man/builder.Rd          | 14 +++++---
 man/tagAddRenderHook.Rd | 34 ++++++--------------
 man/tagList.Rd          | 11 +++++++
 4 files changed, 68 insertions(+), 62 deletions(-)

diff --git a/R/tags.R b/R/tags.R
index ee40e8d6..c45ab142 100644
--- a/R/tags.R
+++ b/R/tags.R
@@ -262,6 +262,7 @@ normalizeText <- function(text) {
 #' etc.
 #'
 #' @param ... A collection of [tag]s.
+#' @inheritParams tag
 #' @export
 #' @examples
 #' tagList(
@@ -315,34 +316,24 @@ tagFunction <- function(func) {
   structure(func, class = "shiny.tag.function")
 }
 
-#' Modify a tag prior to rendering
+#' Modify a tag during the render phase
 #'
-#' Adds a hook to call on a [tag()] (or [tagList()]) object when it is is
-#' rendered as HTML (with, for example, [print()], [renderTags()], [as.tags()],
-#' etc).
+#' Add hook(s) to modify [tag()] (or [tagList()]) object(s) during the render
+#' phase (i.e., when [renderTags()] / [print()] / [as.character()] / etc. happens).
 #'
-#' The primary motivation for [tagAddRenderHook()] is to create tags that can
-#' change their attributes (e.g., change CSS classes) depending upon the context
-#' in which they're rendered (e.g., use one set of CSS classes in one a page
-#' layout, but a different set in another page layout). In this situation,
-#' [tagAddRenderHook()] is preferable to [tagFunction()] since the latter is more a
-#' "black box" in the sense that you don't know anything about the tag structure
-#' until it's rendered.
+#' These hooks allow tags to change their attributes (e.g., change CSS classes)
+#' and/or change their entire HTML structure, depending upon the context in
+#' which they're rendered. For example, you may want to an HTML widget to emit
+#' different HTML depending on what HTML dependencies are being included on the
+#' page.
 #'
 #' @param tag A [tag()] or [tagList()].
 #' @param func A function (_hook_) to call when the `tag` is rendered. This
-#'   function should have at least one argument (the `tag`) and it's return
-#'   value should be 'resolved' in the sense that it shouldn't return:
-#'   * A [tagFunction()].
-#'   * A [tag()] or [tagList()] with render hooks.
-#'   * Any object that requires a [as.tags()] call to be written to HTML.
+#'   function should have at least one argument (the `tag`).
 #' @param replace If `TRUE`, the previous hooks will be removed. If `FALSE`,
 #'   `func` is appended to the previous hooks.
-#' @return A [tag()] object with a `.renderHooks` field containing a list of functions
-#'   (e.g. `func`). When the return value is _rendered_ (such as with [`as.tags()`]),
-#'   these functions will be called just prior to writing the HTML.
+#' @return A [tag()] object.
 #' @export
-#' @seealso [tagFunction()]
 #' @examples
 #' # Have a place holder div and return a span instead
 #' obj <- div("example", .renderHook = function(x) {
@@ -392,22 +383,19 @@ tagFunction <- function(func) {
 #' })
 #' newObj
 tagAddRenderHook <- function(tag, func, replace = FALSE) {
-  if (!is.function(func) || length(formals(func)) == 0) {
-    stop("`func` must be a function that accepts at least 1 argument")
-  }
   addRenderHook(tag, func, replace, post = FALSE)
 }
 
 #' @export
 #' @rdname tagAddRenderHook
 tagAddPostRenderHook <- function(tag, func, replace = FALSE) {
-  if (!is.function(func) || length(formals(func)) != 0) {
-    stop("`func` must be a function that accepts 0 arguments")
-  }
   addRenderHook(tag, func, replace, post = TRUE)
 }
 
 addRenderHook <- function(tag, func, replace, post = FALSE) {
+  if (!is.function(func) || length(formals(func)) == 0) {
+    stop("`func` must be a function that accepts at least 1 argument")
+  }
   if (!(isTag(tag) || isTagList(tag))) {
     stop("Can't set a renderHook on non tag/tagList objects", call. = FALSE)
   }
@@ -764,10 +752,15 @@ hr <- tags$hr
 #'   normally be written around this tag. Valid options include `before`,
 #'   `after`, `outside`, `after-begin`, and `before-end`.
 #'   Any number of these options can be specified.
-#' @param .renderHook A function (or list of functions) to call when the `tag` is rendered. This
-#'   function should have at least one argument (the `tag`) and return anything
-#'   that can be converted into tags via [as.tags()]. Additional hooks may also be
-#'   added to a particular `tag` via [tagAddRenderHook()].
+#' @param .renderHook A function (or list of functions) to call when the `tag`
+#'   is rendered. Each function should have at least one argument (the `tag`).
+#'   Additional hooks may also be added to a particular `tag` via
+#'   [tagAddRenderHook()] (see there for more details and examples).
+#' @param .postRenderHook A function (or list of functions) to call after the
+#'   entire HTML tree has rendered. Each function should have at least one
+#'   argument (the `tag`). Additional hooks may also be added to a particular
+#'   `tag` via [tagAddPostRenderHook()] (see there for more details and
+#'   examples).
 #' @export
 tag <- function(`_tag_name`, varArgs, .noWS = NULL, .renderHook = NULL, .postRenderHook = NULL) {
   validateNoWS(.noWS)
@@ -1227,29 +1220,39 @@ withTags <- function(code, .noWS = NULL) {
 tagify <- function(x) {
 
   # Run pre-render hooks now, post-render after tag conversion (if relevant)
-  if (!isResolvedTag(x)) {
+  if (isTagLike(x) && !isResolvedTag(x)) {
     pre <- attr(x, "renderHooks")
     post <- attr(x, "postRenderHooks")
     attr(x, "renderHooks") <- NULL
     attr(x, "postRenderHooks") <- NULL
     for (hook in pre) x <- tryHook(x, hook)
-    on.exit(for (hook in post) x <- tryHook(x, hook), add = TRUE)
+    x <- tagify(as.tags(x))
+    on.exit({
+      for (hook in post) x <- tryHook(x, hook)
+      return(tagify(as.tags(x)))
+    }, add = TRUE)
   }
 
-  rewriteTags(x, function(uiObj) {
+  x <- rewriteTags(x, function(uiObj) {
     if (isResolvedTag(uiObj) || is.character(uiObj))
       uiObj
     else
       tagify(as.tags(uiObj))
   }, FALSE)
+
+  x
 }
 
 isResolvedTag <- function(x) {
-  (isTag(x) || isTagList(x)) &&
+  isTagLike(x) &&
     is.null(attr(x, "renderHooks")) &&
     is.null(attr(x, "postRenderHooks"))
 }
 
+isTagLike <- function(x) {
+  isTag(x) || isTagList(x)
+}
+
 tryHook <- function(x, hook) {
   msg <- NULL
   x <- tryCatch({ hook(x) }, error = function(e) {
diff --git a/man/builder.Rd b/man/builder.Rd
index 0cd5f0ed..4fd48f58 100644
--- a/man/builder.Rd
+++ b/man/builder.Rd
@@ -84,10 +84,16 @@ normally be written around this tag. Valid options include \code{before},
 \code{after}, \code{outside}, \code{after-begin}, and \code{before-end}.
 Any number of these options can be specified.}
 
-\item{.renderHook}{A function (or list of functions) to call when the \code{tag} is rendered. This
-function should have at least one argument (the \code{tag}) and return anything
-that can be converted into tags via \code{\link[=as.tags]{as.tags()}}. Additional hooks may also be
-added to a particular \code{tag} via \code{\link[=tagAddRenderHook]{tagAddRenderHook()}}.}
+\item{.renderHook}{A function (or list of functions) to call when the \code{tag}
+is rendered. Each function should have at least one argument (the \code{tag}).
+Additional hooks may also be added to a particular \code{tag} via
+\code{\link[=tagAddRenderHook]{tagAddRenderHook()}} (see there for more details and examples).}
+
+\item{.postRenderHook}{A function (or list of functions) to call after the
+entire HTML tree has rendered. Each function should have at least one
+argument (the \code{tag}). Additional hooks may also be added to a particular
+\code{tag} via \code{\link[=tagAddPostRenderHook]{tagAddPostRenderHook()}} (see there for more details and
+examples).}
 
 \item{_tag_name}{A character string to use for the tag name.}
 
diff --git a/man/tagAddRenderHook.Rd b/man/tagAddRenderHook.Rd
index 1f516230..d37518ff 100644
--- a/man/tagAddRenderHook.Rd
+++ b/man/tagAddRenderHook.Rd
@@ -3,7 +3,7 @@
 \name{tagAddRenderHook}
 \alias{tagAddRenderHook}
 \alias{tagAddPostRenderHook}
-\title{Modify a tag prior to rendering}
+\title{Modify a tag during the render phase}
 \usage{
 tagAddRenderHook(tag, func, replace = FALSE)
 
@@ -13,35 +13,24 @@ tagAddPostRenderHook(tag, func, replace = FALSE)
 \item{tag}{A \code{\link[=tag]{tag()}} or \code{\link[=tagList]{tagList()}}.}
 
 \item{func}{A function (\emph{hook}) to call when the \code{tag} is rendered. This
-function should have at least one argument (the \code{tag}) and it's return
-value should be 'resolved' in the sense that it shouldn't return:
-\itemize{
-\item A \code{\link[=tagFunction]{tagFunction()}}.
-\item A \code{\link[=tag]{tag()}} or \code{\link[=tagList]{tagList()}} with render hooks.
-\item Any object that requires a \code{\link[=as.tags]{as.tags()}} call to be written to HTML.
-}}
+function should have at least one argument (the \code{tag}).}
 
 \item{replace}{If \code{TRUE}, the previous hooks will be removed. If \code{FALSE},
 \code{func} is appended to the previous hooks.}
 }
 \value{
-A \code{\link[=tag]{tag()}} object with a \code{.renderHooks} field containing a list of functions
-(e.g. \code{func}). When the return value is \emph{rendered} (such as with \code{\link[=as.tags]{as.tags()}}),
-these functions will be called just prior to writing the HTML.
+A \code{\link[=tag]{tag()}} object.
 }
 \description{
-Adds a hook to call on a \code{\link[=tag]{tag()}} (or \code{\link[=tagList]{tagList()}}) object when it is is
-rendered as HTML (with, for example, \code{\link[=print]{print()}}, \code{\link[=renderTags]{renderTags()}}, \code{\link[=as.tags]{as.tags()}},
-etc).
+Add hook(s) to modify \code{\link[=tag]{tag()}} (or \code{\link[=tagList]{tagList()}}) object(s) during the render
+phase (i.e., when \code{\link[=renderTags]{renderTags()}} / \code{\link[=print]{print()}} / \code{\link[=as.character]{as.character()}} / etc. happens).
 }
 \details{
-The primary motivation for \code{\link[=tagAddRenderHook]{tagAddRenderHook()}} is to create tags that can
-change their attributes (e.g., change CSS classes) depending upon the context
-in which they're rendered (e.g., use one set of CSS classes in one a page
-layout, but a different set in another page layout). In this situation,
-\code{\link[=tagAddRenderHook]{tagAddRenderHook()}} is preferable to \code{\link[=tagFunction]{tagFunction()}} since the latter is more a
-"black box" in the sense that you don't know anything about the tag structure
-until it's rendered.
+These hooks allow tags to change their attributes (e.g., change CSS classes)
+and/or change their entire HTML structure, depending upon the context in
+which they're rendered. For example, you may want to an HTML widget to emit
+different HTML depending on what HTML dependencies are being included on the
+page.
 }
 \examples{
 # Have a place holder div and return a span instead
@@ -92,6 +81,3 @@ newObj <- tagAddRenderHook(obj, function(x) {
 })
 newObj
 }
-\seealso{
-\code{\link[=tagFunction]{tagFunction()}}
-}
diff --git a/man/tagList.Rd b/man/tagList.Rd
index 0c6b6aeb..968b4ca0 100644
--- a/man/tagList.Rd
+++ b/man/tagList.Rd
@@ -8,6 +8,17 @@ tagList(..., .renderHook = NULL, .postRenderHook = NULL)
 }
 \arguments{
 \item{...}{A collection of \link{tag}s.}
+
+\item{.renderHook}{A function (or list of functions) to call when the \code{tag}
+is rendered. Each function should have at least one argument (the \code{tag}).
+Additional hooks may also be added to a particular \code{tag} via
+\code{\link[=tagAddRenderHook]{tagAddRenderHook()}} (see there for more details and examples).}
+
+\item{.postRenderHook}{A function (or list of functions) to call after the
+entire HTML tree has rendered. Each function should have at least one
+argument (the \code{tag}). Additional hooks may also be added to a particular
+\code{tag} via \code{\link[=tagAddPostRenderHook]{tagAddPostRenderHook()}} (see there for more details and
+examples).}
 }
 \description{
 Create a \code{list()} of \link{tag}s with methods for \code{\link[=print]{print()}}, \code{\link[=as.character]{as.character()}},

From 5029b52e7849877e0ec663e88aed69d96aaea125 Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Thu, 27 May 2021 11:09:15 -0500
Subject: [PATCH 08/11] Fix tryHook() return value on error

---
 R/tags.R | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/R/tags.R b/R/tags.R
index c45ab142..2ff44422 100644
--- a/R/tags.R
+++ b/R/tags.R
@@ -1254,14 +1254,10 @@ isTagLike <- function(x) {
 }
 
 tryHook <- function(x, hook) {
-  msg <- NULL
-  x <- tryCatch({ hook(x) }, error = function(e) {
-    msg <<- conditionMessage(e)
+  tryCatch({ hook(x) }, error = function(e) {
+    warning(conditionMessage(e), call. = FALSE)
+    x
   })
-  if (length(msg)) {
-    warning(msg, call. = FALSE)
-  }
-  x
 }
 
 

From c94f6386d5fedf2055fa5837772c4a1f9a2bde4d Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Thu, 27 May 2021 15:55:46 -0500
Subject: [PATCH 09/11] Refactor hook adding logic

---
 R/tags.R | 37 ++++++++++++++++++-------------------
 1 file changed, 18 insertions(+), 19 deletions(-)

diff --git a/R/tags.R b/R/tags.R
index 2ff44422..573a2a71 100644
--- a/R/tags.R
+++ b/R/tags.R
@@ -271,16 +271,12 @@ normalizeText <- function(text) {
 #'   p("Text here")
 #' )
 tagList <- function(..., .renderHook = NULL, .postRenderHook = NULL) {
+
   lst <- dots_list(...)
   class(lst) <- c("shiny.tag.list", "list")
 
-  if (!is.null(.renderHook)) {
-    lst <- tagAddRenderHook(lst, func = .renderHook)
-  }
-
-  if (!is.null(.postRenderHook)) {
-    lst <- tagAddPostRenderHook(lst, func = .postRenderHook)
-  }
+  lst <- tagAddHooks(lst, .renderHook, tagAddRenderHook)
+  lst <- tagAddHooks(lst, .postRenderHook, tagAddPostRenderHook)
 
   lst
 }
@@ -399,7 +395,7 @@ addRenderHook <- function(tag, func, replace, post = FALSE) {
   if (!(isTag(tag) || isTagList(tag))) {
     stop("Can't set a renderHook on non tag/tagList objects", call. = FALSE)
   }
-  name <- if (isTRUE(post)) "postRenderHook" else "renderHooks"
+  name <- if (isTRUE(post)) "postRenderHooks" else "renderHooks"
   hooks <- list(func)
   if (!isTRUE(replace)) {
     hooks <- append(attr(tag, name), hooks)
@@ -780,22 +776,27 @@ tag <- function(`_tag_name`, varArgs, .noWS = NULL, .renderHook = NULL, .postRen
       attribs = attribs,
       children = children)
 
+  class(st) <- "shiny.tag"
+
   # Conditionally include the `.noWS` field.
   # We do this to avoid breaking the hashes of existing tags that weren't leveraging .noWS.
   if (!is.null(.noWS)) {
     st$.noWS <- .noWS
   }
-  # Conditionally include the `.renderHooks` field.
-  # We do this to avoid breaking the hashes of existing tags that weren't leveraging .renderHooks.
-  if (!is.null(.renderHook)) {
-    st <- tagAddRenderHook(st, .renderHook)
+
+  st <- tagAddHooks(st, funcs = .renderHook, addFunc = tagAddRenderHook)
+  tagAddHooks(st, funcs = .postRenderHook, addFunc = tagAddPostRenderHook)
+}
+
+tagAddHooks <- function(tag, funcs = NULL, addFunc = tagAddRenderHook) {
+  if (is.null(funcs)) return(tag)
+  if (is.function(funcs)) {
+    funcs <- list(funcs)
   }
-  if (!is.null(.postRenderHook)) {
-    st <- tagAddPostRenderHook(st, .postRenderHook)
+  for (func in funcs) {
+    tag <- addFunc(tag, func)
   }
-
-  # Return tag data structure
-  structure(st, class = "shiny.tag")
+  tag
 }
 
 isTagList <- function(x) {
@@ -1260,8 +1261,6 @@ tryHook <- function(x, hook) {
   })
 }
 
-
-
 # Given a list of tags, lists, and other items, return a flat list, where the
 # items from the inner, nested lists are pulled to the top level, recursively.
 # Be sure to check for tagEnvLike objects and not allow them

From 99c4ad180ae7f4150416772b902c0879ab48a63a Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Thu, 27 May 2021 16:53:00 -0500
Subject: [PATCH 10/11] Use withr to schedule post render hooks to run; unit
 tests for order execution

---
 DESCRIPTION                        |   3 +-
 R/tags.R                           |  71 ++++-----
 tests/testthat/_snaps/tag-hooks.md |  39 +++++
 tests/testthat/test-tag-hooks.R    | 224 +++++++++++++++++++++++++++++
 4 files changed, 296 insertions(+), 41 deletions(-)
 create mode 100644 tests/testthat/_snaps/tag-hooks.md
 create mode 100644 tests/testthat/test-tag-hooks.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 92b7f793..02730005 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -20,7 +20,8 @@ Imports:
     grDevices,
     base64enc,
     rlang (>= 0.4.11.9000),
-    fastmap
+    fastmap,
+    withr
 Suggests:
     markdown,
     testthat,
diff --git a/R/tags.R b/R/tags.R
index 573a2a71..e21dc18b 100644
--- a/R/tags.R
+++ b/R/tags.R
@@ -389,9 +389,10 @@ tagAddPostRenderHook <- function(tag, func, replace = FALSE) {
 }
 
 addRenderHook <- function(tag, func, replace, post = FALSE) {
-  if (!is.function(func) || length(formals(func)) == 0) {
-    stop("`func` must be a function that accepts at least 1 argument")
-  }
+  # TODO: can postRender hooks have an arg?
+  #if (!is.function(func) || length(formals(func)) == 0) {
+  #  stop("`func` must be a function that accepts at least 1 argument")
+  #}
   if (!(isTag(tag) || isTagList(tag))) {
     stop("Can't set a renderHook on non tag/tagList objects", call. = FALSE)
   }
@@ -1219,46 +1220,36 @@ withTags <- function(code, .noWS = NULL) {
 
 # Make sure any objects in the tree that can be converted to tags, have been
 tagify <- function(x) {
+  rewriteTags(x, function(ui) {
+    if (is.character(ui)) return(ui)
+
+    pre <- attr(ui, "renderHooks")
+    post <- attr(ui, "postRenderHooks")
+    attr(ui, "renderHooks") <- NULL
+    attr(ui, "postRenderHooks") <- NULL
+
+    for (hook in pre) {
+      ui <- tryCatch({ hook(ui) }, error = function(e) {
+        warning(conditionMessage(e), call. = FALSE)
+        ui
+      })
+    }
 
-  # Run pre-render hooks now, post-render after tag conversion (if relevant)
-  if (isTagLike(x) && !isResolvedTag(x)) {
-    pre <- attr(x, "renderHooks")
-    post <- attr(x, "postRenderHooks")
-    attr(x, "renderHooks") <- NULL
-    attr(x, "postRenderHooks") <- NULL
-    for (hook in pre) x <- tryHook(x, hook)
-    x <- tagify(as.tags(x))
-    on.exit({
-      for (hook in post) x <- tryHook(x, hook)
-      return(tagify(as.tags(x)))
-    }, add = TRUE)
-  }
+    # Since tagify() is called recursively within this anonymous function (which
+    # is applied in a preorder=F fashion), I don't think we can simply schedule
+    # post hooks with an on.exit() since both tagify() and this anonymous
+    # function both exit before we've walked the entire tree.
+    if (length(post)) {
+      withr::defer(
+        for (hook in post)
+          tryCatch(hook(), error = function(e) warning(conditionMessage(e), call. = FALSE)),
+        envir = parent.frame(2L),
+        priority = "last"
+      )
+    }
 
-  x <- rewriteTags(x, function(uiObj) {
-    if (isResolvedTag(uiObj) || is.character(uiObj))
-      uiObj
-    else
-      tagify(as.tags(uiObj))
+    if (isTag(ui) || isTagList(ui)) ui else tagify(as.tags(ui))
   }, FALSE)
-
-  x
-}
-
-isResolvedTag <- function(x) {
-  isTagLike(x) &&
-    is.null(attr(x, "renderHooks")) &&
-    is.null(attr(x, "postRenderHooks"))
-}
-
-isTagLike <- function(x) {
-  isTag(x) || isTagList(x)
-}
-
-tryHook <- function(x, hook) {
-  tryCatch({ hook(x) }, error = function(e) {
-    warning(conditionMessage(e), call. = FALSE)
-    x
-  })
 }
 
 # Given a list of tags, lists, and other items, return a flat list, where the
diff --git a/tests/testthat/_snaps/tag-hooks.md b/tests/testthat/_snaps/tag-hooks.md
new file mode 100644
index 00000000..b6150d9f
--- /dev/null
+++ b/tests/testthat/_snaps/tag-hooks.md
@@ -0,0 +1,39 @@
+# render hooks can be used to 
+
+    Code
+      bar_widget
+    Output
+      <div></div>
+
+---
+
+    Code
+      renderTags(html)
+    Output
+      $head
+      
+      
+      $singletons
+      character(0)
+      
+      $dependencies
+      $dependencies[[1]]
+      List of 10
+       $ name      : chr "bar"
+       $ version   : chr "1.0"
+       $ src       :List of 1
+        ..$ file: chr ""
+       $ meta      : NULL
+       $ script    : NULL
+       $ stylesheet: NULL
+       $ head      : NULL
+       $ attachment: NULL
+       $ package   : NULL
+       $ all_files : logi TRUE
+       - attr(*, "class")= chr "html_dependency"
+      
+      
+      $html
+      <div class="bar"></div>
+      
+
diff --git a/tests/testthat/test-tag-hooks.R b/tests/testthat/test-tag-hooks.R
new file mode 100644
index 00000000..462fff72
--- /dev/null
+++ b/tests/testthat/test-tag-hooks.R
@@ -0,0 +1,224 @@
+# expect_tag_hooks <- function(tagFunc, ..., .render = NULL, .postRender = NULL) {
+#   x <- tagFunc(..., .renderHook = .render, .postRenderHook = .postRender)
+#
+#   y <- tagFunc(...)
+#   y <- tagAddHooks(y, .render, tagAddRenderHook)
+#   y <- tagAddHooks(y, .postRender, tagAddPostRenderHook)
+#
+#   expect_same_html(x, y)
+# }
+#
+# expect_same_html <- function(x, y, equal = TRUE) {
+#   local_edition(3)
+#   if (equal) expect_equal(x, y)
+#   expect_snapshot(
+#     renderTags(x)[c("dependencies", "html")],
+#     cran = TRUE
+#   )
+# }
+#
+# test_that("tag(.renderHook, .postRenderHook) basics", {
+#   expect_tag_hooks(div, .render = span)
+#   expect_tag_hooks(div, .postRender = span)
+#   expect_tag_hooks(div, .render = span, .postRender = span)
+#   expect_tag_hooks(
+#     div, .render = function(x) stop("boom"),
+#     .postRender = function(x) stop("boom2")
+#   )
+#
+#   # Adding accumulates by default
+#   expect_tag_hooks(div, .render = list(span, span))
+#   expect_tag_hooks(div, .postRender = list(span, span))
+#   expect_tag_hooks(div, .render = list(span, span), .postRender = list(span, span))
+#
+#   # But can be also be replaced
+#   expect_same_html(
+#     tagAddRenderHook(
+#       tagAddRenderHook(div(), span),
+#       h1, replace = TRUE
+#     ),
+#     div(.renderHook = h1)
+#   )
+#   expect_same_html(
+#     tagAddPostRenderHook(
+#       tagAddPostRenderHook(div(), span),
+#       h1, replace = TRUE
+#     ),
+#     div(.postRenderHook = h1)
+#   )
+# })
+#
+#
+# test_that("tagList(.renderHook, .postRenderHook) basics", {
+#   expect_tag_hooks(tagList, "a", .render = div)
+#   expect_tag_hooks(tagList, "a", .postRender = div)
+#   expect_tag_hooks(tagList, "a", .render = span, .postRender = span)
+#   expect_tag_hooks(tagList, "a", .render = list(span, span))
+#   expect_tag_hooks(tagList, "a", .postRender = list(span, span))
+#   expect_tag_hooks(tagList, "a", .postRender = list(span, span))
+# })
+#
+#
+# test_that("Can return various types of output in render hooks", {
+#
+#   # Strings
+#   hook <- function(x) "foo"
+#
+#   expect_tag_hooks(div, .render = hook)
+#   expect_tag_hooks(div, .postRender = hook)
+#   expect_tag_hooks(tagList, .render = hook)
+#   expect_tag_hooks(tagList, .postRender = hook)
+#
+#   # HTML dependencies
+#   hook <- function(x) {
+#     attachDependencies(x, htmlDependency("foo", "1.0", ""))
+#   }
+#
+#   expect_tag_hooks(div, .render = hook)
+#   expect_tag_hooks(div, .postRender = hook)
+#   expect_tag_hooks(tagList, .render = hook)
+#   expect_tag_hooks(tagList, .postRender = hook)
+#
+#   # Unresolved tags
+#   hook <- function(x) span(x, .renderHook = h1)
+#
+#   expect_tag_hooks(div, .render = hook)
+#   expect_tag_hooks(div, .postRender = hook)
+#   expect_tag_hooks(tagList, .render = hook)
+#   expect_tag_hooks(tagList, .postRender = hook)
+#
+#   # Unresolved tagList()s
+#   hook <- function(x) tagList(span(), x, .renderHook = h1)
+#
+#   expect_tag_hooks(div, .render = hook)
+#   expect_tag_hooks(div, .postRender = hook)
+#   expect_tag_hooks(tagList, .render = hook)
+#   expect_tag_hooks(tagList, .postRender = hook)
+#
+#   # List of unresolved tags
+#   hook <- function(x) list(span(x, .renderHook = h1), span(x, .renderHook = h1))
+#
+#   expect_tag_hooks(div, .render = hook)
+#   expect_tag_hooks(div, .postRender = hook)
+#   expect_tag_hooks(tagList, .render = hook)
+#   expect_tag_hooks(tagList, .postRender = hook)
+#
+#   # Nothing
+#   hook <- function(x) NULL
+#
+#   expect_tag_hooks(div, .render = hook)
+#   expect_tag_hooks(div, .postRender = hook)
+#   expect_tag_hooks(tagList, .render = hook)
+#   expect_tag_hooks(tagList, .postRender = hook)
+# })
+
+test_that("Pre hooks render in order", {
+  # Note that, unlike tagFunction(), .renderHook's order of execution
+  # doesn't follow DOM tree order (preorder, depth-first traversal),
+  # but that seems like a feature, not a bug, since if you need to control
+  # state of html, you can do tagList(myTag, html) for "guaranteed control"
+  # over the state
+  state <- 0
+  renderTags(tagList(
+    div(
+      .renderHook = function(x) {
+        expect_equal(state, 0)
+        state <<- state + 1
+      },
+      .postRenderHook = function() {
+        expect_equal(state, 2)
+        state <<- state + 1
+      }
+    ),
+    div(
+      .renderHook = function(x) {
+        expect_equal(state, 1)
+        state <<- state + 1
+      },
+      .postRenderHook = function() {
+        expect_equal(state, 3)
+        state <<- state + 1
+      }
+    )
+  ))
+  expect_equal(state, 4)
+
+  state <- 0
+  renderTags(tagList(
+    div(
+      .renderHook = function(x) {
+        state <<- state + 1
+        message("A", state)
+      },
+      div(
+        .renderHook = function(x) {
+          state <<- state + 1
+          message("B", state)
+        },
+        .postRenderHook = function() {
+          state <<- state + 1
+          message("C", state)
+        }
+      ),
+      .postRenderHook = function() {
+        state <<- state + 1
+        message("D", state)
+      }
+    )
+  ))
+  expect_equal(state, 4)
+
+
+  # post render hook still executes on failure
+  state <- 0
+  expect_warning(renderTags(tagList(
+    div(
+      .renderHook = function(x) {
+        state <<- state + 1
+        stop("boom")
+      },
+      .postRenderHook = function() {
+        expect_equal(state, 2)
+      }
+    ),
+    div(
+      .renderHook = function(x) {
+        state <<- state + 1
+        stop("boom")
+      },
+      .postRenderHook = function() {
+        expect_equal(state, 2)
+      }
+    )
+  )))
+  expect_equal(state, 2)
+})
+
+test_that("render hooks can be used to ", {
+  local_edition(3)
+
+  bar_widget <- div(
+    .renderHook = function(x) {
+      if (isTRUE(getOption("bar"))) tagQuery(x)$addClass("bar")$allTags() else x
+    }
+  )
+
+  expect_snapshot(bar_widget, cran = TRUE)
+
+  bar_framework <- tagList(
+    htmlDependency("bar", "1.0", ""),
+    .renderHook = function(x) {
+      options("bar" = TRUE)
+      x
+    },
+    .postRenderHook = function() {
+      options("bar" = NULL)
+    }
+  )
+
+  html <- tagList(bar_framework, bar_widget)
+
+  expect_null(getOption("bar"))
+  expect_snapshot(renderTags(html), cran = TRUE)
+  expect_null(getOption("bar"))
+})

From b6e0048f9821ca4ab5eeac72d28dce6b4073f581 Mon Sep 17 00:00:00 2001
From: Carson Sievert <cpsievert1@gmail.com>
Date: Thu, 27 May 2021 18:14:23 -0500
Subject: [PATCH 11/11] Update tests/testthat/test-tag-hooks.R

---
 tests/testthat/test-tag-hooks.R | 26 --------------------------
 1 file changed, 26 deletions(-)

diff --git a/tests/testthat/test-tag-hooks.R b/tests/testthat/test-tag-hooks.R
index 462fff72..d21527af 100644
--- a/tests/testthat/test-tag-hooks.R
+++ b/tests/testthat/test-tag-hooks.R
@@ -143,32 +143,6 @@ test_that("Pre hooks render in order", {
   ))
   expect_equal(state, 4)
 
-  state <- 0
-  renderTags(tagList(
-    div(
-      .renderHook = function(x) {
-        state <<- state + 1
-        message("A", state)
-      },
-      div(
-        .renderHook = function(x) {
-          state <<- state + 1
-          message("B", state)
-        },
-        .postRenderHook = function() {
-          state <<- state + 1
-          message("C", state)
-        }
-      ),
-      .postRenderHook = function() {
-        state <<- state + 1
-        message("D", state)
-      }
-    )
-  ))
-  expect_equal(state, 4)
-
-
   # post render hook still executes on failure
   state <- 0
   expect_warning(renderTags(tagList(