add homekeeper stack
This commit is contained in:
@@ -0,0 +1,2 @@
|
||||
^.*\.Rproj$
|
||||
^\.Rproj\.user$
|
||||
@@ -0,0 +1,15 @@
|
||||
Package: beekeeper
|
||||
Title: Bienenstockverwaltung
|
||||
Version: 0.3.0
|
||||
Authors@R: person("Nico", "Friess", email = "nico.friess@googlemail.com", role = c("aut", "cre"))
|
||||
Description: Shiny-Anwendung zur Verwaltung von Bienenstöcken, Völkern, Durchsichten und Ernten.
|
||||
License: MIT + file LICENSE
|
||||
Encoding: UTF-8
|
||||
Roxygen: list(markdown = TRUE)
|
||||
RoxygenNote: 7.3.2
|
||||
Imports:
|
||||
bslib,
|
||||
httr2,
|
||||
jsonlite,
|
||||
leaflet,
|
||||
shiny
|
||||
@@ -0,0 +1,16 @@
|
||||
FROM rocker/tidyverse:4.4.2
|
||||
|
||||
RUN apt-get update && apt-get install -y --no-install-recommends \
|
||||
libpq-dev \
|
||||
&& rm -rf /var/lib/apt/lists/*
|
||||
|
||||
# Install deps from DESCRIPTION before copying the rest (layer cache)
|
||||
COPY DESCRIPTION /pkg/DESCRIPTION
|
||||
RUN Rscript -e "remotes::install_deps('/pkg', dependencies = TRUE)"
|
||||
|
||||
COPY . /pkg
|
||||
RUN R CMD INSTALL /pkg
|
||||
|
||||
EXPOSE 3838
|
||||
|
||||
CMD ["Rscript", "-e", "beekeeper::run_app()"]
|
||||
@@ -0,0 +1,3 @@
|
||||
# Generated by roxygen2: do not edit by hand
|
||||
export(run_app)
|
||||
import(shiny)
|
||||
@@ -0,0 +1,15 @@
|
||||
# beekeeper 0.3.0
|
||||
|
||||
- Schnelldurchsicht: alle Völker eines Standes auf einem Screen erfassen (K gesehen, Eier, Brutwaben, Notizen), mit einem Speichern-Klick
|
||||
- Sammelmaßnahme: Maßnahme (Mittelwand, Fütterung, etc.) in einem Schritt für mehrere Völker anlegen
|
||||
|
||||
# beekeeper 0.2.0
|
||||
|
||||
- API-Schicht (FastAPI) zwischen App und Datenbank eingeführt; alle DB-Zugriffe laufen jetzt über httr2
|
||||
- Performance: Letzte Durchsicht wird per Subquery im Kolonien-Endpoint mitgeliefert (kein N+1 mehr)
|
||||
- Spracheingabe (Web Speech API, Deutsch) im Notizfeld der Durchsicht — experimentell, nur Chrome
|
||||
- Logging: JSONL-Logdatei in `./logs/YYYY-MM-DD_log.jsonl` mit Startup-Info, Session-Events und API-Fehlern
|
||||
|
||||
# beekeeper 0.1.0
|
||||
|
||||
- Initiale Version: Imkerei-App mit Völkern, Ständen, Durchsichten, Varroa, Ernte, Königinnen
|
||||
@@ -0,0 +1,88 @@
|
||||
.api_req <- function(api, path) {
|
||||
httr2::request(paste0(api$base_url, path)) |>
|
||||
httr2::req_auth_basic(api$user, api$pass)
|
||||
}
|
||||
|
||||
.api_check <- function(resp, path) {
|
||||
status <- httr2::resp_status(resp)
|
||||
if (status >= 400) {
|
||||
body <- tryCatch(httr2::resp_body_string(resp), error = function(e) "")
|
||||
log_error("api_error", path = path, status = status, body = body)
|
||||
}
|
||||
httr2::resp_check_status(resp)
|
||||
}
|
||||
|
||||
api_get <- function(api, path, query = NULL) {
|
||||
req <- .api_req(api, path)
|
||||
if (!is.null(query) && length(query) > 0) {
|
||||
query <- Filter(Negate(is.null), query)
|
||||
if (length(query) > 0) req <- do.call(httr2::req_url_query, c(list(req), query))
|
||||
}
|
||||
resp <- httr2::req_error(req, is_error = \(r) FALSE) |> httr2::req_perform()
|
||||
if (httr2::resp_status(resp) == 404) return(data.frame())
|
||||
.api_check(resp, path)
|
||||
result <- httr2::resp_body_json(resp, simplifyVector = TRUE)
|
||||
if (is.null(result) || length(result) == 0) return(data.frame())
|
||||
if (is.data.frame(result)) return(result)
|
||||
as.data.frame(result, stringsAsFactors = FALSE)
|
||||
}
|
||||
|
||||
api_get_one <- function(api, path, query = NULL) {
|
||||
req <- .api_req(api, path)
|
||||
if (!is.null(query) && length(query) > 0) {
|
||||
query <- Filter(Negate(is.null), query)
|
||||
if (length(query) > 0) req <- do.call(httr2::req_url_query, c(list(req), query))
|
||||
}
|
||||
resp <- httr2::req_error(req, is_error = \(r) FALSE) |> httr2::req_perform()
|
||||
if (httr2::resp_status(resp) %in% c(404, 204)) return(data.frame())
|
||||
.api_check(resp, path)
|
||||
result <- httr2::resp_body_json(resp, simplifyVector = FALSE)
|
||||
if (is.null(result) || length(result) == 0) return(data.frame())
|
||||
as.data.frame(lapply(result, function(x) if (is.null(x)) NA else x), stringsAsFactors = FALSE)
|
||||
}
|
||||
|
||||
api_post <- function(api, path, body = list()) {
|
||||
log_debug("api_post", path = path)
|
||||
resp <- .api_req(api, path) |>
|
||||
httr2::req_body_json(body) |>
|
||||
httr2::req_error(is_error = \(r) FALSE) |>
|
||||
httr2::req_perform()
|
||||
.api_check(resp, path)
|
||||
if (httr2::resp_content_type(resp) == "" || httr2::resp_status(resp) == 204)
|
||||
return(invisible(NULL))
|
||||
result <- httr2::resp_body_json(resp, simplifyVector = FALSE)
|
||||
if (is.null(result)) return(invisible(NULL))
|
||||
result
|
||||
}
|
||||
|
||||
api_put <- function(api, path, body = list()) {
|
||||
log_debug("api_put", path = path)
|
||||
resp <- .api_req(api, path) |>
|
||||
httr2::req_method("PUT") |>
|
||||
httr2::req_body_json(body) |>
|
||||
httr2::req_error(is_error = \(r) FALSE) |>
|
||||
httr2::req_perform()
|
||||
.api_check(resp, path)
|
||||
invisible(NULL)
|
||||
}
|
||||
|
||||
api_patch <- function(api, path, body = list()) {
|
||||
log_debug("api_patch", path = path)
|
||||
resp <- .api_req(api, path) |>
|
||||
httr2::req_method("PATCH") |>
|
||||
httr2::req_body_json(body) |>
|
||||
httr2::req_error(is_error = \(r) FALSE) |>
|
||||
httr2::req_perform()
|
||||
.api_check(resp, path)
|
||||
invisible(NULL)
|
||||
}
|
||||
|
||||
api_delete <- function(api, path) {
|
||||
log_debug("api_delete", path = path)
|
||||
resp <- .api_req(api, path) |>
|
||||
httr2::req_method("DELETE") |>
|
||||
httr2::req_error(is_error = \(r) FALSE) |>
|
||||
httr2::req_perform()
|
||||
.api_check(resp, path)
|
||||
invisible(NULL)
|
||||
}
|
||||
@@ -0,0 +1,21 @@
|
||||
#' @export
|
||||
run_app <- function(host = "0.0.0.0", port = 3838) {
|
||||
log_init()
|
||||
|
||||
api <- list(
|
||||
base_url = Sys.getenv("API_URL", "http://localhost:8000"),
|
||||
user = Sys.getenv("API_USER", "homestead"),
|
||||
pass = Sys.getenv("API_PASS", "homestead")
|
||||
)
|
||||
|
||||
server_fn <- function(input, output, session) {
|
||||
log_info("session_start", session_id = session$token)
|
||||
session$onSessionEnded(function()
|
||||
log_info("session_end", session_id = session$token)
|
||||
)
|
||||
server(input, output, session, db = api)
|
||||
}
|
||||
|
||||
app <- shiny::shinyApp(ui = ui(), server = server_fn)
|
||||
shiny::runApp(app, host = host, port = port, launch.browser = FALSE)
|
||||
}
|
||||
@@ -0,0 +1,32 @@
|
||||
db_actions_list <- function(db, colony_id) {
|
||||
api_get(db, "/v1/actions", list(colony_id = colony_id))
|
||||
}
|
||||
|
||||
db_actions_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/actions/", id))
|
||||
}
|
||||
|
||||
db_actions_insert <- function(db, colony_id, date, type, notes = NA, time = NA,
|
||||
related_colony_id = NA) {
|
||||
result <- api_post(db, "/v1/actions", list(
|
||||
colony_id = colony_id,
|
||||
date = as.character(date),
|
||||
type = type,
|
||||
notes = notes,
|
||||
time = time,
|
||||
related_colony_id = related_colony_id
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_actions_update <- function(db, id, date, type, notes = NA) {
|
||||
api_put(db, paste0("/v1/actions/", id), list(
|
||||
date = as.character(date),
|
||||
type = type,
|
||||
notes = notes
|
||||
))
|
||||
}
|
||||
|
||||
db_actions_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/actions/", id))
|
||||
}
|
||||
@@ -0,0 +1,32 @@
|
||||
db_apiaries_list <- function(db) {
|
||||
api_get(db, "/v1/apiaries")
|
||||
}
|
||||
|
||||
db_apiaries_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/apiaries/", id))
|
||||
}
|
||||
|
||||
db_apiaries_insert <- function(db, name, location_text = NA, lat = NA, lng = NA, notes = NA) {
|
||||
result <- api_post(db, "/v1/apiaries", list(
|
||||
name = name,
|
||||
location_text = location_text,
|
||||
lat = lat,
|
||||
lng = lng,
|
||||
notes = notes
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_apiaries_update <- function(db, id, name, location_text = NA, lat = NA, lng = NA, notes = NA) {
|
||||
api_put(db, paste0("/v1/apiaries/", id), list(
|
||||
name = name,
|
||||
location_text = location_text,
|
||||
lat = lat,
|
||||
lng = lng,
|
||||
notes = notes
|
||||
))
|
||||
}
|
||||
|
||||
db_apiaries_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/apiaries/", id))
|
||||
}
|
||||
@@ -0,0 +1,48 @@
|
||||
db_checklists_list <- function(db, scope = NULL) {
|
||||
api_get(db, "/v1/checklists")
|
||||
}
|
||||
|
||||
db_checklists_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/checklists/", id))
|
||||
}
|
||||
|
||||
db_checklists_insert <- function(db, name, scope = "colony") {
|
||||
result <- api_post(db, "/v1/checklists", list(name = name, scope = scope))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_checklists_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/checklists/", id))
|
||||
}
|
||||
|
||||
db_checklist_items_list <- function(db, checklist_id) {
|
||||
api_get(db, paste0("/v1/checklists/", checklist_id, "/items"))
|
||||
}
|
||||
|
||||
db_checklist_items_insert <- function(db, checklist_id, text, position = 0L) {
|
||||
result <- api_post(db, paste0("/v1/checklists/", checklist_id, "/items"), list(
|
||||
text = text,
|
||||
position = as.integer(position)
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_checklist_items_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/checklists/items/", id))
|
||||
}
|
||||
|
||||
db_checklist_completions_list <- function(db, checklist_id, scope_id, date = NULL) {
|
||||
api_get(db, paste0("/v1/checklists/", checklist_id, "/completions"),
|
||||
list(scope_id = scope_id))
|
||||
}
|
||||
|
||||
db_checklist_completions_toggle <- function(db, checklist_id, item_id,
|
||||
scope_id, date, completed_by = NA) {
|
||||
result <- api_post(db, paste0("/v1/checklists/", checklist_id, "/completions/toggle"), list(
|
||||
item_id = item_id,
|
||||
scope_id = scope_id,
|
||||
date = as.character(date),
|
||||
completed_by = completed_by
|
||||
))
|
||||
isTRUE(result$toggled)
|
||||
}
|
||||
@@ -0,0 +1,52 @@
|
||||
db_colonies_list <- function(db, apiary_id = NULL, include_closed = FALSE) {
|
||||
api_get(db, "/v1/colonies", list(apiary_id = apiary_id, include_closed = include_closed))
|
||||
}
|
||||
|
||||
db_colonies_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/colonies/", id))
|
||||
}
|
||||
|
||||
db_colonies_insert <- function(db, name, apiary_id, status = "wirtschaftsvolk",
|
||||
parent_colony_id = NA, notes = NA) {
|
||||
result <- api_post(db, "/v1/colonies", list(
|
||||
name = name,
|
||||
apiary_id = apiary_id,
|
||||
status = status,
|
||||
parent_colony_id = parent_colony_id,
|
||||
notes = notes
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_colonies_update <- function(db, id, name, apiary_id, status, notes = NA) {
|
||||
api_put(db, paste0("/v1/colonies/", id), list(
|
||||
name = name,
|
||||
apiary_id = apiary_id,
|
||||
status = status,
|
||||
notes = notes
|
||||
))
|
||||
}
|
||||
|
||||
db_colonies_close <- function(db, id) {
|
||||
api_post(db, paste0("/v1/colonies/", id, "/close"))
|
||||
}
|
||||
|
||||
db_colonies_set_queen <- function(db, colony_id, queen_id) {
|
||||
api_post(db, paste0("/v1/colonies/", colony_id, "/set-queen"), list(queen_id = queen_id))
|
||||
}
|
||||
|
||||
db_colony_log <- function(db, colony_id) {
|
||||
api_get(db, paste0("/v1/colonies/", colony_id, "/log"))
|
||||
}
|
||||
|
||||
db_colonies_lineage <- function(db, colony_id) {
|
||||
api_get(db, paste0("/v1/colonies/", colony_id, "/lineage"))
|
||||
}
|
||||
|
||||
db_colonies_descendants <- function(db, colony_id) {
|
||||
api_get(db, paste0("/v1/colonies/", colony_id, "/descendants"))
|
||||
}
|
||||
|
||||
db_colonies_location_history <- function(db, colony_id) {
|
||||
api_get(db, paste0("/v1/colonies/", colony_id, "/location-history"))
|
||||
}
|
||||
@@ -0,0 +1,37 @@
|
||||
db_harvests_list <- function(db, colony_id = NULL, apiary_id = NULL) {
|
||||
api_get(db, "/v1/harvests", list(colony_id = colony_id, apiary_id = apiary_id))
|
||||
}
|
||||
|
||||
db_harvests_insert <- function(db, date, weight_kg, colony_id = NA,
|
||||
apiary_id = NA, type = NA, notes = NA, time = NA) {
|
||||
result <- api_post(db, "/v1/harvests", list(
|
||||
date = as.character(date),
|
||||
weight_kg = weight_kg,
|
||||
colony_id = colony_id,
|
||||
apiary_id = apiary_id,
|
||||
type = type,
|
||||
notes = notes,
|
||||
time = time
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_harvests_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/harvests/", id))
|
||||
}
|
||||
|
||||
db_harvests_update <- function(db, id, date, weight_kg, notes = NA) {
|
||||
api_put(db, paste0("/v1/harvests/", id), list(
|
||||
date = as.character(date),
|
||||
weight_kg = weight_kg,
|
||||
notes = notes
|
||||
))
|
||||
}
|
||||
|
||||
db_harvests_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/harvests/", id))
|
||||
}
|
||||
|
||||
db_harvests_summary <- function(db) {
|
||||
api_get(db, "/v1/harvests/summary")
|
||||
}
|
||||
@@ -0,0 +1,63 @@
|
||||
db_inspections_list <- function(db, colony_id) {
|
||||
api_get(db, "/v1/inspections", list(colony_id = colony_id))
|
||||
}
|
||||
|
||||
db_inspections_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/inspections/", id))
|
||||
}
|
||||
|
||||
db_inspections_insert <- function(db, colony_id, date, inspector = NA,
|
||||
brood_frames = NA, honey_frames = NA,
|
||||
food_stores_kg = NA, colony_strength = NA,
|
||||
queen_seen = FALSE, eggs_seen = FALSE,
|
||||
queen_cells_count = 0L, notes = NA,
|
||||
traits = list()) {
|
||||
result <- api_post(db, "/v1/inspections", list(
|
||||
colony_id = colony_id,
|
||||
date = as.character(date),
|
||||
inspector = inspector,
|
||||
brood_frames = brood_frames,
|
||||
honey_frames = honey_frames,
|
||||
food_stores_kg = food_stores_kg,
|
||||
colony_strength = colony_strength,
|
||||
queen_seen = as.integer(queen_seen),
|
||||
eggs_seen = as.integer(eggs_seen),
|
||||
queen_cells_count = as.integer(queen_cells_count),
|
||||
notes = notes,
|
||||
traits = traits
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_inspections_traits <- function(db, inspection_id) {
|
||||
api_get(db, paste0("/v1/inspections/", inspection_id, "/traits"))
|
||||
}
|
||||
|
||||
db_inspections_update <- function(db, id, date, inspector = NA,
|
||||
brood_frames = NA, honey_frames = NA,
|
||||
food_stores_kg = NA, colony_strength = NA,
|
||||
queen_seen = FALSE, eggs_seen = FALSE,
|
||||
queen_cells_count = 0L, notes = NA,
|
||||
traits = list()) {
|
||||
api_put(db, paste0("/v1/inspections/", id), list(
|
||||
date = as.character(date),
|
||||
inspector = inspector,
|
||||
brood_frames = brood_frames,
|
||||
honey_frames = honey_frames,
|
||||
food_stores_kg = food_stores_kg,
|
||||
colony_strength = colony_strength,
|
||||
queen_seen = as.integer(queen_seen),
|
||||
eggs_seen = as.integer(eggs_seen),
|
||||
queen_cells_count = as.integer(queen_cells_count),
|
||||
notes = notes,
|
||||
traits = traits
|
||||
))
|
||||
}
|
||||
|
||||
db_inspections_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/inspections/", id))
|
||||
}
|
||||
|
||||
db_inspections_last <- function(db, colony_id) {
|
||||
api_get_one(db, "/v1/inspections/last", list(colony_id = colony_id))
|
||||
}
|
||||
@@ -0,0 +1 @@
|
||||
db_migrate <- function(db) invisible(NULL)
|
||||
@@ -0,0 +1,45 @@
|
||||
db_queens_list <- function(db, colony_id = NULL) {
|
||||
api_get(db, "/v1/queens", list(colony_id = colony_id))
|
||||
}
|
||||
|
||||
db_queens_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/queens/", id))
|
||||
}
|
||||
|
||||
db_queens_insert <- function(db, colony_id, year = NA, breed = NA,
|
||||
origin_colony_id = NA, marked_color = NA,
|
||||
notes = NA, introduced_at = NA) {
|
||||
result <- api_post(db, "/v1/queens", list(
|
||||
colony_id = colony_id,
|
||||
year = year,
|
||||
breed = breed,
|
||||
origin_colony_id = origin_colony_id,
|
||||
marked_color = marked_color,
|
||||
notes = notes,
|
||||
introduced_at = introduced_at
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_queens_update <- function(db, id, colony_id, year = NA, breed = NA,
|
||||
origin_colony_id = NA, marked_color = NA,
|
||||
notes = NA, introduced_at = NA, superseded_at = NA) {
|
||||
api_put(db, paste0("/v1/queens/", id), list(
|
||||
colony_id = colony_id,
|
||||
year = year,
|
||||
breed = breed,
|
||||
origin_colony_id = origin_colony_id,
|
||||
marked_color = marked_color,
|
||||
notes = notes,
|
||||
introduced_at = introduced_at,
|
||||
superseded_at = superseded_at
|
||||
))
|
||||
}
|
||||
|
||||
db_queens_supersede <- function(db, id) {
|
||||
api_post(db, paste0("/v1/queens/", id, "/supersede"))
|
||||
}
|
||||
|
||||
db_queens_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/queens/", id))
|
||||
}
|
||||
@@ -0,0 +1,103 @@
|
||||
db_varroa_counts_list <- function(db, colony_id) {
|
||||
api_get(db, "/v1/varroa/counts", list(colony_id = colony_id))
|
||||
}
|
||||
|
||||
db_varroa_counts_insert <- function(db, colony_id, date_from = NA, date, method, count,
|
||||
notes = NA, time = NA) {
|
||||
result <- api_post(db, "/v1/varroa/counts", list(
|
||||
colony_id = colony_id,
|
||||
date_from = date_from,
|
||||
date = as.character(date),
|
||||
method = method,
|
||||
count = count,
|
||||
notes = notes,
|
||||
time = time
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_varroa_counts_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/varroa/counts/", id))
|
||||
}
|
||||
|
||||
db_varroa_counts_update <- function(db, id, date_from = NA, date, method, count, notes = NA) {
|
||||
api_put(db, paste0("/v1/varroa/counts/", id), list(
|
||||
date_from = date_from,
|
||||
date = as.character(date),
|
||||
method = method,
|
||||
count = count,
|
||||
notes = notes
|
||||
))
|
||||
}
|
||||
|
||||
db_varroa_counts_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/varroa/counts/", id))
|
||||
}
|
||||
|
||||
db_varroa_treatments_list <- function(db, colony_id) {
|
||||
api_get(db, "/v1/varroa/treatments", list(colony_id = colony_id))
|
||||
}
|
||||
|
||||
db_varroa_treatments_insert <- function(db, colony_id, date, product,
|
||||
method = NA, dosage = NA, notes = NA, time = NA) {
|
||||
result <- api_post(db, "/v1/varroa/treatments", list(
|
||||
colony_id = colony_id,
|
||||
date = as.character(date),
|
||||
product = product,
|
||||
method = method,
|
||||
dosage = dosage,
|
||||
notes = notes,
|
||||
time = time
|
||||
))
|
||||
result$id
|
||||
}
|
||||
|
||||
db_varroa_treatments_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/varroa/treatments/", id))
|
||||
}
|
||||
|
||||
db_varroa_treatments_update <- function(db, id, date, product, method = NA, dosage = NA, notes = NA) {
|
||||
api_put(db, paste0("/v1/varroa/treatments/", id), list(
|
||||
date = as.character(date),
|
||||
product = product,
|
||||
method = method,
|
||||
dosage = dosage,
|
||||
notes = notes
|
||||
))
|
||||
}
|
||||
|
||||
db_varroa_treatments_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/varroa/treatments/", id))
|
||||
}
|
||||
|
||||
db_varroa_controls_list <- function(db, colony_id = NULL, treatment_id = NULL) {
|
||||
api_get(db, "/v1/varroa/controls", list(colony_id = colony_id, treatment_id = treatment_id))
|
||||
}
|
||||
|
||||
db_varroa_controls_insert <- function(db, treatment_id, colony_id, date,
|
||||
result = NA, notes = NA) {
|
||||
res <- api_post(db, "/v1/varroa/controls", list(
|
||||
treatment_id = treatment_id,
|
||||
colony_id = colony_id,
|
||||
date = as.character(date),
|
||||
result = result,
|
||||
notes = notes
|
||||
))
|
||||
res$id
|
||||
}
|
||||
|
||||
db_varroa_controls_get <- function(db, id) {
|
||||
api_get_one(db, paste0("/v1/varroa/controls/", id))
|
||||
}
|
||||
|
||||
db_varroa_controls_update <- function(db, id, date, result = NA, notes = NA) {
|
||||
api_put(db, paste0("/v1/varroa/controls/", id), list(
|
||||
date = as.character(date),
|
||||
result = result,
|
||||
notes = notes
|
||||
))
|
||||
}
|
||||
|
||||
db_varroa_controls_delete <- function(db, id) {
|
||||
api_delete(db, paste0("/v1/varroa/controls/", id))
|
||||
}
|
||||
@@ -0,0 +1,41 @@
|
||||
.log_env <- new.env(parent = emptyenv())
|
||||
.log_env$file <- NULL
|
||||
|
||||
log_init <- function() {
|
||||
log_dir <- Sys.getenv("LOG_DIR", "/logs")
|
||||
if (!dir.exists(log_dir))
|
||||
dir.create(log_dir, recursive = TRUE, showWarnings = FALSE)
|
||||
fname <- paste0(format(Sys.Date(), "%Y-%m-%d"), "_log.jsonl")
|
||||
.log_env$file <- file.path(log_dir, fname)
|
||||
|
||||
v <- tryCatch(
|
||||
as.character(utils::packageVersion("beekeeper")),
|
||||
error = function(e) "unknown"
|
||||
)
|
||||
.log_write("INFO", "startup",
|
||||
version = v,
|
||||
r_version = paste(R.version$major, R.version$minor, sep = "."),
|
||||
platform = R.version$platform,
|
||||
api_url = Sys.getenv("API_URL", "http://localhost:8000")
|
||||
)
|
||||
}
|
||||
|
||||
.log_write <- function(level, msg, ...) {
|
||||
if (is.null(.log_env$file)) return(invisible(NULL))
|
||||
extra <- list(...)
|
||||
entry <- c(
|
||||
list(
|
||||
ts = format(Sys.time(), "%Y-%m-%dT%H:%M:%OS3"),
|
||||
level = level,
|
||||
msg = msg
|
||||
),
|
||||
extra
|
||||
)
|
||||
line <- jsonlite::toJSON(entry, auto_unbox = TRUE)
|
||||
cat(line, "\n", file = .log_env$file, append = TRUE, sep = "")
|
||||
invisible(NULL)
|
||||
}
|
||||
|
||||
log_info <- function(msg, ...) .log_write("INFO", msg, ...)
|
||||
log_debug <- function(msg, ...) .log_write("DEBUG", msg, ...)
|
||||
log_error <- function(msg, ...) .log_write("ERROR", msg, ...)
|
||||
@@ -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"
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,209 @@
|
||||
screen_apiaries_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
shiny::tagList(
|
||||
shiny::div(class = "mb-3", style = "border-radius:8px;overflow:hidden;box-shadow:0 1px 4px rgba(0,0,0,.15)",
|
||||
leaflet::leafletOutput(ns("overview_map"), height = "200px", width = "100%")
|
||||
),
|
||||
shiny::uiOutput(ns("cards")),
|
||||
shiny::br(),
|
||||
shiny::actionButton(ns("add_btn"), shiny::tagList(shiny::icon("plus"), " Neuer Stand"),
|
||||
class = "add-dashed btn", style = "width:100%;min-height:80px"
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_apiaries_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
reload <- reactiveVal(0)
|
||||
edit_id <- reactiveVal(NULL)
|
||||
add_coords <- reactiveValues(lat = NA_real_, lng = NA_real_)
|
||||
edit_coords <- reactiveValues(lat = NA_real_, lng = NA_real_)
|
||||
|
||||
apiaries <- reactive({ reload(); db_apiaries_list(db) })
|
||||
|
||||
output$cards <- renderUI({
|
||||
ap <- apiaries()
|
||||
if (nrow(ap) == 0) return(shiny::p(class = "text-muted", "Noch keine Bienenstände angelegt."))
|
||||
lapply(seq_len(nrow(ap)), function(i) {
|
||||
row <- ap[i, ]
|
||||
shiny::div(
|
||||
class = "card tap-card mb-3",
|
||||
onclick = sprintf("Shiny.setInputValue('%s', %d, {priority:'event'})",
|
||||
ns("select"), row$id),
|
||||
bslib::card_body(
|
||||
class = "d-flex justify-content-between align-items-start",
|
||||
shiny::div(
|
||||
shiny::tags$strong(class = "fs-5", row$name),
|
||||
shiny::tags$p(class = "text-muted mb-0 small",
|
||||
if (!is.na(row$location_text) && nchar(row$location_text) > 0) row$location_text
|
||||
)
|
||||
),
|
||||
shiny::div(
|
||||
class = "d-flex flex-column align-items-end gap-1",
|
||||
shiny::tags$span(class = "badge bg-secondary",
|
||||
paste(row$colony_count, "Völker")),
|
||||
shiny::div(
|
||||
shiny::actionButton(ns(paste0("edit_", row$id)), shiny::icon("pencil"),
|
||||
class = "btn btn-sm btn-link p-0 text-muted",
|
||||
onclick = "event.stopPropagation()"
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
})
|
||||
})
|
||||
|
||||
observeEvent(input$select, {
|
||||
nav$apiary_id <- input$select
|
||||
nav$screen <- "colonies"
|
||||
})
|
||||
|
||||
# ---- Overview map -------------------------------------------------------
|
||||
output$overview_map <- leaflet::renderLeaflet({
|
||||
ap <- apiaries()
|
||||
m <- leaflet::leaflet(options = leaflet::leafletOptions(zoomControl = FALSE, attributionControl = FALSE)) |>
|
||||
leaflet::addTiles(group = "Karte") |>
|
||||
leaflet::addProviderTiles("Esri.WorldImagery", group = "Satellit") |>
|
||||
leaflet::addLayersControl(baseGroups = c("Karte", "Satellit"),
|
||||
options = leaflet::layersControlOptions(collapsed = TRUE))
|
||||
with_coords <- ap[!is.na(ap$lat) & !is.na(ap$lng), ]
|
||||
if (nrow(with_coords) > 0) {
|
||||
m <- leaflet::addMarkers(m,
|
||||
lng = with_coords$lng, lat = with_coords$lat,
|
||||
label = with_coords$name, layerId = as.character(with_coords$id),
|
||||
clusterOptions = leaflet::markerClusterOptions()
|
||||
)
|
||||
} else {
|
||||
m <- leaflet::setView(m, lng = 10.45, lat = 51.17, zoom = 6)
|
||||
}
|
||||
m
|
||||
})
|
||||
observeEvent(input$overview_map_marker_click, {
|
||||
click <- input$overview_map_marker_click
|
||||
if (!is.null(click$id)) {
|
||||
nav$apiary_id <- as.integer(click$id)
|
||||
nav$screen <- "colonies"
|
||||
}
|
||||
})
|
||||
|
||||
# ---- Add modal -----------------------------------------------------------
|
||||
output$add_map <- leaflet::renderLeaflet({
|
||||
leaflet::leaflet() |>
|
||||
leaflet::addTiles(group = "Karte") |>
|
||||
leaflet::addProviderTiles("Esri.WorldImagery", group = "Satellit") |>
|
||||
leaflet::addLayersControl(baseGroups = c("Karte", "Satellit"),
|
||||
options = leaflet::layersControlOptions(collapsed = TRUE)) |>
|
||||
leaflet::setView(lng = 10.45, lat = 51.17, zoom = 6)
|
||||
})
|
||||
observeEvent(input$add_map_click, {
|
||||
cl <- input$add_map_click
|
||||
add_coords$lat <- cl$lat; add_coords$lng <- cl$lng
|
||||
p <- leaflet::leafletProxy("add_map", session)
|
||||
leaflet::clearMarkers(p)
|
||||
leaflet::addMarkers(p, lng = cl$lng, lat = cl$lat)
|
||||
})
|
||||
|
||||
observeEvent(input$add_btn, {
|
||||
add_coords$lat <- NA_real_; add_coords$lng <- NA_real_
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = "Neuer Bienenstand", size = "l",
|
||||
footer = shiny::tagList(
|
||||
shiny::modalButton("Abbrechen"),
|
||||
shiny::actionButton(ns("confirm_add"), "Anlegen", class = "btn-primary")
|
||||
),
|
||||
shiny::textInput(ns("new_name"), "Name *"),
|
||||
shiny::textInput(ns("new_loc"), "Standortbeschreibung"),
|
||||
shiny::tags$p(class = "text-muted small mt-3 mb-1",
|
||||
shiny::tags$em("Standort auf Karte setzen (optional):")),
|
||||
leaflet::leafletOutput(ns("add_map"), height = "280px"),
|
||||
shiny::uiOutput(ns("add_coords_lbl")),
|
||||
shiny::textAreaInput(ns("new_notes"), "Notizen", rows = 2)
|
||||
))
|
||||
})
|
||||
output$add_coords_lbl <- renderUI({
|
||||
req(!is.na(add_coords$lat))
|
||||
shiny::tags$p(class = "text-muted small mt-1",
|
||||
sprintf("%.5f, %.5f", add_coords$lat, add_coords$lng))
|
||||
})
|
||||
observeEvent(input$confirm_add, {
|
||||
req(nchar(trimws(input$new_name)) > 0)
|
||||
db_apiaries_insert(db,
|
||||
name = trimws(input$new_name), location_text = input$new_loc,
|
||||
lat = add_coords$lat, lng = add_coords$lng, notes = input$new_notes
|
||||
)
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
|
||||
# ---- Edit modal ----------------------------------------------------------
|
||||
output$edit_map <- leaflet::renderLeaflet({
|
||||
lat <- if (!is.na(edit_coords$lat)) edit_coords$lat else 51.17
|
||||
lng <- if (!is.na(edit_coords$lng)) edit_coords$lng else 10.45
|
||||
zoom <- if (!is.na(edit_coords$lat)) 13L else 6L
|
||||
m <- leaflet::leaflet() |>
|
||||
leaflet::addTiles(group = "Karte") |>
|
||||
leaflet::addProviderTiles("Esri.WorldImagery", group = "Satellit") |>
|
||||
leaflet::addLayersControl(baseGroups = c("Karte", "Satellit"),
|
||||
options = leaflet::layersControlOptions(collapsed = TRUE)) |>
|
||||
leaflet::setView(lng = lng, lat = lat, zoom = zoom)
|
||||
if (!is.na(edit_coords$lat)) m <- leaflet::addMarkers(m, lng = lng, lat = lat)
|
||||
m
|
||||
})
|
||||
observeEvent(input$edit_map_click, {
|
||||
cl <- input$edit_map_click
|
||||
edit_coords$lat <- cl$lat; edit_coords$lng <- cl$lng
|
||||
p <- leaflet::leafletProxy("edit_map", session)
|
||||
leaflet::clearMarkers(p)
|
||||
leaflet::addMarkers(p, lng = cl$lng, lat = cl$lat)
|
||||
})
|
||||
|
||||
observe({
|
||||
ap <- apiaries()
|
||||
lapply(ap$id, function(aid) {
|
||||
local({
|
||||
lid <- aid
|
||||
observeEvent(input[[paste0("edit_", lid)]], {
|
||||
row <- db_apiaries_get(db, lid)
|
||||
edit_id(lid)
|
||||
edit_coords$lat <- row$lat %||% NA_real_
|
||||
edit_coords$lng <- row$lng %||% NA_real_
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = "Stand bearbeiten", size = "l",
|
||||
footer = shiny::tagList(
|
||||
shiny::modalButton("Abbrechen"),
|
||||
shiny::actionButton(ns("confirm_edit"), "Speichern", class = "btn-primary"),
|
||||
shiny::actionButton(ns("confirm_delete"), "Löschen", class = "btn-danger ms-auto")
|
||||
),
|
||||
shiny::textInput(ns("edit_name"), "Name *", value = row$name),
|
||||
shiny::textInput(ns("edit_loc"), "Standortbeschreibung", value = row$location_text %||% ""),
|
||||
shiny::tags$p(class = "text-muted small mt-3 mb-1",
|
||||
shiny::tags$em("Standort auf Karte setzen:")),
|
||||
leaflet::leafletOutput(ns("edit_map"), height = "280px"),
|
||||
shiny::uiOutput(ns("edit_coords_lbl")),
|
||||
shiny::textAreaInput(ns("edit_notes"), "Notizen", rows = 2, value = row$notes %||% "")
|
||||
))
|
||||
}, ignoreInit = TRUE)
|
||||
})
|
||||
})
|
||||
})
|
||||
output$edit_coords_lbl <- renderUI({
|
||||
req(!is.na(edit_coords$lat))
|
||||
shiny::tags$p(class = "text-muted small mt-1",
|
||||
sprintf("%.5f, %.5f", edit_coords$lat, edit_coords$lng))
|
||||
})
|
||||
observeEvent(input$confirm_edit, {
|
||||
req(edit_id())
|
||||
db_apiaries_update(db, id = edit_id(),
|
||||
name = trimws(input$edit_name), location_text = input$edit_loc,
|
||||
lat = edit_coords$lat, lng = edit_coords$lng, notes = input$edit_notes
|
||||
)
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
observeEvent(input$confirm_delete, {
|
||||
req(edit_id())
|
||||
db_apiaries_delete(db, edit_id())
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,109 @@
|
||||
ACTION_TYPES <- c(
|
||||
"Mittelwand geben" = "mittelwand",
|
||||
"Fütterung" = "futterung",
|
||||
"Ablegerbildung" = "ablegerbildung",
|
||||
"Brutentnahme" = "brutentnahme",
|
||||
"Standwechsel" = "standwechsel",
|
||||
"Völkervereinigung" = "vereinigung",
|
||||
"Zwischenbödenableger" = "zwischenbodenableger",
|
||||
"Sonstiges" = "sonstig"
|
||||
)
|
||||
|
||||
screen_bulk_action_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
shiny::tagList(
|
||||
section_card(NULL,
|
||||
shiny::div(class = "py-2",
|
||||
shiny::dateInput(ns("date"), "Datum", value = Sys.Date(), language = "de", weekstart = 1),
|
||||
shiny::selectInput(ns("type"), "Maßnahme", choices = ACTION_TYPES),
|
||||
shiny::textAreaInput(ns("notes"), "Notizen", rows = 2, width = "100%")
|
||||
)
|
||||
),
|
||||
section_card("Völker",
|
||||
shiny::div(class = "d-flex gap-2 py-2 border-bottom",
|
||||
shiny::tags$button(
|
||||
type = "button", class = "btn btn-outline-secondary btn-sm",
|
||||
onclick = sprintf("Shiny.setInputValue('%s', Date.now(), {priority:'event'})", ns("sel_all")),
|
||||
"Alle"
|
||||
),
|
||||
shiny::tags$button(
|
||||
type = "button", class = "btn btn-outline-secondary btn-sm",
|
||||
onclick = sprintf("Shiny.setInputValue('%s', Date.now(), {priority:'event'})", ns("sel_none")),
|
||||
"Keine"
|
||||
)
|
||||
),
|
||||
shiny::uiOutput(ns("colony_checkboxes"))
|
||||
),
|
||||
shiny::div(class = "d-grid mt-2 mb-5",
|
||||
shiny::actionButton(ns("save"), "Speichern", class = "btn btn-primary btn-lg")
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_bulk_action_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
colonies <- reactive({
|
||||
req(nav$apiary_id, nav$screen == "bulk_action")
|
||||
db_colonies_list(db, apiary_id = nav$apiary_id, include_closed = FALSE)
|
||||
})
|
||||
|
||||
colony_choices <- reactive({
|
||||
cols <- colonies()
|
||||
if (nrow(cols) == 0) return(character(0))
|
||||
setNames(as.character(cols$id), cols$name)
|
||||
})
|
||||
|
||||
output$colony_checkboxes <- renderUI({
|
||||
ch <- colony_choices()
|
||||
if (length(ch) == 0)
|
||||
return(shiny::p(class = "text-muted py-2", "Keine aktiven Völker."))
|
||||
shiny::checkboxGroupInput(ns("selected"), NULL,
|
||||
choices = ch, selected = ch)
|
||||
})
|
||||
|
||||
observeEvent(input$sel_all, {
|
||||
shiny::updateCheckboxGroupInput(session, "selected",
|
||||
selected = colony_choices())
|
||||
}, ignoreNULL = TRUE, ignoreInit = TRUE)
|
||||
|
||||
observeEvent(input$sel_none, {
|
||||
shiny::updateCheckboxGroupInput(session, "selected", selected = character(0))
|
||||
}, ignoreNULL = TRUE, ignoreInit = TRUE)
|
||||
|
||||
observeEvent(input$save, {
|
||||
selected <- input$selected
|
||||
if (is.null(selected) || length(selected) == 0) {
|
||||
shiny::showNotification("Kein Volk ausgewählt.", type = "warning", duration = 3)
|
||||
return()
|
||||
}
|
||||
|
||||
notes <- trimws(input$notes %||% "")
|
||||
n_saved <- 0L
|
||||
|
||||
for (cid_str in selected) {
|
||||
cid <- as.integer(cid_str)
|
||||
tryCatch({
|
||||
db_actions_insert(db,
|
||||
colony_id = cid,
|
||||
date = input$date,
|
||||
type = input$type,
|
||||
notes = if (nchar(notes) > 0) notes else NA_character_
|
||||
)
|
||||
n_saved <- n_saved + 1L
|
||||
log_debug("bulk_action_saved", colony_id = cid, type = input$type)
|
||||
}, error = function(e) {
|
||||
log_error("bulk_action_error", colony_id = cid, msg = conditionMessage(e))
|
||||
})
|
||||
}
|
||||
|
||||
if (n_saved > 0)
|
||||
shiny::showNotification(
|
||||
sprintf("Maßnahme für %d Volk/Völker gespeichert.", n_saved),
|
||||
type = "message", duration = 3
|
||||
)
|
||||
nav$screen <- "colonies"
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,180 @@
|
||||
screen_checklists_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
bslib::navset_card_tab(
|
||||
bslib::nav_panel("Ausführen",
|
||||
shiny::div(class = "p-2",
|
||||
shiny::uiOutput(ns("checklist_sel")),
|
||||
shiny::uiOutput(ns("run_items"))
|
||||
)
|
||||
),
|
||||
bslib::nav_panel("Verwalten",
|
||||
shiny::div(class = "p-2",
|
||||
shiny::div(class = "d-flex gap-2 mb-3",
|
||||
shiny::textInput(ns("new_name"), NULL, placeholder = "Neue Checkliste..."),
|
||||
shiny::selectInput(ns("new_scope"), NULL,
|
||||
choices = c("Volk" = "colony", "Stand" = "apiary"), width = "120px"),
|
||||
shiny::actionButton(ns("add_list"), shiny::icon("plus"), class = "btn btn-primary")
|
||||
),
|
||||
shiny::uiOutput(ns("manage_list"))
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_checklists_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
reload <- reactiveVal(0)
|
||||
sel_list <- reactiveVal(NULL)
|
||||
|
||||
checklists <- reactive({ reload(); db_checklists_list(db) })
|
||||
|
||||
output$checklist_sel <- renderUI({
|
||||
cls <- checklists()
|
||||
if (nrow(cls) == 0)
|
||||
return(shiny::p(class = "text-muted", "Noch keine Checklisten. Im Tab 'Verwalten' anlegen."))
|
||||
shiny::selectInput(ns("run_list"), "Checkliste",
|
||||
choices = c("Bitte wählen" = "", setNames(cls$id,
|
||||
paste0("[", cls$scope, "] ", cls$name)))
|
||||
)
|
||||
})
|
||||
|
||||
output$run_items <- renderUI({
|
||||
req(input$run_list, input$run_list != "", nav$colony_id)
|
||||
lid <- as.integer(input$run_list)
|
||||
scope_id <- nav$colony_id
|
||||
date <- as.character(Sys.Date())
|
||||
items <- db_checklist_items_list(db, lid)
|
||||
if (nrow(items) == 0) return(shiny::p(class = "text-muted", "Keine Einträge."))
|
||||
done <- db_checklist_completions_list(db, lid, scope_id, date)
|
||||
|
||||
shiny::div(class = "list-group",
|
||||
lapply(seq_len(nrow(items)), function(i) {
|
||||
item <- items[i, ]
|
||||
completed <- item$id %in% done$item_id
|
||||
shiny::div(
|
||||
class = paste("list-group-item d-flex align-items-center gap-3 py-3",
|
||||
if (completed) "list-group-item-success" else ""),
|
||||
shiny::tags$input(
|
||||
class = "form-check-input flex-shrink-0",
|
||||
type = "checkbox",
|
||||
checked = if (completed) NA else NULL,
|
||||
style = "width:1.3em;height:1.3em;cursor:pointer",
|
||||
onclick = sprintf(
|
||||
"Shiny.setInputValue('%s',{id:%d}, {priority:'event'})",
|
||||
ns("toggle"), item$id
|
||||
)
|
||||
),
|
||||
shiny::span(item$text,
|
||||
style = if (completed) "text-decoration:line-through;opacity:.6" else "")
|
||||
)
|
||||
})
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(input$toggle, {
|
||||
req(input$run_list, nav$colony_id)
|
||||
db_checklist_completions_toggle(db,
|
||||
checklist_id = as.integer(input$run_list),
|
||||
item_id = as.integer(input$toggle$id),
|
||||
scope_id = nav$colony_id,
|
||||
date = as.character(Sys.Date())
|
||||
)
|
||||
})
|
||||
|
||||
# ---- Manage tab ---------------------------------------------------------
|
||||
output$manage_list <- renderUI({
|
||||
cls <- checklists()
|
||||
if (nrow(cls) == 0) return(shiny::p(class = "text-muted", "Keine Checklisten."))
|
||||
lapply(seq_len(nrow(cls)), function(i) {
|
||||
row <- cls[i, ]
|
||||
shiny::div(class = "card mb-2",
|
||||
bslib::card_body(
|
||||
class = "py-2",
|
||||
shiny::div(class = "d-flex justify-content-between align-items-center",
|
||||
shiny::div(
|
||||
shiny::tags$strong(row$name),
|
||||
shiny::tags$small(class = "text-muted ms-2", paste0("[", row$scope, "]"))
|
||||
),
|
||||
shiny::div(
|
||||
shiny::actionButton(ns(paste0("sel_", row$id)), "Einträge",
|
||||
class = "btn btn-sm btn-outline-secondary me-1"),
|
||||
shiny::actionButton(ns(paste0("del_list_", row$id)), shiny::icon("trash"),
|
||||
class = "btn btn-sm btn-outline-danger")
|
||||
)
|
||||
),
|
||||
shiny::uiOutput(ns(paste0("items_", row$id)))
|
||||
)
|
||||
)
|
||||
})
|
||||
})
|
||||
|
||||
observe({
|
||||
cls <- checklists()
|
||||
lapply(cls$id, function(lid) {
|
||||
local({
|
||||
llid <- lid
|
||||
observeEvent(input[[paste0("sel_", llid)]], sel_list(llid), ignoreInit = TRUE)
|
||||
observeEvent(input[[paste0("del_list_", llid)]], {
|
||||
db_checklists_delete(db, llid)
|
||||
if (identical(sel_list(), llid)) sel_list(NULL)
|
||||
reload(reload() + 1L)
|
||||
}, ignoreInit = TRUE)
|
||||
})
|
||||
})
|
||||
})
|
||||
|
||||
observe({
|
||||
lid <- sel_list()
|
||||
req(lid)
|
||||
items <- db_checklist_items_list(db, lid)
|
||||
output[[paste0("items_", lid)]] <- renderUI({
|
||||
shiny::div(class = "mt-2",
|
||||
if (nrow(items) > 0)
|
||||
shiny::tags$ul(class = "list-unstyled mb-2",
|
||||
lapply(seq_len(nrow(items)), function(i) {
|
||||
it <- items[i, ]
|
||||
shiny::tags$li(class = "d-flex justify-content-between align-items-center small py-1 border-bottom",
|
||||
it$text,
|
||||
shiny::actionButton(ns(paste0("del_item_", it$id)), "×",
|
||||
class = "btn btn-sm btn-link text-danger p-0",
|
||||
onclick = "event.stopPropagation()"
|
||||
)
|
||||
)
|
||||
})
|
||||
),
|
||||
shiny::div(class = "d-flex gap-2",
|
||||
shiny::textInput(ns(paste0("item_txt_", lid)), NULL, placeholder = "Neuer Eintrag..."),
|
||||
shiny::actionButton(ns(paste0("add_item_", lid)), shiny::icon("plus"),
|
||||
class = "btn btn-outline-primary")
|
||||
)
|
||||
)
|
||||
})
|
||||
lapply(items$id, function(iid) {
|
||||
local({
|
||||
liid <- iid
|
||||
observeEvent(input[[paste0("del_item_", liid)]], {
|
||||
db_checklist_items_delete(db, liid)
|
||||
reload(reload() + 1L)
|
||||
}, ignoreInit = TRUE)
|
||||
})
|
||||
})
|
||||
observeEvent(input[[paste0("add_item_", lid)]], {
|
||||
txt <- input[[paste0("item_txt_", lid)]]
|
||||
req(nchar(trimws(txt)) > 0)
|
||||
its <- db_checklist_items_list(db, lid)
|
||||
pos <- if (nrow(its) > 0) max(its$position) + 1L else 1L
|
||||
db_checklist_items_insert(db, lid, trimws(txt), pos)
|
||||
shiny::updateTextInput(session, paste0("item_txt_", lid), value = "")
|
||||
reload(reload() + 1L)
|
||||
}, ignoreInit = TRUE)
|
||||
})
|
||||
|
||||
observeEvent(input$add_list, {
|
||||
req(nchar(trimws(input$new_name)) > 0)
|
||||
db_checklists_insert(db, trimws(input$new_name), input$new_scope)
|
||||
shiny::updateTextInput(session, "new_name", value = "")
|
||||
reload(reload() + 1L)
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,145 @@
|
||||
screen_colonies_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
shiny::tagList(
|
||||
shiny::uiOutput(ns("status_filters")),
|
||||
shiny::uiOutput(ns("cards")),
|
||||
shiny::br(),
|
||||
shiny::div(class = "d-flex gap-2 mb-2",
|
||||
shiny::actionButton(ns("quick_insp_btn"),
|
||||
shiny::tagList(shiny::icon("bolt"), " Schnelldurchsicht"),
|
||||
class = "btn btn-outline-primary w-100"
|
||||
),
|
||||
shiny::actionButton(ns("bulk_action_btn"),
|
||||
shiny::tagList(shiny::icon("layer-group"), " Sammelmaßnahme"),
|
||||
class = "btn btn-outline-secondary w-100"
|
||||
)
|
||||
),
|
||||
shiny::div(class = "d-flex gap-2 mb-2",
|
||||
shiny::actionButton(ns("lineage_btn"),
|
||||
shiny::tagList(shiny::icon("sitemap"), " Stammbaum"),
|
||||
class = "btn btn-outline-secondary w-100"
|
||||
)
|
||||
),
|
||||
shiny::actionButton(ns("add_btn"), shiny::tagList(shiny::icon("plus"), " Neues Volk"),
|
||||
class = "add-dashed btn", style = "width:100%;min-height:80px"
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_colonies_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
reload <- reactiveVal(0)
|
||||
status_filter <- reactiveVal("")
|
||||
|
||||
colonies <- reactive({
|
||||
req(nav$apiary_id)
|
||||
reload()
|
||||
db_colonies_list(db, apiary_id = nav$apiary_id, include_closed = FALSE)
|
||||
})
|
||||
|
||||
output$status_filters <- renderUI({
|
||||
statuses <- c("Alle" = "", COLONY_STATUSES[names(COLONY_STATUSES) != "Eingegangen"])
|
||||
shiny::div(class = "d-flex gap-2 mb-3 flex-wrap",
|
||||
lapply(seq_along(statuses), function(i) {
|
||||
val <- statuses[[i]]
|
||||
active <- identical(status_filter(), val)
|
||||
shiny::actionButton(
|
||||
ns(paste0("sf_", i)), names(statuses)[i],
|
||||
class = if (active) "btn btn-primary btn-sm" else "btn btn-outline-secondary btn-sm"
|
||||
)
|
||||
})
|
||||
)
|
||||
})
|
||||
|
||||
observe({
|
||||
statuses <- c("Alle" = "", COLONY_STATUSES[names(COLONY_STATUSES) != "Eingegangen"])
|
||||
lapply(seq_along(statuses), function(i) {
|
||||
local({
|
||||
li <- i; val <- statuses[[i]]
|
||||
observeEvent(input[[paste0("sf_", li)]], status_filter(val), ignoreInit = TRUE)
|
||||
})
|
||||
})
|
||||
})
|
||||
|
||||
filtered <- reactive({
|
||||
cols <- colonies()
|
||||
sf <- status_filter()
|
||||
if (!is.null(sf) && sf != "") cols[cols$status == sf, ] else cols
|
||||
})
|
||||
|
||||
output$cards <- renderUI({
|
||||
cols <- filtered()
|
||||
if (nrow(cols) == 0) return(shiny::p(class = "text-muted", "Keine Völker gefunden."))
|
||||
lapply(seq_len(nrow(cols)), function(i) {
|
||||
row <- cols[i, ]
|
||||
days_ago <- if (!is.na(row$last_inspection_date)) {
|
||||
d <- as.integer(Sys.Date() - as.Date(row$last_inspection_date))
|
||||
if (d == 0) "heute" else if (d == 1) "gestern" else paste0("vor ", d, " Tagen")
|
||||
} else "keine Durchsicht"
|
||||
|
||||
shiny::div(
|
||||
class = "card tap-card mb-2",
|
||||
onclick = sprintf("Shiny.setInputValue('%s', %d, {priority:'event'})",
|
||||
ns("select"), row$id),
|
||||
bslib::card_body(
|
||||
class = "d-flex justify-content-between align-items-center py-2",
|
||||
shiny::div(
|
||||
shiny::tags$strong(row$name),
|
||||
shiny::tags$p(class = "text-muted small mb-0", days_ago)
|
||||
),
|
||||
shiny::HTML(colony_status_badge(row$status))
|
||||
)
|
||||
)
|
||||
})
|
||||
})
|
||||
|
||||
observeEvent(input$select, {
|
||||
nav$colony_id <- input$select
|
||||
nav$screen <- "colony"
|
||||
})
|
||||
|
||||
observeEvent(input$quick_insp_btn, { nav$screen <- "quick_inspection" })
|
||||
observeEvent(input$bulk_action_btn, { nav$screen <- "bulk_action" })
|
||||
observeEvent(input$lineage_btn, { nav$screen <- "lineage" })
|
||||
|
||||
# ---- Add colony modal ---------------------------------------------------
|
||||
observeEvent(input$add_btn, {
|
||||
cols <- db_colonies_list(db, include_closed = FALSE)
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = "Neues Volk",
|
||||
footer = shiny::tagList(
|
||||
shiny::modalButton("Abbrechen"),
|
||||
shiny::actionButton(ns("confirm_add"), "Anlegen", class = "btn-primary")
|
||||
),
|
||||
shiny::textInput(ns("new_name"), "Name *"),
|
||||
shiny::selectInput(ns("new_status"), "Status",
|
||||
choices = COLONY_STATUSES[names(COLONY_STATUSES) != "Eingegangen"],
|
||||
selected = "wirtschaftsvolk"
|
||||
),
|
||||
shiny::selectInput(ns("new_parent"), "Muttervolk (optional)",
|
||||
choices = c("–" = "", setNames(cols$id, cols$name))
|
||||
),
|
||||
shiny::textAreaInput(ns("new_notes"), "Notizen", rows = 2)
|
||||
))
|
||||
})
|
||||
|
||||
observeEvent(input$confirm_add, {
|
||||
if (nchar(trimws(input$new_name)) == 0) {
|
||||
shiny::showNotification("Bitte einen Namen eingeben.", type = "warning", duration = 3)
|
||||
return()
|
||||
}
|
||||
req(nav$apiary_id)
|
||||
parent <- if (!is.null(input$new_parent) && input$new_parent != "")
|
||||
as.integer(input$new_parent) else NA
|
||||
db_colonies_insert(db,
|
||||
name = trimws(input$new_name),
|
||||
apiary_id = as.integer(nav$apiary_id),
|
||||
status = input$new_status,
|
||||
parent_colony_id = parent,
|
||||
notes = input$new_notes
|
||||
)
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,490 @@
|
||||
screen_colony_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
shiny::tagList(
|
||||
shiny::uiOutput(ns("header_card")),
|
||||
shiny::div(
|
||||
class = "row g-2 mb-4",
|
||||
lapply(list(
|
||||
list(id = "btn_insp", label = "Durchsicht", icon = "clipboard-list", cls = "btn-primary", screen = "inspection"),
|
||||
list(id = "btn_varroa", label = "Varroa", icon = "bug", cls = "btn-warning", screen = "varroa"),
|
||||
list(id = "btn_harvest",label = "Ernte", icon = "jar", cls = "btn-success", screen = "harvest"),
|
||||
list(id = "btn_queen", label = "Königin", icon = "crown", cls = "btn-info", screen = "queens"),
|
||||
list(id = "btn_check", label = "Checkliste", icon = "list-check", cls = "btn-secondary", screen = "checklists"),
|
||||
list(id = "btn_actions", label = "Maßnahmen", icon = "bolt", cls = "btn-info", screen = "actions"),
|
||||
list(id = "btn_edit", label = "Bearbeiten", icon = "pencil", cls = "btn-outline-secondary", screen = NULL)
|
||||
), function(b) {
|
||||
shiny::div(class = "col-6 col-md-4",
|
||||
shiny::actionButton(ns(b$id),
|
||||
shiny::tagList(shiny::icon(b$icon), shiny::tags$br(), b$label),
|
||||
class = paste("btn action-btn w-100", b$cls)
|
||||
)
|
||||
)
|
||||
})
|
||||
),
|
||||
shiny::uiOutput(ns("activity_log"))
|
||||
)
|
||||
}
|
||||
|
||||
screen_colony_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
reload <- reactiveVal(0)
|
||||
edit_insp_id <- reactiveVal(NULL)
|
||||
log_filter <- reactiveVal("alle")
|
||||
log_sel_type <- reactiveVal(NULL)
|
||||
log_sel_id <- reactiveVal(NULL)
|
||||
|
||||
observeEvent(nav$screen, {
|
||||
if (nav$screen == "colony") {
|
||||
reload(reload() + 1L)
|
||||
log_filter("alle")
|
||||
}
|
||||
}, ignoreInit = TRUE)
|
||||
|
||||
lapply(c("alle", "durchsicht", "varroa", "massnahme", "ernte"), function(f) {
|
||||
observeEvent(input[[paste0("log_filter_", f)]], {
|
||||
log_filter(f)
|
||||
}, ignoreInit = TRUE)
|
||||
})
|
||||
|
||||
colony <- reactive({
|
||||
req(nav$colony_id); reload()
|
||||
db_colonies_get(db, nav$colony_id)
|
||||
})
|
||||
|
||||
output$header_card <- renderUI({
|
||||
co <- colony()
|
||||
req(nrow(co) > 0)
|
||||
last <- db_inspections_last(db, nav$colony_id)
|
||||
bslib::card(
|
||||
class = "mb-3",
|
||||
bslib::card_body(
|
||||
shiny::div(class = "d-flex justify-content-between align-items-start mb-2",
|
||||
shiny::div(
|
||||
shiny::tags$p(class = "text-muted small mb-0", co$apiary_name %||% ""),
|
||||
if (!is.na(co$parent_name)) shiny::tags$p(class = "text-muted small mb-0",
|
||||
paste("Abstammung:", co$parent_name))
|
||||
),
|
||||
shiny::uiOutput(ns("status_selector"))
|
||||
),
|
||||
if (nrow(last) > 0)
|
||||
shiny::div(class = "border-top pt-2 mt-2",
|
||||
shiny::tags$small(class = "text-muted",
|
||||
paste0("Letzte Durchsicht: ", last$date[1]),
|
||||
shiny::tags$br(),
|
||||
paste0(
|
||||
if (!is.na(last$brood_frames)) paste(last$brood_frames, "BW") else "",
|
||||
if (!is.na(last$honey_frames)) paste0(" ", last$honey_frames, " HW") else "",
|
||||
if (!is.na(last$colony_strength)) paste0(" Stärke ", last$colony_strength) else "",
|
||||
if (last$queen_seen) " ♛ gesehen" else ""
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
output$status_selector <- renderUI({
|
||||
co <- colony()
|
||||
req(nrow(co) > 0)
|
||||
shiny::div(
|
||||
class = "d-flex flex-wrap gap-1",
|
||||
lapply(seq_along(COLONY_STATUSES), function(i) {
|
||||
s <- COLONY_STATUSES[[i]]
|
||||
lbl <- names(COLONY_STATUSES)[i]
|
||||
cls <- if (co$status == s) {
|
||||
paste("btn btn-sm", paste0("btn-", colony_status_color(s)))
|
||||
} else "btn btn-sm btn-outline-secondary"
|
||||
shiny::actionButton(ns(paste0("status_", i)), lbl, class = cls)
|
||||
})
|
||||
)
|
||||
})
|
||||
|
||||
observe({
|
||||
lapply(seq_along(COLONY_STATUSES), function(i) {
|
||||
local({
|
||||
li <- i; s <- COLONY_STATUSES[[i]]
|
||||
observeEvent(input[[paste0("status_", li)]], {
|
||||
req(nav$colony_id)
|
||||
if (s == "eingegangen") {
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = "Volk als eingegangen markieren?",
|
||||
footer = shiny::tagList(
|
||||
shiny::modalButton("Abbrechen"),
|
||||
shiny::actionButton(ns("confirm_close"), "Bestätigen", class = "btn-danger")
|
||||
),
|
||||
shiny::p("Das Volk wird als eingegangen markiert.")
|
||||
))
|
||||
} else {
|
||||
db_colonies_update(db,
|
||||
id = nav$colony_id,
|
||||
name = isolate(colony()$name),
|
||||
apiary_id = isolate(colony()$apiary_id),
|
||||
status = s,
|
||||
notes = isolate(colony()$notes)
|
||||
)
|
||||
reload(reload() + 1L)
|
||||
}
|
||||
}, ignoreInit = TRUE)
|
||||
})
|
||||
})
|
||||
})
|
||||
|
||||
observeEvent(input$confirm_close, {
|
||||
db_colonies_close(db, nav$colony_id)
|
||||
shiny::removeModal()
|
||||
nav$screen <- "colonies"
|
||||
})
|
||||
|
||||
# Action button navigation
|
||||
observeEvent(input$btn_insp, nav$screen <- "inspection")
|
||||
observeEvent(input$btn_varroa, nav$screen <- "varroa")
|
||||
observeEvent(input$btn_harvest, nav$screen <- "harvest")
|
||||
observeEvent(input$btn_queen, nav$screen <- "queens")
|
||||
observeEvent(input$btn_check, nav$screen <- "checklists")
|
||||
observeEvent(input$btn_actions, nav$screen <- "actions")
|
||||
|
||||
# Edit colony modal
|
||||
observeEvent(input$btn_edit, {
|
||||
co <- colony()
|
||||
ap <- db_apiaries_list(db)
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = paste("Volk bearbeiten:", co$name),
|
||||
footer = shiny::tagList(
|
||||
shiny::modalButton("Abbrechen"),
|
||||
shiny::actionButton(ns("confirm_edit"), "Speichern", class = "btn-primary")
|
||||
),
|
||||
shiny::textInput(ns("edit_name"), "Name *", value = co$name),
|
||||
shiny::selectInput(ns("edit_apiary"), "Bienenstand",
|
||||
choices = setNames(ap$id, ap$name),
|
||||
selected = co$apiary_id
|
||||
),
|
||||
shiny::textAreaInput(ns("edit_notes"), "Notizen", rows = 2,
|
||||
value = co$notes %||% "")
|
||||
))
|
||||
})
|
||||
observeEvent(input$confirm_edit, {
|
||||
req(nchar(trimws(input$edit_name)) > 0)
|
||||
co <- isolate(colony())
|
||||
db_colonies_update(db,
|
||||
id = nav$colony_id,
|
||||
name = trimws(input$edit_name),
|
||||
apiary_id = as.integer(input$edit_apiary),
|
||||
status = co$status,
|
||||
notes = input$edit_notes
|
||||
)
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
|
||||
output$activity_log <- renderUI({
|
||||
reload()
|
||||
req(nav$colony_id)
|
||||
log <- db_colony_log(db, nav$colony_id)
|
||||
flt <- log_filter()
|
||||
|
||||
type_label <- c(
|
||||
durchsicht = "Durchsicht",
|
||||
kontrolle = "Kontrolle",
|
||||
behandlung = "Behandlung",
|
||||
nachkontrolle = "Nachkontrolle",
|
||||
ernte = "Ernte",
|
||||
massnahme = "Maßnahme"
|
||||
)
|
||||
type_badge <- c(
|
||||
durchsicht = "bg-primary",
|
||||
kontrolle = "bg-warning text-dark",
|
||||
behandlung = "bg-danger",
|
||||
nachkontrolle = "bg-secondary",
|
||||
ernte = "bg-success",
|
||||
massnahme = "bg-info text-dark"
|
||||
)
|
||||
|
||||
filter_cats <- list(
|
||||
list(id = "alle", label = "Alle"),
|
||||
list(id = "durchsicht", label = "Durchsicht"),
|
||||
list(id = "varroa", label = "Varroa"),
|
||||
list(id = "massnahme", label = "Maßnahmen"),
|
||||
list(id = "ernte", label = "Ernte")
|
||||
)
|
||||
chips <- shiny::div(class = "d-flex flex-wrap gap-1 px-3 pt-3 pb-2",
|
||||
lapply(filter_cats, function(f) {
|
||||
cls <- if (flt == f$id) "btn btn-sm btn-primary" else "btn btn-sm btn-outline-secondary"
|
||||
shiny::actionButton(ns(paste0("log_filter_", f$id)), f$label, class = cls)
|
||||
})
|
||||
)
|
||||
|
||||
if (nrow(log) > 0 && flt != "alle") {
|
||||
keep <- switch(flt,
|
||||
durchsicht = log$type == "durchsicht",
|
||||
varroa = log$type %in% c("kontrolle", "behandlung", "nachkontrolle"),
|
||||
massnahme = log$type == "massnahme",
|
||||
ernte = log$type == "ernte",
|
||||
rep(TRUE, nrow(log))
|
||||
)
|
||||
log <- log[keep, , drop = FALSE]
|
||||
}
|
||||
|
||||
items <- if (nrow(log) == 0) {
|
||||
shiny::div(class = "px-3 py-2 text-muted small", "Keine Einträge.")
|
||||
} else {
|
||||
shiny::tags$ul(class = "list-group list-group-flush",
|
||||
lapply(seq_len(nrow(log)), function(i) {
|
||||
r <- log[i, ]
|
||||
is_insp <- r$type == "durchsicht"
|
||||
onclick_val <- if (is_insp)
|
||||
sprintf("Shiny.setInputValue('%s', %s, {priority:'event'})",
|
||||
ns("insp_select"), r$ref_id)
|
||||
else
|
||||
sprintf("Shiny.setInputValue('%s', '%s:%s', {priority:'event'})",
|
||||
ns("log_select"), r$type, r$ref_id)
|
||||
shiny::tags$li(
|
||||
class = "list-group-item py-2 px-3 tap-card",
|
||||
onclick = onclick_val,
|
||||
shiny::div(class = "d-flex justify-content-between align-items-center gap-2",
|
||||
shiny::div(class = "d-flex align-items-center gap-2 min-width-0",
|
||||
shiny::tags$span(class = paste("badge flex-shrink-0", type_badge[r$type]),
|
||||
type_label[r$type]),
|
||||
shiny::tags$span(class = "small text-truncate", r$summary)
|
||||
),
|
||||
shiny::div(class = "d-flex align-items-center gap-1 flex-shrink-0",
|
||||
shiny::tags$span(class = "text-muted small", r$date),
|
||||
shiny::icon("chevron-right", class = "text-muted small")
|
||||
)
|
||||
)
|
||||
)
|
||||
})
|
||||
)
|
||||
}
|
||||
|
||||
bslib::card(
|
||||
class = "mb-3",
|
||||
bslib::card_header("Aktivitätslog"),
|
||||
bslib::card_body(class = "p-0", chips, items)
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(input$insp_select, {
|
||||
id <- as.integer(input$insp_select)
|
||||
insp <- db_inspections_get(db, id)
|
||||
req(nrow(insp) > 0)
|
||||
traits_df <- db_inspections_traits(db, id)
|
||||
get_trait <- function(tval) {
|
||||
s <- traits_df$score[traits_df$trait == tval]
|
||||
if (length(s) > 0 && !is.na(s[1])) as.character(s[1]) else ""
|
||||
}
|
||||
edit_insp_id(id)
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = paste("Durchsicht", insp$date),
|
||||
size = "l",
|
||||
footer = shiny::tagList(
|
||||
shiny::modalButton("Abbrechen"),
|
||||
shiny::actionButton(ns("confirm_insp_edit"), "Speichern", class = "btn-primary"),
|
||||
shiny::actionButton(ns("confirm_insp_delete"), "Löschen", class = "btn-danger ms-auto")
|
||||
),
|
||||
shiny::div(class = "row g-2",
|
||||
shiny::div(class = "col-6",
|
||||
shiny::dateInput(ns("ei_date"), "Datum", value = as.Date(insp$date), language = "de", weekstart = 1)
|
||||
),
|
||||
shiny::div(class = "col-6",
|
||||
shiny::textInput(ns("ei_inspector"), "Imker/in", value = insp$inspector %||% "")
|
||||
)
|
||||
),
|
||||
shiny::div(class = "row g-2 mt-1",
|
||||
shiny::div(class = "col-4",
|
||||
shiny::numericInput(ns("ei_brood"), "Brutwaben", value = insp$brood_frames, min = 0, step = 1)
|
||||
),
|
||||
shiny::div(class = "col-4",
|
||||
shiny::numericInput(ns("ei_honey"), "Honigwaben", value = insp$honey_frames, min = 0, step = 1)
|
||||
),
|
||||
shiny::div(class = "col-4",
|
||||
shiny::numericInput(ns("ei_food"), "Futter (kg)", value = insp$food_stores_kg, min = 0, step = 0.5)
|
||||
)
|
||||
),
|
||||
shiny::div(class = "row g-2 mt-1",
|
||||
shiny::div(class = "col-6",
|
||||
shiny::selectInput(ns("ei_strength"), "Volksstärke",
|
||||
choices = c("–" = "", setNames(as.character(1:9), 1:9)),
|
||||
selected = if (!is.na(insp$colony_strength)) as.character(insp$colony_strength) else ""
|
||||
)
|
||||
),
|
||||
shiny::div(class = "col-6",
|
||||
shiny::numericInput(ns("ei_qcells"), "Weiselzellen", value = insp$queen_cells_count %||% 0, min = 0, step = 1)
|
||||
)
|
||||
),
|
||||
shiny::div(class = "d-flex gap-4 mt-2 mb-2",
|
||||
shiny::checkboxInput(ns("ei_queen"), "Königin gesehen", value = isTRUE(insp$queen_seen == 1)),
|
||||
shiny::checkboxInput(ns("ei_eggs"), "Eier / Stifte gesehen", value = isTRUE(insp$eggs_seen == 1))
|
||||
),
|
||||
shiny::div(class = "row g-2",
|
||||
lapply(names(TRAITS), function(tname) {
|
||||
tval <- TRAITS[[tname]]
|
||||
shiny::div(class = "col-6",
|
||||
shiny::selectInput(ns(paste0("ei_t_", tval)), tname,
|
||||
choices = c("–" = "", setNames(as.character(1:4), 1:4)),
|
||||
selected = get_trait(tval)
|
||||
)
|
||||
)
|
||||
})
|
||||
),
|
||||
shiny::textAreaInput(ns("ei_notes"), "Notizen / Auffälligkeiten",
|
||||
value = insp$notes %||% "", rows = 3, width = "100%")
|
||||
))
|
||||
})
|
||||
|
||||
observeEvent(input$confirm_insp_edit, {
|
||||
id <- edit_insp_id(); req(id)
|
||||
traits <- setNames(
|
||||
lapply(TRAITS, function(tval) {
|
||||
v <- input[[paste0("ei_t_", tval)]]
|
||||
if (!is.null(v) && v != "") as.integer(v) else NA_integer_
|
||||
}),
|
||||
TRAITS
|
||||
)
|
||||
db_inspections_update(db,
|
||||
id = id,
|
||||
date = input$ei_date,
|
||||
inspector = input$ei_inspector,
|
||||
brood_frames = input$ei_brood,
|
||||
honey_frames = input$ei_honey,
|
||||
food_stores_kg = input$ei_food,
|
||||
colony_strength = if (!is.null(input$ei_strength) && input$ei_strength != "")
|
||||
as.integer(input$ei_strength) else NA_integer_,
|
||||
queen_seen = isTRUE(input$ei_queen),
|
||||
eggs_seen = isTRUE(input$ei_eggs),
|
||||
queen_cells_count = as.integer(input$ei_qcells %||% 0L),
|
||||
notes = input$ei_notes,
|
||||
traits = traits
|
||||
)
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
|
||||
observeEvent(input$confirm_insp_delete, {
|
||||
id <- edit_insp_id(); req(id)
|
||||
db_inspections_delete(db, id)
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
|
||||
observeEvent(input$log_select, {
|
||||
parts <- strsplit(input$log_select, ":", fixed = TRUE)[[1]]
|
||||
type <- parts[1]
|
||||
id <- as.integer(parts[2])
|
||||
log_sel_type(type); log_sel_id(id)
|
||||
|
||||
footer <- shiny::tagList(
|
||||
shiny::modalButton("Abbrechen"),
|
||||
shiny::actionButton(ns("confirm_log_save"), "Speichern", class = "btn-primary"),
|
||||
shiny::actionButton(ns("confirm_log_delete"), "Löschen", class = "btn-danger ms-auto")
|
||||
)
|
||||
|
||||
if (type == "kontrolle") {
|
||||
vc <- db_varroa_counts_get(db, id); req(nrow(vc) > 0)
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = paste("Varroa-Kontrolle", vc$date), footer = footer,
|
||||
shiny::div(class = "row g-2",
|
||||
shiny::div(class = "col-6",
|
||||
shiny::dateInput(ns("el_date_from"), "Von",
|
||||
value = if (!is.na(vc$date_from)) as.Date(vc$date_from) else NA,
|
||||
language = "de", weekstart = 1)
|
||||
),
|
||||
shiny::div(class = "col-6",
|
||||
shiny::dateInput(ns("el_date"), "Bis",
|
||||
value = as.Date(vc$date), language = "de", weekstart = 1)
|
||||
)
|
||||
),
|
||||
shiny::numericInput(ns("el_count"), "Anzahl Milben", value = vc$count, min = 0, step = 1, width = "100%"),
|
||||
shiny::selectInput(ns("el_method"), "Methode", choices = VARROA_METHODS, selected = vc$method),
|
||||
shiny::textAreaInput(ns("el_notes"), "Notizen", value = vc$notes %||% "", rows = 2, width = "100%")
|
||||
))
|
||||
|
||||
} else if (type == "behandlung") {
|
||||
vt <- db_varroa_treatments_get(db, id); req(nrow(vt) > 0)
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = paste("Varroa-Behandlung", vt$date), footer = footer,
|
||||
shiny::dateInput(ns("el_date"), "Datum", value = as.Date(vt$date), language = "de", weekstart = 1),
|
||||
shiny::selectizeInput(ns("el_product"), "Mittel",
|
||||
choices = c("Mittel wählen…" = "", VARROA_PRODUCTS),
|
||||
selected = vt$product, options = list(create = TRUE)),
|
||||
shiny::textInput(ns("el_method_txt"), "Anwendung", value = vt$method %||% ""),
|
||||
shiny::textInput(ns("el_dosage"), "Dosierung", value = vt$dosage %||% ""),
|
||||
shiny::textAreaInput(ns("el_notes"), "Notizen", value = vt$notes %||% "", rows = 2, width = "100%")
|
||||
))
|
||||
|
||||
} else if (type == "nachkontrolle") {
|
||||
vc2 <- db_varroa_controls_get(db, id); req(nrow(vc2) > 0)
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = paste("Nachkontrolle", vc2$date), footer = footer,
|
||||
shiny::dateInput(ns("el_date"), "Datum", value = as.Date(vc2$date), language = "de", weekstart = 1),
|
||||
shiny::textInput(ns("el_result"), "Ergebnis / Befund", value = vc2$result %||% ""),
|
||||
shiny::textAreaInput(ns("el_notes"), "Notizen", value = vc2$notes %||% "", rows = 2, width = "100%")
|
||||
))
|
||||
|
||||
} else if (type == "ernte") {
|
||||
h <- db_harvests_get(db, id); req(nrow(h) > 0)
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = paste("Honigernte", h$date), footer = footer,
|
||||
shiny::dateInput(ns("el_date"), "Datum", value = as.Date(h$date), language = "de", weekstart = 1),
|
||||
shiny::numericInput(ns("el_weight"), "Gewicht (kg)", value = h$weight_kg, min = 0, step = 0.1, width = "100%"),
|
||||
shiny::textAreaInput(ns("el_notes"), "Notizen", value = h$notes %||% "", rows = 2, width = "100%")
|
||||
))
|
||||
|
||||
} else if (type == "massnahme") {
|
||||
ac <- db_actions_get(db, id); req(nrow(ac) > 0)
|
||||
shiny::showModal(shiny::modalDialog(
|
||||
title = paste("Maßnahme", ac$date), footer = footer,
|
||||
shiny::dateInput(ns("el_date"), "Datum", value = as.Date(ac$date), language = "de", weekstart = 1),
|
||||
shiny::selectInput(ns("el_action_type"), "Maßnahme",
|
||||
choices = COLONY_ACTION_TYPES, selected = ac$type),
|
||||
shiny::textAreaInput(ns("el_notes"), "Notizen", value = ac$notes %||% "", rows = 2, width = "100%")
|
||||
))
|
||||
}
|
||||
})
|
||||
|
||||
observeEvent(input$confirm_log_save, {
|
||||
type <- log_sel_type(); id <- log_sel_id(); req(type, id)
|
||||
if (type == "kontrolle") {
|
||||
db_varroa_counts_update(db, id,
|
||||
date_from = input$el_date_from,
|
||||
date = input$el_date,
|
||||
method = input$el_method,
|
||||
count = input$el_count,
|
||||
notes = input$el_notes)
|
||||
} else if (type == "behandlung") {
|
||||
db_varroa_treatments_update(db, id,
|
||||
date = input$el_date,
|
||||
product = input$el_product,
|
||||
method = input$el_method_txt,
|
||||
dosage = input$el_dosage,
|
||||
notes = input$el_notes)
|
||||
} else if (type == "nachkontrolle") {
|
||||
db_varroa_controls_update(db, id,
|
||||
date = input$el_date,
|
||||
result = input$el_result,
|
||||
notes = input$el_notes)
|
||||
} else if (type == "ernte") {
|
||||
db_harvests_update(db, id,
|
||||
date = input$el_date,
|
||||
weight_kg = input$el_weight,
|
||||
notes = input$el_notes)
|
||||
} else if (type == "massnahme") {
|
||||
db_actions_update(db, id,
|
||||
date = input$el_date,
|
||||
type = input$el_action_type,
|
||||
notes = input$el_notes)
|
||||
}
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
|
||||
observeEvent(input$confirm_log_delete, {
|
||||
type <- log_sel_type(); id <- log_sel_id(); req(type, id)
|
||||
switch(type,
|
||||
kontrolle = db_varroa_counts_delete(db, id),
|
||||
behandlung = db_varroa_treatments_delete(db, id),
|
||||
nachkontrolle = db_varroa_controls_delete(db, id),
|
||||
ernte = db_harvests_delete(db, id),
|
||||
massnahme = db_actions_delete(db, id)
|
||||
)
|
||||
shiny::removeModal(); reload(reload() + 1L)
|
||||
})
|
||||
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,59 @@
|
||||
screen_harvest_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 = "d-flex justify-content-between align-items-center py-3 border-bottom",
|
||||
shiny::span("Gewicht (kg) *", class = "fw-semibold"),
|
||||
shiny::numericInput(ns("weight_kg"), NULL, value = NA, min = 0, step = 0.1, width = "110px")
|
||||
),
|
||||
btn_group_row(ns, "type", "Honigsorte", HONEY_TYPES)
|
||||
),
|
||||
section_card(NULL,
|
||||
shiny::div(class = "py-2",
|
||||
shiny::textAreaInput(ns("notes"), "Notizen", rows = 2, width = "100%")
|
||||
)
|
||||
),
|
||||
shiny::div(class = "d-grid mt-2 mb-5",
|
||||
shiny::actionButton(ns("save"), "Ernte speichern", class = "btn btn-success btn-lg")
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_harvest_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
type_val <- btn_group_server("type", ns, input, output, HONEY_TYPES)
|
||||
|
||||
observeEvent(nav$screen, {
|
||||
if (nav$screen == "harvest") {
|
||||
type_val(NA)
|
||||
shiny::updateTextInput(session, "time", value = format(Sys.time(), "%H:%M"))
|
||||
}
|
||||
}, ignoreInit = TRUE)
|
||||
|
||||
observeEvent(input$save, {
|
||||
req(nav$colony_id, !is.na(input$weight_kg), input$weight_kg > 0)
|
||||
db_harvests_insert(db,
|
||||
date = input$date,
|
||||
weight_kg = input$weight_kg,
|
||||
colony_id = nav$colony_id,
|
||||
type = type_val(),
|
||||
notes = input$notes,
|
||||
time = input$time %||% NA
|
||||
)
|
||||
nav$screen <- "colony"
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,255 @@
|
||||
INSP_INFO <- list(
|
||||
futtervorrat = list(
|
||||
title = "Futtervorrat schätzen",
|
||||
content = shiny::tagList(
|
||||
shiny::tags$p("Zarge wiegen und Leergewicht abziehen."),
|
||||
shiny::tags$p(shiny::tags$strong("Richtwerte Leergewicht (Holz):")),
|
||||
shiny::tags$table(class = "table table-sm table-borderless mb-0",
|
||||
shiny::tags$tbody(
|
||||
shiny::tags$tr(shiny::tags$td("Zander Honigraum"), shiny::tags$td("ca. 5–6 kg")),
|
||||
shiny::tags$tr(shiny::tags$td("Zander Brutraum"), shiny::tags$td("ca. 7–8 kg")),
|
||||
shiny::tags$tr(shiny::tags$td("Dadant Brutraum"), shiny::tags$td("ca. 8–10 kg"))
|
||||
)
|
||||
),
|
||||
shiny::tags$p(class = "mt-2 mb-0", "1 voll verdeckelter Rahmen ≈ 2–3 kg."),
|
||||
shiny::tags$p(class = "mb-0 text-muted small", "Winterbedarf: ca. 15–20 kg / Volk.")
|
||||
)
|
||||
),
|
||||
sanftmut = list(
|
||||
title = "Sanftmut (1–4)",
|
||||
content = shiny::tagList(
|
||||
shiny::tags$p(class = "mb-1", "Verhalten während der Durchsicht", shiny::tags$em("(niedriger = besser):")),
|
||||
shiny::tags$table(class = "table table-sm table-borderless mb-0",
|
||||
shiny::tags$tbody(
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("sehr sanft – kein Stichversuch")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("sanft – vereinzelte Stichversuche")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("unruhig – mehrere Stichversuche")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("aggressiv – folgt dem Imker"))
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
schwarmtrieb = list(
|
||||
title = "Schwarmtrieb (1–4)",
|
||||
content = shiny::tagList(
|
||||
shiny::tags$p(class = "mb-1", "Neigung zur Schwarmbildung", shiny::tags$em("(niedriger = besser):")),
|
||||
shiny::tags$table(class = "table table-sm table-borderless mb-0",
|
||||
shiny::tags$tbody(
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("kein Schwarmtrieb")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("gering – vereinzelte Zellen")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("erhöht – mehrere Zellen")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("stark – Schwarm unmittelbar"))
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
wabensitz = list(
|
||||
title = "Wabensitz (1–4)",
|
||||
content = shiny::tagList(
|
||||
shiny::tags$p(class = "mb-1", "Ruhigkeit auf der Wabe", shiny::tags$em("(niedriger = besser):")),
|
||||
shiny::tags$table(class = "table table-sm table-borderless mb-0",
|
||||
shiny::tags$tbody(
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("sehr ruhig – Bienen sitzen fest")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("leicht unruhig")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("unruhig – Traubenbildung")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("sehr unruhig – starkes Laufen"))
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
honigertrag = list(
|
||||
title = "Honigertrag (1–4)",
|
||||
content = shiny::tagList(
|
||||
shiny::tags$p(class = "mb-1", "Honigleistung relativ zur Standpopulation", shiny::tags$em("(niedriger = besser):")),
|
||||
shiny::tags$table(class = "table table-sm table-borderless mb-0",
|
||||
shiny::tags$tbody(
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("überdurchschnittlich")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("durchschnittlich")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("unterdurchschnittlich")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("sehr gering"))
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
varroa = list(
|
||||
title = "Varroa-Hygiene (1–4)",
|
||||
content = shiny::tagList(
|
||||
shiny::tags$p(class = "mb-1", "VSH-Verhalten (Varroa Sensitive Hygiene)", shiny::tags$em("(niedriger = besser):")),
|
||||
shiny::tags$table(class = "table table-sm table-borderless mb-0",
|
||||
shiny::tags$tbody(
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("sehr stark – räumt Varroazellen aus")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("erkennbar")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("schwach erkennbar")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("nicht erkennbar"))
|
||||
)
|
||||
),
|
||||
shiny::tags$p(class = "mt-2 mb-0 text-muted small", "Tipp: Alkoholwäsche gibt verlässlichere Werte.")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
screen_inspection_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("inspector"), "Imker/in")
|
||||
)
|
||||
)
|
||||
),
|
||||
section_card("Stockkarte",
|
||||
stepper_row(ns, "brood", "Brutwaben"),
|
||||
stepper_row(ns, "honey", "Honigwaben"),
|
||||
strength_row(ns),
|
||||
shiny::div(
|
||||
class = "d-flex justify-content-between align-items-center py-3 border-bottom",
|
||||
shiny::span(class = "fw-semibold",
|
||||
"Futtervorrat (kg)",
|
||||
info_icon(INSP_INFO$futtervorrat$title, INSP_INFO$futtervorrat$content)
|
||||
),
|
||||
shiny::numericInput(ns("food_kg"), NULL, value = NA, min = 0, step = 0.5, width = "100px")
|
||||
)
|
||||
),
|
||||
section_card("Königin",
|
||||
toggle_row(ns, "queen_seen", "Königin gesehen"),
|
||||
toggle_row(ns, "eggs_seen", "Eier / Stifte gesehen"),
|
||||
stepper_row(ns, "qcells", "Weiselzellen")
|
||||
),
|
||||
section_card(NULL,
|
||||
shiny::div(class = "py-2",
|
||||
shiny::div(class = "d-flex justify-content-between align-items-center mb-1",
|
||||
shiny::tags$label("Notizen / Auffälligkeiten", class = "form-label mb-0"),
|
||||
shiny::div(class = "d-flex align-items-center gap-2",
|
||||
shiny::tags$small(id = ns("mic_status"), class = "text-muted", ""),
|
||||
shiny::tags$button(
|
||||
id = ns("mic_btn"),
|
||||
type = "button",
|
||||
class = "btn btn-outline-secondary btn-sm",
|
||||
title = "Spracheingabe (Deutsch)",
|
||||
"\U0001f3a4"
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::textAreaInput(ns("notes"), NULL, rows = 3, width = "100%"),
|
||||
shiny::tags$script(shiny::HTML(sprintf('
|
||||
setTimeout(function() {
|
||||
var SR = window.SpeechRecognition || window.webkitSpeechRecognition;
|
||||
var btn = document.getElementById("%s");
|
||||
var sts = document.getElementById("%s");
|
||||
if (!SR) { if (btn) btn.style.display = "none"; return; }
|
||||
var rec = null;
|
||||
var active = false;
|
||||
|
||||
function setIdle() {
|
||||
active = false;
|
||||
btn.classList.replace("btn-danger", "btn-outline-secondary");
|
||||
btn.textContent = "\U0001f3a4";
|
||||
sts.textContent = "";
|
||||
}
|
||||
function setRecording() {
|
||||
active = true;
|
||||
btn.classList.replace("btn-outline-secondary", "btn-danger");
|
||||
btn.textContent = "⏹";
|
||||
sts.textContent = "Aufnahme...";
|
||||
}
|
||||
|
||||
btn.addEventListener("click", function() {
|
||||
if (active) {
|
||||
rec.stop();
|
||||
} else {
|
||||
rec = new SR();
|
||||
rec.lang = "de-DE";
|
||||
rec.continuous = false;
|
||||
rec.interimResults = false;
|
||||
|
||||
rec.onstart = function() { setRecording(); };
|
||||
rec.onresult = function(e) {
|
||||
var t = Array.from(e.results)
|
||||
.filter(function(r) { return r.isFinal; })
|
||||
.map(function(r) { return r[0].transcript; })
|
||||
.join(" ").trim();
|
||||
if (!t) return;
|
||||
var ta = document.getElementById("%s");
|
||||
ta.value = ta.value ? ta.value + " " + t : t;
|
||||
Shiny.setInputValue("%s", ta.value, {priority: "event"});
|
||||
};
|
||||
rec.onerror = function(e) {
|
||||
sts.textContent = "Fehler: " + e.error;
|
||||
setTimeout(setIdle, 2000);
|
||||
};
|
||||
rec.onend = function() { setIdle(); };
|
||||
rec.start();
|
||||
}
|
||||
});
|
||||
}, 200);
|
||||
', ns("mic_btn"), ns("mic_status"), ns("notes"), ns("notes"))))
|
||||
)
|
||||
),
|
||||
collapsible_card("Zuchteigenschaften (optional)",
|
||||
trait_row(ns, "t_sanft", "Sanftmut", info = INSP_INFO$sanftmut),
|
||||
trait_row(ns, "t_schwarm", "Schwarmtrieb", info = INSP_INFO$schwarmtrieb),
|
||||
trait_row(ns, "t_waben", "Wabensitz", info = INSP_INFO$wabensitz),
|
||||
trait_row(ns, "t_honig", "Honigertrag", info = INSP_INFO$honigertrag),
|
||||
trait_row(ns, "t_varroa", "Varroa-Hygiene", info = INSP_INFO$varroa),
|
||||
collapse_id = "insp_zuchteig"
|
||||
),
|
||||
shiny::div(class = "d-grid mt-2 mb-5",
|
||||
shiny::actionButton(ns("save"), "Durchsicht speichern",
|
||||
class = "btn btn-primary btn-lg")
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_inspection_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
brood <- stepper_server("brood", input, output)
|
||||
honey <- stepper_server("honey", input, output)
|
||||
qcells <- stepper_server("qcells", input, output, default = 0L)
|
||||
str_v <- strength_server("strength", ns, input, output)
|
||||
|
||||
t_sanft <- trait_server("t_sanft", ns, input, output)
|
||||
t_schwarm <- trait_server("t_schwarm", ns, input, output)
|
||||
t_waben <- trait_server("t_waben", ns, input, output)
|
||||
t_honig <- trait_server("t_honig", ns, input, output)
|
||||
t_varroa <- trait_server("t_varroa", ns, input, output)
|
||||
|
||||
observeEvent(nav$screen, {
|
||||
if (nav$screen == "inspection") {
|
||||
brood(NA_integer_); honey(NA_integer_); qcells(0L); str_v(NA_integer_)
|
||||
t_sanft(NA_integer_); t_schwarm(NA_integer_); t_waben(NA_integer_)
|
||||
t_honig(NA_integer_); t_varroa(NA_integer_)
|
||||
}
|
||||
}, ignoreInit = TRUE)
|
||||
|
||||
observeEvent(input$save, {
|
||||
req(nav$colony_id)
|
||||
db_inspections_insert(db,
|
||||
colony_id = nav$colony_id,
|
||||
date = input$date,
|
||||
inspector = input$inspector,
|
||||
brood_frames = brood(),
|
||||
honey_frames = honey(),
|
||||
food_stores_kg = input$food_kg,
|
||||
colony_strength = str_v(),
|
||||
queen_seen = isTRUE(input$queen_seen),
|
||||
eggs_seen = isTRUE(input$eggs_seen),
|
||||
queen_cells_count = qcells() %||% 0L,
|
||||
notes = input$notes,
|
||||
traits = list(
|
||||
sanftmut = t_sanft(),
|
||||
schwarmtrieb = t_schwarm(),
|
||||
wabensitz = t_waben(),
|
||||
honigertrag = t_honig(),
|
||||
varroa_hygiene = t_varroa()
|
||||
)
|
||||
)
|
||||
nav$screen <- "colony"
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -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"
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,102 @@
|
||||
screen_queen_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
shiny::div(
|
||||
shiny::uiOutput(ns("current_queen")),
|
||||
section_card("Neue Königin erfassen",
|
||||
shiny::div(class = "row g-2 py-2",
|
||||
shiny::div(class = "col-6",
|
||||
shiny::numericInput(ns("year"), "Jahrgang",
|
||||
value = as.integer(format(Sys.Date(), "%Y")), min = 2000, max = 2100, step = 1)
|
||||
),
|
||||
shiny::div(class = "col-6",
|
||||
shiny::textInput(ns("breed"), "Rasse / Zucht")
|
||||
)
|
||||
),
|
||||
btn_group_row(ns, "color", "Markierungsfarbe",
|
||||
c("Weiß" = "weiss", "Gelb" = "gelb", "Rot" = "rot", "Grün" = "gruen", "Blau" = "blau")
|
||||
),
|
||||
shiny::div(class = "py-2",
|
||||
shiny::uiOutput(ns("origin_sel")),
|
||||
shiny::dateInput(ns("introduced"), "Eingeweiselt am",
|
||||
value = Sys.Date(), language = "de", weekstart = 1),
|
||||
shiny::textAreaInput(ns("notes"), "Notizen", rows = 2, width = "100%")
|
||||
)
|
||||
),
|
||||
shiny::div(class = "d-grid mt-2 mb-5",
|
||||
shiny::actionButton(ns("save"), "Königin speichern", class = "btn btn-info btn-lg")
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_queen_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
color_v <- btn_group_server("color", ns, input, output,
|
||||
c("Weiß" = "weiss", "Gelb" = "gelb", "Rot" = "rot", "Grün" = "gruen", "Blau" = "blau"))
|
||||
|
||||
output$current_queen <- renderUI({
|
||||
req(nav$colony_id)
|
||||
co <- db_colonies_get(db, nav$colony_id)
|
||||
req(nrow(co) > 0, !is.na(co$current_queen_id))
|
||||
q <- db_queens_get(db, co$current_queen_id)
|
||||
req(nrow(q) > 0)
|
||||
bslib::card(
|
||||
class = "mb-3",
|
||||
bslib::card_header("Aktuelle Königin"),
|
||||
bslib::card_body(
|
||||
shiny::div(class = "row g-2",
|
||||
shiny::div(class = "col-4",
|
||||
shiny::tags$small(class = "text-muted", "Jahrgang"), shiny::tags$br(),
|
||||
shiny::tags$strong(q$year %||% "–")
|
||||
),
|
||||
shiny::div(class = "col-4",
|
||||
shiny::tags$small(class = "text-muted", "Rasse"), shiny::tags$br(),
|
||||
shiny::tags$strong(q$breed %||% "–")
|
||||
),
|
||||
shiny::div(class = "col-4",
|
||||
shiny::tags$small(class = "text-muted", "Farbe"), shiny::tags$br(),
|
||||
shiny::tags$strong(q$marked_color %||% "–")
|
||||
)
|
||||
),
|
||||
shiny::div(class = "mt-2",
|
||||
shiny::actionButton(ns("supersede"), "Ablösen (neue Königin)",
|
||||
class = "btn btn-sm btn-outline-warning")
|
||||
)
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(input$supersede, {
|
||||
req(nav$colony_id)
|
||||
co <- db_colonies_get(db, nav$colony_id)
|
||||
if (!is.na(co$current_queen_id)) db_queens_supersede(db, co$current_queen_id)
|
||||
})
|
||||
|
||||
output$origin_sel <- renderUI({
|
||||
cols <- db_colonies_list(db)
|
||||
shiny::selectInput(ns("origin"), "Herkunft (Muttervolk)",
|
||||
choices = c("Unbekannt" = "", setNames(cols$id, cols$name))
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(nav$screen, {
|
||||
if (nav$screen == "queens") color_v(NA)
|
||||
}, ignoreInit = TRUE)
|
||||
|
||||
observeEvent(input$save, {
|
||||
req(nav$colony_id)
|
||||
origin <- if (!is.null(input$origin) && input$origin != "")
|
||||
as.integer(input$origin) else NA
|
||||
db_queens_insert(db,
|
||||
colony_id = nav$colony_id,
|
||||
year = input$year,
|
||||
breed = input$breed,
|
||||
origin_colony_id = origin,
|
||||
marked_color = color_v(),
|
||||
notes = input$notes,
|
||||
introduced_at = as.character(input$introduced)
|
||||
)
|
||||
nav$screen <- "colony"
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,113 @@
|
||||
screen_quick_insp_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
shiny::tagList(
|
||||
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("inspector"), "Imker/in")
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::uiOutput(ns("colony_cards")),
|
||||
shiny::div(class = "d-grid mt-2 mb-5",
|
||||
shiny::actionButton(ns("save_all"), "Alle speichern",
|
||||
class = "btn btn-primary btn-lg")
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_quick_insp_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
colonies <- reactive({
|
||||
req(nav$apiary_id, nav$screen == "quick_inspection")
|
||||
db_colonies_list(db, apiary_id = nav$apiary_id, include_closed = FALSE)
|
||||
})
|
||||
|
||||
output$colony_cards <- renderUI({
|
||||
cols <- colonies()
|
||||
if (nrow(cols) == 0)
|
||||
return(shiny::p(class = "text-muted text-center py-4", "Keine aktiven Völker."))
|
||||
|
||||
lapply(seq_len(nrow(cols)), function(i) {
|
||||
row <- cols[i, ]
|
||||
cid <- row$id
|
||||
section_card(
|
||||
shiny::div(class = "d-flex justify-content-between align-items-center",
|
||||
shiny::tags$strong(row$name),
|
||||
shiny::HTML(colony_status_badge(row$status))
|
||||
),
|
||||
# Königin / Eier toggles
|
||||
shiny::div(class = "d-flex gap-4 py-2 border-bottom",
|
||||
toggle_row_inline(ns(paste0("qk_", cid)), "K gesehen"),
|
||||
toggle_row_inline(ns(paste0("qe_", cid)), "Eier")
|
||||
),
|
||||
# Brutwaben
|
||||
shiny::div(
|
||||
class = "d-flex justify-content-between align-items-center py-2 border-bottom",
|
||||
shiny::tags$span("Brutwaben", class = "text-muted small"),
|
||||
shiny::numericInput(ns(paste0("qb_", cid)), NULL,
|
||||
value = NA, min = 0, max = 20, step = 1, width = "80px")
|
||||
),
|
||||
# Notizen
|
||||
shiny::div(class = "py-2",
|
||||
shiny::textAreaInput(ns(paste0("qn_", cid)), NULL,
|
||||
placeholder = "Notizen...", rows = 2, width = "100%")
|
||||
)
|
||||
)
|
||||
})
|
||||
})
|
||||
|
||||
observeEvent(input$save_all, {
|
||||
cols <- isolate(colonies())
|
||||
if (nrow(cols) == 0) return()
|
||||
|
||||
n_saved <- 0L
|
||||
for (i in seq_len(nrow(cols))) {
|
||||
cid <- cols$id[i]
|
||||
queen <- isTRUE(input[[paste0("qk_", cid)]])
|
||||
eggs <- isTRUE(input[[paste0("qe_", cid)]])
|
||||
brood <- suppressWarnings(as.integer(input[[paste0("qb_", cid)]]))
|
||||
notes <- trimws(input[[paste0("qn_", cid)]] %||% "")
|
||||
|
||||
if (!queen && !eggs && is.na(brood) && nchar(notes) == 0) next
|
||||
|
||||
tryCatch({
|
||||
db_inspections_insert(db,
|
||||
colony_id = cid,
|
||||
date = input$date,
|
||||
inspector = input$inspector,
|
||||
brood_frames = if (!is.na(brood)) brood else NA_integer_,
|
||||
queen_seen = queen,
|
||||
eggs_seen = eggs,
|
||||
notes = if (nchar(notes) > 0) notes else NA_character_,
|
||||
traits = list()
|
||||
)
|
||||
n_saved <- n_saved + 1L
|
||||
log_debug("quick_insp_saved", colony_id = cid)
|
||||
}, error = function(e) {
|
||||
log_error("quick_insp_error", colony_id = cid, msg = conditionMessage(e))
|
||||
})
|
||||
}
|
||||
|
||||
if (n_saved > 0)
|
||||
shiny::showNotification(
|
||||
sprintf("%d Durchsicht(en) gespeichert.", n_saved),
|
||||
type = "message", duration = 3
|
||||
)
|
||||
nav$screen <- "colonies"
|
||||
})
|
||||
})
|
||||
}
|
||||
|
||||
# Compact inline toggle (no label on separate line)
|
||||
toggle_row_inline <- function(input_id, label) {
|
||||
shiny::div(class = "d-flex align-items-center gap-2",
|
||||
shiny::checkboxInput(input_id, label = NULL, value = FALSE),
|
||||
shiny::tags$label(`for` = input_id, class = "mb-0", label)
|
||||
)
|
||||
}
|
||||
@@ -0,0 +1,181 @@
|
||||
VARROA_METHODS_DISPLAY <- c(
|
||||
"Nat. Totenfall" = "natuerlicher_totenfall",
|
||||
"Alkoholwäsche" = "alkoholwaesche",
|
||||
"Puderzucker" = "puderzucker"
|
||||
)
|
||||
|
||||
screen_varroa_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
bslib::navset_card_tab(
|
||||
bslib::nav_panel("Kontrolle",
|
||||
shiny::div(class = "p-2",
|
||||
section_card(NULL,
|
||||
shiny::div(class = "row g-2 py-2",
|
||||
shiny::div(class = "col-4",
|
||||
shiny::dateInput(ns("count_date_from"), "Von", value = Sys.Date() - 3L, language = "de", weekstart = 1)
|
||||
),
|
||||
shiny::div(class = "col-4",
|
||||
shiny::dateInput(ns("count_date_to"), "Bis", value = Sys.Date(), language = "de", weekstart = 1)
|
||||
),
|
||||
shiny::div(class = "col-4",
|
||||
shiny::textInput(ns("count_time"), "Uhrzeit",
|
||||
value = format(Sys.time(), "%H:%M"), placeholder = "HH:MM")
|
||||
)
|
||||
)
|
||||
),
|
||||
btn_group_row(ns, "count_method", "Methode", VARROA_METHODS_DISPLAY),
|
||||
stepper_row(ns, "count_val", "Anzahl / Wert"),
|
||||
shiny::uiOutput(ns("milben_pro_tag_ui")),
|
||||
section_card(NULL,
|
||||
shiny::div(class = "py-2",
|
||||
shiny::div(
|
||||
class = "bk-check d-flex justify-content-between align-items-center py-2 border-bottom",
|
||||
shiny::tags$label(class = "fw-semibold", `for` = ns("is_ctrl"), "Nachkontrolle zu Behandlung?"),
|
||||
shiny::checkboxInput(ns("is_ctrl"), NULL, value = FALSE)
|
||||
),
|
||||
shiny::uiOutput(ns("ctrl_extra_ui")),
|
||||
shiny::textAreaInput(ns("count_notes"), "Notizen", rows = 2, width = "100%")
|
||||
)
|
||||
),
|
||||
shiny::div(class = "d-grid mt-2",
|
||||
shiny::actionButton(ns("save_count"), "Kontrolle speichern", class = "btn btn-primary btn-lg")
|
||||
)
|
||||
)
|
||||
),
|
||||
bslib::nav_panel("Behandlung",
|
||||
shiny::div(class = "p-2",
|
||||
section_card(NULL,
|
||||
shiny::div(class = "row g-2 py-2",
|
||||
shiny::div(class = "col-6",
|
||||
shiny::dateInput(ns("treat_date"), "Datum", value = Sys.Date(), language = "de", weekstart = 1)
|
||||
),
|
||||
shiny::div(class = "col-6",
|
||||
shiny::textInput(ns("treat_time"), "Uhrzeit",
|
||||
value = format(Sys.time(), "%H:%M"), placeholder = "HH:MM")
|
||||
),
|
||||
shiny::div(class = "col-12",
|
||||
shiny::selectizeInput(ns("treat_product"), "Mittel *",
|
||||
choices = c("Mittel wählen…" = "", VARROA_PRODUCTS),
|
||||
options = list(create = TRUE, placeholder = "Mittel wählen…")
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
section_card(NULL,
|
||||
shiny::div(class = "py-2",
|
||||
shiny::uiOutput(ns("treat_method_ui")),
|
||||
shiny::textInput(ns("treat_dosage"), "Dosierung", placeholder = "2,3 g / Volk"),
|
||||
shiny::textAreaInput(ns("treat_notes"), "Notizen", rows = 2, width = "100%")
|
||||
)
|
||||
),
|
||||
shiny::div(class = "d-grid mt-2",
|
||||
shiny::actionButton(ns("save_treat"), "Behandlung speichern", class = "btn btn-warning btn-lg")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
screen_varroa_server <- function(id, db, nav) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
count_method <- btn_group_server("count_method", ns, input, output,
|
||||
VARROA_METHODS_DISPLAY, default = "natuerlicher_totenfall")
|
||||
count_val <- stepper_server("count_val", input, output)
|
||||
|
||||
observeEvent(nav$screen, {
|
||||
if (nav$screen == "varroa") {
|
||||
count_val(NA_integer_)
|
||||
shiny::updateCheckboxInput(session, "is_ctrl", value = FALSE)
|
||||
shiny::updateDateInput(session, "count_date_from", value = Sys.Date() - 3L)
|
||||
shiny::updateDateInput(session, "count_date_to", value = Sys.Date())
|
||||
shiny::updateTextInput(session, "count_time", value = format(Sys.time(), "%H:%M"))
|
||||
shiny::updateTextInput(session, "treat_time", value = format(Sys.time(), "%H:%M"))
|
||||
}
|
||||
}, ignoreInit = TRUE)
|
||||
|
||||
output$milben_pro_tag_ui <- renderUI({
|
||||
v <- count_val()
|
||||
d_von <- input$count_date_from
|
||||
d_bis <- input$count_date_to
|
||||
if (is.na(v) || is.null(d_von) || is.null(d_bis)) return(NULL)
|
||||
days <- as.numeric(as.Date(d_bis) - as.Date(d_von))
|
||||
if (days < 0) return(shiny::p(class = "text-danger small py-1", "Bis-Datum liegt vor Von-Datum."))
|
||||
mpt <- round(v / max(1, days), 1)
|
||||
cls <- if (mpt < 1) "text-success" else if (mpt < 3) "text-warning" else "text-danger"
|
||||
shiny::div(
|
||||
class = paste("text-center py-2 fw-bold fs-4", cls),
|
||||
paste0(mpt, " Milben/Tag"),
|
||||
shiny::tags$div(class = "text-muted fw-normal small",
|
||||
paste0(v, " Milben über ", days, " Tage"))
|
||||
)
|
||||
})
|
||||
|
||||
output$ctrl_extra_ui <- renderUI({
|
||||
req(isTRUE(input$is_ctrl), nav$colony_id)
|
||||
treats <- db_varroa_treatments_list(db, nav$colony_id)
|
||||
if (nrow(treats) == 0)
|
||||
return(shiny::p(class = "text-muted small py-2", "Keine Behandlungen erfasst."))
|
||||
shiny::tagList(
|
||||
shiny::selectInput(ns("ctrl_treatment"), "Zur Behandlung",
|
||||
choices = setNames(treats$id, paste(treats$date, treats$product))
|
||||
),
|
||||
shiny::textInput(ns("ctrl_result"), "Ergebnis / Befund")
|
||||
)
|
||||
})
|
||||
|
||||
output$treat_method_ui <- renderUI({
|
||||
product <- input$treat_product
|
||||
methods <- if (!is.null(product) && product != "") VARROA_APPLICATION_METHODS[[product]] else NULL
|
||||
if (!is.null(methods)) {
|
||||
shiny::selectizeInput(ns("treat_method"), "Anwendung",
|
||||
choices = c("Anwendung wählen…" = "", methods),
|
||||
options = list(create = TRUE, placeholder = "Anwendung wählen…")
|
||||
)
|
||||
} else {
|
||||
shiny::textInput(ns("treat_method"), "Anwendung", placeholder = "z. B. Träufeln")
|
||||
}
|
||||
})
|
||||
|
||||
observeEvent(input$save_count, {
|
||||
req(nav$colony_id, !is.na(count_val()))
|
||||
db_varroa_counts_insert(db,
|
||||
colony_id = nav$colony_id,
|
||||
date_from = input$count_date_from,
|
||||
date = input$count_date_to,
|
||||
method = count_method() %||% "natuerlicher_totenfall",
|
||||
count = count_val(),
|
||||
notes = input$count_notes,
|
||||
time = input$count_time %||% NA
|
||||
)
|
||||
if (isTRUE(input$is_ctrl) && !is.null(input$ctrl_treatment)) {
|
||||
db_varroa_controls_insert(db,
|
||||
treatment_id = as.integer(input$ctrl_treatment),
|
||||
colony_id = nav$colony_id,
|
||||
date = input$count_date,
|
||||
result = input$ctrl_result %||% "",
|
||||
notes = input$count_notes
|
||||
)
|
||||
}
|
||||
count_val(NA_integer_)
|
||||
shiny::updateTextAreaInput(session, "count_notes", value = "")
|
||||
shiny::updateCheckboxInput(session, "is_ctrl", value = FALSE)
|
||||
nav$screen <- "colony"
|
||||
})
|
||||
|
||||
observeEvent(input$save_treat, {
|
||||
req(nav$colony_id, nchar(trimws(input$treat_product)) > 0)
|
||||
db_varroa_treatments_insert(db,
|
||||
colony_id = nav$colony_id,
|
||||
date = input$treat_date,
|
||||
product = trimws(input$treat_product),
|
||||
method = input$treat_method,
|
||||
dosage = input$treat_dosage,
|
||||
notes = input$treat_notes,
|
||||
time = input$treat_time %||% NA
|
||||
)
|
||||
nav$screen <- "colony"
|
||||
})
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,101 @@
|
||||
server <- function(input, output, session, db) {
|
||||
|
||||
nav <- reactiveValues(
|
||||
screen = "apiaries",
|
||||
apiary_id = NULL,
|
||||
colony_id = NULL
|
||||
)
|
||||
|
||||
# ---- Module initialization ------------------------------------------------
|
||||
screen_apiaries_server("s_apiaries", db = db, nav = nav)
|
||||
screen_colonies_server("s_colonies", db = db, nav = nav)
|
||||
screen_colony_server("s_colony", db = db, nav = nav)
|
||||
screen_inspection_server("s_insp", db = db, nav = nav)
|
||||
screen_varroa_server("s_varroa", db = db, nav = nav)
|
||||
screen_harvest_server("s_harvest", db = db, nav = nav)
|
||||
screen_queen_server("s_queen", db = db, nav = nav)
|
||||
screen_checklists_server("s_chklst", db = db, nav = nav)
|
||||
screen_actions_server("s_actions", db = db, nav = nav)
|
||||
screen_lineage_server("s_lineage", db = db, nav = nav)
|
||||
screen_quick_insp_server("s_qinsp", db = db, nav = nav)
|
||||
screen_bulk_action_server("s_bulk", db = db, nav = nav)
|
||||
|
||||
# ---- Navigation header ---------------------------------------------------
|
||||
BACK <- c(
|
||||
colonies = "apiaries",
|
||||
colony = "colonies",
|
||||
inspection = "colony",
|
||||
varroa = "colony",
|
||||
harvest = "colony",
|
||||
queens = "colony",
|
||||
checklists = "colony",
|
||||
actions = "colony",
|
||||
lineage = "colonies",
|
||||
quick_inspection = "colonies",
|
||||
bulk_action = "colonies"
|
||||
)
|
||||
|
||||
output$nav_header <- renderUI({
|
||||
screen <- nav$screen
|
||||
if (screen == "apiaries") {
|
||||
return(shiny::div(
|
||||
class = "bk-header d-flex justify-content-between align-items-center",
|
||||
shiny::tags$h4("Beekeeper"),
|
||||
shiny::actionButton("btn_settings", shiny::icon("gear"),
|
||||
class = "btn btn-link bk-header-icon", title = "Einstellungen")
|
||||
))
|
||||
}
|
||||
title <- switch(screen,
|
||||
colonies = {
|
||||
ap <- db_apiaries_get(db, nav$apiary_id)
|
||||
if (nrow(ap) > 0) ap$name[1] else "Stand"
|
||||
},
|
||||
colony = {
|
||||
co <- db_colonies_get(db, nav$colony_id)
|
||||
if (nrow(co) > 0) co$name[1] else "Volk"
|
||||
},
|
||||
inspection = "Neue Durchsicht",
|
||||
quick_inspection = "Schnelldurchsicht",
|
||||
bulk_action = "Sammelmaßnahme",
|
||||
varroa = "Varroa",
|
||||
harvest = "Honigernte",
|
||||
queens = "Königin",
|
||||
checklists = "Checkliste",
|
||||
actions = "Maßnahmen",
|
||||
lineage = "Stammbaum",
|
||||
""
|
||||
)
|
||||
shiny::div(
|
||||
class = "bk-header d-flex align-items-center gap-2",
|
||||
shiny::actionButton("nav_back", shiny::icon("arrow-left"),
|
||||
class = "btn btn-link bk-header-icon"
|
||||
),
|
||||
shiny::tags$h5(class = "mb-0 flex-grow-1", title)
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(input$nav_back, {
|
||||
target <- BACK[nav$screen]
|
||||
if (!is.na(target)) nav$screen <- target
|
||||
})
|
||||
|
||||
observeEvent(input$keepalive_ping, {}, ignoreNULL = TRUE, ignoreInit = TRUE)
|
||||
|
||||
# ---- Content switcher ----------------------------------------------------
|
||||
output$screen_content <- renderUI({
|
||||
switch(nav$screen,
|
||||
apiaries = screen_apiaries_ui("s_apiaries"),
|
||||
colonies = screen_colonies_ui("s_colonies"),
|
||||
colony = screen_colony_ui("s_colony"),
|
||||
inspection = screen_inspection_ui("s_insp"),
|
||||
varroa = screen_varroa_ui("s_varroa"),
|
||||
harvest = screen_harvest_ui("s_harvest"),
|
||||
queens = screen_queen_ui("s_queen"),
|
||||
checklists = screen_checklists_ui("s_chklst"),
|
||||
actions = screen_actions_ui("s_actions"),
|
||||
lineage = screen_lineage_ui("s_lineage"),
|
||||
quick_inspection = screen_quick_insp_ui("s_qinsp"),
|
||||
bulk_action = screen_bulk_action_ui("s_bulk")
|
||||
)
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,83 @@
|
||||
ui <- function() {
|
||||
bslib::page(
|
||||
fillable = FALSE,
|
||||
theme = bslib::bs_theme(version = 5, primary = "#f59e0b"),
|
||||
lang = "de",
|
||||
title = "Beekeeper",
|
||||
|
||||
shiny::tags$style(shiny::HTML("
|
||||
body { background: #fafaf9; }
|
||||
.bk-header {
|
||||
background: #78350f; color: white;
|
||||
position: sticky; top: 0; z-index: 100;
|
||||
padding: .75rem 1rem;
|
||||
box-shadow: 0 2px 8px rgba(0,0,0,.3);
|
||||
min-height: 56px;
|
||||
}
|
||||
.bk-header h5 { color: white; margin: 0; font-size: 1.05rem; font-weight: 600; }
|
||||
.bk-header h4 { color: white; margin: 0; font-size: 1.2rem; font-weight: 700; letter-spacing: -.01em; }
|
||||
.bk-header .btn-link {
|
||||
color: rgba(255,255,255,.9) !important; text-decoration: none;
|
||||
}
|
||||
.bk-header-icon {
|
||||
padding: .35rem .45rem; border-radius: .4rem; line-height: 1; flex-shrink: 0;
|
||||
}
|
||||
.bk-header-icon:hover { background: rgba(255,255,255,.18) !important; color: white !important; }
|
||||
.collapse-toggle { cursor: pointer; user-select: none; }
|
||||
.collapse-toggle .collapse-chevron { transition: transform .2s ease; }
|
||||
.collapse-toggle:not(.collapsed) .collapse-chevron { transform: rotate(180deg); }
|
||||
.bk-content { max-width: 680px; margin: 0 auto; padding: 1rem 1rem 4rem; }
|
||||
.tap-card { cursor: pointer; transition: box-shadow .15s; }
|
||||
.tap-card:hover { box-shadow: 0 0 0 3px #f59e0b44; }
|
||||
.tap-card:active { box-shadow: 0 0 0 3px #f59e0b; }
|
||||
.action-btn {
|
||||
display: flex; flex-direction: column;
|
||||
align-items: center; justify-content: center;
|
||||
height: 80px; gap: .35rem;
|
||||
font-size: .82rem; font-weight: 600;
|
||||
border-radius: 12px;
|
||||
}
|
||||
.action-btn .fa, .action-btn .fas, .action-btn .far { font-size: 1.4rem; }
|
||||
.stepper-val {
|
||||
min-width: 2.8rem; display: inline-block;
|
||||
text-align: center; font-size: 1.3rem; font-weight: 700;
|
||||
}
|
||||
.bk-check .form-check { margin: 0; }
|
||||
.bk-check .form-check-input {
|
||||
width: 3em; height: 1.5em; margin-top: 0; cursor: pointer;
|
||||
}
|
||||
.add-dashed {
|
||||
border: 2px dashed #ccc; background: transparent;
|
||||
border-radius: 8px; cursor: pointer; width: 100%;
|
||||
min-height: 100px; color: #888;
|
||||
display: flex; align-items: center; justify-content: center;
|
||||
gap: .5rem; flex-direction: column; font-weight: 600;
|
||||
}
|
||||
.add-dashed:hover { border-color: #f59e0b; color: #f59e0b; background: #fffbeb; }
|
||||
.leaflet-container { border-radius: 8px; }
|
||||
.leaflet-top, .leaflet-bottom { z-index: 50 !important; }
|
||||
#ss-connect-dialog, .shiny-disconnected-overlay { display: none !important; }
|
||||
")),
|
||||
|
||||
shiny::tags$script(shiny::HTML("
|
||||
$(document).on('shown.bs.modal', function() {
|
||||
setTimeout(function() { window.dispatchEvent(new Event('resize')); }, 150);
|
||||
});
|
||||
|
||||
history.pushState({bk: true}, '');
|
||||
window.addEventListener('popstate', function() {
|
||||
history.pushState({bk: true}, '');
|
||||
if (window.Shiny) Shiny.setInputValue('nav_back', Date.now(), {priority: 'event'});
|
||||
});
|
||||
|
||||
setInterval(function() {
|
||||
if (window.Shiny && Shiny.shinyapp && Shiny.shinyapp.isConnected())
|
||||
Shiny.setInputValue('keepalive_ping', Date.now());
|
||||
}, 25000);
|
||||
")),
|
||||
shiny::uiOutput("nav_header"),
|
||||
shiny::div(class = "bk-content",
|
||||
shiny::uiOutput("screen_content")
|
||||
)
|
||||
)
|
||||
}
|
||||
@@ -0,0 +1,101 @@
|
||||
`%||%` <- function(a, b) if (!is.null(a) && length(a) > 0 && !is.na(a[1]) && a[1] != "") a else b
|
||||
|
||||
colony_status_label <- function(status) {
|
||||
labels <- c(
|
||||
wirtschaftsvolk = "Wirtschaftsvolk",
|
||||
ableger = "Ableger",
|
||||
jungvolk = "Jungvolk",
|
||||
schwarmstimmung = "Schwarmstimmung",
|
||||
eingegangen = "Eingegangen"
|
||||
)
|
||||
labels[status] %||% status
|
||||
}
|
||||
|
||||
colony_status_color <- function(status) {
|
||||
colors <- c(
|
||||
wirtschaftsvolk = "success",
|
||||
ableger = "info",
|
||||
jungvolk = "warning",
|
||||
schwarmstimmung = "danger",
|
||||
eingegangen = "secondary"
|
||||
)
|
||||
colors[status] %||% "secondary"
|
||||
}
|
||||
|
||||
colony_status_badge <- function(status) {
|
||||
sprintf(
|
||||
'<span class="badge bg-%s">%s</span>',
|
||||
colony_status_color(status),
|
||||
colony_status_label(status)
|
||||
)
|
||||
}
|
||||
|
||||
trait_label <- function(trait) {
|
||||
labels <- c(
|
||||
sanftmut = "Sanftmut",
|
||||
schwarmtrieb = "Schwarmtrieb",
|
||||
wabensitz = "Wabensitz",
|
||||
honigertrag = "Honigertrag",
|
||||
varroa_hygiene = "Varroa-Hygiene"
|
||||
)
|
||||
labels[trait] %||% trait
|
||||
}
|
||||
|
||||
COLONY_STATUSES <- c(
|
||||
"Wirtschaftsvolk" = "wirtschaftsvolk",
|
||||
"Ableger" = "ableger",
|
||||
"Jungvolk" = "jungvolk",
|
||||
"Schwarmstimmung" = "schwarmstimmung",
|
||||
"Eingegangen" = "eingegangen"
|
||||
)
|
||||
|
||||
TRAITS <- c(
|
||||
"Sanftmut" = "sanftmut",
|
||||
"Schwarmtrieb" = "schwarmtrieb",
|
||||
"Wabensitz" = "wabensitz",
|
||||
"Honigertrag" = "honigertrag",
|
||||
"Varroa-Hygiene" = "varroa_hygiene"
|
||||
)
|
||||
|
||||
VARROA_PRODUCTS <- c("Ameisensäure", "Oxalsäure", "Thymol", "Apibioxal", "MAQS")
|
||||
|
||||
VARROA_APPLICATION_METHODS <- list(
|
||||
"Ameisensäure" = c("Kurzzeitbehandlung (4h)", "Langzeitbehandlung (3 Wo.)", "Schwammtuch"),
|
||||
"Oxalsäure" = c("Träufeln", "Sublimation / Verdampfen", "Sprühen"),
|
||||
"Thymol" = c("Apilife VAR", "Thymovar", "Thymol-Kristalle"),
|
||||
"Apibioxal" = c("Träufeln", "Sublimation / Verdampfen"),
|
||||
"MAQS" = c("Streifen-Einlage")
|
||||
)
|
||||
|
||||
VARROA_METHODS <- c(
|
||||
"Natürlicher Totenfall" = "natuerlicher_totenfall",
|
||||
"Alkoholwäsche" = "alkoholwaesche",
|
||||
"Puderzucker" = "puderzucker"
|
||||
)
|
||||
|
||||
HONEY_TYPES <- c(
|
||||
"Frühtracht" = "fruehtracht",
|
||||
"Sommertracht" = "sommertracht",
|
||||
"Waldhonig" = "waldhonig",
|
||||
"Rapshonig" = "rapshonig",
|
||||
"Akazienhonig" = "akazienhonig",
|
||||
"Sonstiges" = "sonstiges"
|
||||
)
|
||||
|
||||
COLONY_ACTION_TYPES <- c(
|
||||
"Ablegerbildung" = "ablegerbildung",
|
||||
"Zwischenbödenableger" = "zwischenbodenableger",
|
||||
"Brutentnahme" = "brutentnahme",
|
||||
"Standwechsel" = "standwechsel",
|
||||
"Fütterung" = "futterung",
|
||||
"Völkervereinigung" = "vereinigung",
|
||||
"Sonstige Maßnahme" = "sonstiges"
|
||||
)
|
||||
|
||||
QUEEN_COLORS <- c(
|
||||
"Weiß (2021, 2026)" = "weiss",
|
||||
"Gelb (2022, 2027)" = "gelb",
|
||||
"Rot (2023, 2028)" = "rot",
|
||||
"Grün (2024, 2029)" = "gruen",
|
||||
"Blau (2025, 2030)" = "blau"
|
||||
)
|
||||
@@ -0,0 +1,156 @@
|
||||
# ---- Stepper ----------------------------------------------------------------
|
||||
|
||||
stepper_row <- function(ns, id, label) {
|
||||
shiny::div(
|
||||
class = "d-flex justify-content-between align-items-center py-3 border-bottom",
|
||||
shiny::span(label, class = "fw-semibold"),
|
||||
shiny::div(
|
||||
class = "d-flex align-items-center gap-3",
|
||||
shiny::actionButton(ns(paste0(id, "_minus")), "−",
|
||||
class = "btn btn-outline-secondary rounded-circle p-0",
|
||||
style = "width:44px;height:44px;font-size:1.3rem;line-height:1"
|
||||
),
|
||||
shiny::uiOutput(ns(paste0(id, "_disp")), inline = TRUE),
|
||||
shiny::actionButton(ns(paste0(id, "_plus")), "+",
|
||||
class = "btn btn-outline-secondary rounded-circle p-0",
|
||||
style = "width:44px;height:44px;font-size:1.3rem;line-height:1"
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
stepper_server <- function(id, input, output, default = NA_integer_) {
|
||||
val <- reactiveVal(default)
|
||||
observeEvent(input[[paste0(id, "_plus")]], {
|
||||
v <- val(); val(if (is.na(v)) 1L else v + 1L)
|
||||
}, ignoreInit = TRUE)
|
||||
observeEvent(input[[paste0(id, "_minus")]], {
|
||||
v <- val(); if (!is.na(v) && v > 0) val(v - 1L)
|
||||
}, ignoreInit = TRUE)
|
||||
output[[paste0(id, "_disp")]] <- renderUI({
|
||||
v <- val()
|
||||
shiny::tags$span(class = "stepper-val",
|
||||
if (is.na(v)) "–" else as.character(v))
|
||||
})
|
||||
val
|
||||
}
|
||||
|
||||
# ---- Info popover -----------------------------------------------------------
|
||||
|
||||
info_icon <- function(title, content) {
|
||||
bslib::popover(
|
||||
trigger = shiny::icon("circle-info",
|
||||
style = paste(
|
||||
"cursor:pointer;color:#6c757d;font-size:.8em;",
|
||||
"margin-left:.35rem;vertical-align:middle"
|
||||
)
|
||||
),
|
||||
title = title,
|
||||
content,
|
||||
placement = "auto"
|
||||
)
|
||||
}
|
||||
|
||||
# ---- Button-group selector (trait 1-4, strength 1-9, methods) --------------
|
||||
|
||||
btn_group_row <- function(ns, id, label, choices, info = NULL, stacked = FALSE) {
|
||||
label_el <- shiny::tagList(label, if (!is.null(info)) info_icon(info$title, info$content))
|
||||
if (stacked) {
|
||||
shiny::div(
|
||||
class = "py-2 border-bottom",
|
||||
shiny::div(class = "fw-semibold mb-2", label_el),
|
||||
shiny::uiOutput(ns(paste0(id, "_btns")))
|
||||
)
|
||||
} else {
|
||||
shiny::div(
|
||||
class = "d-flex justify-content-between align-items-center py-2 border-bottom",
|
||||
shiny::span(class = "fw-semibold", label_el),
|
||||
shiny::uiOutput(ns(paste0(id, "_btns")), inline = TRUE)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
btn_group_server <- function(id, ns, input, output, choices, default = NA) {
|
||||
val <- reactiveVal(default)
|
||||
lapply(seq_along(choices), function(i) {
|
||||
observeEvent(input[[paste0(id, "_", i)]], {
|
||||
if (identical(val(), choices[[i]])) val(NA) else val(choices[[i]])
|
||||
}, ignoreInit = TRUE)
|
||||
})
|
||||
output[[paste0(id, "_btns")]] <- renderUI({
|
||||
v <- val()
|
||||
shiny::div(
|
||||
class = "d-flex flex-wrap gap-1",
|
||||
lapply(seq_along(choices), function(i) {
|
||||
selected <- !is.na(v) && identical(v, choices[[i]])
|
||||
cls <- if (selected) "btn btn-sm btn-primary" else "btn btn-sm btn-outline-secondary"
|
||||
shiny::actionButton(ns(paste0(id, "_", i)), names(choices)[i],
|
||||
class = cls, style = "min-width:38px;min-height:38px")
|
||||
})
|
||||
)
|
||||
})
|
||||
val
|
||||
}
|
||||
|
||||
trait_row <- function(ns, id, label, info = NULL) btn_group_row(ns, id, label, stats::setNames(1:4, 1:4), info = info)
|
||||
trait_server <- function(id, ns, input, output) btn_group_server(id, ns, input, output, stats::setNames(1:4, 1:4))
|
||||
|
||||
STRENGTH_INFO <- list(
|
||||
title = "Volksstärke (1–9)",
|
||||
content = shiny::tagList(
|
||||
shiny::tags$p("Schätzung der Bienenmenge nach Liebefeld-Methode:"),
|
||||
shiny::tags$table(class = "table table-sm table-borderless mb-0",
|
||||
shiny::tags$tbody(
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1–2"), .noWS = "after"), shiny::tags$td("sehr schwaches Volk")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3–4"), .noWS = "after"), shiny::tags$td("schwaches bis mittleres Volk")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("5–6"), .noWS = "after"), shiny::tags$td("mittleres bis starkes Volk")),
|
||||
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("7–9"), .noWS = "after"), shiny::tags$td("sehr starkes Volk"))
|
||||
)
|
||||
),
|
||||
shiny::tags$p(class = "mt-2 mb-0 text-muted small", "Winterüberwinterung: mind. 4–5 anstreben.")
|
||||
)
|
||||
)
|
||||
|
||||
strength_row <- function(ns, id = "strength") btn_group_row(ns, id, "Volksstärke", stats::setNames(1:9, 1:9), info = STRENGTH_INFO, stacked = TRUE)
|
||||
strength_server <- function(id = "strength", ns, input, output) btn_group_server(id, ns, input, output, stats::setNames(1:9, 1:9))
|
||||
|
||||
# ---- Toggle (checkbox styled as switch) ------------------------------------
|
||||
|
||||
toggle_row <- function(ns, id, label) {
|
||||
shiny::div(
|
||||
class = "bk-check d-flex justify-content-between align-items-center py-3 border-bottom",
|
||||
shiny::tags$label(class = "fw-semibold", `for` = ns(id), label),
|
||||
shiny::checkboxInput(ns(id), NULL, value = FALSE)
|
||||
)
|
||||
}
|
||||
|
||||
# ---- Section card -----------------------------------------------------------
|
||||
|
||||
section_card <- function(header = NULL, ...) {
|
||||
bslib::card(
|
||||
class = "mb-3",
|
||||
if (!is.null(header)) bslib::card_header(header),
|
||||
bslib::card_body(class = "px-2 py-0", ...)
|
||||
)
|
||||
}
|
||||
|
||||
# ---- Collapsible card (Bootstrap collapse) ----------------------------------
|
||||
|
||||
collapsible_card <- function(header, ..., collapse_id, open = FALSE) {
|
||||
shiny::tags$div(class = "card mb-3",
|
||||
shiny::tags$div(
|
||||
class = paste("card-header d-flex justify-content-between align-items-center collapse-toggle",
|
||||
if (!open) "collapsed"),
|
||||
`data-bs-toggle` = "collapse",
|
||||
`data-bs-target` = paste0("#", collapse_id),
|
||||
`aria-expanded` = tolower(as.character(open)),
|
||||
shiny::tags$span(class = "fw-semibold small text-uppercase text-muted", header),
|
||||
shiny::tags$i(class = "fa fa-chevron-down collapse-chevron text-muted ms-2")
|
||||
),
|
||||
shiny::tags$div(
|
||||
id = collapse_id,
|
||||
class = if (open) "collapse show" else "collapse",
|
||||
shiny::tags$div(class = "card-body px-2 py-0", ...)
|
||||
)
|
||||
)
|
||||
}
|
||||
@@ -0,0 +1,2 @@
|
||||
pkgload::load_all()
|
||||
beekeeper::run_app()
|
||||
@@ -0,0 +1,17 @@
|
||||
Version: 1.0
|
||||
|
||||
RestoreWorkspace: Default
|
||||
SaveWorkspace: Default
|
||||
AlwaysSaveHistory: Default
|
||||
|
||||
EnableCodeIndexing: Yes
|
||||
UseSpacesForTab: Yes
|
||||
NumSpacesForTab: 2
|
||||
Encoding: UTF-8
|
||||
|
||||
RnwWeave: Sweave
|
||||
LaTeX: pdfLaTeX
|
||||
|
||||
BuildType: Package
|
||||
PackageUseDevtools: Yes
|
||||
PackageInstallArgs: --no-multiarch --with-keep.source
|
||||
Reference in New Issue
Block a user