improve covr tests

.covrignore

@@ -0,0 +1,4 @@
+R/module_teal_with_splash.R
+R/tdata.R
+R/landing_popup_module.R
+R/show_rcode_modal.R

DESCRIPTION

@@ -117,11 +117,11 @@ Collate:
     'module_snapshot_manager.R'
     'module_source_code.R'
     'module_teal.R'
-    'module_teal_data.R'
     'module_teal_lockfile.R'
     'module_teal_reporter.R'
     'module_teal_with_splash.R'
     'module_transform_data.R'
+    'module_validate_error.R'
     'reporter_previewer_module.R'
     'show_rcode_modal.R'
     'tdata.R'

R/module_bookmark_manager.R

@@ -189,128 +189,17 @@ need_bookmarking <- function(modules) {
 #' @keywords internal
 #'
 restoreValue <- function(value, default) { # nolint: object_name.
-  checkmate::assert_character("value")
+  checkmate::assert_character(value)
   session_default <- shiny::getDefaultReactiveDomain()
   session_parent <- .subset2(session_default, "parent")
   session <- if (is.null(session_parent)) session_default else session_parent
-
   if (isTRUE(session$restoreContext$active) && exists(value, session$restoreContext$values, inherits = FALSE)) {
     session$restoreContext$values[[value]]
   } else {
     default
   }
 }
 
-#' Compare bookmarks.
-#'
-#' Test if two bookmarks store identical state.
-#'
-#' `input` environments are compared one variable at a time and if not identical,
-#' values in both bookmarks are reported. States of `datatable`s are stripped
-#' of the `time` element before comparing because the time stamp is always different.
-#' The contents themselves are not printed as they are large and the contents are not informative.
-#' Elements present in one bookmark and absent in the other are also reported.
-#' Differences are printed as messages.
-#'
-#' `values` environments are compared with `all.equal`.
-#'
-#' @section How to use:
-#' Open an application, change relevant inputs (typically, all of them), and create a bookmark.
-#' Then open that bookmark and immediately create a bookmark of that.
-#' If restoring bookmarks occurred properly, the two bookmarks should store the same state.
-#'
-#'
-#' @param book1,book2 bookmark directories stored in `shiny_bookmarks/`;
-#'                    default to the two most recently modified directories
-#'
-#' @return
-#' Invisible `NULL` if bookmarks are identical or if there are no bookmarks to test.
-#' `FALSE` if inconsistencies are detected.
-#'
-#' @keywords internal
-#'
-bookmarks_identical <- function(book1, book2) {
-  if (!dir.exists("shiny_bookmarks")) {
-    message("no bookmark directory")
-    return(invisible(NULL))
-  }
-
-  ans <- TRUE
-
-  if (missing(book1) && missing(book2)) {
-    dirs <- list.dirs("shiny_bookmarks", recursive = FALSE)
-    bookmarks_sorted <- basename(rev(dirs[order(file.mtime(dirs))]))
-    if (length(bookmarks_sorted) < 2L) {
-      message("no bookmarks to compare")
-      return(invisible(NULL))
-    }
-    book1 <- bookmarks_sorted[2L]
-    book2 <- bookmarks_sorted[1L]
-  } else {
-    if (!dir.exists(file.path("shiny_bookmarks", book1))) stop(book1, " not found")
-    if (!dir.exists(file.path("shiny_bookmarks", book2))) stop(book2, " not found")
-  }
-
-  book1_input <- readRDS(file.path("shiny_bookmarks", book1, "input.rds"))
-  book2_input <- readRDS(file.path("shiny_bookmarks", book2, "input.rds"))
-
-  elements_common <- intersect(names(book1_input), names(book2_input))
-  dt_states <- grepl("_state$", elements_common)
-  if (any(dt_states)) {
-    for (el in elements_common[dt_states]) {
-      book1_input[[el]][["time"]] <- NULL
-      book2_input[[el]][["time"]] <- NULL
-    }
-  }
-
-  identicals <- mapply(identical, book1_input[elements_common], book2_input[elements_common])
-  non_identicals <- names(identicals[!identicals])
-  compares <- sprintf("$ %s:\t%s --- %s", non_identicals, book1_input[non_identicals], book2_input[non_identicals])
-  if (length(compares) != 0L) {
-    message("common elements not identical: \n", paste(compares, collapse = "\n"))
-    ans <- FALSE
-  }
-
-  elements_boook1 <- setdiff(names(book1_input), names(book2_input))
-  if (length(elements_boook1) != 0L) {
-    dt_states <- grepl("_state$", elements_boook1)
-    if (any(dt_states)) {
-      for (el in elements_boook1[dt_states]) {
-        if (is.list(book1_input[[el]])) book1_input[[el]] <- "--- data table state ---"
-      }
-    }
-    excess1 <- sprintf("$ %s:\t%s", elements_boook1, book1_input[elements_boook1])
-    message("elements only in book1: \n", paste(excess1, collapse = "\n"))
-    ans <- FALSE
-  }
-
-  elements_boook2 <- setdiff(names(book2_input), names(book1_input))
-  if (length(elements_boook2) != 0L) {
-    dt_states <- grepl("_state$", elements_boook1)
-    if (any(dt_states)) {
-      for (el in elements_boook1[dt_states]) {
-        if (is.list(book2_input[[el]])) book2_input[[el]] <- "--- data table state ---"
-      }
-    }
-    excess2 <- sprintf("$ %s:\t%s", elements_boook2, book2_input[elements_boook2])
-    message("elements only in book2: \n", paste(excess2, collapse = "\n"))
-    ans <- FALSE
-  }
-
-  book1_values <- readRDS(file.path("shiny_bookmarks", book1, "values.rds"))
-  book2_values <- readRDS(file.path("shiny_bookmarks", book2, "values.rds"))
-
-  if (!isTRUE(all.equal(book1_values, book2_values))) {
-    message("different values detected")
-    message("choices for numeric filters MAY be different, see RangeFilterState$set_choices")
-    ans <- FALSE
-  }
-
-  if (ans) message("perfect!")
-  invisible(NULL)
-}
-
-
 # Replacement for [base::rapply] which doesn't handle NULL values - skips the evaluation
 # of the function and returns NULL for given element.
 rapply2 <- function(x, f) {

R/module_filter_manager.R

@@ -286,32 +286,6 @@ methods::setOldClass("reactivevalues")
         invisible(.self)
       })
     },
