diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index cc3d83e961..3e1cc7600e 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -10,8 +10,8 @@ repos: hooks: - id: style-files name: Style code with `styler` - args: [--style_pkg=styler, --style_fun=tidyverse_style, - --cache-root=styler] + args: + [--style_pkg=styler, --style_fun=tidyverse_style, --cache-root=styler] - id: roxygenize name: Regenerate package documentation additional_dependencies: @@ -19,6 +19,7 @@ repos: - davidgohel/gdtools # for flextable - mirai - checkmate + - crayon - jsonlite - lifecycle - logger diff --git a/DESCRIPTION b/DESCRIPTION index 479b340e88..14b4b65883 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9080 -Date: 2024-11-06 +Version: 0.15.2.9081 +Date: 2024-11-07 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), @@ -41,6 +41,7 @@ Depends: teal.slice (>= 0.5.1.9009) Imports: checkmate (>= 2.1.0), + crayon, jsonlite, lifecycle (>= 0.2.0), logger (>= 0.2.0), @@ -75,7 +76,7 @@ RdMacros: lifecycle Config/Needs/verdepcheck: rstudio/shiny, insightsengineering/teal.data, insightsengineering/teal.slice, mllg/checkmate, jeroen/jsonlite, - r-lib/lifecycle, daroczig/logger, shikokuchuo/mirai, + r-lib/lifecycle, daroczig/logger, shikokuchuo/mirai, r-lib/crayon, shikokuchuo/nanonext, rstudio/renv, r-lib/rlang, daattali/shinyjs, insightsengineering/teal.code, insightsengineering/teal.logger, insightsengineering/teal.reporter, insightsengineering/teal.widgets, diff --git a/NEWS.md b/NEWS.md index 55d7d9f4ce..4ec0f426fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9080 +# teal 0.15.2.9081 ### New features diff --git a/R/modules.R b/R/modules.R index 15d2c13caa..181e47111e 100644 --- a/R/modules.R +++ b/R/modules.R @@ -322,16 +322,263 @@ modules <- function(..., label = "root") { # printing methods ---- #' @rdname teal_modules +#' @param is_last (`logical(1)`) Whether this is the last item in its parent's children list. +#' Affects the tree branch character used (L- vs |-) +#' @param parent_prefix (`character(1)`) The prefix inherited from parent nodes, +#' used to maintain the tree structure in nested levels +#' @param is_root (`logical(1)`) Whether this is the root node of the tree. Only used in +#' format.teal_modules(). Determines whether to show "TEAL ROOT" header +#' @param what (`character`) Specifies which metadata to display. +#' Possible values: "datasets", "properties", "ui_args", "server_args", "transformers" +#' @examples +#' mod <- module( +#' label = "My Custom Module", +#' server = function(id, data, ...) {}, +#' ui = function(id, ...) {}, +#' datanames = c("ADSL", "ADTTE"), +#' transformers = list(), +#' ui_args = list(a = 1, b = "b"), +#' server_args = list(x = 5, y = list(p = 1)) +#' ) +#' cat(format(mod)) #' @export -format.teal_module <- function(x, ...) { - if (is.null(list(...)$indent)) { - indent <- 0L +format.teal_module <- function( + x, indent = 0, is_last = FALSE, parent_prefix = "", + what = c("datasets", "properties", "ui_args", "server_args", "transformers"), ...) { + empty_text <- "" + branch <- if (is_last) "L-" else "|-" + current_prefix <- paste0(parent_prefix, branch, " ") + content_prefix <- paste0(parent_prefix, if (is_last) " " else "| ") + + format_list <- function(lst, empty = empty_text, label_width = 0) { + if (is.null(lst) || length(lst) == 0) { + empty + } else { + colon_space <- paste(rep(" ", label_width), collapse = "") + + first_item <- sprintf("%s (%s)", names(lst)[1], crayon::silver(class(lst[[1]])[1])) + rest_items <- if (length(lst) > 1) { + paste( + vapply( + names(lst)[-1], + function(name) { + sprintf( + "%s%s (%s)", + paste0(content_prefix, "| ", colon_space), + name, + crayon::silver(class(lst[[name]])[1]) + ) + }, + character(1) + ), + collapse = "\n" + ) + } + if (length(lst) > 1) paste0(first_item, "\n", rest_items) else first_item + } + } + + bookmarkable <- isTRUE(attr(x, "teal_bookmarkable")) + reportable <- "reporter" %in% names(formals(x$server)) + + transformers <- if (length(x$transformers) > 0) { + paste(sapply(x$transformers, function(t) attr(t, "label")), collapse = ", ") } else { - indent <- list(...)$indent + empty_text + } + + output <- pasten(current_prefix, crayon::bgWhite(x$label)) + + if ("datasets" %in% what) { + output <- paste0( + output, + content_prefix, "|- ", crayon::yellow("Datasets : "), paste(x$datanames, collapse = ", "), "\n" + ) + } + if ("properties" %in% what) { + output <- paste0( + output, + content_prefix, "|- ", crayon::blue("Properties:"), "\n", + content_prefix, "| |- ", crayon::cyan("Bookmarkable : "), bookmarkable, "\n", + content_prefix, "| L- ", crayon::cyan("Reportable : "), reportable, "\n" + ) + } + if ("ui_args" %in% what) { + ui_args_formatted <- format_list(x$ui_args, label_width = 19) + output <- paste0( + output, + content_prefix, "|- ", crayon::green("UI Arguments : "), ui_args_formatted, "\n" + ) } - paste0(paste(rep(" ", indent), collapse = ""), "+ ", x$label, "\n", collapse = "") + if ("server_args" %in% what) { + server_args_formatted <- format_list(x$server_args, label_width = 19) + output <- paste0( + output, + content_prefix, "|- ", crayon::green("Server Arguments : "), server_args_formatted, "\n" + ) + } + if ("transformers" %in% what) { + output <- paste0( + output, + content_prefix, "L- ", crayon::magenta("Transformers : "), transformers, "\n" + ) + } + + output } +#' @rdname teal_modules +#' @examples +#' custom_module <- function( +#' label = "label", ui_args = NULL, server_args = NULL, +#' datanames = "all", transformers = list(), bk = FALSE) { +#' ans <- module( +#' label, +#' server = function(id, data, ...) {}, +#' ui = function(id, ...) { +#' }, +#' datanames = datanames, +#' transformers = transformers, +#' ui_args = ui_args, +#' server_args = server_args +#' ) +#' attr(ans, "teal_bookmarkable") <- bk +#' ans +#' } +#' +#' dummy_transformer <- teal_transform_module( +#' label = "Dummy Transform", +#' ui = function(id) div("(does nothing)"), +#' server = function(id, data) { +#' moduleServer(id, function(input, output, session) data) +#' } +#' ) +#' +#' plot_transformer <- teal_transform_module( +#' label = "Plot Settings", +#' ui = function(id) div("(does nothing)"), +#' server = function(id, data) { +#' moduleServer(id, function(input, output, session) data) +#' } +#' ) +#' +#' complete_modules <- modules( +#' custom_module( +#' label = "Data Overview", +#' datanames = c("ADSL", "ADAE", "ADVS"), +#' ui_args = list( +#' view_type = "table", +#' page_size = 10, +#' filters = c("ARM", "SEX", "RACE") +#' ), +#' server_args = list( +#' cache = TRUE, +#' debounce = 1000 +#' ), +#' transformers = list(dummy_transformer), +#' bk = TRUE +#' ), +#' modules( +#' label = "Nested 1", +#' custom_module( +#' label = "Interactive Plots", +#' datanames = c("ADSL", "ADVS"), +#' ui_args = list( +#' plot_type = c("scatter", "box", "line"), +#' height = 600, +#' width = 800, +#' color_scheme = "viridis" +#' ), +#' server_args = list( +#' render_type = "svg", +#' cache_plots = TRUE +#' ), +#' transformers = list(dummy_transformer, plot_transformer), +#' bk = TRUE +#' ), +#' modules( +#' label = "Nested 2", +#' custom_module( +#' label = "Summary Statistics", +#' datanames = "ADSL", +#' ui_args = list( +#' stats = c("mean", "median", "sd", "range"), +#' grouping = c("ARM", "SEX") +#' ) +#' ), +#' modules( +#' label = "Labeled nested modules", +#' custom_module( +#' label = "Subgroup Analysis", +#' datanames = c("ADSL", "ADAE"), +#' ui_args = list( +#' subgroups = c("AGE", "SEX", "RACE"), +#' analysis_type = "stratified" +#' ), +#' bk = TRUE +#' ) +#' ), +#' modules(custom_module(label = "Subgroup Analysis in non-labled modules")) +#' ) +#' ), +#' custom_module("Non-nested module") +#' ) +#' +#' cat(format(complete_modules)) +#' cat(format(complete_modules, what = c("ui_args", "server_args", "transformers"))) +#' @export +format.teal_modules <- function(x, indent = 0, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...) { + if (is_root) { + header <- pasten(crayon::bold("TEAL ROOT")) + new_parent_prefix <- " " #' Initial indent for root level + } else { + if (!is.null(x$label)) { + branch <- if (is_last) "L-" else "|-" + header <- pasten(parent_prefix, branch, " ", crayon::bold(x$label)) + new_parent_prefix <- paste0(parent_prefix, if (is_last) " " else "| ") + } else { + header <- "" + new_parent_prefix <- parent_prefix + } + } + + if (length(x$children) > 0) { + children_output <- character(0) + n_children <- length(x$children) + + for (i in seq_along(x$children)) { + child <- x$children[[i]] + is_last_child <- (i == n_children) + + if (inherits(child, "teal_modules")) { + children_output <- c( + children_output, + format(child, + indent = indent, + is_root = FALSE, + is_last = is_last_child, + parent_prefix = new_parent_prefix, + ... + ) + ) + } else { + children_output <- c( + children_output, + format(child, + indent = indent, + is_last = is_last_child, + parent_prefix = new_parent_prefix, + ... + ) + ) + } + } + + paste0(header, paste(children_output, collapse = "")) + } else { + header + } +} #' @rdname teal_modules #' @export @@ -340,23 +587,11 @@ print.teal_module <- function(x, ...) { invisible(x) } - #' @rdname teal_modules #' @export -format.teal_modules <- function(x, ...) { - if (is.null(list(...)$indent)) { - indent <- 0L - } else { - indent <- list(...)$indent - } - - paste( - c( - paste0(rep(" ", indent), "+ ", x$label, "\n"), - unlist(lapply(x$children, format, indent = indent + 1, ...)) - ), - collapse = "" - ) +print.teal_modules <- function(x, ...) { + cat(format(x, ...)) + invisible(x) } #' @param modules (`teal_module` or `teal_modules`) @@ -392,11 +627,6 @@ set_datanames <- function(modules, datanames) { modules } -#' @rdname teal_modules -#' @export -print.teal_modules <- print.teal_module - - # utilities ---- ## subset or modify modules ---- diff --git a/R/utils.R b/R/utils.R index 345350fe0d..312d3a5f73 100644 --- a/R/utils.R +++ b/R/utils.R @@ -377,6 +377,10 @@ strip_style <- function(string) { ) } +#' @keywords internal +#' @noRd +pasten <- function(...) paste0(..., "\n") + #' Convert character list to human readable html with commas and "and" #' @noRd paste_datanames_character <- function(x, diff --git a/inst/WORDLIST b/inst/WORDLIST index 5bb4a5bf45..77ac78fdfb 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -8,6 +8,7 @@ Reproducibility TLG UI UX +args bookmarkable cloneable customizable @@ -26,4 +27,5 @@ summarization tabset themer theming +ui uncheck diff --git a/man/teal_modules.Rd b/man/teal_modules.Rd index 73fe9d90a5..84ad1544e2 100644 --- a/man/teal_modules.Rd +++ b/man/teal_modules.Rd @@ -6,10 +6,10 @@ \alias{teal_module} \alias{modules} \alias{format.teal_module} -\alias{print.teal_module} \alias{format.teal_modules} -\alias{set_datanames} +\alias{print.teal_module} \alias{print.teal_modules} +\alias{set_datanames} \title{Create \code{teal_module} and \code{teal_modules} objects} \usage{ module( @@ -26,15 +26,22 @@ module( modules(..., label = "root") -\method{format}{teal_module}(x, ...) +\method{format}{teal_module}( + x, + indent = 0, + is_last = FALSE, + parent_prefix = "", + what = c("datasets", "properties", "ui_args", "server_args", "transformers"), + ... +) + +\method{format}{teal_modules}(x, indent = 0, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...) \method{print}{teal_module}(x, ...) -\method{format}{teal_modules}(x, ...) +\method{print}{teal_modules}(x, ...) set_datanames(modules, datanames) - -\method{print}{teal_modules}(x, ...) } \arguments{ \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. @@ -92,6 +99,20 @@ will be added to the \code{datanames}.} \item{x}{(\code{teal_module} or \code{teal_modules}) Object to format/print.} +\item{indent}{(\code{integer(1)}) Indention level; each nested element is indented one level more.} + +\item{is_last}{(\code{logical(1)}) Whether this is the last item in its parent's children list. +Affects the tree branch character used (L- vs |-)} + +\item{parent_prefix}{(\code{character(1)}) The prefix inherited from parent nodes, +used to maintain the tree structure in nested levels} + +\item{what}{(\code{character}) Specifies which metadata to display. +Possible values: "datasets", "properties", "ui_args", "server_args", "transformers"} + +\item{is_root}{(\code{logical(1)}) Whether this is the root node of the tree. Only used in +format.teal_modules(). Determines whether to show "TEAL ROOT" header} + \item{modules}{(\code{teal_module} or \code{teal_modules})} } \value{ @@ -204,6 +225,113 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } +mod <- module( + label = "My Custom Module", + server = function(id, data, ...) {}, + ui = function(id, ...) {}, + datanames = c("ADSL", "ADTTE"), + transformers = list(), + ui_args = list(a = 1, b = "b"), + server_args = list(x = 5, y = list(p = 1)) +) +cat(format(mod)) +custom_module <- function( + label = "label", ui_args = NULL, server_args = NULL, + datanames = "all", transformers = list(), bk = FALSE) { + ans <- module( + label, + server = function(id, data, ...) {}, + ui = function(id, ...) { + }, + datanames = datanames, + transformers = transformers, + ui_args = ui_args, + server_args = server_args + ) + attr(ans, "teal_bookmarkable") <- bk + ans +} + +dummy_transformer <- teal_transform_module( + label = "Dummy Transform", + ui = function(id) div("(does nothing)"), + server = function(id, data) { + moduleServer(id, function(input, output, session) data) + } +) + +plot_transformer <- teal_transform_module( + label = "Plot Settings", + ui = function(id) div("(does nothing)"), + server = function(id, data) { + moduleServer(id, function(input, output, session) data) + } +) + +complete_modules <- modules( + custom_module( + label = "Data Overview", + datanames = c("ADSL", "ADAE", "ADVS"), + ui_args = list( + view_type = "table", + page_size = 10, + filters = c("ARM", "SEX", "RACE") + ), + server_args = list( + cache = TRUE, + debounce = 1000 + ), + transformers = list(dummy_transformer), + bk = TRUE + ), + modules( + label = "Nested 1", + custom_module( + label = "Interactive Plots", + datanames = c("ADSL", "ADVS"), + ui_args = list( + plot_type = c("scatter", "box", "line"), + height = 600, + width = 800, + color_scheme = "viridis" + ), + server_args = list( + render_type = "svg", + cache_plots = TRUE + ), + transformers = list(dummy_transformer, plot_transformer), + bk = TRUE + ), + modules( + label = "Nested 2", + custom_module( + label = "Summary Statistics", + datanames = "ADSL", + ui_args = list( + stats = c("mean", "median", "sd", "range"), + grouping = c("ARM", "SEX") + ) + ), + modules( + label = "Labeled nested modules", + custom_module( + label = "Subgroup Analysis", + datanames = c("ADSL", "ADAE"), + ui_args = list( + subgroups = c("AGE", "SEX", "RACE"), + analysis_type = "stratified" + ), + bk = TRUE + ) + ), + modules(custom_module(label = "Subgroup Analysis in non-labled modules")) + ) + ), + custom_module("Non-nested module") +) + +cat(format(complete_modules)) +cat(format(complete_modules, what = c("ui_args", "server_args", "transformers"))) # change the module's datanames set_datanames(module(datanames = "all"), "a") diff --git a/tests/testthat/test-modules.R b/tests/testthat/test-modules.R index 9085f76462..b1658af98c 100644 --- a/tests/testthat/test-modules.R +++ b/tests/testthat/test-modules.R @@ -508,8 +508,8 @@ testthat::test_that("format.teal_modules returns proper structure", { appended_mods <- append_module(mods, mod3) testthat::expect_equal( - format(appended_mods), - "+ c\n + a\n + c\n + c\n" + gsub("\033\\[[0-9;]*m", "", format(appended_mods)), + "TEAL ROOT\n |- a\n | |- Datasets : all\n | |- Properties:\n | | |- Bookmarkable : FALSE\n | | L- Reportable : FALSE\n | |- UI Arguments : \n | |- Server Arguments : \n | L- Transformers : \n |- c\n | |- Datasets : all\n | |- Properties:\n | | |- Bookmarkable : FALSE\n | | L- Reportable : FALSE\n | |- UI Arguments : \n | |- Server Arguments : \n | L- Transformers : \n L- c\n |- Datasets : all\n |- Properties:\n | |- Bookmarkable : FALSE\n | L- Reportable : FALSE\n |- UI Arguments : \n |- Server Arguments : \n L- Transformers : \n" # nolint: line_length ) })