Teal refactor

DESCRIPTION

@@ -92,6 +92,7 @@ Collate:
     'modules_debugging.R'
     'reporter_previewer_module.R'
     'show_rcode_modal.R'
+    'tdata.R'
     'teal.R'
     'utils.R'
     'validations.R'

NAMESPACE

@@ -1,5 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(get_code,tdata)
+S3method(get_join_keys,default)
+S3method(get_join_keys,tdata)
+S3method(get_metadata,default)
+S3method(get_metadata,tdata)
 S3method(is_arg_used,"function")
 S3method(is_arg_used,default)
 S3method(is_arg_used,teal_module)
@@ -20,17 +25,22 @@ export(.log)
 export(bookmarkableShinyApp)
 export(default_filter)
 export(example_module)
+export(get_code_tdata)
+export(get_join_keys)
+export(get_metadata)
 export(get_rcode)
 export(get_rcode_srv)
 export(get_rcode_ui)
 export(init)
 export(log_app_usage)
 export(module)
 export(modules)
+export(new_tdata)
 export(reporter_previewer_module)
 export(root_modules)
 export(show_rcode_modal)
 export(srv_teal_with_splash)
+export(tdata2env)
 export(ui_teal_with_splash)
 export(validate_has_data)
 export(validate_has_elements)

NEWS.md

@@ -1,5 +1,16 @@
 # teal 0.12.0.9002
 
+### Major breaking changes
+
+* The use of `datasets` argument in `teal` `modules` has been deprecated and will be removed in a future release. Please use `data` argument instead. `data` is of type `tdata`; see "Creating custom modules" vignettes and function documentation of `teal::new_tdata` for further details.
+
+### Breaking changes
+
+* Due to deprecation of `chunks` in `teal.code`, the `teal` framework now uses their replacement (`qenv`) instead. The documentation in `teal` has been updated to reflect this and custom modules written with `chunks` should be updated to use `qenv`.
+
+
+### Miscellaneous
+
 * Updated examples to use `scda.2022`.
 * Added R session information into a link in the footer of `teal` applications.
 
@@ -15,7 +26,7 @@
 * Updated `teal_module` to have `data` argument which receives a list of reactive filter data with `"code"` and `"join_keys"` attributes.
 * Updated `teal_module` to have `filter_panel_api` argument which receives a `FilterPanelAPI` object.
 * Updated the internals of `module_teal` to reflect changes in `teal.slice`.
-* Updated vignettes and README content.
+
 
 ### Breaking changes
 

R/example_module.R

@@ -11,24 +11,25 @@
 #'   ),
 #'   modules = modules(example_module())
 #' )
