quosures in teal and deprecate old show r code approach

NEWS.md

@@ -9,6 +9,7 @@
 ### Breaking changes
 
 * `...` argument in the `teal_module` no longer receives `datasets` object. In order to use `datasets` in the `teal_module` please specify `datasets` explicitly.
+* `get_rcode`, `get_rcode_ui` and `get_rcode_srv` has been deprecated in favour of `teal.widgets::verbatim_popup_ui` and `teal.widgets::verbatim_popup_srv`.
 * Deprecated `merge_expression` argument in `get_rcode_srv` and `get_rcode` has been removed.
 * Deprecated `session` argument in `get_rcode` function.
 

R/example_module.R

@@ -19,16 +19,16 @@ example_module <- function(label = "example teal module") {
   checkmate::assert_string(label)
   module(
     label,
-    server = function(id, datasets) {
+    server = function(id, data) {
       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.11.2",
+    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")
   }
@@ -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.11.2",
+    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.11.2",
+    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

@@ -117,16 +117,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, ...) {

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,38 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) {
   }
   reactive(modules)
 }
+
+#' Convert `FilteredData` to reactive list of data
+#'
+#' Converts `FilteredData` object to list of data containing datasets needed for 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)) {
+    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))
+    }
+  )
+
+  # code from previous stages
+  attr(data, "code") <- get_datasets_code(datanames, datasets)
+
+  # join_keys
+  attr(data, "join_keys") <- datasets$get_join_keys()
+  data
+}

R/modules.R

@@ -29,15 +29,15 @@
 #'       label = "Module",
 #'       module(
 #'         label = "Inner module",
-#'         server = function(id, datasets) {
+#'         server = function(id, data) {
 #'           moduleServer(
 #'             id,
 #'             module = function(input, output, session) {
-#'               output$data <- renderDataTable(datasets$get_data("iris"))
+#'               output$data <- renderDataTable(data[["iris"]]())
 #'             }
 #'           )
 #'         },
-#'         ui = function(id, datasets) {
+#'         ui = function(id) {
 #'           ns <- NS(id)
 #'           tagList(dataTableOutput(ns("data")))
 #'         },
@@ -46,15 +46,15 @@
 #'     ),
 #'     module(
 #'       label = "Another module",
-#'       server = function(id, datasets) {
+#'       server = function(id) {
 #'         moduleServer(
 #'           id,
 #'           module = function(input, output, session) {
 #'             output$text <- renderText("Another module")
 #'           }
 #'         )
 #'       },
-#'       ui = function(id, datasets) {
+#'       ui = function(id) {
 #'         ns <- NS(id)
 #'         tagList(textOutput(ns("text")))
 #'       },
@@ -169,35 +169,35 @@ is_arg_used.function <- function(modules, arg) {
 #'   modules = modules(
 #'     module(
 #'       label = "Module",
-#'       server = function(id, datasets) {
+#'       server = function(id, data) {
 #'         moduleServer(
 #'           id,
 #'           module = function(input, output, session) {
-#'             output$data <- renderDataTable(datasets$get_data("iris"))
+#'             output$data <- renderDataTable(data[["iris"]]())
 #'           }
 #'         )
 #'       },
-#'       ui = function(id, datasets) {
+#'       ui = function(id) {
 #'         ns <- NS(id)
 #'         tagList(dataTableOutput(ns("data")))
 #'       },
 #'       filters = "all"
 #'     ),
 #'     module(
 #'       label = "Another module",
-#'       server = function(id, datasets) {
+#'       server = function(id) {
 #'         moduleServer(
 #'           id,
 #'           module = function(input, output, session) {
 #'             output$text <- renderText("Another module")
 #'           }
 #'         )
 #'       },
-#'       ui = function(id, datasets) {
+#'       ui = function(id) {
 #'         ns <- NS(id)
 #'         tagList(textOutput(ns("text")))
 #'       },
-#'       filters = NULL
+#'       filters = "all"
 #'     )
 #'   )
 #' )
@@ -261,15 +261,15 @@ root_modules <- function(...) {
 #'   modules = list(
 #'     module(
 #'       label = "Module",
-#'       server = function(id, datasets) {
+#'       server = function(id, data) {
 #'         moduleServer(
 #'           id,
 #'           module = function(input, output, session) {
-#'             output$data <- renderDataTable(datasets$get_data("iris"))
+#'             output$data <- renderDataTable(data[["iris"]]())
 #'           }
 #'         )
 #'       },
-#'       ui = function(id, datasets) {
+#'       ui = function(id) {
 #'         ns <- NS(id)
 #'         tagList(dataTableOutput(ns("data")))
 #'       }

R/reporter_previewer_module.R

@@ -14,11 +14,11 @@
 #' @export
 reporter_previewer_module <- function(label = "Report previewer") {
   checkmate::assert_string(label)
-  srv <- function(id, datasets, reporter, ...) {
+  srv <- function(id, reporter, ...) {
     teal.reporter::reporter_previewer_srv(id, reporter, ...)
   }
 
-  ui <- function(id, datasets, ...) {
+  ui <- function(id, ...) {
     teal.reporter::reporter_previewer_ui(id, ...)
   }