create append_md and prepend_md methods

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

R/add_md.R

@@ -21,6 +21,71 @@ add_nodes_to_body <- function(body, nodes, where = 0L) {
   }
 }
 
+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)
+  copy_xml(body)
+}
+
+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())
+  }
+  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"
+    )
+  }
+  root <- xml2::xml_root(nodes)
+  if (!identical(root, body)) {
+    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, space = space))
+}
+
+
+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 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)
+  # 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", 
+        class = "insert-md-dual-type",
+        call. = FALSE
+      )
+    }
+    # make sure the new nodes are inline by extracting the children. 
+    new <- xml2::xml_children(new)
+    if (space) {
+      # 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, new, 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

R/class-yarn.R

@@ -203,6 +203,55 @@ 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). 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)
+    #' # 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, space = TRUE) {
+      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
+    #'
+    #' @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). 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)
+    #'
+    #' # 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 <- insert_md(self$body, md, nodes, where = "before", space = space)
+      invisible(self)
+    },
     #' @description Protect math blocks from being escaped
     #'
     #' @examples

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,99 @@ 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)
+  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)
+  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)
+  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")