-    slices_deactivate_all = function(module_label) {
-      shiny::isolate({
-        new_slices <- .self$all_slices()
-        old_mapping <- attr(new_slices, "mapping")
-
-        new_mapping <- if (.self$is_module_specific()) {
-          new_module_mapping <- setNames(nm = module_label, list(character(0)))
-          modifyList(old_mapping, new_module_mapping)
-        } else if (missing(module_label)) {
-          lapply(
-            attr(.self$all_slices(), "mapping"),
-            function(x) character(0)
-          )
-        } else {
-          old_mapping[[module_label]] <- character(0)
-          old_mapping
-        }
-
-        if (!identical(new_mapping, old_mapping)) {
-          logger::log_debug(".slicesGlobal@slices_deactivate_all: deactivating all slices.")
-          attr(new_slices, "mapping") <- new_mapping
-          .self$all_slices(new_slices)
-        }
-        invisible(.self)
-      })
-    },
     slices_active = function(mapping_elem) {
       shiny::isolate({
         if (.self$is_module_specific()) {

R/module_init_data.R

@@ -20,7 +20,6 @@
 #' lies in data control: the first method involves external control, while the second method
 #' involves control from a custom module within the app.
 #'
-#' For more details, see [`module_teal_data`].
 #'
 #' @inheritParams module_teal
 #'

R/module_snapshot_manager.R

@@ -111,7 +111,8 @@ srv_snapshot_manager_panel <- function(id, slices_global) {
         )
       )
     })
-    srv_snapshot_manager("module", slices_global = slices_global)
+    snapshot_history <- srv_snapshot_manager("module", slices_global = slices_global)
+    snapshot_history
   })
 }
 

R/module_transform_data.R

@@ -3,10 +3,12 @@
 #' Module calls [teal_transform_module()] in sequence so that `reactive teal_data` output
 #' from one module is handed over to the following module's input.
 #'
-#' @inheritParams module_teal_data
+#' @inheritParams module_validate_error
 #' @inheritParams teal_modules
 #' @param class (character(1)) CSS class to be added in the `div` wrapper tag.
-
+#' @param is_transform_failed (`reactiveValues`) contains `logical` flags named after each transformator.
+#' Help to determine if any previous transformator failed, so that following transformators can be disabled
+#' and display a generic failure message.
 #' @return `reactive` `teal_data`
 #'
 #' @name module_transform_data

R/module_teal_data.R → R/module_validate_error.R

@@ -21,140 +21,24 @@
 #' (except error 1).
 #'
 #' @inheritParams module_teal
-#' @param data_module (`teal_data_module`)
 #' @param modules (`teal_modules` or `teal_module`) For `datanames` validation purpose
 #' @param validate_shiny_silent_error (`logical`) If `TRUE`, then `shiny.silent.error` is validated and
-#' @param is_transform_failed (`reactiveValues`) contains `logical` flags named after each transformator.
-#' Help to determine if any previous transformator failed, so that following transformators can be disabled
-#' and display a generic failure message.
 #'
 #' @return `reactive` `teal_data`
 #'
-#' @rdname module_teal_data
-#' @name module_teal_data
+#' @rdname module_validate_error
+#' @name module_validate_error
 #' @keywords internal
 NULL
 
