Merge pull request #89 from Appsilon/fix/remove-head-error-table

Fix: remove head error table

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: data.validator
 Type: Package
 Title: Automatic Data Validation and Reporting
-Version: 0.2.0.9002
+Version: 0.2.0.9003
 Authors@R: c(person("Marcin", "Dubel", email = "opensource+marcin@appsilon.com", role = c("aut", "cre")),
              person("Paweł", "Przytuła", email = "pawel@appsilon.com", role = c("aut")),
              person("Jakub", "Nowicki", email = "kuba@appsilon.com", role = c("aut")),

NEWS.md

@@ -3,6 +3,7 @@
 - Swapping of `error` and `warning` arguments in `save_summary()` fixed
 - Fixed `validate()` function to correctly return `data-name` attribute when used in pipe chains with `%>%` or `|>` operator.
 - `save_results()` now uses function passed to `method` argument to write results
+- Enable the option to change the size of the sample of errors displayed in `render_semantic_report_ui`.
 
 # data.validator 0.2.0
 

R/report.R

@@ -174,6 +174,7 @@ save_results <- function(report, file_name = "results.csv", method = utils::writ
 #'   \code{data.validator} rmarkdown template to see basic construction - the one is used as a
 #'   default template.
 #' @param ... Additional parameters passed to \code{ui_constructor}.
+#' For example: \code{df_error_head_n}
 #' @export
 save_report <- function(report,
                         output_file = "validation_report.html",

R/semantic_report_constructors.R

@@ -16,9 +16,10 @@ segment <- function(title, ...) {
 #' Prepare modal content.
 #' @description Prepare modal content.
 #' @param error Assertr error.
+#' @param df_error_head_n Number of rows to display in error table.
 #' @return Modal content.
 #' @keywords internal
-prepare_modal_content <- function(error) {
+prepare_modal_content <- function(error, df_error_head_n) {
   data_part <- NULL #nolint: object_usage_linter
   errors_number <- seq_along(error$error_df[[1]])
   purrr::map(errors_number, ~ {
@@ -28,7 +29,7 @@ prepare_modal_content <- function(error) {
         htmltools::div(class = "ui header", "Violated data (sample)"),
         htmltools::HTML(
           knitr::kable(
-            utils::head(error$error_df[[1]][[.x]]),
+            utils::head(error$error_df[[1]][[.x]], n = df_error_head_n),
             "html",
             align = NULL,
             table.attr = "class=\"ui cellable table\""
@@ -66,11 +67,12 @@ prepare_modal_content <- function(error) {
 #' @param results Results to display in a row.
 #' @param type Result type.
 #' @param mark Icon to display.
+#' @param df_error_head_n Number of rows to display in error table.
 #' @return Table row.
 #' @importFrom dplyr %>%
 #' @importFrom rlang .data
 #' @keywords internal
-make_table_row <- function(results, type, mark) {
+make_table_row <- function(results, type, mark, df_error_head_n) {
   description <- results %>% dplyr::pull(.data$description)
   id <- results %>% dplyr::pull(.data$assertion.id)
   data_name <- results %>% dplyr::pull(.data$table_name)
@@ -92,7 +94,7 @@ make_table_row <- function(results, type, mark) {
         htmltools::div(
           class = "description",
           htmltools::tagList(
-            prepare_modal_content(results)
+            prepare_modal_content(results, df_error_head_n)
           )
         )
       )
@@ -123,9 +125,10 @@ make_table_row <- function(results, type, mark) {
 #' @param results Result to display in table.
 #' @param type Result type.
 #' @param mark Icon to display.
+#' @param df_error_head_n Number of rows to display in error table.
 #' @return Table row.
 #' @keywords internal
-result_table <- function(results, type, mark) {
+result_table <- function(results, type, mark, df_error_head_n) {
   if (nrow(results) == 0) {
     "No cases to display."
   } else {
@@ -147,7 +150,15 @@ result_table <- function(results, type, mark) {
         )
       ),
       htmltools::tags$tbody(
-        purrr::map(1:nrow(results), ~ make_table_row(results[.x, ], type, mark)) #nolint: seq_linter
+        purrr::map(
+          seq_len(nrow(results)),
+          ~ make_table_row(
+            results[.x, ],
+            type,
+            mark,
+            df_error_head_n = df_error_head_n
+          )
+        )
       )
     )
   }
@@ -173,9 +184,18 @@ make_accordion_container <- function(...) {
 #' @param color Color of the label icon.
 #' @param type Result type.
 #' @param active Is active?
+#' @param df_error_head_n Number of rows to display in error table.
 #' @return Accordion.
 #' @keywords internal
-make_accordion_element <- function(results, color = "green", label, active = FALSE, type, mark) {
+make_accordion_element <- function(
+  results,
+  color = "green",
+  label,
+  active = FALSE,
+  type,
+  mark,
+  df_error_head_n
+) {
   state <- NULL
   if (active) {
     state <- "active"
@@ -192,7 +212,10 @@ make_accordion_element <- function(results, color = "green", label, active = FAL
         label
       )
     ),
-    htmltools::div(class = paste("content", state), result_table(results, type, mark))
+    htmltools::div(
+      class = paste("content", state),
+      result_table(results, type, mark, df_error_head_n)
+    )
   )
 }
 
@@ -202,9 +225,10 @@ make_accordion_element <- function(results, color = "green", label, active = FAL
 #' @param n_passes Number of successful assertions.
 #' @param n_fails Number of warning assertions.
 #' @param n_warns Number of violation assertions.
+#' @param df_error_head_n Number of rows to display in error table.
 #' @return Validation report.
 #' @keywords internal
-display_results <- function(data, n_passes, n_fails, n_warns) {
+display_results <- function(data, n_passes, n_fails, n_warns, df_error_head_n) {
   data_name <- data$table_name[1]
   results_failed <- data %>%
     dplyr::filter(.data$type == error_id)
@@ -235,7 +259,8 @@ display_results <- function(data, n_passes, n_fails, n_warns) {
           label = "Failed",
           mark = "red big remove",
           type = error_id,
-          active = is_negative_active
+          active = is_negative_active,
+          df_error_head_n = df_error_head_n
         ),
       if (!is.null(n_warns))
         make_accordion_element(
@@ -317,15 +342,22 @@ make_summary_table <- function(n_passes, n_fails, n_warns) {
 #' @param n_fails Number of failed validations.
 #' @param n_warns Number of warnings.
 #' @param validation_results Data frame with validation results.
+#' @param df_error_head_n Number of rows to display in error table.
 #' @return HTML validation report.
 #' @keywords internal
-get_semantic_report_ui <- function(n_passes, n_fails, n_warns, validation_results) {
+get_semantic_report_ui <- function(
+  n_passes,
+  n_fails,
+  n_warns,
+  validation_results,
+  df_error_head_n
+) {
   summary_table <- make_summary_table(n_passes, n_fails, n_warns)
   unique_objects <- validation_results %>% dplyr::pull(.data$table_name) %>% unique()
   html_report <- unique_objects %>% purrr::map(~ {
     validation_results %>%
       dplyr::filter(.data$table_name == .x) %>%
-      display_results(n_passes, n_fails, n_warns)
+      display_results(n_passes, n_fails, n_warns, df_error_head_n)
   }) %>%
     htmltools::div()
 
@@ -351,11 +383,14 @@ post_render_js <- "
 #' @param success Should success results be presented?
 #' @param warning Should warning results be presented?
 #' @param error Should error results be presented?
+#' @param df_error_head_n Number of rows to display in error table.
+#' Works in the same way as \code{head} function.
 #' @export
 render_semantic_report_ui <- function(validation_results,
                                       success = TRUE,
                                       warning = TRUE,
-                                      error = TRUE) {
+                                      error = TRUE,
+                                      df_error_head_n = 6L) {
   n_passes <- NULL
   n_fails <- NULL
   n_warns <- NULL
@@ -372,7 +407,8 @@ render_semantic_report_ui <- function(validation_results,
     n_passes,
     n_fails,
     n_warns,
-    validation_results
+    validation_results,
+    df_error_head_n
   ) %>%
     shiny.semantic::uirender(width = "100%", height = "100%") %>%
     htmlwidgets::onRender(post_render_js)

tests/testthat/test-report_constructors.R

@@ -81,7 +81,7 @@ test_that("make_accordion_container() generates ui with 'ui styled accordion' cl
 
 test_that("prepare_modal_content() includes results' error message", {
   results  <- results_test()
-  ui <- prepare_modal_content(results)
+  ui <- prepare_modal_content(results, df_error_head_n = 6L)
 
   tagq <- tagQuery(ui)
   tags <- tagq$find("td")$selectedTags()
@@ -93,7 +93,7 @@ test_that("make_table_row() creates a table row tag", {
   results_passed <- results_test() %>%
     dplyr::filter(.data$type == success_id)
 
-  ui <- make_table_row(results_passed, mark = mark_success, type = success_id)
+  ui <- make_table_row(results_passed, mark = mark_success, type = success_id, df_error_head_n = 6L)
   ui <- as.character(ui)
 
   expect_true(startsWith(ui, "<tr>"))
@@ -104,7 +104,7 @@ test_that("make_table_row() generates modal content for results with failed vali
   results_failed <- results_test() %>%
     dplyr::filter(.data$type == error_id)
 
-  ui <- make_table_row(results_failed, mark = mark_failed, type = error_id)
+  ui <- make_table_row(results_failed, mark = mark_failed, type = error_id, df_error_head_n = 6L)
 
   tagq <- tagQuery(ui)
   tags <- tagq$
@@ -119,7 +119,7 @@ test_that("make_table_row() generates modal content for results with failed vali
     gsub("\\s", "", .)
 
 
-  modal <- prepare_modal_content(results_failed) %>%
+  modal <- prepare_modal_content(results_failed, df_error_head_n = 6L) %>%
     as.character() %>%
     gsub("\\s", "", .)