add homekeeper stack

2026-07-06 19:25:38 +02:00
commit 58983e6855
90 changed files with 6816 additions and 0 deletions
@@ -0,0 +1,95 @@
+lineage_render_node <- function(ns, co, all_cols) {
+  children <- all_cols[
+    !is.na(all_cols$parent_colony_id) & all_cols$parent_colony_id == co$id, ]
+  children <- children[order(children$name), ]
+
+  is_closed  <- !is.na(co$closed_at)
+  apiary_lbl <- co$apiary_name %||% "–"
+  queen_lbl  <- if (!is.na(co$queen_year) && co$queen_year != "")
+    paste0(" · Kgn. ", co$queen_year) else ""
+
+  card <- shiny::div(
+    class = paste("card tap-card mb-2", if (is_closed) "opacity-60 border-secondary" else ""),
+    onclick = sprintf("Shiny.setInputValue('%s', %d, {priority:'event'})", ns("select"), co$id),
+    bslib::card_body(
+      class = "d-flex justify-content-between align-items-center py-2 px-3",
+      shiny::div(
+        shiny::tags$strong(class = if (is_closed) "text-muted" else "", co$name),
+        shiny::tags$p(class = "text-muted small mb-0",
+          paste0(apiary_lbl, queen_lbl))
+      ),
+      shiny::HTML(colony_status_badge(co$status))
+    )
+  )
+
+  if (nrow(children) == 0) {
+    card
+  } else {
+    shiny::tagList(
+      card,
+      shiny::div(
+        class = "ms-4 ps-2 border-start border-2 border-secondary-subtle mb-1",
+        lapply(seq_len(nrow(children)), function(i)
+          lineage_render_node(ns, children[i, ], all_cols))
+      )
+    )
+  }
+}
+
+screen_lineage_ui <- function(id) {
+  ns <- NS(id)
+  shiny::div(
+    shiny::div(
+      class = "d-flex gap-2 mb-3",
+      shiny::checkboxInput(ns("show_closed"), "Eingegangene Völker anzeigen", value = FALSE)
+    ),
+    shiny::uiOutput(ns("tree"))
+  )
+}
+
+screen_lineage_server <- function(id, db, nav) {
+  moduleServer(id, function(input, output, session) {
+    ns <- session$ns
+
+    all_cols <- reactive({
+      req(nav$screen == "lineage")
+      db_colonies_list(db, include_closed = TRUE)
+    })
+
+    output$tree <- renderUI({
+      cols <- all_cols()
+      if (!isTRUE(input$show_closed))
+        cols <- cols[is.na(cols$closed_at), ]
+
+      if (nrow(cols) == 0)
+        return(shiny::p(class = "text-muted", "Keine Völker vorhanden."))
+
+      all_ids <- cols$id
+      is_root <- is.na(cols$parent_colony_id) | !(cols$parent_colony_id %in% all_ids)
+      roots   <- cols[is_root, ]
+      roots   <- roots[order(roots$apiary_name, roots$name), ]
+
+      cur_apiary <- NULL
+      out <- list()
+      for (i in seq_len(nrow(roots))) {
+        ro <- roots[i, ]
+        ap <- ro$apiary_name %||% "–"
+        if (!identical(ap, cur_apiary)) {
+          out <- c(out, list(shiny::tags$p(class = "text-muted small fw-semibold mt-3 mb-1", ap)))
+          cur_apiary <- ap
+        }
+        out <- c(out, list(lineage_render_node(ns, ro, cols)))
+      }
+      shiny::tagList(out)
+    })
+
+    observeEvent(input$select, {
+      id   <- as.integer(input$select)
+      cols <- isolate(all_cols())
+      co   <- cols[cols$id == id, ]
+      if (nrow(co) > 0) nav$apiary_id <- co$apiary_id[1]
+      nav$colony_id <- id
+      nav$screen    <- "colony"
+    })
+  })
+}