From 0af8a67c7ad5899d71103a565d3ecccefc425803 Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 10 Jan 2025 15:09:19 +0530 Subject: [PATCH] improvements from @gogonzo --- R/init.R | 63 +++++++++++++++++++++++++------------------------------- 1 file changed, 28 insertions(+), 35 deletions(-) diff --git a/R/init.R b/R/init.R index d589307be..cab1f5817 100644 --- a/R/init.R +++ b/R/init.R @@ -224,24 +224,11 @@ init <- function(data, # argument transformations ## `modules` - landing module landing <- extract_module(modules, "teal_module_landing") - if (length(landing) == 1L) { - landing_popup_server <- landing[[1L]]$server - modules <- drop_module(modules, "teal_module_landing") - lifecycle::deprecate_warn( - when = "0.15.3", - what = "landing_popup_module()", - details = paste( - "landing_popup_module() is deprecated.", - "Use add_landing_popup() on the teal app object instead." - ) - ) - } else if (length(landing) > 1L) { - stop("Only one `landing_popup_module` can be used.") - } + modules <- drop_module(modules, "teal_module_landing") # Note: UI must be a function to support bookmarking. res <- list( - ui = function(request, ...) { + ui = function(request) { ui_teal( id = "teal", modules = modules, @@ -251,13 +238,26 @@ init <- function(data, ) }, server = function(input, output, session) { - if (!is.null(landing_popup_server)) { - do.call(landing_popup_server, c(list(id = "landing_module_shiny_id"))) - } srv_teal(id = "teal", data = data, modules = modules, filter = deep_copy_filter(filter)) } ) + if (length(landing) == 1L) { + res <- add_custom_server(res, function(input, output, session) { + do.call(landing[[1L]]$server, c(list(id = "landing_module_shiny_id"))) + }) + lifecycle::deprecate_warn( + when = "0.15.3", + what = "landing_popup_module()", + details = paste( + "landing_popup_module() is deprecated.", + "Use add_landing_popup() on the teal app object instead." + ) + ) + } else if (length(landing) > 1L) { + stop("Only one `landing_popup_module` can be used.") + } + logger::log_debug("init teal app has been initialized.") res @@ -281,15 +281,13 @@ modify_title <- function( title = "teal app", favicon = "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png") { res <- app - res$ui <- function(request, ...) { - args <- list(...) - args$title <- tags$div( + res$ui <- function(request) { + title <- tags$div( id = "teal-title", build_app_title(title, favicon) ) - ui_tq <- htmltools::tagQuery(do.call(app$ui, c(list(request = request), args))) - - ui_tq$find("#teal-title")$replaceWith(args$title)$allTags() + ui_tq <- htmltools::tagQuery(app$ui(request = request)) + ui_tq$find("#teal-title")$replaceWith(title)$allTags() } res } @@ -315,11 +313,9 @@ modify_title <- function( #' shinyApp(app$ui, app$server) modify_header <- function(app, header = tags$p()) { res <- app - res$ui <- function(request, ...) { - args <- list(...) - args$header <- header - ui_tq <- htmltools::tagQuery(do.call(app$ui, c(list(request = request), args))) - ui_tq$find("#teal-header")$replaceWith(tags$header(id = "teal-header", args$header))$allTags() + res$ui <- function(request) { + ui_tq <- htmltools::tagQuery(app$ui(request = request)) + ui_tq$find("#teal-header")$replaceWith(tags$header(id = "teal-header", header))$allTags() } res } @@ -341,11 +337,9 @@ modify_header <- function(app, header = tags$p()) { #' shinyApp(app$ui, app$server) modify_footer <- function(app, footer = tags$p()) { res <- app - res$ui <- function(request, ...) { - args <- list(...) - args$footer <- footer - ui_tq <- htmltools::tagQuery(do.call(app$ui, c(list(request = request), args))) - ui_tq$find("#teal-footer")$replaceWith(tags$div(id = "teal-footer", args$footer))$allTags() + res$ui <- function(request) { + ui_tq <- htmltools::tagQuery(app$ui(request = request)) + ui_tq$find("#teal-footer")$replaceWith(tags$div(id = "teal-footer", footer))$allTags() } res } @@ -412,7 +406,6 @@ add_landing_popup <- function( #' modules = modules(example_module()) #' ) |> #' add_custom_server(function(input, output, session) { -#' print("injected server logic to the main shiny server function") #' }) #' #' shinyApp(app$ui, app$server)