teal
teal copied to clipboard
insightsengineering
Function to disable download feature
Feature description
When we work in a GxP environment most of the clinical data would be lying on the server and data is not shared between systems or downloaded from the server directly to desktop folders or even download them.
While working on teal module, have observed teal reporter have an option for downloading them to downloads folder directly, which would be against GxP policies. Is there any way to remove or disable them while launching shiny app.
Code of Conduct
- [X] I agree to follow this project's Code of Conduct.
Contribution Guidelines
- [X] I agree to follow this project's Contribution Guidelines.
Security Policy
- [X] I agree to follow this project's Security Policy.
User require to disable or to remove all download buttons in the teal application.
Example app to demonstrate how difficult is to disable buttons in teal app.
library(teal.modules.general)
library(teal.widgets)
data <- teal_data()
data <- within(data, {
library(nestcolor)
ADSL <- rADSL
})
datanames <- c("ADSL")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]
app <- init(
data = data,
modules = modules(
teal.modules.general::tm_a_pca(
"PCA",
dat = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(
data = data[["ADSL"]], c("BMRKR1", "AGE", "EOSDY")
),
selected = c("BMRKR1", "AGE"),
multiple = TRUE
),
filter = NULL
),
ggplot2_args = ggplot2_args(
labs = list(subtitle = "Plot generated by PCA Module")
)
)
)
)
app$ui <- shiny::tagAppendChild(
app$ui,
tags$head(
tags$style(HTML('
.simple_report_button[title="Download"] {
opacity: 0.5;
cursor: not-allowed;
color: #ccc;
}
')),
tags$script(HTML('
// this script triggers to late as buttons are inserted by shiny server
$(document).on("shiny:connected", function() {
var buttons = document.querySelectorAll(".simple_report_button");
console.log(buttons);
buttons.forEach(function(b) {
b.disabled = true;
})
});
'))
)
)
shinyApp(app$ui, app$server)
Included css rules don't disable buttons, they are just changing style of the button.
To disable button "for real" we need to modify html element directly with js script. Problem roots in the fact that initialization of the ui is delayed and inserted by server. There might be better event than "shiny:connected" to trigger script when every module is initialized.
Possible to use css selector with display: none. Seems to solve the problem. Ignore previous comment
library(teal.modules.general)
library(teal.widgets)
data <- teal_data()
data <- within(data, {
library(nestcolor)
ADSL <- rADSL
})
datanames <- c("ADSL")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]
app <- init(
data = data,
modules = modules(
teal.modules.general::tm_a_pca(
"PCA",
dat = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(
data = data[["ADSL"]], c("BMRKR1", "AGE", "EOSDY")
),
selected = c("BMRKR1", "AGE"),
multiple = TRUE
),
filter = NULL
),
ggplot2_args = ggplot2_args(
labs = list(subtitle = "Plot generated by PCA Module")
)
)
)
)
app$ui <- shiny::tagAppendChild(
app$ui,
tags$head(
tags$style(HTML('
.simple_report_button[title="Download"] {
display:none
}
a[id$="download_data_prev"] {
display:none
}
button[id$="downbutton-downl"] {
display:none
}
'))
)
)
shinyApp(app$ui, app$server)
Another possibility: Use a teal global option that would prevent the Reporter feature from being enabled (as a tab and on encodings)
The caveat is that this would be applied globally, so the user wouldn't have access to any reports.
Proof-of-concept (with changes to `{teal}` and `{teal.reporter}`)
note: it might be safer to use !isTRUE instead of isFALSE for this feature to be resilient and only kick in if the option is explicitly TRUE
{teal.reporter}: prevent encodings from showing "Reporter"
diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R
index d2da97c..8d272e2 100644
--- a/R/SimpleReporter.R
+++ b/R/SimpleReporter.R
@@ -37,6 +37,8 @@ NULL
#' @export
simple_reporter_ui <- function(id) {
ns <- shiny::NS(id)
+ if (isTRUE(getOption("teal.disable_reporter"))) return(NULL)
shiny::tagList(
shiny::singleton(
shiny::tags$head(shiny::includeCSS(system.file("css/custom.css", package = "teal.reporter")))
{teal}
diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R
index 2648c9751..2be53596c 100644
--- a/R/module_nested_tabs.R
+++ b/R/module_nested_tabs.R
@@ -198,7 +198,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
# collect arguments to run teal_module
args <- c(list(id = "module"), modules$server_args)
- if (is_arg_used(modules$server, "reporter")) {
+ if (is_arg_used(modules$server, "reporter") && isFALSE(getOption("teal.disable_reporter"))) {
args <- c(args, list(reporter = reporter))
}
diff --git a/R/module_teal.R b/R/module_teal.R
index b7d11cc54..775358860 100644
--- a/R/module_teal.R
+++ b/R/module_teal.R
@@ -153,7 +153,9 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) {
)
reporter <- teal.reporter::Reporter$new()
- if (is_arg_used(modules, "reporter") && length(extract_module(modules, "teal_module_previewer")) == 0) {
+
+ if (is_arg_used(modules, "reporter") && length(extract_module(modules, "teal_module_previewer")) == 0 &&
+ isFALSE(getOption("teal.disable_reporter"))) {
modules <- append_module(modules, reporter_previewer_module())
}
diff --git a/R/zzz.R b/R/zzz.R
index a85f3f143..09d680caa 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -1,6 +1,6 @@
.onLoad <- function(libname, pkgname) { # nolint
# adapted from https://github.com/r-lib/devtools/blob/master/R/zzz.R
- teal_default_options <- list(teal.show_js_log = FALSE)
+ teal_default_options <- list(teal.show_js_log = FALSE, teal.disable_reporter = FALSE)
op <- options()
toset <- !(names(teal_default_options) %in% names(op))
edit: This strategy could also be applied only the download button.
@averissimo yes @pawelru already suggested an option. Please note that issue refers only to "download" button, not to the whole reporter. Anyway, option to hide reporter is also needed. I think this needs "strategic" decision about options structure etc.
IMO it is easier and more robust to clean html classes and allow to use JS to hide elements than to have options to control the UI. Having clear class/id structure will also be beneficial for testing
Possible to disable download buttons by including simple js call
options(
teal.log_level = "TRACE",
teal.show_js_log = TRUE,
# teal.bs_theme = bslib::bs_theme(version = 5),
shiny.bookmarkStore = "server"
)
# pkgload::load_all("teal.data")
pkgload::load_all("teal")
library(teal.modules.general)
data <- teal_data_module(
once = FALSE,
ui = function(id) {
ns <- NS(id)
tagList(
numericInput(ns("obs"), "Number of observations to show", 1000),
actionButton(ns("submit"), label = "Submit")
)
},
server = function(id, ...) {
moduleServer(id, function(input, output, session) {
logger::log_trace("example_module_transform2 initializing.")
eventReactive(input$submit, {
data <- teal_data() |>
within(
{
logger::log_trace("Loading data")
ADSL <- head(teal.data::rADSL, n = n)
ADTTE <- teal.data::rADTTE
aaa <- iris
CO2 <- CO2
factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
CO2[factors] <- lapply(CO2[factors], as.character)
},
n = as.numeric(input$obs)
)
join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]
teal.data::datanames(data) <- c("CO2", "ADTTE", "aaa", "ADSL")
data
})
})
}
)
app <- init(
data = data,
modules = modules(
tm_g_association(
ref = data_extract_spec(
dataname = "ADSL",
select = select_spec(
label = "Select variable:",
choices = variable_choices(
"ADSL",
c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2")
),
selected = "RACE",
fixed = FALSE
)
),
vars = data_extract_spec(
dataname = "ADSL",
select = select_spec(
label = "Select variables:",
choices = variable_choices(
"ADSL",
c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2")
),
selected = "BMRKR2",
multiple = TRUE,
fixed = FALSE
)
)
),
tm_g_association(
ref = data_extract_spec(
dataname = "ADSL",
select = select_spec(
label = "Select variable:",
choices = variable_choices(
"ADSL",
c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2")
),
selected = "RACE",
fixed = FALSE
)
),
vars = data_extract_spec(
dataname = "ADSL",
select = select_spec(
label = "Select variables:",
choices = variable_choices(
"ADSL",
c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2")
),
selected = "BMRKR2",
multiple = TRUE,
fixed = FALSE
)
)
)
),
header = tags$p(tags$script("
$(document).ready(function() {
var elements = document.querySelectorAll(\".single_report_button,button[id$='download_button']\");
elements.forEach(function(element) {
element.style.display = 'none';
});
})
"))
)
runApp(app)