From 2e06eaff883e4bd7dc8f692625ddc45c09fea5da Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 12 Oct 2023 15:39:27 +0200 Subject: [PATCH 01/26] #812 proposition for landing popup with shinyalert package --- DESCRIPTION | 1 + R/init.R | 25 +++++++++++++++++++++++-- man/init.Rd | 13 +++++++++++-- 3 files changed, 35 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0930538a7c..833c7a06c5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,6 +40,7 @@ Imports: logger (>= 0.2.0), magrittr, rlang, + shinyalert, shinyjs, stats, teal.logger (>= 0.1.1), diff --git a/R/init.R b/R/init.R index 4fdb147951..fc1c5d8776 100644 --- a/R/init.R +++ b/R/init.R @@ -45,6 +45,8 @@ #' the server function must be called with [shiny::moduleServer()]; #' See the vignette for an example. However, [ui_teal_with_splash()] #' is then preferred to this function. +#' @param langind A named `list` with 3 character elements `title`, `text` and `button`. They +#' will be passed to a disclaimer landing popup created with [shinyalert::shinyalert]. #' #' @return named list with `server` and `ui` function #' @@ -100,7 +102,12 @@ #' ) #' ), #' header = tags$h1("Sample App"), -#' footer = tags$p("Copyright 2017 - 2023") +#' footer = tags$p("Copyright 2017 - 2023"), +#' landing = list( +#' title = 'Disclaimer', +#' text = 'By agreeing to this statement you confirm you accept A, B and C.', +#' button = 'Agree' +#' ) #' ) #' if (interactive()) { #' shinyApp(app$ui, app$server) @@ -112,7 +119,8 @@ init <- function(data, filter = teal_slices(), header = tags$p(), footer = tags$p(), - id = character(0)) { + id = character(0), + landing = NULL) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") data <- teal.data::to_relational_data(data = data) @@ -126,6 +134,10 @@ init <- function(data, checkmate::assert_multi_class(header, c("shiny.tag", "character")) checkmate::assert_multi_class(footer, c("shiny.tag", "character")) checkmate::assert_character(id, max.len = 1, any.missing = FALSE) + checkmate::check_list(landing, names = "named", null.ok = TRUE) + if (is.list(landing)) { + checkmate::check_names(names(landing), subset.of = c('title', 'text', 'button')) + } teal.logger::log_system_info() @@ -212,6 +224,15 @@ init <- function(data, res <- list( ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { + if (!is.null(landing)) { + shinyalert::shinyalert( + title = landing$title, + text = landing$text, + type = "info", + showConfirmButton = TRUE, + confirmButtonText = landing$button + ) + } # copy object so that load won't be shared between the session data <- data$copy(deep = TRUE) filter <- deep_copy_filter(filter) diff --git a/man/init.Rd b/man/init.Rd index 234f60697f..ca0e259d01 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -11,7 +11,8 @@ init( filter = teal_slices(), header = tags$p(), footer = tags$p(), - id = character(0) + id = character(0), + landing = NULL ) } \arguments{ @@ -52,6 +53,9 @@ module id to embed it, if provided, the server function must be called with \code{\link[shiny:moduleServer]{shiny::moduleServer()}}; See the vignette for an example. However, \code{\link[=ui_teal_with_splash]{ui_teal_with_splash()}} is then preferred to this function.} + +\item{langind}{A named \code{list} with 3 character elements \code{title}, \code{text} and \code{button}. They +will be passed to a disclaimer landing popup created with \link[shinyalert:shinyalert]{shinyalert::shinyalert}.} } \value{ named list with \code{server} and \code{ui} function @@ -113,7 +117,12 @@ app <- init( ) ), header = tags$h1("Sample App"), - footer = tags$p("Copyright 2017 - 2023") + footer = tags$p("Copyright 2017 - 2023"), + landing = list( + title = 'Disclaimer', + text = 'By agreeing to this statement you confirm you accept A, B and C.', + button = 'Agree' + ) ) if (interactive()) { shinyApp(app$ui, app$server) From 713b37fcc4b9dfc365c918149fd1e223f83dfb4f Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 12 Oct 2023 13:47:19 +0000 Subject: [PATCH 02/26] [skip actions] Restyle files --- R/init.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/init.R b/R/init.R index fc1c5d8776..04e7ed6716 100644 --- a/R/init.R +++ b/R/init.R @@ -104,9 +104,9 @@ #' header = tags$h1("Sample App"), #' footer = tags$p("Copyright 2017 - 2023"), #' landing = list( -#' title = 'Disclaimer', -#' text = 'By agreeing to this statement you confirm you accept A, B and C.', -#' button = 'Agree' +#' title = "Disclaimer", +#' text = "By agreeing to this statement you confirm you accept A, B and C.", +#' button = "Agree" #' ) #' ) #' if (interactive()) { @@ -136,7 +136,7 @@ init <- function(data, checkmate::assert_character(id, max.len = 1, any.missing = FALSE) checkmate::check_list(landing, names = "named", null.ok = TRUE) if (is.list(landing)) { - checkmate::check_names(names(landing), subset.of = c('title', 'text', 'button')) + checkmate::check_names(names(landing), subset.of = c("title", "text", "button")) } teal.logger::log_system_info() From 18834f459cf51dbc535a58afe68b3764ae146aa6 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 12 Oct 2023 16:02:57 +0200 Subject: [PATCH 03/26] Empty-Commit From 02b83fd91e5eae3ad8c32f0956cfccb45eb4eb1b Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Thu, 12 Oct 2023 14:07:35 +0000 Subject: [PATCH 04/26] [skip actions] Roxygen Man Pages Auto Update --- man/init.Rd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/man/init.Rd b/man/init.Rd index ca0e259d01..3f630fb872 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -119,9 +119,9 @@ app <- init( header = tags$h1("Sample App"), footer = tags$p("Copyright 2017 - 2023"), landing = list( - title = 'Disclaimer', - text = 'By agreeing to this statement you confirm you accept A, B and C.', - button = 'Agree' + title = "Disclaimer", + text = "By agreeing to this statement you confirm you accept A, B and C.", + button = "Agree" ) ) if (interactive()) { From e920f50d1955f7956cabcc8595eec2a69b863540 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 12 Oct 2023 16:08:47 +0200 Subject: [PATCH 05/26] Empty-Commit From 3dcccf3fb538c2d4bd1ac398cc488b2969c12b29 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 12 Oct 2023 16:21:37 +0200 Subject: [PATCH 06/26] typo --- R/init.R | 2 +- man/init.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/init.R b/R/init.R index 04e7ed6716..8ed1fe128a 100644 --- a/R/init.R +++ b/R/init.R @@ -45,7 +45,7 @@ #' the server function must be called with [shiny::moduleServer()]; #' See the vignette for an example. However, [ui_teal_with_splash()] #' is then preferred to this function. -#' @param langind A named `list` with 3 character elements `title`, `text` and `button`. They +#' @param landing A named `list` with 3 character elements `title`, `text` and `button`. They #' will be passed to a disclaimer landing popup created with [shinyalert::shinyalert]. #' #' @return named list with `server` and `ui` function diff --git a/man/init.Rd b/man/init.Rd index 3f630fb872..3353c5d32f 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -54,7 +54,7 @@ the server function must be called with \code{\link[shiny:moduleServer]{shiny::m See the vignette for an example. However, \code{\link[=ui_teal_with_splash]{ui_teal_with_splash()}} is then preferred to this function.} -\item{langind}{A named \code{list} with 3 character elements \code{title}, \code{text} and \code{button}. They +\item{landing}{A named \code{list} with 3 character elements \code{title}, \code{text} and \code{button}. They will be passed to a disclaimer landing popup created with \link[shinyalert:shinyalert]{shinyalert::shinyalert}.} } \value{ From 5d338932e48d90c3df5ade51b39b24df8829fe41 Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 13 Oct 2023 11:47:34 +0200 Subject: [PATCH 07/26] Empty-Commit From f973beb78965fbadd5e7f18843ba752f3b4052a3 Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 13 Oct 2023 12:04:35 +0200 Subject: [PATCH 08/26] rename landing param to extra_server in teal --- NAMESPACE | 1 + R/init.R | 21 ++++----------------- R/utils.R | 17 +++++++++++++++++ man/init.Rd | 7 +++---- man/landing_modal.Rd | 14 ++++++++++++++ 5 files changed, 39 insertions(+), 21 deletions(-) create mode 100644 man/landing_modal.Rd diff --git a/NAMESPACE b/NAMESPACE index 4711ead7a4..dee47cf21f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,6 +24,7 @@ export(get_code_tdata) export(get_join_keys) export(get_metadata) export(init) +export(landing_modal) export(module) export(modules) export(new_tdata) diff --git a/R/init.R b/R/init.R index 8ed1fe128a..baa7937983 100644 --- a/R/init.R +++ b/R/init.R @@ -45,8 +45,7 @@ #' the server function must be called with [shiny::moduleServer()]; #' See the vignette for an example. However, [ui_teal_with_splash()] #' is then preferred to this function. -#' @param landing A named `list` with 3 character elements `title`, `text` and `button`. They -#' will be passed to a disclaimer landing popup created with [shinyalert::shinyalert]. +#' @param extra_server A list of elements passed to `shiny::server`. #' #' @return named list with `server` and `ui` function #' @@ -103,7 +102,7 @@ #' ), #' header = tags$h1("Sample App"), #' footer = tags$p("Copyright 2017 - 2023"), -#' landing = list( +#' extra_server = landing_modal( #' title = "Disclaimer", #' text = "By agreeing to this statement you confirm you accept A, B and C.", #' button = "Agree" @@ -120,7 +119,7 @@ init <- function(data, header = tags$p(), footer = tags$p(), id = character(0), - landing = NULL) { + extra_server = NULL) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") data <- teal.data::to_relational_data(data = data) @@ -134,10 +133,6 @@ init <- function(data, checkmate::assert_multi_class(header, c("shiny.tag", "character")) checkmate::assert_multi_class(footer, c("shiny.tag", "character")) checkmate::assert_character(id, max.len = 1, any.missing = FALSE) - checkmate::check_list(landing, names = "named", null.ok = TRUE) - if (is.list(landing)) { - checkmate::check_names(names(landing), subset.of = c("title", "text", "button")) - } teal.logger::log_system_info() @@ -224,15 +219,7 @@ init <- function(data, res <- list( ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { - if (!is.null(landing)) { - shinyalert::shinyalert( - title = landing$title, - text = landing$text, - type = "info", - showConfirmButton = TRUE, - confirmButtonText = landing$button - ) - } + extra_server # copy object so that load won't be shared between the session data <- data$copy(deep = TRUE) filter <- deep_copy_filter(filter) diff --git a/R/utils.R b/R/utils.R index 9d284e5054..131161a18a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -46,3 +46,20 @@ include_parent_datanames <- function(dataname, join_keys) { return(unique(c(parents, dataname))) } + +#' @title A Landing Page Popup +#' @description Should be a part of `teal.modules.general` +#' @param title,text,button Arguments passed to `shinyalert::shinyalert`. +#' +#' @export +landing_modal <- function(title = NULL, text = NULL, button = NULL) { + checkmate::assert_string(title, null.ok = TRUE) + checkmate::assert_string(text, null.ok = TRUE) + checkmate::assert_string(button, null.ok = TRUE) + shinyalert::shinyalert( + title = title, + text = text, + type = "info", + confirmButtonText = button + ) +} diff --git a/man/init.Rd b/man/init.Rd index 3353c5d32f..2e0795d224 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -12,7 +12,7 @@ init( header = tags$p(), footer = tags$p(), id = character(0), - landing = NULL + extra_server = NULL ) } \arguments{ @@ -54,8 +54,7 @@ the server function must be called with \code{\link[shiny:moduleServer]{shiny::m See the vignette for an example. However, \code{\link[=ui_teal_with_splash]{ui_teal_with_splash()}} is then preferred to this function.} -\item{landing}{A named \code{list} with 3 character elements \code{title}, \code{text} and \code{button}. They -will be passed to a disclaimer landing popup created with \link[shinyalert:shinyalert]{shinyalert::shinyalert}.} +\item{extra_server}{A list of elements passed to \code{shiny::server}.} } \value{ named list with \code{server} and \code{ui} function @@ -118,7 +117,7 @@ app <- init( ), header = tags$h1("Sample App"), footer = tags$p("Copyright 2017 - 2023"), - landing = list( + extra_server = landing_modal( title = "Disclaimer", text = "By agreeing to this statement you confirm you accept A, B and C.", button = "Agree" diff --git a/man/landing_modal.Rd b/man/landing_modal.Rd new file mode 100644 index 0000000000..8d43775be9 --- /dev/null +++ b/man/landing_modal.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{landing_modal} +\alias{landing_modal} +\title{A Landing Page Popup} +\usage{ +landing_modal(title = NULL, text = NULL, button = NULL) +} +\arguments{ +\item{title, text, button}{Arguments passed to \code{shinyalert::shinyalert}.} +} +\description{ +Should be a part of \code{teal.modules.general} +} From a04ee4acb255564bbc77358e6f72709d732e9333 Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 13 Oct 2023 12:35:01 +0200 Subject: [PATCH 09/26] move out landing popup to teal.modules.general --- DESCRIPTION | 1 - NAMESPACE | 1 - R/init.R | 8 ++++---- R/utils.R | 17 ----------------- man/init.Rd | 8 ++++---- man/landing_modal.Rd | 14 -------------- 6 files changed, 8 insertions(+), 41 deletions(-) delete mode 100644 man/landing_modal.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 833c7a06c5..0930538a7c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,7 +40,6 @@ Imports: logger (>= 0.2.0), magrittr, rlang, - shinyalert, shinyjs, stats, teal.logger (>= 0.1.1), diff --git a/NAMESPACE b/NAMESPACE index dee47cf21f..4711ead7a4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,7 +24,6 @@ export(get_code_tdata) export(get_join_keys) export(get_metadata) export(init) -export(landing_modal) export(module) export(modules) export(new_tdata) diff --git a/R/init.R b/R/init.R index baa7937983..346dda1b70 100644 --- a/R/init.R +++ b/R/init.R @@ -102,10 +102,10 @@ #' ), #' header = tags$h1("Sample App"), #' footer = tags$p("Copyright 2017 - 2023"), -#' extra_server = landing_modal( -#' title = "Disclaimer", -#' text = "By agreeing to this statement you confirm you accept A, B and C.", -#' button = "Agree" +#' extra_server = teal.modules.general::tm_landing_popup( +#' title = "Welcome", +#' text = "A place for a welcome message or a disclaimer statement.", +#' button = "Proceed" #' ) #' ) #' if (interactive()) { diff --git a/R/utils.R b/R/utils.R index 131161a18a..9d284e5054 100644 --- a/R/utils.R +++ b/R/utils.R @@ -46,20 +46,3 @@ include_parent_datanames <- function(dataname, join_keys) { return(unique(c(parents, dataname))) } - -#' @title A Landing Page Popup -#' @description Should be a part of `teal.modules.general` -#' @param title,text,button Arguments passed to `shinyalert::shinyalert`. -#' -#' @export -landing_modal <- function(title = NULL, text = NULL, button = NULL) { - checkmate::assert_string(title, null.ok = TRUE) - checkmate::assert_string(text, null.ok = TRUE) - checkmate::assert_string(button, null.ok = TRUE) - shinyalert::shinyalert( - title = title, - text = text, - type = "info", - confirmButtonText = button - ) -} diff --git a/man/init.Rd b/man/init.Rd index 2e0795d224..2bdc348534 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -117,10 +117,10 @@ app <- init( ), header = tags$h1("Sample App"), footer = tags$p("Copyright 2017 - 2023"), - extra_server = landing_modal( - title = "Disclaimer", - text = "By agreeing to this statement you confirm you accept A, B and C.", - button = "Agree" + extra_server = teal.modules.general::tm_landing_popup( + title = "Welcome", + text = "A place for the welcome message or a disclaimer statement.", + button = "Proceed" ) ) if (interactive()) { diff --git a/man/landing_modal.Rd b/man/landing_modal.Rd deleted file mode 100644 index 8d43775be9..0000000000 --- a/man/landing_modal.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{landing_modal} -\alias{landing_modal} -\title{A Landing Page Popup} -\usage{ -landing_modal(title = NULL, text = NULL, button = NULL) -} -\arguments{ -\item{title, text, button}{Arguments passed to \code{shinyalert::shinyalert}.} -} -\description{ -Should be a part of \code{teal.modules.general} -} From aa253fabc38a795a6c27cc181018e600d550a7bd Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Fri, 13 Oct 2023 10:40:12 +0000 Subject: [PATCH 10/26] [skip actions] Roxygen Man Pages Auto Update --- man/init.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/init.Rd b/man/init.Rd index 2bdc348534..e14cda6540 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -119,7 +119,7 @@ app <- init( footer = tags$p("Copyright 2017 - 2023"), extra_server = teal.modules.general::tm_landing_popup( title = "Welcome", - text = "A place for the welcome message or a disclaimer statement.", + text = "A place for a welcome message or a disclaimer statement.", button = "Proceed" ) ) From 66662373c844008ea1d8ae732357c004b45422ee Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 13 Oct 2023 14:10:29 +0200 Subject: [PATCH 11/26] update examples --- R/init.R | 4 ++-- man/init.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/init.R b/R/init.R index 346dda1b70..4c46a00c0e 100644 --- a/R/init.R +++ b/R/init.R @@ -102,10 +102,10 @@ #' ), #' header = tags$h1("Sample App"), #' footer = tags$p("Copyright 2017 - 2023"), -#' extra_server = teal.modules.general::tm_landing_popup( +#' extra_server = teal.modules.general::landing_popup( #' title = "Welcome", #' text = "A place for a welcome message or a disclaimer statement.", -#' button = "Proceed" +#' button = modalButton("Proceed") #' ) #' ) #' if (interactive()) { diff --git a/man/init.Rd b/man/init.Rd index e14cda6540..0d4df7a818 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -117,10 +117,10 @@ app <- init( ), header = tags$h1("Sample App"), footer = tags$p("Copyright 2017 - 2023"), - extra_server = teal.modules.general::tm_landing_popup( + extra_server = teal.modules.general::landing_popup( title = "Welcome", text = "A place for a welcome message or a disclaimer statement.", - button = "Proceed" + button = modalButton("Proceed") ) ) if (interactive()) { From eb3bffa917726ad27d9606743f3f5ee2f0c0b729 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 16 Oct 2023 11:44:53 +0200 Subject: [PATCH 12/26] add teal.modules.general to Suggests --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 95328de84b..7085e9141b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,6 +56,7 @@ Suggests: rmarkdown, shinyvalidate, teal.code (>= 0.3.0.9009), + teal.modules.general, testthat (>= 3.1.5), withr, yaml From 0bd57c64e807ec4bc6bc59197ab0586d56202dab Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 16 Oct 2023 14:00:32 +0200 Subject: [PATCH 13/26] remove extra_server parameter --- DESCRIPTION | 1 - R/init.R | 12 ++---------- man/init.Rd | 12 ++---------- 3 files changed, 4 insertions(+), 21 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7085e9141b..95328de84b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,7 +56,6 @@ Suggests: rmarkdown, shinyvalidate, teal.code (>= 0.3.0.9009), - teal.modules.general, testthat (>= 3.1.5), withr, yaml diff --git a/R/init.R b/R/init.R index 4c46a00c0e..4fdb147951 100644 --- a/R/init.R +++ b/R/init.R @@ -45,7 +45,6 @@ #' the server function must be called with [shiny::moduleServer()]; #' See the vignette for an example. However, [ui_teal_with_splash()] #' is then preferred to this function. -#' @param extra_server A list of elements passed to `shiny::server`. #' #' @return named list with `server` and `ui` function #' @@ -101,12 +100,7 @@ #' ) #' ), #' header = tags$h1("Sample App"), -#' footer = tags$p("Copyright 2017 - 2023"), -#' extra_server = teal.modules.general::landing_popup( -#' title = "Welcome", -#' text = "A place for a welcome message or a disclaimer statement.", -#' button = modalButton("Proceed") -#' ) +#' footer = tags$p("Copyright 2017 - 2023") #' ) #' if (interactive()) { #' shinyApp(app$ui, app$server) @@ -118,8 +112,7 @@ init <- function(data, filter = teal_slices(), header = tags$p(), footer = tags$p(), - id = character(0), - extra_server = NULL) { + id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") data <- teal.data::to_relational_data(data = data) @@ -219,7 +212,6 @@ init <- function(data, res <- list( ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { - extra_server # copy object so that load won't be shared between the session data <- data$copy(deep = TRUE) filter <- deep_copy_filter(filter) diff --git a/man/init.Rd b/man/init.Rd index 0d4df7a818..234f60697f 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -11,8 +11,7 @@ init( filter = teal_slices(), header = tags$p(), footer = tags$p(), - id = character(0), - extra_server = NULL + id = character(0) ) } \arguments{ @@ -53,8 +52,6 @@ module id to embed it, if provided, the server function must be called with \code{\link[shiny:moduleServer]{shiny::moduleServer()}}; See the vignette for an example. However, \code{\link[=ui_teal_with_splash]{ui_teal_with_splash()}} is then preferred to this function.} - -\item{extra_server}{A list of elements passed to \code{shiny::server}.} } \value{ named list with \code{server} and \code{ui} function @@ -116,12 +113,7 @@ app <- init( ) ), header = tags$h1("Sample App"), - footer = tags$p("Copyright 2017 - 2023"), - extra_server = teal.modules.general::landing_popup( - title = "Welcome", - text = "A place for a welcome message or a disclaimer statement.", - button = modalButton("Proceed") - ) + footer = tags$p("Copyright 2017 - 2023") ) if (interactive()) { shinyApp(app$ui, app$server) From b86ccff9fdc993fce228c032da87d2c6debb286e Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 16 Oct 2023 16:43:17 +0200 Subject: [PATCH 14/26] Remove module labelled "Landing Popup" from modules list and pass it to server directly --- R/init.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/R/init.R b/R/init.R index 4fdb147951..452fa51291 100644 --- a/R/init.R +++ b/R/init.R @@ -46,6 +46,8 @@ #' See the vignette for an example. However, [ui_teal_with_splash()] #' is then preferred to this function. #' +#' @note If you use a module labelled `"Landing Popup"` `teal` will not create a tab for this module. +#' #' @return named list with `server` and `ui` function #' #' @export @@ -205,6 +207,20 @@ init <- function(data, } } + # In case of a "Landing Popup", do not create a module for it. Just extract the module and use directly in server. + # Assuming "Landing Popup" is not used in a nested module. + labels <- module_labels(modules) + lp_cond <- "Landing_Popup" %in% names(labels) + + if (!lp_cond && "Landing Page" %in% unlist(labels)) { + stop("Please do not use a module labelled 'Landing Popup' within a nested module.") + } else if (lp_cond) { + landing_popup <- modules$children[which(lp_cond)] + modules$children <- modules$children[-which(lp_cond)] + } else { + landing_popup <- NULL + } + # Note regarding case `id = character(0)`: # rather than using `callModule` and creating a submodule of this module, we directly modify # the `ui` and `server` with `id = character(0)` and calling the server function directly @@ -212,6 +228,7 @@ init <- function(data, res <- list( ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { + landing_popup # copy object so that load won't be shared between the session data <- data$copy(deep = TRUE) filter <- deep_copy_filter(filter) From 4f01d3170eb3f8d69beb3e4e0fffa1a494ec6239 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Mon, 16 Oct 2023 14:49:09 +0000 Subject: [PATCH 15/26] [skip actions] Roxygen Man Pages Auto Update --- man/init.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/init.Rd b/man/init.Rd index 234f60697f..a60f6c1735 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -65,6 +65,9 @@ teal app that is composed out of teal modules. This is a wrapper function around the \code{module_teal.R} functions. Unless you are an end-user, don't use this function, but instead this module. } +\note{ +If you use a module labelled \code{"Landing Popup"} \code{teal} will not create a tab for this module. +} \examples{ new_iris <- transform(iris, id = seq_len(nrow(iris))) new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars))) From 5d1841788a6ef94bc093ab3ebfbb9bd456836b43 Mon Sep 17 00:00:00 2001 From: m7pr Date: Tue, 17 Oct 2023 17:40:21 +0200 Subject: [PATCH 16/26] fix teal::init server usage of landing popup thanks to @chlebowa ideas --- R/init.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/init.R b/R/init.R index 452fa51291..67faa4e1bd 100644 --- a/R/init.R +++ b/R/init.R @@ -228,7 +228,9 @@ init <- function(data, res <- list( ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { - landing_popup + if (length(landing_popup) > 0L) { + do.call(landing_popup[[1]]$server, c(list(id = "landing_module_shiny_id"), landing_popup[[1]]$server_args)) + } # copy object so that load won't be shared between the session data <- data$copy(deep = TRUE) filter <- deep_copy_filter(filter) From a0e2ce24cf892bbbcb6f6f5c6c126820c98d6c64 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Date: Mon, 23 Oct 2023 12:37:42 +0200 Subject: [PATCH 17/26] 812 landing popup mod@812 landing popup@main (#936) some suggestions --------- Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: m7pr Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> --- R/init.R | 45 +++++++++++++++++++++++++++++---------------- 1 file changed, 29 insertions(+), 16 deletions(-) diff --git a/R/init.R b/R/init.R index c6587f0c8e..8f609737ea 100644 --- a/R/init.R +++ b/R/init.R @@ -138,6 +138,32 @@ init <- function(data, modules <- do.call(teal::modules, modules) } + # move these two functions to utils.R or modules.R + # maybe combine into one function? + extract_landing <- function(modules) { + if (inherits(modules, "landing_module")) { + modules + } else if (inherits(modules, "teal_module")) { + NULL + } else if (inherits(modules, "teal_modules")) { + Filter(function(x) length(x) > 0L, lapply(modules$children, extract_landing)) + } + } + drop_landing <- function(modules) { + if (inherits(modules, "landing_module")) { + NULL + } else if (inherits(modules, "teal_module")) { + modules + } else if (inherits(modules, "teal_modules")) { + do.call( + "modules", + c(Filter(function(x) length(x) > 0L, lapply(modules$children, drop_landing)), label = modules$label) + ) + } + } + landing <- extract_landing(modules) + modules <- drop_landing(modules) + # resolve modules datanames datanames <- teal.data::get_dataname(data) join_keys <- data$get_join_keys() @@ -218,20 +244,6 @@ init <- function(data, } } - # In case of a "Landing Popup", do not create a module for it. Just extract the module and use directly in server. - # Assuming "Landing Popup" is not used in a nested module. - labels <- module_labels(modules) - lp_cond <- "Landing_Popup" %in% names(labels) - - if (!lp_cond && "Landing Page" %in% unlist(labels)) { - stop("Please do not use a module labelled 'Landing Popup' within a nested module.") - } else if (lp_cond) { - landing_popup <- modules$children[which(lp_cond)] - modules$children <- modules$children[-which(lp_cond)] - } else { - landing_popup <- NULL - } - # Note regarding case `id = character(0)`: # rather than using `callModule` and creating a submodule of this module, we directly modify # the `ui` and `server` with `id = character(0)` and calling the server function directly @@ -239,8 +251,9 @@ init <- function(data, res <- list( ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { - if (length(landing_popup) > 0L) { - do.call(landing_popup[[1]]$server, c(list(id = "landing_module_shiny_id"), landing_popup[[1]]$server_args)) + if (length(landing) > 0L) { + landing_module <- landing[[1L]] + do.call(landing_module$server, c(list(id = "landing_module_shiny_id"), landing_module$server_args)) } # copy object so that load won't be shared between the session data <- data$copy(deep = TRUE) From 5b3467816f781a7747face41cc01140a88487e5c Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 23 Oct 2023 12:41:39 +0200 Subject: [PATCH 18/26] move extract_landing and drop_landing into modules.R --- R/init.R | 23 ----------------------- R/modules.R | 30 ++++++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 23 deletions(-) diff --git a/R/init.R b/R/init.R index 8f609737ea..030d4f3742 100644 --- a/R/init.R +++ b/R/init.R @@ -138,29 +138,6 @@ init <- function(data, modules <- do.call(teal::modules, modules) } - # move these two functions to utils.R or modules.R - # maybe combine into one function? - extract_landing <- function(modules) { - if (inherits(modules, "landing_module")) { - modules - } else if (inherits(modules, "teal_module")) { - NULL - } else if (inherits(modules, "teal_modules")) { - Filter(function(x) length(x) > 0L, lapply(modules$children, extract_landing)) - } - } - drop_landing <- function(modules) { - if (inherits(modules, "landing_module")) { - NULL - } else if (inherits(modules, "teal_module")) { - modules - } else if (inherits(modules, "teal_modules")) { - do.call( - "modules", - c(Filter(function(x) length(x) > 0L, lapply(modules$children, drop_landing)), label = modules$label) - ) - } - } landing <- extract_landing(modules) modules <- drop_landing(modules) diff --git a/R/modules.R b/R/modules.R index 2cc426b7fe..7bf6412379 100644 --- a/R/modules.R +++ b/R/modules.R @@ -103,6 +103,36 @@ append_module <- function(modules, module) { modules } +#' Extract a `landing_module` from list of `modules` +#' @param modules `teal_modules` +#' @keywords internal +#' @return `landing_module` +extract_landing <- function(modules) { + if (inherits(modules, "landing_module")) { + modules + } else if (inherits(modules, "teal_module")) { + NULL + } else if (inherits(modules, "teal_modules")) { + Filter(function(x) length(x) > 0L, lapply(modules$children, extract_landing)) + } +} +#' Remove a `landing_module` from list of `modules` +#' @param modules `teal_modules` +#' @keywords internal +#' @return `teal_modules` +drop_landing <- function(modules) { + if (inherits(modules, "landing_module")) { + NULL + } else if (inherits(modules, "teal_module")) { + modules + } else if (inherits(modules, "teal_modules")) { + do.call( + "modules", + c(Filter(function(x) length(x) > 0L, lapply(modules$children, drop_landing)), label = modules$label) + ) + } +} + #' Does the object make use of the `arg` #' #' @param modules (`teal_module` or `teal_modules`) object From 54482060f14f682668b3b2229d48a57dd5bc43bd Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Mon, 23 Oct 2023 10:46:13 +0000 Subject: [PATCH 19/26] [skip actions] Roxygen Man Pages Auto Update --- man/drop_landing.Rd | 18 ++++++++++++++++++ man/extract_landing.Rd | 18 ++++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 man/drop_landing.Rd create mode 100644 man/extract_landing.Rd diff --git a/man/drop_landing.Rd b/man/drop_landing.Rd new file mode 100644 index 0000000000..a38d91c6c4 --- /dev/null +++ b/man/drop_landing.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{drop_landing} +\alias{drop_landing} +\title{Remove a \code{landing_module} from list of \code{modules}} +\usage{ +drop_landing(modules) +} +\arguments{ +\item{modules}{\code{teal_modules}} +} +\value{ +\code{teal_modules} +} +\description{ +Remove a \code{landing_module} from list of \code{modules} +} +\keyword{internal} diff --git a/man/extract_landing.Rd b/man/extract_landing.Rd new file mode 100644 index 0000000000..0e1bbee714 --- /dev/null +++ b/man/extract_landing.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{extract_landing} +\alias{extract_landing} +\title{Extract a \code{landing_module} from list of \code{modules}} +\usage{ +extract_landing(modules) +} +\arguments{ +\item{modules}{\code{teal_modules}} +} +\value{ +\code{landing_module} +} +\description{ +Extract a \code{landing_module} from list of \code{modules} +} +\keyword{internal} From ec595bc551f553e2924beaf742593b507def53c9 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 23 Oct 2023 12:52:30 +0200 Subject: [PATCH 20/26] extend module - change `landing_module` class to `teal_module_landing` - specify new parameter type where you can specify one of 3 classes for final module --- NEWS.md | 2 ++ R/init.R | 1 + R/modules.R | 19 ++++++++++++------- man/drop_landing.Rd | 18 ++++++++++++++++++ man/extract_landing.Rd | 18 ++++++++++++++++++ 5 files changed, 51 insertions(+), 7 deletions(-) create mode 100644 man/drop_landing.Rd create mode 100644 man/extract_landing.Rd diff --git a/NEWS.md b/NEWS.md index 645ed4a170..f4f18f9deb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,8 @@ * Added internal functions for storing and restoring of `teal_slices` objects. * Filter state snapshots can now be uploaded from file. See `?snapshot`. * Added argument to `teal_slices` and made modifications to `init` to enable tagging `teal_slices` with an app id to safely upload snapshots from disk. +* Modules created with `module()` function are divided into specific classes: `"teal_module"`, `"teal_module_reporter"` +and `"teal_module_landing"`. Modules of class `"teal_module_landing"` will not be wrapped into tabs in the `teal` apps. # teal 0.14.0 diff --git a/R/init.R b/R/init.R index 030d4f3742..c9f7b0dbc9 100644 --- a/R/init.R +++ b/R/init.R @@ -139,6 +139,7 @@ init <- function(data, } landing <- extract_landing(modules) + if (length(landing) > 1L) stop("teal only supports apps with one module of `tm_landing_poup` class.") modules <- drop_landing(modules) # resolve modules datanames diff --git a/R/modules.R b/R/modules.R index 7bf6412379..6d03488aaa 100644 --- a/R/modules.R +++ b/R/modules.R @@ -103,12 +103,12 @@ append_module <- function(modules, module) { modules } -#' Extract a `landing_module` from list of `modules` +#' Extract a `teal_module_landing` from list of `modules` #' @param modules `teal_modules` #' @keywords internal -#' @return `landing_module` +#' @return `teal_module_landing` extract_landing <- function(modules) { - if (inherits(modules, "landing_module")) { + if (inherits(modules, "teal_module_landing")) { modules } else if (inherits(modules, "teal_module")) { NULL @@ -116,12 +116,12 @@ extract_landing <- function(modules) { Filter(function(x) length(x) > 0L, lapply(modules$children, extract_landing)) } } -#' Remove a `landing_module` from list of `modules` +#' Remove a `teal_module_landing` from list of `modules` #' @param modules `teal_modules` #' @keywords internal #' @return `teal_modules` drop_landing <- function(modules) { - if (inherits(modules, "landing_module")) { + if (inherits(modules, "teal_module_landing")) { NULL } else if (inherits(modules, "teal_module")) { modules @@ -185,6 +185,9 @@ is_arg_used <- function(modules, arg) { #' `server` function. #' @param ui_args (named `list`) with additional arguments passed on to the #' `ui` function. +#' @param type (`character(1)`) The type of the class assigned to the final module. One of `"teal_module"`, +#' `"teal_module_reporter"` or `"teal_module_landing"`. Modules of class `"teal_module_landing"` will not be wrapped +#' into tabs in the `teal` application. #' #' @return object of class `teal_module`. #' @export @@ -224,13 +227,15 @@ module <- function(label = "module", filters, datanames = "all", server_args = NULL, - ui_args = NULL) { + ui_args = NULL, + type = c("teal_module", "teal_module_reporter", "teal_module_landing")) { checkmate::assert_string(label) checkmate::assert_function(server) checkmate::assert_function(ui) checkmate::assert_character(datanames, min.len = 1, null.ok = TRUE, any.missing = FALSE) checkmate::assert_list(server_args, null.ok = TRUE, names = "named") checkmate::assert_list(ui_args, null.ok = TRUE, names = "named") + type <- match.arg(type) if (!missing(filters)) { checkmate::assert_character(filters, min.len = 1, null.ok = TRUE, any.missing = FALSE) @@ -314,7 +319,7 @@ module <- function(label = "module", server = server, ui = ui, datanames = datanames, server_args = server_args, ui_args = ui_args ), - class = "teal_module" + class = type ) } diff --git a/man/drop_landing.Rd b/man/drop_landing.Rd new file mode 100644 index 0000000000..a38d91c6c4 --- /dev/null +++ b/man/drop_landing.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{drop_landing} +\alias{drop_landing} +\title{Remove a \code{landing_module} from list of \code{modules}} +\usage{ +drop_landing(modules) +} +\arguments{ +\item{modules}{\code{teal_modules}} +} +\value{ +\code{teal_modules} +} +\description{ +Remove a \code{landing_module} from list of \code{modules} +} +\keyword{internal} diff --git a/man/extract_landing.Rd b/man/extract_landing.Rd new file mode 100644 index 0000000000..0e1bbee714 --- /dev/null +++ b/man/extract_landing.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{extract_landing} +\alias{extract_landing} +\title{Extract a \code{landing_module} from list of \code{modules}} +\usage{ +extract_landing(modules) +} +\arguments{ +\item{modules}{\code{teal_modules}} +} +\value{ +\code{landing_module} +} +\description{ +Extract a \code{landing_module} from list of \code{modules} +} +\keyword{internal} From b03ddc109068c936e889acae2b8abb4d0c5cdee6 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 23 Oct 2023 12:52:53 +0200 Subject: [PATCH 21/26] rebuild manual pages --- man/drop_landing.Rd | 4 ++-- man/extract_landing.Rd | 6 +++--- man/module.Rd | 7 ++++++- 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/man/drop_landing.Rd b/man/drop_landing.Rd index a38d91c6c4..7e46431fe5 100644 --- a/man/drop_landing.Rd +++ b/man/drop_landing.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/modules.R \name{drop_landing} \alias{drop_landing} -\title{Remove a \code{landing_module} from list of \code{modules}} +\title{Remove a \code{teal_module_landing} from list of \code{modules}} \usage{ drop_landing(modules) } @@ -13,6 +13,6 @@ drop_landing(modules) \code{teal_modules} } \description{ -Remove a \code{landing_module} from list of \code{modules} +Remove a \code{teal_module_landing} from list of \code{modules} } \keyword{internal} diff --git a/man/extract_landing.Rd b/man/extract_landing.Rd index 0e1bbee714..71a78ede66 100644 --- a/man/extract_landing.Rd +++ b/man/extract_landing.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/modules.R \name{extract_landing} \alias{extract_landing} -\title{Extract a \code{landing_module} from list of \code{modules}} +\title{Extract a \code{teal_module_landing} from list of \code{modules}} \usage{ extract_landing(modules) } @@ -10,9 +10,9 @@ extract_landing(modules) \item{modules}{\code{teal_modules}} } \value{ -\code{landing_module} +\code{teal_module_landing} } \description{ -Extract a \code{landing_module} from list of \code{modules} +Extract a \code{teal_module_landing} from list of \code{modules} } \keyword{internal} diff --git a/man/module.Rd b/man/module.Rd index d7267630cd..5e037668b0 100644 --- a/man/module.Rd +++ b/man/module.Rd @@ -20,7 +20,8 @@ module( filters, datanames = "all", server_args = NULL, - ui_args = NULL + ui_args = NULL, + type = c("teal_module", "teal_module_reporter", "teal_module_landing") ) \method{toString}{teal_module}(x, indent = 0, ...) @@ -64,6 +65,10 @@ a subset of datasets which are appended to the \code{data} argument in \code{ser \item{ui_args}{(named \code{list}) with additional arguments passed on to the \code{ui} function.} +\item{type}{(\code{character(1)}) The type of the class assigned to the final module. One of \code{"teal_module"}, +\code{"teal_module_reporter"} or \code{"teal_module_landing"}. Modules of class \code{"teal_module_landing"} will not be wrapped +into tabs in the \code{teal} application.} + \item{x}{\code{teal_module}} \item{indent}{(\code{integer}) indent level; From bdc373b4bf78d1bd41db0f9545ac104ae96b4559 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 23 Oct 2023 12:54:12 +0200 Subject: [PATCH 22/26] Empty-Commit From 464c42c5fc8d1590aafad28e8586b7dbe9e1de4f Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 23 Oct 2023 13:17:09 +0200 Subject: [PATCH 23/26] extend assertion of class of elements passed to modules() --- R/modules.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/modules.R b/R/modules.R index 6d03488aaa..3064937c26 100644 --- a/R/modules.R +++ b/R/modules.R @@ -75,7 +75,7 @@ modules <- function(..., label = "root") { ) } - checkmate::assert_list(submodules, min.len = 1, any.missing = FALSE, types = c("teal_module", "teal_modules")) + checkmate::assert_list(submodules, min.len = 1, any.missing = FALSE, types = c("teal_module", "teal_module_reporter", "teal_module_landing", "teal_modules")) # name them so we can more easily access the children # beware however that the label of the submodules should not be changed as it must be kept synced labels <- vapply(submodules, function(submodule) submodule$label, character(1)) From 11955bc32d7b9271ef3b0fd47166037be09cca7d Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 23 Oct 2023 13:45:04 +0200 Subject: [PATCH 24/26] update teal init note --- R/init.R | 3 ++- man/init.Rd | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/init.R b/R/init.R index c9f7b0dbc9..af1bb3d25f 100644 --- a/R/init.R +++ b/R/init.R @@ -46,7 +46,8 @@ #' See the vignette for an example. However, [ui_teal_with_splash()] #' is then preferred to this function. #' -#' @note If you use a module labelled `"Landing Popup"` `teal` will not create a tab for this module. +#' @note If you pass a module of class `"teal_module_landing"` in `modules` parameter, `teal` will not create a tab for +#' this module. #' #' @return named list with `server` and `ui` function #' diff --git a/man/init.Rd b/man/init.Rd index a60f6c1735..a1bfc9e9e6 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -66,7 +66,8 @@ This is a wrapper function around the \code{module_teal.R} functions. Unless you an end-user, don't use this function, but instead this module. } \note{ -If you use a module labelled \code{"Landing Popup"} \code{teal} will not create a tab for this module. +If you pass a module of class \code{"teal_module_landing"} in \code{modules} parameter, \code{teal} will not create a tab for +this module. } \examples{ new_iris <- transform(iris, id = seq_len(nrow(iris))) From 881d88ff42e285947d147d3dbc38dfc9e13e6549 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 23 Oct 2023 13:47:34 +0200 Subject: [PATCH 25/26] typo --- R/init.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/init.R b/R/init.R index af1bb3d25f..d019994f86 100644 --- a/R/init.R +++ b/R/init.R @@ -140,7 +140,7 @@ init <- function(data, } landing <- extract_landing(modules) - if (length(landing) > 1L) stop("teal only supports apps with one module of `tm_landing_poup` class.") + if (length(landing) > 1L) stop("teal only supports apps with one module of `tm_landing_popup` class.") modules <- drop_landing(modules) # resolve modules datanames From 69d5c714cd18f48f87eb22108a0a2c8ad3691236 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 23 Oct 2023 14:04:59 +0200 Subject: [PATCH 26/26] change extract/drop_landing into extract/drop_module with class argument --- R/init.R | 4 ++-- R/module_teal.R | 11 +---------- R/modules.R | 15 ++++++++------- man/{drop_landing.Rd => drop_module.Rd} | 10 +++++----- man/{extract_landing.Rd => extract_module.Rd} | 10 +++++----- 5 files changed, 21 insertions(+), 29 deletions(-) rename man/{drop_landing.Rd => drop_module.Rd} (51%) rename man/{extract_landing.Rd => extract_module.Rd} (51%) diff --git a/R/init.R b/R/init.R index d019994f86..cc71084d4c 100644 --- a/R/init.R +++ b/R/init.R @@ -139,9 +139,9 @@ init <- function(data, modules <- do.call(teal::modules, modules) } - landing <- extract_landing(modules) + landing <- extract_module(modules, "teal_module_landing") if (length(landing) > 1L) stop("teal only supports apps with one module of `tm_landing_popup` class.") - modules <- drop_landing(modules) + modules <- drop_module(modules, "teal_module_landing") # resolve modules datanames datanames <- teal.data::get_dataname(data) diff --git a/R/module_teal.R b/R/module_teal.R index fbce6ed5bd..5f068b483b 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -226,16 +226,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { }) reporter <- teal.reporter::Reporter$new() - is_any_previewer <- function(modules) { - if (inherits(modules, "teal_modules")) { - any(unlist(lapply(modules$children, is_any_previewer), use.names = FALSE)) - } else if (inherits(modules, "teal_module_previewer")) { - TRUE - } else { - FALSE - } - } - if (is_arg_used(modules, "reporter") && !is_any_previewer(modules)) { + if (is_arg_used(modules, "reporter") && length(extract_module(modules, 'teal_module_previewer')) == 0) { modules <- append_module(modules, reporter_previewer_module()) } diff --git a/R/modules.R b/R/modules.R index 3064937c26..4b9e9edeea 100644 --- a/R/modules.R +++ b/R/modules.R @@ -103,25 +103,26 @@ append_module <- function(modules, module) { modules } -#' Extract a `teal_module_landing` from list of `modules` +#' Extract specific class from a list of `modules` #' @param modules `teal_modules` #' @keywords internal #' @return `teal_module_landing` -extract_landing <- function(modules) { - if (inherits(modules, "teal_module_landing")) { +extract_module <- function(modules, class) { + if (inherits(modules, class)) { modules } else if (inherits(modules, "teal_module")) { NULL } else if (inherits(modules, "teal_modules")) { - Filter(function(x) length(x) > 0L, lapply(modules$children, extract_landing)) + Filter(function(x) length(x) > 0L, lapply(modules$children, extract_module)) } } -#' Remove a `teal_module_landing` from list of `modules` + +#' Remove a specific class from list of `modules` #' @param modules `teal_modules` #' @keywords internal #' @return `teal_modules` -drop_landing <- function(modules) { - if (inherits(modules, "teal_module_landing")) { +drop_module <- function(modules, class) { + if (inherits(modules, class)) { NULL } else if (inherits(modules, "teal_module")) { modules diff --git a/man/drop_landing.Rd b/man/drop_module.Rd similarity index 51% rename from man/drop_landing.Rd rename to man/drop_module.Rd index 7e46431fe5..d29d808c4d 100644 --- a/man/drop_landing.Rd +++ b/man/drop_module.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/modules.R -\name{drop_landing} -\alias{drop_landing} -\title{Remove a \code{teal_module_landing} from list of \code{modules}} +\name{drop_module} +\alias{drop_module} +\title{Remove a specific class from list of \code{modules}} \usage{ -drop_landing(modules) +drop_module(modules, class) } \arguments{ \item{modules}{\code{teal_modules}} @@ -13,6 +13,6 @@ drop_landing(modules) \code{teal_modules} } \description{ -Remove a \code{teal_module_landing} from list of \code{modules} +Remove a specific class from list of \code{modules} } \keyword{internal} diff --git a/man/extract_landing.Rd b/man/extract_module.Rd similarity index 51% rename from man/extract_landing.Rd rename to man/extract_module.Rd index 71a78ede66..5c6213a038 100644 --- a/man/extract_landing.Rd +++ b/man/extract_module.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/modules.R -\name{extract_landing} -\alias{extract_landing} -\title{Extract a \code{teal_module_landing} from list of \code{modules}} +\name{extract_module} +\alias{extract_module} +\title{Extract specific class from a list of \code{modules}} \usage{ -extract_landing(modules) +extract_module(modules, class) } \arguments{ \item{modules}{\code{teal_modules}} @@ -13,6 +13,6 @@ extract_landing(modules) \code{teal_module_landing} } \description{ -Extract a \code{teal_module_landing} from list of \code{modules} +Extract specific class from a list of \code{modules} } \keyword{internal}