Merge branch 'main' into 1187_decorate_output@main

.pre-commit-config.yaml

@@ -10,15 +10,16 @@ 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:
           - davidgohel/flextable # Error: package 'flextable' is not available
           - davidgohel/gdtools # for flextable
           - mirai
           - checkmate
+          - crayon
           - jsonlite
           - lifecycle
           - logger

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", , "[email protected]", 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,

NEWS.md

@@ -1,4 +1,4 @@
-# teal 0.15.2.9080
+# teal 0.15.2.9081
 
 ### New features
 

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 ----
 

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,

inst/WORDLIST

@@ -8,6 +8,7 @@ Reproducibility
 TLG
 UI
 UX
+args
 bookmarkable
 cloneable
 customizable
@@ -26,4 +27,5 @@ summarization
 tabset
 themer
 theming
+ui
 uncheck