Skip to content

Commit

Permalink
Expannd testing
Browse files Browse the repository at this point in the history
  • Loading branch information
richfitz committed Sep 16, 2024
1 parent 728c235 commit 7779eaf
Show file tree
Hide file tree
Showing 2 changed files with 170 additions and 23 deletions.
55 changes: 32 additions & 23 deletions R/errors-parse.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,15 +9,19 @@
##' e.g., `E[0-9]{4}`. This should not include beginning or end of
##' string markers.
##'
##' @param cmd_explain The name of the command to explain an error
##'
##' @param check Logical, indicating if we should check that we can
##' render everything we produce
##'
##' @return A list, save this within the package
##'
##' @export
errors_parse <- function(path_rmd, pattern, check = TRUE) {
errors_parse <- function(path_rmd, pattern, cmd_explain, check = TRUE) {
assert_scalar_character(cmd_explain)
dat <- errors_read(path_rmd, pattern)
errors <- Map(error_parse, names(dat), dat)
info <- list(cmd_explain = cmd_explain)
errors <- Map(error_parse, names(dat), dat, info)
if (check) {
cli::cli_alert_info("Checking errors render")
for (err in errors) {
Expand Down Expand Up @@ -70,61 +74,66 @@ errors_read <- function(path_rmd, pattern) {
}


error_parse <- function(name, txt) {
xml <- xml2::read_xml(commonmark::markdown_xml(txt))
error_parse <- function(name, txt, info) {
list(code = name,
plain = txt,
parsed = lapply(xml2::xml_children(xml), error_parse_node))
parsed = error_parse_md(txt, info))
}


error_parse_md <- function(txt, info) {
xml <- xml2::read_xml(commonmark::markdown_xml(txt))
lapply(xml2::xml_children(xml), error_parse_node, info)
}


error_parse_node <- function(x) {
error_parse_node <- function(x, info) {
nm <- xml2::xml_name(x)
switch(nm,
paragraph = error_parse_paragraph(x),
code_block = error_parse_code_block(x),
list = error_parse_list(x),
paragraph = error_parse_paragraph(x, info),
code_block = error_parse_code_block(x, info),
list = error_parse_list(x, info),
## Hard, inline:
link = error_parse_link(x),
link = error_parse_link(x, info),
## Easy, inline:
code = sprintf("{.code %s}", xml2::xml_text(x)),
emph = sprintf("{.emph %s}", xml2::xml_text(x)),
strong = sprintf("{.strong %s}", xml2::xml_text(x)),
text = xml2::xml_text(x),
stop(sprintf("Unknown node '%s'", nm)))
cli::cli_abort("Unknown node in md: '{nm}'"))
}


error_parse_list <- function(x) {
error_parse_list <- function(x, info) {
items <- xml2::xml_children(x)
stopifnot(all(vapply(items, xml2::xml_name, "") == "item"))
items <- lapply(items, function(x) error_parse_node(xml2::xml_child(x)))
items <- lapply(items, function(x) error_parse_node(xml2::xml_child(x), info))
list(type = "list",
mode = xml2::xml_attr(x, "type"),
items = items)
}


error_parse_paragraph <- function(x) {
txt <- vapply(xml2::xml_children(x), error_parse_node, "")
error_parse_paragraph <- function(x, info) {
txt <- vapply(xml2::xml_children(x), error_parse_node, "", info)
list(type = "paragraph",
text = paste(txt, collapse = ""))
}


error_parse_code_block <- function(x) {
error_parse_code_block <- function(x, info) {
list(type = "code_block",
text = strsplit(sub("\n$", "", xml2::xml_text(x)), "\n")[[1]])
}


error_parse_link <- function(x) {
error_parse_link <- function(x, info) {
target <- xml2::xml_attr(x, "destination")
if (grepl("^#e[0-9]{4}$", target)) {
if (grepl("^#(.+)$", target)) {
code <- xml2::xml_text(x)
stopifnot(tolower(code) == sub("^#", "", target))
sprintf('{.run odin2::odin_error_explain("%s")}', code)
sprintf('{.run %s("%s")}', info$cmd_explain, code)
} else {
txt <- paste(vapply(xml2::xml_children(x), error_parse_node, ""),
txt <- paste(vapply(xml2::xml_children(x), error_parse_node, "", info),
collapse = "")
sprintf("{.href [%s](%s)}", target, txt)
}
Expand All @@ -134,10 +143,10 @@ error_parse_link <- function(x) {
trim_blank <- function(x) {
i <- 1L
j <- length(x)
while (x[[i]] == "" && i > j) {
while (x[[i]] == "" && i < j) {
i <- i + 1L
}
while (x[[j]] == "" && j < i) {
while (x[[j]] == "" && j > i) {
j <- j - 1L
}
x[i:j]
Expand Down
138 changes: 138 additions & 0 deletions tests/testthat/test-errors-parse.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,138 @@
test_that("can construct a friendly pattern", {
expect_equal(pattern_to_hint("E[0-9]{3}"), "Exxx")
expect_equal(pattern_to_hint("E[0-9]{4}"), "Exxxx")
expect_equal(pattern_to_hint("E[0-9]{4}[a-z]"), "E[0-9]{4}[a-z]")
})


test_that("can construct a url to an RMD", {
skip_if_not_installed("mockery")
mock_as_pkgdown <- mockery::mock(
list(meta = list(url = "https://example.com"),
vignettes = data.frame(
file_in = "vignettes/errors.Rmd",
file_out = "path/errors.html")))
mockery::stub(errors_url, "pkgdown::as_pkgdown", mock_as_pkgdown)
res <- errors_url("vignettes/errors.Rmd")
expect_equal(res, "https://example.com/path/errors.html")
mockery::expect_called(mock_as_pkgdown, 1)
expect_equal(mockery::mock_args(mock_as_pkgdown)[[1]], list("."))
})


test_that("can parse all errors into a structure", {
skip_if_not_installed("mockery")
mock_errors_url <- mockery::mock("https://example.com/path/errors.html",
cycle = TRUE)
mockery::stub(errors_parse, "errors_url", mock_errors_url)
tmp <- withr::local_tempfile()
err <- c("# `E0001`",
"",
"my error")
writeLines(err, tmp)
res <- evaluate_promise(errors_parse(tmp, "E[0-9]{4}", "pkg::explain"))
expect_equal(res$result$url, "https://example.com/path/errors.html")
expect_equal(res$result$pattern,
list(local = "E[0-9]{4}",
complete = "^E[0-9]{4}$",
hint = "Exxxx"))
expect_match(res$messages,
"Checking errors render", all = FALSE)
expect_named(res$result$errors, "E0001")
expect_equal(res$result$errors$E0001,
list(code = "E0001",
plain = "my error",
parsed = list(list(type = "paragraph",
text = "my error"))))
expect_match(res$messages,
"all ok", all = FALSE)
})


test_that("can trim string vectors", {
expect_equal(trim_blank(c("", "", "x", "", "y")), c("x", "", "y"))
expect_equal(trim_blank(c("", "", "x", "", "y", "")), c("x", "", "y"))
expect_equal(trim_blank(c("x", "", "y", "")), c("x", "", "y"))
})


test_that("can parse error into cli", {
info <- list(cmd_explain = "pkg::explain")
expect_equal(
error_parse_md("simple", info),
list(list(type = "paragraph", text = "simple")))
expect_equal(
error_parse_md("*simple* with **inline** markdown `styles`", info),
list(
list(
type = "paragraph",
text = "{.emph simple} with {.strong inline} markdown {.code styles}")))
expect_equal(
error_parse_md(c("a paragraph",
"",
"1. a list",
"1. that is numbered"),
info),
list(
list(type = "paragraph", text = "a paragraph"),
list(type = "list",
mode = "ordered",
items = list(list(type = "paragraph", text = "a list"),
list(type = "paragraph", text = "that is numbered")))))
expect_equal(
error_parse_md(c("a paragraph",
"",
"* a list",
"* that is bullets"),
info),
list(
list(type = "paragraph", text = "a paragraph"),
list(type = "list",
mode = "bullet",
items = list(list(type = "paragraph", text = "a list"),
list(type = "paragraph", text = "that is bullets")))))
expect_equal(
error_parse_md(c("a paragraph",
"",
"```r",
"f <- function(x) {",
" x",
"}",
"```"),
info),
list(
list(type = "paragraph", text = "a paragraph"),
list(type = "code_block", text = c("f <- function(x) {", " x", "}"))))

expect_equal(
error_parse_md("foo [link](dest) bar", info),
list(list(type = "paragraph", text = "foo {.href [dest](link)} bar")))
expect_equal(
error_parse_md("foo [E101](#e101) bar", info),
list(list(type = "paragraph",
text = 'foo {.run pkg::explain("E101")} bar')))
})


test_that("require errors have consistent pattern", {
tmp <- withr::local_tempfile()
writeLines(
c("# `E0001`",
"",
"error1",
"",
"# `E002`",
"",
"error2"),
tmp)
expect_no_error(errors_read(tmp, "E[0-9]+"))
expect_error(
errors_read(tmp, "E[0-9]{4}"),
"Some headings in")
})


test_that("error on unknown node", {
expect_error(error_parse_md("---", NULL),
"Unknown node in md: 'thematic_break'")
})

0 comments on commit 7779eaf

Please sign in to comment.