-#' @rdname module_teal_data
-#' @aliases ui_teal_data
-#' @note
-#' `ui_teal_data_module` was renamed from `ui_teal_data`.
-ui_teal_data_module <- function(id, data_module = function(id) NULL) {
-  checkmate::assert_string(id)
-  checkmate::assert_function(data_module, args = "id")
-  ns <- NS(id)
-
-  shiny::tagList(
-    tags$div(id = ns("wrapper"), data_module(id = ns("data"))),
-    ui_validate_reactive_teal_data(ns("validate"))
-  )
-}
-
-#' @rdname module_teal_data
-#' @aliases srv_teal_data
-#' @note
-#' `srv_teal_data_module` was renamed from `srv_teal_data`.
-srv_teal_data_module <- function(id,
-                                 data_module = function(id) NULL,
-                                 modules = NULL,
-                                 validate_shiny_silent_error = TRUE,
-                                 is_transform_failed = reactiveValues()) {
-  checkmate::assert_string(id)
-  checkmate::assert_function(data_module, args = "id")
-  checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"), null.ok = TRUE)
-  checkmate::assert_class(is_transform_failed, "reactivevalues")
-
-  moduleServer(id, function(input, output, session) {
-    logger::log_debug("srv_teal_data_module initializing.")
-    is_transform_failed[[id]] <- FALSE
-    module_out <- data_module(id = "data")
-    try_module_out <- reactive(tryCatch(module_out(), error = function(e) e))
-    observeEvent(try_module_out(), {
-      if (!inherits(try_module_out(), "teal_data")) {
-        is_transform_failed[[id]] <- TRUE
-      } else {
-        is_transform_failed[[id]] <- FALSE
-      }
-    })
-
-    is_previous_failed <- reactive({
-      idx_this <- which(names(is_transform_failed) == id)
-      is_transform_failed_list <- reactiveValuesToList(is_transform_failed)
-      idx_failures <- which(unlist(is_transform_failed_list))
-      any(idx_failures < idx_this)
-    })
-
-    observeEvent(is_previous_failed(), {
-      if (is_previous_failed()) {
-        shinyjs::disable("wrapper")
-      } else {
-        shinyjs::enable("wrapper")
-      }
-    })
-
-    srv_validate_reactive_teal_data(
-      "validate",
-      data = try_module_out,
-      modules = modules,
-      validate_shiny_silent_error = validate_shiny_silent_error,
-      hide_validation_error = is_previous_failed
-    )
-  })
-}
-
-#' @rdname module_teal_data
-ui_validate_reactive_teal_data <- function(id) {
-  ns <- NS(id)
-  tags$div(
-    div(
-      id = ns("validate_messages"),
-      class = "teal_validated",
-      ui_validate_error(ns("silent_error")),
-      ui_check_class_teal_data(ns("class_teal_data")),
-      ui_check_module_datanames(ns("shiny_warnings"))
-    ),
-    div(
-      class = "teal_validated",
-      uiOutput(ns("previous_failed"))
-    )
-  )
-}
-
-#' @rdname module_teal_data
-srv_validate_reactive_teal_data <- function(id, # nolint: object_length
-                                            data,
-                                            modules = NULL,
-                                            validate_shiny_silent_error = FALSE,
-                                            hide_validation_error = reactive(FALSE)) {
-  checkmate::assert_string(id)
-  checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"), null.ok = TRUE)
-  checkmate::assert_flag(validate_shiny_silent_error)
-
-  moduleServer(id, function(input, output, session) {
-    # there is an empty reactive cycle on `init` and `data` has `shiny.silent.error` class
-    srv_validate_error("silent_error", data, validate_shiny_silent_error)
-    srv_check_class_teal_data("class_teal_data", data)
-    srv_check_module_datanames("shiny_warnings", data, modules)
-    output$previous_failed <- renderUI({
-      if (hide_validation_error()) {
-        shinyjs::hide("validate_messages")
-        tags$div("One of previous transformators failed. Please check its inputs.", class = "teal-output-warning")
-      } else {
-        shinyjs::show("validate_messages")
-        NULL
-      }
-    })
-
-    .trigger_on_success(data)
-  })
-}
-
+#' @rdname module_validate_error
 #' @keywords internal
 ui_validate_error <- function(id) {
   ns <- NS(id)
   uiOutput(ns("message"))
 }
 
+#' @rdname module_validate_error
 #' @keywords internal
 srv_validate_error <- function(id, data, validate_shiny_silent_error) {
   checkmate::assert_string(id)
@@ -193,13 +77,14 @@ srv_validate_error <- function(id, data, validate_shiny_silent_error) {
   })
 }
 
-
+#' @rdname module_validate_error
 #' @keywords internal
 ui_check_class_teal_data <- function(id) {
   ns <- NS(id)
   uiOutput(ns("message"))
 }
 
+#' @rdname module_validate_error
 #' @keywords internal
 srv_check_class_teal_data <- function(id, data) {
   checkmate::assert_string(id)
@@ -215,12 +100,14 @@ srv_check_class_teal_data <- function(id, data) {
   })
 }
 
+#' @rdname module_validate_error
 #' @keywords internal
 ui_check_module_datanames <- function(id) {
   ns <- NS(id)
   uiOutput(NS(id, "message"))
 }
 
+#' @rdname module_validate_error
 #' @keywords internal
 srv_check_module_datanames <- function(id, data, modules) {
   checkmate::assert_string(id)