create append_md and prepend_md methods

.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$

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

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

@@ -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,13 +27,107 @@ 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)
+  copy_xml(body)
+}
+
+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"
+    )
+  }
+  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(.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)
 }

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 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
+    #'   `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