review suggestions

- input, input_mask to env and env_mask to match substitute formals
- make assertions
- fix failing tests and vignettes

NAMESPACE

@@ -18,6 +18,10 @@ S3method(ui_nested_tabs,teal_modules)
 export("%>%")
 export(TealReportCard)
 export(as.teal_slices)
+export(close_conn)
+export(ddl)
+export(delayed_data)
+export(eval_and_mask)
 export(example_module)
 export(get_code_tdata)
 export(get_metadata)
@@ -26,6 +30,7 @@ export(landing_popup_module)
 export(module)
 export(modules)
 export(new_tdata)
+export(open_conn)
 export(report_card_template)
 export(reporter_previewer_module)
 export(show_rcode_modal)

R/data-ddl-utils.R

@@ -1,23 +1,24 @@
 #' Function runs the `code`, masks the `code` and creates `teal_data` object.
 #' @param data (`teal_data`) object
 #' @param code (`language`) code to evaluate
-#' @param input (`list`) containing inputs to be used in the `code`
-#' @param input_mask (`list`) containing inputs to be masked in the `code`
+#' @param env (`list`) containing inputs to be used in the `code`
+#' @param env_mask (`list`) containing inputs to be masked in the `code`
 #'
 #' @return `teal_data` object
 #'
 #' @export
 eval_and_mask <- function(data,
                           code,
-                          input = list(),
-                          input_mask = list()) {
-  # todo: do we need also within_and_mask?
-  checkmate::assert_list(input)
-  if (inherits(input, "reactivevalues")) {
-    input <- shiny::reactiveValuesToList(input)
-  }
+                          env = list(),
+                          env_mask = list()) {
+  checkmate::assert_class(data, "teal_data")
+  checkmate::assert_true(is.language(code))
+  checkmate::assert_list(env)
+  checkmate::assert_list(env_mask)
+
+
   # evaluate code and substitute input
-  data <- teal.code::eval_code(data, .substitute_code(code, args = input))
+  data <- teal.code::eval_code(data, .substitute_code(expr = code, env = env))
   if (inherits(data, "qenv.error")) {
     return(data)
   }
@@ -29,14 +30,14 @@ eval_and_mask <- function(data,
     )
   }
 
