add homekeeper stack

This commit is contained in:
2026-07-06 19:25:38 +02:00
commit 58983e6855
90 changed files with 6816 additions and 0 deletions
+164
View File
@@ -0,0 +1,164 @@
screen_actions_ui <- function(id) {
ns <- NS(id)
shiny::div(
section_card(NULL,
shiny::div(class = "row g-2 py-2",
shiny::div(class = "col-6",
shiny::dateInput(ns("date"), "Datum", value = Sys.Date(), language = "de", weekstart = 1)
),
shiny::div(class = "col-6",
shiny::textInput(ns("time"), "Uhrzeit",
value = format(Sys.time(), "%H:%M"), placeholder = "HH:MM")
)
)
),
section_card(NULL,
shiny::div(class = "py-2",
shiny::selectInput(ns("type"), "Maßnahme *",
choices = c("Maßnahme wählen…" = "", COLONY_ACTION_TYPES)
),
shiny::uiOutput(ns("extra_ui")),
shiny::textAreaInput(ns("notes"), "Notizen", rows = 2, width = "100%")
)
),
shiny::div(class = "d-grid mt-2 mb-5",
shiny::actionButton(ns("save"), "Maßnahme speichern", class = "btn btn-info btn-lg")
)
)
}
screen_actions_server <- function(id, db, nav) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
observeEvent(nav$screen, {
if (nav$screen == "actions") {
shiny::updateDateInput(session, "date", value = Sys.Date())
shiny::updateTextInput(session, "time", value = format(Sys.time(), "%H:%M"))
shiny::updateSelectInput(session, "type", selected = "")
shiny::updateTextAreaInput(session, "notes", value = "")
}
}, ignoreInit = TRUE)
output$extra_ui <- renderUI({
type <- input$type
if (is.null(type) || type == "") return(NULL)
if (type %in% c("ablegerbildung", "zwischenbodenableger")) {
all_cols <- db_colonies_list(db, include_closed = FALSE)
co <- db_colonies_get(db, nav$colony_id)
placeholder <- if (nrow(co) > 0) paste0(co$name[1], " Ableger") else "Name Ableger"
shiny::tagList(
shiny::textInput(ns("new_colony_name"), "Name neuer Ableger *", placeholder = placeholder),
shiny::selectInput(ns("parent_colony"), "Muttervolk",
choices = setNames(all_cols$id, paste0(all_cols$name, " (", all_cols$apiary_name, ")")),
selected = nav$colony_id
)
)
} else if (type == "standwechsel") {
ap <- db_apiaries_list(db)
co <- db_colonies_get(db, nav$colony_id)
shiny::selectInput(ns("new_apiary"), "Neuer Standort",
choices = setNames(ap$id, ap$name),
selected = if (nrow(co) > 0) co$apiary_id[1] else NULL
)
} else if (type == "vereinigung") {
all_cols <- db_colonies_list(db, include_closed = FALSE)
other_cols <- all_cols[all_cols$id != nav$colony_id, ]
shiny::tagList(
shiny::div(
class = "alert alert-info py-2 small mb-2",
shiny::icon("info-circle"), " ",
"Das ", shiny::tags$strong("aktuelle Volk"), " ist das führende (behält die Königin). ",
"Das ausgewählte Volk wird aufgelöst und als eingegangen markiert."
),
shiny::selectInput(ns("absorbed_colony"), "Aufzulösendes Volk *",
choices = c("Volk wählen…" = "",
setNames(other_cols$id,
paste0(other_cols$name, " (", other_cols$apiary_name, ")")))
)
)
} else {
NULL
}
})
observeEvent(input$save, {
req(nav$colony_id, nchar(trimws(input$type %||% "")) > 0)
type <- input$type
if (type %in% c("ablegerbildung", "zwischenbodenableger")) {
req(!is.null(input$new_colony_name), nchar(trimws(input$new_colony_name)) > 0)
parent_id <- if (!is.null(input$parent_colony) && input$parent_colony != "")
as.integer(input$parent_colony) else nav$colony_id
new_id <- db_colonies_insert(db,
name = trimws(input$new_colony_name),
apiary_id = db_colonies_get(db, parent_id)$apiary_id[1],
status = "ableger",
parent_colony_id = parent_id
)
db_actions_insert(db,
colony_id = nav$colony_id,
date = input$date,
time = input$time %||% NA,
type = type,
notes = input$notes,
related_colony_id = new_id
)
nav$colony_id <- new_id
nav$screen <- "colony"
return()
}
if (type == "vereinigung") {
req(!is.null(input$absorbed_colony), input$absorbed_colony != "")
absorbed_id <- as.integer(input$absorbed_colony)
absorbed <- db_colonies_get(db, absorbed_id)
current <- db_colonies_get(db, nav$colony_id)
db_actions_insert(db,
colony_id = nav$colony_id,
date = input$date,
time = input$time %||% NA,
type = "vereinigung",
notes = paste0("Vereinigt mit: ", absorbed$name[1]),
related_colony_id = absorbed_id
)
db_actions_insert(db,
colony_id = absorbed_id,
date = input$date,
time = input$time %||% NA,
type = "vereinigung",
notes = paste0("Aufgegangen in: ", current$name[1]),
related_colony_id = nav$colony_id
)
db_colonies_close(db, absorbed_id)
nav$screen <- "colony"
return()
}
db_actions_insert(db,
colony_id = nav$colony_id,
date = input$date,
time = input$time %||% NA,
type = type,
notes = input$notes
)
if (type == "standwechsel" && !is.null(input$new_apiary)) {
co <- db_colonies_get(db, nav$colony_id)
db_colonies_update(db,
id = nav$colony_id,
name = co$name[1],
apiary_id = as.integer(input$new_apiary),
status = co$status[1],
notes = co$notes[1]
)
}
nav$screen <- "colony"
})
})
}