-#' \dontrun{
-#' shinyApp(app$ui, app$server)
+#' if (interactive()) {
+#'   shinyApp(app$ui, app$server)
 #' }
 #' @export
 example_module <- function(label = "example teal module") {
   checkmate::assert_string(label)
   module(
     label,
-    server = function(id, datasets) {
+    server = function(id, data) {
+      checkmate::assert_class(data, "tdata")
       moduleServer(id, function(input, output, session) {
-        output$text <- renderPrint(datasets$get_data(input$dataname, filtered = TRUE))
+        output$text <- renderPrint(data[[input$dataname]]())
       })
     },
-    ui = function(id, datasets) {
+    ui = function(id, data) {
       ns <- NS(id)
       teal.widgets::standard_layout(
         output = verbatimTextOutput(ns("text")),
-        encoding = selectInput(ns("dataname"), "Choose a dataset", choices = datasets$datanames())
+        encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data))
       )
     },
     filters = "all"

R/get_rcode.R

@@ -1,6 +1,6 @@
 #' Returns R Code from a teal module
 #'
-#' @description `r lifecycle::badge("stable")`
+#' @description `r lifecycle::badge("deprecated")`
 #' Return the R-code used to create a teal::teal] module analysis. This function
 #' will return all analysis code as a character string. In case of a good setup it will
 #' not only return the code used create the module analysis, but also the code used by
@@ -62,6 +62,14 @@ get_rcode <- function(datasets = NULL,
                       title = NULL,
                       description = NULL) {
   checkmate::assert_class(datasets, "FilteredData", null.ok = TRUE)
+
+  lifecycle::deprecate_warn(
+    when = "0.12.1",
+    what = "get_rcode()",
+    details = "Reproducibility in teal apps has changed.
+      See the teal.code package and example modules for further details"
+  )
+
   if (!inherits(chunks, "chunks")) {
     stop("No code chunks given")
   }
@@ -70,7 +78,7 @@ get_rcode <- function(datasets = NULL,
   rlang::push_options(width = 120)
 
   if (!is.null(session)) {
-    lifecycle::deprecate_warn("0.11.2", "get_rcode(session)")
+    lifecycle::deprecate_warn("0.12.1", "get_rcode(session)")
   }
 
   if (!is.null(datasets)) {
@@ -191,7 +199,7 @@ get_datasets_code <- function(datanames, datasets) {
 ## Module ----
 #' Server part of get R code module
 #'
-#' @description `r lifecycle::badge("stable")`
+#' @description `r lifecycle::badge("deprecated")`
 #'
 #' @inheritParams get_rcode
 #' @inheritParams shiny::moduleServer
@@ -210,6 +218,15 @@ get_rcode_srv <- function(id,
                           code_header = "Automatically generated R code",
                           disable_buttons = reactiveVal(FALSE)) {
   checkmate::check_class(disable_buttons, c("reactive", "function"))
+
+  lifecycle::deprecate_warn(
+    when = "0.12.1",
+    what = "get_rcode_srv()",
+    with = "teal.widgets::verbatim_popup_srv()",
+    details = "Show R Code behaviour has changed,
+      see example modules in vignettes for more details"
+  )
+
   moduleServer(id, function(input, output, server) {
     chunks <- teal.code::get_chunks_object(parent_idx = 1L)
     observeEvent(input$show_rcode, {
@@ -247,13 +264,21 @@ get_rcode_srv <- function(id,
 
 #' Ui part of get R code module
 #'
-#' @description `r lifecycle::badge("stable")`
+#' @description `r lifecycle::badge("deprecated")`
 #' @param id (`character`) id of shiny module
 #'
 #' @return (`shiny.tag`)
 #'
 #' @export
 get_rcode_ui <- function(id) {
+  lifecycle::deprecate_warn(
+    when = "0.12.1",
+    what = "get_rcode_ui()",
+    with = "teal.widgets::verbatim_popup_ui()",
+    details = "Show R Code behaviour has changed,
+      see example modules in vignettes for more details"
+  )
+
   ns <- NS(id)
   tagList(
     tags$div(actionButton(ns("show_rcode"), "Show R code", width = "100%")),

R/init.R

@@ -16,8 +16,9 @@
 #'
 #' @param data (`TealData` or `TealDataset` or `TealDatasetConnector` or `list` or `data.frame`
 #' or `MultiAssayExperiment`)\cr
-#' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], [teal.data::cdisc_dataset()], [teal.data::dataset()],
-#' [teal.data::dataset_connector()] or [teal.data::cdisc_dataset_connector()] or a single `data.frame` or a `MultiAssayExperiment`
+#' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()],
+#' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or
+#' [teal.data::cdisc_dataset_connector()] or a single `data.frame` or a `MultiAssayExperiment`
 #' or a list of the previous objects or function returning a named list.
 #' NOTE: teal does not guarantee reproducibility of the code when names of the list elements
 #' do not match the original object names. To ensure reproducibility please use [teal.data::teal_data()]
@@ -120,16 +121,16 @@
 #'   modules = modules(
 #'     module(
 #'       "data source",
-#'       server = function(input, output, session, datasets) {},
+#'       server = function(input, output, session, data) {},
 #'       ui = function(id, ...) div(p("information about data source")),
 #'       filters = "all"
 #'     ),
 #'     example_module(),
 #'     module(
 #'       "ADSL AGE histogram",
-#'       server = function(input, output, session, datasets) {
+#'       server = function(input, output, session, data) {
 #'         output$hist <- renderPlot(
-#'           hist(datasets$get_data("ADSL", filtered = TRUE)$AGE)
+#'           hist(data[["ADSL"]]()$AGE)
 #'         )
 #'       },
 #'       ui = function(id, ...) {
@@ -144,12 +145,10 @@
 #'   header = tags$h1("Sample App"),
 #'   footer = tags$p("Copyright 2017 - 2020")
 #' )
-#' \dontrun{
-#' shinyApp(app$ui, app$server)
+#' if (interactive()) {
+#'   shinyApp(app$ui, app$server)
 #' }
 #'
-#' # See the vignette for an example how to embed this app as a module
-#' # into a larger application
 init <- function(data,
                  modules,
                  title = NULL,

R/module_nested_tabs.R

@@ -96,24 +96,9 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L) {
     args <- c(args, datasets = datasets)
   }
 
-  if (is_arg_used(modules$ui, "data")) {
-    datanames <- if (identical("all", modules$filter)) datasets$datanames() else modules$filter
-
-    # list of reactive filtered data
-    data <- sapply(
-      datanames,
-      simplify = FALSE,
-      function(x) {
-        reactive(datasets$get_data(x, filtered = TRUE))
-      }
-    )
-
-    # code from previous stages
-    attr(data, "code") <- get_datasets_code(datanames, datasets)
-
-    # join_keys
-    attr(data, "join_keys") <- datasets$get_join_keys()
 
+  if (is_arg_used(modules$ui, "data")) {
+    data <- .datasets_to_data(modules, datasets)
     args <- c(args, data = list(data))
   }
 
@@ -217,23 +202,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) {
   }
 
   if (is_arg_used(modules$server, "data")) {
-    datanames <- if (identical("all", modules$filter)) datasets$datanames() else modules$filter
-
-    # list of reactive filtered data
-    data <- sapply(
-      datanames,
-      simplify = FALSE,
-      function(x) {
-        reactive(datasets$get_data(x, filtered = TRUE))
-      }
-    )
-
-    # code from previous stages
-    attr(data, "code") <- get_datasets_code(datanames, datasets)
-
-    # join_keys
-    attr(data, "join_keys") <- datasets$get_join_keys()
-
+    data <- .datasets_to_data(modules, datasets)
     args <- c(args, data = list(data))
   }
 
@@ -258,3 +227,41 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) {
   }
   reactive(modules)
 }
+
+#' Convert `FilteredData` to reactive list of datasets of the `tdata` type.
+#'
+#' Converts `FilteredData` object to `tdata` object containing datasets needed for a specific module.
+#' Please note that if module needs dataset which has a parent, then parent will be also returned.
+#'
+#' @param module (`teal_module`) module where needed filters are taken from
+#' @param datasets (`FilteredData`) object where needed data are taken from
+#' @return list of reactive datasets with following attributes:
+#' - `code` (`character`) containing datasets reproducible code.
+#' @keywords internal
+#' - `join_keys` (`JoinKeys`) containing relationships between datasets.
+.datasets_to_data <- function(module, datasets) {
+  datanames <- if (identical("all", module$filter) || is.null(module$filter)) {
+    datasets$datanames()
+  } else {
+    datasets$get_filterable_datanames(module$filter) # get_filterable_datanames adds parents if present
+  }
+
+  # list of reactive filtered data
+  data <- sapply(
+    datanames,
+    simplify = FALSE,
+    function(x) {
+      reactive(datasets$get_data(x, filtered = TRUE))
+    }
+  )
+
+  metadata <- lapply(datanames, datasets$get_metadata)
+  names(metadata) <- datanames
+
+  new_tdata(
+    data,
+    reactive(get_datasets_code(datanames, datasets)),
+    datasets$get_join_keys(),
+    metadata
+  )
+}