From 587364a57f804608a82bb97a323af314863c6972 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Wed, 11 Sep 2024 12:52:32 -0400 Subject: [PATCH 1/6] pb_call stores the internal function as string --- R/get_agent_report.R | 2 +- R/interrogate.R | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/R/get_agent_report.R b/R/get_agent_report.R index 6af117258..e43eaa8f1 100644 --- a/R/get_agent_report.R +++ b/R/get_agent_report.R @@ -2473,7 +2473,7 @@ pointblank_cnd_to_string <- function(cnd, pb_call) { if (rlang::is_warning(cnd)) return(cnd) # Reconstruct trimmed down error and rethrow without cli new <- rlang::error_cnd( - call = rlang::call2(":::", quote(pointblank), pb_call[1]), + call = rlang::call2(":::", quote(pointblank), rlang::sym(pb_call)), message = cnd$parent$message %||% cnd$message, use_cli_format = FALSE ) diff --git a/R/interrogate.R b/R/interrogate.R index 22606466c..0a97cebdd 100644 --- a/R/interrogate.R +++ b/R/interrogate.R @@ -2940,6 +2940,11 @@ column_validity_checks_ib_nb <- function( pointblank_try_catch <- function(expr) { call <- rlang::enexpr(expr) + call_fn <- if (rlang::is_call_simple(call)) { + deparse(call[[1]]) # ex: "tbl_call_exists" + } else { + "" + } warn <- err <- NULL @@ -2953,7 +2958,7 @@ pointblank_try_catch <- function(expr) { invokeRestart("muffleWarning") }) - eval_list <- list(value = value, warning = warn, error = err, pb_call = call) + eval_list <- list(value = value, warning = warn, error = err, pb_call = call_fn) class(eval_list) <- "table_eval" eval_list From dcff523d6cd6c91eea32353785f49c7d8285dac3 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Wed, 11 Sep 2024 13:00:22 -0400 Subject: [PATCH 2/6] add test for error tooltip in report --- tests/testthat/test-get_agent_report.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/testthat/test-get_agent_report.R b/tests/testthat/test-get_agent_report.R index d8075cb23..9cefca3f7 100644 --- a/tests/testthat/test-get_agent_report.R +++ b/tests/testthat/test-get_agent_report.R @@ -302,3 +302,19 @@ test_that("col_vals_expr() shows used columns", { expect_equal(report_columns[4], "a") }) + +test_that("report shows informative error tooltips", { + + df <- data.frame(date = "invalid date") + agent <- create_agent(df) |> + col_vals_equal(date, Sys.Date()) |> + interrogate(progress = TRUE) + report <- get_agent_report(agent) + + error_source <- agent$validation_set$capture_stack[[1]]$pb_call + error_tooltip <- report$`_data`$eval_sym + + expect_equal(error_source, "tbl_val_comparison") + expect_true(grepl(error_source, error_tooltip)) + +}) From 26e04b4ce18e9e414c9fd0b3a3b9c85cb4d4af09 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Wed, 11 Sep 2024 13:11:14 -0400 Subject: [PATCH 3/6] typos --- R/create_agent.R | 2 +- R/interrogate.R | 2 +- man/create_agent.Rd | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/create_agent.R b/R/create_agent.R index f2ac0e0b2..5006f2824 100644 --- a/R/create_agent.R +++ b/R/create_agent.R @@ -394,7 +394,7 @@ #' ```r #' agent <- #' agent %>% -#' col_exists(columns = date, date_time) %>% +#' col_exists(columns = c(date, date_time)) %>% #' col_vals_regex( #' columns = b, #' regex = "[0-9]-[a-z]{3}-[0-9]{3}" diff --git a/R/interrogate.R b/R/interrogate.R index 0a97cebdd..0e1e45688 100644 --- a/R/interrogate.R +++ b/R/interrogate.R @@ -2941,7 +2941,7 @@ pointblank_try_catch <- function(expr) { call <- rlang::enexpr(expr) call_fn <- if (rlang::is_call_simple(call)) { - deparse(call[[1]]) # ex: "tbl_call_exists" + deparse(call[[1]]) # ex: "tbl_val_comparison" } else { "" } diff --git a/man/create_agent.Rd b/man/create_agent.Rd index e9462d034..560fd6ecb 100644 --- a/man/create_agent.Rd +++ b/man/create_agent.Rd @@ -412,7 +412,7 @@ to actually perform the validations and gather intel. \if{html}{\out{
}}\preformatted{agent <- agent \%>\% - col_exists(columns = date, date_time) \%>\% + col_exists(columns = c(date, date_time)) \%>\% col_vals_regex( columns = b, regex = "[0-9]-[a-z]\{3\}-[0-9]\{3\}" From 537c388aa7a6e21bbff92e57d6c026f3e3aed2db Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Wed, 11 Sep 2024 13:15:52 -0400 Subject: [PATCH 4/6] lintr --- R/interrogate.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/interrogate.R b/R/interrogate.R index 0e1e45688..03a15e4e6 100644 --- a/R/interrogate.R +++ b/R/interrogate.R @@ -2958,7 +2958,8 @@ pointblank_try_catch <- function(expr) { invokeRestart("muffleWarning") }) - eval_list <- list(value = value, warning = warn, error = err, pb_call = call_fn) + eval_list <- list(value = value, warning = warn, error = err, + pb_call = call_fn) class(eval_list) <- "table_eval" eval_list From 568976171ff9ad6733f66fcae36de75500e4c4b3 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Wed, 11 Sep 2024 22:17:03 -0400 Subject: [PATCH 5/6] manual test for agent serialization size --- .../tests_agent_serialization_size.R | 30 +++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 tests/manual_tests/tests_agent_serialization_size.R diff --git a/tests/manual_tests/tests_agent_serialization_size.R b/tests/manual_tests/tests_agent_serialization_size.R new file mode 100644 index 000000000..24b51d94c --- /dev/null +++ b/tests/manual_tests/tests_agent_serialization_size.R @@ -0,0 +1,30 @@ +# Setup +library(pointblank) +agent <- create_agent(data.frame(x = 1)) |> + col_vals_equal(x, 1) |> + interrogate() +show_size <- function(x) { + size <- if (is.character(x) && file.exists(x)) file.size(x) else object.size(x) + scales::label_bytes()(as.integer(size)) +} + +# Assign something large to env +largeobj <- replicate(100, mtcars[sample(nrow(mtcars), 1e4, replace = TRUE),]) +show_size(largeobj) + +# Serialize +f <- tempfile(fileext = ".rds") +saveRDS(agent, f) + +# Should be equivalent +stopifnot(identical(agent, readRDS(f))) + +# File size check +show_size(agent) +show_size(f) + +# Should be uninfluenced by size of objects in env +stopifnot(file.size(f) < as.integer(object.size(largeobj))) + +# Cleanup +file.remove(f) From ca668cd210e0c89eea852ad49436f337aa04c753 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Wed, 11 Sep 2024 22:18:25 -0400 Subject: [PATCH 6/6] standardize file names --- tests/manual_tests/test-quarto-render.R | 16 ---------------- tests/manual_tests/test_quarto_render.R | 16 ++++++++++++++++ ...-quarto-render.qmd => test_quarto_render.qmd} | 0 3 files changed, 16 insertions(+), 16 deletions(-) delete mode 100644 tests/manual_tests/test-quarto-render.R create mode 100644 tests/manual_tests/test_quarto_render.R rename tests/manual_tests/{test-quarto-render.qmd => test_quarto_render.qmd} (100%) diff --git a/tests/manual_tests/test-quarto-render.R b/tests/manual_tests/test-quarto-render.R deleted file mode 100644 index 936c1cea4..000000000 --- a/tests/manual_tests/test-quarto-render.R +++ /dev/null @@ -1,16 +0,0 @@ -# Ensure that rendering reports in Quarto do not produce `data-qmd` attributes -# since the reports are not *data* tables - -quarto::quarto_render("tests/manual_tests/test-quarto-render.qmd") -stopifnot(file.exists("tests/manual_tests/test-quarto-render.html")) -utils::browseURL("tests/manual_tests/test-quarto-render.html") - -test_qmd <- xml2::read_html("tests/manual_tests/test-quarto-render.html") - -data_qmd_divs <- xml2::xml_find_all(test_qmd, "//div[@data-qmd]") -data_qmd_divs - -stopifnot(length(data_qmd_divs) == 0) - -unlink("tests/manual_tests/test-quarto-render.html") -unlink("tests/manual_tests/test-quarto-render_files/*", recursive = TRUE) \ No newline at end of file diff --git a/tests/manual_tests/test_quarto_render.R b/tests/manual_tests/test_quarto_render.R new file mode 100644 index 000000000..231d4560a --- /dev/null +++ b/tests/manual_tests/test_quarto_render.R @@ -0,0 +1,16 @@ +# Ensure that rendering reports in Quarto do not produce `data-qmd` attributes +# since the reports are not *data* tables + +quarto::quarto_render("tests/manual_tests/test_quarto_render.qmd") +stopifnot(file.exists("tests/manual_tests/test_quarto_render.html")) +utils::browseURL("tests/manual_tests/test_quarto_render.html") + +test_qmd <- xml2::read_html("tests/manual_tests/test_quarto_render.html") + +data_qmd_divs <- xml2::xml_find_all(test_qmd, "//div[@data-qmd]") +data_qmd_divs + +stopifnot(length(data_qmd_divs) == 0) + +unlink("tests/manual_tests/test_quarto_render.html") +unlink("tests/manual_tests/test_quarto_render_files/*", recursive = TRUE) diff --git a/tests/manual_tests/test-quarto-render.qmd b/tests/manual_tests/test_quarto_render.qmd similarity index 100% rename from tests/manual_tests/test-quarto-render.qmd rename to tests/manual_tests/test_quarto_render.qmd