add homekeeper stack

This commit is contained in:
2026-07-06 19:25:38 +02:00
commit 58983e6855
90 changed files with 6816 additions and 0 deletions
+14
View File
@@ -0,0 +1,14 @@
Package: listkeeper
Title: Listen- und Aufgabenverwaltung
Version: 0.2.0
Authors@R: person("Nico", "Friess", email = "nico.friess@googlemail.com", role = c("aut", "cre"))
Description: Shiny-Anwendung zur Verwaltung von Einkaufslisten, Aufgaben und Projekten.
License: MIT + file LICENSE
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.2
Imports:
bslib,
httr2,
jsonlite,
shiny
+15
View File
@@ -0,0 +1,15 @@
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/*
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", "listkeeper::run_app()"]
+3
View File
@@ -0,0 +1,3 @@
export(run_app)
import(shiny)
import(bslib)
+10
View File
@@ -0,0 +1,10 @@
# listkeeper 0.2.0
- API-Schicht (FastAPI) zwischen App und Datenbank; alle Zugriffe über httr2
- Performance: Item-Counts per Subquery im Listen-Endpoint, Items werden lazy beim Aufklappen geladen
- Logging: JSONL-Logdatei in `./logs/YYYY-MM-DD_log.jsonl`
- Port über `PORT`-Umgebungsvariable konfigurierbar
# listkeeper 0.1.0
- Initiale Version: Einkaufslisten, Aufgabenlisten, Projekte mit T-Shirt-Größen
+88
View File
@@ -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)
}
+21
View File
@@ -0,0 +1,21 @@
#' @export
run_app <- function(host = "0.0.0.0", port = as.integer(Sys.getenv("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)
}
+15
View File
@@ -0,0 +1,15 @@
db_items_by_list <- function(db, list_id) {
api_get(db, paste0("/v1/lists/", list_id, "/items"))
}
db_items_insert <- function(db, list_id, text) {
api_post(db, paste0("/v1/lists/", list_id, "/items"), list(text = text))
}
db_items_set_checked <- function(db, id, checked) {
api_patch(db, paste0("/v1/lists/items/", id), list(checked = isTRUE(checked)))
}
db_items_delete <- function(db, id) {
api_delete(db, paste0("/v1/lists/items/", id))
}
+24
View File
@@ -0,0 +1,24 @@
db_lists_get_all <- function(db, include_closed = FALSE) {
api_get(db, "/v1/lists", list(include_closed = include_closed))
}
db_lists_insert <- function(db, name, type, t_shirt_size = NA, notes = NA) {
api_post(db, "/v1/lists", list(
name = name,
type = type,
t_shirt_size = t_shirt_size,
notes = notes
))
}
db_lists_close <- function(db, id) {
api_post(db, paste0("/v1/lists/", id, "/close"))
}
db_lists_reopen <- function(db, id) {
api_post(db, paste0("/v1/lists/", id, "/reopen"))
}
db_lists_delete <- function(db, id) {
api_delete(db, paste0("/v1/lists/", id))
}
+1
View File
@@ -0,0 +1 @@
db_migrate <- function(db) invisible(NULL)
+36
View File
@@ -0,0 +1,36 @@
.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("listkeeper")),
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))
entry <- c(
list(ts = format(Sys.time(), "%Y-%m-%dT%H:%M:%OS3"), level = level, msg = msg),
list(...)
)
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, ...)
+301
View File
@@ -0,0 +1,301 @@
screen_home_ui <- function(id) {
ns <- NS(id)
shiny::tagList(
shiny::uiOutput(ns("filter_row")),
shiny::div(class = "mb-3",
shiny::checkboxInput(ns("show_closed"), "Erledigte anzeigen", value = FALSE)
),
shiny::uiOutput(ns("list_cards")),
shiny::br(),
shiny::actionButton(ns("new_btn"),
shiny::tagList(shiny::icon("plus"), " Neue Liste"),
class = "btn btn-primary w-100",
style = "min-height:50px"
)
)
}
screen_home_server <- function(id, db) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
reload <- reactiveVal(0)
type_filter <- reactiveVal("")
expanded <- reactiveVal(integer(0))
# ---- Filter chips --------------------------------------------------------
FILTERS <- list(
list(lbl = "Alle", val = ""),
list(lbl = "Einkaufen", val = "shopping"),
list(lbl = "Aufgaben", val = "todo"),
list(lbl = "Projekte", val = "project")
)
output$filter_row <- renderUI({
cur <- type_filter()
shiny::div(class = "d-flex gap-2 mb-3 flex-wrap",
lapply(seq_along(FILTERS), function(i) {
f <- FILTERS[[i]]
active <- identical(cur, f$val)
shiny::actionButton(ns(paste0("f_", i)), f$lbl,
class = if (active) "btn btn-primary btn-sm" else "btn btn-outline-secondary btn-sm"
)
})
)
})
observe({
lapply(seq_along(FILTERS), function(i) {
local({
li <- i; val <- FILTERS[[li]]$val
observeEvent(input[[paste0("f_", li)]], type_filter(val), ignoreInit = TRUE)
})
})
})
# ---- Data ----------------------------------------------------------------
lists <- reactive({
reload()
db_lists_get_all(db, include_closed = isTRUE(input$show_closed))
})
filtered <- reactive({
ls <- lists()
tf <- type_filter()
if (!is.null(tf) && tf != "") ls[ls$type == tf, ] else ls
})
# ---- Card interactions ---------------------------------------------------
observeEvent(input$expand, {
id <- as.integer(input$expand)
cur <- expanded()
expanded(if (id %in% cur) setdiff(cur, id) else c(cur, id))
})
observeEvent(input$item_toggle, {
req(input$item_toggle)
db_items_set_checked(db,
id = as.integer(input$item_toggle$id),
checked = isTRUE(input$item_toggle$checked)
)
reload(reload() + 1L)
})
observeEvent(input$add_item, {
req(input$add_item)
txt <- trimws(input$add_item$text %||% "")
if (nchar(txt) == 0) return()
db_items_insert(db,
list_id = as.integer(input$add_item$list_id),
text = txt
)
reload(reload() + 1L)
})
observeEvent(input$close_list, {
req(input$close_list)
db_lists_close(db, id = as.integer(input$close_list))
reload(reload() + 1L)
})
observeEvent(input$reopen_list, {
req(input$reopen_list)
db_lists_reopen(db, id = as.integer(input$reopen_list))
reload(reload() + 1L)
})
observeEvent(input$delete_list, {
req(input$delete_list)
db_lists_delete(db, id = as.integer(input$delete_list))
expanded(setdiff(expanded(), as.integer(input$delete_list)))
reload(reload() + 1L)
})
# ---- Render cards --------------------------------------------------------
output$list_cards <- renderUI({
ls <- filtered()
exp <- expanded()
if (nrow(ls) == 0)
return(shiny::p(class = "text-muted text-center py-4", "Keine Listen vorhanden."))
lapply(seq_len(nrow(ls)), function(i) {
row <- ls[i, ]
is_exp <- row$id %in% exp
is_cls <- !is.na(row$closed_at)
n_tot <- as.integer(row$item_count %||% 0L)
n_chk <- as.integer(row$checked_count %||% 0L)
items <- if (is_exp) db_items_by_list(db, row$id) else data.frame()
type_cls <- switch(row$type,
shopping = "bg-warning text-dark",
todo = "bg-primary",
project = "bg-info text-dark",
"bg-secondary"
)
type_lbl <- switch(row$type,
shopping = "Einkaufen",
todo = "Aufgaben",
project = "Projekt",
row$type
)
# Header (always visible, tappable to expand)
hdr <- shiny::div(
class = paste("tap-card d-flex justify-content-between align-items-center py-2 px-3",
if (is_cls) "bg-light" else "bg-white"),
style = "border-bottom: 1px solid rgba(0,0,0,.125);",
onclick = sprintf("Shiny.setInputValue('%s', %d, {priority:'event'})", ns("expand"), row$id),
shiny::div(class = "d-flex align-items-center gap-2 overflow-hidden",
shiny::HTML(sprintf('<span class="badge %s flex-shrink-0">%s</span>', type_cls, type_lbl)),
shiny::tags$strong(
class = paste("text-truncate", if (is_cls) "text-muted" else ""),
row$name
),
if (!is.na(row$t_shirt_size))
shiny::HTML(sprintf('<span class="badge bg-secondary flex-shrink-0">%s</span>', row$t_shirt_size))
else NULL
),
shiny::div(class = "d-flex align-items-center gap-2 flex-shrink-0 ms-2",
shiny::tags$small(class = "text-muted",
if (n_tot > 0) sprintf("%d/%d", n_chk, n_tot) else "leer"
),
shiny::icon(if (is_exp) "chevron-up" else "chevron-down", class = "text-muted")
)
)
# Body (only when expanded)
bdy <- if (is_exp) {
item_rows <- if (nrow(items) > 0) {
lapply(seq_len(n_tot), function(j) {
it <- items[j, ]
shiny::div(
class = "item-row d-flex align-items-start gap-2 py-2 px-3",
shiny::tags$input(
type = "checkbox",
class = "form-check-input mt-1 flex-shrink-0",
style = "width:1.1rem;height:1.1rem;cursor:pointer",
checked = if (isTRUE(it$checked)) NA else NULL,
onclick = sprintf(
"Shiny.setInputValue('%s',{id:%d,checked:this.checked},{priority:'event'})",
ns("item_toggle"), it$id
)
),
shiny::tags$span(
class = if (isTRUE(it$checked))
"flex-grow-1 text-muted text-decoration-line-through"
else "flex-grow-1",
it$text
)
)
})
} else {
list(shiny::p(class = "text-muted small px-3 py-2 mb-0", "Noch keine Einträge."))
}
inp_id <- sprintf("lk_inp_%d", row$id)
add_row <- shiny::div(class = "d-flex gap-2 px-3 pt-2 pb-1",
shiny::tags$input(
type = "text",
id = inp_id,
class = "form-control form-control-sm",
placeholder = "Neuer Eintrag...",
onkeyup = sprintf(
"if(event.key==='Enter'){var v=this.value.trim();if(v){Shiny.setInputValue('%s',{list_id:%d,text:v,ts:Date.now()},{priority:'event'});this.value='';}}",
ns("add_item"), row$id
)
),
shiny::tags$button(
type = "button",
class = "btn btn-outline-primary btn-sm flex-shrink-0",
onclick = sprintf(
"(function(i){var v=i.value.trim();if(v){Shiny.setInputValue('%s',{list_id:%d,text:v,ts:Date.now()},{priority:'event'});i.value='';}})(document.getElementById('%s'))",
ns("add_item"), row$id, inp_id
),
shiny::icon("plus")
)
)
footer_btns <- shiny::div(
class = "d-flex justify-content-between align-items-center px-3 py-2 bg-light border-top",
if (!is_cls) {
shiny::tags$button(
type = "button",
class = "btn btn-success btn-sm",
onclick = sprintf("Shiny.setInputValue('%s',%d,{priority:'event'})", ns("close_list"), row$id),
shiny::icon("check"), " Erledigt"
)
} else {
shiny::tags$button(
type = "button",
class = "btn btn-outline-secondary btn-sm",
onclick = sprintf("Shiny.setInputValue('%s',%d,{priority:'event'})", ns("reopen_list"), row$id),
shiny::icon("undo"), " Wieder öffnen"
)
},
shiny::tags$button(
type = "button",
class = "btn btn-outline-danger btn-sm",
onclick = sprintf(
"if(confirm('Liste und alle Einträge löschen?'))Shiny.setInputValue('%s',%d,{priority:'event'})",
ns("delete_list"), row$id
),
shiny::icon("trash")
)
)
shiny::div(
shiny::tagList(item_rows),
add_row,
footer_btns
)
} else NULL
shiny::div(class = "card mb-2 shadow-sm", hdr, bdy)
})
})
# ---- New list modal ------------------------------------------------------
observeEvent(input$new_btn, {
shiny::showModal(shiny::modalDialog(
title = "Neue Liste",
footer = shiny::tagList(
shiny::modalButton("Abbrechen"),
shiny::actionButton(ns("confirm_new"), "Erstellen", class = "btn-primary")
),
shiny::textInput(ns("new_name"), "Name *"),
shiny::selectInput(ns("new_type"), "Typ",
choices = c("Einkaufen" = "shopping", "Aufgaben" = "todo", "Projekt" = "project"),
selected = "shopping"
),
shiny::uiOutput(ns("new_extra_ui"))
))
})
output$new_extra_ui <- renderUI({
req(input$new_type)
if (input$new_type == "project") {
shiny::selectInput(ns("new_size"), "Aufwand (T-Shirt-Größe)",
choices = c("XS", "S", "M", "L", "XL"),
selected = "M"
)
}
})
observeEvent(input$confirm_new, {
name <- trimws(input$new_name %||% "")
if (nchar(name) == 0) {
shiny::showNotification("Bitte einen Namen eingeben.", type = "warning", duration = 3)
return()
}
t_size <- if (!is.null(input$new_type) && input$new_type == "project")
input$new_size else NA
db_lists_insert(db,
name = name,
type = input$new_type,
t_shirt_size = t_size
)
shiny::removeModal()
reload(reload() + 1L)
})
})
}
+3
View File
@@ -0,0 +1,3 @@
server <- function(input, output, session, db) {
screen_home_server("s_home", db = db)
}
+35
View File
@@ -0,0 +1,35 @@
ui <- function() {
bslib::page(
fillable = FALSE,
title = "Listen",
theme = bslib::bs_theme(version = 5),
shiny::tags$head(
shiny::tags$meta(name = "viewport", content = "width=device-width, initial-scale=1"),
shiny::tags$style(shiny::HTML("
body { background: #f8f9fa !important; }
.bk-header {
background: #fff;
border-bottom: 1px solid #dee2e6;
padding: .75rem 1rem;
position: sticky;
top: 0;
z-index: 100;
}
.tap-card { cursor: pointer; }
.tap-card:active { opacity: .8; }
.card { overflow: hidden; }
.item-row { border-bottom: 1px solid #f0f0f0; }
.item-row:last-child { border-bottom: none; }
#ss-connect-dialog, .shiny-disconnected-overlay { display: none !important; }
"))
),
shiny::div(
class = "bk-header d-flex justify-content-between align-items-center",
shiny::tags$h4(class = "mb-0", "Listen")
),
shiny::div(
class = "container-fluid p-3",
screen_home_ui("s_home")
)
)
}
+1
View File
@@ -0,0 +1 @@
`%||%` <- function(a, b) if (!is.null(a) && length(a) > 0 && !is.na(a[1])) a else b