Merge pull request #111 from ropensci/feature-add-get-protected

add get_protected()

DESCRIPTION

@@ -42,6 +42,7 @@ Imports:
     magrittr,
     purrr,
     R6,
+    rlang (>= 0.4.5),
     xml2,
     xslt,
     yaml
@@ -55,5 +56,5 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 VignetteBuilder: knitr

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(find_between)
+export(get_protected)
 export(md_ns)
 export(protect_curly)
 export(protect_math)

NEWS.md

@@ -1,5 +1,21 @@
 # tinkr 0.2.0.9000
 
+## NEW FEATURES
+
+* `get_protected()` function (and yarn method) will return nodes which have
+  been protected in some way by {tinkr} via one of the `protect_` family of
+  functions. Adopting this pattern is preferred over using
+  `md:text[@asis='true']` as the attribute names may change in the future
+  (@zkamvar, #111; reviewed: @maelle)
+* Block math will now include the delimiters and the softbreaks for protection
+  (issue/review: #113, @maelle; implemented: #111, @zkamvar)
+
+## NEW IMPORTS
+
+* We now import {rlang} for error handling. Because we already import {purrr},
+  this does not impact the dependency footprint (suggested: @maelle, #111;
+  implemented: @zkamvar, #111).
+
 ## BUG FIX
 
 * Bare links in Markdown (e.g. `<https://example.com/one>`) are no longer

R/asis-nodes.R

@@ -29,7 +29,7 @@ protect_math <- function(body, ns = md_ns()) {
 }
 
 set_asis <- function(nodes) {
-  xml2::xml_set_attr(nodes[xml2::xml_name(nodes) != "softbreak"], "asis", "true")
+  xml2::xml_set_attr(nodes, "asis", "true")
 }
 
 # INLINE MATH ------------------------------------------------------------------
@@ -178,8 +178,8 @@ fix_partial_inline <- function(tag, body, ns) {
   # paste the lines together and create new nodes
   n <- length(math_lines)
   char <- as.character(math_lines)
-  char[[1]] <- sub("[$]", "$</text><text asis='true'>", char[[1]])
-  char[[n]] <- sub("[<]text ", "<text asis='true' ", char[[n]])
+  char[[1]] <- sub("[$]", "$</text><text asis='true' math='true'>", char[[1]])
+  char[[n]] <- sub("[<]text ", "<text asis='true' math='true' ", char[[n]])
   nodes <- paste(char, collapse = "")
   nodes <- make_text_nodes(nodes)
   # add the new nodes to the bottom of the existing math lines
@@ -198,7 +198,7 @@ fix_fully_inline <- function(math) {
   # <text>this is </text><text asis='true'>$\LaTeX$</text><text> text</text>
   char <- gsub(
     pattern = inline_dollars_regex("full"),
-    replacement = "</text><text asis='true'>\\1</text><text>",
+    replacement = "</text><text asis='true' math='true'>\\1</text><text>",
     x = char,
     perl = TRUE
   )
@@ -246,7 +246,12 @@ make_text_nodes <- function(txt) {
 # BLOCK MATH ------------------------------------------------------------------
 
 find_block_math <- function(body, ns) {
-  find_between(body, ns, pattern = "md:text[contains(text(), '$$')]", include = FALSE)
+  # https://github.com/ropensci/tinkr/issues/113#issue-2302065427
+  find_between(body, 
+    ns, 
+    pattern = "md:text[contains(text(), '$$')]", 
+    include = TRUE
+  )
 }
 
 find_between_inlines <- function(body, ns, tag) {
@@ -259,6 +264,7 @@ protect_block_math <- function(body, ns) {
   # get all of the internal nodes
   bm <- xml2::xml_find_all(bm, ".//descendant-or-self::md:*", ns = ns)
   set_asis(bm)
+  xml2::xml_set_attr(bm, "math", "true")
 }
 
 # TICK BOXES -------------------------------------------------------------------

R/class-yarn.R

@@ -199,6 +199,32 @@ yarn <- R6::R6Class("yarn",
         message("to use the `protect_unescaped()` method, you will need to re-read your document with `yarn$new(sourcepos = TRUE)`")
       }
       invisible(self)
+    },
+    #' @description Return nodes whose contents are protected from being escaped
+    #' @param type a character vector listing the protections to be included.
+    #'   Defaults to `NULL`, which includes all protected nodes:
+    #'   - math: via the [protect_math()] function
+    #'   - curly: via the `protect_curly()` function
+    #'   - unescaped: via the `protect_unescaped()` function
+    #'
+    #' @examples
+    #' path <- system.file("extdata", "basic-curly.md", package = "tinkr")
+    #' ex <- tinkr::yarn$new(path, sourcepos = TRUE)
+    #' # protect curly braces
+    #' ex$protect_curly()
+    #' # add math and protect it
+    #' ex$add_md(c("## math\n", 
+    #'   "$c^2 = a^2 + b^2$\n", 
+    #'   "$$",
+    #'   "\\sum_{i}^k = x_i + 1",
+    #'   "$$\n")
+    #' )
+    #' ex$protect_math()
+    #' # get protected now shows all the protected nodes
+    #' ex$get_protected()
+    #' ex$get_protected(c("math", "curly")) # only show the math and curly
+    get_protected = function(type = NULL) {
+      get_protected(self$body, type = type, self$ns)
     }
   ),
   private = list(

R/get_protected.R

@@ -0,0 +1,41 @@
+#' Get protected nodes
+#'
+#' @param body an `xml_document` object
+#' @param type a character vector listing the protections to be included.
+#'   Defaults to `NULL`, which includes all protected nodes:
+#'   - math: via the `protect_math()` function
+#'   - curly: via the `protect_curly()` function
+#'   - unescaped: via the `protect_unescaped()` function
+#' @param ns the namespace of the document (defaults to [md_ns()])
+#' @return an `xml_nodelist` object.
+#' @export
+#' @examples
+#' path <- system.file("extdata", "basic-curly.md", package = "tinkr")
+#' ex <- tinkr::yarn$new(path, sourcepos = TRUE)
+#' # protect curly braces
+#' ex$protect_curly()
+#' # add math and protect it
+#' ex$add_md(c("## math\n", 
+#'   "$c^2 = a^2 + b^2$\n", 
+#'   "$$",
+#'   "\\sum_{i}^k = x_i + 1",
+#'   "$$\n")
+#' )
+#' ex$protect_math()
+#' # get protected now shows all the protected nodes
+#' get_protected(ex$body)
+#' get_protected(ex$body, c("math", "curly")) # only show the math and curly
+get_protected <- function(body, type = NULL, ns = md_ns()) {
+  protections <- c(
+    math = "@math",
+    curly = "@curly",
+    unescaped = "(@asis and text()='[' or text()=']')"
+  )
+  if (!is.null(type)) {
+    keep <- rlang::arg_match(type, names(protections), multiple = TRUE)
+  } else {
+    keep <- TRUE
+  }
+  xpath <- sprintf(".//node()[%s]", paste(protections[keep], collapse = " or "))
+  xml2::xml_find_all(body, xpath, ns = ns)
+}

tests/testthat/test-asis-nodes.R

@@ -68,6 +68,12 @@ test_that("block math can be protected", {
   expect_snapshot(show_user(m$protect_math()$tail(48), force = TRUE))
   expect_length(xml2::xml_ns(m$body), 1L)
   expect_equal(md_ns()[[1]], xml2::xml_ns(m$body)[[1]])
+  # 3 math blocks with code examples
+  expect_length(grep("$$", m$show(), fixed = TRUE), 12)
+  # 3 math delimiters included in the get_protected
+  expect_equal(sum(xml2::xml_text(m$get_protected("math")) == "$$"), 6)
+
+
 })
 
 

tests/testthat/test-get_protected.R

@@ -0,0 +1,45 @@
+test_that("protected nodes can be accessed", {
+  path <- withr::local_tempfile()
+  # five protected curly elements
+  curlies <- c("## curlies",
+    "\nThis line has {xml2} one and {tinkr} two curlies!",
+    "\n![a pretty kitten](https://placekitten.com/200/300){#kitteh alt='a picture of a kitten'}",
+    "\n![a pretty puppy](https://placedog.net/200/300){#dog alt=\"a picture", 
+    "of a dog\"}",
+    # two protected unescaped elements
+    "\n[span with attributes]{.span-with-attributes ",
+    "style='color: red'}",
+    ""
+  )
+  # six protected math elements
+  math <- c("## math", 
+    "\n$c^2 = a^2 + b^2$", # 1
+    "\n$$", # 2
+    # 3 <softbreak>
+    "\\sum_{i}^k = x_i + 1", # 4
+    # 5 <softbreak>
+    "$$", # 6
+    ""
+  )
+  writeLines(c(curlies, "\n", math), path)
+  ex <- tinkr::yarn$new(path, sourcepos = TRUE)
+  # we should have two protected elements right off due to the braces
+  expect_length(ex$get_protected(), 2)
+
+  # one inline math, two softbreaks, one line of block
+  ex$protect_math()
+  expect_length(ex$get_protected(), 2 + 6)
+
+  # we should have six protected curly nodes
+  ex$protect_curly()
+  expect_length(ex$get_protected(), 2 + 6 + 5)
+
+  expect_length(ex$get_protected("curly"), 5)
+  expect_length(ex$get_protected("math"), 6)
+  expect_length(ex$get_protected("unescaped"), 2)
+
+  expect_error(ex$get_protected(c("curly", "shemp")), 
+    "not \"shemp\""
+  )
+})
+