Create per-dataset hidden dashboard pages with stable nav links

DESCRIPTION

@@ -38,4 +38,6 @@ Imports:
     tibble
 Suggests: 
     pkgload,
-    rsconnect
+    rsconnect,
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3

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`)
 
   }
 

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
+  )
+}

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)
   }

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(LightLogWeb)
+
+test_check("LightLogWeb")

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")
+})