diff --git a/NEWS.md b/NEWS.md index 6a3c7ccce9..a3910fc9f1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ ### New features -* `data` argument in `init` accepts now `teal_data` and `teal_data_module`. +* `data` argument in `init` now accepts `teal_data` and `teal_data_module`. * Added `landing_popup_module` function which creates a module that will display a popup when the app starts. The popup will block access to the app until it is dismissed. * Filter state snapshots can now be uploaded from file. See `?snapshot`. diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 6d03ad65f1..608c1a3241 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -75,7 +75,6 @@ example_datasets <- function() { # nolint #' #' @description `r lifecycle::badge("experimental")` #' @inheritParams module -#' @param src (`logical(1)`) whether to display reproducible R code in the module. #' @return A `teal` module which can be included in the `modules` argument to [teal::init()]. #' @examples #' app <- init( @@ -89,7 +88,7 @@ example_datasets <- function() { # nolint #' shinyApp(app$ui, app$server) #' } #' @export -example_module <- function(label = "example teal module", datanames = "all", src = TRUE) { +example_module <- function(label = "example teal module", datanames = "all") { checkmate::assert_string(label) module( label, @@ -110,9 +109,7 @@ example_module <- function(label = "example teal module", datanames = "all", src output = verbatimTextOutput(ns("text")), encoding = div( selectInput(ns("dataname"), "Choose a dataset", choices = names(data)), - if (src) { - teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") - } + teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ) ) }, diff --git a/R/init.R b/R/init.R index 4d04adcdc9..50e4fe2c0a 100644 --- a/R/init.R +++ b/R/init.R @@ -190,6 +190,10 @@ init <- function(data, } if (inherits(data, "teal_data")) { + if (length(teal.data::datanames(data)) == 0) { + stop("`data` object has no datanames. Specify `datanames(data)` and try again.") + } + # in case of teal_data_module this check is postponed to the srv_teal_with_splash is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) if (!isTRUE(is_modules_ok)) { @@ -200,7 +204,6 @@ init <- function(data, is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) if (!isTRUE(is_filter_ok)) { logger::log_warn(is_filter_ok) - warning(is_filter_ok) # we allow app to continue if applied filters are outside # of possible data range } diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 94e747f566..03e8f5d906 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -110,7 +110,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { } if (!is.reactive(raw_data)) { - stop("The delayed loading module has to return a reactive object.") + stop("The `teal_data_module` has to return a reactive object.", call. = FALSE) } raw_data_checked <- reactive({ @@ -128,9 +128,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { need( FALSE, paste( - "Error when executing `teal_data_module`:\n", + "Error when executing `teal_data_module`:\n ", data$message, - "\n Check your inputs or contact app developer if error persist" + "\n Check your inputs or contact app developer if error persists" ) ) ) @@ -142,9 +142,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { need( FALSE, paste0( - "Error when executing `teal_data_module`:", + "Error when executing `teal_data_module`:\n ", attr(data, "condition")$message, - "\n Check your inputs or contact app developer if error persist" + "\n Check your inputs or contact app developer if error persists" ) ) ) @@ -154,19 +154,22 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { need( inherits(data, "teal_data"), paste( - "Error: `teal_data_module` didn't return `teal_data` object", - "\n Check your inputs or contact app developer if error persist" + "Error: `teal_data_module` did not return `teal_data` object", + "\n Check your inputs or contact app developer if error persists" ) ) ) + validate(need(teal.data::datanames(data), "Data has no datanames. Contact app developer")) + + is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) validate(need(isTRUE(is_modules_ok), is_modules_ok)) if (!isTRUE(is_filter_ok)) { - showNotification(is_filter_ok, type = "warning") + showNotification(is_filter_ok, type = "warning", duration = 10) logger::log_warn(is_filter_ok) } diff --git a/R/utils.R b/R/utils.R index 3b5cd9d913..7af83979f2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -160,7 +160,7 @@ check_modules_datanames <- function(modules, datanames) { extra_datanames <- setdiff(modules$datanames, c("all", datanames)) if (length(extra_datanames)) { sprintf( - "- Module '%s' uses different datanames than available in the 'data': (%s) not in (%s)", + "- Module '%s' uses datanames not available in the 'data': (%s) not in (%s)", modules$label, toString(dQuote(extra_datanames, q = FALSE)), toString(dQuote(datanames, q = FALSE)) @@ -178,7 +178,7 @@ check_modules_datanames <- function(modules, datanames) { #' Check `datanames` in filters #' -#' This function check `datanames` in filters correspond to those in `data`, +#' This function checks whether `datanames` in filters correspond to those in `data`, #' returning character vector with error messages or TRUE if all checks pass. #' #' @param filters (`teal_slices`) object @@ -188,20 +188,22 @@ check_modules_datanames <- function(modules, datanames) { #' @keywords internal check_filter_datanames <- function(filters, datanames) { # check teal_slices against datanames - out <- sapply( + out <- unlist(sapply( filters, function(filter) { dataname <- shiny::isolate(filter$dataname) if (!dataname %in% datanames) { sprintf( - "- Filter '%s' refers to dataname that in unavailable to 'data':\n %s not in (%s)", + "- Filter '%s' refers to dataname not available in 'data':\n %s not in (%s)", shiny::isolate(filter$id), dQuote(dataname, q = FALSE), toString(dQuote(datanames, q = FALSE)) ) } } - ) - if (length(unlist(out))) { + )) + + + if (length(out)) { paste(out, collapse = "\n") } else { TRUE diff --git a/man/check_filter_datanames.Rd b/man/check_filter_datanames.Rd index e4e46e8c16..2827604a27 100644 --- a/man/check_filter_datanames.Rd +++ b/man/check_filter_datanames.Rd @@ -15,7 +15,7 @@ check_filter_datanames(filters, datanames) A \code{character(1)} containing error message or TRUE if validation passes. } \description{ -This function check \code{datanames} in filters correspond to those in \code{data}, +This function checks whether \code{datanames} in filters correspond to those in \code{data}, returning character vector with error messages or TRUE if all checks pass. } \keyword{internal} diff --git a/man/example_module.Rd b/man/example_module.Rd index c2a58c3dec..9a0c88862b 100644 --- a/man/example_module.Rd +++ b/man/example_module.Rd @@ -4,7 +4,7 @@ \alias{example_module} \title{An example \code{teal} module} \usage{ -example_module(label = "example teal module", datanames = "all", src = TRUE) +example_module(label = "example teal module", datanames = "all") } \arguments{ \item{label}{(\code{character(1)}) Label shown in the navigation item for the module. Any label possible except @@ -15,8 +15,6 @@ filter panel will automatically update the shown filters to include only filters in the listed datasets. \code{NULL} will hide the filter panel, and the keyword \code{'all'} will show filters of all datasets. \code{datanames} also determines a subset of datasets which are appended to the \code{data} argument in \code{server} function.} - -\item{src}{(\code{logical(1)}) whether to display reproducible R code in the module.} } \value{ A \code{teal} module which can be included in the \code{modules} argument to \code{\link[=init]{init()}}. diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 18aac986ab..d1989650fa 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -192,20 +192,31 @@ testthat::test_that("init filter accepts `teal_slices`", { ) }) -testthat::test_that("init throws when incompatible module's datanames", { +testthat::test_that("init throws when data has no datanames", { testthat::expect_error( - init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))), - "Module 'example teal module' uses different datanames than available in the 'data'" + init(data = teal_data(), modules = list(example_module())), + "has no datanames" + ) +}) + +testthat::test_that("init throws when incompatible module's datanames", { + msg <- "Module 'example teal module' uses datanames not available in the 'data'" + testthat::expect_output( + testthat::expect_error( + init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))), + msg + ), + msg ) }) testthat::test_that("init throws when incompatible filter's datanames", { - testthat::expect_warning( + testthat::expect_output( init( data = teal_data(mtcars = mtcars), modules = modules(example_module()), filter = teal_slices(teal_slice(dataname = "iris", varname = "Species")) ), - "Filter 'iris Species' refers to dataname that in unavailable to 'data'" + "Filter 'iris Species' refers to dataname not available in 'data'" ) }) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 34868a853d..acdfff310c 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -23,7 +23,7 @@ testthat::test_that("srv_teal_with_splash throws when teal_data_module doesn't r ), expr = {} ), - "The delayed loading module has to return a reactive object." + "The `teal_data_module` has to return a reactive object." ) }) @@ -47,7 +47,7 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", { app = srv_teal_with_splash, args = list( id = "test", - data = teal_data(), + data = teal_data(iris = iris), modules = modules(example_module()) ), expr = { @@ -57,6 +57,20 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", { ) }) +testthat::test_that("srv_teal_with_splash throws when datanames are empty", { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = teal_data(), + modules = modules(example_module()) + ), + expr = { + testthat::expect_error(raw_data_checked(), "Data has no datanames") + } + ) +}) + testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data_module returns error", { shiny::testServer( app = srv_teal_with_splash, @@ -106,7 +120,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data ), expr = { testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_error(raw_data_checked(), "didn't return `teal_data`") + testthat::expect_error(raw_data_checked(), "did not return `teal_data`") } ) }) @@ -158,7 +172,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when incompati testthat::expect_is(raw_data_checked, "reactive") testthat::expect_error( raw_data_checked(), - "Module 'example teal module' uses different datanames than available in the 'data'" + "Module 'example teal module' uses datanames not available in the 'data'" ) } )