96 lines
2.9 KiB
R
96 lines
2.9 KiB
R
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"
|
||
})
|
||
})
|
||
}
|