test_that("an empty yarn object can be created", { y1 <- yarn$new() expect_s3_class(y1, "yarn") expect_null(y1$body) expect_null(y1$toml) expect_null(y1$ns) expect_null(y1$path) }) test_that("yarn can be created from markdown", { pathmd <- system.file("extdata", "example1.md", package = "tinkr") y1 <- yarn$new(pathmd) t1 <- to_xml(pathmd) expect_s3_class(y1, "yarn") expect_s3_class(y1$body, "xml_document") expect_named(y1$ns, "md") expect_match(y1$ns, "commonmark") }) test_that("yarn show, head, and tail methods work", { pathrmd <- system.file("extdata", "example2.Rmd", package = "tinkr") y1 <- yarn$new(pathrmd) expect_snapshot(show_user(res <- y1$show(), TRUE)) expect_type(res, "character") # the head method is identical to subsetting 10 lines expect_snapshot(show_user(res_11 <- y1$show(11:20), TRUE)) expect_length(res_11, 10) %>% expect_identical(res[11:20]) %>% expect_type("character") # a subset from the top has 10 lines expect_snapshot(show_user(res_1 <- y1$show(1:10), TRUE)) expect_length(res_1, 10) %>% expect_type("character") # the head method is identical to subsetting 10 lines expect_snapshot(show_user(res <- y1$head(10), TRUE)) expect_length(res, 10) %>% expect_identical(res_1) %>% expect_type("character") expect_snapshot(show_user(res <- y1$tail(11), TRUE)) expect_length(res, 11) %>% expect_type("character") }) test_that("yarn show method will warn if using positional stylesheet", { path <- system.file("extdata", "table.md", package = "tinkr") y1 <- yarn$new(path) expect_no_warning({ md_show <- y1$show(TRUE) }) expect_no_warning({ md_show1 <- y1$show(stylesheet_path = stylesheet()) }) suppressWarnings({ expect_warning(md_show2 <- y1$show(stylesheet())) }) expect_identical(md_show, md_show2) }) test_that("yarn can be created from Rmarkdown", { pathrmd <- system.file("extdata", "example2.Rmd", package = "tinkr") y1 <- yarn$new(pathrmd) t1 <- to_xml(pathrmd) expect_s3_class(y1, "yarn") expect_s3_class(y1$body, "xml_document") expect_named(y1$ns, "md") expect_match(y1$ns, "commonmark") }) test_that("the write method needs a filename", { pathmd <- system.file("extdata", "example1.md", package = "tinkr") expect_error(yarn$new(pathmd)$write(), "Please provide a file path") }) test_that("a yarn object can be written back to markdown", { tmpdir <- withr::local_tempdir() scarf1 <- withr::local_file(file.path(tmpdir, "yarn.md")) scarf2 <- withr::local_file(file.path(tmpdir, "yarn.Rmd")) pathrmd <- system.file("extdata", "example2.Rmd", package = "tinkr") pathmd <- system.file("extdata", "example1.md", package = "tinkr") y1 <- yarn$new(pathmd) y2 <- yarn$new(pathrmd) y1$write(scarf1) y2$write(scarf2) expect_snapshot_file(scarf1) expect_snapshot_file(scarf2) }) test_that("protect_unescaped() throws a message if sourcepos is not available", { path <- system.file("extdata", "basic-curly.md", package = "tinkr") y1 <- yarn$new(path, sourcepos = FALSE) expect_message(y1$protect_unescaped(), "sourcepos") }) test_that("protect_unescaped() will work if the user implements it later", { path <- system.file("extdata", "basic-curly.md", package = "tinkr") y1 <- yarn$new(path, sourcepos = TRUE, unescaped = FALSE) old <- y1$tail() new <- y1$protect_unescaped()$tail() expect_snapshot(writeLines(old)) expect_snapshot(writeLines(new)) }) test_that("a yarn object can be reset", { scarf1 <- withr::local_tempfile(fileext = "md") pathmd <- system.file("extdata", "example1.md", package = "tinkr") y1 <- yarn$new(pathmd, sourcepos = TRUE, encoding = "utf-8") expect_equal(y1$.__enclos_env__$private$encoding, "utf-8") expect_true(y1$.__enclos_env__$private$sourcepos) expect_s3_class(y1$body, "xml_document") expect_false(is.na(xml2::xml_attr(y1$body, "sourcepos"))) y1$body <- xml2::xml_missing() expect_s3_class(y1$body, "xml_missing") y1$reset() expect_s3_class(y1$body, "xml_document") expect_equal(y1$.__enclos_env__$private$encoding, "utf-8") expect_true(y1$.__enclos_env__$private$sourcepos) expect_false(is.na(xml2::xml_attr(y1$body, "sourcepos"))) }) test_that("random markdown can be added to the body", { tmpdir <- withr::local_tempdir() scarf3 <- withr::local_file(file.path(tmpdir, "yarn-kilroy.md")) mdtable <- system.file("extdata", "table.md", package = "tinkr") t1 <- yarn$new(mdtable) expect_equal(xml2::xml_name(xml2::xml_child(t1$body)), "table") expect_length(xml2::xml_find_all(t1$body, "link", t1$ns), 0L) newmd <- c("# TABLE HERE\n\n", "[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 = "")) t1$add_md(toupper(newmd[[3]]), where = 3) expect_length(xml2::xml_find_all(t1$body, "md:link", t1$ns), 0L) t1$write(scarf3) expect_snapshot_file(scarf3) }) 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("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 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[text()='<-- READ THIS']/preceding-sibling::md:text[text()=' ']", ex$ns) expect_length(nodes, 1) tst <- tinkr::yarn$new(con <- textConnection("how are you?")) withr::defer(close(con)) tst$append_md("_hello_?", ".//md:text") expect_equal(tst$show()[1], "how are you? *hello*?") expect_equal(tst$append_md("**oh hai**", ".//md:emph")$show()[1], "how are you? *hello* **oh hai**?" ) }) 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("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.") }) test_that("inline markdown can be prepended", { tst <- tinkr::yarn$new(con <- textConnection("how are you?")) withr::defer(close(con)) tst$prepend_md("_hello_?", ".//md:text") # should be "*hello*? how are you?" expect_equal(tst$show()[1], "*hello*? how are you?") #> *hello*? how are you? expect_equal(tst$prepend_md("**oh hai**", ".//md:emph")$show()[1], "**oh hai** *hello*? how are you?" ) }) 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 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", { 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") y1 <- yarn$new(pathmd, sourcepos = TRUE, encoding = "utf-8") expect_null(y1$md_vec(NULL)) headings <- xml2::xml_find_all(y1$body, ".//md:heading", y1$ns) expected <- paste(strrep("#", xml2::xml_attr(headings, "level")), xml2::xml_text(headings) ) expect_equal(y1$md_vec(".//md:heading[@level=3]"), expected[1:4]) expect_length(y1$md_vec(".//md:list//md:link"), 5) skip_on_os("windows") expect_equal(y1$md_vec(".//md:heading[@level=4]"), expected[5:7]) expect_equal(y1$md_vec(".//md:heading"), expected) }) test_that("TOML is preserved", { pathmd <- system.file("extdata", "example-toml.md", package = "tinkr") y1 <- yarn$new(pathmd) expect_gt(length(y1$frontmatter), 0) expect_equal(y1$frontmatter_format, "TOML") path <- withr::local_tempfile() y1$write(path) expect_snapshot_file(path, name = "example-toml.md") }) test_that("TOML is preserved", { pathmd <- system.file("extdata", "example-json.md", package = "tinkr") y1 <- yarn$new(pathmd) expect_gt(length(y1$frontmatter), 0) expect_equal(y1$frontmatter_format, "JSON") path <- withr::local_tempfile() y1$write(path) expect_snapshot_file(path, name = "example-json.md") }) test_that("no metadata, chunk works", { pathmd <- system.file("extdata", "example-chunk-not-json.md", package = "tinkr") y1 <- yarn$new(pathmd) expect_equal(length(y1$frontmatter), 0) path <- withr::local_tempfile() y1$write(path) expect_snapshot_file(path, name = "example-chunk-not-json.md") })