From be6fdd4e4a1bf00185921e523831c3de77d9bd53 Mon Sep 17 00:00:00 2001 From: Johannes Zauner <112665672+JZauner@users.noreply.github.com> Date: Fri, 13 Mar 2026 09:37:28 +0100 Subject: [PATCH] Create one hidden dashboard nav page per dataset --- DESCRIPTION | 4 +- R/LightLogWeb-app.R | 98 +++++++++++++++++++------ R/dataset_nav_pages.R | 27 +++++++ R/m_dataset_dashboard.R | 17 +---- tests/testthat.R | 4 + tests/testthat/test-dataset-nav-pages.R | 38 ++++++++++ 6 files changed, 151 insertions(+), 37 deletions(-) create mode 100644 R/dataset_nav_pages.R create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-dataset-nav-pages.R diff --git a/DESCRIPTION b/DESCRIPTION index 4a691af..dee363e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -38,4 +38,6 @@ Imports: tibble Suggests: pkgload, - rsconnect + rsconnect, + testthat (>= 3.0.0) +Config/testthat/edition: 3 diff --git a/R/LightLogWeb-app.R b/R/LightLogWeb-app.R index fcbd6ed..c03ca82 100644 --- a/R/LightLogWeb-app.R +++ b/R/LightLogWeb-app.R @@ -13,9 +13,9 @@ LightLogWeb <- function(...) { #setting the upload limit to 100 MB ops <- - options(shiny.maxRequestSize=100*1024^2, + options(shiny.maxRequestSize = 100 * 1024^2, spinner.caption = "Calculating..." - ) + ) on.exit(options(ops)) #add a resource path to the www folder addResourcePath( @@ -32,11 +32,8 @@ LightLogWeb <- function(...) { sidebar = datasetSidebarUI("datasets"), # nav_spacer(), nav_panel("Import", - importUI("import") - ), - nav_panel("Dashboard", value = "dashboard", - datasetDashboardUI("dashboard") - ) + importUI("import") + ) ) # Server ------------------------------------------------------------------ @@ -60,11 +57,78 @@ LightLogWeb <- function(...) { #Dataset handling selected_dataset <- datasetManagerServer("datasets", datasets, newest_set) - #Dataset Dashboard - datasetDashboardServer("dashboard", - datasets = datasets, - selected_dataset =selected_dataset, - active_panel = reactive(input$main_nav)) + dataset_pages <- reactiveVal(list()) + next_page_id <- reactiveVal(1L) + + observe({ + current_datasets <- names(reactiveValuesToList(datasets)) + pages <- dataset_pages() + page_diff <- reconcile_dataset_pages( + pages = pages, + dataset_names = current_datasets, + selected_dataset = selected_dataset() + ) + + if (!is.null(page_diff$renamed)) { + page <- pages[[page_diff$renamed$from]] + page$dataset_name(page_diff$renamed$to) + pages[[page_diff$renamed$to]] <- page + pages[[page_diff$renamed$from]] <- NULL + page_diff$removed <- setdiff(page_diff$removed, page_diff$renamed$from) + page_diff$added <- setdiff(page_diff$added, page_diff$renamed$to) + } + + if (length(page_diff$removed) > 0) { + purrr::walk(page_diff$removed, function(dataset_name) { + nav_remove( + id = "main_nav", + target = pages[[dataset_name]]$nav_value, + session = session + ) + pages[[dataset_name]] <- NULL + }) + } + + if (length(page_diff$added) > 0) { + purrr::walk(page_diff$added, function(dataset_name) { + page_id <- next_page_id() + next_page_id(page_id + 1L) + page <- new_dataset_page(dataset_name = dataset_name, id = page_id) + + nav_insert( + id = "main_nav", + nav = nav_panel_hidden( + title = dataset_name, + value = page$nav_value, + datasetDashboardUI(page$module_id) + ), + target = "Import", + position = "after", + session = session + ) + + datasetDashboardServer( + id = page$module_id, + datasets = datasets, + selected_dataset = reactive(page$dataset_name()) + ) + + pages[[dataset_name]] <- page + }) + } + + dataset_pages(pages) + }) + + observe({ + req(selected_dataset()) + req(selected_dataset() %in% names(dataset_pages())) + nav_select( + id = "main_nav", + selected = dataset_pages()[[selected_dataset()]]$nav_value, + session = session + ) + }) #close the waiting screen # waiter::waiter_hide() @@ -75,15 +139,7 @@ LightLogWeb <- function(...) { observe({ nav_select("main_nav", selected = "Import") accordion_panel_open("import-import_accordion", "import_specs") - }) |> bindEvent(input$`datasets-import_newdata`, - input$`dashboard-to_import`) - - #when testdata were loaded in - observe({ - nav_select("main_nav", selected = "dashboard") - }) |> bindEvent(input$`datasets-import_testdata`, - ignoreInit = TRUE - ) + }) |> bindEvent(input$`datasets-import_newdata`) } diff --git a/R/dataset_nav_pages.R b/R/dataset_nav_pages.R new file mode 100644 index 0000000..1215bc0 --- /dev/null +++ b/R/dataset_nav_pages.R @@ -0,0 +1,27 @@ +new_dataset_page <- function(dataset_name, id) { + list( + nav_value = paste0("dataset_", id), + module_id = paste0("dashboard_dataset_", id), + dataset_name = reactiveVal(dataset_name) + ) +} + +reconcile_dataset_pages <- function(pages, dataset_names, selected_dataset = NULL) { + existing_names <- names(pages) + added <- setdiff(dataset_names, existing_names) + removed <- setdiff(existing_names, dataset_names) + + renamed <- NULL + if (length(added) == 1 && + length(removed) == 1 && + !is.null(selected_dataset) && + identical(selected_dataset, added)) { + renamed <- list(from = removed, to = added) + } + + list( + added = added, + removed = removed, + renamed = renamed + ) +} diff --git a/R/m_dataset_dashboard.R b/R/m_dataset_dashboard.R index 7249c69..d34faf2 100644 --- a/R/m_dataset_dashboard.R +++ b/R/m_dataset_dashboard.R @@ -45,23 +45,11 @@ datasetDashboardUI <- function(id) { datasetDashboardServer <- function(id, datasets, - selected_dataset, - active_panel) { + selected_dataset) { stopifnot(is.reactive(selected_dataset), - is.reactivevalues(datasets), - is.reactive(active_panel)) + is.reactivevalues(datasets)) moduleServer(id, function(input, output, session) { - #check whether a dataset is selected - observe({ - req(active_panel() == "dashboard") - no_dataset_modal(selected_dataset, session) - }) - - observe({ - removeModal() - }) |> bindEvent(input$to_import) - #create the ui of the dataset heading output$dataset_name <- renderUI({ req(selected_dataset()) @@ -152,7 +140,6 @@ datasetDashboard <- function(...) { bindEvent(TRUE, once = TRUE) datasetDashboardServer("Dashboard", - active_panel = reactive("dashboard"), selected_dataset = selected_dataset, datasets = datasets) } diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..bb614d7 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(LightLogWeb) + +test_check("LightLogWeb") diff --git a/tests/testthat/test-dataset-nav-pages.R b/tests/testthat/test-dataset-nav-pages.R new file mode 100644 index 0000000..313738e --- /dev/null +++ b/tests/testthat/test-dataset-nav-pages.R @@ -0,0 +1,38 @@ +test_that("LightLogWeb:::new_dataset_page creates stable identifiers", { + page <- LightLogWeb:::new_dataset_page("example", 4) + + expect_equal(page$nav_value, "dataset_4") + expect_equal(page$module_id, "dashboard_dataset_4") + expect_equal(page$dataset_name(), "example") + + page$dataset_name("renamed") + expect_equal(page$dataset_name(), "renamed") +}) + +test_that("LightLogWeb:::reconcile_dataset_pages detects added and removed datasets", { + pages <- list(alpha = list(), beta = list()) + + page_diff <- LightLogWeb:::reconcile_dataset_pages( + pages = pages, + dataset_names = c("beta", "gamma") + ) + + expect_equal(page_diff$added, "gamma") + expect_equal(page_diff$removed, "alpha") + expect_null(page_diff$renamed) +}) + +test_that("LightLogWeb:::reconcile_dataset_pages detects single rename", { + pages <- list(alpha = list()) + + page_diff <- LightLogWeb:::reconcile_dataset_pages( + pages = pages, + dataset_names = "beta", + selected_dataset = "beta" + ) + + expect_equal(page_diff$added, "beta") + expect_equal(page_diff$removed, "alpha") + expect_equal(page_diff$renamed$from, "alpha") + expect_equal(page_diff$renamed$to, "beta") +})