From 9850c74c0b73965f65725f90dd1a2afe78d43e9c Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar" Date: Fri, 21 Jun 2024 16:30:12 -0700 Subject: [PATCH 1/8] update yarn with new classes --- NEWS.md | 2 ++ R/add_md.R | 50 ++++++++++++++++++++++++++++ R/class-yarn.R | 33 ++++++++++++++++++ man/yarn.Rd | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 175 insertions(+) diff --git a/NEWS.md b/NEWS.md index 588622b..99ba18d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ## NEW FEATURES +* `yarn$append_md()` and `yarn$prepend_md()` methods allow you to add new + markdown to specific places in the document using XPath expressions. * `to_md_vec()` takes an xml node or nodelist and returns a character vector of the markdown produced. * `show_list()`, `show_block()`, and `show_censor()` will show the markdown diff --git a/R/add_md.R b/R/add_md.R index ec3e175..edac90f 100644 --- a/R/add_md.R +++ b/R/add_md.R @@ -21,6 +21,56 @@ add_nodes_to_body <- function(body, nodes, where = 0L) { } } +append_md <- function(body, md, after = NULL) { + new <- md_to_xml(md) + shove_nodes_in(body, new, nodes = after, where = "after") + copy_xml(body) +} + +prepend_md <- function(body, md, before = NULL) { + new <- md_to_xml(md) + shove_nodes_in(body, new, nodes = before, where = "before") + copy_xml(body) +} + +shove_nodes_in <- function(body, new, nodes, where = "after") { + if (inherits(nodes, "character")) { + nodes <- xml2::xml_find_all(body, nodes, ns = md_ns()) + } + if (!inherits(nodes, c("xml_node", "xml_nodeset"))) { + rlang::abort("an object of class `xml_node` or `xml_nodeset` was expected") + } + root <- xml2::xml_root(nodes) + if (!identical(root, body)) { + rlang::abort("nodes must come from the same body as the yarn document") + } + return(add_nodes_to_nodes(new, old = nodes, where = where)) +} + + +node_is_inline <- function(node) { + blocks <- c("document", "paragraph", "heading", "block_quote", "list", + "item", "code_block", "html_block", "custom_block", "thematic_break", + "table") + !xml2::xml_name(node) %in% blocks +} + +add_nodes_to_nodes <- function(nodes, old, where = "after") { + inlines <- node_is_inline(old) + n <- sum(inlines) + single_node <- inherits(old, "xml_node") + if (n > 0) { + if (!single_node && n < length(old)) { + rlang::abort("Nodes must be either block type or inline, but not both", call. = FALSE) + } + nodes <- xml2::xml_children(nodes) + } + if (!single_node) { + old <- list(old) + } + purrr::walk(old, add_node_siblings, nodes, where = where, remove = FALSE) +} + # Add siblings to a node add_node_siblings <- function(node, nodes, where = "after", remove = TRUE) { # if there is a single node, then we need only add it diff --git a/R/class-yarn.R b/R/class-yarn.R index a352c3a..3492f98 100644 --- a/R/class-yarn.R +++ b/R/class-yarn.R @@ -203,6 +203,39 @@ yarn <- R6::R6Class("yarn", self$body <- add_md(self$body, md, where) invisible(self) }, + #' @description append abritrary markdown to a node or set of nodes + #' + #' @param md a string of markdown formatted text. + #' @param nodes an XPath expression that evaulates to object of class + #' `xml_node` or `xml_nodeset` that are all either inline or block nodes + #' (never both) + #' @examples + #' path <- system.file("extdata", "example2.Rmd", package = "tinkr") + #' ex <- tinkr::yarn$new(path) + #' # append a note after the first heading + #' + #' txt <- c("> Hello from *tinkr*!", ">", "> :heart: R") + #' ex$append_md(txt, ".//md:heading[1]")$head(20) + append_md = function(md, nodes = NULL) { + self$body <- append_md(self$body, md, nodes) + invisible(self) + }, + #' @description prepend abritrary markdown to a node or set of nodes + #' + #' @param md a string of markdown formatted text. + #' @param nodes an XPath expression that evaulates to object of class + #' `xml_node` or `xml_nodeset` that are all either inline or block nodes + #' (never both) + #' @examples + #' path <- system.file("extdata", "example2.Rmd", package = "tinkr") + #' ex <- tinkr::yarn$new(path) + #' + #' # prepend a table description to the birds table + #' ex$prepend_md("Table: BIRDS, NERDS", ".//md:table[1]")$tail(20) + prepend_md = function(md, nodes = NULL) { + self$body <- prepend_md(self$body, md, nodes) + invisible(self) + }, #' @description Protect math blocks from being escaped #' #' @examples diff --git a/man/yarn.Rd b/man/yarn.Rd index 5e24189..9a461cf 100644 --- a/man/yarn.Rd +++ b/man/yarn.Rd @@ -105,6 +105,27 @@ tmp <- tempfile() ex$write(tmp) readLines(tmp, n = 20) +## ------------------------------------------------ +## Method `yarn$append_md` +## ------------------------------------------------ + +path <- system.file("extdata", "example2.Rmd", package = "tinkr") +ex <- tinkr::yarn$new(path) +# append a note after the first heading + +txt <- c("> Hello from *tinkr*!", ">", "> :heart: R") +ex$append_md(txt, ".//md:heading[1]")$head(20) + +## ------------------------------------------------ +## Method `yarn$prepend_md` +## ------------------------------------------------ + +path <- system.file("extdata", "example2.Rmd", package = "tinkr") +ex <- tinkr::yarn$new(path) + +# prepend a table description to the birds table +ex$prepend_md("Table: BIRDS, NERDS", ".//md:table[1]")$tail(20) + ## ------------------------------------------------ ## Method `yarn$protect_math` ## ------------------------------------------------ @@ -180,6 +201,8 @@ commonmark.} \item \href{#method-yarn-tail}{\code{yarn$tail()}} \item \href{#method-yarn-md_vec}{\code{yarn$md_vec()}} \item \href{#method-yarn-add_md}{\code{yarn$add_md()}} +\item \href{#method-yarn-append_md}{\code{yarn$append_md()}} +\item \href{#method-yarn-prepend_md}{\code{yarn$prepend_md()}} \item \href{#method-yarn-protect_math}{\code{yarn$protect_math()}} \item \href{#method-yarn-protect_curly}{\code{yarn$protect_curly()}} \item \href{#method-yarn-protect_unescaped}{\code{yarn$protect_unescaped()}} @@ -453,6 +476,73 @@ readLines(tmp, n = 20) } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-yarn-append_md}{}}} +\subsection{Method \code{append_md()}}{ +append abritrary markdown to a node or set of nodes +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{yarn$append_md(md, nodes = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{md}}{a string of markdown formatted text.} + +\item{\code{nodes}}{an XPath expression that evaulates to object of class +\code{xml_node} or \code{xml_nodeset} that are all either inline or block nodes +(never both)} +} +\if{html}{\out{
}} +} +\subsection{Examples}{ +\if{html}{\out{
}} +\preformatted{path <- system.file("extdata", "example2.Rmd", package = "tinkr") +ex <- tinkr::yarn$new(path) +# append a note after the first heading + +txt <- c("> Hello from *tinkr*!", ">", "> :heart: R") +ex$append_md(txt, ".//md:heading[1]")$head(20) +} +\if{html}{\out{
}} + +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-yarn-prepend_md}{}}} +\subsection{Method \code{prepend_md()}}{ +prepend abritrary markdown to a node or set of nodes +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{yarn$prepend_md(md, nodes = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{md}}{a string of markdown formatted text.} + +\item{\code{nodes}}{an XPath expression that evaulates to object of class +\code{xml_node} or \code{xml_nodeset} that are all either inline or block nodes +(never both)} +} +\if{html}{\out{
}} +} +\subsection{Examples}{ +\if{html}{\out{
}} +\preformatted{path <- system.file("extdata", "example2.Rmd", package = "tinkr") +ex <- tinkr::yarn$new(path) + +# prepend a table description to the birds table +ex$prepend_md("Table: BIRDS, NERDS", ".//md:table[1]")$tail(20) +} +\if{html}{\out{
}} + +} + } \if{html}{\out{
}} \if{html}{\out{}} From 3a122e377da72442864c723185cab83f4cfb0fbd Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar" Date: Fri, 21 Jun 2024 16:55:55 -0700 Subject: [PATCH 2/8] add tests --- R/add_md.R | 15 +++++-- tests/testthat/test-class-yarn.R | 74 +++++++++++++++++++++++++++++++- 2 files changed, 83 insertions(+), 6 deletions(-) diff --git a/R/add_md.R b/R/add_md.R index edac90f..fe93409 100644 --- a/R/add_md.R +++ b/R/add_md.R @@ -38,11 +38,15 @@ shove_nodes_in <- function(body, new, nodes, where = "after") { nodes <- xml2::xml_find_all(body, nodes, ns = md_ns()) } if (!inherits(nodes, c("xml_node", "xml_nodeset"))) { - rlang::abort("an object of class `xml_node` or `xml_nodeset` was expected") + rlang::abort("an object of class `xml_node` or `xml_nodeset` was expected", + class = "insert-md-node" + ) } root <- xml2::xml_root(nodes) if (!identical(root, body)) { - rlang::abort("nodes must come from the same body as the yarn document") + rlang::abort("nodes must come from the same body as the yarn document", + class = "insert-md-body" + ) } return(add_nodes_to_nodes(new, old = nodes, where = where)) } @@ -61,11 +65,14 @@ add_nodes_to_nodes <- function(nodes, old, where = "after") { single_node <- inherits(old, "xml_node") if (n > 0) { if (!single_node && n < length(old)) { - rlang::abort("Nodes must be either block type or inline, but not both", call. = FALSE) + rlang::abort("Nodes must be either block type or inline, but not both", + class = "insert-md-dual-type", + call. = FALSE + ) } nodes <- xml2::xml_children(nodes) } - if (!single_node) { + if (single_node) { old <- list(old) } purrr::walk(old, add_node_siblings, nodes, where = where, remove = FALSE) diff --git a/tests/testthat/test-class-yarn.R b/tests/testthat/test-class-yarn.R index 24eb010..12bc48a 100644 --- a/tests/testthat/test-class-yarn.R +++ b/tests/testthat/test-class-yarn.R @@ -133,7 +133,7 @@ test_that("a yarn object can be reset", { }) -test_that("random markdown can be added", { +test_that("random markdown can be added to the body", { tmpdir <- withr::local_tempdir() scarf3 <- withr::local_file(file.path(tmpdir, "yarn-kilroy.md")) @@ -146,7 +146,8 @@ test_that("random markdown can be added", { "[KILROY](https://en.wikipedia.org/wiki/Kilroy_was_here) WAS **HERE**\n\n", "stop copying me!" # THIS WILL BE COPIED TWICE ) - t1$add_md(paste(newmd, collapse = ""))$add_md(toupper(newmd[[3]]), where = 3) + t1$add_md(paste(newmd, collapse = "")) + t1$add_md(toupper(newmd[[3]]), where = 3) expect_length(xml2::xml_find_all(t1$body, "md:link", t1$ns), 0L) t1$write(scarf3) @@ -155,6 +156,75 @@ test_that("random markdown can be added", { }) +test_that("markdown can be appended to elements", { + path <- system.file("extdata", "example2.Rmd", package = "tinkr") + ex <- tinkr::yarn$new(path) + # append a note after the first heading + txt <- c("> Hello from *tinkr*!", ">", "> :heart: R") + # Via XPath ------------------------------------------------------------------ + ex$append_md(txt, ".//md:heading[1]") + # the block quote has been added to the first heading + expect_length(xml2::xml_find_all(ex$body, ".//md:block_quote", ns = ex$ns), 1) + # Via node ------------------------------------------------------------------- + heading2 <- xml2::xml_find_first(ex$body, ".//md:heading[2]", ns = ex$ns) + ex$append_md(txt, heading2) + expect_length(xml2::xml_find_all(ex$body, ".//md:block_quote", ns = ex$ns), 2) + # Because the body is a copy, the original nodeset will throw an error + expect_error(ex$append_md(txt, heading2), class = "insert-md-body") + + # Via nodeset ---------------------------------------------------------------- + ex$append_md(txt, ".//md:heading") + expect_length(xml2::xml_find_all(ex$body, ".//md:block_quote", ns = ex$ns), 4) +}) + + +test_that("Inline markdown can be appended (to a degree)", { + path <- system.file("extdata", "example2.Rmd", package = "tinkr") + ex <- tinkr::yarn$new(path) + nodes <- xml2::xml_find_all(ex$body, + ".//md:code[contains(text(), 'READ THIS')]", ex$ns) + expect_length(nodes, 0) + ex <- tinkr::yarn$new(path) + ex$append_md("`<-- READ THIS`", ".//md:link") + nodes <- xml2::xml_find_all(ex$body, + ".//md:code[contains(text(), 'READ THIS')]", ex$ns) + expect_length(nodes, 1) +}) + + +test_that("markdown can be prepended", { + path <- system.file("extdata", "example2.Rmd", package = "tinkr") + ex <- tinkr::yarn$new(path) + nodes <- xml2::xml_find_all(ex$body, + ".//node()[contains(text(), 'NERDS')]", ex$ns) + expect_length(nodes, 0) + ex$prepend_md("Table: BIRDS, NERDS", ".//md:table") + nodes <- xml2::xml_find_all(ex$body, + ".//node()[contains(text(), 'NERDS')]", ex$ns) + expect_length(nodes, 1) +}) + + +test_that("an error happens when you try to append with a number", { + path <- system.file("extdata", "example2.Rmd", package = "tinkr") + ex <- tinkr::yarn$new(path) + expect_error(ex$append_md("WRONG", 42), class = "insert-md-node") +}) + + + +test_that("an error happens when you try to append markdown to disparate elements", { + + path <- system.file("extdata", "example2.Rmd", package = "tinkr") + ex <- tinkr::yarn$new(path) + xpath <- ".//md:text[contains(text(), 'bird')] | .//md:paragraph[md:text[contains(text(), 'Non')]]" + + expect_error(ex$append_md("WRONG", xpath), class = "insert-md-dual-type") +}) + + + + test_that("md_vec() will convert a query to a markdown vector", { pathmd <- system.file("extdata", "example1.md", package = "tinkr") From 5756ee68933600bdc851cd81d7583928bcae1ede Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar" Date: Fri, 21 Jun 2024 17:22:53 -0700 Subject: [PATCH 3/8] add space parameter --- R/add_md.R | 19 ++++++++++++------- R/class-yarn.R | 12 ++++++++---- man/yarn.Rd | 10 ++++++++-- tests/testthat/test-class-yarn.R | 26 +++++++++++++++++++++++++- 4 files changed, 53 insertions(+), 14 deletions(-) diff --git a/R/add_md.R b/R/add_md.R index fe93409..f21569b 100644 --- a/R/add_md.R +++ b/R/add_md.R @@ -21,19 +21,19 @@ add_nodes_to_body <- function(body, nodes, where = 0L) { } } -append_md <- function(body, md, after = NULL) { +append_md <- function(body, md, after = NULL, space = TRUE) { new <- md_to_xml(md) - shove_nodes_in(body, new, nodes = after, where = "after") + shove_nodes_in(body, new, nodes = after, where = "after", space = space) copy_xml(body) } -prepend_md <- function(body, md, before = NULL) { +prepend_md <- function(body, md, before = NULL, space = TRUE) { new <- md_to_xml(md) - shove_nodes_in(body, new, nodes = before, where = "before") + shove_nodes_in(body, new, nodes = before, where = "before", space = space) copy_xml(body) } -shove_nodes_in <- function(body, new, nodes, where = "after") { +shove_nodes_in <- function(body, new, nodes, where = "after", space = TRUE) { if (inherits(nodes, "character")) { nodes <- xml2::xml_find_all(body, nodes, ns = md_ns()) } @@ -48,7 +48,7 @@ shove_nodes_in <- function(body, new, nodes, where = "after") { class = "insert-md-body" ) } - return(add_nodes_to_nodes(new, old = nodes, where = where)) + return(add_nodes_to_nodes(new, old = nodes, where = where, space = space)) } @@ -59,7 +59,7 @@ node_is_inline <- function(node) { !xml2::xml_name(node) %in% blocks } -add_nodes_to_nodes <- function(nodes, old, where = "after") { +add_nodes_to_nodes <- function(nodes, old, where = "after", space = TRUE) { inlines <- node_is_inline(old) n <- sum(inlines) single_node <- inherits(old, "xml_node") @@ -71,6 +71,11 @@ add_nodes_to_nodes <- function(nodes, old, where = "after") { ) } nodes <- xml2::xml_children(nodes) + if (space) { + lead <- if (inherits(nodes, "xml_node")) nodes else nodes[[1]] + txt <- if (where == "after") " %s" else "%s " + xml2::xml_set_text(lead, sprintf(txt, xml2::xml_text(lead))) + } } if (single_node) { old <- list(old) diff --git a/R/class-yarn.R b/R/class-yarn.R index 3492f98..0e3bac9 100644 --- a/R/class-yarn.R +++ b/R/class-yarn.R @@ -209,6 +209,8 @@ yarn <- R6::R6Class("yarn", #' @param nodes an XPath expression that evaulates to object of class #' `xml_node` or `xml_nodeset` that are all either inline or block nodes #' (never both) + #' @param space if `TRUE`, inline nodes will have a space inserted before + #' they are appended. #' @examples #' path <- system.file("extdata", "example2.Rmd", package = "tinkr") #' ex <- tinkr::yarn$new(path) @@ -216,8 +218,8 @@ yarn <- R6::R6Class("yarn", #' #' txt <- c("> Hello from *tinkr*!", ">", "> :heart: R") #' ex$append_md(txt, ".//md:heading[1]")$head(20) - append_md = function(md, nodes = NULL) { - self$body <- append_md(self$body, md, nodes) + append_md = function(md, nodes = NULL, space = TRUE) { + self$body <- append_md(self$body, md, nodes, space = space) invisible(self) }, #' @description prepend abritrary markdown to a node or set of nodes @@ -226,14 +228,16 @@ yarn <- R6::R6Class("yarn", #' @param nodes an XPath expression that evaulates to object of class #' `xml_node` or `xml_nodeset` that are all either inline or block nodes #' (never both) + #' @param space if `TRUE`, inline nodes will have a space inserted before + #' they are prepended. #' @examples #' path <- system.file("extdata", "example2.Rmd", package = "tinkr") #' ex <- tinkr::yarn$new(path) #' #' # prepend a table description to the birds table #' ex$prepend_md("Table: BIRDS, NERDS", ".//md:table[1]")$tail(20) - prepend_md = function(md, nodes = NULL) { - self$body <- prepend_md(self$body, md, nodes) + prepend_md = function(md, nodes = NULL, space = TRUE) { + self$body <- prepend_md(self$body, md, nodes, space = space) invisible(self) }, #' @description Protect math blocks from being escaped diff --git a/man/yarn.Rd b/man/yarn.Rd index 9a461cf..f57d96b 100644 --- a/man/yarn.Rd +++ b/man/yarn.Rd @@ -483,7 +483,7 @@ readLines(tmp, n = 20) \subsection{Method \code{append_md()}}{ append abritrary markdown to a node or set of nodes \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{yarn$append_md(md, nodes = NULL)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{yarn$append_md(md, nodes = NULL, space = TRUE)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -494,6 +494,9 @@ append abritrary markdown to a node or set of nodes \item{\code{nodes}}{an XPath expression that evaulates to object of class \code{xml_node} or \code{xml_nodeset} that are all either inline or block nodes (never both)} + +\item{\code{space}}{if \code{TRUE}, inline nodes will have a space inserted before +they are appended.} } \if{html}{\out{}} } @@ -517,7 +520,7 @@ ex$append_md(txt, ".//md:heading[1]")$head(20) \subsection{Method \code{prepend_md()}}{ prepend abritrary markdown to a node or set of nodes \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{yarn$prepend_md(md, nodes = NULL)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{yarn$prepend_md(md, nodes = NULL, space = TRUE)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -528,6 +531,9 @@ prepend abritrary markdown to a node or set of nodes \item{\code{nodes}}{an XPath expression that evaulates to object of class \code{xml_node} or \code{xml_nodeset} that are all either inline or block nodes (never both)} + +\item{\code{space}}{if \code{TRUE}, inline nodes will have a space inserted before +they are prepended.} } \if{html}{\out{}} } diff --git a/tests/testthat/test-class-yarn.R b/tests/testthat/test-class-yarn.R index 12bc48a..d604f27 100644 --- a/tests/testthat/test-class-yarn.R +++ b/tests/testthat/test-class-yarn.R @@ -185,13 +185,37 @@ test_that("Inline markdown can be appended (to a degree)", { ".//md:code[contains(text(), 'READ THIS')]", ex$ns) expect_length(nodes, 0) ex <- tinkr::yarn$new(path) + nodes <- xml2::xml_find_all(ex$body, + ".//md:code[contains(text(), ' <-- READ THIS')]", ex$ns) + expect_length(nodes, 0) ex$append_md("`<-- READ THIS`", ".//md:link") nodes <- xml2::xml_find_all(ex$body, - ".//md:code[contains(text(), 'READ THIS')]", ex$ns) + ".//md:code[contains(text(), ' <-- READ THIS')]", ex$ns) expect_length(nodes, 1) }) +test_that("space parameter can be shut off", { + path <- system.file("extdata", "example2.Rmd", package = "tinkr") + ex <- tinkr::yarn$new(path) + chk <- xml2::xml_find_all(ex$body, + ".//md:heading/*[contains(text(), '!!!')]", ex$ns) + space_chk <- xml2::xml_find_all(ex$body, + ".//md:heading/*[contains(text(), ' !!!')]", ex$ns) + expect_length(chk, 0) + expect_length(space_chk, 0) + ex <- tinkr::yarn$new(path) + ex$append_md("!!!", ".//md:heading/*", space = FALSE) + chk <- xml2::xml_find_all(ex$body, + ".//md:heading/*[contains(text(), '!!!')]", ex$ns) + space_chk <- xml2::xml_find_all(ex$body, + ".//md:heading/*[contains(text(), ' !!!')]", ex$ns) + expect_length(chk, 2) + expect_length(space_chk, 0) +}) + + + test_that("markdown can be prepended", { path <- system.file("extdata", "example2.Rmd", package = "tinkr") ex <- tinkr::yarn$new(path) From 8e878b2d8d4108b165c2a729d6c547ca357e6b13 Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar" Date: Sat, 22 Jun 2024 14:33:31 -0700 Subject: [PATCH 4/8] simplify and document --- R/add_md.R | 29 ++++++++++++++++------------- R/class-yarn.R | 20 ++++++++++++++++---- man/yarn.Rd | 26 ++++++++++++++++++++++++-- 3 files changed, 56 insertions(+), 19 deletions(-) diff --git a/R/add_md.R b/R/add_md.R index f21569b..80feef8 100644 --- a/R/add_md.R +++ b/R/add_md.R @@ -21,15 +21,9 @@ add_nodes_to_body <- function(body, nodes, where = 0L) { } } -append_md <- function(body, md, after = NULL, space = TRUE) { +insert_md <- function(body, md, nodes, where = "after", space = TRUE) { new <- md_to_xml(md) - shove_nodes_in(body, new, nodes = after, where = "after", space = space) - copy_xml(body) -} - -prepend_md <- function(body, md, before = NULL, space = TRUE) { - new <- md_to_xml(md) - shove_nodes_in(body, new, nodes = before, where = "before", space = space) + shove_nodes_in(body, new, nodes = nodes, where = where, space = space) copy_xml(body) } @@ -59,10 +53,15 @@ node_is_inline <- function(node) { !xml2::xml_name(node) %in% blocks } -add_nodes_to_nodes <- function(nodes, old, where = "after", space = TRUE) { +# add a new set of nodes before or after an exsiting set of nodes. +add_nodes_to_nodes <- function(new, old, where = "after", space = TRUE) { + single_node <- inherits(old, "xml_node") + # count the number of inline elements inlines <- node_is_inline(old) n <- sum(inlines) - single_node <- inherits(old, "xml_node") + # when there are any inline nodes, we need to adjust the new node so that + # we extract child-level elements. Note that we assume that the user will + # be supplying strictly inline markdown, but it may not be so neat. if (n > 0) { if (!single_node && n < length(old)) { rlang::abort("Nodes must be either block type or inline, but not both", @@ -70,17 +69,21 @@ add_nodes_to_nodes <- function(nodes, old, where = "after", space = TRUE) { call. = FALSE ) } - nodes <- xml2::xml_children(nodes) + # make sure the new nodes are inline by extracting the children. + new <- xml2::xml_children(new) if (space) { - lead <- if (inherits(nodes, "xml_node")) nodes else nodes[[1]] + # For inline nodes, we want to make sure they are separated from existing + # nodes by a space. + lead <- if (inherits(new, "xml_node")) new else new[[1]] txt <- if (where == "after") " %s" else "%s " xml2::xml_set_text(lead, sprintf(txt, xml2::xml_text(lead))) } } if (single_node) { + # allow purrr::walk() to work on a single node old <- list(old) } - purrr::walk(old, add_node_siblings, nodes, where = where, remove = FALSE) + purrr::walk(old, add_node_siblings, new, where = where, remove = FALSE) } # Add siblings to a node diff --git a/R/class-yarn.R b/R/class-yarn.R index 0e3bac9..2718dc5 100644 --- a/R/class-yarn.R +++ b/R/class-yarn.R @@ -208,9 +208,15 @@ yarn <- R6::R6Class("yarn", #' @param md a string of markdown formatted text. #' @param nodes an XPath expression that evaulates to object of class #' `xml_node` or `xml_nodeset` that are all either inline or block nodes - #' (never both) + #' (never both). The XPath expression is passed to [xml2::xml_find_all()]. + #' If you want to append a specific node, you can pass that node to this + #' parameter. #' @param space if `TRUE`, inline nodes will have a space inserted before #' they are appended. + #' @details this is similar to the `add_md()` method except that it can do + #' the following: + #' 1. append content after a _specific_ node or set of nodes + #' 2. append content to multiple places in the document #' @examples #' path <- system.file("extdata", "example2.Rmd", package = "tinkr") #' ex <- tinkr::yarn$new(path) @@ -219,7 +225,7 @@ yarn <- R6::R6Class("yarn", #' txt <- c("> Hello from *tinkr*!", ">", "> :heart: R") #' ex$append_md(txt, ".//md:heading[1]")$head(20) append_md = function(md, nodes = NULL, space = TRUE) { - self$body <- append_md(self$body, md, nodes, space = space) + self$body <- insert_md(self$body, md, nodes, where = "after", space = space) invisible(self) }, #' @description prepend abritrary markdown to a node or set of nodes @@ -227,9 +233,15 @@ yarn <- R6::R6Class("yarn", #' @param md a string of markdown formatted text. #' @param nodes an XPath expression that evaulates to object of class #' `xml_node` or `xml_nodeset` that are all either inline or block nodes - #' (never both) + #' (never both). The XPath expression is passed to [xml2::xml_find_all()]. + #' If you want to append a specific node, you can pass that node to this + #' parameter. #' @param space if `TRUE`, inline nodes will have a space inserted before #' they are prepended. + #' @details this is similar to the `add_md()` method except that it can do + #' the following: + #' 1. prepend content after a _specific_ node or set of nodes + #' 2. prepend content to multiple places in the document #' @examples #' path <- system.file("extdata", "example2.Rmd", package = "tinkr") #' ex <- tinkr::yarn$new(path) @@ -237,7 +249,7 @@ yarn <- R6::R6Class("yarn", #' # prepend a table description to the birds table #' ex$prepend_md("Table: BIRDS, NERDS", ".//md:table[1]")$tail(20) prepend_md = function(md, nodes = NULL, space = TRUE) { - self$body <- prepend_md(self$body, md, nodes, space = space) + self$body <- insert_md(self$body, md, nodes, where = "before", space = space) invisible(self) }, #' @description Protect math blocks from being escaped diff --git a/man/yarn.Rd b/man/yarn.Rd index f57d96b..c51af6d 100644 --- a/man/yarn.Rd +++ b/man/yarn.Rd @@ -493,13 +493,24 @@ append abritrary markdown to a node or set of nodes \item{\code{nodes}}{an XPath expression that evaulates to object of class \code{xml_node} or \code{xml_nodeset} that are all either inline or block nodes -(never both)} +(never both). The XPath expression is passed to \code{\link[xml2:xml_find_all]{xml2::xml_find_all()}}. +If you want to append a specific node, you can pass that node to this +parameter.} \item{\code{space}}{if \code{TRUE}, inline nodes will have a space inserted before they are appended.} } \if{html}{\out{}} } +\subsection{Details}{ +this is similar to the \code{add_md()} method except that it can do +the following: +\enumerate{ +\item append content after a \emph{specific} node or set of nodes +\item append content to multiple places in the document +} +} + \subsection{Examples}{ \if{html}{\out{
}} \preformatted{path <- system.file("extdata", "example2.Rmd", package = "tinkr") @@ -530,13 +541,24 @@ prepend abritrary markdown to a node or set of nodes \item{\code{nodes}}{an XPath expression that evaulates to object of class \code{xml_node} or \code{xml_nodeset} that are all either inline or block nodes -(never both)} +(never both). The XPath expression is passed to \code{\link[xml2:xml_find_all]{xml2::xml_find_all()}}. +If you want to append a specific node, you can pass that node to this +parameter.} \item{\code{space}}{if \code{TRUE}, inline nodes will have a space inserted before they are prepended.} } \if{html}{\out{
}} } +\subsection{Details}{ +this is similar to the \code{add_md()} method except that it can do +the following: +\enumerate{ +\item prepend content after a \emph{specific} node or set of nodes +\item prepend content to multiple places in the document +} +} + \subsection{Examples}{ \if{html}{\out{
}} \preformatted{path <- system.file("extdata", "example2.Rmd", package = "tinkr") From 46974f28184ceb344975d871643d4f05613fad8f Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar" Date: Wed, 16 Oct 2024 18:42:22 -0500 Subject: [PATCH 5/8] Apply suggestions from code review MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Maëlle Salmon --- R/class-yarn.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/class-yarn.R b/R/class-yarn.R index 2718dc5..ccd6083 100644 --- a/R/class-yarn.R +++ b/R/class-yarn.R @@ -203,7 +203,7 @@ yarn <- R6::R6Class("yarn", self$body <- add_md(self$body, md, where) invisible(self) }, - #' @description append abritrary markdown to a node or set of nodes + #' @description append abritrarily markdown to a node or set of nodes #' #' @param md a string of markdown formatted text. #' @param nodes an XPath expression that evaulates to object of class @@ -228,7 +228,7 @@ yarn <- R6::R6Class("yarn", self$body <- insert_md(self$body, md, nodes, where = "after", space = space) invisible(self) }, - #' @description prepend abritrary markdown to a node or set of nodes + #' @description prepend abritrarily markdown to a node or set of nodes #' #' @param md a string of markdown formatted text. #' @param nodes an XPath expression that evaulates to object of class From 798f62b78c26de2a75817c178e2a7273da229fc4 Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar (UMass)" Date: Thu, 17 Oct 2024 17:37:30 -0700 Subject: [PATCH 6/8] fix bug with backwards additions --- R/add_md.R | 25 ++++++++++++++++++++----- tests/testthat/test-class-yarn.R | 13 +++++++++++-- 2 files changed, 31 insertions(+), 7 deletions(-) diff --git a/R/add_md.R b/R/add_md.R index 80feef8..422d9e1 100644 --- a/R/add_md.R +++ b/R/add_md.R @@ -29,8 +29,15 @@ insert_md <- function(body, md, nodes, where = "after", space = TRUE) { shove_nodes_in <- function(body, new, nodes, where = "after", space = TRUE) { if (inherits(nodes, "character")) { + xpath <- nodes nodes <- xml2::xml_find_all(body, nodes, ns = md_ns()) + } else { + xpath <- NULL } + if (length(nodes) == 0) { + msg <- glue::glue("No nodes matched the expression {sQuote(xpath)}") + rlang::abort(msg, class = "insert-md-xpath") + } if (!inherits(nodes, c("xml_node", "xml_nodeset"))) { rlang::abort("an object of class `xml_node` or `xml_nodeset` was expected", class = "insert-md-node" @@ -83,16 +90,24 @@ add_nodes_to_nodes <- function(new, old, where = "after", space = TRUE) { # allow purrr::walk() to work on a single node old <- list(old) } - purrr::walk(old, add_node_siblings, new, where = where, remove = FALSE) + purrr::walk(.x = old, .f = add_node_siblings, + new = new, where = where, remove = FALSE + ) } # Add siblings to a node -add_node_siblings <- function(node, nodes, where = "after", remove = TRUE) { +add_node_siblings <- function(node, new, where = "after", remove = TRUE) { # if there is a single node, then we need only add it - if (inherits(nodes, "xml_node")) { - xml2::xml_add_sibling(node, nodes, .where = where) + if (inherits(new, "xml_node")) { + xml2::xml_add_sibling(node, new, .where = where) } else { - purrr::walk(rev(nodes), ~xml2::xml_add_sibling(node, .x, .where = where)) + if (where == "after") { + # Appending new nodes requires us to insert them from the bottom to + # the top. The reason for this is because we are always using the existing + # node as a reference. + new <- rev(new) + } + purrr::walk(new, ~xml2::xml_add_sibling(node, .x, .where = where)) } if (remove) xml2::xml_remove(node) } diff --git a/tests/testthat/test-class-yarn.R b/tests/testthat/test-class-yarn.R index d604f27..35322c4 100644 --- a/tests/testthat/test-class-yarn.R +++ b/tests/testthat/test-class-yarn.R @@ -160,7 +160,7 @@ test_that("markdown can be appended to elements", { path <- system.file("extdata", "example2.Rmd", package = "tinkr") ex <- tinkr::yarn$new(path) # append a note after the first heading - txt <- c("> Hello from *tinkr*!", ">", "> :heart: R") + txt <- c("The following message is sponsored by me:\n", "> Hello from *tinkr*!", ">", "> :heart: R") # Via XPath ------------------------------------------------------------------ ex$append_md(txt, ".//md:heading[1]") # the block quote has been added to the first heading @@ -222,10 +222,12 @@ test_that("markdown can be prepended", { nodes <- xml2::xml_find_all(ex$body, ".//node()[contains(text(), 'NERDS')]", ex$ns) expect_length(nodes, 0) - ex$prepend_md("Table: BIRDS, NERDS", ".//md:table") + ex$prepend_md("I come before the table.\n\nTable: BIRDS, NERDS", ".//md:table") nodes <- xml2::xml_find_all(ex$body, ".//node()[contains(text(), 'NERDS')]", ex$ns) expect_length(nodes, 1) + pretxt <- xml2::xml_find_first(nodes[[1]], ".//parent::*/preceding-sibling::*[1]") + expect_equal(xml2::xml_text(pretxt), "I come before the table.") }) @@ -235,6 +237,13 @@ test_that("an error happens when you try to append with a number", { expect_error(ex$append_md("WRONG", 42), class = "insert-md-node") }) +test_that("an error happens when you try to append to a non-existant node", { + path <- system.file("extdata", "example2.Rmd", package = "tinkr") + ex <- tinkr::yarn$new(path) + expect_error(ex$append_md("WRONG", ".//md:nope"), + "No nodes matched the expression './/md:nope'", + class = "insert-md-xpath") +}) test_that("an error happens when you try to append markdown to disparate elements", { From 8cd7583be62092f5539630b8e544de1bd17589a5 Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar (UMass)" Date: Tue, 5 Nov 2024 08:54:51 -0800 Subject: [PATCH 7/8] add dev comments --- .Rbuildignore | 3 +++ DESCRIPTION | 3 ++- R/add_md.R | 22 +++++++++++++++++++++- man/add_md.Rd | 1 + man/add_nodes_to_body.Rd | 22 ++++++++++++++++++++++ man/insert_md.Rd | 32 ++++++++++++++++++++++++++++++++ man/isolate_nodes.Rd | 2 +- man/provision_isolation.Rd | 2 +- man/yarn.Rd | 4 ++-- 9 files changed, 85 insertions(+), 6 deletions(-) create mode 100644 man/add_nodes_to_body.Rd create mode 100644 man/insert_md.Rd diff --git a/.Rbuildignore b/.Rbuildignore index a43ff80..a46c589 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -19,3 +19,6 @@ ^inst/scripts/samples.R ^inst/extdata/bigsample.*$ ^inst/extdata/xml_table.xml$ +^man/add_md\.Rd$ +^man/add_nodes_to_body\.Rd$ +^man/insert_md\.Rd$ diff --git a/DESCRIPTION b/DESCRIPTION index c1747cf..f80fb8e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,6 +55,7 @@ Suggests: Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true -Roxygen: list(markdown = TRUE) +Roxygen: list(markdown = TRUE, roclets = c("collate", "rd", "namespace", "devtag::dev_roclet")) RoxygenNote: 7.3.2.9000 VignetteBuilder: knitr +Config/Needs/build: moodymudskipper/devtag diff --git a/R/add_md.R b/R/add_md.R index 422d9e1..83d9aad 100644 --- a/R/add_md.R +++ b/R/add_md.R @@ -6,13 +6,19 @@ #' @keywords internal #' #' @return a copy of the XML object with the markdown inserted. +#' @dev add_md <- function(body, md, where = 0L) { new <- md_to_xml(md) add_nodes_to_body(body, new, where) copy_xml(body) } -# Add children to a specific location in the full document. +#' Add children to a specific location in the full document. +#' +#' @inheritParams add_md +#' @param nodes an object of `xml_node` or list of nodes +#' @return a copy of the XML object with nodes inserted +#' @dev add_nodes_to_body <- function(body, nodes, where = 0L) { if (inherits(nodes, "xml_node")) { xml2::xml_add_child(body, nodes, .where = where) @@ -21,6 +27,20 @@ add_nodes_to_body <- function(body, nodes, where = 0L) { } } + +#' Insert markdown before or after a set of nodes +#' +#' @inheritParams add_md +#' @param md markdown text to insert +#' @param nodes a character vector of an XPath expression OR an `xml_node` or +#' `xml_nodeset` object. +#' @param space when `TRUE` (default) inline nodes have a single space appended +#' or prepended to avoid the added markdown abutting text. +#' @return a copy of the XML object with the translated markdown inserted +#' +#' @note The markdown content must be of the same type as the XML nodes, either +#' inline or block content. +#' @dev insert_md <- function(body, md, nodes, where = "after", space = TRUE) { new <- md_to_xml(md) shove_nodes_in(body, new, nodes = nodes, where = where, space = space) diff --git a/man/add_md.Rd b/man/add_md.Rd index 5db57bd..819069a 100644 --- a/man/add_md.Rd +++ b/man/add_md.Rd @@ -20,3 +20,4 @@ a copy of the XML object with the markdown inserted. Add markdown content to an XML object } \keyword{internal} +\keyword{internal} diff --git a/man/add_nodes_to_body.Rd b/man/add_nodes_to_body.Rd new file mode 100644 index 0000000..56ee346 --- /dev/null +++ b/man/add_nodes_to_body.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_md.R +\name{add_nodes_to_body} +\alias{add_nodes_to_body} +\title{Add children to a specific location in the full document.} +\usage{ +add_nodes_to_body(body, nodes, where = 0L) +} +\arguments{ +\item{body}{an XML object generated via {tinkr}} + +\item{nodes}{an object of \code{xml_node} or list of nodes} + +\item{where}{the position in the markdown document to insert the new markdown} +} +\value{ +a copy of the XML object with nodes inserted +} +\description{ +Add children to a specific location in the full document. +} +\keyword{internal} diff --git a/man/insert_md.Rd b/man/insert_md.Rd new file mode 100644 index 0000000..211725e --- /dev/null +++ b/man/insert_md.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_md.R +\name{insert_md} +\alias{insert_md} +\title{Insert markdown before or after a set of nodes} +\usage{ +insert_md(body, md, nodes, where = "after", space = TRUE) +} +\arguments{ +\item{body}{an XML object generated via {tinkr}} + +\item{md}{markdown text to insert} + +\item{nodes}{a character vector of an XPath expression OR an \code{xml_node} or +\code{xml_nodeset} object.} + +\item{where}{the position in the markdown document to insert the new markdown} + +\item{space}{when \code{TRUE} (default) inline nodes have a single space appended +or prepended to avoid the added markdown abutting text.} +} +\value{ +a copy of the XML object with the translated markdown inserted +} +\description{ +Insert markdown before or after a set of nodes +} +\note{ +The markdown content must be of the same type as the XML nodes, either +inline or block content. +} +\keyword{internal} diff --git a/man/isolate_nodes.Rd b/man/isolate_nodes.Rd index 33ce12c..380e07c 100644 --- a/man/isolate_nodes.Rd +++ b/man/isolate_nodes.Rd @@ -41,7 +41,7 @@ as a list of paragraphs. } } \examples{ -\dontshow{if (isTRUE(as.logical(Sys.getenv("NOT_CRAN", "false")))) withAutoprint(\{ # examplesIf} +\dontshow{if (isTRUE(as.logical(Sys.getenv("NOT_CRAN", "false")))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} path <- system.file("extdata", "show-example.md", package = "tinkr") y <- tinkr::yarn$new(path, sourcepos = TRUE) y$protect_math()$protect_curly() diff --git a/man/provision_isolation.Rd b/man/provision_isolation.Rd index 0764da3..c1c22b9 100644 --- a/man/provision_isolation.Rd +++ b/man/provision_isolation.Rd @@ -28,7 +28,7 @@ we can filter on nodes that are not connected to those present in the nodelist. This function is required for \code{\link[=isolate_nodes]{isolate_nodes()}} to work. } \examples{ -\dontshow{if (isTRUE(as.logical(Sys.getenv("NOT_CRAN", "false")))) withAutoprint(\{ # examplesIf} +\dontshow{if (isTRUE(as.logical(Sys.getenv("NOT_CRAN", "false")))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} path <- system.file("extdata", "show-example.md", package = "tinkr") y <- tinkr::yarn$new(path, sourcepos = TRUE) y$protect_math()$protect_curly() diff --git a/man/yarn.Rd b/man/yarn.Rd index c51af6d..0657e6e 100644 --- a/man/yarn.Rd +++ b/man/yarn.Rd @@ -481,7 +481,7 @@ readLines(tmp, n = 20) \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-yarn-append_md}{}}} \subsection{Method \code{append_md()}}{ -append abritrary markdown to a node or set of nodes +append abritrarily markdown to a node or set of nodes \subsection{Usage}{ \if{html}{\out{
}}\preformatted{yarn$append_md(md, nodes = NULL, space = TRUE)}\if{html}{\out{
}} } @@ -529,7 +529,7 @@ ex$append_md(txt, ".//md:heading[1]")$head(20) \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-yarn-prepend_md}{}}} \subsection{Method \code{prepend_md()}}{ -prepend abritrary markdown to a node or set of nodes +prepend abritrarily markdown to a node or set of nodes \subsection{Usage}{ \if{html}{\out{
}}\preformatted{yarn$prepend_md(md, nodes = NULL, space = TRUE)}\if{html}{\out{
}} } From c99654534a916d83c65cddc21d2553a8cacbe5d6 Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar" Date: Tue, 12 Nov 2024 07:33:55 -0800 Subject: [PATCH 8/8] Apply suggestions from code review --- R/class-yarn.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/class-yarn.R b/R/class-yarn.R index ccd6083..1b21402 100644 --- a/R/class-yarn.R +++ b/R/class-yarn.R @@ -203,7 +203,7 @@ yarn <- R6::R6Class("yarn", self$body <- add_md(self$body, md, where) invisible(self) }, - #' @description append abritrarily markdown to a node or set of nodes + #' @description append abritrary markdown to a node or set of nodes #' #' @param md a string of markdown formatted text. #' @param nodes an XPath expression that evaulates to object of class @@ -228,7 +228,7 @@ yarn <- R6::R6Class("yarn", self$body <- insert_md(self$body, md, nodes, where = "after", space = space) invisible(self) }, - #' @description prepend abritrarily markdown to a node or set of nodes + #' @description prepend arbitrary markdown to a node or set of nodes #' #' @param md a string of markdown formatted text. #' @param nodes an XPath expression that evaulates to object of class