-  if (!missing(input_mask)) {
+  if (!missing(env_mask)) {
     # mask dynamic inputs with mask
-    input <- utils::modifyList(input, input_mask)
+    env_masked <- utils::modifyList(env, env_mask)
 
     # replace last code entry with masked code
     # format_expression needed to convert expression into character(1)
     #  question: warnings and errors are not masked, is it ok?
-    data@code[length(data@code)] <- format_expression(.substitute_code(code, args = input))
+    data@code[length(data@code)] <- format_expression(.substitute_code(expr = code, env = env_masked))
   }
 
   # todo: should it be here or in datanames(data)?
@@ -51,37 +52,41 @@ eval_and_mask <- function(data,
 #'
 #' Function replaces symbols in the provided code by values of the `args` argument.
 #'
-#' @param code (`language`) code to substitute
-#' @param args (`list`) named list or arguments
+#' @inheritParams base::substitute
 #' @keywords internal
-.substitute_code <- function(code, args) {
+.substitute_code <- function(expr, env) {
   do.call(
     substitute,
     list(
       expr = do.call(
         substitute,
-        list(expr = code)
+        list(expr = expr)
       ),
-      env = args
+      env = env
     )
   )
 }
 
 #' Convenience wrapper for ddl
-#' @export # todo: do we want to export this?
-ddl <- function(code, input_mask, ui, server) {
-  delayed_data(ui = ui, server = server, code = code, input_mask = input_mask)
+#'
+#' @inheritParams delayed_data
+#' @param code (`character` or `language`)
+#' @param env_mask (`named list`)
+#' @export
+ddl <- function(code, env_mask, ui, server) {
+  # todo: do we want to export this?
+  delayed_data(ui = ui, server = server, code = code, env_mask = env_mask)
 }
 
 ui_login_and_password <- function(id) {
   ns <- NS(id)
   actionButton(inputId = ns("submit"), label = "Submit")
 }
 
-srv_login_and_password <- function(id, code, input_mask) {
+srv_login_and_password <- function(id, code, env_mask) {
   moduleServer(id, function(input, output, session) {
     eventReactive(input$submit, {
-      teal_data() |> eval_and_mask(code = code, input = input, input_mask = input_mask)
+      eval_and_mask(teal_data(), code = code, env = reactiveValuesToList(input), env_mask = env_mask)
     })
   })
 }

R/data-transform_module.R

@@ -1,16 +1,17 @@
 #' `delayed_data` for `teal_data`
 #'
 #' Function creates object of class `delayed_data` which allows
-#' `teal` app developer to transform freely `teal_data` object passed to `data` argument in
+#' `teal` app developer to transform `teal_data` object passed to `data` argument in
 #' [teal::init()]. This helps in case when app developer wants to use `teal` app
 #' where `data` can be influenced by app user. For example, app developer can create
 #' `teal` app which allows user to connect to database and then use data from this database.
 #' @param ... (`any`) arguments passed to `server` function.
 #' @param ui (`function(id)`) function to create UI
 #' @param server (`function(id)`) `shiny` server which returns `teal_data` object wrapped in
 #' `reactive`. `server` should have `id` argument and exactly the same formals as specified in `...`.
-#' @export # todo: do we want to export this?
+#' @export
 delayed_data <- function(ui, server, ...) {
+  # todo: do we want to export this?
   checkmate::assert_function(ui, args = "id")
   server_args <- list(...)
   if (length(server_args) && is.null(names(server_args))) {
@@ -19,11 +20,11 @@ delayed_data <- function(ui, server, ...) {
 
   server_formals <- names(formals(server))
   extra_args <- setdiff(names(server_args), server_formals)
-  if (length(extra_args) > 0) {
+  if (length(extra_args) > 0 && !"..." %in% server_formals) {
     stop(
       "Unexpected arguments specified in delayed_data(): ",
       toString(extra_args),
-      "\n arguments specified in `...` should be the same as in `server` function",
+      "\n arguments specified in `...` should be accepted by the `server` function",
       call. = FALSE
     )
   }

R/module_teal.R

@@ -165,16 +165,9 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
       modules <- append_module(modules, reporter_previewer_module())
     }
 
-    # Replace splash / welcome screen once data is loaded ----
-    # ignoreNULL to not trigger at the beginning when data is NULL
-    # just handle it once because data obtained through delayed loading should
-    # usually not change afterwards
-    # if restored from bookmarked state, `filter` is ignored
     env <- environment()
-    observeEvent(raw_data(), {
-      logger::log_trace("srv_teal@5 setting main ui after data was pulled")
+    datasets_reactive <- eventReactive(raw_data(), {
       env$progress <- shiny::Progress$new(session)
-      on.exit(env$progress$close())
       env$progress$set(0.25, message = "Setting data")
 
       # create a list of data following structure of the nested modules list structure.
@@ -217,10 +210,22 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
           datasets_singleton
         }
       }
-      datasets <- module_datasets(modules)
+      module_datasets(modules)
+    })
 
-      # main_ui_container contains splash screen first and we remove it and replace it by the real UI
+    # Replace splash / welcome screen once data is loaded ----
+    # ignoreNULL to not trigger at the beginning when data is NULL
+    # just handle it once because data obtained through delayed loading should
+    # usually not change afterwards
+    # if restored from bookmarked state, `filter` is ignored
+
+    observeEvent(datasets_reactive(), {
+      logger::log_trace("srv_teal@5 setting main ui after data was pulled")
+      on.exit(env$progress$close())
       env$progress$set(0.5, message = "Setting up main UI")
+      datasets <- datasets_reactive()
+
+      # main_ui_container contains splash screen first and we remove it and replace it by the real UI
       removeUI(sprintf("#%s:first-child", session$ns("main_ui_container")))
       insertUI(
         selector = paste0("#", session$ns("main_ui_container")),

R/module_teal_with_splash.R

@@ -125,6 +125,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
       if (inherits(data, "qenv.error")) {
         #
         showNotification(sprintf("Error: %s", data$message))
+        logger::log_error(data$message)
         return(NULL)
       }
 
@@ -133,12 +134,14 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
 
       if (!isTRUE(is_modules_ok)) {
         showNotification(is_modules_ok)
+        logger::log_error(is_modules_ok)
         # NULL won't trigger observe which waits for raw_data()
         # we will need to consider validate process for filtered data and modules!
         return(NULL)
       }
       if (!isTRUE(is_filter_ok)) {
         showNotification(is_filter_ok)
+        logger::log_warn(is_filter_ok)
         # we allow app to continue if applied filters are outside
         # of possible data range
       }

R/utils.R

@@ -152,8 +152,8 @@ check_modules_datanames <- function(modules, datanames) {
         sprintf(
           "- Module %s has a different dataname than available in a 'data': %s not in %s",
           modules$label,
-          toString(extra_datanames),
-          toString(datanames)
+          toString(dQuote(extra_datanames, q = FALSE)),
+          toString(dQuote(datanames, q = FALSE))
         )
       }
     }
@@ -176,8 +176,8 @@ check_filter_datanames <- function(filters, datanames) {
         sprintf(
           "- Filter %s has a different dataname than available in a 'data':\n %s not in %s",
           filter$label,
-          dataname,
-          toString(datanames)
+          dQuote(dataname),
+          toString(dQuote(datanames))
         )
       }
     }