Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Adds warning on reserved datanames ("all") #1416

Merged
merged 10 commits into from
Nov 18, 2024
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@
* Possibility to download lockfile to restore app session for reproducibility. #479
* Introduced a function `set_datanames()` to change a `datanames` of the `teal_module`.
* Datasets which name starts with `.` are ignored when `module`'s `datanames` is set as `"all"`.
* Added warning when reserved `datanames`, such as `all` and `.raw_data` are being used.

### Breaking changes

Expand Down
79 changes: 65 additions & 14 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -134,31 +134,58 @@ check_modules_datanames <- function(modules, datanames) {
}

#' @rdname check_modules_datanames
check_modules_datanames_html <- function(modules,
datanames) {
check_reserved_datanames <- function(datanames) {
reserved_datanames <- datanames[datanames %in% c("all", ".raw_data")]
if (length(reserved_datanames) == 0L) {
return(NULL)
}

tags$span(
to_html_code_list(reserved_datanames),
sprintf(
"%s reserved for internal use. Please avoid using %s as %s.",
pluralize(reserved_datanames, "is", "are"),
pluralize(reserved_datanames, "it", "them"),
pluralize(reserved_datanames, "a dataset name", "dataset names")
)
)
}

#' @rdname check_modules_datanames
check_modules_datanames_html <- function(modules, datanames) {
check_datanames <- check_modules_datanames_recursive(modules, datanames)
show_module_info <- inherits(modules, "teal_modules") # used in two contexts - module and app

reserved_datanames <- check_reserved_datanames(datanames)

if (!length(check_datanames)) {
return(TRUE)
out <- if (is.null(reserved_datanames)) {
TRUE
} else {
shiny::tagList(reserved_datanames)
}
return(out)
llrs-roche marked this conversation as resolved.
Show resolved Hide resolved
}
shiny::tagList(
reserved_datanames,
lapply(
check_datanames,
function(mod) {
tagList(
tags$span(
tags$span(if (length(mod$missing_datanames) == 1) "Dataset" else "Datasets"),
tags$span(pluralize(mod$missing_datanames, "Dataset")),
to_html_code_list(mod$missing_datanames),
tags$span(
paste0(
if (length(mod$missing_datanames) > 1) "are missing" else "is missing",
if (show_module_info) sprintf(" for module '%s'.", mod$label) else "."
sprintf(
"%s missing%s.",
pluralize(mod$missing_datanames, "is", "are"),
if (show_module_info) sprintf(" for module '%s'", mod$label) else ""
)
)
),
if (length(datanames) >= 1) {
tagList(
tags$span(if (length(datanames) == 1) "Dataset" else "Datasets"),
tags$span(pluralize(datanames, "Dataset")),
tags$span("available in data:"),
tagList(
tags$span(
Expand Down Expand Up @@ -382,7 +409,7 @@ paste_datanames_character <- function(x,
tagList(
tags$code(x[.ix]),
if (.ix != length(x)) {
tags$span(ifelse(.ix == length(x) - 1, " and ", ", "))
tags$span(if (.ix == length(x) - 1) " and " else ", ")
}
)
})
Expand All @@ -400,17 +427,18 @@ build_datanames_error_message <- function(label = NULL,
tags = list(span = shiny::tags$span, code = shiny::tags$code),
tagList = shiny::tagList) { # nolint: object_name.
tags$span(
tags$span(ifelse(length(extra_datanames) > 1, "Datasets", "Dataset")),
tags$span(pluralize(extra_datanames, "Dataset")),
paste_datanames_character(extra_datanames, tags, tagList),
tags$span(
paste0(
ifelse(length(extra_datanames) > 1, "are missing", "is missing"),
ifelse(is.null(label), ".", sprintf(" for tab '%s'.", label))
sprintf(
"%s missing%s",
pluralize(extra_datanames, "is", "are"),
if (is.null(label)) "" else sprintf(" for tab '%s'", label)
)
),
if (length(datanames) >= 1) {
tagList(
tags$span(ifelse(length(datanames) > 1, "Datasets", "Dataset")),
tags$span(pluralize(datanames, "Dataset")),
tags$span("available in data:"),
tagList(
tags$span(
Expand Down Expand Up @@ -445,3 +473,26 @@ build_datanames_error_message <- function(label = NULL,
}
)
}

#' Pluralize a word depending on the size of the input
#'
#' @param x (`object`) to check length for plural.
#' @param singular (`character`) singular form of the word.
#' @param plural (optional `character`) plural form of the word. If not given an "s"
#' is added to the singular form.
#'
#' @return A `character` that correctly represents the size of the `x` argument.
#' @keywords internal
pluralize <- function(x, singular, plural = NULL) {
llrs-roche marked this conversation as resolved.
Show resolved Hide resolved
checkmate::assert_string(singular)
checkmate::assert_string(plural, null.ok = TRUE)
if (length(x) == 1L) { # Zero length object should use plural form.
singular
} else {
if (is.null(plural)) {
sprintf("%ss", singular)
} else {
plural
}
}
}
3 changes: 3 additions & 0 deletions man/check_modules_datanames.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

23 changes: 23 additions & 0 deletions man/pluralize.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

27 changes: 27 additions & 0 deletions tests/testthat/test-init.R
Original file line number Diff line number Diff line change
Expand Up @@ -108,6 +108,33 @@ testthat::test_that(
}
)

testthat::describe("init throws warning when datanames in modules has reserved name", {
testthat::it("`all`", {
testthat::expect_warning(
init(
data = teal.data::teal_data(all = mtcars),
modules = list(example_module())
),
"`all` is reserved for internal use\\. Please avoid using it as a dataset name\\."
)
})

testthat::it("`.raw_data` and `all`", {
td <-
testthat::expect_warning(
init(
data = teal.data::teal_data(
all = mtcars,
.raw_data = iris,
join_keys = teal.data::join_keys(teal.data::join_key(".raw_data", "all", "a_key"))
),
modules = list(example_module())
),
"`.raw_data` and `all` are reserved for internal use\\. Please avoid using them as dataset names\\."
)
})
})

testthat::test_that("init throws when dataname in filter incompatible w/ datanames in data", {
testthat::expect_warning(
init(
Expand Down
72 changes: 72 additions & 0 deletions tests/testthat/test-module_teal.R
Original file line number Diff line number Diff line change
Expand Up @@ -545,6 +545,78 @@ testthat::describe("srv_teal teal_modules", {
)
})

testthat::describe("reserved dataname is being used:", {
testthat::it("multiple datanames with `all` and `.raw_data`", {
testthat::skip_if_not_installed("rvest")

# Shared common code for tests
td <- within(teal.data::teal_data(), {
all <- mtcars
iris <- iris
.raw_data <- data.frame(
Species = c("Setosa", "Virginica", "Versicolor"),
New.Column = c("Setosas are cool", "Virginicas are also cool", "Versicolors are cool too")
)
})
teal.data::join_keys(td) <- teal.data::join_keys(join_key(".raw_data", "iris", "Species"))

shiny::testServer(
app = srv_teal,
args = list(
id = "test",
data = td,
modules = modules(module("module_1", server = function(id, data) data))
),
expr = {
session$setInputs("teal_modules-active_tab" = "module_1")
testthat::expect_equal(
trimws(
rvest::html_text2(
rvest::read_html(
output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html
)
)
),
"all and .raw_data are reserved for internal use. Please avoid using them as dataset names."
)
}
)
})

testthat::it("single dataname with `all`", {
testthat::skip_if_not_installed("rvest")

td <- within(teal.data::teal_data(), {
all <- mtcars
iris <- iris
})

shiny::testServer(
app = srv_teal,
args = list(
id = "test",
data = td,
modules = modules(
module("module_1", server = function(id, data) data)
)
),
expr = {
session$setInputs("teal_modules-active_tab" = "module_1")
testthat::expect_equal(
trimws(
rvest::html_text2(
rvest::read_html(
output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html
)
)
),
"all is reserved for internal use. Please avoid using it as a dataset name."
)
}
)
})
})

testthat::describe("warnings on missing datanames", {
testthat::it("warns when dataname is not available", {
testthat::skip_if_not_installed("rvest")
Expand Down
Loading