Merge pull request #33 from ropensci/znk-r6

Use R6 representation

.Rbuildignore

@@ -6,3 +6,4 @@
 ^LICENSE\.md$
 ^tinkr\.Rproj$
 ^\.Rproj\.user$
+^README\.Rmd$

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: tinkr
-Title: Casts (R)Markdown files to XML and back
+Title: Casts (R)Markdown Files to XML and Back Again
 Version: 0.0.0.9000
 Authors@R: 
     c(person(given = "Maëlle",
@@ -24,11 +24,11 @@ Authors@R:
       person(given = "Peter",
              family = "Daengeli",
              role = "ctb"))
-Description: Casts (R)Markdown files to XML and back to allow their editing via XPat.
+Description: Casts (R)Markdown files to XML and back to allow their editing via XPath.
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.1.9000
 Imports: 
     magrittr,
     commonmark (>= 1.6),
@@ -39,12 +39,13 @@ Imports:
     yaml,
     stringr,
     knitr,
-    purrr
+    purrr,
+    R6
 Suggests: 
-    testthat (>= 2.99.0.9000),
-    covr
-Remotes:
-    r-lib/testthat
+    testthat (>= 3.0.0),
+    covr,
+    withr
 URL: https://docs.ropensci.org/tinkr/, https://github.com/ropensci/tinkr
 BugReports: https://github.com/ropensci/tinkr/issues
 Config/testthat/edition: 3
+Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -2,4 +2,5 @@
 
 export(to_md)
 export(to_xml)
+export(yarn)
 importFrom(magrittr,"%>%")

NEWS.md

@@ -1,5 +1,7 @@
 # tinkr dev
 
+* xml and yaml objects are now stored in an R6 class called `yarn`.
+* testthat edition 3 is now being used with snapshot testing.
 * Tables are now pretty after a full loop `to_xml()` + `to_md()` (@pdaengeli, #9)
 
 # tinkr 0.0.0.9000

R/class-yarn.R

@@ -0,0 +1,181 @@
+#' R6 class containing XML representation of Markdown
+#'
+#' @description
+#' Wrapper around an XML representation of a Markdown document. It contains four
+#' publicly accessible slots: path, yaml, body, and ns.
+#' @details
+#' This class is a fancy wrapper around the results of [tinkr::to_xml()] and
+#' has methods that make it easier to add, analyze, remove, or write elements
+#' of your markdown document.
+#' @export
+yarn <- R6::R6Class("yarn", 
+  portable = TRUE,
+  public = list(
+    #' @field path \[`character`\] path to file on disk
+    path = NULL,
+
+    #' @field yaml \[`character`\] text block at head of file
+    yaml = NULL,
+
+    #' @field body \[`xml_document`\] an xml document of the (R)Markdown file. 
+    body = NULL,
+
+    #' @field ns \[`xml_document`\] an xml namespace object definining "md" to
+    #'   commonmark.
+    ns = NULL,
+    #' @description Create a new yarn document 
+    #' 
+    #' @param path \[`character`\] path to a markdown episode file on disk
+    #' @param encoding \[`character`\] encoding passed to [readLines()]
+    #' @param sourcepos passed to [commonmark::markdown_xml()]. If `TRUE`, the
+    #'   source position of the file will be included as a "sourcepos" attribute.
+    #'   Defaults to `FALSE`.
+    #' @return A new yarn object containing an XML representation of a 
+    #' (R)Markdown file.
+    #'
+    #' @examples
+    #' path <- system.file("extdata", "example1.md", package = "tinkr")
+    #' ex1 <- tinkr::yarn$new(path)
+    #' ex1
+    #' path2 <- system.file("extdata", "example2.Rmd", package = "tinkr")
+    #' ex2 <- tinkr::yarn$new(path2)
+    #' ex2
+    initialize = function(path = NULL, encoding = "UTF-8", sourcepos = FALSE) {
+      if (is.null(path)) {
+        return(self)
+      } else {
+        xml <- to_xml(path, encoding, sourcepos)
+      }
+      self$path <- path
+      self$yaml <- xml$yaml
+      self$body <- xml$body
+      self$ns   <- xml2::xml_ns_rename(xml2::xml_ns(xml$body), d1 = "md")
+      invisible(self)
+    },
+
+    #' @description reset a yarn document from the original file
+    #' @examples
+    #'
+    #' path <- system.file("extdata", "example1.md", package = "tinkr")
+    #' ex1 <- tinkr::yarn$new(path)
+    #' # OH NO
+    #' ex1$body
+    #' ex1$body <- xml2::xml_missing()
+    #' ex1$reset()
+    #' ex1$body
+    reset = function() {
+      x <- to_xml(self$path)
+      self$body <- x$body
+      self$yaml <- x$yaml
+      invisible(self)
+    },
+
+    #' @description Write a yarn document to Markdown/R Markdown
+    #'
+    #' @param path path to the file you want to write
+    #' @param stylesheet_path path to the xsl stylesheet to convert XML to markdown.
+    #' @examples
+    #' path <- system.file("extdata", "example1.md", package = "tinkr")
+    #' ex1 <- tinkr::yarn$new(path)
+    #' ex1
+    #' tmp <- tempfile()
+    #' try(readLines(tmp)) # nothing in the file
+    #' ex1$write(tmp)
+    #' head(readLines(tmp)) # now a markdown file
+    #' unlink(tmp)
+    write = function(path = NULL, 
+      stylesheet_path = system.file("extdata", "xml2md_gfm.xsl", package = "tinkr")){
+      if (is.null(path)) {
+        stop("Please provide a file path", call. = FALSE)
+      }
+      to_md(self, path, stylesheet_path)
+      invisible(self)
+    },
+
+    #' @description show the markdown contents on the screen
+    #'
+    #' @return a character vector with one line for each line in the output
+    #' @examples
+    #' path <- system.file("extdata", "example2.Rmd", package = "tinkr")
+    #' ex2 <- tinkr::yarn$new(path)
+    #' ex2$head(5)
+    #' ex2$tail(5)
+    #' ex2$show()
+    show = function() {
+      cat(out <- private$md_lines(), sep = "\n")
+      invisible(out)
+    },
+
+    #' @description show the head of the markdown contents on the screen
+    #'
+    #' @param n the number of elements to show from the top. Negative numbers
+    #' exclude lines from the bottom
+    #' @return a character vector with `n` elements
+    head = function(n = 6L) {
+      cat(out <- head(private$md_lines(), n), sep = "\n")
+      invisible(out)
+    },
+
+    #' @description show the tail of the markdown contents on the screen
+    #'
+    #' @param n the number of elements to show from the bottom. Negative numbers
+    #' exclude lines from the top
+    #' 
+    #' @return a character vector with `n` elements
+    tail = function(n = 6L) {
+      cat(out <- tail(private$md_lines(), n), sep = "\n")
+      invisible(out)
+    },
+
+    #' @description add an arbitrary Markdown element to the document
+    #'
+    #' @param md a string of markdown formatted text.
+    #' @param where the location in the document to add your markdown text.
+    #'   This is passed on to [xml2::xml_add_child()]. Defaults to 0, which
+    #'   indicates the very top of the document.
+    #' @examples
+    #' path <- system.file("extdata", "example2.Rmd", package = "tinkr")
+    #' ex <- tinkr::yarn$new(path)
+    #' # two headings, no lists
+    #' xml2::xml_find_all(ex$body, "md:heading", ex$ns)
+    #' xml2::xml_find_all(ex$body, "md:list", ex$ns)
+    #' ex$add_md(
+    #'   "# Hello\n\nThis is *new* formatted text from `{tinkr}`!",
+    #'   where = 1L
+    #' )$add_md(
+    #'   " - This\n - is\n - a new list",
+    #'   where = 2L
+    #' )
+    #' # three headings
+    #' xml2::xml_find_all(ex$body, "md:heading", ex$ns)
+    #' xml2::xml_find_all(ex$body, "md:list", ex$ns)
+    #' tmp <- tempfile()
+    #' ex$write(tmp)
+    #' readLines(tmp, n = 20) 
+    add_md = function(md, where = 0L) {
+      b <- self$body
+      new <- clean_content(md)
+      new <- commonmark::markdown_xml(new, extensions = TRUE)
+      new <- xml2::xml_ns_strip(xml2::read_xml(new))
+      new <- xml2::xml_children(new)
+      for (child in rev(new)) {
+        xml2::xml_add_child(b, child, .where = where)
+      }
+      self$body <- copy_xml(b)
+      invisible(self)
+    }
+  ),
+  private = list(
+    # converts the document to markdown and separates the output into lines
+    md_lines = function() {
+      md <- to_md(self)
+      # Make sure that the yaml is not sitting on top of the first markdown line
+      if (length(md) == 2) {
+        md[1] <- paste0(md[1], "\n")
+      }
+      f  <- textConnection(md)
+      on.exit(close(f))
+      readLines(f)
+    }
+  )
+)

R/stylesheet.R

@@ -0,0 +1,31 @@
+is_stylesheet <- function(stylesheet) {
+  inherits(stylesheet, "xml_document") && 
+    length(xml2::xml_name(stylesheet)) == 1L    &&
+    xml2::xml_name(stylesheet) == "stylesheet"
+}
+
+read_stylesheet <- function(stylesheet_path) {
+
+  # if the stylesheet already is an XML stylesheet, just return.
+  if (is_stylesheet(stylesheet_path)) {
+    return(stylesheet_path)
+  }
+
+  null_or_na <- is.null(stylesheet_path) ||
+    length(stylesheet_path) != 1L ||
+    any(is.na(stylesheet_path))
+
+  if (null_or_na) {
+    stop("'stylesheet_path' must be a path to an XSL stylesheet", call. = FALSE)
+  }
+  if (!file.exists(stylesheet_path)) {
+    stop(glue::glue("The file '{stylesheet_path}' does not exist."), call. = FALSE)
+  }
+  out <- xml2::read_xml(stylesheet_path)
+  if (is_stylesheet(out)) {
+    return(out)
+  } else {
+    stop(glue::glue("'{stylesheet_path}' is not a valid stylesheet"))
+  }
+
+}

R/to_md.R

@@ -1,14 +1,19 @@
 #' Write YAML and XML back to disk as (R)Markdown
 #'
-#' @param yaml_xml_list result from a call to \code{to_xml} and editing.
-#' @param path path of the new file
+#' @param yaml_xml_list result from a call to [to_xml()] and editing.
+#' @param path path of the new file. Defaults to `NULL`, which will not write
+#'   any file, but will still produce the conversion and pass the output as
+#'   a character vector.
 #' @param stylesheet_path path to the XSL stylesheet
 #'
 #' @details The stylesheet you use will decide whether lists
 #' are built using "*" or "-" for instance. If you're keen to
-#'  keep your own Markdown style when using \code{to_md} after
-#'  \code{to_xml}, you can tweak the XSL stylesheet a bit and provide
-#'  the path to your XSL stylesheet as argument.
+#' keep your own Markdown style when using [to_md()] after
+#' [to_xml()], you can tweak the XSL stylesheet a bit and provide
+#' the path to your XSL stylesheet as argument.
+#'
+#'
+#' @return the converted document, invisibly. 
 #'
 #' @export
 #'
@@ -31,25 +36,34 @@
 #' # file.edit("newmd.md")
 #' file.remove(newmd)
 #'
-to_md <- function(yaml_xml_list, path,
+to_md <- function(yaml_xml_list, path = NULL,
                   stylesheet_path = system.file("extdata", "xml2md_gfm.xsl", package = "tinkr")){
 
-  stylesheet_path %>%
-    xml2::read_xml() -> stylesheet
-
   # duplicate document to avoid overwriting
   body <- copy_xml(yaml_xml_list$body)
+  yaml <- yaml_xml_list$yaml
+
+  # read stylesheet and fail early if it doesn't exist
+  stylesheet <- read_stylesheet(stylesheet_path)
 
   transform_code_blocks(body)
 
+  md_out <- transform_to_md(body, yaml, stylesheet)
+
+  if (!is.null(path)) {
+    writeLines(md_out, con = path, useBytes = TRUE, sep =  "\n\n")
+  }
+
+  invisible(md_out)
+}
+
+# convert body and yaml to markdown text given a stylesheet
+transform_to_md <- function(body, yaml, stylesheet) {
   body <- xslt::xml_xslt(body, stylesheet = stylesheet)
 
-  yaml_xml_list$yaml %>%
-    glue::glue_collapse(sep = "\n") -> yaml
+  yaml <- glue::glue_collapse(yaml, sep = "\n")
 
-  writeLines(c(yaml, body), con = path,
-             useBytes = TRUE,
-             sep =  "\n\n")
+  c(yaml, body)
 }
 
 copy_xml <- function(xml) {

R/to_xml.R

@@ -31,11 +31,7 @@ to_xml <- function(path, encoding = "UTF-8", sourcepos = FALSE){
     commonmark::markdown_xml(extensions = TRUE, sourcepos = sourcepos) %>%
     xml2::read_xml(encoding = encoding) -> body
 
-  if(stringr::str_detect(fs::path_ext(path), "[Rr]")){
-
-    parse_rmd(body)
-
-  }
+  parse_rmd(body)
 
   list(yaml = yaml,
        body = body)