From 9ee3c22a1c7b02d9f1008d0161c6c26dee915bc9 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 12:58:49 +0200 Subject: [PATCH 001/117] create functions to grab and restore app state --- R/module_state_manager.R | 110 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 110 insertions(+) create mode 100644 R/module_state_manager.R diff --git a/R/module_state_manager.R b/R/module_state_manager.R new file mode 100644 index 0000000000..5204dd7f07 --- /dev/null +++ b/R/module_state_manager.R @@ -0,0 +1,110 @@ +app_state_grab <- function() { + session <- .get_session() + input <- session$input + + ans <- lapply(names(input), function(i) { + list(id = i, value = as.vector(input[[i]])) + }) + + excluded_ids <- paste(c("filter_panel", "filter_manager", "snapshot_manager", "state_manager"), collapse = "|") + included_ids <- grep(excluded_ids, vapply(ans, `[[`, character(1L), "id"), value = TRUE, invert = TRUE) + ans <- Filter(function(x) x[["id"]] %in% included_ids, ans) + + class(ans) <- c("teal_grab", class(ans)) + + ans +} + +app_state_store <- function(grab, file) { + checkmate::assert_class(grab, "teal_grab") + checkmate::assert_path_for_output(file, overwrite = TRUE, extension = "json") + + jsonlite::write_json(jsonlite::serializeJSON(grab, pretty = TRUE), file) + invisible(NULL) +} + +app_state_restore <- function(grab, file) { + if ((missing(grab) && missing(file)) || (!missing(grab) && !missing(file))) { + stop("specify either \"grab\" or \"file\"") + } + if (!missing(grab)) { + checkmate::assert_class(grab, "teal_grab") + } + if (!missing(file)) { + checkmate::assert_file_exists(file, access = "r") + } + + app_state <- + if (missing(file)) { + grab + } else if (missing(grab)) { + jsonlite::unserializeJSON(jsonlite::read_json(file)[[1L]]) + } + + session <- .get_session() + input <- session$input + + # validate saved input state + checkmate::assert_subset(vapply(app_state, `[[`, character(1L), "id"), choices = names(input)) + + lapply(app_state, function(i) { + session$sendInputMessage(inputId = i$id, message = list(value = i$value)) + }) + + invisible(NULL) +} + + +setdiff_teal_grab <- function(x, y) { + ans <- setdiff(x, y) + class(ans) <- c("teal_grab", class(ans)) + if (length(ans)) { + ans + } +} + + +format.teal_grab <- function(x) { + all_ids <- vapply(x, `[[`, character(1), "id") + all_values <- vapply(x, function(xx) toString(xx[["value"]]), character(1L)) + + contents <- if (length(all_ids) + length(all_values) > 0L) { + all_values_trimmed <- lapply(all_values, function(x) { + if (nchar(x) > 40) { + paste(substr(x, 1, 36), "...") + } else { + x + } + }) + longest_id <- max(nchar(all_ids)) + longest_value <- max(nchar(all_values_trimmed)) + sprintf(sprintf("%%0%ds : %%0%ds", longest_id + 2L, longest_value), all_ids, all_values_trimmed) + } else { + " no inputs" + } + + paste( + c( + "teal_grab:", + contents, + "" + ), + collapse = "\n" + ) +} + + +print.teal_grab <- function(x, ...) { + cat(format(x, ...)) +} + + +.get_session <- function() { + local_session <- shiny::getDefaultReactiveDomain() + app_session <- .subset2(local_session, "parent") + if (is.null(app_session)) { + local_session + } else { + app_session + } +} From 4278015f4d9c20f40aff3fad61b7742bd001fd84 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 12:59:35 +0200 Subject: [PATCH 002/117] add state manager module --- R/module_state_manager.R | 199 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 199 insertions(+) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 5204dd7f07..47a8455c77 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -1,3 +1,180 @@ +#' App state management. +#' +#' Capture and restore the global (app) input state. +#' +#' This is a work in progress. +#' +#' @param id (`character(1)`) `shiny` module id +#' +#' @return Nothing is returned. +#' +#' @name state_manager_module +#' @aliases grab grab_manager state_manager +#' +#' @author Aleksander Chlebowski +#' +#' @seealso [`app_state_grab`], [`app_state_store`], [`app_state_restore`] +#' +#' @rdname state_manager_module +#' @keywords internal +#' +state_manager_ui <- function(id) { + ns <- NS(id) + div( + class = "snapshot_manager_content", + div( + class = "snapshot_table_row", + span(tags$b("State manager")), + actionLink(ns("grab_add"), label = NULL, icon = icon("camera"), title = "grab input state"), + actionLink(ns("grab_reset"), label = NULL, icon = icon("undo"), title = "reset initial state"), + NULL + ), + uiOutput(ns("grab_list")) + ) +} + +#' @rdname state_manager_module +#' @keywords internal +#' +state_manager_srv <- function(id) { + checkmate::assert_character(id) + + moduleServer(id, function(input, output, session) { + ns <- session$ns + + # Store initial input states. + grab_history <- reactiveVal({ + list( + "Initial input state" = app_state_grab() + ) + }) + + # Grab current input state - name grab. + observeEvent(input$grab_add, { + showModal( + modalDialog( + textInput(ns("grab_name"), "Name the grab", width = "100%", placeholder = "Meaningful, unique name"), + footer = tagList( + actionButton(ns("grab_name_accept"), "Accept", icon = icon("thumbs-up")), + modalButton(label = "Cancel", icon = icon("thumbs-down")) + ), + size = "s" + ) + ) + }) + # Grab current input state - store grab. + observeEvent(input$grab_name_accept, { + grab_name <- trimws(input$grab_name) + if (identical(grab_name, "")) { + showNotification( + "Please name the grab.", + type = "message" + ) + updateTextInput(inputId = "grab_name", value = "", placeholder = "Meaningful, unique name") + } else if (is.element(make.names(grab_name), make.names(names(grab_history())))) { + showNotification( + "This name is in conflict with other grab names. Please choose a different one.", + type = "message" + ) + updateTextInput(inputId = "grab_name", value = , placeholder = "Meaningful, unique name") + } else { + grab <- app_state_grab() + grab_update <- c(grab_history(), list(grab)) + names(grab_update)[length(grab_update)] <- grab_name + grab_history(grab_update) + removeModal() + # Reopen filter manager modal by clicking button in the main application. + shinyjs::click(id = "teal-main_ui-filter_manager-show", asis = TRUE) + } + }) + + # Restore initial input state. + observeEvent(input$grab_reset, { + s <- "Initial input state" + ### Begin restore procedure. ### + grab <- grab_history()[[s]] + app_state_restore(grab) + removeModal() + ### End restore procedure. ### + }) + + # Create UI elements and server logic for the grab table. + # Observers must be tracked to avoid duplication and excess reactivity. + # Remaining elements are tracked likewise for consistency and a slight speed margin. + observers <- reactiveValues() + handlers <- reactiveValues() + divs <- reactiveValues() + + observeEvent(grab_history(), { + lapply(names(grab_history())[-1L], function(s) { + id_pickme <- sprintf("pickme_%s", make.names(s)) + id_saveme <- sprintf("saveme_%s", make.names(s)) + id_rowme <- sprintf("rowme_%s", make.names(s)) + + # Observer for restoring grab. + if (!is.element(id_pickme, names(observers))) { + observers[[id_pickme]] <- observeEvent(input[[id_pickme]], { + ### Begin restore procedure. ### + grab <- grab_history()[[s]] + app_state_restore(grab) + removeModal() + ### End restore procedure. ### + }) + } + # Create handler for downloading grab. + if (!is.element(id_saveme, names(handlers))) { + output[[id_saveme]] <- downloadHandler( + filename = function() { + sprintf("teal_inputs_%s_%s.json", s, Sys.Date()) + }, + content = function(file) { + app_state_store(grab = grab_history()[[s]], file = file) + } + ) + handlers[[id_saveme]] <- id_saveme + } + # Create a row for the grab table. + if (!is.element(id_rowme, names(divs))) { + divs[[id_rowme]] <- div( + class = "snapshot_table_row", + span(h5(s)), + actionLink(inputId = ns(id_pickme), label = icon("circle-check"), title = "select"), + downloadLink(outputId = ns(id_saveme), label = icon("save"), title = "save to file") + ) + } + }) + }) + + # Create table to display list of grabs and their actions. + output$grab_list <- renderUI({ + rows <- lapply(rev(reactiveValuesToList(divs)), function(d) d) + if (length(rows) == 0L) { + div( + class = "snapshot_manager_placeholder", + "Input states will appear here." + ) + } else { + rows + } + }) + + + }) +} + + + + +# utility functions ---- + +#' Grab selection state (value) of all input items in the app. +#' +#' @return +#' Object of class `teal_grab`, which is a list of lists, +#' each of which has two elements, one named "id" and the other "value". +#' @keywords internal +#' @seealso [`app_state_store`], [`app_state_restore`], [`state_manager_module`] +#' app_state_grab <- function() { session <- .get_session() input <- session$input @@ -15,6 +192,15 @@ app_state_grab <- function() { ans } + +#' Save input grab to json file. +#' +#' @param grab `teal_grab` +#' @param file `path` to save the input states to; must be a .json file; will be overwritten +#' @return Returns `NULL` invisibly. +#' @keywords internal +#' @seealso [`app_state_grab`], [`app_state_restore`], [`state_manager_module`] +#' app_state_store <- function(grab, file) { checkmate::assert_class(grab, "teal_grab") checkmate::assert_path_for_output(file, overwrite = TRUE, extension = "json") @@ -23,6 +209,15 @@ app_state_store <- function(grab, file) { invisible(NULL) } + +#' Restore state (value) of all input items in the app according to a grab or file. +#' +#' @param grab optional `teal_grab` +#' @param file optional `path` to a .json file +#' @return Returns `NULL` invisibly. +#' @keywords internal +#' @seealso [`app_state_grab`], [`app_state_store`], [`state_manager_module`] +#' app_state_restore <- function(grab, file) { if ((missing(grab) && missing(file)) || (!missing(grab) && !missing(file))) { stop("specify either \"grab\" or \"file\"") @@ -55,6 +250,8 @@ app_state_restore <- function(grab, file) { } +#' @keywords internal +#' setdiff_teal_grab <- function(x, y) { ans <- setdiff(x, y) class(ans) <- c("teal_grab", class(ans)) @@ -64,6 +261,7 @@ setdiff_teal_grab <- function(x, y) { } +#' @export format.teal_grab <- function(x) { all_ids <- vapply(x, `[[`, character(1), "id") all_values <- vapply(x, function(xx) toString(xx[["value"]]), character(1L)) @@ -94,6 +292,7 @@ format.teal_grab <- function(x) { } +#' @export print.teal_grab <- function(x, ...) { cat(format(x, ...)) } From edfd6be035f0924f4f073580eaba16f8c89f1072 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 13:00:03 +0200 Subject: [PATCH 003/117] amend documentation --- DESCRIPTION | 1 + NAMESPACE | 2 ++ man/app_state_grab.Rd | 19 +++++++++++++++++++ man/app_state_restore.Rd | 23 +++++++++++++++++++++++ man/app_state_store.Rd | 23 +++++++++++++++++++++++ man/state_manager_module.Rd | 34 ++++++++++++++++++++++++++++++++++ 6 files changed, 102 insertions(+) create mode 100644 man/app_state_grab.Rd create mode 100644 man/app_state_restore.Rd create mode 100644 man/app_state_store.Rd create mode 100644 man/state_manager_module.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 534c0e15ec..fefa0ae0fa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -75,6 +75,7 @@ Collate: 'module_filter_manager.R' 'module_nested_tabs.R' 'module_snapshot_manager.R' + 'module_state_manager.R' 'module_tabs_with_filters.R' 'module_teal.R' 'module_teal_with_splash.R' diff --git a/NAMESPACE b/NAMESPACE index abcab1ba5a..ce91e050c1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,10 +1,12 @@ # Generated by roxygen2: do not edit by hand +S3method(format,teal_grab) S3method(get_code,tdata) S3method(get_join_keys,default) S3method(get_join_keys,tdata) S3method(get_metadata,default) S3method(get_metadata,tdata) +S3method(print,teal_grab) S3method(print,teal_module) S3method(print,teal_modules) S3method(srv_nested_tabs,default) diff --git a/man/app_state_grab.Rd b/man/app_state_grab.Rd new file mode 100644 index 0000000000..2ec51ad319 --- /dev/null +++ b/man/app_state_grab.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_state_manager.R +\name{app_state_grab} +\alias{app_state_grab} +\title{Grab selection state (value) of all input items in the app.} +\usage{ +app_state_grab() +} +\value{ +Object of class \code{teal_grab}, which is a list of lists, +each of which has two elements, one named "id" and the other "value". +} +\description{ +Grab selection state (value) of all input items in the app. +} +\seealso{ +\code{\link{app_state_store}}, \code{\link{app_state_restore}}, \code{\link{state_manager_module}} +} +\keyword{internal} diff --git a/man/app_state_restore.Rd b/man/app_state_restore.Rd new file mode 100644 index 0000000000..4854c0039b --- /dev/null +++ b/man/app_state_restore.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_state_manager.R +\name{app_state_restore} +\alias{app_state_restore} +\title{Restore state (value) of all input items in the app according to a grab or file.} +\usage{ +app_state_restore(grab, file) +} +\arguments{ +\item{grab}{optional \code{teal_grab}} + +\item{file}{optional \code{path} to a .json file} +} +\value{ +Returns \code{NULL} invisibly. +} +\description{ +Restore state (value) of all input items in the app according to a grab or file. +} +\seealso{ +\code{\link{app_state_grab}}, \code{\link{app_state_store}}, \code{\link{state_manager_module}} +} +\keyword{internal} diff --git a/man/app_state_store.Rd b/man/app_state_store.Rd new file mode 100644 index 0000000000..bfff1f36f9 --- /dev/null +++ b/man/app_state_store.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_state_manager.R +\name{app_state_store} +\alias{app_state_store} +\title{Save input grab to json file.} +\usage{ +app_state_store(grab, file) +} +\arguments{ +\item{grab}{\code{teal_grab}} + +\item{file}{\code{path} to save the input states to; must be a .json file; will be overwritten} +} +\value{ +Returns \code{NULL} invisibly. +} +\description{ +Save input grab to json file. +} +\seealso{ +\code{\link{app_state_grab}}, \code{\link{app_state_restore}}, \code{\link{state_manager_module}} +} +\keyword{internal} diff --git a/man/state_manager_module.Rd b/man/state_manager_module.Rd new file mode 100644 index 0000000000..99d5e56313 --- /dev/null +++ b/man/state_manager_module.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_state_manager.R +\name{state_manager_module} +\alias{state_manager_module} +\alias{state_manager_ui} +\alias{grab} +\alias{grab_manager} +\alias{state_manager} +\alias{state_manager_srv} +\title{App state management.} +\usage{ +state_manager_ui(id) + +state_manager_srv(id) +} +\arguments{ +\item{id}{(\code{character(1)}) \code{shiny} module id} +} +\value{ +Nothing is returned. +} +\description{ +Capture and restore the global (app) input state. +} +\details{ +This is a work in progress. +} +\seealso{ +\code{\link{app_state_grab}}, \code{\link{app_state_store}}, \code{\link{app_state_restore}} +} +\author{ +Aleksander Chlebowski +} +\keyword{internal} From 1b3b5248da525f5ed2d8ecb00caba0388cfa3411 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 13:00:27 +0200 Subject: [PATCH 004/117] insert state manager into filter manager --- R/module_filter_manager.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index d3292f5a3f..31012d50ee 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -80,7 +80,8 @@ filter_manager_ui <- function(id) { div( class = "filter_manager_content", tableOutput(ns("slices_table")), - snapshot_manager_ui(ns("snapshot_manager")) + snapshot_manager_ui(ns("snapshot_manager")), + state_manager_ui(ns("state_manager")) ) } @@ -181,6 +182,8 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Call snapshot manager. snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) + # Call state manager. + state_manager_srv("state_manager") modules_out # returned for testing purpose }) From 1b149e8c3805b420c5f35c8b393978f1c3e2df43 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 13:45:24 +0200 Subject: [PATCH 005/117] rename one funciton --- R/module_state_manager.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 47a8455c77..1bc58b1995 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -176,7 +176,7 @@ state_manager_srv <- function(id) { #' @seealso [`app_state_store`], [`app_state_restore`], [`state_manager_module`] #' app_state_grab <- function() { - session <- .get_session() + session <- get_master_session() input <- session$input ans <- lapply(names(input), function(i) { @@ -236,7 +236,7 @@ app_state_restore <- function(grab, file) { jsonlite::unserializeJSON(jsonlite::read_json(file)[[1L]]) } - session <- .get_session() + session <- get_master_session() input <- session$input # validate saved input state @@ -262,6 +262,7 @@ setdiff_teal_grab <- function(x, y) { #' @export +#' format.teal_grab <- function(x) { all_ids <- vapply(x, `[[`, character(1), "id") all_values <- vapply(x, function(xx) toString(xx[["value"]]), character(1L)) @@ -293,12 +294,14 @@ format.teal_grab <- function(x) { #' @export +#' print.teal_grab <- function(x, ...) { cat(format(x, ...)) } - -.get_session <- function() { +#' @keywords internal +#' +get_master_session <- function() { local_session <- shiny::getDefaultReactiveDomain() app_session <- .subset2(local_session, "parent") if (is.null(app_session)) { From a7405d9ae11c18309f0dd1d771d6d237ae78b8c4 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 18:11:44 +0200 Subject: [PATCH 006/117] omit action buttons from grabs --- R/module_state_manager.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 1bc58b1995..69d87a4566 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -180,8 +180,11 @@ app_state_grab <- function() { input <- session$input ans <- lapply(names(input), function(i) { - list(id = i, value = as.vector(input[[i]])) + if (!inherits(input[[i]], "shinyActionButtonValue")) { + list(id = i, value = as.vector(input[[i]])) + } }) + ans <- Filter(Negate(is.null), ans) excluded_ids <- paste(c("filter_panel", "filter_manager", "snapshot_manager", "state_manager"), collapse = "|") included_ids <- grep(excluded_ids, vapply(ans, `[[`, character(1L), "id"), value = TRUE, invert = TRUE) From 6a0cc29bb5ef8dd4c51c836891ec52b35d8a1965 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 18:12:13 +0200 Subject: [PATCH 007/117] re-click until grab fully reset --- R/module_state_manager.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 69d87a4566..b5d35694f2 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -94,6 +94,9 @@ state_manager_srv <- function(id) { ### Begin restore procedure. ### grab <- grab_history()[[s]] app_state_restore(grab) + if (!is.null(setdiff_teal_grab(grab, app_state_grab()))) { + shinyjs::click("grab_reset") + } removeModal() ### End restore procedure. ### }) @@ -117,6 +120,9 @@ state_manager_srv <- function(id) { ### Begin restore procedure. ### grab <- grab_history()[[s]] app_state_restore(grab) + if (!is.null(setdiff_teal_grab(grab, app_state_grab()))) { + shinyjs::click(id_pickme) + } removeModal() ### End restore procedure. ### }) From 130fbc8c3dee0b8fc65281c1f6c82b84f9b3177d Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 18:51:30 +0200 Subject: [PATCH 008/117] encapsulate creating grabs --- R/module_state_manager.R | 52 +++++++++++++++++++++++++++------------- 1 file changed, 35 insertions(+), 17 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index b5d35694f2..0471189178 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -175,30 +175,19 @@ state_manager_srv <- function(id) { #' Grab selection state (value) of all input items in the app. #' +#' Find all inputs in the app ans store their state. +#' Buttons are omitted as their values do not (usually) matter +#' and they are virtually impossible to restore. +#' #' @return -#' Object of class `teal_grab`, which is a list of lists, -#' each of which has two elements, one named "id" and the other "value". +#' Object of class `teal_grab`, describing the state of all inputs in the app (except buttons). #' @keywords internal #' @seealso [`app_state_store`], [`app_state_restore`], [`state_manager_module`] #' app_state_grab <- function() { session <- get_master_session() input <- session$input - - ans <- lapply(names(input), function(i) { - if (!inherits(input[[i]], "shinyActionButtonValue")) { - list(id = i, value = as.vector(input[[i]])) - } - }) - ans <- Filter(Negate(is.null), ans) - - excluded_ids <- paste(c("filter_panel", "filter_manager", "snapshot_manager", "state_manager"), collapse = "|") - included_ids <- grep(excluded_ids, vapply(ans, `[[`, character(1L), "id"), value = TRUE, invert = TRUE) - ans <- Filter(function(x) x[["id"]] %in% included_ids, ans) - - class(ans) <- c("teal_grab", class(ans)) - - ans + as.teal_grab(shiny::reactiveValuesToList(input)) } @@ -308,6 +297,35 @@ print.teal_grab <- function(x, ...) { cat(format(x, ...)) } + +#' Convert named list to `teal_grab`. +#' +#' @param x `named list` +#' @return +#' Object of class `teal_grab`, which is a list of lists, +#' each of which has two elements, one named "id" and the other "value". +#' @keywords internal +#' +as.teal_grab <- function(x) { #nolint + checkmate::assert_list(x, names = "named") + + ans <- lapply(names(x), function(i) { + if (!inherits(x[[i]], "shinyActionButtonValue")) { + list(id = i, value = as.vector(x[[i]])) + } + }) + ans <- Filter(Negate(is.null), ans) + + excluded_ids <- paste(c("filter_panel", "filter_manager", "snapshot_manager", "state_manager"), collapse = "|") + included_ids <- grep(excluded_ids, vapply(ans, `[[`, character(1L), "id"), value = TRUE, invert = TRUE) + ans <- Filter(function(x) x[["id"]] %in% included_ids, ans) + + class(ans) <- c("teal_grab", class(ans)) + + ans +} + + #' @keywords internal #' get_master_session <- function() { From 3b963faa48a72097075402339fb546a35c5577a2 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 18:52:18 +0200 Subject: [PATCH 009/117] reorder file --- R/module_state_manager.R | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 0471189178..d41fbdc5a6 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -248,17 +248,6 @@ app_state_restore <- function(grab, file) { } -#' @keywords internal -#' -setdiff_teal_grab <- function(x, y) { - ans <- setdiff(x, y) - class(ans) <- c("teal_grab", class(ans)) - if (length(ans)) { - ans - } -} - - #' @export #' format.teal_grab <- function(x) { @@ -326,6 +315,23 @@ as.teal_grab <- function(x) { #nolint } +#' Compare `teal_grab` objects. +#' +#' Performs a set difference adapted for the `teal_grab` class. Returns NULL if the difference is empty. +#' +#' @param x,y `teal_grab` objects +#' @return `teal_grab` or `NULL`, if the difference is empty. +#' @keywords internal +#' +setdiff_teal_grab <- function(x, y) { + ans <- setdiff(x, y) + class(ans) <- c("teal_grab", class(ans)) + if (length(ans)) { + ans + } +} + + #' @keywords internal #' get_master_session <- function() { From 634b5e8bf6ee7771920e30d30f3bb7a05c6a31a7 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 24 Aug 2023 18:52:52 +0200 Subject: [PATCH 010/117] amend documentation --- man/app_state_grab.Rd | 7 ++++--- man/as.teal_grab.Rd | 19 +++++++++++++++++++ man/setdiff_teal_grab.Rd | 18 ++++++++++++++++++ 3 files changed, 41 insertions(+), 3 deletions(-) create mode 100644 man/as.teal_grab.Rd create mode 100644 man/setdiff_teal_grab.Rd diff --git a/man/app_state_grab.Rd b/man/app_state_grab.Rd index 2ec51ad319..5b031b29a1 100644 --- a/man/app_state_grab.Rd +++ b/man/app_state_grab.Rd @@ -7,11 +7,12 @@ app_state_grab() } \value{ -Object of class \code{teal_grab}, which is a list of lists, -each of which has two elements, one named "id" and the other "value". +Object of class \code{teal_grab}, describing the state of all inputs in the app (except buttons). } \description{ -Grab selection state (value) of all input items in the app. +Find all inputs in the app ans store their state. +Buttons are omitted as their values do not (usually) matter +and they are virtually impossible to restore. } \seealso{ \code{\link{app_state_store}}, \code{\link{app_state_restore}}, \code{\link{state_manager_module}} diff --git a/man/as.teal_grab.Rd b/man/as.teal_grab.Rd new file mode 100644 index 0000000000..8876f6a796 --- /dev/null +++ b/man/as.teal_grab.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_state_manager.R +\name{as.teal_grab} +\alias{as.teal_grab} +\title{Convert named list to \code{teal_grab}.} +\usage{ +as.teal_grab(x) +} +\arguments{ +\item{x}{\verb{named list}} +} +\value{ +Object of class \code{teal_grab}, which is a list of lists, +each of which has two elements, one named "id" and the other "value". +} +\description{ +Convert named list to \code{teal_grab}. +} +\keyword{internal} diff --git a/man/setdiff_teal_grab.Rd b/man/setdiff_teal_grab.Rd new file mode 100644 index 0000000000..d75f4732b7 --- /dev/null +++ b/man/setdiff_teal_grab.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_state_manager.R +\name{setdiff_teal_grab} +\alias{setdiff_teal_grab} +\title{Compare \code{teal_grab} objects.} +\usage{ +setdiff_teal_grab(x, y) +} +\arguments{ +\item{x, y}{\code{teal_grab} objects} +} +\value{ +\code{teal_grab} or \code{NULL}, if the difference is empty. +} +\description{ +Performs a set difference adapted for the \code{teal_grab} class. Returns NULL if the difference is empty. +} +\keyword{internal} From d45232690ff912c707a183794aafde3a962f9533 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 25 Aug 2023 17:09:00 +0200 Subject: [PATCH 011/117] remove dewclassing of grabbed values to keep dates and date times --- R/module_state_manager.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index d41fbdc5a6..141affcf42 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -300,7 +300,7 @@ as.teal_grab <- function(x) { #nolint ans <- lapply(names(x), function(i) { if (!inherits(x[[i]], "shinyActionButtonValue")) { - list(id = i, value = as.vector(x[[i]])) + list(id = i, value = x[[i]]) } }) ans <- Filter(Negate(is.null), ans) From e131b713094b85a6f73f85d82b97a5ff8e3bce87 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 25 Aug 2023 17:14:01 +0200 Subject: [PATCH 012/117] handle POSIXct in airDatePickerInput --- R/module_state_manager.R | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 141affcf42..4b140d331c 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -241,6 +241,9 @@ app_state_restore <- function(grab, file) { checkmate::assert_subset(vapply(app_state, `[[`, character(1L), "id"), choices = names(input)) lapply(app_state, function(i) { + if (inherits(i$value, "POSIXt")) { + i$value <- posix_ms_to_json(i$value) + } session$sendInputMessage(inputId = i$id, message = list(value = i$value)) }) @@ -343,3 +346,23 @@ get_master_session <- function() { app_session } } + + +#' Special consideration for datetimes which are handled by `airDatepickerInput`. +#' `POSIXct` is expressed in milliseconds and converted to a JSON representation. +#' Apparently this is the only way for the input widget to accept data. +#' +#' Adapted from `shinyWidgets`. +#' +#' @section Warning: +#' Potential vulnerability if a different date time widget is used. +#' +#' @source [`shinyWidgets::updateAirDateInput`] +#' @keywords internal +#' +posix_ms_to_json <- function(x) { + x <- if (!is.null(x)) { + 1000 * as.numeric(as.POSIXct(as.character(x), tz = Sys.timezone())) + } + as.character(jsonlite::toJSON(x = x, auto_unbox = FALSE)) +} From 709c4ef178a640bb845b7f87e181211dbcb0dceb Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Mon, 28 Aug 2023 15:29:18 +0000 Subject: [PATCH 013/117] [skip actions] Restyle files --- R/module_state_manager.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 4b140d331c..20f6f03a8f 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -163,8 +163,6 @@ state_manager_srv <- function(id) { rows } }) - - }) } @@ -260,7 +258,7 @@ format.teal_grab <- function(x) { contents <- if (length(all_ids) + length(all_values) > 0L) { all_values_trimmed <- lapply(all_values, function(x) { if (nchar(x) > 40) { - paste(substr(x, 1, 36), "...") + paste(substr(x, 1, 36), "...") } else { x } @@ -298,7 +296,7 @@ print.teal_grab <- function(x, ...) { #' each of which has two elements, one named "id" and the other "value". #' @keywords internal #' -as.teal_grab <- function(x) { #nolint +as.teal_grab <- function(x) { # nolint checkmate::assert_list(x, names = "named") ans <- lapply(names(x), function(i) { From c2e0be421676188b2623736373d213e9237296ab 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, 28 Aug 2023 15:32:07 +0000 Subject: [PATCH 014/117] [skip actions] Roxygen Man Pages Auto Update --- man/posix_ms_to_json.Rd | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 man/posix_ms_to_json.Rd diff --git a/man/posix_ms_to_json.Rd b/man/posix_ms_to_json.Rd new file mode 100644 index 0000000000..a27ac4e15b --- /dev/null +++ b/man/posix_ms_to_json.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_state_manager.R +\name{posix_ms_to_json} +\alias{posix_ms_to_json} +\title{Special consideration for datetimes which are handled by \code{airDatepickerInput}. +\code{POSIXct} is expressed in milliseconds and converted to a JSON representation. +Apparently this is the only way for the input widget to accept data.} +\source{ +\code{\link[shinyWidgets:updateAirDateInput]{shinyWidgets::updateAirDateInput}} +} +\usage{ +posix_ms_to_json(x) +} +\description{ +Adapted from \code{shinyWidgets}. +} +\section{Warning}{ + +Potential vulnerability if a different date time widget is used. +} + +\keyword{internal} From 735650cb6d5891ee2c72ff8ea86c6a7432eb0bb5 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 28 Aug 2023 18:19:38 +0200 Subject: [PATCH 015/117] remove storing initial input state as always empty --- R/module_state_manager.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 20f6f03a8f..01ce1702a2 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -26,7 +26,7 @@ state_manager_ui <- function(id) { class = "snapshot_table_row", span(tags$b("State manager")), actionLink(ns("grab_add"), label = NULL, icon = icon("camera"), title = "grab input state"), - actionLink(ns("grab_reset"), label = NULL, icon = icon("undo"), title = "reset initial state"), + # actionLink(ns("grab_reset"), label = NULL, icon = icon("undo"), title = "reset initial state"), NULL ), uiOutput(ns("grab_list")) @@ -44,9 +44,9 @@ state_manager_srv <- function(id) { # Store initial input states. grab_history <- reactiveVal({ - list( - "Initial input state" = app_state_grab() - ) + # list( + # "Initial input state" = app_state_grab() + # ) }) # Grab current input state - name grab. @@ -109,7 +109,7 @@ state_manager_srv <- function(id) { divs <- reactiveValues() observeEvent(grab_history(), { - lapply(names(grab_history())[-1L], function(s) { + lapply(names(grab_history()), function(s) { id_pickme <- sprintf("pickme_%s", make.names(s)) id_saveme <- sprintf("saveme_%s", make.names(s)) id_rowme <- sprintf("rowme_%s", make.names(s)) From f854b9d40597419ba2f9395b416606527ae9ebf0 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 28 Aug 2023 18:40:33 +0200 Subject: [PATCH 016/117] spelling --- R/module_state_manager.R | 6 +++--- inst/WORDLIST | 13 +++++++------ man/app_state_restore.Rd | 2 +- man/app_state_store.Rd | 2 +- man/posix_ms_to_json.Rd | 2 +- 5 files changed, 13 insertions(+), 12 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 01ce1702a2..2c2cf875bc 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -192,7 +192,7 @@ app_state_grab <- function() { #' Save input grab to json file. #' #' @param grab `teal_grab` -#' @param file `path` to save the input states to; must be a .json file; will be overwritten +#' @param file `path` to save the input states to; must be a `.json` file; will be overwritten #' @return Returns `NULL` invisibly. #' @keywords internal #' @seealso [`app_state_grab`], [`app_state_restore`], [`state_manager_module`] @@ -209,7 +209,7 @@ app_state_store <- function(grab, file) { #' Restore state (value) of all input items in the app according to a grab or file. #' #' @param grab optional `teal_grab` -#' @param file optional `path` to a .json file +#' @param file optional `path` to a `.json` file #' @return Returns `NULL` invisibly. #' @keywords internal #' @seealso [`app_state_grab`], [`app_state_store`], [`state_manager_module`] @@ -346,7 +346,7 @@ get_master_session <- function() { } -#' Special consideration for datetimes which are handled by `airDatepickerInput`. +#' Special consideration for date time objects which are handled by `airDatepickerInput`. #' `POSIXct` is expressed in milliseconds and converted to a JSON representation. #' Apparently this is the only way for the input widget to accept data. #' diff --git a/inst/WORDLIST b/inst/WORDLIST index fc9934a03d..cf0e029aa5 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,11 +1,8 @@ -Forkers -Hoffmann -TLG -UI -UIs -UX cloneable +Forkers funder +Hoffmann +JSON omics pharmaverse preselected @@ -15,4 +12,8 @@ reproducibility tabsetted themer theming +TLG +UI +UIs uncheck +UX diff --git a/man/app_state_restore.Rd b/man/app_state_restore.Rd index 4854c0039b..dde624d197 100644 --- a/man/app_state_restore.Rd +++ b/man/app_state_restore.Rd @@ -9,7 +9,7 @@ app_state_restore(grab, file) \arguments{ \item{grab}{optional \code{teal_grab}} -\item{file}{optional \code{path} to a .json file} +\item{file}{optional \code{path} to a \code{.json} file} } \value{ Returns \code{NULL} invisibly. diff --git a/man/app_state_store.Rd b/man/app_state_store.Rd index bfff1f36f9..d84d4fff2f 100644 --- a/man/app_state_store.Rd +++ b/man/app_state_store.Rd @@ -9,7 +9,7 @@ app_state_store(grab, file) \arguments{ \item{grab}{\code{teal_grab}} -\item{file}{\code{path} to save the input states to; must be a .json file; will be overwritten} +\item{file}{\code{path} to save the input states to; must be a \code{.json} file; will be overwritten} } \value{ Returns \code{NULL} invisibly. diff --git a/man/posix_ms_to_json.Rd b/man/posix_ms_to_json.Rd index a27ac4e15b..d5dc858089 100644 --- a/man/posix_ms_to_json.Rd +++ b/man/posix_ms_to_json.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/module_state_manager.R \name{posix_ms_to_json} \alias{posix_ms_to_json} -\title{Special consideration for datetimes which are handled by \code{airDatepickerInput}. +\title{Special consideration for date time objects which are handled by \code{airDatepickerInput}. \code{POSIXct} is expressed in milliseconds and converted to a JSON representation. Apparently this is the only way for the input widget to accept data.} \source{ From 556c1bb662d8a3d985516ccc4bc20a00f30bcbbf Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 28 Aug 2023 18:53:05 +0200 Subject: [PATCH 017/117] spelling --- R/module_state_manager.R | 2 +- man/app_state_store.Rd | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 2c2cf875bc..4878a821bf 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -189,7 +189,7 @@ app_state_grab <- function() { } -#' Save input grab to json file. +#' Save input grab to JSON file. #' #' @param grab `teal_grab` #' @param file `path` to save the input states to; must be a `.json` file; will be overwritten diff --git a/man/app_state_store.Rd b/man/app_state_store.Rd index d84d4fff2f..9f7d68d6cd 100644 --- a/man/app_state_store.Rd +++ b/man/app_state_store.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/module_state_manager.R \name{app_state_store} \alias{app_state_store} -\title{Save input grab to json file.} +\title{Save input grab to JSON file.} \usage{ app_state_store(grab, file) } @@ -15,7 +15,7 @@ app_state_store(grab, file) Returns \code{NULL} invisibly. } \description{ -Save input grab to json file. +Save input grab to JSON file. } \seealso{ \code{\link{app_state_grab}}, \code{\link{app_state_restore}}, \code{\link{state_manager_module}} From 3e40918c9f01c486b16b23d427138e1bb741816a Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 8 Sep 2023 18:44:12 +0200 Subject: [PATCH 018/117] use native shiny bookmarking --- NAMESPACE | 2 - R/module_filter_manager.R | 8 +- R/module_state_manager.R | 308 ++++++++++---------------------------- man/app_state_grab.Rd | 20 --- man/app_state_restore.Rd | 23 --- man/app_state_store.Rd | 23 --- man/as.teal_grab.Rd | 19 --- man/posix_ms_to_json.Rd | 22 --- man/setdiff_teal_grab.Rd | 18 --- 9 files changed, 83 insertions(+), 360 deletions(-) delete mode 100644 man/app_state_grab.Rd delete mode 100644 man/app_state_restore.Rd delete mode 100644 man/app_state_store.Rd delete mode 100644 man/as.teal_grab.Rd delete mode 100644 man/posix_ms_to_json.Rd delete mode 100644 man/setdiff_teal_grab.Rd diff --git a/NAMESPACE b/NAMESPACE index fec9e3effb..4711ead7a4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,13 +1,11 @@ # Generated by roxygen2: do not edit by hand S3method(c,teal_slices) -S3method(format,teal_grab) S3method(get_code,tdata) S3method(get_join_keys,default) S3method(get_join_keys,tdata) S3method(get_metadata,default) S3method(get_metadata,tdata) -S3method(print,teal_grab) S3method(print,teal_module) S3method(print,teal_modules) S3method(srv_nested_tabs,default) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 31012d50ee..26fe1c945b 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -81,7 +81,9 @@ filter_manager_ui <- function(id) { class = "filter_manager_content", tableOutput(ns("slices_table")), snapshot_manager_ui(ns("snapshot_manager")), - state_manager_ui(ns("state_manager")) + if (getShinyOption("bookmarkStore", default = "disable") != "server") { + state_manager_ui(ns("state_manager")) + } ) } @@ -183,7 +185,9 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Call snapshot manager. snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) # Call state manager. - state_manager_srv("state_manager") + if (getShinyOption("bookmarkStore", default = "disable") != "server") { + state_manager_srv("state_manager") + } modules_out # returned for testing purpose }) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 4878a821bf..1f624dec48 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -26,7 +26,6 @@ state_manager_ui <- function(id) { class = "snapshot_table_row", span(tags$b("State manager")), actionLink(ns("grab_add"), label = NULL, icon = icon("camera"), title = "grab input state"), - # actionLink(ns("grab_reset"), label = NULL, icon = icon("undo"), title = "reset initial state"), NULL ), uiOutput(ns("grab_list")) @@ -44,9 +43,9 @@ state_manager_srv <- function(id) { # Store initial input states. grab_history <- reactiveVal({ - # list( - # "Initial input state" = app_state_grab() - # ) + list( + "Initial input state" = grab_state(get_master_session()) + ) }) # Grab current input state - name grab. @@ -78,74 +77,68 @@ state_manager_srv <- function(id) { ) updateTextInput(inputId = "grab_name", value = , placeholder = "Meaningful, unique name") } else { - grab <- app_state_grab() - grab_update <- c(grab_history(), list(grab)) + sesh <- get_master_session() + # 1. get input names and isolate filter panel + filter_panel_inputs <- grep("filter_panel", names(sesh$input), value = TRUE) + # 2. exclude filter panel from bookmark + sesh$setBookmarkExclude(character(0L)) + sesh$setBookmarkExclude(filter_panel_inputs) + # 3. arrange restoring filter state after restoring bookmark + ### work in progress + sesh$onBookmark(function(state) { + ### smth like this should happen: + snapshot <- as.list(slices_global(), recursive = TRUE) + attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) + state$filter_state_on_bookmark <- snapshot + ### end; requires access to slices_global and mapping_matrix + state$snapshot_history <- snapshot_history() # isolate this? + state$grab_history <- grab_history() # isolate this? + }) + sesh$onRestored(function(state) { + ### smth like this should happen: + snapshot <- state$filter_state_on_bookmark + snapshot_state <- as.teal_slices(snapshot) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapply( + function(filtered_data, filter_ids) { + filtered_data$clear_filter_states(force = TRUE) + slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) + filtered_data$set_filter_state(slices) + }, + filtered_data = filtered_data_list, + filter_ids = mapping_unfolded + ) + slices_global(snapshot_state) + ### end; requires access to slices_global and filtered_data_list + snapshot_history(state$snapshot_history) + grab_history(state$grab_history) + }) + # 4. do bookmark + url <- grab_state(sesh) + # 5. add bookmark URL to grab history (with name) + grab_update <- c(grab_history(), list(url)) names(grab_update)[length(grab_update)] <- grab_name grab_history(grab_update) + # 6. remove modal removeModal() # Reopen filter manager modal by clicking button in the main application. shinyjs::click(id = "teal-main_ui-filter_manager-show", asis = TRUE) } }) - # Restore initial input state. - observeEvent(input$grab_reset, { - s <- "Initial input state" - ### Begin restore procedure. ### - grab <- grab_history()[[s]] - app_state_restore(grab) - if (!is.null(setdiff_teal_grab(grab, app_state_grab()))) { - shinyjs::click("grab_reset") - } - removeModal() - ### End restore procedure. ### - }) - # Create UI elements and server logic for the grab table. - # Observers must be tracked to avoid duplication and excess reactivity. - # Remaining elements are tracked likewise for consistency and a slight speed margin. - observers <- reactiveValues() - handlers <- reactiveValues() + # Divs are tracked for a slight speed margin. divs <- reactiveValues() observeEvent(grab_history(), { - lapply(names(grab_history()), function(s) { - id_pickme <- sprintf("pickme_%s", make.names(s)) - id_saveme <- sprintf("saveme_%s", make.names(s)) + lapply(names(grab_history())[-1L], function(s) { id_rowme <- sprintf("rowme_%s", make.names(s)) - # Observer for restoring grab. - if (!is.element(id_pickme, names(observers))) { - observers[[id_pickme]] <- observeEvent(input[[id_pickme]], { - ### Begin restore procedure. ### - grab <- grab_history()[[s]] - app_state_restore(grab) - if (!is.null(setdiff_teal_grab(grab, app_state_grab()))) { - shinyjs::click(id_pickme) - } - removeModal() - ### End restore procedure. ### - }) - } - # Create handler for downloading grab. - if (!is.element(id_saveme, names(handlers))) { - output[[id_saveme]] <- downloadHandler( - filename = function() { - sprintf("teal_inputs_%s_%s.json", s, Sys.Date()) - }, - content = function(file) { - app_state_store(grab = grab_history()[[s]], file = file) - } - ) - handlers[[id_saveme]] <- id_saveme - } # Create a row for the grab table. if (!is.element(id_rowme, names(divs))) { divs[[id_rowme]] <- div( class = "snapshot_table_row", - span(h5(s)), - actionLink(inputId = ns(id_pickme), label = icon("circle-check"), title = "select"), - downloadLink(outputId = ns(id_saveme), label = icon("save"), title = "save to file") + a(h5(s), title = "restore bookmark", href = grab_history()[[s]]) ) } }) @@ -168,171 +161,8 @@ state_manager_srv <- function(id) { - # utility functions ---- -#' Grab selection state (value) of all input items in the app. -#' -#' Find all inputs in the app ans store their state. -#' Buttons are omitted as their values do not (usually) matter -#' and they are virtually impossible to restore. -#' -#' @return -#' Object of class `teal_grab`, describing the state of all inputs in the app (except buttons). -#' @keywords internal -#' @seealso [`app_state_store`], [`app_state_restore`], [`state_manager_module`] -#' -app_state_grab <- function() { - session <- get_master_session() - input <- session$input - as.teal_grab(shiny::reactiveValuesToList(input)) -} - - -#' Save input grab to JSON file. -#' -#' @param grab `teal_grab` -#' @param file `path` to save the input states to; must be a `.json` file; will be overwritten -#' @return Returns `NULL` invisibly. -#' @keywords internal -#' @seealso [`app_state_grab`], [`app_state_restore`], [`state_manager_module`] -#' -app_state_store <- function(grab, file) { - checkmate::assert_class(grab, "teal_grab") - checkmate::assert_path_for_output(file, overwrite = TRUE, extension = "json") - - jsonlite::write_json(jsonlite::serializeJSON(grab, pretty = TRUE), file) - invisible(NULL) -} - - -#' Restore state (value) of all input items in the app according to a grab or file. -#' -#' @param grab optional `teal_grab` -#' @param file optional `path` to a `.json` file -#' @return Returns `NULL` invisibly. -#' @keywords internal -#' @seealso [`app_state_grab`], [`app_state_store`], [`state_manager_module`] -#' -app_state_restore <- function(grab, file) { - if ((missing(grab) && missing(file)) || (!missing(grab) && !missing(file))) { - stop("specify either \"grab\" or \"file\"") - } - if (!missing(grab)) { - checkmate::assert_class(grab, "teal_grab") - } - if (!missing(file)) { - checkmate::assert_file_exists(file, access = "r") - } - - app_state <- - if (missing(file)) { - grab - } else if (missing(grab)) { - jsonlite::unserializeJSON(jsonlite::read_json(file)[[1L]]) - } - - session <- get_master_session() - input <- session$input - - # validate saved input state - checkmate::assert_subset(vapply(app_state, `[[`, character(1L), "id"), choices = names(input)) - - lapply(app_state, function(i) { - if (inherits(i$value, "POSIXt")) { - i$value <- posix_ms_to_json(i$value) - } - session$sendInputMessage(inputId = i$id, message = list(value = i$value)) - }) - - invisible(NULL) -} - - -#' @export -#' -format.teal_grab <- function(x) { - all_ids <- vapply(x, `[[`, character(1), "id") - all_values <- vapply(x, function(xx) toString(xx[["value"]]), character(1L)) - - contents <- if (length(all_ids) + length(all_values) > 0L) { - all_values_trimmed <- lapply(all_values, function(x) { - if (nchar(x) > 40) { - paste(substr(x, 1, 36), "...") - } else { - x - } - }) - longest_id <- max(nchar(all_ids)) - longest_value <- max(nchar(all_values_trimmed)) - sprintf(sprintf("%%0%ds : %%0%ds", longest_id + 2L, longest_value), all_ids, all_values_trimmed) - } else { - " no inputs" - } - - paste( - c( - "teal_grab:", - contents, - "" - ), - collapse = "\n" - ) -} - - -#' @export -#' -print.teal_grab <- function(x, ...) { - cat(format(x, ...)) -} - - -#' Convert named list to `teal_grab`. -#' -#' @param x `named list` -#' @return -#' Object of class `teal_grab`, which is a list of lists, -#' each of which has two elements, one named "id" and the other "value". -#' @keywords internal -#' -as.teal_grab <- function(x) { # nolint - checkmate::assert_list(x, names = "named") - - ans <- lapply(names(x), function(i) { - if (!inherits(x[[i]], "shinyActionButtonValue")) { - list(id = i, value = x[[i]]) - } - }) - ans <- Filter(Negate(is.null), ans) - - excluded_ids <- paste(c("filter_panel", "filter_manager", "snapshot_manager", "state_manager"), collapse = "|") - included_ids <- grep(excluded_ids, vapply(ans, `[[`, character(1L), "id"), value = TRUE, invert = TRUE) - ans <- Filter(function(x) x[["id"]] %in% included_ids, ans) - - class(ans) <- c("teal_grab", class(ans)) - - ans -} - - -#' Compare `teal_grab` objects. -#' -#' Performs a set difference adapted for the `teal_grab` class. Returns NULL if the difference is empty. -#' -#' @param x,y `teal_grab` objects -#' @return `teal_grab` or `NULL`, if the difference is empty. -#' @keywords internal -#' -setdiff_teal_grab <- function(x, y) { - ans <- setdiff(x, y) - class(ans) <- c("teal_grab", class(ans)) - if (length(ans)) { - ans - } -} - - #' @keywords internal #' get_master_session <- function() { @@ -346,21 +176,37 @@ get_master_session <- function() { } -#' Special consideration for date time objects which are handled by `airDatepickerInput`. -#' `POSIXct` is expressed in milliseconds and converted to a JSON representation. -#' Apparently this is the only way for the input widget to accept data. -#' -#' Adapted from `shinyWidgets`. -#' -#' @section Warning: -#' Potential vulnerability if a different date time widget is used. -#' -#' @source [`shinyWidgets::updateAirDateInput`] +# add bookmark and return URL to saved state +# simplified from session$doBookmark #' @keywords internal #' -posix_ms_to_json <- function(x) { - x <- if (!is.null(x)) { - 1000 * as.numeric(as.POSIXct(as.character(x), tz = Sys.timezone())) +grab_state <- function(session) { + if (getShinyOption("bookmarkStore", default = "disable") != "server") { + showNotification("Bookmarks have not been enabled for this application.") + return(invisible(NULL)) } - as.character(jsonlite::toJSON(x = x, auto_unbox = FALSE)) + tryCatch(shiny:::withLogErrors({ + saveState <- shiny:::ShinySaveState$new( + input = session$.__enclos_env__$self$input, + exclude = session$.__enclos_env__$self$getBookmarkExclude(), + onSave = function(state) { + session$.__enclos_env__$private$bookmarkCallbacks$invoke(state) + }) + url <- shiny:::saveShinySaveState(saveState) + clientData <- session$.__enclos_env__$self$clientData + url <- paste0( + clientData$url_protocol, + "//", + clientData$url_hostname, + if (nzchar(clientData$url_port)) paste0(":", clientData$url_port), + clientData$url_pathname, + "?", + url + ) + }), error = function(e) { + msg <- paste0("Error bookmarking state: ", e$message) + shiny::showNotification(msg, duration = NULL, type = "error") + }) + + url } diff --git a/man/app_state_grab.Rd b/man/app_state_grab.Rd deleted file mode 100644 index 5b031b29a1..0000000000 --- a/man/app_state_grab.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_state_manager.R -\name{app_state_grab} -\alias{app_state_grab} -\title{Grab selection state (value) of all input items in the app.} -\usage{ -app_state_grab() -} -\value{ -Object of class \code{teal_grab}, describing the state of all inputs in the app (except buttons). -} -\description{ -Find all inputs in the app ans store their state. -Buttons are omitted as their values do not (usually) matter -and they are virtually impossible to restore. -} -\seealso{ -\code{\link{app_state_store}}, \code{\link{app_state_restore}}, \code{\link{state_manager_module}} -} -\keyword{internal} diff --git a/man/app_state_restore.Rd b/man/app_state_restore.Rd deleted file mode 100644 index dde624d197..0000000000 --- a/man/app_state_restore.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_state_manager.R -\name{app_state_restore} -\alias{app_state_restore} -\title{Restore state (value) of all input items in the app according to a grab or file.} -\usage{ -app_state_restore(grab, file) -} -\arguments{ -\item{grab}{optional \code{teal_grab}} - -\item{file}{optional \code{path} to a \code{.json} file} -} -\value{ -Returns \code{NULL} invisibly. -} -\description{ -Restore state (value) of all input items in the app according to a grab or file. -} -\seealso{ -\code{\link{app_state_grab}}, \code{\link{app_state_store}}, \code{\link{state_manager_module}} -} -\keyword{internal} diff --git a/man/app_state_store.Rd b/man/app_state_store.Rd deleted file mode 100644 index 9f7d68d6cd..0000000000 --- a/man/app_state_store.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_state_manager.R -\name{app_state_store} -\alias{app_state_store} -\title{Save input grab to JSON file.} -\usage{ -app_state_store(grab, file) -} -\arguments{ -\item{grab}{\code{teal_grab}} - -\item{file}{\code{path} to save the input states to; must be a \code{.json} file; will be overwritten} -} -\value{ -Returns \code{NULL} invisibly. -} -\description{ -Save input grab to JSON file. -} -\seealso{ -\code{\link{app_state_grab}}, \code{\link{app_state_restore}}, \code{\link{state_manager_module}} -} -\keyword{internal} diff --git a/man/as.teal_grab.Rd b/man/as.teal_grab.Rd deleted file mode 100644 index 8876f6a796..0000000000 --- a/man/as.teal_grab.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_state_manager.R -\name{as.teal_grab} -\alias{as.teal_grab} -\title{Convert named list to \code{teal_grab}.} -\usage{ -as.teal_grab(x) -} -\arguments{ -\item{x}{\verb{named list}} -} -\value{ -Object of class \code{teal_grab}, which is a list of lists, -each of which has two elements, one named "id" and the other "value". -} -\description{ -Convert named list to \code{teal_grab}. -} -\keyword{internal} diff --git a/man/posix_ms_to_json.Rd b/man/posix_ms_to_json.Rd deleted file mode 100644 index d5dc858089..0000000000 --- a/man/posix_ms_to_json.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_state_manager.R -\name{posix_ms_to_json} -\alias{posix_ms_to_json} -\title{Special consideration for date time objects which are handled by \code{airDatepickerInput}. -\code{POSIXct} is expressed in milliseconds and converted to a JSON representation. -Apparently this is the only way for the input widget to accept data.} -\source{ -\code{\link[shinyWidgets:updateAirDateInput]{shinyWidgets::updateAirDateInput}} -} -\usage{ -posix_ms_to_json(x) -} -\description{ -Adapted from \code{shinyWidgets}. -} -\section{Warning}{ - -Potential vulnerability if a different date time widget is used. -} - -\keyword{internal} diff --git a/man/setdiff_teal_grab.Rd b/man/setdiff_teal_grab.Rd deleted file mode 100644 index d75f4732b7..0000000000 --- a/man/setdiff_teal_grab.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_state_manager.R -\name{setdiff_teal_grab} -\alias{setdiff_teal_grab} -\title{Compare \code{teal_grab} objects.} -\usage{ -setdiff_teal_grab(x, y) -} -\arguments{ -\item{x, y}{\code{teal_grab} objects} -} -\value{ -\code{teal_grab} or \code{NULL}, if the difference is empty. -} -\description{ -Performs a set difference adapted for the \code{teal_grab} class. Returns NULL if the difference is empty. -} -\keyword{internal} From 0c22dcd22780d43b038589b1af861ec1fb749eb6 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 8 Sep 2023 18:54:23 +0200 Subject: [PATCH 019/117] open bookmarks in new window --- R/module_state_manager.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 1f624dec48..0dca0bc848 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -138,7 +138,7 @@ state_manager_srv <- function(id) { if (!is.element(id_rowme, names(divs))) { divs[[id_rowme]] <- div( class = "snapshot_table_row", - a(h5(s), title = "restore bookmark", href = grab_history()[[s]]) + a(h5(s), title = "restore bookmark", href = grab_history()[[s]], target = "blank") ) } }) From b9e3e377653fc4125d315e2e78a624497ee00154 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 11 Sep 2023 13:57:05 +0200 Subject: [PATCH 020/117] minor update to defauts --- R/module_state_manager.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 0dca0bc848..4310e597d2 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -178,9 +178,11 @@ get_master_session <- function() { # add bookmark and return URL to saved state # simplified from session$doBookmark +# @param session a `session` object; use get_master_session for best results +# @return URL pointing to a bookmarked application state #' @keywords internal #' -grab_state <- function(session) { +grab_state <- function(session = shiny::getDefaultReactiveDomain()) { if (getShinyOption("bookmarkStore", default = "disable") != "server") { showNotification("Bookmarks have not been enabled for this application.") return(invisible(NULL)) From edb94dc56e8352320f51208ccf0feaa55feadbf5 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Dec 2023 16:55:29 +0100 Subject: [PATCH 021/117] fix logic operators --- R/module_filter_manager.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index cd91a3e8d8..0b70607cbd 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -81,7 +81,7 @@ filter_manager_ui <- function(id) { class = "filter_manager_content", tableOutput(ns("slices_table")), snapshot_manager_ui(ns("snapshot_manager")), - if (getShinyOption("bookmarkStore", default = "disable") != "server") { + if (getShinyOption("bookmarkStore", default = "disable") == "server") { state_manager_ui(ns("state_manager")) } ) @@ -186,7 +186,7 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Call snapshot manager. snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) # Call state manager. - if (getShinyOption("bookmarkStore", default = "disable") != "server") { + if (getShinyOption("bookmarkStore", default = "disable") == "server") { state_manager_srv("state_manager") } From 67f8be54cfeee0b2d3489f375fc39f4be939506e Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Dec 2023 16:57:14 +0100 Subject: [PATCH 022/117] fix state manager server definition and call --- R/module_filter_manager.R | 2 +- R/module_state_manager.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 0b70607cbd..2236346c05 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -187,7 +187,7 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) # Call state manager. if (getShinyOption("bookmarkStore", default = "disable") == "server") { - state_manager_srv("state_manager") + state_manager_srv("state_manager", slices_global, mapping_matrix) } modules_out # returned for testing purpose diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 4310e597d2..a5d419f09a 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -35,7 +35,7 @@ state_manager_ui <- function(id) { #' @rdname state_manager_module #' @keywords internal #' -state_manager_srv <- function(id) { +state_manager_srv <- function(id, slices_global, mapping_matrix) { checkmate::assert_character(id) moduleServer(id, function(input, output, session) { From 56067038c18c2e00cedbc543abd7e7ec200b6c32 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 09:26:00 +0100 Subject: [PATCH 023/117] add hook to teal to set shiny option for bookmarking --- R/zzz.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/zzz.R b/R/zzz.R index a85f3f1437..54c041bc4a 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -10,6 +10,8 @@ # Set up the teal logger instance teal.logger::register_logger("teal") + # Turn on server-side bookmarking in shiny. + shiny::shinyOptions("bookmarkStore" = "server") invisible() } From 5b47506bc0f66d22d45da889c94bd21a22d38d43 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 09:26:28 +0100 Subject: [PATCH 024/117] fix bookmarking and restoring callbacks --- R/module_state_manager.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index a5d419f09a..be0c15067c 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -89,14 +89,14 @@ state_manager_srv <- function(id, slices_global, mapping_matrix) { ### smth like this should happen: snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) - state$filter_state_on_bookmark <- snapshot + state$values$filter_state_on_bookmark <- snapshot ### end; requires access to slices_global and mapping_matrix - state$snapshot_history <- snapshot_history() # isolate this? - state$grab_history <- grab_history() # isolate this? + state$values$snapshot_history <- snapshot_history() # isolate this? + state$values$grab_history <- grab_history() # isolate this? }) sesh$onRestored(function(state) { ### smth like this should happen: - snapshot <- state$filter_state_on_bookmark + snapshot <- state$values$filter_state_on_bookmark snapshot_state <- as.teal_slices(snapshot) mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) mapply( @@ -110,8 +110,8 @@ state_manager_srv <- function(id, slices_global, mapping_matrix) { ) slices_global(snapshot_state) ### end; requires access to slices_global and filtered_data_list - snapshot_history(state$snapshot_history) - grab_history(state$grab_history) + snapshot_history(state$values$snapshot_history) + grab_history(state$values$grab_history) }) # 4. do bookmark url <- grab_state(sesh) From a583e237c0f801dd23210d0d9879ec0314edb383 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 09:27:05 +0100 Subject: [PATCH 025/117] add missing arguments in state manager and add return value in snapshot manager --- R/module_filter_manager.R | 4 ++-- R/module_snapshot_manager.R | 2 ++ R/module_state_manager.R | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 2236346c05..2b123dc338 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -184,10 +184,10 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { }) # Call snapshot manager. - snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) + snapshot_history <- snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) # Call state manager. if (getShinyOption("bookmarkStore", default = "disable") == "server") { - state_manager_srv("state_manager", slices_global, mapping_matrix) + state_manager_srv("state_manager", slices_global, mapping_matrix, snapshot_history) } modules_out # returned for testing purpose diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index da49dd842e..5f47c8597f 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -325,6 +325,8 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat rows } }) + + return(snapshot_history) }) } diff --git a/R/module_state_manager.R b/R/module_state_manager.R index be0c15067c..b7d2b404b6 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -35,7 +35,7 @@ state_manager_ui <- function(id) { #' @rdname state_manager_module #' @keywords internal #' -state_manager_srv <- function(id, slices_global, mapping_matrix) { +state_manager_srv <- function(id, slices_global, mapping_matrix, snapshot_history) { checkmate::assert_character(id) moduleServer(id, function(input, output, session) { From 47cc2a5c43c2c920e3b9c9ca6aa50b5efb9188a1 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 09:29:47 +0100 Subject: [PATCH 026/117] properly call public methods of session object --- R/module_state_manager.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index b7d2b404b6..8a81b8d548 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -189,13 +189,13 @@ grab_state <- function(session = shiny::getDefaultReactiveDomain()) { } tryCatch(shiny:::withLogErrors({ saveState <- shiny:::ShinySaveState$new( - input = session$.__enclos_env__$self$input, - exclude = session$.__enclos_env__$self$getBookmarkExclude(), + input = session$input, + exclude = session$getBookmarkExclude(), onSave = function(state) { session$.__enclos_env__$private$bookmarkCallbacks$invoke(state) }) url <- shiny:::saveShinySaveState(saveState) - clientData <- session$.__enclos_env__$self$clientData + clientData <- session$clientData url <- paste0( clientData$url_protocol, "//", From 81f10fbc7a3bb66cc92a2e136bb6b4f332618ee2 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 11:53:34 +0100 Subject: [PATCH 027/117] add more missing arguments to state manager module --- R/module_filter_manager.R | 2 +- R/module_state_manager.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 2b123dc338..5f9364c544 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -187,7 +187,7 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { snapshot_history <- snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) # Call state manager. if (getShinyOption("bookmarkStore", default = "disable") == "server") { - state_manager_srv("state_manager", slices_global, mapping_matrix, snapshot_history) + state_manager_srv("state_manager", slices_global, mapping_matrix, filtered_data_list, snapshot_history) } modules_out # returned for testing purpose diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 8a81b8d548..b34a131955 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -35,7 +35,7 @@ state_manager_ui <- function(id) { #' @rdname state_manager_module #' @keywords internal #' -state_manager_srv <- function(id, slices_global, mapping_matrix, snapshot_history) { +state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_list, snapshot_history) { checkmate::assert_character(id) moduleServer(id, function(input, output, session) { From 5bb01256aff5f06a575eee94d381c3dc8f6540ea Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 11:54:05 +0100 Subject: [PATCH 028/117] clean up docs --- R/module_state_manager.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index b34a131955..158407041b 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -13,8 +13,6 @@ #' #' @author Aleksander Chlebowski #' -#' @seealso [`app_state_grab`], [`app_state_store`], [`app_state_restore`] -#' #' @rdname state_manager_module #' @keywords internal #' From 9e9c9decf96147e0238a2a8c700124116fedee92 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 11:54:55 +0100 Subject: [PATCH 029/117] rebuild module --- R/module_state_manager.R | 105 ++++++++++++++++++++------------------- 1 file changed, 54 insertions(+), 51 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 158407041b..71171b6ade 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -38,6 +38,7 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l moduleServer(id, function(input, output, session) { ns <- session$ns + sesh <- get_master_session() # Store initial input states. grab_history <- reactiveVal({ @@ -46,21 +47,44 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l ) }) - # Grab current input state - name grab. - observeEvent(input$grab_add, { - showModal( - modalDialog( - textInput(ns("grab_name"), "Name the grab", width = "100%", placeholder = "Meaningful, unique name"), - footer = tagList( - actionButton(ns("grab_name_accept"), "Accept", icon = icon("thumbs-up")), - modalButton(label = "Cancel", icon = icon("thumbs-down")) - ), - size = "s" - ) + # 3. arrange restoring filter state after restoring bookmark + ### work in progress + sesh$onBookmark(function(state) { + # 1. get input names and isolate filter panel + filter_panel_inputs <- grep("filter_panel", names(sesh$input), value = TRUE) + # 2. exclude filter panel from bookmark + sesh$setBookmarkExclude(character(0L)) + sesh$setBookmarkExclude(filter_panel_inputs) + + ### smth like this should happen: + snapshot <- as.list(slices_global(), recursive = TRUE) + attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) + state$values$filter_state_on_bookmark <- snapshot + ### end; requires access to slices_global and mapping_matrix + state$values$snapshot_history <- snapshot_history() # isolate this? + state$values$grab_history <- grab_history() # isolate this? + }) + sesh$onRestored(function(state) { + ### smth like this should happen: + snapshot <- state$values$filter_state_on_bookmark + snapshot_state <- as.teal_slices(snapshot) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapply( + function(filtered_data, filter_ids) { + filtered_data$clear_filter_states(force = TRUE) + slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) + filtered_data$set_filter_state(slices) + }, + filtered_data = filtered_data_list, + filter_ids = mapping_unfolded ) + slices_global(snapshot_state) + ### end; requires access to slices_global and filtered_data_list + snapshot_history(state$values$snapshot_history) + grab_history(state$values$grab_history) }) - # Grab current input state - store grab. - observeEvent(input$grab_name_accept, { + + sesh$onBookmarked(function(url) { grab_name <- trimws(input$grab_name) if (identical(grab_name, "")) { showNotification( @@ -68,51 +92,15 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l type = "message" ) updateTextInput(inputId = "grab_name", value = "", placeholder = "Meaningful, unique name") + unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else if (is.element(make.names(grab_name), make.names(names(grab_history())))) { showNotification( "This name is in conflict with other grab names. Please choose a different one.", type = "message" ) updateTextInput(inputId = "grab_name", value = , placeholder = "Meaningful, unique name") + unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else { - sesh <- get_master_session() - # 1. get input names and isolate filter panel - filter_panel_inputs <- grep("filter_panel", names(sesh$input), value = TRUE) - # 2. exclude filter panel from bookmark - sesh$setBookmarkExclude(character(0L)) - sesh$setBookmarkExclude(filter_panel_inputs) - # 3. arrange restoring filter state after restoring bookmark - ### work in progress - sesh$onBookmark(function(state) { - ### smth like this should happen: - snapshot <- as.list(slices_global(), recursive = TRUE) - attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) - state$values$filter_state_on_bookmark <- snapshot - ### end; requires access to slices_global and mapping_matrix - state$values$snapshot_history <- snapshot_history() # isolate this? - state$values$grab_history <- grab_history() # isolate this? - }) - sesh$onRestored(function(state) { - ### smth like this should happen: - snapshot <- state$values$filter_state_on_bookmark - snapshot_state <- as.teal_slices(snapshot) - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) - mapply( - function(filtered_data, filter_ids) { - filtered_data$clear_filter_states(force = TRUE) - slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) - filtered_data$set_filter_state(slices) - }, - filtered_data = filtered_data_list, - filter_ids = mapping_unfolded - ) - slices_global(snapshot_state) - ### end; requires access to slices_global and filtered_data_list - snapshot_history(state$values$snapshot_history) - grab_history(state$values$grab_history) - }) - # 4. do bookmark - url <- grab_state(sesh) # 5. add bookmark URL to grab history (with name) grab_update <- c(grab_history(), list(url)) names(grab_update)[length(grab_update)] <- grab_name @@ -124,6 +112,21 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l } }) + # Grab current input state - name grab. + observeEvent(input$grab_add, { + showModal( + modalDialog( + textInput(ns("grab_name"), "Name the grab", width = "100%", placeholder = "Meaningful, unique name"), + footer = tagList( + # actionButton(ns("grab_name_accept"), "Accept", icon = icon("thumbs-up")), + bookmarkButton("Accept", icon = icon("thumbs-up")), + modalButton(label = "Cancel", icon = icon("thumbs-down")) + ), + size = "s" + ) + ) + }) + # Create UI elements and server logic for the grab table. # Divs are tracked for a slight speed margin. divs <- reactiveValues() From e2fea5d7cd5ed86a85b5e5ed4b1336b81f2b6a9a Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 11:59:20 +0100 Subject: [PATCH 030/117] remove grab_state function --- R/module_state_manager.R | 40 +--------------------------------------- 1 file changed, 1 insertion(+), 39 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 71171b6ade..0cb284e855 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -162,7 +162,7 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l -# utility functions ---- +## utility functions ---- #' @keywords internal #' @@ -175,41 +175,3 @@ get_master_session <- function() { app_session } } - - -# add bookmark and return URL to saved state -# simplified from session$doBookmark -# @param session a `session` object; use get_master_session for best results -# @return URL pointing to a bookmarked application state -#' @keywords internal -#' -grab_state <- function(session = shiny::getDefaultReactiveDomain()) { - if (getShinyOption("bookmarkStore", default = "disable") != "server") { - showNotification("Bookmarks have not been enabled for this application.") - return(invisible(NULL)) - } - tryCatch(shiny:::withLogErrors({ - saveState <- shiny:::ShinySaveState$new( - input = session$input, - exclude = session$getBookmarkExclude(), - onSave = function(state) { - session$.__enclos_env__$private$bookmarkCallbacks$invoke(state) - }) - url <- shiny:::saveShinySaveState(saveState) - clientData <- session$clientData - url <- paste0( - clientData$url_protocol, - "//", - clientData$url_hostname, - if (nzchar(clientData$url_port)) paste0(":", clientData$url_port), - clientData$url_pathname, - "?", - url - ) - }), error = function(e) { - msg <- paste0("Error bookmarking state: ", e$message) - shiny::showNotification(msg, duration = NULL, type = "error") - }) - - url -} From ca24e29db18d074e93f6f19547860ee8f25b18e7 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 13:39:22 +0100 Subject: [PATCH 031/117] add argument checks to state manager module --- R/module_state_manager.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 0cb284e855..8a76735895 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -35,6 +35,13 @@ state_manager_ui <- function(id) { #' state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_list, snapshot_history) { checkmate::assert_character(id) + checkmate::assert_true(is.reactive(slices_global)) + checkmate::assert_class(isolate(slices_global()), "teal_slices") + checkmate::assert_true(is.reactive(mapping_matrix)) + checkmate::assert_data_frame(isolate(mapping_matrix()), null.ok = TRUE) + checkmate::assert_list(filtered_data_list, types = "FilteredData", any.missing = FALSE, names = "named") + checkmate::assert_true(is.reactive(snapshot_history)) + checkmate::assert_list(isolate(snapshot_history()), names = "unique") moduleServer(id, function(input, output, session) { ns <- session$ns From 3ec250d624023cc9a4bbb6e6340afe9aba8a2561 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 13:39:56 +0100 Subject: [PATCH 032/117] remove filter panel exclusion --- R/module_state_manager.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 8a76735895..7841694560 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -57,12 +57,6 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l # 3. arrange restoring filter state after restoring bookmark ### work in progress sesh$onBookmark(function(state) { - # 1. get input names and isolate filter panel - filter_panel_inputs <- grep("filter_panel", names(sesh$input), value = TRUE) - # 2. exclude filter panel from bookmark - sesh$setBookmarkExclude(character(0L)) - sesh$setBookmarkExclude(filter_panel_inputs) - ### smth like this should happen: snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) From c9bbb541b9991d38e8899a3cab029f57c8bec0f7 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 13:41:35 +0100 Subject: [PATCH 033/117] don't store initial app state --- R/module_state_manager.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 7841694560..4ac7d53498 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -49,9 +49,7 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l # Store initial input states. grab_history <- reactiveVal({ - list( - "Initial input state" = grab_state(get_master_session()) - ) + list() }) # 3. arrange restoring filter state after restoring bookmark @@ -133,7 +131,7 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l divs <- reactiveValues() observeEvent(grab_history(), { - lapply(names(grab_history())[-1L], function(s) { + lapply(names(grab_history()), function(s) { id_rowme <- sprintf("rowme_%s", make.names(s)) # Create a row for the grab table. From 63eb7383446f714f565d26dd05b53459622937ac Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Dec 2023 14:44:03 +0100 Subject: [PATCH 034/117] clean up comemnts --- R/module_state_manager.R | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 4ac7d53498..76a59dd477 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -47,24 +47,22 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l ns <- session$ns sesh <- get_master_session() - # Store initial input states. + # Store input states. grab_history <- reactiveVal({ list() }) - # 3. arrange restoring filter state after restoring bookmark - ### work in progress sesh$onBookmark(function(state) { - ### smth like this should happen: + # Add current filter state to bookmark. snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) state$values$filter_state_on_bookmark <- snapshot - ### end; requires access to slices_global and mapping_matrix + # Add snapshot history and grab history to bookmark. state$values$snapshot_history <- snapshot_history() # isolate this? state$values$grab_history <- grab_history() # isolate this? }) sesh$onRestored(function(state) { - ### smth like this should happen: + # Restore filter state. snapshot <- state$values$filter_state_on_bookmark snapshot_state <- as.teal_slices(snapshot) mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) @@ -78,7 +76,7 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l filter_ids = mapping_unfolded ) slices_global(snapshot_state) - ### end; requires access to slices_global and filtered_data_list + # Restore snapshot history and grab history. snapshot_history(state$values$snapshot_history) grab_history(state$values$grab_history) }) @@ -100,14 +98,12 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l updateTextInput(inputId = "grab_name", value = , placeholder = "Meaningful, unique name") unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else { - # 5. add bookmark URL to grab history (with name) + # Add bookmark URL to grab history (with name). grab_update <- c(grab_history(), list(url)) names(grab_update)[length(grab_update)] <- grab_name grab_history(grab_update) - # 6. remove modal + removeModal() - # Reopen filter manager modal by clicking button in the main application. - shinyjs::click(id = "teal-main_ui-filter_manager-show", asis = TRUE) } }) @@ -117,7 +113,6 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l modalDialog( textInput(ns("grab_name"), "Name the grab", width = "100%", placeholder = "Meaningful, unique name"), footer = tagList( - # actionButton(ns("grab_name_accept"), "Accept", icon = icon("thumbs-up")), bookmarkButton("Accept", icon = icon("thumbs-up")), modalButton(label = "Cancel", icon = icon("thumbs-down")) ), From c3d40cf33396e4c3cb9c8eaaea58c1f7e442cadb Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 18 Dec 2023 15:47:53 +0100 Subject: [PATCH 035/117] init returns ui as function --- R/init.R | 5 +++-- man/init.Rd | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/init.R b/R/init.R index bf7b82dc8a..c6d6da87db 100644 --- a/R/init.R +++ b/R/init.R @@ -37,7 +37,7 @@ #' See the vignette for an example. However, [ui_teal_with_splash()] #' is then preferred to this function. #' -#' @return named list with `server` and `ui` function +#' @return Named list containing `ui` and `server` functions. #' #' @export #' @@ -207,8 +207,9 @@ init <- function(data, # 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 # rather than through `callModule` + # UI must be a function to support bookmarking. res <- list( - ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), + ui = function(request) ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { if (length(landing) == 1L) { landing_module <- landing[[1L]] diff --git a/man/init.Rd b/man/init.Rd index 308af0d5dc..9de56d864d 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -49,7 +49,7 @@ See the vignette for an example. However, \code{\link[=ui_teal_with_splash]{ui_t is then preferred to this function.} } \value{ -named list with \code{server} and \code{ui} function +Named list containing \code{ui} and \code{server} functions. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} From ac363d2e353bea982d397b5954dee2a403c40189 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 18 Dec 2023 15:49:50 +0100 Subject: [PATCH 036/117] use state manager module always --- R/module_filter_manager.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 5f9364c544..fb735a2366 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -81,9 +81,7 @@ filter_manager_ui <- function(id) { class = "filter_manager_content", tableOutput(ns("slices_table")), snapshot_manager_ui(ns("snapshot_manager")), - if (getShinyOption("bookmarkStore", default = "disable") == "server") { - state_manager_ui(ns("state_manager")) - } + state_manager_ui(ns("state_manager")) ) } @@ -186,9 +184,7 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Call snapshot manager. snapshot_history <- snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) # Call state manager. - if (getShinyOption("bookmarkStore", default = "disable") == "server") { - state_manager_srv("state_manager", slices_global, mapping_matrix, filtered_data_list, snapshot_history) - } + state_manager_srv("state_manager", slices_global, mapping_matrix, filtered_data_list, snapshot_history) modules_out # returned for testing purpose }) From c0f854c3d3f8c804aaf6297308c5762ca613acdd Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 13:26:51 +0100 Subject: [PATCH 037/117] all managers return --- R/module_filter_manager.R | 7 ++++++- R/module_snapshot_manager.R | 2 +- R/module_state_manager.R | 2 ++ 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index d3c19fa9d1..0215e9eb33 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -153,7 +153,12 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Call state manager. state_manager_srv("state_manager", slices_global, mapping_matrix, filtered_data_list, snapshot_history) - modules_out # returned for testing purpose + list( + slices_global = slices_global, + mapping_matrix = mapping_matrix, + filtered_data_list = filtered_data_list, + modules_out = modules_out # returned for testing purpose + ) }) } diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 564d8c08d8..6056570125 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -326,7 +326,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat } }) - return(snapshot_history) + snapshot_history }) } diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 76a59dd477..6783bae29e 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -151,6 +151,8 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l rows } }) + + grab_history }) } From 159e3379c79fbe9de076d10c3b49f62c8b102f6b Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 13:32:14 +0100 Subject: [PATCH 038/117] isolate manager_manager_module --- R/module_filter_manager.R | 39 -------------------------------------- R/module_manager_manager.R | 39 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 39 deletions(-) create mode 100644 R/module_manager_manager.R diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 0215e9eb33..47970c4307 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -22,45 +22,6 @@ #' NULL -#' Filter manager modal -#' -#' Opens a modal containing the filter manager UI. -#' -#' @name module_filter_manager_modal -#' @inheritParams module_filter_manager -#' @keywords internal -#' -NULL - -#' @rdname module_filter_manager_modal -filter_manager_modal_ui <- function(id) { - ns <- NS(id) - tags$button( - id = ns("show"), - class = "btn action-button filter_manager_button", - title = "Show filters manager modal", - icon("gear") - ) -} - -#' @rdname module_filter_manager_modal -filter_manager_modal_srv <- function(id, filtered_data_list, filter) { - moduleServer(id, function(input, output, session) { - observeEvent(input$show, { - logger::log_trace("filter_manager_modal_srv@1 show button has been clicked.") - showModal( - modalDialog( - filter_manager_ui(session$ns("filter_manager")), - size = "l", - footer = NULL, - easyClose = TRUE - ) - ) - }) - - filter_manager_srv("filter_manager", filtered_data_list, filter) - }) -} #' @rdname module_filter_manager filter_manager_ui <- function(id) { diff --git a/R/module_manager_manager.R b/R/module_manager_manager.R new file mode 100644 index 0000000000..95d75595b4 --- /dev/null +++ b/R/module_manager_manager.R @@ -0,0 +1,39 @@ +#' Filter manager modal +#' +#' Opens a modal containing the filter manager UI. +#' +#' @name module_filter_manager_modal +#' @inheritParams module_filter_manager +#' @keywords internal +#' +NULL + +#' @rdname module_filter_manager_modal +manager_manager_ui <- function(id) { + ns <- NS(id) + tags$button( + id = ns("show"), + class = "btn action-button filter_manager_button", + title = "Show filters manager modal", + icon("gear") + ) +} + +#' @rdname module_filter_manager_modal +manager_manager_srv <- function(id, filtered_data_list, filter) { + moduleServer(id, function(input, output, session) { + observeEvent(input$show, { + logger::log_trace("filter_manager_modal_srv@1 show button has been clicked.") + showModal( + modalDialog( + filter_manager_ui(session$ns("filter_manager")), + size = "l", + footer = NULL, + easyClose = TRUE + ) + ) + }) + + filter_manager_srv("filter_manager", filtered_data_list, filter) + }) +} From 0eb331ed8054e43ede56eef521c7afa7c868094e Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 14:46:14 +0100 Subject: [PATCH 039/117] rename manager_manager where it is used --- R/module_tabs_with_filters.R | 4 ++-- inst/css/sidebar.css | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index 4cf2f58fdc..7f392f8a5f 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -47,7 +47,7 @@ ui_tabs_with_filters <- function(id, modules, datasets, filter = teal_slices()) title = "Toggle filter panels", icon("fas fa-bars") ), - filter_manager_modal_ui(ns("filter_manager")) + manager_manager_ui(ns("manager_manager")) ) teal_ui$children[[1]] <- tagAppendChild(teal_ui$children[[1]], filter_panel_btns) @@ -84,7 +84,7 @@ srv_tabs_with_filters <- function(id, logger::log_trace("srv_tabs_with_filters initializing the module.") is_module_specific <- isTRUE(attr(filter, "module_specific")) - manager_out <- filter_manager_modal_srv("filter_manager", filtered_data_list = datasets, filter = filter) + manager_out <- manager_manager_srv("manager_manager", filtered_data_list = datasets, filter = filter) active_module <- srv_nested_tabs( id = "root", diff --git a/inst/css/sidebar.css b/inst/css/sidebar.css index f0d30a0677..e3a689f2c9 100644 --- a/inst/css/sidebar.css +++ b/inst/css/sidebar.css @@ -1,7 +1,7 @@ /* teal sidebar css */ -.filter_hamburger, .filter_manager_button { +.filter_hamburger, .manager_manager_button { font-size: 16px; padding: 8px !important; float: right !important; From ef6c04993a6213c07aa38b579b66f5d286a3cef2 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 14:46:57 +0100 Subject: [PATCH 040/117] move snapshot_manager and state_manager to manager manager --- R/module_filter_manager.R | 9 +---- R/module_manager_manager.R | 79 +++++++++++++++++++++++++++++++++----- R/module_state_manager.R | 2 +- 3 files changed, 72 insertions(+), 18 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 47970c4307..09c00b4f4f 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -28,9 +28,7 @@ filter_manager_ui <- function(id) { ns <- NS(id) tags$div( class = "filter_manager_content", - tableOutput(ns("slices_table")), - snapshot_manager_ui(ns("snapshot_manager")), - state_manager_ui(ns("state_manager")) + tableOutput(ns("slices_table")) ) } @@ -109,11 +107,6 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { ) }) - # Call snapshot manager. - snapshot_history <- snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) - # Call state manager. - state_manager_srv("state_manager", slices_global, mapping_matrix, filtered_data_list, snapshot_history) - list( slices_global = slices_global, mapping_matrix = mapping_matrix, diff --git a/R/module_manager_manager.R b/R/module_manager_manager.R index 95d75595b4..230c3a3314 100644 --- a/R/module_manager_manager.R +++ b/R/module_manager_manager.R @@ -11,22 +11,41 @@ NULL #' @rdname module_filter_manager_modal manager_manager_ui <- function(id) { ns <- NS(id) - tags$button( - id = ns("show"), - class = "btn action-button filter_manager_button", - title = "Show filters manager modal", - icon("gear") + rev( # Reversing order because buttons show up in UI from right to left. + tagList( + tags$button( + id = ns("show_filter_manager"), + class = "btn action-button manager_manager_button", + title = "Show filter manager modal", + suppressMessages(icon("solid fa-filter")) + ), + tags$button( + id = ns("show_snapshot_manager"), + class = "btn action-button manager_manager_button", + title = "Show snapshot manager modal", + icon("camera") + ), + tags$button( + id = ns("show_state_manager"), + class = "btn action-button manager_manager_button", + title = "Show state manager modal", + suppressMessages(icon("solid fa-bookmark")) + ) + ) ) } #' @rdname module_filter_manager_modal manager_manager_srv <- function(id, filtered_data_list, filter) { moduleServer(id, function(input, output, session) { - observeEvent(input$show, { - logger::log_trace("filter_manager_modal_srv@1 show button has been clicked.") + + ns <- session$ns + + observeEvent(input$show_filter_manager, { + logger::log_trace("manager_manager_modal_srv@1 show_filter_manager button has been clicked.") showModal( modalDialog( - filter_manager_ui(session$ns("filter_manager")), + filter_manager_ui(ns("filter_manager")), size = "l", footer = NULL, easyClose = TRUE @@ -34,6 +53,48 @@ manager_manager_srv <- function(id, filtered_data_list, filter) { ) }) - filter_manager_srv("filter_manager", filtered_data_list, filter) + observeEvent(input$show_snapshot_manager, { + logger::log_trace("manager_manager_modal_srv@1 show_snapshot_manager button has been clicked.") + showModal( + modalDialog( + snapshot_manager_ui(ns("snapshot_manager")), + size = "m", + footer = NULL, + easyClose = TRUE + ) + ) + }) + + observeEvent(input$show_state_manager, { + logger::log_trace("manager_manager_modal_srv@1 show_state_manager button has been clicked.") + showModal( + modalDialog( + state_manager_ui(ns("state_manager")), + size = "m", + footer = NULL, + easyClose = TRUE + ) + ) + }) + + filtrer_manager_results <- filter_manager_srv( + id = "filter_manager", + filtered_data_list = filtered_data_list, + filter = filter + ) + snapshot_history <- snapshot_manager_srv( + id = "snapshot_manager", + slices_global = filtrer_manager_results$slices_global, + mapping_matrix = filtrer_manager_results$mapping_matrix, + filtered_data_list = filtrer_manager_results$filtered_data_list + ) + state_manager_srv( + id = "state_manager", + slices_global = filtrer_manager_results$slices_global, + mapping_matrix = filtrer_manager_results$mapping_matrix, + filtered_data_list = filtrer_manager_results$filtered_data_list, + snapshot_history = snapshot_history + ) + }) } diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 6783bae29e..362f42c9c8 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -23,7 +23,7 @@ state_manager_ui <- function(id) { div( class = "snapshot_table_row", span(tags$b("State manager")), - actionLink(ns("grab_add"), label = NULL, icon = icon("camera"), title = "grab input state"), + actionLink(ns("grab_add"), label = NULL, icon = suppressMessages(icon("solid fa-bookmark")), title = "grab input state"), NULL ), uiOutput(ns("grab_list")) From d25397ccb88b104555954befd650cee085e9a1c6 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 15:48:08 +0100 Subject: [PATCH 041/117] rename module --- R/module_tabs_with_filters.R | 4 ++-- ...ule_manager_manager.R => module_wunder_bar.R} | 16 ++++++++-------- inst/css/sidebar.css | 2 +- 3 files changed, 11 insertions(+), 11 deletions(-) rename R/{module_manager_manager.R => module_wunder_bar.R} (80%) diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index 7f392f8a5f..c6a72822d8 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -47,7 +47,7 @@ ui_tabs_with_filters <- function(id, modules, datasets, filter = teal_slices()) title = "Toggle filter panels", icon("fas fa-bars") ), - manager_manager_ui(ns("manager_manager")) + wunder_bar_ui(ns("wunder_bar")) ) teal_ui$children[[1]] <- tagAppendChild(teal_ui$children[[1]], filter_panel_btns) @@ -84,7 +84,7 @@ srv_tabs_with_filters <- function(id, logger::log_trace("srv_tabs_with_filters initializing the module.") is_module_specific <- isTRUE(attr(filter, "module_specific")) - manager_out <- manager_manager_srv("manager_manager", filtered_data_list = datasets, filter = filter) + wunder_bar_out <- wunder_bar_srv("wunder_bar", filtered_data_list = datasets, filter = filter) active_module <- srv_nested_tabs( id = "root", diff --git a/R/module_manager_manager.R b/R/module_wunder_bar.R similarity index 80% rename from R/module_manager_manager.R rename to R/module_wunder_bar.R index 230c3a3314..1b9952405c 100644 --- a/R/module_manager_manager.R +++ b/R/module_wunder_bar.R @@ -9,25 +9,25 @@ NULL #' @rdname module_filter_manager_modal -manager_manager_ui <- function(id) { +wunder_bar_ui <- function(id) { ns <- NS(id) rev( # Reversing order because buttons show up in UI from right to left. tagList( tags$button( id = ns("show_filter_manager"), - class = "btn action-button manager_manager_button", + class = "btn action-button wunder_bar_button", title = "Show filter manager modal", suppressMessages(icon("solid fa-filter")) ), tags$button( id = ns("show_snapshot_manager"), - class = "btn action-button manager_manager_button", + class = "btn action-button wunder_bar_button", title = "Show snapshot manager modal", icon("camera") ), tags$button( id = ns("show_state_manager"), - class = "btn action-button manager_manager_button", + class = "btn action-button wunder_bar_button", title = "Show state manager modal", suppressMessages(icon("solid fa-bookmark")) ) @@ -36,13 +36,13 @@ manager_manager_ui <- function(id) { } #' @rdname module_filter_manager_modal -manager_manager_srv <- function(id, filtered_data_list, filter) { +wunder_bar_srv <- function(id, filtered_data_list, filter) { moduleServer(id, function(input, output, session) { ns <- session$ns observeEvent(input$show_filter_manager, { - logger::log_trace("manager_manager_modal_srv@1 show_filter_manager button has been clicked.") + logger::log_trace("wunder_bar_srv@1 show_filter_manager button has been clicked.") showModal( modalDialog( filter_manager_ui(ns("filter_manager")), @@ -54,7 +54,7 @@ manager_manager_srv <- function(id, filtered_data_list, filter) { }) observeEvent(input$show_snapshot_manager, { - logger::log_trace("manager_manager_modal_srv@1 show_snapshot_manager button has been clicked.") + logger::log_trace("wunder_bar_srv@1 show_snapshot_manager button has been clicked.") showModal( modalDialog( snapshot_manager_ui(ns("snapshot_manager")), @@ -66,7 +66,7 @@ manager_manager_srv <- function(id, filtered_data_list, filter) { }) observeEvent(input$show_state_manager, { - logger::log_trace("manager_manager_modal_srv@1 show_state_manager button has been clicked.") + logger::log_trace("wunder_bar_srv@1 show_state_manager button has been clicked.") showModal( modalDialog( state_manager_ui(ns("state_manager")), diff --git a/inst/css/sidebar.css b/inst/css/sidebar.css index e3a689f2c9..f4f13f3ff2 100644 --- a/inst/css/sidebar.css +++ b/inst/css/sidebar.css @@ -1,7 +1,7 @@ /* teal sidebar css */ -.filter_hamburger, .manager_manager_button { +.filter_hamburger, .wunder_bar_button { font-size: 16px; padding: 8px !important; float: right !important; From b8b7b5ce423d93708b765ffc8b26b6883c6f0dd9 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 17:34:13 +0100 Subject: [PATCH 042/117] shorten line --- R/module_state_manager.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 362f42c9c8..738cf42812 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -23,7 +23,7 @@ state_manager_ui <- function(id) { div( class = "snapshot_table_row", span(tags$b("State manager")), - actionLink(ns("grab_add"), label = NULL, icon = suppressMessages(icon("solid fa-bookmark")), title = "grab input state"), + actionLink(ns("grab_add"), NULL, icon = suppressMessages(icon("solid fa-bookmark")), title = "grab input state"), NULL ), uiOutput(ns("grab_list")) From 712a5c3f148df24bcd7628b8f18d894f8df97472 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 17:34:33 +0100 Subject: [PATCH 043/117] remove superfluous utility function --- R/module_state_manager.R | 24 ++++-------------------- 1 file changed, 4 insertions(+), 20 deletions(-) diff --git a/R/module_state_manager.R b/R/module_state_manager.R index 738cf42812..0d8e8b7285 100644 --- a/R/module_state_manager.R +++ b/R/module_state_manager.R @@ -45,14 +45,14 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l moduleServer(id, function(input, output, session) { ns <- session$ns - sesh <- get_master_session() + app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") # Store input states. grab_history <- reactiveVal({ list() }) - sesh$onBookmark(function(state) { + app_session$onBookmark(function(state) { # Add current filter state to bookmark. snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) @@ -61,7 +61,7 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l state$values$snapshot_history <- snapshot_history() # isolate this? state$values$grab_history <- grab_history() # isolate this? }) - sesh$onRestored(function(state) { + app_session$onRestored(function(state) { # Restore filter state. snapshot <- state$values$filter_state_on_bookmark snapshot_state <- as.teal_slices(snapshot) @@ -81,7 +81,7 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l grab_history(state$values$grab_history) }) - sesh$onBookmarked(function(url) { + app_session$onBookmarked(function(url) { grab_name <- trimws(input$grab_name) if (identical(grab_name, "")) { showNotification( @@ -155,19 +155,3 @@ state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_l grab_history }) } - - - -## utility functions ---- - -#' @keywords internal -#' -get_master_session <- function() { - local_session <- shiny::getDefaultReactiveDomain() - app_session <- .subset2(local_session, "parent") - if (is.null(app_session)) { - local_session - } else { - app_session - } -} From 1084353d12a165abcfbd6db72ab2f2972e950edb Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 17:40:33 +0100 Subject: [PATCH 044/117] rename module to bookmark_manager --- ...e_state_manager.R => module_bookmark_manager.R} | 14 +++++++------- R/module_wunder_bar.R | 14 +++++++------- 2 files changed, 14 insertions(+), 14 deletions(-) rename R/{module_state_manager.R => module_bookmark_manager.R} (94%) diff --git a/R/module_state_manager.R b/R/module_bookmark_manager.R similarity index 94% rename from R/module_state_manager.R rename to R/module_bookmark_manager.R index 0d8e8b7285..323626f331 100644 --- a/R/module_state_manager.R +++ b/R/module_bookmark_manager.R @@ -8,21 +8,21 @@ #' #' @return Nothing is returned. #' -#' @name state_manager_module -#' @aliases grab grab_manager state_manager +#' @name bookmark_manager_module +#' @aliases bookmark bookmark_manager #' #' @author Aleksander Chlebowski #' -#' @rdname state_manager_module +#' @rdname bookmark_manager_module #' @keywords internal #' -state_manager_ui <- function(id) { +bookmark_manager_ui <- function(id) { ns <- NS(id) div( class = "snapshot_manager_content", div( class = "snapshot_table_row", - span(tags$b("State manager")), + span(tags$b("Bookmark manager")), actionLink(ns("grab_add"), NULL, icon = suppressMessages(icon("solid fa-bookmark")), title = "grab input state"), NULL ), @@ -30,10 +30,10 @@ state_manager_ui <- function(id) { ) } -#' @rdname state_manager_module +#' @rdname bookmark_manager_module #' @keywords internal #' -state_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_list, snapshot_history) { +bookmark_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_list, snapshot_history) { checkmate::assert_character(id) checkmate::assert_true(is.reactive(slices_global)) checkmate::assert_class(isolate(slices_global()), "teal_slices") diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 1b9952405c..b1797918ac 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -26,9 +26,9 @@ wunder_bar_ui <- function(id) { icon("camera") ), tags$button( - id = ns("show_state_manager"), + id = ns("show_bookmark_manager"), class = "btn action-button wunder_bar_button", - title = "Show state manager modal", + title = "Show bookmark manager modal", suppressMessages(icon("solid fa-bookmark")) ) ) @@ -65,11 +65,11 @@ wunder_bar_srv <- function(id, filtered_data_list, filter) { ) }) - observeEvent(input$show_state_manager, { - logger::log_trace("wunder_bar_srv@1 show_state_manager button has been clicked.") + observeEvent(input$show_bookmark_manager, { + logger::log_trace("wunder_bar_srv@1 show_bookmark_manager button has been clicked.") showModal( modalDialog( - state_manager_ui(ns("state_manager")), + bookmark_manager_ui(ns("bookmark_manager")), size = "m", footer = NULL, easyClose = TRUE @@ -88,8 +88,8 @@ wunder_bar_srv <- function(id, filtered_data_list, filter) { mapping_matrix = filtrer_manager_results$mapping_matrix, filtered_data_list = filtrer_manager_results$filtered_data_list ) - state_manager_srv( - id = "state_manager", + bookmark_manager_srv( + id = "bookmark_manager", slices_global = filtrer_manager_results$slices_global, mapping_matrix = filtrer_manager_results$mapping_matrix, filtered_data_list = filtrer_manager_results$filtered_data_list, From b950e31484459acfbbb1d3ebd176f8f85bac3edb Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 13 Mar 2024 17:54:25 +0100 Subject: [PATCH 045/117] rename grab to bookmark --- R/module_bookmark_manager.R | 60 ++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 323626f331..1a34ffc2ae 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -23,10 +23,10 @@ bookmark_manager_ui <- function(id) { div( class = "snapshot_table_row", span(tags$b("Bookmark manager")), - actionLink(ns("grab_add"), NULL, icon = suppressMessages(icon("solid fa-bookmark")), title = "grab input state"), + actionLink(ns("bookmark_add"), NULL, icon = suppressMessages(icon("solid fa-bookmark")), title = "add bookmark"), NULL ), - uiOutput(ns("grab_list")) + uiOutput(ns("bookmark_list")) ) } @@ -48,7 +48,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") # Store input states. - grab_history <- reactiveVal({ + bookmark_history <- reactiveVal({ list() }) @@ -57,9 +57,9 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) state$values$filter_state_on_bookmark <- snapshot - # Add snapshot history and grab history to bookmark. + # Add snapshot history and bookmark history to bookmark. state$values$snapshot_history <- snapshot_history() # isolate this? - state$values$grab_history <- grab_history() # isolate this? + state$values$bookmark_history <- bookmark_history() # isolate this? }) app_session$onRestored(function(state) { # Restore filter state. @@ -76,42 +76,42 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat filter_ids = mapping_unfolded ) slices_global(snapshot_state) - # Restore snapshot history and grab history. + # Restore snapshot history and bookmark history. snapshot_history(state$values$snapshot_history) - grab_history(state$values$grab_history) + bookmark_history(state$values$bookmark_history) }) app_session$onBookmarked(function(url) { - grab_name <- trimws(input$grab_name) - if (identical(grab_name, "")) { + bookmark_name <- trimws(input$bookmark_name) + if (identical(bookmark_name, "")) { showNotification( - "Please name the grab.", + "Please name the bookmark.", type = "message" ) - updateTextInput(inputId = "grab_name", value = "", placeholder = "Meaningful, unique name") + updateTextInput(inputId = "bookmark_name", value = "", placeholder = "Meaningful, unique name") unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) - } else if (is.element(make.names(grab_name), make.names(names(grab_history())))) { + } else if (is.element(make.names(bookmark_name), make.names(names(bookmark_history())))) { showNotification( - "This name is in conflict with other grab names. Please choose a different one.", + "This name is in conflict with other bookmark names. Please choose a different one.", type = "message" ) - updateTextInput(inputId = "grab_name", value = , placeholder = "Meaningful, unique name") + updateTextInput(inputId = "bookmark_name", value = , placeholder = "Meaningful, unique name") unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else { - # Add bookmark URL to grab history (with name). - grab_update <- c(grab_history(), list(url)) - names(grab_update)[length(grab_update)] <- grab_name - grab_history(grab_update) + # Add bookmark URL to bookmark history (with name). + bookmark_update <- c(bookmark_history(), list(url)) + names(bookmark_update)[length(bookmark_update)] <- bookmark_name + bookmark_history(bookmark_update) removeModal() } }) - # Grab current input state - name grab. - observeEvent(input$grab_add, { + # Bookmark current input state - name bookmark. + observeEvent(input$bookmark_add, { showModal( modalDialog( - textInput(ns("grab_name"), "Name the grab", width = "100%", placeholder = "Meaningful, unique name"), + textInput(ns("bookmark_name"), "Name the bookmark", width = "100%", placeholder = "Meaningful, unique name"), footer = tagList( bookmarkButton("Accept", icon = icon("thumbs-up")), modalButton(label = "Cancel", icon = icon("thumbs-down")) @@ -121,37 +121,37 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat ) }) - # Create UI elements and server logic for the grab table. + # Create UI elements and server logic for the bookmark table. # Divs are tracked for a slight speed margin. divs <- reactiveValues() - observeEvent(grab_history(), { - lapply(names(grab_history()), function(s) { + observeEvent(bookmark_history(), { + lapply(names(bookmark_history()), function(s) { id_rowme <- sprintf("rowme_%s", make.names(s)) - # Create a row for the grab table. + # Create a row for the bookmark table. if (!is.element(id_rowme, names(divs))) { divs[[id_rowme]] <- div( class = "snapshot_table_row", - a(h5(s), title = "restore bookmark", href = grab_history()[[s]], target = "blank") + a(h5(s), title = "go to bookmark", href = bookmark_history()[[s]], target = "blank") ) } }) }) - # Create table to display list of grabs and their actions. - output$grab_list <- renderUI({ + # Create table to display list of bookmarks and their actions. + output$bookmark_list <- renderUI({ rows <- lapply(rev(reactiveValuesToList(divs)), function(d) d) if (length(rows) == 0L) { div( class = "snapshot_manager_placeholder", - "Input states will appear here." + "Bookmarks will appear here." ) } else { rows } }) - grab_history + bookmark_history }) } From a3d2147b7ad04310c392f20864223cf8066eeb1e Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 11:00:51 +0100 Subject: [PATCH 046/117] fix typo --- R/module_wunder_bar.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index b1797918ac..e080a4e875 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -77,22 +77,22 @@ wunder_bar_srv <- function(id, filtered_data_list, filter) { ) }) - filtrer_manager_results <- filter_manager_srv( + filter_manager_results <- filter_manager_srv( id = "filter_manager", filtered_data_list = filtered_data_list, filter = filter ) snapshot_history <- snapshot_manager_srv( id = "snapshot_manager", - slices_global = filtrer_manager_results$slices_global, - mapping_matrix = filtrer_manager_results$mapping_matrix, - filtered_data_list = filtrer_manager_results$filtered_data_list + slices_global = filter_manager_results$slices_global, + mapping_matrix = filter_manager_results$mapping_matrix, + filtered_data_list = filter_manager_results$filtered_data_list ) bookmark_manager_srv( id = "bookmark_manager", - slices_global = filtrer_manager_results$slices_global, - mapping_matrix = filtrer_manager_results$mapping_matrix, - filtered_data_list = filtrer_manager_results$filtered_data_list, + slices_global = filter_manager_results$slices_global, + mapping_matrix = filter_manager_results$mapping_matrix, + filtered_data_list = filter_manager_results$filtered_data_list, snapshot_history = snapshot_history ) From 214930691cf6d6c26c3bb310480431d9c78ffb1c Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 11:41:32 +0100 Subject: [PATCH 047/117] separate utility function in filter manager --- R/module_filter_manager.R | 45 +++++++++++++++++++++++++++++++-------- 1 file changed, 36 insertions(+), 9 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 09c00b4f4f..d828cfb522 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -51,15 +51,6 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # List of length one is named "global_filters" because that name is forbidden for a module label. list(global_filters = unlist(filtered_data_list)[[1]]) } else { - # Flatten potentially nested list of FilteredData objects while maintaining useful names. - # Simply using `unlist` would result in concatenated names. - flatten_nested <- function(x, name = NULL) { - if (inherits(x, "FilteredData")) { - setNames(list(x), name) - } else { - unlist(lapply(names(x), function(name) flatten_nested(x[[name]], name))) - } - } flatten_nested(filtered_data_list) } @@ -178,3 +169,39 @@ filter_manager_module_srv <- function(id, module_fd, slices_global) { slices_module # returned for testing purpose }) } + + + +# utilities ---- + +# Flatten potentially nested list of FilteredData objects while maintaining useful names. +# Simply using `unlist` would result in concatenated names. +#' @keywords internal +#' @noRd +#' +flatten_nested <- function(x, name = NULL) { + if (inherits(x, "FilteredData")) { + setNames(list(x), name) + } else { + unlist(lapply(names(x), function(name) flatten_nested(x[[name]], name))) + } +} + +#' # Create mapping fo filters to modules in matrix form (presented as data.frame). +#' # Modules get NAs for filters that cannot be set for them. +#' #' @keywords internal +#' #' @noRd +#' #' +#' create_mapping_matrix <- function(filtered_data_list, slices_global) { +#' reactive({ +#' state_ids_global <- vapply(slices_global(), `[[`, character(1L), "id") +#' mapping_smooth <- lapply(filtered_data_list, function(x) { +#' state_ids_local <- vapply(x$get_filter_state(), `[[`, character(1L), "id") +#' state_ids_allowed <- vapply(x$get_available_teal_slices()(), `[[`, character(1L), "id") +#' states_active <- state_ids_global %in% state_ids_local +#' ifelse(state_ids_global %in% state_ids_allowed, states_active, NA) +#' }) +#' +#' as.data.frame(mapping_smooth, row.names = state_ids_global, check.names = FALSE) +#' }) +#' } From af3ebfcfeefc8061ade0d72e16e3eb9d59f19394 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 12:02:10 +0100 Subject: [PATCH 048/117] move renaming of global filtered data list --- R/module_filter_manager.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index d828cfb522..0233b2bd73 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -48,8 +48,8 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { filtered_data_list <- if (!is_module_specific) { # Retrieve the first FilteredData from potentially nested list. - # List of length one is named "global_filters" because that name is forbidden for a module label. - list(global_filters = unlist(filtered_data_list)[[1]]) + # List of length one is named "Global Filters" because that name used in the mapping matrix display. + list("Global Filters" = unlist(filtered_data_list)[[1]]) } else { flatten_nested(filtered_data_list) } @@ -74,7 +74,6 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { mm <- mapping_matrix() mm[] <- lapply(mm, ifelse, yes = intToUtf8(9989), no = intToUtf8(10060)) mm[] <- lapply(mm, function(x) ifelse(is.na(x), intToUtf8(128306), x)) - if (!is_module_specific) colnames(mm) <- "Global Filters" # Display placeholder if no filters defined. if (nrow(mm) == 0L) { From 8ba143a19709255c927984ade86d535d89a42c1b Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 12:47:36 +0100 Subject: [PATCH 049/117] rename flat filtered data list and tweak utility function --- R/module_filter_manager.R | 43 +++++++++++---------------------------- 1 file changed, 12 insertions(+), 31 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 0233b2bd73..a58e205b79 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -45,20 +45,18 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Down there a subset that pertains to the data sets used in that module is applied and displayed. slices_global <- reactiveVal(filter) - filtered_data_list <- + filtered_data_flat <- if (!is_module_specific) { - # Retrieve the first FilteredData from potentially nested list. - # List of length one is named "Global Filters" because that name used in the mapping matrix display. - list("Global Filters" = unlist(filtered_data_list)[[1]]) + flatten_filtered_data_list(unlist(filtered_data_list)[[1]]) } else { - flatten_nested(filtered_data_list) + flatten_filtered_data_list(filtered_data_list) } # Create mapping of filters to modules in matrix form (presented as data.frame). # Modules get NAs for filters that cannot be set for them. mapping_matrix <- reactive({ state_ids_global <- vapply(slices_global(), `[[`, character(1L), "id") - mapping_smooth <- lapply(filtered_data_list, function(x) { + mapping_smooth <- lapply(filtered_data_flat, function(x) { state_ids_local <- vapply(x$get_filter_state(), `[[`, character(1L), "id") state_ids_allowed <- vapply(x$get_available_teal_slices()(), `[[`, character(1L), "id") states_active <- state_ids_global %in% state_ids_local @@ -84,15 +82,15 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Report Previewer will not be displayed. mm[names(mm) != "Report previewer"] }, - align = paste(c("l", rep("c", sum(names(filtered_data_list) != "Report previewer"))), collapse = ""), + align = paste(c("l", rep("c", sum(names(filtered_data_flat) != "Report previewer"))), collapse = ""), rownames = TRUE ) # Create list of module calls. - modules_out <- lapply(names(filtered_data_list), function(module_name) { + modules_out <- lapply(names(filtered_data_flat), function(module_name) { filter_manager_module_srv( id = module_name, - module_fd = filtered_data_list[[module_name]], + module_fd = filtered_data_flat[[module_name]], slices_global = slices_global ) }) @@ -100,7 +98,7 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { list( slices_global = slices_global, mapping_matrix = mapping_matrix, - filtered_data_list = filtered_data_list, + filtered_data_flat = filtered_data_flat, modules_out = modules_out # returned for testing purpose ) }) @@ -173,34 +171,17 @@ filter_manager_module_srv <- function(id, module_fd, slices_global) { # utilities ---- +# Retrieve the first FilteredData from potentially nested list. +# List of length one is named "Global Filters" because that name used in the mapping matrix display. # Flatten potentially nested list of FilteredData objects while maintaining useful names. # Simply using `unlist` would result in concatenated names. #' @keywords internal #' @noRd #' -flatten_nested <- function(x, name = NULL) { +flatten_filtered_data_list <- function(x, name = "Global Filters") { if (inherits(x, "FilteredData")) { setNames(list(x), name) } else { - unlist(lapply(names(x), function(name) flatten_nested(x[[name]], name))) + unlist(lapply(names(x), function(name) flatten_filtered_data_list(x[[name]], name))) } } - -#' # Create mapping fo filters to modules in matrix form (presented as data.frame). -#' # Modules get NAs for filters that cannot be set for them. -#' #' @keywords internal -#' #' @noRd -#' #' -#' create_mapping_matrix <- function(filtered_data_list, slices_global) { -#' reactive({ -#' state_ids_global <- vapply(slices_global(), `[[`, character(1L), "id") -#' mapping_smooth <- lapply(filtered_data_list, function(x) { -#' state_ids_local <- vapply(x$get_filter_state(), `[[`, character(1L), "id") -#' state_ids_allowed <- vapply(x$get_available_teal_slices()(), `[[`, character(1L), "id") -#' states_active <- state_ids_global %in% state_ids_local -#' ifelse(state_ids_global %in% state_ids_allowed, states_active, NA) -#' }) -#' -#' as.data.frame(mapping_smooth, row.names = state_ids_global, check.names = FALSE) -#' }) -#' } From 6a3689a28e341ad60434582bda5a1109410aaec2 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 12:56:19 +0100 Subject: [PATCH 050/117] rename filtered_data_list to datasets --- R/module_bookmark_manager.R | 8 ++++---- R/module_filter_manager.R | 10 +++++----- R/module_snapshot_manager.R | 20 ++++++++++---------- R/module_tabs_with_filters.R | 2 +- R/module_wunder_bar.R | 8 ++++---- 5 files changed, 24 insertions(+), 24 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 1a34ffc2ae..e2453a5501 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -33,13 +33,13 @@ bookmark_manager_ui <- function(id) { #' @rdname bookmark_manager_module #' @keywords internal #' -bookmark_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_list, snapshot_history) { +bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, snapshot_history) { checkmate::assert_character(id) checkmate::assert_true(is.reactive(slices_global)) checkmate::assert_class(isolate(slices_global()), "teal_slices") checkmate::assert_true(is.reactive(mapping_matrix)) checkmate::assert_data_frame(isolate(mapping_matrix()), null.ok = TRUE) - checkmate::assert_list(filtered_data_list, types = "FilteredData", any.missing = FALSE, names = "named") + checkmate::assert_list(datasets, types = "FilteredData", any.missing = FALSE, names = "named") checkmate::assert_true(is.reactive(snapshot_history)) checkmate::assert_list(isolate(snapshot_history()), names = "unique") @@ -65,14 +65,14 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat # Restore filter state. snapshot <- state$values$filter_state_on_bookmark snapshot_state <- as.teal_slices(snapshot) - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) mapply( function(filtered_data, filter_ids) { filtered_data$clear_filter_states(force = TRUE) slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) filtered_data$set_filter_state(slices) }, - filtered_data = filtered_data_list, + filtered_data = datasets, filter_ids = mapping_unfolded ) slices_global(snapshot_state) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index a58e205b79..490ec6ec1f 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -11,7 +11,7 @@ #' #' @param id (`character(1)`) #' `shiny` module id. -#' @param filtered_data_list (named `list`) +#' @param datasets (named `list`) #' A list, possibly nested, of `FilteredData` objects. #' Each `FilteredData` will be served to one module in the `teal` application. #' The structure of the list must reflect the nesting of modules in tabs @@ -33,9 +33,9 @@ filter_manager_ui <- function(id) { } #' @rdname module_filter_manager -filter_manager_srv <- function(id, filtered_data_list, filter) { +filter_manager_srv <- function(id, datasets, filter) { moduleServer(id, function(input, output, session) { - logger::log_trace("filter_manager_srv initializing for: { paste(names(filtered_data_list), collapse = ', ')}.") + logger::log_trace("filter_manager_srv initializing for: { paste(names(datasets), collapse = ', ')}.") is_module_specific <- isTRUE(attr(filter, "module_specific")) @@ -47,9 +47,9 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { filtered_data_flat <- if (!is_module_specific) { - flatten_filtered_data_list(unlist(filtered_data_list)[[1]]) + flatten_filtered_data_list(unlist(datasets)[[1]]) } else { - flatten_filtered_data_list(filtered_data_list) + flatten_filtered_data_list(datasets) } # Create mapping of filters to modules in matrix form (presented as data.frame). diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 6056570125..15ee45c1d9 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -44,7 +44,7 @@ #' This is substituted as the snapshot's `mapping` attribute and the snapshot is added to the snapshot list. #' #' To restore app state, a snapshot is retrieved from storage and rebuilt into a `teal_slices` object. -#' Then state of all `FilteredData` objects (provided in `filtered_data_list`) is cleared +#' Then state of all `FilteredData` objects (provided in `datasets`) is cleared #' and set anew according to the `mapping` attribute of the snapshot. #' The snapshot is then set as the current content of `slices_global`. #' @@ -71,7 +71,7 @@ #' @param mapping_matrix (`reactive`) that contains a `data.frame` representation #' of the mapping of filter state ids (rows) to modules labels (columns); #' all columns are `logical` vectors -#' @param filtered_data_list non-nested (named `list`) that contains `FilteredData` objects +#' @param datasets non-nested (named `list`) that contains `FilteredData` objects #' #' @return Nothing is returned. #' @@ -102,13 +102,13 @@ snapshot_manager_ui <- function(id) { #' @rdname snapshot_manager_module #' @keywords internal #' -snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_list) { +snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { checkmate::assert_character(id) checkmate::assert_true(is.reactive(slices_global)) checkmate::assert_class(isolate(slices_global()), "teal_slices") checkmate::assert_true(is.reactive(mapping_matrix)) checkmate::assert_data_frame(isolate(mapping_matrix()), null.ok = TRUE) - checkmate::assert_list(filtered_data_list, types = "FilteredData", any.missing = FALSE, names = "named") + checkmate::assert_list(datasets, types = "FilteredData", any.missing = FALSE, names = "named") moduleServer(id, function(input, output, session) { ns <- session$ns @@ -213,14 +213,14 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat names(snapshot_update)[length(snapshot_update)] <- snapshot_name snapshot_history(snapshot_update) ### Begin simplified restore procedure. ### - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) mapply( function(filtered_data, filter_ids) { filtered_data$clear_filter_states(force = TRUE) slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) filtered_data$set_filter_state(slices) }, - filtered_data = filtered_data_list, + filtered_data = datasets, filter_ids = mapping_unfolded ) slices_global(snapshot_state) @@ -237,14 +237,14 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat ### Begin restore procedure. ### snapshot <- snapshot_history()[[s]] snapshot_state <- as.teal_slices(snapshot) - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) mapply( function(filtered_data, filter_ids) { filtered_data$clear_filter_states(force = TRUE) slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) filtered_data$set_filter_state(slices) }, - filtered_data = filtered_data_list, + filtered_data = datasets, filter_ids = mapping_unfolded ) slices_global(snapshot_state) @@ -272,14 +272,14 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat ### Begin restore procedure. ### snapshot <- snapshot_history()[[s]] snapshot_state <- as.teal_slices(snapshot) - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) mapply( function(filtered_data, filter_ids) { filtered_data$clear_filter_states(force = TRUE) slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) filtered_data$set_filter_state(slices) }, - filtered_data = filtered_data_list, + filtered_data = datasets, filter_ids = mapping_unfolded ) slices_global(snapshot_state) diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index c6a72822d8..edb1e686fd 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -84,7 +84,7 @@ srv_tabs_with_filters <- function(id, logger::log_trace("srv_tabs_with_filters initializing the module.") is_module_specific <- isTRUE(attr(filter, "module_specific")) - wunder_bar_out <- wunder_bar_srv("wunder_bar", filtered_data_list = datasets, filter = filter) + wunder_bar_out <- wunder_bar_srv("wunder_bar", datasets, filter) active_module <- srv_nested_tabs( id = "root", diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index e080a4e875..3e999b26af 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -36,7 +36,7 @@ wunder_bar_ui <- function(id) { } #' @rdname module_filter_manager_modal -wunder_bar_srv <- function(id, filtered_data_list, filter) { +wunder_bar_srv <- function(id, datasets, filter) { moduleServer(id, function(input, output, session) { ns <- session$ns @@ -79,20 +79,20 @@ wunder_bar_srv <- function(id, filtered_data_list, filter) { filter_manager_results <- filter_manager_srv( id = "filter_manager", - filtered_data_list = filtered_data_list, + datasets = datasets, filter = filter ) snapshot_history <- snapshot_manager_srv( id = "snapshot_manager", slices_global = filter_manager_results$slices_global, mapping_matrix = filter_manager_results$mapping_matrix, - filtered_data_list = filter_manager_results$filtered_data_list + datasets = filter_manager_results$filtered_data_flat ) bookmark_manager_srv( id = "bookmark_manager", slices_global = filter_manager_results$slices_global, mapping_matrix = filter_manager_results$mapping_matrix, - filtered_data_list = filter_manager_results$filtered_data_list, + datasets = filter_manager_results$filtered_data_flat, snapshot_history = snapshot_history ) From fe0afb0d85b08a410bd6a77d8982e0bef0f205ea Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 12:59:02 +0100 Subject: [PATCH 051/117] rename filtered_data_flat to datasets_flat --- R/module_filter_manager.R | 20 ++++++++++---------- R/module_wunder_bar.R | 4 ++-- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 490ec6ec1f..3c7a8f79f6 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -45,18 +45,18 @@ filter_manager_srv <- function(id, datasets, filter) { # Down there a subset that pertains to the data sets used in that module is applied and displayed. slices_global <- reactiveVal(filter) - filtered_data_flat <- + datasets_flat <- if (!is_module_specific) { - flatten_filtered_data_list(unlist(datasets)[[1]]) + flatten_datasets(unlist(datasets)[[1]]) } else { - flatten_filtered_data_list(datasets) + flatten_datasets(datasets) } # Create mapping of filters to modules in matrix form (presented as data.frame). # Modules get NAs for filters that cannot be set for them. mapping_matrix <- reactive({ state_ids_global <- vapply(slices_global(), `[[`, character(1L), "id") - mapping_smooth <- lapply(filtered_data_flat, function(x) { + mapping_smooth <- lapply(datasets_flat, function(x) { state_ids_local <- vapply(x$get_filter_state(), `[[`, character(1L), "id") state_ids_allowed <- vapply(x$get_available_teal_slices()(), `[[`, character(1L), "id") states_active <- state_ids_global %in% state_ids_local @@ -82,15 +82,15 @@ filter_manager_srv <- function(id, datasets, filter) { # Report Previewer will not be displayed. mm[names(mm) != "Report previewer"] }, - align = paste(c("l", rep("c", sum(names(filtered_data_flat) != "Report previewer"))), collapse = ""), + align = paste(c("l", rep("c", sum(names(datasets_flat) != "Report previewer"))), collapse = ""), rownames = TRUE ) # Create list of module calls. - modules_out <- lapply(names(filtered_data_flat), function(module_name) { + modules_out <- lapply(names(datasets_flat), function(module_name) { filter_manager_module_srv( id = module_name, - module_fd = filtered_data_flat[[module_name]], + module_fd = datasets_flat[[module_name]], slices_global = slices_global ) }) @@ -98,7 +98,7 @@ filter_manager_srv <- function(id, datasets, filter) { list( slices_global = slices_global, mapping_matrix = mapping_matrix, - filtered_data_flat = filtered_data_flat, + datasets_flat = datasets_flat, modules_out = modules_out # returned for testing purpose ) }) @@ -178,10 +178,10 @@ filter_manager_module_srv <- function(id, module_fd, slices_global) { #' @keywords internal #' @noRd #' -flatten_filtered_data_list <- function(x, name = "Global Filters") { +flatten_datasets <- function(x, name = "Global Filters") { if (inherits(x, "FilteredData")) { setNames(list(x), name) } else { - unlist(lapply(names(x), function(name) flatten_filtered_data_list(x[[name]], name))) + unlist(lapply(names(x), function(name) flatten_datasets(x[[name]], name))) } } diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 3e999b26af..9cf1e9b305 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -86,13 +86,13 @@ wunder_bar_srv <- function(id, datasets, filter) { id = "snapshot_manager", slices_global = filter_manager_results$slices_global, mapping_matrix = filter_manager_results$mapping_matrix, - datasets = filter_manager_results$filtered_data_flat + datasets = filter_manager_results$datasets_flat ) bookmark_manager_srv( id = "bookmark_manager", slices_global = filter_manager_results$slices_global, mapping_matrix = filter_manager_results$mapping_matrix, - datasets = filter_manager_results$filtered_data_flat, + datasets = filter_manager_results$datasets_flat, snapshot_history = snapshot_history ) From e59ab91973168e03539d0494e357d96be1735a06 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 13:18:28 +0100 Subject: [PATCH 052/117] improve documentation for flatten_datasets --- R/module_filter_manager.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 3c7a8f79f6..11a7382144 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -171,10 +171,13 @@ filter_manager_module_srv <- function(id, module_fd, slices_global) { # utilities ---- -# Retrieve the first FilteredData from potentially nested list. -# List of length one is named "Global Filters" because that name used in the mapping matrix display. -# Flatten potentially nested list of FilteredData objects while maintaining useful names. -# Simply using `unlist` would result in concatenated names. +#' Flatten potentially nested list of FilteredData objects while maintaining useful names. +#' Simply using `unlist` would result in concatenated names. +#' A single `FilteredData` will result in a list named "Global Filters" +#' because that name used in the mapping matrix display. +#' @param x `FilteredData` or a `list` thereof +#' @param name (`character(1)`) string used to name `x` in the resulting list +#' @return Unnested named list of `FilteredData` objects. #' @keywords internal #' @noRd #' From 2b08206dc50cc666df95d41bbba7ffe069eb815c Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 14:00:31 +0100 Subject: [PATCH 053/117] add logging to all manager modules --- R/module_bookmark_manager.R | 12 ++++++++++++ R/module_snapshot_manager.R | 18 ++++++++++++++++++ R/module_wunder_bar.R | 1 + 3 files changed, 31 insertions(+) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index e2453a5501..3eaddb86fd 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -44,6 +44,8 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn checkmate::assert_list(isolate(snapshot_history()), names = "unique") moduleServer(id, function(input, output, session) { + logger::log_trace("bookmark_manager_srv initializing") + ns <- session$ns app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") @@ -54,15 +56,18 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn app_session$onBookmark(function(state) { # Add current filter state to bookmark. + logger::log_trace("bookmark_manager_srv: onBookmark hook: storing filter state") snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) state$values$filter_state_on_bookmark <- snapshot # Add snapshot history and bookmark history to bookmark. + logger::log_trace("bookmark_manager_srv: onBookmark hook: storing snapshot and bookmark history") state$values$snapshot_history <- snapshot_history() # isolate this? state$values$bookmark_history <- bookmark_history() # isolate this? }) app_session$onRestored(function(state) { # Restore filter state. + logger::log_trace("bookmark_manager_srv: onRestored hook: restoring filter state") snapshot <- state$values$filter_state_on_bookmark snapshot_state <- as.teal_slices(snapshot) mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) @@ -77,13 +82,16 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn ) slices_global(snapshot_state) # Restore snapshot history and bookmark history. + logger::log_trace("bookmark_manager_srv: onRestored hook: restoring snapshot and bookmark history") snapshot_history(state$values$snapshot_history) bookmark_history(state$values$bookmark_history) }) app_session$onBookmarked(function(url) { + logger::log_trace("bookmark_manager_srv: onBookmarked hook: bookmark button clicked, registering bookmark") bookmark_name <- trimws(input$bookmark_name) if (identical(bookmark_name, "")) { + logger::log_trace("bookmark_manager_srv: onBookmarked hook: bookmark name rejected") showNotification( "Please name the bookmark.", type = "message" @@ -91,6 +99,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn updateTextInput(inputId = "bookmark_name", value = "", placeholder = "Meaningful, unique name") unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else if (is.element(make.names(bookmark_name), make.names(names(bookmark_history())))) { + logger::log_trace("bookmark_manager_srv: onBookmarked hook: bookmark name rejected") showNotification( "This name is in conflict with other bookmark names. Please choose a different one.", type = "message" @@ -99,6 +108,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else { # Add bookmark URL to bookmark history (with name). + logger::log_trace("bookmark_manager_srv: onBookmarked hook: bookmark name accepted, adding to history") bookmark_update <- c(bookmark_history(), list(url)) names(bookmark_update)[length(bookmark_update)] <- bookmark_name bookmark_history(bookmark_update) @@ -109,6 +119,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn # Bookmark current input state - name bookmark. observeEvent(input$bookmark_add, { + logger::log_trace("bookmark_manager_srv: bookmark_add button clicked") showModal( modalDialog( textInput(ns("bookmark_name"), "Name the bookmark", width = "100%", placeholder = "Meaningful, unique name"), @@ -126,6 +137,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn divs <- reactiveValues() observeEvent(bookmark_history(), { + logger::log_trace("bookmark_manager_srv: bookmark history changed, updating bookmark list") lapply(names(bookmark_history()), function(s) { id_rowme <- sprintf("rowme_%s", make.names(s)) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 15ee45c1d9..044da28622 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -111,6 +111,8 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { checkmate::assert_list(datasets, types = "FilteredData", any.missing = FALSE, names = "named") moduleServer(id, function(input, output, session) { + logger::log_trace("snapshot_manager_srv initializing") + ns <- session$ns # Store global filter states ---- @@ -124,6 +126,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { # Snapshot current application state ---- # Name snaphsot. observeEvent(input$snapshot_add, { + logger::log_trace("snapshot_manager_srv: snapshot_add button clicked") showModal( modalDialog( textInput(ns("snapshot_name"), "Name the snapshot", width = "100%", placeholder = "Meaningful, unique name"), @@ -137,20 +140,24 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { }) # Store snaphsot. observeEvent(input$snapshot_name_accept, { + logger::log_trace("snapshot_manager_srv: snapshot_name_accept button clicked") snapshot_name <- trimws(input$snapshot_name) if (identical(snapshot_name, "")) { + logger::log_trace("snapshot_manager_srv: snapshot name rejected") showNotification( "Please name the snapshot.", type = "message" ) updateTextInput(inputId = "snapshot_name", value = "", placeholder = "Meaningful, unique name") } else if (is.element(make.names(snapshot_name), make.names(names(snapshot_history())))) { + logger::log_trace("snapshot_manager_srv: snapshot name rejected") showNotification( "This name is in conflict with other snapshot names. Please choose a different one.", type = "message" ) updateTextInput(inputId = "snapshot_name", value = "", placeholder = "Meaningful, unique name") } else { + logger::log_trace("snapshot_manager_srv: snapshot name accepted, adding snapshot") snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) snapshot_update <- c(snapshot_history(), list(snapshot)) @@ -165,6 +172,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { # Upload a snapshot file ---- # Select file. observeEvent(input$snapshot_load, { + logger::log_trace("snapshot_manager_srv: snapshot_load button clicked") showModal( modalDialog( fileInput(ns("snapshot_file"), "Choose snapshot file", accept = ".json", width = "100%"), @@ -183,11 +191,14 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { }) # Store new snapshot to list and restore filter states. observeEvent(input$snaphot_file_accept, { + logger::log_trace("snapshot_manager_srv: snapshot_file_accept button clicked") snapshot_name <- trimws(input$snapshot_name) if (identical(snapshot_name, "")) { + logger::log_trace("snapshot_manager_srv: snapshot name rejected") snapshot_name <- tools::file_path_sans_ext(input$snapshot_file$name) } if (is.element(make.names(snapshot_name), make.names(names(snapshot_history())))) { + logger::log_trace("snapshot_manager_srv: snapshot name rejected") showNotification( "This name is in conflict with other snapshot names. Please choose a different one.", type = "message" @@ -195,24 +206,29 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { updateTextInput(inputId = "snapshot_name", value = "", placeholder = "Meaningful, unique name") } else { # Restore snapshot and verify app compatibility. + logger::log_trace("snapshot_manager_srv: snapshot name accepted, loading snapshot") snapshot_state <- try(slices_restore(input$snapshot_file$datapath)) if (!inherits(snapshot_state, "modules_teal_slices")) { + logger::log_trace("snapshot_manager_srv: snapshot file corrupt") showNotification( "File appears to be corrupt.", type = "error" ) } else if (!identical(attr(snapshot_state, "app_id"), attr(slices_global(), "app_id"))) { + logger::log_trace("snapshot_manager_srv: snapshot not compatible with app") showNotification( "This snapshot file is not compatible with the app and cannot be loaded.", type = "warning" ) } else { # Add to snapshot history. + logger::log_trace("snapshot_manager_srv: snapshot loaded, adding to history") snapshot <- as.list(snapshot_state, recursive = TRUE) snapshot_update <- c(snapshot_history(), list(snapshot)) names(snapshot_update)[length(snapshot_update)] <- snapshot_name snapshot_history(snapshot_update) ### Begin simplified restore procedure. ### + logger::log_trace("snapshot_manager_srv: restoring snapshot") mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) mapply( function(filtered_data, filter_ids) { @@ -233,6 +249,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { # Restore initial state ---- observeEvent(input$snapshot_reset, { + logger::log_trace("snapshot_manager_srv: snapshot_reset button clicked, restoring snapshot") s <- "Initial application state" ### Begin restore procedure. ### snapshot <- snapshot_history()[[s]] @@ -261,6 +278,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { divs <- reactiveValues() observeEvent(snapshot_history(), { + logger::log_trace("snapshot_manager_srv: snapshot history modified, updating snapshot list") lapply(names(snapshot_history())[-1L], function(s) { id_pickme <- sprintf("pickme_%s", make.names(s)) id_saveme <- sprintf("saveme_%s", make.names(s)) diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 9cf1e9b305..47cb743824 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -38,6 +38,7 @@ wunder_bar_ui <- function(id) { #' @rdname module_filter_manager_modal wunder_bar_srv <- function(id, datasets, filter) { moduleServer(id, function(input, output, session) { + logger::log_trace("wunder_bar_srv initializing") ns <- session$ns From 3b82671687707cc0a4e99c8df3bbb61a93cfac47 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 14:01:48 +0100 Subject: [PATCH 054/117] update name of programmatically clicked button --- R/module_snapshot_manager.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 044da28622..4043c23ac5 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -165,7 +165,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { snapshot_history(snapshot_update) removeModal() # Reopen filter manager modal by clicking button in the main application. - shinyjs::click(id = "teal-main_ui-filter_manager-show", asis = TRUE) + shinyjs::click(id = "teal-main_ui-wunder_bar-show_snapshot_manager", asis = TRUE) } }) From 4371359f8695ba4a68c97c9a359031565361cdba Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 14:03:38 +0100 Subject: [PATCH 055/117] fix erroneous log --- R/module_snapshot_manager.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 4043c23ac5..3d31f67d1c 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -194,7 +194,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { logger::log_trace("snapshot_manager_srv: snapshot_file_accept button clicked") snapshot_name <- trimws(input$snapshot_name) if (identical(snapshot_name, "")) { - logger::log_trace("snapshot_manager_srv: snapshot name rejected") + logger::log_trace("snapshot_manager_srv: no snapshot name provided, naming after file") snapshot_name <- tools::file_path_sans_ext(input$snapshot_file$name) } if (is.element(make.names(snapshot_name), make.names(names(snapshot_history())))) { From 5d62ff4ef3cad8176a09152aabbc83dfef01dd38 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 15:57:39 +0100 Subject: [PATCH 056/117] remove delayed module initiation when starting from bookmark --- R/module_nested_tabs.R | 35 +++++++++++++++++++++++------------ 1 file changed, 23 insertions(+), 12 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 07825917ca..ee0f153f53 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -216,19 +216,30 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi args <- c(args, filter_panel_api = filter_panel_api) } - # observe the trigger_module above to induce the module once the renderUI is triggered - observeEvent( - ignoreNULL = TRUE, - once = TRUE, - eventExpr = trigger_module(), - handlerExpr = { - module_output <- if (is_arg_used(modules$server, "id")) { - do.call(modules$server, args) - } else { - do.call(callModule, c(args, list(module = modules$server))) - } + # This function calls a module server function. + call_module <- function() { + if (is_arg_used(modules$server, "id")) { + do.call(modules$server, args) + } else { + do.call(callModule, c(args, list(module = modules$server))) } - ) + } + + # Call modules. + if (.subset2(session, "parent")$restoreContext$active) { + # When restoring bookmark, all modules must be initialized on app start. + # Delayed module initiation (below) precludes restoring state b/c inputs do not exist when restoring occurs. + call_module() + } else { + # When app starts normally, modules are initialized only when corresponding tabs are clicked. + # This is done by observing trigger_module (see above) to induce the module only when renderUI is triggered. + observeEvent( + ignoreNULL = TRUE, + once = TRUE, + eventExpr = trigger_module(), + handlerExpr = call_module() + ) + } reactive(modules) }) From 23d408d9b564ed14c941ce3525194f4ae6dee5d2 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 16:12:25 +0100 Subject: [PATCH 057/117] bug fix: missing argument value --- R/module_bookmark_manager.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 3eaddb86fd..49c59833d3 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -104,7 +104,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn "This name is in conflict with other bookmark names. Please choose a different one.", type = "message" ) - updateTextInput(inputId = "bookmark_name", value = , placeholder = "Meaningful, unique name") + updateTextInput(inputId = "bookmark_name", value = "", placeholder = "Meaningful, unique name") unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else { # Add bookmark URL to bookmark history (with name). From c4b669cf4591b07cd9b2ad2a6b6d6919932fdf35 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 16:20:12 +0100 Subject: [PATCH 058/117] fix update in example module --- R/dummy_functions.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 19abbaa16d..e59fa06917 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -20,7 +20,11 @@ example_module <- function(label = "example teal module", datanames = "all") { server = function(id, data) { checkmate::assert_class(data(), "teal_data") moduleServer(id, function(input, output, session) { - updateSelectInput(session, "dataname", choices = isolate(teal.data::datanames(data()))) + updateSelectInput( + inputId = "dataname", + choices = isolate(teal.data::datanames(data())), + selected = restoreInput(session$ns("dataname"), NULL) + ) output$text <- renderPrint({ req(input$dataname) data()[[input$dataname]] From 6d07bd22c83a4e837021eb2458be9f032deb4653 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 17:36:35 +0100 Subject: [PATCH 059/117] improve logs in bookmark manager --- R/module_bookmark_manager.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 49c59833d3..c6913cd226 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -56,18 +56,18 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn app_session$onBookmark(function(state) { # Add current filter state to bookmark. - logger::log_trace("bookmark_manager_srv: onBookmark hook: storing filter state") + logger::log_trace("bookmark_manager_srv@onBookmark: storing filter state") snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) state$values$filter_state_on_bookmark <- snapshot # Add snapshot history and bookmark history to bookmark. - logger::log_trace("bookmark_manager_srv: onBookmark hook: storing snapshot and bookmark history") + logger::log_trace("bookmark_manager_srv@onBookmark: storing snapshot and bookmark history") state$values$snapshot_history <- snapshot_history() # isolate this? state$values$bookmark_history <- bookmark_history() # isolate this? }) app_session$onRestored(function(state) { # Restore filter state. - logger::log_trace("bookmark_manager_srv: onRestored hook: restoring filter state") + logger::log_trace("bookmark_manager_srv@onRestored: restoring filter state") snapshot <- state$values$filter_state_on_bookmark snapshot_state <- as.teal_slices(snapshot) mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) @@ -82,16 +82,16 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn ) slices_global(snapshot_state) # Restore snapshot history and bookmark history. - logger::log_trace("bookmark_manager_srv: onRestored hook: restoring snapshot and bookmark history") + logger::log_trace("bookmark_manager_srv@onRestored: restoring snapshot and bookmark history") snapshot_history(state$values$snapshot_history) bookmark_history(state$values$bookmark_history) }) app_session$onBookmarked(function(url) { - logger::log_trace("bookmark_manager_srv: onBookmarked hook: bookmark button clicked, registering bookmark") + logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark button clicked, registering bookmark") bookmark_name <- trimws(input$bookmark_name) if (identical(bookmark_name, "")) { - logger::log_trace("bookmark_manager_srv: onBookmarked hook: bookmark name rejected") + logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark name rejected") showNotification( "Please name the bookmark.", type = "message" @@ -99,7 +99,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn updateTextInput(inputId = "bookmark_name", value = "", placeholder = "Meaningful, unique name") unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else if (is.element(make.names(bookmark_name), make.names(names(bookmark_history())))) { - logger::log_trace("bookmark_manager_srv: onBookmarked hook: bookmark name rejected") + logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark name rejected") showNotification( "This name is in conflict with other bookmark names. Please choose a different one.", type = "message" @@ -108,7 +108,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else { # Add bookmark URL to bookmark history (with name). - logger::log_trace("bookmark_manager_srv: onBookmarked hook: bookmark name accepted, adding to history") + logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark name accepted, adding to history") bookmark_update <- c(bookmark_history(), list(url)) names(bookmark_update)[length(bookmark_update)] <- bookmark_name bookmark_history(bookmark_update) From 43752bf037ec81acc7b7109ec61b169345af2f52 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 18:17:09 +0100 Subject: [PATCH 060/117] add bookmark exclusions --- R/module_bookmark_manager.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index c6913cd226..c71a2ce268 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -54,6 +54,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn list() }) + setBookmarkExclude(c("bookmark_name", "bookmark_add")) app_session$onBookmark(function(state) { # Add current filter state to bookmark. logger::log_trace("bookmark_manager_srv@onBookmark: storing filter state") From cd6c6bc1f9ea0f89608bb84c8a7bfc60531f438c Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 14 Mar 2024 18:17:58 +0100 Subject: [PATCH 061/117] add code comment --- R/module_bookmark_manager.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index c71a2ce268..9a00d1d0a4 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -54,6 +54,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn list() }) + # These exclusions ensure the right modals open in bookmarked app. setBookmarkExclude(c("bookmark_name", "bookmark_add")) app_session$onBookmark(function(state) { # Add current filter state to bookmark. From fc3872adeb81627bd66f44c0542072fc32220c47 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 12:29:43 +0100 Subject: [PATCH 062/117] modify button titles --- R/module_tabs_with_filters.R | 2 +- R/module_wunder_bar.R | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index edb1e686fd..410c208932 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -44,7 +44,7 @@ ui_tabs_with_filters <- function(id, modules, datasets, filter = teal_slices()) class = "btn action-button filter_hamburger", # see sidebar.css for style filter_hamburger href = "javascript:void(0)", onclick = "toggleFilterPanel();", # see sidebar.js - title = "Toggle filter panels", + title = "Toggle filter panel", icon("fas fa-bars") ), wunder_bar_ui(ns("wunder_bar")) diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 47cb743824..67adbc0837 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -16,19 +16,19 @@ wunder_bar_ui <- function(id) { tags$button( id = ns("show_filter_manager"), class = "btn action-button wunder_bar_button", - title = "Show filter manager modal", - suppressMessages(icon("solid fa-filter")) + title = "View filter mapping", + suppressMessages(icon("solid fa-grip")) ), tags$button( id = ns("show_snapshot_manager"), class = "btn action-button wunder_bar_button", - title = "Show snapshot manager modal", + title = "Manage filter state snapshots", icon("camera") ), tags$button( id = ns("show_bookmark_manager"), class = "btn action-button wunder_bar_button", - title = "Show bookmark manager modal", + title = "Manage bookmarks", suppressMessages(icon("solid fa-bookmark")) ) ) From 8181ca6affd1cdcae15b0b86b039fb9c043915ce Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 12:33:42 +0100 Subject: [PATCH 063/117] remove superfluous CSS --- inst/css/sidebar.css | 7 ------- 1 file changed, 7 deletions(-) diff --git a/inst/css/sidebar.css b/inst/css/sidebar.css index f4f13f3ff2..c394215467 100644 --- a/inst/css/sidebar.css +++ b/inst/css/sidebar.css @@ -17,16 +17,9 @@ a.disabled { .filter_manager_content { display: flex; - flex-direction: row; flex-wrap: wrap; - align-items: flex-start; justify-content: center; } -.filter_manager_content > * { - flex: 1 1 auto; - padding: 0em 1em; - width: min-content; -} .snapshot_table_row { display: flex; From 07fa52f1d69f4d0942c15113331287147ea6ce79 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 13:38:16 +0100 Subject: [PATCH 064/117] change CSS class names --- R/module_bookmark_manager.R | 8 ++++---- R/module_snapshot_manager.R | 8 ++++---- inst/css/sidebar.css | 8 ++++---- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 9a00d1d0a4..089fcb0ff5 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -19,9 +19,9 @@ bookmark_manager_ui <- function(id) { ns <- NS(id) div( - class = "snapshot_manager_content", + class = "manager_content", div( - class = "snapshot_table_row", + class = "manager_table_row", span(tags$b("Bookmark manager")), actionLink(ns("bookmark_add"), NULL, icon = suppressMessages(icon("solid fa-bookmark")), title = "add bookmark"), NULL @@ -146,7 +146,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn # Create a row for the bookmark table. if (!is.element(id_rowme, names(divs))) { divs[[id_rowme]] <- div( - class = "snapshot_table_row", + class = "manager_table_row", a(h5(s), title = "go to bookmark", href = bookmark_history()[[s]], target = "blank") ) } @@ -158,7 +158,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn rows <- lapply(rev(reactiveValuesToList(divs)), function(d) d) if (length(rows) == 0L) { div( - class = "snapshot_manager_placeholder", + class = "manager_placeholder", "Bookmarks will appear here." ) } else { diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 3d31f67d1c..69b2db169f 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -86,9 +86,9 @@ snapshot_manager_ui <- function(id) { ns <- NS(id) tags$div( - class = "snapshot_manager_content", + class = "manager_content", tags$div( - class = "snapshot_table_row", + class = "manager_table_row", tags$span(tags$b("Snapshot manager")), actionLink(ns("snapshot_add"), label = NULL, icon = icon("camera"), title = "add snapshot"), actionLink(ns("snapshot_load"), label = NULL, icon = icon("upload"), title = "upload snapshot"), @@ -322,7 +322,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { # Create a row for the snapshot table. if (!is.element(id_rowme, names(divs))) { divs[[id_rowme]] <- tags$div( - class = "snapshot_table_row", + class = "manager_table_row", tags$span(tags$h5(s)), actionLink(inputId = ns(id_pickme), label = icon("circle-check"), title = "select"), downloadLink(outputId = ns(id_saveme), label = icon("save"), title = "save to file") @@ -336,7 +336,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { rows <- lapply(rev(reactiveValuesToList(divs)), function(d) d) if (length(rows) == 0L) { tags$div( - class = "snapshot_manager_placeholder", + class = "manager_placeholder", "Snapshots will appear here." ) } else { diff --git a/inst/css/sidebar.css b/inst/css/sidebar.css index c394215467..f65e8ee9d4 100644 --- a/inst/css/sidebar.css +++ b/inst/css/sidebar.css @@ -21,18 +21,18 @@ a.disabled { justify-content: center; } -.snapshot_table_row { +.manager_table_row { display: flex; flex-direction: row; align-items: center; } -.snapshot_table_row *:first-child { +.manager_table_row *:first-child { flex: 1 1 80%; } -.snapshot_table_row * + * { +.manager_table_row * + * { flex: 1 0 50px; padding: 0em 1em; } -.snapshot_manager_placeholder { +.manager_placeholder { margin-top: 1em; } From d896983d3cebcf3bd50a55d5c473efdfb8ee3478 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 13:38:53 +0100 Subject: [PATCH 065/117] adjust style of bnon-first children in manager_table_row --- inst/css/sidebar.css | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/css/sidebar.css b/inst/css/sidebar.css index f65e8ee9d4..bf40f19d1f 100644 --- a/inst/css/sidebar.css +++ b/inst/css/sidebar.css @@ -30,8 +30,8 @@ a.disabled { flex: 1 1 80%; } .manager_table_row * + * { - flex: 1 0 50px; - padding: 0em 1em; + flex: 0 0 0px; + padding: 0em 1.5em; } .manager_placeholder { margin-top: 1em; From ed34a946bdb0df102906e2d730754fdf6485bb68 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 15:37:05 +0100 Subject: [PATCH 066/117] update code comment --- R/module_nested_tabs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index ee0f153f53..110224bbcd 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -232,7 +232,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi call_module() } else { # When app starts normally, modules are initialized only when corresponding tabs are clicked. - # This is done by observing trigger_module (see above) to induce the module only when renderUI is triggered. + # Observing trigger_module() induces the module only when output$data_reactive is triggered (see above). observeEvent( ignoreNULL = TRUE, once = TRUE, From 2495fb31309cfcb2c6c8e1f6bf9a40be3ba83c8d Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 15:42:52 +0100 Subject: [PATCH 067/117] simplify 'when from bookmark' condition --- R/module_nested_tabs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 110224bbcd..035a9133b9 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -226,7 +226,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi } # Call modules. - if (.subset2(session, "parent")$restoreContext$active) { + if (session$restoreContext$active) { # When restoring bookmark, all modules must be initialized on app start. # Delayed module initiation (below) precludes restoring state b/c inputs do not exist when restoring occurs. call_module() From 5b5a1e26dd0272c7e6e1723bf63a04d938a91389 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 15:53:47 +0100 Subject: [PATCH 068/117] replace bookmarkButton with action Button --- R/module_bookmark_manager.R | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 089fcb0ff5..1e05396802 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -54,8 +54,8 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn list() }) - # These exclusions ensure the right modals open in bookmarked app. - setBookmarkExclude(c("bookmark_name", "bookmark_add")) + # These exclusions are to ensure the right modals open in bookmarked app (first 2) and for extra security (3rd). + setBookmarkExclude(c("bookmark_add", "bookmark_name", "bookmark_accept")) app_session$onBookmark(function(state) { # Add current filter state to bookmark. logger::log_trace("bookmark_manager_srv@onBookmark: storing filter state") @@ -126,7 +126,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn modalDialog( textInput(ns("bookmark_name"), "Name the bookmark", width = "100%", placeholder = "Meaningful, unique name"), footer = tagList( - bookmarkButton("Accept", icon = icon("thumbs-up")), + actionButton(ns("bookmark_accept"), label = "Accept", icon = icon("thumbs-up")), modalButton(label = "Cancel", icon = icon("thumbs-down")) ), size = "s" @@ -134,6 +134,11 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn ) }) + # Initiate bookmarking with normal action button b/c `bookmarkButton` may not work on Windows. + observeEvent(input$bookmark_accept, { + app_session$doBookmark() + }) + # Create UI elements and server logic for the bookmark table. # Divs are tracked for a slight speed margin. divs <- reactiveValues() From debf0f21064179641f539baada50dde1160c7093 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 18:45:51 +0100 Subject: [PATCH 069/117] amend documentation --- DESCRIPTION | 3 +- R/module_bookmark_manager.R | 62 ++++++++++-- R/module_filter_manager.R | 28 ++++-- R/module_snapshot_manager.R | 24 +++-- R/module_wunder_bar.R | 26 +++-- man/filter_manager_module_srv.Rd | 2 +- man/module_bookmark_manager.Rd | 96 +++++++++++++++++++ man/module_filter_manager.Rd | 22 ++++- man/module_filter_manager_modal.Rd | 29 ------ ...r_module.Rd => module_snapshot_manager.Rd} | 21 ++-- man/module_wunder_bar.Rd | 44 +++++++++ man/state_manager_module.Rd | 34 ------- 12 files changed, 279 insertions(+), 112 deletions(-) create mode 100644 man/module_bookmark_manager.Rd delete mode 100644 man/module_filter_manager_modal.Rd rename man/{snapshot_manager_module.Rd => module_snapshot_manager.Rd} (90%) create mode 100644 man/module_wunder_bar.Rd delete mode 100644 man/state_manager_module.Rd diff --git a/DESCRIPTION b/DESCRIPTION index cccdb53975..7f693c1f49 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -90,13 +90,14 @@ Collate: 'modules.R' 'init.R' 'landing_popup_module.R' + 'module_bookmark_manager.R' 'module_filter_manager.R' 'module_nested_tabs.R' 'module_snapshot_manager.R' - 'module_state_manager.R' 'module_tabs_with_filters.R' 'module_teal.R' 'module_teal_with_splash.R' + 'module_wunder_bar.R' 'reporter_previewer_module.R' 'show_rcode_modal.R' 'tdata.R' diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 1e05396802..59984b9a3e 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -2,18 +2,64 @@ #' #' Capture and restore the global (app) input state. #' -#' This is a work in progress. +#' This module introduces bookmarks into `teal` apps: the `shiny` bookmarking mechanism becomes enabled +#' and server-side bookmarks can be created. #' -#' @param id (`character(1)`) `shiny` module id +#' The bookmark manager is accessed with the bookmark icon in the [`wunder_bar`]. +#' The manager's header contains a title and a bookmark icon. Clicking the icon creates a bookmark. +#' As bookmarks are added, they will show up as rows in a table, each being a link that, when clicked, +#' will open the bookmarked application in a new window. #' -#' @return Nothing is returned. +#' @section Server logic: +#' A bookmark is a URL that contains the app address with a `/?_state_id_=` suffix. +#' `` is a directory created on the server, where the state of the application is saved. +#' Accessing the bookmark URL opens a new session of the app that starts in the previously saved state. #' -#' @name bookmark_manager_module -#' @aliases bookmark bookmark_manager +#' Bookmarks are stored in a `reactiveVal` as a named list. +#' For every bookmark created a piece of HTML is created that contains a link, +#' whose text is the name of the bookmark and whose href is the bookmark URL. #' -#' @author Aleksander Chlebowski +#' @section Bookmark mechanics: +#' When a bookmark is added, the user is prompted to name it. +#' New bookmark names are validated so that thy are unique. Leading and trailing white space is trimmed. #' -#' @rdname bookmark_manager_module +#' Once a bookmark name has been accepted, the app state is saved: values of all inputs, +#' which are kept in the `input` slot of the `session` object, are dumped into the `input.rds` file +#' in the `` directory on the server. +#' This is out of the box behavior that permeates the entire app, no adjustments to modules are necessary. +#' An additional `onBookmark` callback creates a snapshot of the current filter state +#' (the module has access to the filter state of the application through `slices_global` and `mapping_matrix`). +#' Then that snapshot, the previous snapshot history (which is passed to this module as argument), +#' and the previous bookmark history are dumped into the `values.rds` file in ``. +#' +#' Finally, an `onBookmarked` callback adds the newly created bookmark to the bookmark history. +#' Notably, this occurs _after_ creating the bookmark is concluded so the bookmark history that was stored +#' does not include the newly added bookmark. +#' +#' When starting the app from a bookmark, `shiny` recognizes that the app is being restored, +#' locates the bookmark directory and loads both `.rds` file. +#' Values stored in `input.rds` are automatically set to their corresponding inputs. +#' The filter state that the app had upon bookmarking, which was saved as a separate snapshot, is restored. +#' This is done in the same manner as in the `snapshot_manager` module and thus requires access to `datasets_flat`, +#' which is passed to this module as argument. +#' Finally, snapshot history and bookmark history are loaded from `values.rds` and set to appropriate `reactiveVal`s. +#' +#' @section Note: +#' All `teal` apps are inherently bookmarkable. Normal `shiny` apps require that `enableBookmarking` be set to "server", +#' either by setting an argument in a `shinyApp` call or by calling a special function. In `teal` bookmarks are enabled +#' by automatically setting an option when the apckage is loaded. +#' +#' @param id (`character(1)`) `shiny` module instance id. +#' @inheritParams module_snapshot_manager +#' @param snapshot_history (named `list`) of unlisted `teal_slices` objects, as returned by the `snapshot_manager`. +#' +#' @return `reactiveVal` containing a named list of bookmark URLs. +#' +#' @name module_bookmark_manager +#' @aliases bookmark bookmark_manager bookmark_manager_module +#' + +#' @rdname module_bookmark_manager #' @keywords internal #' bookmark_manager_ui <- function(id) { @@ -30,7 +76,7 @@ bookmark_manager_ui <- function(id) { ) } -#' @rdname bookmark_manager_module +#' @rdname module_bookmark_manager #' @keywords internal #' bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, snapshot_history) { diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 11a7382144..611a1bcc38 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -7,23 +7,33 @@ #' is kept in the `mapping_matrix` object (which is actually a `data.frame`) #' that tracks which filters (rows) are active in which modules (columns). #' -#' @name module_filter_manager -#' #' @param id (`character(1)`) -#' `shiny` module id. +#' `shiny` module instance id. #' @param datasets (named `list`) #' A list, possibly nested, of `FilteredData` objects. #' Each `FilteredData` will be served to one module in the `teal` application. #' The structure of the list must reflect the nesting of modules in tabs #' and the names of the list must match the labels of their respective modules. #' @inheritParams init -#' @return A list of `reactive`s, each holding a `teal_slices`, as returned by `filter_manager_module_srv`. -#' @keywords internal #' -NULL - +#' @return +#' A `list` containing: +#' +#' objects used by other manager modules +#' - `datasets_flat`: named list of `FilteredData` objects, +#' - `mapping_matrix`: `reactive` containing a `data.frame`, +#' - `slices_global`: `reactiveVal` containing a `teal_slices` object, +#' +#' objects used for testing +#' - modules_out: `list` of `reactive`s, each holding a `teal_slices`, as returned by `filter_manager_module_srv`. +#' +#' @name module_filter_manager +#' @aliases filter_manager filter_manager_module +#' #' @rdname module_filter_manager +#' @keywords internal +#' filter_manager_ui <- function(id) { ns <- NS(id) tags$div( @@ -33,6 +43,8 @@ filter_manager_ui <- function(id) { } #' @rdname module_filter_manager +#' @keywords internal +#' filter_manager_srv <- function(id, datasets, filter) { moduleServer(id, function(input, output, session) { logger::log_trace("filter_manager_srv initializing for: { paste(names(datasets), collapse = ', ')}.") @@ -123,7 +135,7 @@ filter_manager_srv <- function(id, datasets, filter) { #' - to disable/enable a specific filter in a module #' - to restore saved filter settings #' - to save current filter panel settings -#' @return A `reactive` expression containing the slices active in this module. +#' @return A `reactive` expression containing a `teal_slices` with the slices active in this module. #' @keywords internal #' filter_manager_module_srv <- function(id, module_fd, slices_global) { diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 69b2db169f..313b2821a3 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -7,7 +7,7 @@ #' as well as to save it to file in order to share it with an app developer or other users, #' who in turn can upload it to their own session. #' -#' The snapshot manager is accessed through the filter manager, with the cog icon in the top right corner. +#' The snapshot manager is accessed with the camera icon in the [`wunder_bar`]. #' At the beginning of a session it presents three icons: a camera, an upload, and an circular arrow. #' Clicking the camera captures a snapshot, clicking the upload adds a snapshot from a file #' and applies the filter states therein, and clicking the arrow resets initial application state. @@ -65,22 +65,24 @@ #' a `teal_slices` object. When a snapshot is restored from file, its `app_id` is compared to that #' of the current app state and only if the match is the snapshot admitted to the session. #' -#' @param id (`character(1)`) `shiny` module id +#' @param id (`character(1)`) `shiny` module instance id. #' @param slices_global (`reactiveVal`) that contains a `teal_slices` object -#' containing all `teal_slice`s existing in the app, both active and inactive +#' containing all `teal_slice`s existing in the app, both active and inactive. #' @param mapping_matrix (`reactive`) that contains a `data.frame` representation #' of the mapping of filter state ids (rows) to modules labels (columns); -#' all columns are `logical` vectors -#' @param datasets non-nested (named `list`) that contains `FilteredData` objects +#' all columns are `logical` vectors. +#' @param datasets non-nested (named `list`) of `FilteredData` objects. #' -#' @return Nothing is returned. +#' @return `list` containing the snapshot histtory, where each element is an unlisted `teal_slices` object. #' -#' @name snapshot_manager_module -#' @aliases snapshot snapshot_manager +#' @name module_snapshot_manager +#' @aliases snapshot snapshot_manager snapshot_manager_module #' #' @author Aleksander Chlebowski #' -#' @rdname snapshot_manager_module + + +#' @rdname module_snapshot_manager #' @keywords internal #' snapshot_manager_ui <- function(id) { @@ -99,7 +101,7 @@ snapshot_manager_ui <- function(id) { ) } -#' @rdname snapshot_manager_module +#' @rdname module_snapshot_manager #' @keywords internal #' snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { @@ -357,6 +359,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { #' @param mapping (named `list`) as stored in mapping parameter of `teal_slices` #' @param module_names (`character`) vector containing names of all modules in the app #' @return A `named_list` with one element per module, each element containing all filters applied to that module. +#' #' @keywords internal #' unfold_mapping <- function(mapping, module_names) { @@ -374,6 +377,7 @@ unfold_mapping <- function(mapping, module_names) { #' @param mapping_matrix (`data.frame`) of logical vectors where #' columns represent modules and row represent `teal_slice`s #' @return Named `list` like that in the `mapping` attribute of a `teal_slices` object. +#' #' @keywords internal #' matrix_to_mapping <- function(mapping_matrix) { diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 67adbc0837..4748c76c6e 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -1,14 +1,25 @@ -#' Filter manager modal +#' Manager bar module #' -#' Opens a modal containing the filter manager UI. +#' Bar of buttons that open modal dialogs. #' -#' @name module_filter_manager_modal +#' Creates a bar of buttons that open modal dialogs where manager modules reside. +#' Currently contains three modules: +#' - [`module_filter_manager`] +#' - [`module_snapshot_manager`] +#' - [`module_bookmark_manager`] +#' +#' The bar is placed in the `teal` app UI, next to the filter panel hamburger. +#' +#' @name module_wunder_bar +#' @aliases wunder_bar wunder_bar_module +#' +#' @param id (`character(1)`) `shiny` module instance id. #' @inheritParams module_filter_manager -#' @keywords internal #' -NULL +#' @return Nothing is returned. -#' @rdname module_filter_manager_modal +#' @rdname module_wunder_bar +#' @keywords internal wunder_bar_ui <- function(id) { ns <- NS(id) rev( # Reversing order because buttons show up in UI from right to left. @@ -35,7 +46,8 @@ wunder_bar_ui <- function(id) { ) } -#' @rdname module_filter_manager_modal +#' @rdname module_wunder_bar +#' @keywords internal wunder_bar_srv <- function(id, datasets, filter) { moduleServer(id, function(input, output, session) { logger::log_trace("wunder_bar_srv initializing") diff --git a/man/filter_manager_module_srv.Rd b/man/filter_manager_module_srv.Rd index e00afd6e38..e00216a5d1 100644 --- a/man/filter_manager_module_srv.Rd +++ b/man/filter_manager_module_srv.Rd @@ -22,7 +22,7 @@ stores \code{teal_slices} with all available filters; allows the following actio }} } \value{ -A \code{reactive} expression containing the slices active in this module. +A \code{reactive} expression containing a \code{teal_slices} with the slices active in this module. } \description{ Tracks filter states in a single module. diff --git a/man/module_bookmark_manager.Rd b/man/module_bookmark_manager.Rd new file mode 100644 index 0000000000..ecc62926d4 --- /dev/null +++ b/man/module_bookmark_manager.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_bookmark_manager.R +\name{module_bookmark_manager} +\alias{module_bookmark_manager} +\alias{bookmark_manager_ui} +\alias{bookmark} +\alias{bookmark_manager} +\alias{bookmark_manager_module} +\alias{bookmark_manager_srv} +\title{App state management.} +\usage{ +bookmark_manager_ui(id) + +bookmark_manager_srv( + id, + slices_global, + mapping_matrix, + datasets, + snapshot_history +) +} +\arguments{ +\item{id}{(\code{character(1)}) \code{shiny} module instance id.} + +\item{slices_global}{(\code{reactiveVal}) that contains a \code{teal_slices} object +containing all \code{teal_slice}s existing in the app, both active and inactive.} + +\item{mapping_matrix}{(\code{reactive}) that contains a \code{data.frame} representation +of the mapping of filter state ids (rows) to modules labels (columns); +all columns are \code{logical} vectors.} + +\item{datasets}{non-nested (named \code{list}) of \code{FilteredData} objects.} + +\item{snapshot_history}{(named \code{list}) of unlisted \code{teal_slices} objects, as returned by the \code{snapshot_manager}.} +} +\value{ +\code{reactiveVal} containing a named list of bookmark URLs. +} +\description{ +Capture and restore the global (app) input state. +} +\details{ +This module introduces bookmarks into \code{teal} apps: the \code{shiny} bookmarking mechanism becomes enabled +and server-side bookmarks can be created. + +The bookmark manager is accessed with the bookmark icon in the \code{\link{wunder_bar}}. +The manager's header contains a title and a bookmark icon. Clicking the icon creates a bookmark. +As bookmarks are added, they will show up as rows in a table, each being a link that, when clicked, +will open the bookmarked application in a new window. +} +\section{Server logic}{ + +A bookmark is a URL that contains the app address with a \verb{/?_state_id_=} suffix. +\verb{} is a directory created on the server, where the state of the application is saved. +Accessing the bookmark URL opens a new session of the app that starts in the previously saved state. + +Bookmarks are stored in a \code{reactiveVal} as a named list. +For every bookmark created a piece of HTML is created that contains a link, +whose text is the name of the bookmark and whose href is the bookmark URL. +} + +\section{Bookmark mechanics}{ + +When a bookmark is added, the user is prompted to name it. +New bookmark names are validated so that thy are unique. Leading and trailing white space is trimmed. + +Once a bookmark name has been accepted, the app state is saved: values of all inputs, +which are kept in the \code{input} slot of the \code{session} object, are dumped into the \code{input.rds} file +in the \verb{} directory on the server. +This is out of the box behavior that permeates the entire app, no adjustments to modules are necessary. +An additional \code{onBookmark} callback creates a snapshot of the current filter state +(the module has access to the filter state of the application through \code{slices_global} and \code{mapping_matrix}). +Then that snapshot, the previous snapshot history (which is passed to this module as argument), +and the previous bookmark history are dumped into the \code{values.rds} file in \verb{}. + +Finally, an \code{onBookmarked} callback adds the newly created bookmark to the bookmark history. +Notably, this occurs \emph{after} creating the bookmark is concluded so the bookmark history that was stored +does not include the newly added bookmark. + +When starting the app from a bookmark, \code{shiny} recognizes that the app is being restored, +locates the bookmark directory and loads both \code{.rds} file. +Values stored in \code{input.rds} are automatically set to their corresponding inputs. +The filter state that the app had upon bookmarking, which was saved as a separate snapshot, is restored. +This is done in the same manner as in the \code{snapshot_manager} module and thus requires access to \code{datasets_flat}, +which is passed to this module as argument. +Finally, snapshot history and bookmark history are loaded from \code{values.rds} and set to appropriate \code{reactiveVal}s. +} + +\section{Note}{ + +All \code{teal} apps are inherently bookmarkable. Normal \code{shiny} apps require that \code{enableBookmarking} be set to "server", +either by setting an argument in a \code{shinyApp} call or by calling a special function. In \code{teal} bookmarks are enabled +by automatically setting an option when the apckage is loaded. +} + +\keyword{internal} diff --git a/man/module_filter_manager.Rd b/man/module_filter_manager.Rd index 3d487118fd..1d0e5af2ef 100644 --- a/man/module_filter_manager.Rd +++ b/man/module_filter_manager.Rd @@ -3,18 +3,20 @@ \name{module_filter_manager} \alias{module_filter_manager} \alias{filter_manager_ui} +\alias{filter_manager} +\alias{filter_manager_module} \alias{filter_manager_srv} \title{Manage multiple \code{FilteredData} objects} \usage{ filter_manager_ui(id) -filter_manager_srv(id, filtered_data_list, filter) +filter_manager_srv(id, datasets, filter) } \arguments{ \item{id}{(\code{character(1)}) -\code{shiny} module id.} +\code{shiny} module instance id.} -\item{filtered_data_list}{(named \code{list}) +\item{datasets}{(named \code{list}) A list, possibly nested, of \code{FilteredData} objects. Each \code{FilteredData} will be served to one module in the \code{teal} application. The structure of the list must reflect the nesting of modules in tabs @@ -24,7 +26,19 @@ and the names of the list must match the labels of their respective modules.} Specifies the initial filter using \code{\link[=teal_slices]{teal_slices()}}.} } \value{ -A list of \code{reactive}s, each holding a \code{teal_slices}, as returned by \code{filter_manager_module_srv}. +A \code{list} containing: + +objects used by other manager modules +\itemize{ +\item \code{datasets_flat}: named list of \code{FilteredData} objects, +\item \code{mapping_matrix}: \code{reactive} containing a \code{data.frame}, +\item \code{slices_global}: \code{reactiveVal} containing a \code{teal_slices} object, +} + +objects used for testing +\itemize{ +\item modules_out: \code{list} of \code{reactive}s, each holding a \code{teal_slices}, as returned by \code{filter_manager_module_srv}. +} } \description{ Oversee filter states across the entire application. diff --git a/man/module_filter_manager_modal.Rd b/man/module_filter_manager_modal.Rd deleted file mode 100644 index e3f5c5225f..0000000000 --- a/man/module_filter_manager_modal.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_filter_manager.R -\name{module_filter_manager_modal} -\alias{module_filter_manager_modal} -\alias{filter_manager_modal_ui} -\alias{filter_manager_modal_srv} -\title{Filter manager modal} -\usage{ -filter_manager_modal_ui(id) - -filter_manager_modal_srv(id, filtered_data_list, filter) -} -\arguments{ -\item{id}{(\code{character(1)}) -\code{shiny} module id.} - -\item{filtered_data_list}{(named \code{list}) -A list, possibly nested, of \code{FilteredData} objects. -Each \code{FilteredData} will be served to one module in the \code{teal} application. -The structure of the list must reflect the nesting of modules in tabs -and the names of the list must match the labels of their respective modules.} - -\item{filter}{(\code{teal_slices}) -Specifies the initial filter using \code{\link[=teal_slices]{teal_slices()}}.} -} -\description{ -Opens a modal containing the filter manager UI. -} -\keyword{internal} diff --git a/man/snapshot_manager_module.Rd b/man/module_snapshot_manager.Rd similarity index 90% rename from man/snapshot_manager_module.Rd rename to man/module_snapshot_manager.Rd index 307abaf06a..bb49af9d52 100644 --- a/man/snapshot_manager_module.Rd +++ b/man/module_snapshot_manager.Rd @@ -1,31 +1,32 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/module_snapshot_manager.R -\name{snapshot_manager_module} -\alias{snapshot_manager_module} +\name{module_snapshot_manager} +\alias{module_snapshot_manager} \alias{snapshot_manager_ui} \alias{snapshot} \alias{snapshot_manager} +\alias{snapshot_manager_module} \alias{snapshot_manager_srv} \title{Filter state snapshot management} \usage{ snapshot_manager_ui(id) -snapshot_manager_srv(id, slices_global, mapping_matrix, filtered_data_list) +snapshot_manager_srv(id, slices_global, mapping_matrix, datasets) } \arguments{ -\item{id}{(\code{character(1)}) \code{shiny} module id} +\item{id}{(\code{character(1)}) \code{shiny} module instance id.} \item{slices_global}{(\code{reactiveVal}) that contains a \code{teal_slices} object -containing all \code{teal_slice}s existing in the app, both active and inactive} +containing all \code{teal_slice}s existing in the app, both active and inactive.} \item{mapping_matrix}{(\code{reactive}) that contains a \code{data.frame} representation of the mapping of filter state ids (rows) to modules labels (columns); -all columns are \code{logical} vectors} +all columns are \code{logical} vectors.} -\item{filtered_data_list}{non-nested (named \code{list}) that contains \code{FilteredData} objects} +\item{datasets}{non-nested (named \code{list}) of \code{FilteredData} objects.} } \value{ -Nothing is returned. +\code{list} containing the snapshot histtory, where each element is an unlisted \code{teal_slices} object. } \description{ Capture and restore snapshots of the global (app) filter state. @@ -36,7 +37,7 @@ Snapshots allow the user to save the current filter state of the application for as well as to save it to file in order to share it with an app developer or other users, who in turn can upload it to their own session. -The snapshot manager is accessed through the filter manager, with the cog icon in the top right corner. +The snapshot manager is accessed with the camera icon in the \code{\link{wunder_bar}}. At the beginning of a session it presents three icons: a camera, an upload, and an circular arrow. Clicking the camera captures a snapshot, clicking the upload adds a snapshot from a file and applies the filter states therein, and clicking the arrow resets initial application state. @@ -76,7 +77,7 @@ when passed to the \code{mapping} argument of \code{\link[=teal_slices]{teal_sli This is substituted as the snapshot's \code{mapping} attribute and the snapshot is added to the snapshot list. To restore app state, a snapshot is retrieved from storage and rebuilt into a \code{teal_slices} object. -Then state of all \code{FilteredData} objects (provided in \code{filtered_data_list}) is cleared +Then state of all \code{FilteredData} objects (provided in \code{datasets}) is cleared and set anew according to the \code{mapping} attribute of the snapshot. The snapshot is then set as the current content of \code{slices_global}. diff --git a/man/module_wunder_bar.Rd b/man/module_wunder_bar.Rd new file mode 100644 index 0000000000..32d7653038 --- /dev/null +++ b/man/module_wunder_bar.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_wunder_bar.R +\name{module_wunder_bar} +\alias{module_wunder_bar} +\alias{wunder_bar_ui} +\alias{wunder_bar} +\alias{wunder_bar_module} +\alias{wunder_bar_srv} +\title{Manager bar module} +\usage{ +wunder_bar_ui(id) + +wunder_bar_srv(id, datasets, filter) +} +\arguments{ +\item{id}{(\code{character(1)}) \code{shiny} module instance id.} + +\item{datasets}{(named \code{list}) +A list, possibly nested, of \code{FilteredData} objects. +Each \code{FilteredData} will be served to one module in the \code{teal} application. +The structure of the list must reflect the nesting of modules in tabs +and the names of the list must match the labels of their respective modules.} + +\item{filter}{(\code{teal_slices}) +Specifies the initial filter using \code{\link[=teal_slices]{teal_slices()}}.} +} +\value{ +Nothing is returned. +} +\description{ +Bar of buttons that open modal dialogs. +} +\details{ +Creates a bar of buttons that open modal dialogs where manager modules reside. +Currently contains three modules: +\itemize{ +\item \code{\link{module_filter_manager}} +\item \code{\link{module_snapshot_manager}} +\item \code{\link{module_bookmark_manager}} +} + +The bar is placed in the \code{teal} app UI, next to the filter panel hamburger. +} +\keyword{internal} diff --git a/man/state_manager_module.Rd b/man/state_manager_module.Rd deleted file mode 100644 index 99d5e56313..0000000000 --- a/man/state_manager_module.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_state_manager.R -\name{state_manager_module} -\alias{state_manager_module} -\alias{state_manager_ui} -\alias{grab} -\alias{grab_manager} -\alias{state_manager} -\alias{state_manager_srv} -\title{App state management.} -\usage{ -state_manager_ui(id) - -state_manager_srv(id) -} -\arguments{ -\item{id}{(\code{character(1)}) \code{shiny} module id} -} -\value{ -Nothing is returned. -} -\description{ -Capture and restore the global (app) input state. -} -\details{ -This is a work in progress. -} -\seealso{ -\code{\link{app_state_grab}}, \code{\link{app_state_store}}, \code{\link{app_state_restore}} -} -\author{ -Aleksander Chlebowski -} -\keyword{internal} From 24966a680a97f920d2a83778139e2964c234d98b Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 19:51:40 +0100 Subject: [PATCH 070/117] amend NEWS --- NEWS.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/NEWS.md b/NEWS.md index 1f5f5d51c3..4a55e11206 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # teal 0.15.2.9004 +### New features +* Introduced bookmarking feature. Click the bookmark icon in the top-right corner to access the bookmark manager. + +### Miscellaneous +* Filter mapping display is no longer coupled to the snapshot manager. + # teal 0.15.2 ### Bug fixes From ed94c39a02243c05840f84d17d33136f54d20633 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 15 Mar 2024 19:54:09 +0100 Subject: [PATCH 071/117] rearrange code --- R/module_bookmark_manager.R | 58 ++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 59984b9a3e..b9e480cef2 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -92,14 +92,8 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn moduleServer(id, function(input, output, session) { logger::log_trace("bookmark_manager_srv initializing") - ns <- session$ns + # Set up bookmarking callbacks. app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") - - # Store input states. - bookmark_history <- reactiveVal({ - list() - }) - # These exclusions are to ensure the right modals open in bookmarked app (first 2) and for extra security (3rd). setBookmarkExclude(c("bookmark_add", "bookmark_name", "bookmark_accept")) app_session$onBookmark(function(state) { @@ -113,28 +107,6 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn state$values$snapshot_history <- snapshot_history() # isolate this? state$values$bookmark_history <- bookmark_history() # isolate this? }) - app_session$onRestored(function(state) { - # Restore filter state. - logger::log_trace("bookmark_manager_srv@onRestored: restoring filter state") - snapshot <- state$values$filter_state_on_bookmark - snapshot_state <- as.teal_slices(snapshot) - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) - mapply( - function(filtered_data, filter_ids) { - filtered_data$clear_filter_states(force = TRUE) - slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) - filtered_data$set_filter_state(slices) - }, - filtered_data = datasets, - filter_ids = mapping_unfolded - ) - slices_global(snapshot_state) - # Restore snapshot history and bookmark history. - logger::log_trace("bookmark_manager_srv@onRestored: restoring snapshot and bookmark history") - snapshot_history(state$values$snapshot_history) - bookmark_history(state$values$bookmark_history) - }) - app_session$onBookmarked(function(url) { logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark button clicked, registering bookmark") bookmark_name <- trimws(input$bookmark_name) @@ -164,6 +136,34 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn removeModal() } }) + app_session$onRestored(function(state) { + # Restore filter state. + logger::log_trace("bookmark_manager_srv@onRestored: restoring filter state") + snapshot <- state$values$filter_state_on_bookmark + snapshot_state <- as.teal_slices(snapshot) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) + mapply( + function(filtered_data, filter_ids) { + filtered_data$clear_filter_states(force = TRUE) + slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) + filtered_data$set_filter_state(slices) + }, + filtered_data = datasets, + filter_ids = mapping_unfolded + ) + slices_global(snapshot_state) + # Restore snapshot history and bookmark history. + logger::log_trace("bookmark_manager_srv@onRestored: restoring snapshot and bookmark history") + snapshot_history(state$values$snapshot_history) + bookmark_history(state$values$bookmark_history) + }) + + ns <- session$ns + + # Store input states. + bookmark_history <- reactiveVal({ + list() + }) # Bookmark current input state - name bookmark. observeEvent(input$bookmark_add, { From 38c9598acc0f48c90df7b86c8e94d81b8afb7f48 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 15 Mar 2024 19:00:58 +0000 Subject: [PATCH 072/117] [skip style] [skip vbump] Restyle files --- R/module_bookmark_manager.R | 4 ++-- R/module_wunder_bar.R | 1 - 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index b9e480cef2..dc61baec62 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -104,8 +104,8 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn state$values$filter_state_on_bookmark <- snapshot # Add snapshot history and bookmark history to bookmark. logger::log_trace("bookmark_manager_srv@onBookmark: storing snapshot and bookmark history") - state$values$snapshot_history <- snapshot_history() # isolate this? - state$values$bookmark_history <- bookmark_history() # isolate this? + state$values$snapshot_history <- snapshot_history() # isolate this? + state$values$bookmark_history <- bookmark_history() # isolate this? }) app_session$onBookmarked(function(url) { logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark button clicked, registering bookmark") diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 4748c76c6e..a507bf310d 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -108,6 +108,5 @@ wunder_bar_srv <- function(id, datasets, filter) { datasets = filter_manager_results$datasets_flat, snapshot_history = snapshot_history ) - }) } From fa334605ce0de5647371a282ccfc4b484a30cff4 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 18 Mar 2024 09:43:03 +0100 Subject: [PATCH 073/117] fix spelling --- R/module_bookmark_manager.R | 2 +- R/module_snapshot_manager.R | 2 +- inst/WORDLIST | 16 +++++++--------- man/module_bookmark_manager.Rd | 2 +- man/module_snapshot_manager.Rd | 2 +- 5 files changed, 11 insertions(+), 13 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index dc61baec62..cf61a215eb 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -47,7 +47,7 @@ #' @section Note: #' All `teal` apps are inherently bookmarkable. Normal `shiny` apps require that `enableBookmarking` be set to "server", #' either by setting an argument in a `shinyApp` call or by calling a special function. In `teal` bookmarks are enabled -#' by automatically setting an option when the apckage is loaded. +#' by automatically setting an option when the package is loaded. #' #' @param id (`character(1)`) `shiny` module instance id. #' @inheritParams module_snapshot_manager diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 313b2821a3..892a077984 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -73,7 +73,7 @@ #' all columns are `logical` vectors. #' @param datasets non-nested (named `list`) of `FilteredData` objects. #' -#' @return `list` containing the snapshot histtory, where each element is an unlisted `teal_slices` object. +#' @return `list` containing the snapshot history, where each element is an unlisted `teal_slices` object. #' #' @name module_snapshot_manager #' @aliases snapshot snapshot_manager snapshot_manager_module diff --git a/inst/WORDLIST b/inst/WORDLIST index 7c9c44530d..20dae96097 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,26 +1,24 @@ Biomarker +bookmarkable CDISC -Forkers -Hoffmann -MAEs -ORCID -Reproducibility -TLG -UI -UIs -UX cloneable customizable +dialog favicon favicons +Forkers funder Hoffmann +href JSON +MAEs omics +ORCID pre programmatically repo reproducibility +Reproducibility summarization tabsetted themer diff --git a/man/module_bookmark_manager.Rd b/man/module_bookmark_manager.Rd index ecc62926d4..9c18e38afa 100644 --- a/man/module_bookmark_manager.Rd +++ b/man/module_bookmark_manager.Rd @@ -90,7 +90,7 @@ Finally, snapshot history and bookmark history are loaded from \code{values.rds} All \code{teal} apps are inherently bookmarkable. Normal \code{shiny} apps require that \code{enableBookmarking} be set to "server", either by setting an argument in a \code{shinyApp} call or by calling a special function. In \code{teal} bookmarks are enabled -by automatically setting an option when the apckage is loaded. +by automatically setting an option when the package is loaded. } \keyword{internal} diff --git a/man/module_snapshot_manager.Rd b/man/module_snapshot_manager.Rd index bb49af9d52..cef2a1f802 100644 --- a/man/module_snapshot_manager.Rd +++ b/man/module_snapshot_manager.Rd @@ -26,7 +26,7 @@ all columns are \code{logical} vectors.} \item{datasets}{non-nested (named \code{list}) of \code{FilteredData} objects.} } \value{ -\code{list} containing the snapshot histtory, where each element is an unlisted \code{teal_slices} object. +\code{list} containing the snapshot history, where each element is an unlisted \code{teal_slices} object. } \description{ Capture and restore snapshots of the global (app) filter state. From 4dcc66c40f9a62824a3a3d1ec49850878b1b1709 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 18 Mar 2024 14:07:32 +0100 Subject: [PATCH 074/117] improve flow control condition --- R/module_nested_tabs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 035a9133b9..237a254bde 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -226,7 +226,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi } # Call modules. - if (session$restoreContext$active) { + if (isTRUE(session$restoreContext$active)) { # When restoring bookmark, all modules must be initialized on app start. # Delayed module initiation (below) precludes restoring state b/c inputs do not exist when restoring occurs. call_module() From 882c1cf9a262ed00047603db8031a702b1ce98d7 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 18 Mar 2024 14:07:43 +0100 Subject: [PATCH 075/117] amend unit tests --- tests/testthat/test-filter_manager.R | 8 ++++---- tests/testthat/test-snapshot_manager.R | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-filter_manager.R b/tests/testthat/test-filter_manager.R index 9cc0bd8d91..67550e3fa6 100644 --- a/tests/testthat/test-filter_manager.R +++ b/tests/testthat/test-filter_manager.R @@ -41,11 +41,11 @@ testthat::test_that("filter_manager_srv initializes properly processes input arg app = filter_manager_srv, args = list( id = "test", - filtered_data_list = filtered_data_list, + datasets = filtered_data_list, filter = filter_global ), expr = { - testthat::expect_named(filtered_data_list, c("m1", "m2", "m3")) + testthat::expect_named(datasets_flat, c("m1", "m2", "m3")) testthat::expect_identical(slices_global(), filter) } @@ -56,11 +56,11 @@ testthat::test_that("filter_manager_srv initializes properly processes input arg app = filter_manager_srv, args = list( id = "test", - filtered_data_list = filtered_data_list, + datasets = filtered_data_list, filter = filter_modular ), expr = { - testthat::expect_named(filtered_data_list, "global_filters") + testthat::expect_named(datasets_flat, "Global Filters") testthat::expect_identical(slices_global(), filter) } diff --git a/tests/testthat/test-snapshot_manager.R b/tests/testthat/test-snapshot_manager.R index 800ece54b3..98e336b551 100644 --- a/tests/testthat/test-snapshot_manager.R +++ b/tests/testthat/test-snapshot_manager.R @@ -32,7 +32,7 @@ testthat::test_that("snapshot manager holds initial state in history", { id = "test", slices_global = slices_global, mapping_matrix = mapping_matrix, - filtered_data_list = filtered_data_list + datasets = filtered_data_list ), expr = { testthat::expect_true("Initial application state" %in% names(snapshot_history())) From 40d7cb96e28f20711a229bb5a78492a8e08be703 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 18 Mar 2024 15:44:54 +0100 Subject: [PATCH 076/117] assign return value in wunder_bar server --- R/module_wunder_bar.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index a507bf310d..44fe28987c 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -101,7 +101,7 @@ wunder_bar_srv <- function(id, datasets, filter) { mapping_matrix = filter_manager_results$mapping_matrix, datasets = filter_manager_results$datasets_flat ) - bookmark_manager_srv( + bookmark_history <- bookmark_manager_srv( id = "bookmark_manager", slices_global = filter_manager_results$slices_global, mapping_matrix = filter_manager_results$mapping_matrix, From 6b99ded58faaf07979e04611bf341f94fac4072c Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 18 Mar 2024 15:45:18 +0100 Subject: [PATCH 077/117] simplify unit test for snapshot manager --- tests/testthat/test-snapshot_manager.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-snapshot_manager.R b/tests/testthat/test-snapshot_manager.R index 98e336b551..4954fe4b41 100644 --- a/tests/testthat/test-snapshot_manager.R +++ b/tests/testthat/test-snapshot_manager.R @@ -14,12 +14,12 @@ testthat::test_that("snapshot manager holds initial state in history", { fd1 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris))) fd2 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), mtcars = list(dataset = mtcars))) fd3 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), women = list(dataset = women))) - filtered_data_list <- list(m1 = fd1, m2 = fd2, m3 = fd3) + datasets_flat <- list(m1 = fd1, m2 = fd2, m3 = fd3) slices_global <- reactiveVal(shiny::isolate(filter)) mapping_matrix <- reactive({ - module_states <- lapply(filtered_data_list, function(x) x$get_filter_state()) + module_states <- lapply(datasets_flat, function(x) x$get_filter_state()) mapping_ragged <- lapply(module_states, function(x) vapply(x, `[[`, character(1L), "id")) all_names <- vapply(slices_global(), `[[`, character(1L), "id") mapping_smooth <- lapply(mapping_ragged, is.element, el = all_names) @@ -32,7 +32,7 @@ testthat::test_that("snapshot manager holds initial state in history", { id = "test", slices_global = slices_global, mapping_matrix = mapping_matrix, - datasets = filtered_data_list + datasets = datasets_flat ), expr = { testthat::expect_true("Initial application state" %in% names(snapshot_history())) From 2b81ce2501b589f274abe2b5334533986d3a40e1 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 18 Mar 2024 15:45:33 +0100 Subject: [PATCH 078/117] add unit tests for wunder_bar module --- tests/testthat/test-wunder_bar.R | 83 ++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 tests/testthat/test-wunder_bar.R diff --git a/tests/testthat/test-wunder_bar.R b/tests/testthat/test-wunder_bar.R new file mode 100644 index 0000000000..52579e2f65 --- /dev/null +++ b/tests/testthat/test-wunder_bar.R @@ -0,0 +1,83 @@ +testthat::test_that("manager modules return expected values", { + filter <- teal_slices( + teal.slice::teal_slice(dataname = "iris", varname = "Sepal.Length"), + teal.slice::teal_slice(dataname = "iris", varname = "Species"), + teal.slice::teal_slice(dataname = "mtcars", varname = "mpg"), + teal.slice::teal_slice(dataname = "women", varname = "height"), + module_specific = TRUE, + mapping = list( + m1 = c("iris Sepal.Length"), + m3 = c("women height"), + global_filters = "iris Species" + ) + ) + + fd1 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris))) + fd2 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), mtcars = list(dataset = mtcars))) + fd3 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), women = list(dataset = women))) + # nolint start: line_length. + set_filter_state(fd1, filter[shiny::isolate(vapply(filter, `[[`, character(1L), "id")) %in% unlist(attr(filter, "mapping")[c("m1", "global_filters")])]) + set_filter_state(fd1, filter[shiny::isolate(vapply(filter, `[[`, character(1L), "id")) %in% unlist(attr(filter, "mapping")[c("m1", "global_filters")])]) + set_filter_state(fd2, filter[shiny::isolate(vapply(filter, `[[`, character(1L), "id")) %in% unlist(attr(filter, "mapping")[c("m2", "global_filters")])]) + set_filter_state(fd3, filter[shiny::isolate(vapply(filter, `[[`, character(1L), "id")) %in% unlist(attr(filter, "mapping")[c("m3", "global_filters")])]) + # nolint end: line_length. + datasets <- list(m1 = fd1, tabs = list(m2 = fd2, m3 = fd3)) + + + shiny::testServer( + app = wunder_bar_srv, + args = list( + id = "wunder_bar_test", + datasets = datasets, + filter = filter + ), + expr = { + testthat::context("filter manager returns slices_global as reactiveVal with teal_slices") + testthat::expect_s3_class(filter_manager_results[["slices_global"]], "reactiveVal") + testthat::expect_s3_class(filter_manager_results[["slices_global"]](), "teal_slices") + testthat::expect_equal( + filter_manager_results[["slices_global"]](), + filter + ) + + testthat::context("filter manager returns mapping_matrix as reactive with data.frame") + testthat::expect_s3_class(filter_manager_results[["mapping_matrix"]], "reactive") + testthat::expect_s3_class(filter_manager_results[["mapping_matrix"]](), "data.frame") + mapping_matrix_expected <- data.frame( + row.names = c("iris Sepal.Length", "iris Species", "mtcars mpg", "women height"), + m1 = c(TRUE, TRUE, NA, NA), + m2 = c(FALSE, TRUE, FALSE, NA), + m3 = c(FALSE, TRUE, NA, TRUE) + ) + testthat::expect_equal( + filter_manager_results[["mapping_matrix"]](), + mapping_matrix_expected + ) + + testthat::context("filter manager returns datasets_flat as flat list of FilteredData objects") + testthat::expect_true(is.list(filter_manager_results[["datasets_flat"]]), info = "datasets_flat is a list") + testthat::expect_named(filter_manager_results[["datasets_flat"]]) + datasets_flat_classes <- lapply(filter_manager_results[["datasets_flat"]], class) + testthat::expect_true( + all(vapply(datasets_flat_classes, identical, logical(1L), c("FilteredData", "R6"))), + info = "datasets_flat contains only FilteredData objects" + ) + testthat::expect_equal( + filter_manager_results[["datasets_flat"]], + list(m1 = fd1, m2 = fd2, m3 = fd3) + ) + + testthat::context("snapshot manager returns snapshot history as list containing unlisted teal_slices") + testthat::expect_equal( + snapshot_history(), + list("Initial application state" = as.list(filter, recursive = TRUE)) + ) + + testthat::context("bookmark manager returns bookmark history as (initially) empty list") + testthat::expect_equal( + bookmark_history(), + list() + ) + } + ) +}) From a7661104574719270e256141fdc3c7e31ca334c0 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 20 Mar 2024 13:29:32 +0100 Subject: [PATCH 079/117] remove delay on starting report previewer --- R/module_nested_tabs.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 237a254bde..d6fc129e59 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -230,6 +230,10 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi # When restoring bookmark, all modules must be initialized on app start. # Delayed module initiation (below) precludes restoring state b/c inputs do not exist when restoring occurs. call_module() + } else if (id == "report_previewer") { + # Report previewer must be initiated on app start for report cards to be included in bookmarks. + # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited). + call_module() } else { # When app starts normally, modules are initialized only when corresponding tabs are clicked. # Observing trigger_module() induces the module only when output$data_reactive is triggered (see above). From 40bed62bd8de6aa84a3f1849f6bd11f2e1fbdb15 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 20 Mar 2024 13:30:40 +0100 Subject: [PATCH 080/117] exclude all buttons (app-wide) from bookmark --- R/module_bookmark_manager.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index cf61a215eb..ec5dbdb166 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -94,8 +94,14 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn # Set up bookmarking callbacks. app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") - # These exclusions are to ensure the right modals open in bookmarked app (first 2) and for extra security (3rd). - setBookmarkExclude(c("bookmark_add", "bookmark_name", "bookmark_accept")) + # Register bookmark exclusions: all buttons and the `textInput` for bookmark name. + # Run in observer so list is updated every time new input item is registered. + observe({ + inputs <- reactiveValuesToList(app_session$input) + ids_buttons <- names(Filter(function(x) inherits(x, "shinyActionButtonValue"), inputs)) + id_bookmark_name <- grep("bookmark_name", names(inputs), value = TRUE, fixed = TRUE) + setBookmarkExclude(union(ids_buttons, id_bookmark_name), session = app_session) + }) app_session$onBookmark(function(state) { # Add current filter state to bookmark. logger::log_trace("bookmark_manager_srv@onBookmark: storing filter state") From 92391a569f76eddf27ed3f187fd321b51c438796 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 21 Mar 2024 09:10:20 +0100 Subject: [PATCH 081/117] simplify code --- R/module_bookmark_manager.R | 2 +- R/module_snapshot_manager.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index ec5dbdb166..4cbe1a6a9d 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -212,7 +212,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn # Create table to display list of bookmarks and their actions. output$bookmark_list <- renderUI({ - rows <- lapply(rev(reactiveValuesToList(divs)), function(d) d) + rows <- rev(reactiveValuesToList(divs)) if (length(rows) == 0L) { div( class = "manager_placeholder", diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 892a077984..ca60fc1774 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -335,7 +335,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { # Create table to display list of snapshots and their actions. output$snapshot_list <- renderUI({ - rows <- lapply(rev(reactiveValuesToList(divs)), function(d) d) + rows <- rev(reactiveValuesToList(divs)) if (length(rows) == 0L) { tags$div( class = "manager_placeholder", From a83b42ce6e2a415597f2c3d3d0f6cb03069c1913 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 21 Mar 2024 11:10:16 +0100 Subject: [PATCH 082/117] change condition for initiating reporte previewer module --- R/module_nested_tabs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index d6fc129e59..71f0cd22fd 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -230,7 +230,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi # When restoring bookmark, all modules must be initialized on app start. # Delayed module initiation (below) precludes restoring state b/c inputs do not exist when restoring occurs. call_module() - } else if (id == "report_previewer") { + } else if (inherits(modules, "teal_module_previewer")) { # Report previewer must be initiated on app start for report cards to be included in bookmarks. # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited). call_module() From 9d7d7b9e4621db9778e68163bec3f45bcc927bf9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= Date: Fri, 22 Mar 2024 14:18:06 +0100 Subject: [PATCH 083/117] restoreValue --- R/module_bookmark_manager.R | 15 +++++++++++++++ R/module_teal.R | 11 ++++++++++- 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 4cbe1a6a9d..efff9b7d5b 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -143,6 +143,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn } }) app_session$onRestored(function(state) { + browser() # Restore filter state. logger::log_trace("bookmark_manager_srv@onRestored: restoring filter state") snapshot <- state$values$filter_state_on_bookmark @@ -226,3 +227,17 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn bookmark_history }) } + + +restoreValue <- function(object_name, default) { + session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") + if (isTRUE(session$restoreContext$active)) { + if (exists(object_name, session$restoreContext$values, inherits = FALSE)) { + session$restoreContext$values[[object_name]] + } else { + default + } + } else { + default + } +} diff --git a/R/module_teal.R b/R/module_teal.R index cb12b09fd8..296261cbda 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -163,7 +163,16 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) { env$progress$set(0.25, message = "Setting data") # Create list of `FilteredData` objects that reflects structure of `modules`. - modules_datasets(teal_data_rv(), modules, filter, teal_data_to_filtered_data(teal_data_rv())) + restored_filter <- restoreValue("filter_state_on_bookmark", filter) + if (!is.teal_slices(restored_filter)) { + restored_filter <- as.teal_slices(restored_filter) + } + modules_datasets( + teal_data_rv(), + modules, + restored_filter, + teal_data_to_filtered_data(teal_data_rv()) + ) }) # Replace splash / welcome screen once data is loaded ---- From 557364caee3503f2ca7f8ec4996be6158f3ab3d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= Date: Fri, 22 Mar 2024 14:58:13 +0100 Subject: [PATCH 084/117] remove browser --- R/module_bookmark_manager.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index efff9b7d5b..0adce788aa 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -143,7 +143,6 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn } }) app_session$onRestored(function(state) { - browser() # Restore filter state. logger::log_trace("bookmark_manager_srv@onRestored: restoring filter state") snapshot <- state$values$filter_state_on_bookmark From be642f5e5d6481f8664e57f823ede2f38546d8c6 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 22 Mar 2024 15:51:16 +0100 Subject: [PATCH 085/117] trigger From 55bf1e0e607e8f2b91cefa9bf5006aa50a78e985 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 22 Mar 2024 16:51:33 +0100 Subject: [PATCH 086/117] add documentation for restoreValue --- R/module_bookmark_manager.R | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 0adce788aa..ff4dcd1cc8 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -227,12 +227,34 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn }) } +# utilities ---- -restoreValue <- function(object_name, default) { +#' Restore value from bookmark. +#' +#' Get value from bookmark or return default. +#' +#' Server-side bookmarks can store not only inputs but also arbitrary values. +#' These values are stored by `onBookmark` callbacks and restored by `onBookmarked` callbacks. +#' Using `teal_data_module` makes it impossible to run the callbacks +#' because the app becomes ready before modules execute and callbacks are registered. +#' In those cases the stored values can still be recovered from the `session` object directly. +#' +#' @param value (`character(1)`) name of value to restore +#' @param default fallback value +#' +#' @return +#' In an application restored from a server-side bookmark, +#' the variable specified by `value` from the `values` environment. +#' Otherwise `default`. +#' +#' @keywords internal +#' +restoreValue <- function(value, default) { # nolint: object_name. + checkmate::assert_character("value") session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") if (isTRUE(session$restoreContext$active)) { - if (exists(object_name, session$restoreContext$values, inherits = FALSE)) { - session$restoreContext$values[[object_name]] + if (exists(value, session$restoreContext$values, inherits = FALSE)) { + session$restoreContext$values[[value]] } else { default } From 75ffb21b96f2233a828117dc04c2abed24625b1a Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 22 Mar 2024 17:04:27 +0100 Subject: [PATCH 087/117] add function for comparing bookmarked states --- R/module_bookmark_manager.R | 108 ++++++++++++++++++++++++++++++++++++ 1 file changed, 108 insertions(+) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index ff4dcd1cc8..cc8c3595a6 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -262,3 +262,111 @@ restoreValue <- function(value, default) { # nolint: object_name. default } } + +#' Compare bookmarks. +#' +#' Test if two bookmarks store identical state. +#' +#' `input` environments are compared one variable at a time and if not identical, +#' values in both bookmarks are reported. States of `datatable`s are stripped +#' of the `time` element before comparing because the time stamp is always different. +#' The contents themselves are not printed as they are large and the contents are not informative. +#' Elements present in one bookmark and absent in the other are also reported. +#' Differences are printed as messages. +#' +#' `values` environments are compared with `all.equal`. +#' +#' @section How to use: +#' Open an application, change relevant inputs (typically, all of them), and create a bookmark. +#' Then open that bookmark and immediately create a bookmark of that. +#' If restoring bookmarks occurred properly, the two bookmarks should store the same state. +#' +#' +#' @param book1,book2 bookmark directories stored in `shiny_bookmarks/`; +#' default to the two most recently modified directories +#' +#' @return +#' Invisible `NULL` if bookmarks are identical or if there are no bookmarks to test. +#' `FALSE` if inconsistencies are detected. +#' +#' @keywords internal +#' +bookmarks_identical <- function(book1, book2) { + if (!dir.exists("shiny_bookmarks")) { + message("no bookmark directory") + return(invisible(NULL)) + } + + ans <- TRUE + + if (missing(book1) && missing(book2)) { + dirs <- list.dirs("shiny_bookmarks", recursive = FALSE) + bookmarks_sorted <- basename(rev(dirs[order(file.mtime(dirs))])) + if (length(bookmarks_sorted) < 2L) { + message("no bookmarks to compare") + return(invisible(NULL)) + } + book1 <- bookmarks_sorted[2L] + book2 <- bookmarks_sorted[1L] + } else { + if (!dir.exists(file.path("shiny_bookmarks", book1))) stop(book1, " not found") + if (!dir.exists(file.path("shiny_bookmarks", book2))) stop(book2, " not found") + } + + book1_input <- readRDS(file.path("shiny_bookmarks", book1, "input.rds")) + book2_input <- readRDS(file.path("shiny_bookmarks", book2, "input.rds")) + + elements_common <- intersect(names(book1_input), names(book2_input)) + dt_states <- grepl("_state$", elements_common) + if (any(dt_states)) { + for (el in elements_common[dt_states]) { + book1_input[[el]][["time"]] <- NULL + book2_input[[el]][["time"]] <- NULL + } + } + + identicals <- mapply(identical, book1_input[elements_common], book2_input[elements_common]) + non_identicals <- names(identicals[!identicals]) + compares <- sprintf("$ %s:\t%s --- %s", non_identicals, book1_input[non_identicals], book2_input[non_identicals]) + if (length(compares) != 0L) { + message("common elements not identical: \n", paste(compares, collapse = "\n")) + ans <- FALSE + } + + elements_boook1 <- setdiff(names(book1_input), names(book2_input)) + if (length(elements_boook1) != 0L) { + dt_states <- grepl("_state$", elements_boook1) + if (any(dt_states)) { + for (el in elements_boook1[dt_states]) { + if (is.list(book1_input[[el]])) book1_input[[el]] <- "--- data table state ---" + } + } + excess1 <- sprintf("$ %s:\t%s", elements_boook1, book1_input[elements_boook1]) + message("elements only in book1: \n", paste(excess1, collapse = "\n")) + ans <- FALSE + } + + elements_boook2 <- setdiff(names(book2_input), names(book1_input)) + if (length(elements_boook2) != 0L) { + dt_states <- grepl("_state$", elements_boook1) + if (any(dt_states)) { + for (el in elements_boook1[dt_states]) { + if (is.list(book2_input[[el]])) book2_input[[el]] <- "--- data table state ---" + } + } + excess2 <- sprintf("$ %s:\t%s", elements_boook2, book2_input[elements_boook2]) + message("elements only in book2: \n", paste(excess2, collapse = "\n")) + ans <- FALSE + } + + book1_values <- readRDS(file.path("shiny_bookmarks", book1, "values.rds")) + book2_values <- readRDS(file.path("shiny_bookmarks", book2, "values.rds")) + + if (!isTRUE(all.equal(book1_values, book2_values))) { + message("different values detected") + ans <- FALSE + } + + if (ans) message("perfect!") + invisible(NULL) +} From 4b94872c410069e0d17940d314a8e006eafc8ba2 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 22 Mar 2024 17:07:44 +0100 Subject: [PATCH 088/117] reorganize code --- R/module_teal.R | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/R/module_teal.R b/R/module_teal.R index 296261cbda..924077a79f 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -162,17 +162,13 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) { env$progress <- shiny::Progress$new(session) env$progress$set(0.25, message = "Setting data") - # Create list of `FilteredData` objects that reflects structure of `modules`. - restored_filter <- restoreValue("filter_state_on_bookmark", filter) - if (!is.teal_slices(restored_filter)) { - restored_filter <- as.teal_slices(restored_filter) + # Restore filter from bookmarked state, if applicable. + filter_restored <- restoreValue("filter_state_on_bookmark", filter) + if (!is.teal_slices(filter_restored)) { + filter_restored <- as.teal_slices(filter_restored) } - modules_datasets( - teal_data_rv(), - modules, - restored_filter, - teal_data_to_filtered_data(teal_data_rv()) - ) + # Create list of `FilteredData` objects that reflects structure of `modules`. + modules_datasets(teal_data_rv(), modules, filter_restored, teal_data_to_filtered_data(teal_data_rv())) }) # Replace splash / welcome screen once data is loaded ---- From 72bce6455df9e289642edbe533cf0ce0002a2532 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Fri, 22 Mar 2024 17:34:00 +0100 Subject: [PATCH 089/117] amend documentation for restoreValue --- R/module_bookmark_manager.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index cc8c3595a6..1a6305728c 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -239,6 +239,10 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn #' because the app becomes ready before modules execute and callbacks are registered. #' In those cases the stored values can still be recovered from the `session` object directly. #' +#' @section Use in modules: +#' Variable names in the `values` environment are prefixed with module name space names, +#' therefore, when using this function in modules, `value` must be run through the name space function. +#' #' @param value (`character(1)`) name of value to restore #' @param default fallback value #' From c4e7556dd03fb43505945219784d359200504c45 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 08:56:32 +0100 Subject: [PATCH 090/117] move storing values to respective modules --- R/module_bookmark_manager.R | 37 ++++++------------------------------- R/module_snapshot_manager.R | 16 +++++++++++++--- 2 files changed, 19 insertions(+), 34 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 1a6305728c..14cfc76118 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -102,17 +102,12 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn id_bookmark_name <- grep("bookmark_name", names(inputs), value = TRUE, fixed = TRUE) setBookmarkExclude(union(ids_buttons, id_bookmark_name), session = app_session) }) - app_session$onBookmark(function(state) { - # Add current filter state to bookmark. - logger::log_trace("bookmark_manager_srv@onBookmark: storing filter state") - snapshot <- as.list(slices_global(), recursive = TRUE) - attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) - state$values$filter_state_on_bookmark <- snapshot - # Add snapshot history and bookmark history to bookmark. - logger::log_trace("bookmark_manager_srv@onBookmark: storing snapshot and bookmark history") - state$values$snapshot_history <- snapshot_history() # isolate this? + # This bookmark concenrs only this module so it can be set on the module session. + session$onBookmark(function(state) { + logger::log_trace("bookmark_manager_srv@onBookmark: storing bookmark history") state$values$bookmark_history <- bookmark_history() # isolate this? }) + # This bookmark can only be used on the app session. app_session$onBookmarked(function(url) { logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark button clicked, registering bookmark") bookmark_name <- trimws(input$bookmark_name) @@ -142,33 +137,13 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn removeModal() } }) - app_session$onRestored(function(state) { - # Restore filter state. - logger::log_trace("bookmark_manager_srv@onRestored: restoring filter state") - snapshot <- state$values$filter_state_on_bookmark - snapshot_state <- as.teal_slices(snapshot) - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) - mapply( - function(filtered_data, filter_ids) { - filtered_data$clear_filter_states(force = TRUE) - slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) - filtered_data$set_filter_state(slices) - }, - filtered_data = datasets, - filter_ids = mapping_unfolded - ) - slices_global(snapshot_state) - # Restore snapshot history and bookmark history. - logger::log_trace("bookmark_manager_srv@onRestored: restoring snapshot and bookmark history") - snapshot_history(state$values$snapshot_history) - bookmark_history(state$values$bookmark_history) - }) ns <- session$ns # Store input states. bookmark_history <- reactiveVal({ - list() + # Restore directly from bookmarked state, if applicable. + restoreValue(ns("bookmark_history"), list()) }) # Bookmark current input state - name bookmark. diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index ca60fc1774..f151757b11 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -115,14 +115,24 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { moduleServer(id, function(input, output, session) { logger::log_trace("snapshot_manager_srv initializing") + session$onBookmark(function(state) { + # Add current filter state to bookmark. + logger::log_trace("snapshot_manager_srv@onBookmark: storing filter state") + snapshot <- as.list(slices_global(), recursive = TRUE) + attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) + state$values$filter_state_on_bookmark <- snapshot + # Add snapshot history and bookmark history to bookmark. + logger::log_trace("snapshot_manager_srv@onBookmark: storing snapshot and bookmark history") + state$values$snapshot_history <- snapshot_history() # isolate this? + }) + ns <- session$ns # Store global filter states ---- filter <- isolate(slices_global()) snapshot_history <- reactiveVal({ - list( - "Initial application state" = as.list(filter, recursive = TRUE) - ) + # Restore directly from bookmarked state, if applicable. + restoreValue(ns("snapshot_history"), list("Initial application state" = as.list(filter, recursive = TRUE))) }) # Snapshot current application state ---- From c0d1e328b72a5273e89dee5771fc0baf86d80b6c Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 08:56:43 +0100 Subject: [PATCH 091/117] correct for namespace when restoring filter in module_teal --- R/module_teal.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_teal.R b/R/module_teal.R index 924077a79f..4c9b109bb5 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -163,7 +163,7 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) { env$progress$set(0.25, message = "Setting data") # Restore filter from bookmarked state, if applicable. - filter_restored <- restoreValue("filter_state_on_bookmark", filter) + filter_restored <- restoreValue("teal-main_ui-wunder_bar-snapshot_manager-filter_state_on_bookmark", filter) if (!is.teal_slices(filter_restored)) { filter_restored <- as.teal_slices(filter_restored) } From 1b716d220f9cedc1a342bf961a70427625b81782 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, 25 Mar 2024 08:10:50 +0000 Subject: [PATCH 092/117] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/bookmarks_identical.Rd | 37 +++++++++++++++++++++++++++++++++++++ man/restoreValue.Rd | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+) create mode 100644 man/bookmarks_identical.Rd create mode 100644 man/restoreValue.Rd diff --git a/man/bookmarks_identical.Rd b/man/bookmarks_identical.Rd new file mode 100644 index 0000000000..a61169362f --- /dev/null +++ b/man/bookmarks_identical.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_bookmark_manager.R +\name{bookmarks_identical} +\alias{bookmarks_identical} +\title{Compare bookmarks.} +\usage{ +bookmarks_identical(book1, book2) +} +\arguments{ +\item{book1, book2}{bookmark directories stored in \verb{shiny_bookmarks/}; +default to the two most recently modified directories} +} +\value{ +Invisible \code{NULL} if bookmarks are identical or if there are no bookmarks to test. +\code{FALSE} if inconsistencies are detected. +} +\description{ +Test if two bookmarks store identical state. +} +\details{ +\code{input} environments are compared one variable at a time and if not identical, +values in both bookmarks are reported. States of \code{datatable}s are stripped +of the \code{time} element before comparing because the time stamp is always different. +The contents themselves are not printed as they are large and the contents are not informative. +Elements present in one bookmark and absent in the other are also reported. +Differences are printed as messages. + +\code{values} environments are compared with \code{all.equal}. +} +\section{How to use}{ + +Open an application, change relevant inputs (typically, all of them), and create a bookmark. +Then open that bookmark and immediately create a bookmark of that. +If restoring bookmarks occurred properly, the two bookmarks should store the same state. +} + +\keyword{internal} diff --git a/man/restoreValue.Rd b/man/restoreValue.Rd new file mode 100644 index 0000000000..63f0b6a860 --- /dev/null +++ b/man/restoreValue.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_bookmark_manager.R +\name{restoreValue} +\alias{restoreValue} +\title{Restore value from bookmark.} +\usage{ +restoreValue(value, default) +} +\arguments{ +\item{value}{(\code{character(1)}) name of value to restore} + +\item{default}{fallback value} +} +\value{ +In an application restored from a server-side bookmark, +the variable specified by \code{value} from the \code{values} environment. +Otherwise \code{default}. +} +\description{ +Get value from bookmark or return default. +} +\details{ +Server-side bookmarks can store not only inputs but also arbitrary values. +These values are stored by \code{onBookmark} callbacks and restored by \code{onBookmarked} callbacks. +Using \code{teal_data_module} makes it impossible to run the callbacks +because the app becomes ready before modules execute and callbacks are registered. +In those cases the stored values can still be recovered from the \code{session} object directly. +} +\section{Use in modules}{ + +Variable names in the \code{values} environment are prefixed with module name space names, +therefore, when using this function in modules, \code{value} must be run through the name space function. +} + +\keyword{internal} From 02a7db43f7631232efc1fa3cd77867fb4151f615 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 09:58:34 +0100 Subject: [PATCH 093/117] modify restoreValue --- R/module_bookmark_manager.R | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 14cfc76118..38e8387be0 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -230,13 +230,12 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn #' restoreValue <- function(value, default) { # nolint: object_name. checkmate::assert_character("value") - session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") - if (isTRUE(session$restoreContext$active)) { - if (exists(value, session$restoreContext$values, inherits = FALSE)) { - session$restoreContext$values[[value]] - } else { - default - } + session_default <- shiny::getDefaultReactiveDomain() + session_parent <- .subset2(session_default, "parent") + session <- if (is.null(session_parent)) session_default else session_parent + + if (isTRUE(session$restoreContext$active) && exists(value, session$restoreContext$values, inherits = FALSE)) { + session$restoreContext$values[[value]] } else { default } From 320014e83e2017ffca5f910059c506c5ccf1e301 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 10:53:12 +0100 Subject: [PATCH 094/117] update documentation for restoreValue --- R/module_bookmark_manager.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 38e8387be0..6f565563d6 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -208,14 +208,14 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn #' #' Get value from bookmark or return default. #' -#' Server-side bookmarks can store not only inputs but also arbitrary values. -#' These values are stored by `onBookmark` callbacks and restored by `onBookmarked` callbacks. +#' Bookmarks can store not only inputs but also arbitrary values. +#' These values are stored by `onBookmark` callbacks and restored by `onBookmarked` callbacks, +#' and they are placed in the `values` environment in the `session$restoreContext` field. #' Using `teal_data_module` makes it impossible to run the callbacks #' because the app becomes ready before modules execute and callbacks are registered. #' In those cases the stored values can still be recovered from the `session` object directly. #' -#' @section Use in modules: -#' Variable names in the `values` environment are prefixed with module name space names, +#' Note that variable names in the `values` environment are prefixed with module name space names, #' therefore, when using this function in modules, `value` must be run through the name space function. #' #' @param value (`character(1)`) name of value to restore From 5dbf498dc851386cd1dc15cb15e1cdfde5605dc5 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 10:54:49 +0100 Subject: [PATCH 095/117] clean up bookmark exclusions in bookmark manager --- R/module_bookmark_manager.R | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 6f565563d6..3c31c90ee0 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -93,21 +93,15 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn logger::log_trace("bookmark_manager_srv initializing") # Set up bookmarking callbacks. - app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") # Register bookmark exclusions: all buttons and the `textInput` for bookmark name. - # Run in observer so list is updated every time new input item is registered. - observe({ - inputs <- reactiveValuesToList(app_session$input) - ids_buttons <- names(Filter(function(x) inherits(x, "shinyActionButtonValue"), inputs)) - id_bookmark_name <- grep("bookmark_name", names(inputs), value = TRUE, fixed = TRUE) - setBookmarkExclude(union(ids_buttons, id_bookmark_name), session = app_session) - }) - # This bookmark concenrs only this module so it can be set on the module session. + setBookmarkExclude(c("bookmark_add", "bookmark_accept", "bookmark_name")) + # Add bookmark history to bookmark. session$onBookmark(function(state) { logger::log_trace("bookmark_manager_srv@onBookmark: storing bookmark history") state$values$bookmark_history <- bookmark_history() # isolate this? }) # This bookmark can only be used on the app session. + app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") app_session$onBookmarked(function(url) { logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark button clicked, registering bookmark") bookmark_name <- trimws(input$bookmark_name) From 02b67107f1716889ee7b4d5b656dee6951a4149a Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 10:56:06 +0100 Subject: [PATCH 096/117] modify storing filter state on bookmark --- R/module_snapshot_manager.R | 13 +++++++++---- R/module_teal.R | 2 +- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index f151757b11..05d976a8ef 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -115,20 +115,25 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { moduleServer(id, function(input, output, session) { logger::log_trace("snapshot_manager_srv initializing") - session$onBookmark(function(state) { - # Add current filter state to bookmark. + # Add current filter state to bookmark. + # This is done on the app session because the value is restored in `module_teal` + # and we don't want to have to use this module's name space there. + app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") + app_session$onBookmark(function(state) { logger::log_trace("snapshot_manager_srv@onBookmark: storing filter state") snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) state$values$filter_state_on_bookmark <- snapshot - # Add snapshot history and bookmark history to bookmark. + }) + # Add snapshot history to bookmark. + session$onBookmark(function(state) { logger::log_trace("snapshot_manager_srv@onBookmark: storing snapshot and bookmark history") state$values$snapshot_history <- snapshot_history() # isolate this? }) ns <- session$ns - # Store global filter states ---- + # Track global filter states ---- filter <- isolate(slices_global()) snapshot_history <- reactiveVal({ # Restore directly from bookmarked state, if applicable. diff --git a/R/module_teal.R b/R/module_teal.R index 4c9b109bb5..924077a79f 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -163,7 +163,7 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) { env$progress$set(0.25, message = "Setting data") # Restore filter from bookmarked state, if applicable. - filter_restored <- restoreValue("teal-main_ui-wunder_bar-snapshot_manager-filter_state_on_bookmark", filter) + filter_restored <- restoreValue("filter_state_on_bookmark", filter) if (!is.teal_slices(filter_restored)) { filter_restored <- as.teal_slices(filter_restored) } From 9e0f2131597e9afb58efe335a390903b168a2113 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 10:58:00 +0100 Subject: [PATCH 097/117] add comment headers --- R/module_bookmark_manager.R | 10 +++++----- R/module_snapshot_manager.R | 1 + 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 3c31c90ee0..70e68e8e4d 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -92,7 +92,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn moduleServer(id, function(input, output, session) { logger::log_trace("bookmark_manager_srv initializing") - # Set up bookmarking callbacks. + # Set up bookmarking callbacks ---- # Register bookmark exclusions: all buttons and the `textInput` for bookmark name. setBookmarkExclude(c("bookmark_add", "bookmark_accept", "bookmark_name")) # Add bookmark history to bookmark. @@ -134,13 +134,13 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn ns <- session$ns - # Store input states. + # Track input states ---- bookmark_history <- reactiveVal({ # Restore directly from bookmarked state, if applicable. restoreValue(ns("bookmark_history"), list()) }) - # Bookmark current input state - name bookmark. + # Bookmark current input state - name bookmark. ---- observeEvent(input$bookmark_add, { logger::log_trace("bookmark_manager_srv: bookmark_add button clicked") showModal( @@ -160,7 +160,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn app_session$doBookmark() }) - # Create UI elements and server logic for the bookmark table. + # Create UI elements and server logic for the bookmark table ---- # Divs are tracked for a slight speed margin. divs <- reactiveValues() @@ -179,7 +179,7 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn }) }) - # Create table to display list of bookmarks and their actions. + # Create table to display list of bookmarks and their actions ---- output$bookmark_list <- renderUI({ rows <- rev(reactiveValuesToList(divs)) if (length(rows) == 0L) { diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 05d976a8ef..239bb4c000 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -115,6 +115,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { moduleServer(id, function(input, output, session) { logger::log_trace("snapshot_manager_srv initializing") + # Set up bookmarking callbacks ---- # Add current filter state to bookmark. # This is done on the app session because the value is restored in `module_teal` # and we don't want to have to use this module's name space there. From 5c1896e57a3731e2f54cef491f9555ab20aec083 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 11:00:11 +0100 Subject: [PATCH 098/117] add enforcement of server-side bookmarks --- R/module_bookmark_manager.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 70e68e8e4d..43e9135a12 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -92,6 +92,21 @@ bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, sn moduleServer(id, function(input, output, session) { logger::log_trace("bookmark_manager_srv initializing") + # Enforce server-side bookmarking ---- + bookmark_option <- getShinyOption("bookmarkStore", "disabled") + if (bookmark_option != "server") { + shinyjs::disable("bookmark_add") + output$bookmark_list <- renderUI({ + div( + class = "manager_placeholder", + sprintf("Bookmarking has been set to \"%s\".", bookmark_option), tags$br(), + "Only server-side bookmarking is supported.", tags$br(), + "Please contact your app developer." + ) + }) + return(list()) + } + # Set up bookmarking callbacks ---- # Register bookmark exclusions: all buttons and the `textInput` for bookmark name. setBookmarkExclude(c("bookmark_add", "bookmark_accept", "bookmark_name")) From ae46faa957ab9ac2c12e7de4b283fd5e2c68aa0d Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 11:05:56 +0100 Subject: [PATCH 099/117] register bookmark exclusions in snapshot manager --- R/module_snapshot_manager.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 239bb4c000..1e724e2058 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -116,6 +116,10 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { logger::log_trace("snapshot_manager_srv initializing") # Set up bookmarking callbacks ---- + # Register bookmark exclusions (all buttons and text fields). + setBookmarkExclude(c("snapshot_add", "snapshot_load", "snapshot_reset", + "snapshot_name_accept", "snaphot_file_accept", + "snapshot_name", "snapshot_file")) # Add current filter state to bookmark. # This is done on the app session because the value is restored in `module_teal` # and we don't want to have to use this module's name space there. From 3423345985c07dbdb0cc329640d64e79407e4f34 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Mon, 25 Mar 2024 10:08:25 +0000 Subject: [PATCH 100/117] [skip style] [skip vbump] Restyle files --- R/module_snapshot_manager.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 1e724e2058..3c14008b52 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -117,9 +117,11 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { # Set up bookmarking callbacks ---- # Register bookmark exclusions (all buttons and text fields). - setBookmarkExclude(c("snapshot_add", "snapshot_load", "snapshot_reset", - "snapshot_name_accept", "snaphot_file_accept", - "snapshot_name", "snapshot_file")) + setBookmarkExclude(c( + "snapshot_add", "snapshot_load", "snapshot_reset", + "snapshot_name_accept", "snaphot_file_accept", + "snapshot_name", "snapshot_file" + )) # Add current filter state to bookmark. # This is done on the app session because the value is restored in `module_teal` # and we don't want to have to use this module's name space there. From 0e25d4c2e4b5bd08278efd3a0cd18ae64f0618fa 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, 25 Mar 2024 10:09:29 +0000 Subject: [PATCH 101/117] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/restoreValue.Rd | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/man/restoreValue.Rd b/man/restoreValue.Rd index 63f0b6a860..ebfce5b446 100644 --- a/man/restoreValue.Rd +++ b/man/restoreValue.Rd @@ -20,16 +20,14 @@ Otherwise \code{default}. Get value from bookmark or return default. } \details{ -Server-side bookmarks can store not only inputs but also arbitrary values. -These values are stored by \code{onBookmark} callbacks and restored by \code{onBookmarked} callbacks. +Bookmarks can store not only inputs but also arbitrary values. +These values are stored by \code{onBookmark} callbacks and restored by \code{onBookmarked} callbacks, +and they are placed in the \code{values} environment in the \code{session$restoreContext} field. Using \code{teal_data_module} makes it impossible to run the callbacks because the app becomes ready before modules execute and callbacks are registered. In those cases the stored values can still be recovered from the \code{session} object directly. -} -\section{Use in modules}{ -Variable names in the \code{values} environment are prefixed with module name space names, +Note that variable names in the \code{values} environment are prefixed with module name space names, therefore, when using this function in modules, \code{value} must be run through the name space function. } - \keyword{internal} From e1df2fd2ae16a8eb0ac169e76a3cc1d6efd3afa9 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 13:51:31 +0100 Subject: [PATCH 102/117] remove agruments in bookmark manager --- R/module_bookmark_manager.R | 9 +-------- R/module_wunder_bar.R | 8 +------- 2 files changed, 2 insertions(+), 15 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 43e9135a12..007e60a096 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -79,15 +79,8 @@ bookmark_manager_ui <- function(id) { #' @rdname module_bookmark_manager #' @keywords internal #' -bookmark_manager_srv <- function(id, slices_global, mapping_matrix, datasets, snapshot_history) { +bookmark_manager_srv <- function(id) { checkmate::assert_character(id) - checkmate::assert_true(is.reactive(slices_global)) - checkmate::assert_class(isolate(slices_global()), "teal_slices") - checkmate::assert_true(is.reactive(mapping_matrix)) - checkmate::assert_data_frame(isolate(mapping_matrix()), null.ok = TRUE) - checkmate::assert_list(datasets, types = "FilteredData", any.missing = FALSE, names = "named") - checkmate::assert_true(is.reactive(snapshot_history)) - checkmate::assert_list(isolate(snapshot_history()), names = "unique") moduleServer(id, function(input, output, session) { logger::log_trace("bookmark_manager_srv initializing") diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 44fe28987c..7410cd891a 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -101,12 +101,6 @@ wunder_bar_srv <- function(id, datasets, filter) { mapping_matrix = filter_manager_results$mapping_matrix, datasets = filter_manager_results$datasets_flat ) - bookmark_history <- bookmark_manager_srv( - id = "bookmark_manager", - slices_global = filter_manager_results$slices_global, - mapping_matrix = filter_manager_results$mapping_matrix, - datasets = filter_manager_results$datasets_flat, - snapshot_history = snapshot_history - ) + bookmark_history <- bookmark_manager_srv(id = "bookmark_manager") }) } From b01a39589aeabc952df6b6efab1821c9b2087a3f Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 13:51:52 +0100 Subject: [PATCH 103/117] fix return value --- R/module_bookmark_manager.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 007e60a096..2231b3d9ed 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -97,7 +97,7 @@ bookmark_manager_srv <- function(id) { "Please contact your app developer." ) }) - return(list()) + return(reactiveVal(list())) } # Set up bookmarking callbacks ---- From 5294f7c49950c9f6b6a9fd5b0d217ed3814afad8 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 13:52:08 +0100 Subject: [PATCH 104/117] exclude buttons from bookmark in wunder bar --- R/module_wunder_bar.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 7410cd891a..d7886ac467 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -52,6 +52,8 @@ wunder_bar_srv <- function(id, datasets, filter) { moduleServer(id, function(input, output, session) { logger::log_trace("wunder_bar_srv initializing") + setBookmarkExclude(c("show_filter_manager", "show_bookmark_manager", "show_bookmark_manager")) + ns <- session$ns observeEvent(input$show_filter_manager, { From 56c55a01e32a1c7757179ab0f2f474738799c3f9 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 14:02:21 +0100 Subject: [PATCH 105/117] amend documentation for snapshot and bookmark managers --- R/module_bookmark_manager.R | 15 +++++---------- R/module_snapshot_manager.R | 6 ++++++ man/module_bookmark_manager.Rd | 32 ++++++-------------------------- man/module_snapshot_manager.Rd | 8 ++++++++ 4 files changed, 25 insertions(+), 36 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 2231b3d9ed..58f19e0a38 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -27,10 +27,7 @@ #' which are kept in the `input` slot of the `session` object, are dumped into the `input.rds` file #' in the `` directory on the server. #' This is out of the box behavior that permeates the entire app, no adjustments to modules are necessary. -#' An additional `onBookmark` callback creates a snapshot of the current filter state -#' (the module has access to the filter state of the application through `slices_global` and `mapping_matrix`). -#' Then that snapshot, the previous snapshot history (which is passed to this module as argument), -#' and the previous bookmark history are dumped into the `values.rds` file in ``. +#' An additional `onBookmark` callback dumps the previous bookmark history to the `values.rds` file in ``. #' #' Finally, an `onBookmarked` callback adds the newly created bookmark to the bookmark history. #' Notably, this occurs _after_ creating the bookmark is concluded so the bookmark history that was stored @@ -39,19 +36,17 @@ #' When starting the app from a bookmark, `shiny` recognizes that the app is being restored, #' locates the bookmark directory and loads both `.rds` file. #' Values stored in `input.rds` are automatically set to their corresponding inputs. -#' The filter state that the app had upon bookmarking, which was saved as a separate snapshot, is restored. -#' This is done in the same manner as in the `snapshot_manager` module and thus requires access to `datasets_flat`, -#' which is passed to this module as argument. -#' Finally, snapshot history and bookmark history are loaded from `values.rds` and set to appropriate `reactiveVal`s. +#' +#' Finally, bookmark history is loaded from `values.rds` and set to the module's `reactiveVal`. #' #' @section Note: #' All `teal` apps are inherently bookmarkable. Normal `shiny` apps require that `enableBookmarking` be set to "server", #' either by setting an argument in a `shinyApp` call or by calling a special function. In `teal` bookmarks are enabled #' by automatically setting an option when the package is loaded. #' +#' If the option is set to a different value by the app developer, the bookmark manager will forbid creating bookmarks. +#' #' @param id (`character(1)`) `shiny` module instance id. -#' @inheritParams module_snapshot_manager -#' @param snapshot_history (named `list`) of unlisted `teal_slices` objects, as returned by the `snapshot_manager`. #' #' @return `reactiveVal` containing a named list of bookmark URLs. #' diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 3c14008b52..bbdfdea2f5 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -65,6 +65,12 @@ #' a `teal_slices` object. When a snapshot is restored from file, its `app_id` is compared to that #' of the current app state and only if the match is the snapshot admitted to the session. #' +#' @section Bookmarks: +#' An `onBookmark` callback creates a snapshot of the current filter state. +#' This is done on the app session, not the module session. +#' (The snapshot will be retrieved by `module_teal` in order to set initial app state in a restored app.) +#' Then that snapshot, and the previous snapshot history are dumped into the `values.rds` file in ``. +#' #' @param id (`character(1)`) `shiny` module instance id. #' @param slices_global (`reactiveVal`) that contains a `teal_slices` object #' containing all `teal_slice`s existing in the app, both active and inactive. diff --git a/man/module_bookmark_manager.Rd b/man/module_bookmark_manager.Rd index 9c18e38afa..8c16a1a84d 100644 --- a/man/module_bookmark_manager.Rd +++ b/man/module_bookmark_manager.Rd @@ -11,27 +11,10 @@ \usage{ bookmark_manager_ui(id) -bookmark_manager_srv( - id, - slices_global, - mapping_matrix, - datasets, - snapshot_history -) +bookmark_manager_srv(id) } \arguments{ \item{id}{(\code{character(1)}) \code{shiny} module instance id.} - -\item{slices_global}{(\code{reactiveVal}) that contains a \code{teal_slices} object -containing all \code{teal_slice}s existing in the app, both active and inactive.} - -\item{mapping_matrix}{(\code{reactive}) that contains a \code{data.frame} representation -of the mapping of filter state ids (rows) to modules labels (columns); -all columns are \code{logical} vectors.} - -\item{datasets}{non-nested (named \code{list}) of \code{FilteredData} objects.} - -\item{snapshot_history}{(named \code{list}) of unlisted \code{teal_slices} objects, as returned by the \code{snapshot_manager}.} } \value{ \code{reactiveVal} containing a named list of bookmark URLs. @@ -68,10 +51,7 @@ Once a bookmark name has been accepted, the app state is saved: values of all in which are kept in the \code{input} slot of the \code{session} object, are dumped into the \code{input.rds} file in the \verb{} directory on the server. This is out of the box behavior that permeates the entire app, no adjustments to modules are necessary. -An additional \code{onBookmark} callback creates a snapshot of the current filter state -(the module has access to the filter state of the application through \code{slices_global} and \code{mapping_matrix}). -Then that snapshot, the previous snapshot history (which is passed to this module as argument), -and the previous bookmark history are dumped into the \code{values.rds} file in \verb{}. +An additional \code{onBookmark} callback dumps the previous bookmark history to the \code{values.rds} file in \verb{}. Finally, an \code{onBookmarked} callback adds the newly created bookmark to the bookmark history. Notably, this occurs \emph{after} creating the bookmark is concluded so the bookmark history that was stored @@ -80,10 +60,8 @@ does not include the newly added bookmark. When starting the app from a bookmark, \code{shiny} recognizes that the app is being restored, locates the bookmark directory and loads both \code{.rds} file. Values stored in \code{input.rds} are automatically set to their corresponding inputs. -The filter state that the app had upon bookmarking, which was saved as a separate snapshot, is restored. -This is done in the same manner as in the \code{snapshot_manager} module and thus requires access to \code{datasets_flat}, -which is passed to this module as argument. -Finally, snapshot history and bookmark history are loaded from \code{values.rds} and set to appropriate \code{reactiveVal}s. + +Finally, bookmark history is loaded from \code{values.rds} and set to the module's \code{reactiveVal}. } \section{Note}{ @@ -91,6 +69,8 @@ Finally, snapshot history and bookmark history are loaded from \code{values.rds} All \code{teal} apps are inherently bookmarkable. Normal \code{shiny} apps require that \code{enableBookmarking} be set to "server", either by setting an argument in a \code{shinyApp} call or by calling a special function. In \code{teal} bookmarks are enabled by automatically setting an option when the package is loaded. + +If the option is set to a different value by the app developer, the bookmark manager will forbid creating bookmarks. } \keyword{internal} diff --git a/man/module_snapshot_manager.Rd b/man/module_snapshot_manager.Rd index cef2a1f802..80aa9fb44b 100644 --- a/man/module_snapshot_manager.Rd +++ b/man/module_snapshot_manager.Rd @@ -101,6 +101,14 @@ a \code{teal_slices} object. When a snapshot is restored from file, its \code{ap of the current app state and only if the match is the snapshot admitted to the session. } +\section{Bookmarks}{ + +An \code{onBookmark} callback creates a snapshot of the current filter state. +This is done on the app session, not the module session. +(The snapshot will be retrieved by \code{module_teal} in order to set initial app state in a restored app.) +Then that snapshot, and the previous snapshot history are dumped into the \code{values.rds} file in \verb{}. +} + \author{ Aleksander Chlebowski } From 8aac98cc3024605788f7ffdc6d8d3963d677e1b1 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 25 Mar 2024 16:33:50 +0100 Subject: [PATCH 106/117] extend message in bookmarks_identical --- R/module_bookmark_manager.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 58f19e0a38..5004d1af3f 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -339,6 +339,7 @@ bookmarks_identical <- function(book1, book2) { if (!isTRUE(all.equal(book1_values, book2_values))) { message("different values detected") + message("choices for numeric filters MAY be different, see RangeFilterState$set_choices") ans <- FALSE } From bf8b39b906620c6286000833f347935d7904f67f Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Tue, 26 Mar 2024 11:00:22 +0100 Subject: [PATCH 107/117] teal_bookmarkable flags --- R/dummy_functions.R | 4 +++- R/reporter_previewer_module.R | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/dummy_functions.R b/R/dummy_functions.R index e59fa06917..4624b783d9 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -15,7 +15,7 @@ #' @export example_module <- function(label = "example teal module", datanames = "all") { checkmate::assert_string(label) - module( + ans <- module( label, server = function(id, data) { checkmate::assert_class(data(), "teal_data") @@ -48,4 +48,6 @@ example_module <- function(label = "example teal module", datanames = "all") { }, datanames = datanames ) + attr(ans, "teal_bookmarkable") <- TRUE + ans } diff --git a/R/reporter_previewer_module.R b/R/reporter_previewer_module.R index eeba694a7f..ba84f3173f 100644 --- a/R/reporter_previewer_module.R +++ b/R/reporter_previewer_module.R @@ -43,5 +43,6 @@ reporter_previewer_module <- function(label = "Report previewer", server_args = # This is to prevent another module being labeled "Report previewer". class(module) <- c("teal_module_previewer", class(module)) module$label <- label + attr(module, "teal_bookmarkable") <- TRUE module } From d4a2b4dac6ef3e2844b6d69e8e0bcbff20451488 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Tue, 26 Mar 2024 11:01:26 +0100 Subject: [PATCH 108/117] only set app id on filter when missing --- R/init.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/init.R b/R/init.R index 34adf6cdb8..8bea52b69a 100644 --- a/R/init.R +++ b/R/init.R @@ -164,8 +164,8 @@ init <- function(data, stop("Only one `landing_popup_module` can be used.") } - ## `filter` - app_id attribute - attr(filter, "app_id") <- create_app_id(data, modules) + ## `filter` - set app_id attribute unless present (when restoring bookmark) + if (is.null(attr(filter, "app_id", exact = TRUE))) attr(filter, "app_id") <- create_app_id(data, modules) ## `filter` - convert teal.slice::teal_slices to teal::teal_slices filter <- as.teal_slices(as.list(filter)) From 9edf512cfba5f8dc516357876c6d960dbc1b7401 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= <6959016+gogonzo@users.noreply.github.com> Date: Thu, 28 Mar 2024 12:32:34 +0100 Subject: [PATCH 109/117] Bookmarking info (#1184) --- R/module_bookmark_manager.R | 235 +++++++----------- R/module_tabs_with_filters.R | 2 +- R/module_wunder_bar.R | 31 +-- R/modules.R | 18 ++ R/zzz.R | 3 - inst/css/sidebar.css | 20 +- man/module_bookmark_manager.Rd | 61 ++--- man/module_wunder_bar.Rd | 19 +- man/modules_bookmarkable.Rd | 19 ++ .../test-shinytest2-module_bookmark_manager.R | 29 +++ tests/testthat/test-shinytest2-wunder_bar.R | 38 +++ tests/testthat/test-wunder_bar.R | 83 ------- 12 files changed, 255 insertions(+), 303 deletions(-) create mode 100644 man/modules_bookmarkable.Rd create mode 100644 tests/testthat/test-shinytest2-module_bookmark_manager.R create mode 100644 tests/testthat/test-shinytest2-wunder_bar.R delete mode 100644 tests/testthat/test-wunder_bar.R diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 5004d1af3f..1516a0c194 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -1,201 +1,148 @@ #' App state management. #' +#' @description +#' `r lifecycle::badge("experimental")` +#' #' Capture and restore the global (app) input state. #' +#' @details #' This module introduces bookmarks into `teal` apps: the `shiny` bookmarking mechanism becomes enabled #' and server-side bookmarks can be created. #' -#' The bookmark manager is accessed with the bookmark icon in the [`wunder_bar`]. -#' The manager's header contains a title and a bookmark icon. Clicking the icon creates a bookmark. -#' As bookmarks are added, they will show up as rows in a table, each being a link that, when clicked, -#' will open the bookmarked application in a new window. +#' The bookmark manager presents a button with the bookmark icon and is placed in the [`wunder_bar`]. +#' When clicked, the button creates a bookmark and opens a modal which displays the bookmark URL. +#' +#' `teal` does not guarantee that all modules (`teal_module` objects) are bookmarkable. +#' Those that are, have a `teal_bookmarkable` attribute set to `TRUE`. If any modules are not bookmarkable, +#' the bookmark manager modal displays a warning and the bookmark button displays a flag. +#' In order to communicate that a external module is bookmarkable, the module developer +#' should set the `teal_bookmarkable` attribute to `TRUE`. #' #' @section Server logic: #' A bookmark is a URL that contains the app address with a `/?_state_id_=` suffix. #' `` is a directory created on the server, where the state of the application is saved. #' Accessing the bookmark URL opens a new session of the app that starts in the previously saved state. #' -#' Bookmarks are stored in a `reactiveVal` as a named list. -#' For every bookmark created a piece of HTML is created that contains a link, -#' whose text is the name of the bookmark and whose href is the bookmark URL. -#' -#' @section Bookmark mechanics: -#' When a bookmark is added, the user is prompted to name it. -#' New bookmark names are validated so that thy are unique. Leading and trailing white space is trimmed. -#' -#' Once a bookmark name has been accepted, the app state is saved: values of all inputs, -#' which are kept in the `input` slot of the `session` object, are dumped into the `input.rds` file -#' in the `` directory on the server. -#' This is out of the box behavior that permeates the entire app, no adjustments to modules are necessary. -#' An additional `onBookmark` callback dumps the previous bookmark history to the `values.rds` file in ``. -#' -#' Finally, an `onBookmarked` callback adds the newly created bookmark to the bookmark history. -#' Notably, this occurs _after_ creating the bookmark is concluded so the bookmark history that was stored -#' does not include the newly added bookmark. -#' -#' When starting the app from a bookmark, `shiny` recognizes that the app is being restored, -#' locates the bookmark directory and loads both `.rds` file. -#' Values stored in `input.rds` are automatically set to their corresponding inputs. -#' -#' Finally, bookmark history is loaded from `values.rds` and set to the module's `reactiveVal`. -#' #' @section Note: -#' All `teal` apps are inherently bookmarkable. Normal `shiny` apps require that `enableBookmarking` be set to "server", -#' either by setting an argument in a `shinyApp` call or by calling a special function. In `teal` bookmarks are enabled -#' by automatically setting an option when the package is loaded. +#' `shinyOptions("bookmarkStore" = "server")` is set in `teal` by default on package load. +#' Using the `url` option is not supported. #' -#' If the option is set to a different value by the app developer, the bookmark manager will forbid creating bookmarks. +#' @inheritParams module_wunder_bar #' -#' @param id (`character(1)`) `shiny` module instance id. +#' @return Invisible `NULL`. #' -#' @return `reactiveVal` containing a named list of bookmark URLs. -#' -#' @name module_bookmark_manager #' @aliases bookmark bookmark_manager bookmark_manager_module #' - #' @rdname module_bookmark_manager #' @keywords internal #' bookmark_manager_ui <- function(id) { ns <- NS(id) - div( - class = "manager_content", - div( - class = "manager_table_row", - span(tags$b("Bookmark manager")), - actionLink(ns("bookmark_add"), NULL, icon = suppressMessages(icon("solid fa-bookmark")), title = "add bookmark"), - NULL - ), - uiOutput(ns("bookmark_list")) + tags$button( + id = ns("do_bookmark"), + class = "btn action-button wunder_bar_button bookmark_manager_button", + title = "Add bookmark", + tags$span( + suppressMessages(icon("solid fa-bookmark")), + uiOutput(ns("warning_badge"), inline = TRUE) + ) ) } #' @rdname module_bookmark_manager #' @keywords internal #' -bookmark_manager_srv <- function(id) { +bookmark_manager_srv <- function(id, modules) { checkmate::assert_character(id) - + checkmate::assert_class(modules, "teal_modules") moduleServer(id, function(input, output, session) { logger::log_trace("bookmark_manager_srv initializing") - - # Enforce server-side bookmarking ---- + ns <- session$ns bookmark_option <- getShinyOption("bookmarkStore", "disabled") - if (bookmark_option != "server") { - shinyjs::disable("bookmark_add") - output$bookmark_list <- renderUI({ - div( - class = "manager_placeholder", - sprintf("Bookmarking has been set to \"%s\".", bookmark_option), tags$br(), - "Only server-side bookmarking is supported.", tags$br(), - "Please contact your app developer." + is_unbookmarkable <- rapply( + modules_bookmarkable(modules), + Negate(isTRUE), + how = "unlist" + ) + # Render bookmark warnings count + output$warning_badge <- renderUI({ + if (!identical(bookmark_option, "server")) { + shinyjs::hide("do_bookmark") + NULL + } else if (any(is_unbookmarkable)) { + tags$span( + sum(is_unbookmarkable), + class = "badge-warning badge-count text-white bg-danger" ) - }) - return(reactiveVal(list())) - } + } + }) # Set up bookmarking callbacks ---- - # Register bookmark exclusions: all buttons and the `textInput` for bookmark name. - setBookmarkExclude(c("bookmark_add", "bookmark_accept", "bookmark_name")) - # Add bookmark history to bookmark. - session$onBookmark(function(state) { - logger::log_trace("bookmark_manager_srv@onBookmark: storing bookmark history") - state$values$bookmark_history <- bookmark_history() # isolate this? - }) + # Register bookmark exclusions: do_bookmark button to avoid re-bookmarking + setBookmarkExclude(c("do_bookmark")) # This bookmark can only be used on the app session. app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") app_session$onBookmarked(function(url) { logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark button clicked, registering bookmark") - bookmark_name <- trimws(input$bookmark_name) - if (identical(bookmark_name, "")) { - logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark name rejected") - showNotification( - "Please name the bookmark.", - type = "message" + modal_content <- if (bookmark_option != "server") { + msg <- sprintf( + "Bookmarking has been set to \"%s\".\n%s\n%s", + bookmark_option, + "Only server-side bookmarking is supported.", + "Please contact your app developer." ) - updateTextInput(inputId = "bookmark_name", value = "", placeholder = "Meaningful, unique name") - unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) - } else if (is.element(make.names(bookmark_name), make.names(names(bookmark_history())))) { - logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark name rejected") - showNotification( - "This name is in conflict with other bookmark names. Please choose a different one.", - type = "message" + tags$div( + tags$p(msg, class = "text-warning") ) - updateTextInput(inputId = "bookmark_name", value = "", placeholder = "Meaningful, unique name") - unlink(strsplit(url, "_state_id_=")[[1L]][[2L]], recursive = TRUE, force = TRUE, expand = FALSE) } else { - # Add bookmark URL to bookmark history (with name). - logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark name accepted, adding to history") - bookmark_update <- c(bookmark_history(), list(url)) - names(bookmark_update)[length(bookmark_update)] <- bookmark_name - bookmark_history(bookmark_update) - - removeModal() + tags$div( + tags$span( + tags$pre(url) + ), + if (any(is_unbookmarkable)) { + bkmb_summary <- rapply( + modules_bookmarkable(modules), + function(x) { + if (isTRUE(x)) { + "\u2705" # check mark + } else if (isFALSE(x)) { + "\u274C" # cross mark + } else { + "\u2753" # question mark + } + }, + how = "replace" + ) + tags$div( + tags$p( + icon("fas fa-exclamation-triangle"), + "Some modules will not be restored when using this bookmark.", + tags$br(), + "Check the list below to see which modules are not bookmarkable.", + class = "text-warning" + ), + tags$pre(yaml::as.yaml(bkmb_summary)) + ) + } + ) } - }) - ns <- session$ns - - # Track input states ---- - bookmark_history <- reactiveVal({ - # Restore directly from bookmarked state, if applicable. - restoreValue(ns("bookmark_history"), list()) - }) - - # Bookmark current input state - name bookmark. ---- - observeEvent(input$bookmark_add, { - logger::log_trace("bookmark_manager_srv: bookmark_add button clicked") showModal( modalDialog( - textInput(ns("bookmark_name"), "Name the bookmark", width = "100%", placeholder = "Meaningful, unique name"), - footer = tagList( - actionButton(ns("bookmark_accept"), label = "Accept", icon = icon("thumbs-up")), - modalButton(label = "Cancel", icon = icon("thumbs-down")) - ), - size = "s" + title = "Bookmarked teal app url", + modal_content, + easyClose = TRUE ) ) }) - # Initiate bookmarking with normal action button b/c `bookmarkButton` may not work on Windows. - observeEvent(input$bookmark_accept, { - app_session$doBookmark() - }) - - # Create UI elements and server logic for the bookmark table ---- - # Divs are tracked for a slight speed margin. - divs <- reactiveValues() - - observeEvent(bookmark_history(), { - logger::log_trace("bookmark_manager_srv: bookmark history changed, updating bookmark list") - lapply(names(bookmark_history()), function(s) { - id_rowme <- sprintf("rowme_%s", make.names(s)) - - # Create a row for the bookmark table. - if (!is.element(id_rowme, names(divs))) { - divs[[id_rowme]] <- div( - class = "manager_table_row", - a(h5(s), title = "go to bookmark", href = bookmark_history()[[s]], target = "blank") - ) - } - }) - }) - - # Create table to display list of bookmarks and their actions ---- - output$bookmark_list <- renderUI({ - rows <- rev(reactiveValuesToList(divs)) - if (length(rows) == 0L) { - div( - class = "manager_placeholder", - "Bookmarks will appear here." - ) - } else { - rows - } + # manually trigger bookmarking because of the problems reported on windows with bookmarkButton in teal + observeEvent(input$do_bookmark, { + logger::log_trace("bookmark_manager_srv@1 do_bookmark module clicked.") + session$doBookmark() }) - bookmark_history + invisible(NULL) }) } diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index 410c208932..a9651c7ff4 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -84,7 +84,7 @@ srv_tabs_with_filters <- function(id, logger::log_trace("srv_tabs_with_filters initializing the module.") is_module_specific <- isTRUE(attr(filter, "module_specific")) - wunder_bar_out <- wunder_bar_srv("wunder_bar", datasets, filter) + wunder_bar_out <- wunder_bar_srv("wunder_bar", datasets, filter, modules) active_module <- srv_nested_tabs( id = "root", diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index d7886ac467..28b245f7bb 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -13,8 +13,7 @@ #' @name module_wunder_bar #' @aliases wunder_bar wunder_bar_module #' -#' @param id (`character(1)`) `shiny` module instance id. -#' @inheritParams module_filter_manager +#' @inheritParams module_tabs_with_filters #' #' @return Nothing is returned. @@ -22,8 +21,9 @@ #' @keywords internal wunder_bar_ui <- function(id) { ns <- NS(id) - rev( # Reversing order because buttons show up in UI from right to left. + rev( tagList( + title = "", tags$button( id = ns("show_filter_manager"), class = "btn action-button wunder_bar_button", @@ -36,19 +36,14 @@ wunder_bar_ui <- function(id) { title = "Manage filter state snapshots", icon("camera") ), - tags$button( - id = ns("show_bookmark_manager"), - class = "btn action-button wunder_bar_button", - title = "Manage bookmarks", - suppressMessages(icon("solid fa-bookmark")) - ) + bookmark_manager_ui(ns("bookmark_manager")) ) ) } #' @rdname module_wunder_bar #' @keywords internal -wunder_bar_srv <- function(id, datasets, filter) { +wunder_bar_srv <- function(id, datasets, filter, modules) { moduleServer(id, function(input, output, session) { logger::log_trace("wunder_bar_srv initializing") @@ -61,6 +56,7 @@ wunder_bar_srv <- function(id, datasets, filter) { showModal( modalDialog( filter_manager_ui(ns("filter_manager")), + class = "filter_manager_modal", size = "l", footer = NULL, easyClose = TRUE @@ -73,18 +69,7 @@ wunder_bar_srv <- function(id, datasets, filter) { showModal( modalDialog( snapshot_manager_ui(ns("snapshot_manager")), - size = "m", - footer = NULL, - easyClose = TRUE - ) - ) - }) - - observeEvent(input$show_bookmark_manager, { - logger::log_trace("wunder_bar_srv@1 show_bookmark_manager button has been clicked.") - showModal( - modalDialog( - bookmark_manager_ui(ns("bookmark_manager")), + class = "snapshot_manager_modal", size = "m", footer = NULL, easyClose = TRUE @@ -103,6 +88,6 @@ wunder_bar_srv <- function(id, datasets, filter) { mapping_matrix = filter_manager_results$mapping_matrix, datasets = filter_manager_results$datasets_flat ) - bookmark_history <- bookmark_manager_srv(id = "bookmark_manager") + bookmark_manager_srv(id = "bookmark_manager", modules = modules) }) } diff --git a/R/modules.R b/R/modules.R index 751d34fb74..4ec76a2ca7 100644 --- a/R/modules.R +++ b/R/modules.R @@ -421,3 +421,21 @@ module_labels <- function(modules) { modules$label } } + +#' Retrieve `teal_bookmarkable` attribute from `teal_modules` +#' +#' @param modules (`teal_modules` or `teal_module`) object +#' @return named list of the same structure as `modules` with `TRUE` or `FALSE` values indicating +#' whether the module is bookmarkable. +#' @keywords internal +modules_bookmarkable <- function(modules) { + checkmate::assert_multi_class(modules, c("teal_modules", "teal_module")) + if (inherits(modules, "teal_modules")) { + setNames( + lapply(modules$children, modules_bookmarkable), + vapply(modules$children, `[[`, "label", FUN.VALUE = character(1)) + ) + } else { + attr(modules, "teal_bookmarkable", exact = TRUE) + } +} diff --git a/R/zzz.R b/R/zzz.R index b71efe3e1b..817f9bae4b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -12,9 +12,6 @@ teal.logger::register_logger("teal") teal.logger::register_handlers("teal") - # Turn on server-side bookmarking in shiny. - shiny::shinyOptions("bookmarkStore" = "server") - invisible() } diff --git a/inst/css/sidebar.css b/inst/css/sidebar.css index bf40f19d1f..60a9380f7d 100644 --- a/inst/css/sidebar.css +++ b/inst/css/sidebar.css @@ -1,13 +1,26 @@ /* teal sidebar css */ -.filter_hamburger, .wunder_bar_button { +.filter_hamburger, +.wunder_bar_button { font-size: 16px; padding: 8px !important; float: right !important; background-color: transparent !important; } +.badge-count { + padding-left: 1em; + padding-right: 1em; + -webkit-border-radius: 1em; + -moz-border-radius: 1em; + border-radius: 1em; + font-size: 0.7em; + padding: 0 .5em; + vertical-align: top; + margin-left: -1em; +} + /* disable any anchor with the disabled class */ a.disabled { pointer-events: none; @@ -26,13 +39,16 @@ a.disabled { flex-direction: row; align-items: center; } + .manager_table_row *:first-child { flex: 1 1 80%; } -.manager_table_row * + * { + +.manager_table_row *+* { flex: 0 0 0px; padding: 0em 1.5em; } + .manager_placeholder { margin-top: 1em; } diff --git a/man/module_bookmark_manager.Rd b/man/module_bookmark_manager.Rd index 8c16a1a84d..c7a2aa0a28 100644 --- a/man/module_bookmark_manager.Rd +++ b/man/module_bookmark_manager.Rd @@ -1,7 +1,6 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/module_bookmark_manager.R -\name{module_bookmark_manager} -\alias{module_bookmark_manager} +\name{bookmark_manager_ui} \alias{bookmark_manager_ui} \alias{bookmark} \alias{bookmark_manager} @@ -11,66 +10,48 @@ \usage{ bookmark_manager_ui(id) -bookmark_manager_srv(id) +bookmark_manager_srv(id, modules) } \arguments{ -\item{id}{(\code{character(1)}) \code{shiny} module instance id.} +\item{id}{(\code{character(1)}) +module id} + +\item{modules}{(\code{teal_modules}) object containing the output modules which +will be displayed in the \code{teal} application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for +more details.} } \value{ -\code{reactiveVal} containing a named list of bookmark URLs. +Invisible \code{NULL}. } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + Capture and restore the global (app) input state. } \details{ This module introduces bookmarks into \code{teal} apps: the \code{shiny} bookmarking mechanism becomes enabled and server-side bookmarks can be created. -The bookmark manager is accessed with the bookmark icon in the \code{\link{wunder_bar}}. -The manager's header contains a title and a bookmark icon. Clicking the icon creates a bookmark. -As bookmarks are added, they will show up as rows in a table, each being a link that, when clicked, -will open the bookmarked application in a new window. +The bookmark manager presents a button with the bookmark icon and is placed in the \code{\link{wunder_bar}}. +When clicked, the button creates a bookmark and opens a modal which displays the bookmark URL. + +\code{teal} does not guarantee that all modules (\code{teal_module} objects) are bookmarkable. +Those that are, have a \code{teal_bookmarkable} attribute set to \code{TRUE}. If any modules are not bookmarkable, +the bookmark manager modal displays a warning and the bookmark button displays a flag. +In order to communicate that a external module is bookmarkable, the module developer +should set the \code{teal_bookmarkable} attribute to \code{TRUE}. } \section{Server logic}{ A bookmark is a URL that contains the app address with a \verb{/?_state_id_=} suffix. \verb{} is a directory created on the server, where the state of the application is saved. Accessing the bookmark URL opens a new session of the app that starts in the previously saved state. - -Bookmarks are stored in a \code{reactiveVal} as a named list. -For every bookmark created a piece of HTML is created that contains a link, -whose text is the name of the bookmark and whose href is the bookmark URL. -} - -\section{Bookmark mechanics}{ - -When a bookmark is added, the user is prompted to name it. -New bookmark names are validated so that thy are unique. Leading and trailing white space is trimmed. - -Once a bookmark name has been accepted, the app state is saved: values of all inputs, -which are kept in the \code{input} slot of the \code{session} object, are dumped into the \code{input.rds} file -in the \verb{} directory on the server. -This is out of the box behavior that permeates the entire app, no adjustments to modules are necessary. -An additional \code{onBookmark} callback dumps the previous bookmark history to the \code{values.rds} file in \verb{}. - -Finally, an \code{onBookmarked} callback adds the newly created bookmark to the bookmark history. -Notably, this occurs \emph{after} creating the bookmark is concluded so the bookmark history that was stored -does not include the newly added bookmark. - -When starting the app from a bookmark, \code{shiny} recognizes that the app is being restored, -locates the bookmark directory and loads both \code{.rds} file. -Values stored in \code{input.rds} are automatically set to their corresponding inputs. - -Finally, bookmark history is loaded from \code{values.rds} and set to the module's \code{reactiveVal}. } \section{Note}{ -All \code{teal} apps are inherently bookmarkable. Normal \code{shiny} apps require that \code{enableBookmarking} be set to "server", -either by setting an argument in a \code{shinyApp} call or by calling a special function. In \code{teal} bookmarks are enabled -by automatically setting an option when the package is loaded. - -If the option is set to a different value by the app developer, the bookmark manager will forbid creating bookmarks. +\code{shinyOptions("bookmarkStore" = "server")} is set in \code{teal} by default on package load. +Using the \code{url} option is not supported. } \keyword{internal} diff --git a/man/module_wunder_bar.Rd b/man/module_wunder_bar.Rd index 32d7653038..6e4f5b8fa1 100644 --- a/man/module_wunder_bar.Rd +++ b/man/module_wunder_bar.Rd @@ -10,19 +10,24 @@ \usage{ wunder_bar_ui(id) -wunder_bar_srv(id, datasets, filter) +wunder_bar_srv(id, datasets, filter, modules) } \arguments{ -\item{id}{(\code{character(1)}) \code{shiny} module instance id.} +\item{id}{(\code{character(1)}) +module id} -\item{datasets}{(named \code{list}) -A list, possibly nested, of \code{FilteredData} objects. -Each \code{FilteredData} will be served to one module in the \code{teal} application. -The structure of the list must reflect the nesting of modules in tabs -and the names of the list must match the labels of their respective modules.} +\item{datasets}{(named \code{list} of \code{FilteredData}) +object to store filter state and filtered datasets, shared across modules. For more +details see \code{\link[teal.slice:FilteredData]{teal.slice::FilteredData}}. Structure of the list must be the same as structure +of the \code{modules} argument and list names must correspond to the labels in \code{modules}. +When filter is not module-specific then list contains the same object in all elements.} \item{filter}{(\code{teal_slices}) Specifies the initial filter using \code{\link[=teal_slices]{teal_slices()}}.} + +\item{modules}{(\code{teal_modules}) object containing the output modules which +will be displayed in the \code{teal} application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for +more details.} } \value{ Nothing is returned. diff --git a/man/modules_bookmarkable.Rd b/man/modules_bookmarkable.Rd new file mode 100644 index 0000000000..2b33647a2b --- /dev/null +++ b/man/modules_bookmarkable.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{modules_bookmarkable} +\alias{modules_bookmarkable} +\title{Retrieve \code{teal_bookmarkable} attribute from \code{teal_modules}} +\usage{ +modules_bookmarkable(modules) +} +\arguments{ +\item{modules}{(\code{teal_modules} or \code{teal_module}) object} +} +\value{ +named list of the same structure as \code{modules} with \code{TRUE} or \code{FALSE} values indicating +whether the module is bookmarkable. +} +\description{ +Retrieve \code{teal_bookmarkable} attribute from \code{teal_modules} +} +\keyword{internal} diff --git a/tests/testthat/test-shinytest2-module_bookmark_manager.R b/tests/testthat/test-shinytest2-module_bookmark_manager.R new file mode 100644 index 0000000000..5d10369aff --- /dev/null +++ b/tests/testthat/test-shinytest2-module_bookmark_manager.R @@ -0,0 +1,29 @@ +testthat::test_that("bookmark_manager_button is hidden by default", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + on.exit(app$stop()) + app$wait_for_idle(timeout = default_idle_timeout) + testthat::expect_identical( + app$get_attr(".bookmark_manager_button", "style"), + "display: none;" + ) +}) + + +test_that("bookmark_manager_button is hidden when enableBookmarking = 'url'", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + enableBookmarking = "url" + ) + on.exit(app$stop()) + app$wait_for_idle(timeout = default_idle_timeout) + testthat::expect_identical( + app$get_attr(".bookmark_manager_button", "style"), + "display: none;" + ) +}) diff --git a/tests/testthat/test-shinytest2-wunder_bar.R b/tests/testthat/test-shinytest2-wunder_bar.R new file mode 100644 index 0000000000..838924d14b --- /dev/null +++ b/tests/testthat/test-shinytest2-wunder_bar.R @@ -0,0 +1,38 @@ +testthat::test_that("wunder_bar_srv clicking filter icon opens filter-manager modal", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + app$wait_for_idle(timeout = default_idle_timeout) + + filter_manager_btn_id <- grep( + "filter_manager", + x = app$get_attr(".wunder_bar_button", "id"), + value = TRUE + ) + + testthat::expect_true(is.null(app$get_text(".filter_manager_modal"))) + app$click(filter_manager_btn_id) + testthat::expect_true(!is.null(app$get_text(".filter_manager_modal"))) +}) + + +testthat::test_that("wunder_bar_srv clicking snapshot icon opens snapshot-manager modal", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + app$wait_for_idle(timeout = default_idle_timeout) + + snapshot_manager_btn_id <- grep( + "snapshot_manager", + x = app$get_attr(".wunder_bar_button", "id"), + value = TRUE + ) + + testthat::expect_true(is.null(app$get_text(".snapshot_manager_modal"))) + app$click(snapshot_manager_btn_id) + testthat::expect_true(!is.null(app$get_text(".snapshot_manager_modal"))) +}) diff --git a/tests/testthat/test-wunder_bar.R b/tests/testthat/test-wunder_bar.R deleted file mode 100644 index 52579e2f65..0000000000 --- a/tests/testthat/test-wunder_bar.R +++ /dev/null @@ -1,83 +0,0 @@ -testthat::test_that("manager modules return expected values", { - filter <- teal_slices( - teal.slice::teal_slice(dataname = "iris", varname = "Sepal.Length"), - teal.slice::teal_slice(dataname = "iris", varname = "Species"), - teal.slice::teal_slice(dataname = "mtcars", varname = "mpg"), - teal.slice::teal_slice(dataname = "women", varname = "height"), - module_specific = TRUE, - mapping = list( - m1 = c("iris Sepal.Length"), - m3 = c("women height"), - global_filters = "iris Species" - ) - ) - - fd1 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris))) - fd2 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), mtcars = list(dataset = mtcars))) - fd3 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), women = list(dataset = women))) - # nolint start: line_length. - set_filter_state(fd1, filter[shiny::isolate(vapply(filter, `[[`, character(1L), "id")) %in% unlist(attr(filter, "mapping")[c("m1", "global_filters")])]) - set_filter_state(fd1, filter[shiny::isolate(vapply(filter, `[[`, character(1L), "id")) %in% unlist(attr(filter, "mapping")[c("m1", "global_filters")])]) - set_filter_state(fd2, filter[shiny::isolate(vapply(filter, `[[`, character(1L), "id")) %in% unlist(attr(filter, "mapping")[c("m2", "global_filters")])]) - set_filter_state(fd3, filter[shiny::isolate(vapply(filter, `[[`, character(1L), "id")) %in% unlist(attr(filter, "mapping")[c("m3", "global_filters")])]) - # nolint end: line_length. - datasets <- list(m1 = fd1, tabs = list(m2 = fd2, m3 = fd3)) - - - shiny::testServer( - app = wunder_bar_srv, - args = list( - id = "wunder_bar_test", - datasets = datasets, - filter = filter - ), - expr = { - testthat::context("filter manager returns slices_global as reactiveVal with teal_slices") - testthat::expect_s3_class(filter_manager_results[["slices_global"]], "reactiveVal") - testthat::expect_s3_class(filter_manager_results[["slices_global"]](), "teal_slices") - testthat::expect_equal( - filter_manager_results[["slices_global"]](), - filter - ) - - testthat::context("filter manager returns mapping_matrix as reactive with data.frame") - testthat::expect_s3_class(filter_manager_results[["mapping_matrix"]], "reactive") - testthat::expect_s3_class(filter_manager_results[["mapping_matrix"]](), "data.frame") - mapping_matrix_expected <- data.frame( - row.names = c("iris Sepal.Length", "iris Species", "mtcars mpg", "women height"), - m1 = c(TRUE, TRUE, NA, NA), - m2 = c(FALSE, TRUE, FALSE, NA), - m3 = c(FALSE, TRUE, NA, TRUE) - ) - testthat::expect_equal( - filter_manager_results[["mapping_matrix"]](), - mapping_matrix_expected - ) - - testthat::context("filter manager returns datasets_flat as flat list of FilteredData objects") - testthat::expect_true(is.list(filter_manager_results[["datasets_flat"]]), info = "datasets_flat is a list") - testthat::expect_named(filter_manager_results[["datasets_flat"]]) - datasets_flat_classes <- lapply(filter_manager_results[["datasets_flat"]], class) - testthat::expect_true( - all(vapply(datasets_flat_classes, identical, logical(1L), c("FilteredData", "R6"))), - info = "datasets_flat contains only FilteredData objects" - ) - testthat::expect_equal( - filter_manager_results[["datasets_flat"]], - list(m1 = fd1, m2 = fd2, m3 = fd3) - ) - - testthat::context("snapshot manager returns snapshot history as list containing unlisted teal_slices") - testthat::expect_equal( - snapshot_history(), - list("Initial application state" = as.list(filter, recursive = TRUE)) - ) - - testthat::context("bookmark manager returns bookmark history as (initially) empty list") - testthat::expect_equal( - bookmark_history(), - list() - ) - } - ) -}) From 92890d522714b8bb27d0101b100b21ebeaf574ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= Date: Thu, 28 Mar 2024 13:03:18 +0100 Subject: [PATCH 110/117] remove test --- .../test-shinytest2-module_bookmark_manager.R | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/tests/testthat/test-shinytest2-module_bookmark_manager.R b/tests/testthat/test-shinytest2-module_bookmark_manager.R index 5d10369aff..0d22c480bf 100644 --- a/tests/testthat/test-shinytest2-module_bookmark_manager.R +++ b/tests/testthat/test-shinytest2-module_bookmark_manager.R @@ -11,19 +11,3 @@ testthat::test_that("bookmark_manager_button is hidden by default", { "display: none;" ) }) - - -test_that("bookmark_manager_button is hidden when enableBookmarking = 'url'", { - skip_if_too_deep(5) - app <- TealAppDriver$new( - data = simple_teal_data(), - modules = example_module(label = "Example Module"), - enableBookmarking = "url" - ) - on.exit(app$stop()) - app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical( - app$get_attr(".bookmark_manager_button", "style"), - "display: none;" - ) -}) From 30e8b28b40a6d8577da4548d1d1970333494c31c Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 28 Mar 2024 13:33:50 +0100 Subject: [PATCH 111/117] trigger From a3659db23ca2ce78e154e86e4f4480a39b6fa578 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= Date: Thu, 28 Mar 2024 13:46:52 +0100 Subject: [PATCH 112/117] fix docs collate --- R/module_wunder_bar.R | 1 + man/teal_slices.Rd | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 28b245f7bb..7f9382aab1 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -12,6 +12,7 @@ #' #' @name module_wunder_bar #' @aliases wunder_bar wunder_bar_module +#' @include module_bookmark_manager.R #' #' @inheritParams module_tabs_with_filters #' diff --git a/man/teal_slices.Rd b/man/teal_slices.Rd index b24cc9a5a3..834ba37617 100644 --- a/man/teal_slices.Rd +++ b/man/teal_slices.Rd @@ -22,7 +22,8 @@ as.teal_slices(x) \method{c}{teal_slices}(...) } \arguments{ -\item{...}{any number of \code{teal_slice} objects.} +\item{...}{any number of \code{teal_slice} objects. For \code{print} and \code{format}, +additional arguments passed to other functions.} \item{include_varnames, exclude_varnames}{(\verb{named list}s of \code{character}) where list names match names of data sets and vector elements match variable names in respective data sets; From d3a0e09f7a3b30b26765bdb155eba0d4a9f18403 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= Date: Thu, 28 Mar 2024 13:50:02 +0100 Subject: [PATCH 113/117] fix docs --- R/module_bookmark_manager.R | 2 +- R/module_wunder_bar.R | 1 - man/module_bookmark_manager.Rd | 3 ++- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index 1516a0c194..e7da1b5a53 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -33,7 +33,7 @@ #' #' @aliases bookmark bookmark_manager bookmark_manager_module #' -#' @rdname module_bookmark_manager +#' @name module_bookmark_manager #' @keywords internal #' bookmark_manager_ui <- function(id) { diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R index 7f9382aab1..28b245f7bb 100644 --- a/R/module_wunder_bar.R +++ b/R/module_wunder_bar.R @@ -12,7 +12,6 @@ #' #' @name module_wunder_bar #' @aliases wunder_bar wunder_bar_module -#' @include module_bookmark_manager.R #' #' @inheritParams module_tabs_with_filters #' diff --git a/man/module_bookmark_manager.Rd b/man/module_bookmark_manager.Rd index c7a2aa0a28..dfab0d417e 100644 --- a/man/module_bookmark_manager.Rd +++ b/man/module_bookmark_manager.Rd @@ -1,6 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/module_bookmark_manager.R -\name{bookmark_manager_ui} +\name{module_bookmark_manager} +\alias{module_bookmark_manager} \alias{bookmark_manager_ui} \alias{bookmark} \alias{bookmark_manager} From 7b40974333126d0f33fb7f762fc3289905ea7c8c 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, 28 Mar 2024 12:53:27 +0000 Subject: [PATCH 114/117] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/teal_slices.Rd | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/man/teal_slices.Rd b/man/teal_slices.Rd index 834ba37617..b24cc9a5a3 100644 --- a/man/teal_slices.Rd +++ b/man/teal_slices.Rd @@ -22,8 +22,7 @@ as.teal_slices(x) \method{c}{teal_slices}(...) } \arguments{ -\item{...}{any number of \code{teal_slice} objects. For \code{print} and \code{format}, -additional arguments passed to other functions.} +\item{...}{any number of \code{teal_slice} objects.} \item{include_varnames, exclude_varnames}{(\verb{named list}s of \code{character}) where list names match names of data sets and vector elements match variable names in respective data sets; From 0aca94c49c93e19e4d56e242d303c60e611d7849 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 28 Mar 2024 14:56:37 +0100 Subject: [PATCH 115/117] trigger From 97c2efb0b5c838f77e6cad5f1e4c1fd5c12856bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= Date: Thu, 28 Mar 2024 15:32:23 +0100 Subject: [PATCH 116/117] adding testing --- R/module_bookmark_manager.R | 72 ++++++++++++------- man/module_bookmark_manager.Rd | 7 +- man/teal_slices.Rd | 3 +- .../test-shinytest2-module_bookmark_manager.R | 56 +++++++++++++-- tests/testthat/test-shinytest2-wunder_bar.R | 2 - 5 files changed, 101 insertions(+), 39 deletions(-) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R index e7da1b5a53..594392ba00 100644 --- a/R/module_bookmark_manager.R +++ b/R/module_bookmark_manager.R @@ -24,8 +24,10 @@ #' Accessing the bookmark URL opens a new session of the app that starts in the previously saved state. #' #' @section Note: -#' `shinyOptions("bookmarkStore" = "server")` is set in `teal` by default on package load. -#' Using the `url` option is not supported. +#' To enable bookmarking use either: +#' - `shiny` app by using `shinyApp(..., enableBookmarking = "server")` (not supported in `shinytest2`) +#' - set `options(shiny.bookmarkStore = "server")` before running the app +#' #' #' @inheritParams module_wunder_bar #' @@ -38,15 +40,7 @@ #' bookmark_manager_ui <- function(id) { ns <- NS(id) - tags$button( - id = ns("do_bookmark"), - class = "btn action-button wunder_bar_button bookmark_manager_button", - title = "Add bookmark", - tags$span( - suppressMessages(icon("solid fa-bookmark")), - uiOutput(ns("warning_badge"), inline = TRUE) - ) - ) + uiOutput(ns("bookmark_button"), inline = TRUE) } #' @rdname module_bookmark_manager @@ -58,21 +52,34 @@ bookmark_manager_srv <- function(id, modules) { moduleServer(id, function(input, output, session) { logger::log_trace("bookmark_manager_srv initializing") ns <- session$ns - bookmark_option <- getShinyOption("bookmarkStore", "disabled") - is_unbookmarkable <- rapply( + bookmark_option <- getShinyOption("bookmarkStore") + if (is.null(bookmark_option) && identical(getOption("shiny.bookmarkStore"), "server")) { + bookmark_option <- getOption("shiny.bookmarkStore") + # option alone doesn't activate bookmarking - we need to set shinyOptions + shinyOptions(bookmarkStore = bookmark_option) + } + + is_unbookmarkable <- unlist(rapply2( modules_bookmarkable(modules), - Negate(isTRUE), - how = "unlist" - ) + Negate(isTRUE) + )) + # Render bookmark warnings count - output$warning_badge <- renderUI({ - if (!identical(bookmark_option, "server")) { - shinyjs::hide("do_bookmark") - NULL - } else if (any(is_unbookmarkable)) { - tags$span( - sum(is_unbookmarkable), - class = "badge-warning badge-count text-white bg-danger" + output$bookmark_button <- renderUI({ + if (!all(is_unbookmarkable) && identical(bookmark_option, "server")) { + tags$button( + id = ns("do_bookmark"), + class = "btn action-button wunder_bar_button bookmark_manager_button", + title = "Add bookmark", + tags$span( + suppressMessages(icon("solid fa-bookmark")), + if (any(is_unbookmarkable)) { + tags$span( + sum(is_unbookmarkable), + class = "badge-warning badge-count text-white bg-danger" + ) + } + ) ) } }) @@ -100,7 +107,7 @@ bookmark_manager_srv <- function(id, modules) { tags$pre(url) ), if (any(is_unbookmarkable)) { - bkmb_summary <- rapply( + bkmb_summary <- rapply2( modules_bookmarkable(modules), function(x) { if (isTRUE(x)) { @@ -110,8 +117,7 @@ bookmark_manager_srv <- function(id, modules) { } else { "\u2753" # question mark } - }, - how = "replace" + } ) tags$div( tags$p( @@ -129,6 +135,7 @@ bookmark_manager_srv <- function(id, modules) { showModal( modalDialog( + id = ns("bookmark_modal"), title = "Bookmarked teal app url", modal_content, easyClose = TRUE @@ -293,3 +300,14 @@ bookmarks_identical <- function(book1, book2) { if (ans) message("perfect!") invisible(NULL) } + + +# Replacement for [base::rapply] which doesn't handle NULL values - skips the evaluation +# of the function and returns NULL for given element. +rapply2 <- function(x, f) { + if (inherits(x, "list")) { + lapply(x, rapply2, f = f) + } else { + f(x) + } +} diff --git a/man/module_bookmark_manager.Rd b/man/module_bookmark_manager.Rd index dfab0d417e..ca7a892cb5 100644 --- a/man/module_bookmark_manager.Rd +++ b/man/module_bookmark_manager.Rd @@ -51,8 +51,11 @@ Accessing the bookmark URL opens a new session of the app that starts in the pre \section{Note}{ -\code{shinyOptions("bookmarkStore" = "server")} is set in \code{teal} by default on package load. -Using the \code{url} option is not supported. +To enable bookmarking use either: +\itemize{ +\item \code{shiny} app by using \code{shinyApp(..., enableBookmarking = "server")} (not supported in \code{shinytest2}) +\item set \code{options(shiny.bookmarkStore = "server")} before running the app +} } \keyword{internal} diff --git a/man/teal_slices.Rd b/man/teal_slices.Rd index 834ba37617..b24cc9a5a3 100644 --- a/man/teal_slices.Rd +++ b/man/teal_slices.Rd @@ -22,8 +22,7 @@ as.teal_slices(x) \method{c}{teal_slices}(...) } \arguments{ -\item{...}{any number of \code{teal_slice} objects. For \code{print} and \code{format}, -additional arguments passed to other functions.} +\item{...}{any number of \code{teal_slice} objects.} \item{include_varnames, exclude_varnames}{(\verb{named list}s of \code{character}) where list names match names of data sets and vector elements match variable names in respective data sets; diff --git a/tests/testthat/test-shinytest2-module_bookmark_manager.R b/tests/testthat/test-shinytest2-module_bookmark_manager.R index 0d22c480bf..237e53a99b 100644 --- a/tests/testthat/test-shinytest2-module_bookmark_manager.R +++ b/tests/testthat/test-shinytest2-module_bookmark_manager.R @@ -1,13 +1,57 @@ -testthat::test_that("bookmark_manager_button is hidden by default", { +testthat::test_that("bookmark_manager_button is not rendered by default", { skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), - modules = example_module(label = "Example Module") + modules = example_module(label = "Example Module"), + options = options() ) on.exit(app$stop()) - app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical( - app$get_attr(".bookmark_manager_button", "style"), - "display: none;" + testthat::expect_null( + app$get_html(".bookmark_manager_button") + ) +}) + + +testthat::test_that("bookmark_manager_button is not rendered when enableBookmarking = 'url'", { + skip_if_too_deep(5) + options(shiny.bookmarkStore = "url") + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + options = options() + ) + on.exit(app$stop()) + testthat::expect_null( + app$get_html(".bookmark_manager_button") + ) +}) + + +testthat::test_that("bookmark_manager_button is rendered when enableBookmarking = 'server'", { + skip_if_too_deep(5) + options(shiny.bookmarkStore = "server") + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + options = options() + ) + on.exit(app$stop()) + testthat::expect_true(!is.null(app$get_html(".bookmark_manager_button"))) +}) + +testthat::test_that("bookmark_manager_button shows modal with url containing state_id when clicked", { + skip_if_too_deep(5) + options(shiny.bookmarkStore = "server") + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + options = options() + ) + bookmark_button_id <- app$get_attr(".bookmark_manager_button", "id") + app$click(bookmark_button_id) + + testthat::expect_match( + rvest::html_text(app$get_html_rvest("div[id$=bookmark_modal] pre")), + "_state_id_" ) }) diff --git a/tests/testthat/test-shinytest2-wunder_bar.R b/tests/testthat/test-shinytest2-wunder_bar.R index 838924d14b..dedb7c244d 100644 --- a/tests/testthat/test-shinytest2-wunder_bar.R +++ b/tests/testthat/test-shinytest2-wunder_bar.R @@ -4,7 +4,6 @@ testthat::test_that("wunder_bar_srv clicking filter icon opens filter-manager mo data = simple_teal_data(), modules = example_module(label = "Example Module") ) - app$wait_for_idle(timeout = default_idle_timeout) filter_manager_btn_id <- grep( "filter_manager", @@ -24,7 +23,6 @@ testthat::test_that("wunder_bar_srv clicking snapshot icon opens snapshot-manage data = simple_teal_data(), modules = example_module(label = "Example Module") ) - app$wait_for_idle(timeout = default_idle_timeout) snapshot_manager_btn_id <- grep( "snapshot_manager", From 6682d750bebbae3e4b951ffa63df5a426e3a89f7 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 28 Mar 2024 15:54:10 +0100 Subject: [PATCH 117/117] revert NEWS update --- NEWS.md | 3 --- 1 file changed, 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index a3f8aa899b..401182f502 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,5 @@ # teal 0.15.2.9018 -### New features -* Introduced bookmarking feature. Click the bookmark icon in the top-right corner to access the bookmark manager. - ### Miscellaneous * Filter mapping display is no longer coupled to the snapshot manager.