madeliri/shiny_form
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: манипуляции со схемами через R6 объект а не танцы с листами и вложенными таблицами

Browse Source
This commit is contained in:
madeliri
2026-04-10 23:33:50 +03:00
parent 04e8242b56
commit 31294f1958
5 changed files with 250 additions and 163 deletions
Download Patch File Download Diff File Expand all files Collapse all files

165
app.R
View File

@@ -10,6 +10,7 @@ suppressPackageStartupMessages({
})
source("helpers/functions.R")
source("helpers/scheme_generator.R")
# box::purge_cache()
# box::use(./helpers/db)
@@ -40,106 +41,41 @@ rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
# TODO: dynamic button render depend on pandoc installation
if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!")
load_scheme_from_xlsx <- function(
sheet_name
) {
colnames <- switch(sheet_name,
"main" = c("part", "subgroup", "form_id", "form_label", "form_type"),
c("subgroup", "form_id", "form_label", "form_type")
)
readxl::read_xlsx(FILE_SCHEME, sheet = sheet_name) |>
# fill NA down
tidyr::fill(all_of(colnames), .direction = "down") |>
dplyr::group_by(form_id) |>
tidyr::fill(c(condition, required), .direction = "down") |>
dplyr::ungroup()
}
extract_forms_id_and_types_from_scheme <- function(scheme, drop_key = c("main_key", "nested_key")) {
drop_key <- match.arg(drop_key)
form_id_and_types_list <- scheme |>
dplyr::filter(!form_type %in% c("inline_table", "nested_forms","description", "description_header")) |>
dplyr::distinct(form_id, form_type) |>
tibble::deframe()
if(!drop_key %in% names(form_id_and_types_list)) cli::cli_abort("в схеме должно быть поле с ключем (key)")
form_id_and_types_list[names(form_id_and_types_list) != drop_key]
}
# SCHEME_MAIN UNPACK ==========================
# load scheme
SCHEMES_LIST <- list()
SCHEMES_LIST[["main"]] <- load_scheme_from_xlsx("main")
schm <- scheme_R6$new(FILE_SCHEME)
object.size(schm)
schm$get_key_id("main")
schm$get_forms_ids("main")
schm$get_all_ids("main")
# get list of simple inputs
main_id_and_types_list <- extract_forms_id_and_types_from_scheme(SCHEMES_LIST[["main"]])
schm$get_schema("main")
nested_forms_df <- SCHEMES_LIST[["main"]] |>
dplyr::filter(form_type == "nested_forms") |>
dplyr::distinct(form_id, .keep_all = TRUE)
schm$get_id_type_list("allergo_anamnesis")
# лист со схемами для всех вложенных формы
purrr::walk(
# active
schm$get_main_key_id
schm$all_tables_names
.x = purrr::set_names(unique(nested_forms_df$form_id)),
.f = \(nested_form_id) {
nested_form_scheme_sheet_name <- nested_forms_df |>
dplyr::filter(form_id == {nested_form_id}) |>
dplyr::pull(choices)
# загрузка схемы для данной вложенной формы
SCHEMES_LIST[[nested_form_id]] <<- load_scheme_from_xlsx(nested_form_scheme_sheet_name)
}
)
# establish connection
con <- db$make_db_connection()
# init DB (write dummy data to "main" table)
db$check_if_table_is_exist_and_init_if_not("main", main_id_and_types_list)
purrr::walk(
.x = unique(nested_forms_df$form_id),
.f = \(table_name) {
this_inline_table2_info <- nested_forms_df |>
dplyr::filter(form_id == {table_name})
# получение имя файла с таблицой
nested_form_scheme_sheet_name <- this_inline_table2_info$choices
# загрузка схемы для данной вложенной формы
this_nested_form_scheme <- load_scheme_from_xlsx(nested_form_scheme_sheet_name)
this_table_id_and_types_list <- extract_forms_id_and_types_from_scheme(this_nested_form_scheme, "nested_key")
db$check_if_table_is_exist_and_init_if_not(
table_name,
this_table_id_and_types_list,
con = con
)
}
)
# db$check_if_table_is_exist_and_init_if_not("main", main_id_and_types_list)
db$check_if_table_is_exist_and_init_if_not(schm, con)
# close connection to prevent data loss
db$close_db_connection(con)
# generate nav panels for each page
nav_panels_list <- purrr::map(
.x = unique(SCHEMES_LIST[["main"]]$part),
.x = unique(schm$get_schema("main")$part),
.f = \(page_name) {
# отделить схему для каждой страницы
this_page_panels_scheme <- SCHEMES_LIST[["main"]] |>
this_page_panels_scheme <- schm$get_schema("main") |>
dplyr::filter(!form_id %in% c("main_key", "nested_key")) |>
dplyr::filter(part == {{page_name}})
@@ -270,6 +206,7 @@ server <- function(input, output, session) {
con
) {
nested_key_id <- schm$get_key_id(table_name)
input_types <- unname(id_and_types_list)
input_ids <- names(id_and_types_list)
@@ -306,7 +243,7 @@ server <- function(input, output, session) {
if (table_name == "main") {
exported_df <- exported_df |>
mutate(
main_key = values$main_key,
!!dplyr::sym(schm$get_main_key_id) := values$main_key,
.before = 1
)
}
@@ -315,8 +252,8 @@ server <- function(input, output, session) {
if (table_name != "main") {
exported_df <- exported_df |>
mutate(
main_key = values$main_key,
nested_key = values$nested_key,
!!dplyr::sym(schm$get_main_key_id) := values$main_key,
!!dplyr::sym(nested_key_id) := values$nested_key,
.before = 1
)
}
@@ -327,9 +264,9 @@ server <- function(input, output, session) {
db$write_df_to_db(
df = exported_df,
table_name = table_name,
scheme = SCHEMES_LIST[[table_name]],
main_key = values$main_key,
nested_key = values$nested_key,
schm = schm,
main_key_value = values$main_key,
nested_key_value = values$nested_key,
con = con
)
}
@@ -339,7 +276,7 @@ server <- function(input, output, session) {
# ====================================
## кнопки для каждой вложенной таблицы -------------------------------
purrr::walk(
.x = nested_forms_df$form_id,
.x = schm$nested_tables_names,
.f = \(nested_form_id) {
observeEvent(input[[nested_form_id]], {
@@ -350,7 +287,6 @@ server <- function(input, output, session) {
values$nested_form_id <- nested_form_id
values$nested_key <- NULL # для нормальной работы реактивных значений
show_modal_for_nested_form(con)
})
@@ -363,8 +299,8 @@ server <- function(input, output, session) {
ns <- NS(values$nested_form_id)
# загрузка схемы для данной вложенной формы
this_nested_form_scheme <- SCHEMES_LIST[[values$nested_form_id]]
values$nested_id_and_types <- extract_forms_id_and_types_from_scheme(this_nested_form_scheme, "nested_key")
this_nested_form_scheme <- schm$get_schema(values$nested_form_id)
values$nested_id_and_types <- schm$get_id_type_list(values$nested_form_id)
# мини-схема для ключа
this_nested_form_key_scheme <- subset(this_nested_form_scheme, form_id == "nested_key")
@@ -451,7 +387,7 @@ server <- function(input, output, session) {
con = con
)
col_types <- SCHEMES_LIST[[values$nested_form_id]] |>
col_types <- schm$get_schema(values$nested_form_id) |>
dplyr::distinct(form_id, form_type, form_label)
date_cols <- subset(col_types, form_type == "date", form_id, drop = TRUE)
@@ -518,9 +454,9 @@ server <- function(input, output, session) {
db$write_df_to_db(
df = export_df,
table_name = values$nested_form_id,
scheme = SCHEMES_LIST[[values$nested_form_id]],
main_key = values$main_key,
nested_key = NULL,
schm = schm,
main_key_value = values$main_key,
nested_key_value = NULL,
con = con
)
@@ -540,7 +476,7 @@ server <- function(input, output, session) {
# сохраняем данные основной формы!!!
save_inputs_to_db(
table_name = "main",
id_and_types_list = main_id_and_types_list,
id_and_types_list = schm$get_id_type_list("main"),
con = con
)
@@ -600,7 +536,7 @@ server <- function(input, output, session) {
removeModal()
# та самая форма для ключа
scheme_for_key_input <- SCHEMES_LIST[[values$nested_form_id]] |>
scheme_for_key_input <- schm$get_schema(values$nested_form_id) |>
dplyr::filter(form_id %in% c("nested_key"))
ui1 <- rlang::exec(
@@ -650,7 +586,7 @@ server <- function(input, output, session) {
# VALIDATIONS ============================
# create new validator
iv_main <- data_validation$init_val(SCHEMES_LIST[["main"]])
iv_main <- data_validation$init_val(schm$get_schema("main"))
iv_main$enable()
# STATUSES ===============================
@@ -673,7 +609,7 @@ server <- function(input, output, session) {
observeEvent(input$add_new_main_key_button, {
# данные для главного ключа
scheme_for_key_input <- SCHEMES_LIST[["main"]] |>
scheme_for_key_input <- schm$get_schema("main") |>
dplyr::filter(form_id == "main_key")
# создать форму для выбора ключа
@@ -714,7 +650,7 @@ server <- function(input, output, session) {
}
values$main_key <- input$main_key
utils$clean_forms(main_id_and_types_list)
utils$clean_forms(schm$get_id_type_list("main"))
removeModal()
})
@@ -729,7 +665,7 @@ server <- function(input, output, session) {
observeEvent(input$clean_all_action, {
# rewrite all inputs with empty data
utils$clean_forms(main_id_and_types_list)
utils$clean_forms(schm$get_id_type_list("main"))
removeModal()
showNotification("Данные очищены!", type = "warning")
@@ -744,7 +680,7 @@ server <- function(input, output, session) {
save_inputs_to_db(
table_name = "main",
id_and_types_list = main_id_and_types_list,
id_and_types_list = schm$get_id_type_list("main"),
con = con
)
@@ -811,7 +747,7 @@ server <- function(input, output, session) {
load_data_to_form(
df = df,
id_and_types_list = main_id_and_types_list
id_and_types_list = schm$get_id_type_list("main")
)
values$main_key <- input$load_data_key_selector
@@ -829,14 +765,14 @@ server <- function(input, output, session) {
# get all data
list_of_df <- purrr::map(
.x = purrr::set_names(c("main", unique(nested_forms_df$form_id))),
.x = purrr::set_names(schm$all_tables_names),
.f = \(x) {
df <- read_df_from_db_all(x, con) |>
tibble::as_tibble()
# handle with data
scheme <- SCHEMES_LIST[[x]]
scheme <- schm$get_schema(x)
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
@@ -890,7 +826,7 @@ server <- function(input, output, session) {
# iterate by scheme parts
purrr::walk(
.x = unique(SCHEMES_LIST[["main"]]$part),
.x = unique(schm$get_schema("main")$part),
.f = \(x_iter1) {
# write level 1 header
HEADER_1 <- paste("#", x_iter1, "\n")
@@ -898,14 +834,14 @@ server <- function(input, output, session) {
# iterate by level2 headers (subgroups)
purrr::walk(
.x = dplyr::pull(unique(subset(SCHEMES_LIST[["main"]], part == x_iter1, "subgroup"))),
.x = dplyr::pull(unique(subset(schm$get_schema("main"), part == x_iter1, "subgroup"))),
.f = \(x_iter2) {
# get header 2 name
HEADER_2 <- paste("##", x_iter2, "\n")
# for some reason set litle scheme...
litle_scheme <- subset(
x = SCHEMES_LIST[["main"]],
x = schm$get_schema("main"),
subset = part == x_iter1 & subgroup == x_iter2,
select = c("form_id", "form_label", "form_type")
) |>
@@ -989,30 +925,31 @@ server <- function(input, output, session) {
})
observeEvent(input$button_upload_data_from_xlsx_confirm, {
req(input$upload_xlsx
)
req(input$upload_xlsx)
con <- db$make_db_connection("button_upload_data_from_xlsx_confirm")
on.exit(db$close_db_connection(con, "button_upload_data_from_xlsx_confirm"), add = TRUE)
file <- input$upload_xlsx$datapath
# print(file)
wb <- openxlsx2::wb_load(file)
# проверка на наличие всех листов в файле
if (!all(names(SCHEMES_LIST) %in% openxlsx2::wb_get_sheet_names(wb))) {
if (!all(schm$all_tables_names %in% openxlsx2::wb_get_sheet_names(wb))) {
cli::cli_alert_warning("данные в файле '{file} не соответствуют схеме'")
return()
}
# проверка схемы --------------
for (table_name in names(SCHEMES_LIST)) {
for (table_name in schm$all_tables_names) {
df <- openxlsx2::read_xlsx(wb, table_name)
scheme <- SCHEMES_LIST[[table_name]] |>
scheme <- schm$get_schema(table_name) |>
filter(!form_type %in% c("description", "nested_forms"))
# столбцы в таблицы и схема
df_to_schema_compare <- setdiff(colnames(df), unique(scheme$form_id))
schema_to_df_compare <- setdiff(unique(scheme$form_id), colnames(df))
if (length(schema_to_df_compare) > 0 ) {
cli::cli_warn(c("в схеме для '{table_name}' нет следующих столбцов:", paste("- ", df_to_schema_compare)))
}
@@ -1030,10 +967,10 @@ server <- function(input, output, session) {
}
# обновление данных
for (table_name in names(SCHEMES_LIST)) {
for (table_name in schm$all_tables_names) {
df <- openxlsx2::read_xlsx(wb, table_name)
scheme <- SCHEMES_LIST[[table_name]] |>
scheme <- schm$get_schema(table_name) |>
filter(!form_type %in% c("description", "nested_forms"))
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)

2
configs/config.yml
View File

@@ -2,6 +2,6 @@ default:
header: "TEST"
version: "0.14.1"
# shiny serve option
shiny_host: "127.0.0.1"
shiny_host: "0.0.0.0"
shiny_port: 1337
auth_module: FALSE # default: FALSE

BIN
configs/schemas/example_inline.xlsx
View File

Binary file not shown.

123
helpers/scheme_generator.R Normal file
View File

@@ -0,0 +1,123 @@
#' @export
scheme_R6 <- R6::R6Class(
"schemes_f",
public = list(
initialize = function(scheme_file_path = NULL) {
private$scheme_file_path <- scheme_file_path
# make list of schemas
private$schemes_list <- list()
private$schemes_list[["main"]] <- private$load_scheme_from_xlsx("main")
# имена вложенных форм
private$nested_forms_names <- private$schemes_list[["main"]] |>
dplyr::filter(form_type == "nested_forms") |>
dplyr::distinct(form_id) |>
dplyr::pull(form_id)
purrr::walk(
.x = purrr::set_names(private$nested_forms_names),
.f = \(nested_form_id) {
nested_form_scheme_sheet_name <- private$schemes_list[["main"]] |>
dplyr::filter(form_id == {{nested_form_id}}) |>
dplyr::distinct(form_id, .keep_all = TRUE) |>
dplyr::pull(choices)
# загрузка схемы для данной вложенной формы
private$schemes_list[[nested_form_id]] <<- private$load_scheme_from_xlsx(nested_form_scheme_sheet_name)
}
)
# extract main key
private$main_key_id <- self$get_key_id("main")
},
get_all_ids = function(table_name) {
private$schemes_list[[table_name]] |>
dplyr::filter(!form_type %in% private$exluded_types) |>
dplyr::distinct(form_id) |>
dplyr::pull(form_id)
},
get_key_id = function(table_name) {
ids <- self$get_all_ids(table_name)
ids[1]
},
get_forms_ids = function(table_name) {
ids <- self$get_all_ids(table_name)
ids[-1]
},
extract_forms_id_and_types_from_scheme2 = function(scheme) {
form_id_and_types_list <- scheme |>
dplyr::filter(!form_type %in% private$exluded_types) |>
dplyr::distinct(form_id, form_type) |>
tibble::deframe()
list(
key = form_id_and_types_list[1],
form = form_id_and_types_list[-1]
)
},
# get_key_id = function(table_name) {
# self$extract_forms_id_and_types_from_scheme2(private$schemes_list[[table_name]])
# },
get_schema = function(table_name) {
private$schemes_list[[table_name]]
},
get_id_type_list = function(table_name) {
# wo main key
this_key_id <- self$get_key_id(table_name)
private$schemes_list[[table_name]] |>
dplyr::filter(!form_type %in% private$exluded_types) |>
dplyr::filter(form_id != {{this_key_id}}) |>
dplyr::distinct(form_id, form_type) |>
tibble::deframe()
}
),
active = list(
get_main_key_id = function() {
private$main_key_id
},
all_tables_names = function() {
c("main", private$nested_forms_names)
},
nested_tables_names = function() {
private$nested_forms_names
}
),
private = list(
scheme_file_path = NA,
schemes_list = NULL,
main_key_id = NA,
nested_forms_names = NA,
exluded_types = c("inline_table", "nested_forms","description", "description_header"),
load_scheme_from_xlsx = function(sheet_name) {
colnames <- switch(sheet_name,
"main" = c("part", "subgroup", "form_id", "form_label", "form_type"),
c("subgroup", "form_id", "form_label", "form_type")
)
readxl::read_xlsx(FILE_SCHEME, sheet = sheet_name) |>
# fill NA down
tidyr::fill(all_of(colnames), .direction = "down") |>
dplyr::group_by(form_id) |>
tidyr::fill(c(condition, required), .direction = "down") |>
dplyr::ungroup()
}
)
)

121
modules/db.R
View File

@@ -24,42 +24,56 @@ close_db_connection <- function(con, where = "") {
#' @description
#' Проверить если таблица есть в базе данных и инициировать ее, если от
check_if_table_is_exist_and_init_if_not <- function(
table_name,
forms_id_type_list,
schm,
con = rlang::env_get(rlang::caller_env(), nm = "con")
) {
if (table_name %in% DBI::dbListTables(con)) {
main_key <- schm$get_main_key_id
cli::cli_inform(c("*" = "таблица есть такая: '{table_name}'"))
purrr::walk(
.x = schm$all_tables_names,
.f = \(table_name, con) {
# если таблица существует, производим проверку структуры таблицы
compare_existing_table_with_schema(table_name, forms_id_type_list)
forms_id_type_list <- schm$get_id_type_list(table_name)
key_name <- schm$get_key_id(table_name)
} else {
if (table_name %in% DBI::dbListTables(con)) {
if (table_name == "main") {
dummy_df <- dplyr::mutate(
get_dummy_df(forms_id_type_list),
main_key = "dummy",
.before = 1
)
}
if (table_name != "main") {
dummy_df <- get_dummy_df(forms_id_type_list) |>
dplyr::mutate(
main_key = "dummy",
nested_key = "dummy",
.before = 1
cli::cli_inform(c("*" = "таблица есть такая: '{table_name}'"))
# если таблица существует, производим проверку структуры таблицы
compare_existing_table_with_schema(
table_name = table_name,
schm = schm
)
}
# write dummy df into base, then delete dummy row
DBI::dbWriteTable(con, table_name, dummy_df, append = TRUE)
DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE main_key = 'dummy'"))
} else {
cli::cli_alert_success("таблица '{table_name}' успешно создана")
}
if (table_name == "main") {
dummy_df <- get_dummy_df(forms_id_type_list) |>
dplyr::mutate(
!!dplyr::sym(main_key) := "dummy",
.before = 1
)
}
if (table_name != "main") {
dummy_df <- get_dummy_df(forms_id_type_list) |>
dplyr::mutate(
!!dplyr::sym(main_key) := "dummy",
!!dplyr::sym(key_name) := "dummy",
.before = 1
)
}
# write dummy df into base, then delete dummy row
DBI::dbWriteTable(con, table_name, dummy_df, append = TRUE)
DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key} = 'dummy'"))
cli::cli_alert_success("таблица '{table_name}' успешно создана")
}
},
con = con
)
}
@@ -96,45 +110,47 @@ get_dummy_df <- function(forms_id_type_list) {
#' коррекции таблицы
compare_existing_table_with_schema <- function(
table_name,
forms_id_type_list,
schm,
con = rlang::env_get(rlang::caller_env(), nm = "con")
) {
forms_id_type_list_names <- names(forms_id_type_list)
main_key <- schm$get_main_key_id
key_id <- schm$get_key_id(table_name)
forms_ids <- schm$get_forms_ids(table_name)
if (table_name == "main") {
forms_id_type_list_names <- c("main_key", forms_id_type_list_names)
all_ids_from_schema <- c(main_key, forms_ids)
} else {
forms_id_type_list_names <- c("main_key", "nested_key", forms_id_type_list_names)
all_ids_from_schema <- c(main_key, key_id, forms_ids)
}
options(box.path = here::here())
box::use(modules/utils)
# checking if db structure in form compatible with alrady writed data (in case on changig form)
if (identical(colnames(DBI::dbReadTable(con, table_name)), forms_id_type_list_names)) {
if (identical(colnames(DBI::dbReadTable(con, table_name)), all_ids_from_schema)) {
# ...
} else {
df_to_rewrite <- DBI::dbReadTable(con, table_name)
form_base_difference <- setdiff(forms_id_type_list_names, colnames(df_to_rewrite))
base_form_difference <- setdiff(colnames(df_to_rewrite), forms_id_type_list_names)
form_base_difference <- setdiff(all_ids_from_schema, colnames(df_to_rewrite))
base_form_difference <- setdiff(colnames(df_to_rewrite), all_ids_from_schema)
# if lengths are equal
if (length(forms_id_type_list_names) == length(colnames(df_to_rewrite)) &&
if (length(all_ids_from_schema) == length(colnames(df_to_rewrite)) &&
length(form_base_difference) == 0 &&
length(base_form_difference) == 0) {
cli::cli_warn("changes in scheme file detected: assuming order changed only")
print(forms_id_type_list_names)
print(all_ids_from_schema)
}
if (length(forms_id_type_list_names) == length(colnames(df_to_rewrite)) &&
if (length(all_ids_from_schema) == length(colnames(df_to_rewrite)) &&
length(form_base_difference) != 0 &&
length(base_form_difference) != 0) {
cli::cli_abort("changes in scheme file detected: structure has been changed")
}
if (length(forms_id_type_list_names) > length(colnames(df_to_rewrite)) && length(form_base_difference) != 0) {
if (length(all_ids_from_schema) > length(colnames(df_to_rewrite)) && length(form_base_difference) != 0) {
cli::cli_warn("changes in scheme file detected: new inputs form was added")
cli::cli_warn("trying to adapt database")
@@ -146,13 +162,13 @@ compare_existing_table_with_schema <- function(
# reorder due to scheme
df_to_rewrite <- df_to_rewrite |>
dplyr::select(dplyr::all_of(forms_id_type_list_names))
dplyr::select(dplyr::all_of(all_ids_from_schema))
DBI::dbWriteTable(con, table_name, df_to_rewrite, overwrite = TRUE)
DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE main_key = 'dummy'"))
DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key} = 'dummy'"))
}
if (length(forms_id_type_list_names) < length(colnames(df_to_rewrite))) {
if (length(all_ids_from_schema) < length(colnames(df_to_rewrite))) {
cli::cli_abort("changes in scheme file detected: some of inputs form was deleted! it may cause data loss!")
}
@@ -160,7 +176,18 @@ compare_existing_table_with_schema <- function(
}
#' @export
write_df_to_db <- function(df, table_name, scheme, main_key, nested_key, con) {
write_df_to_db <- function(
df,
table_name,
schm,
main_key_value,
nested_key_value,
con
) {
scheme <- schm$get_schema(table_name)
main_key_id <- schm$get_main_key_id
nested_key_id <- schm$get_key_id(table_name)
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
@@ -174,25 +201,25 @@ write_df_to_db <- function(df, table_name, scheme, main_key, nested_key, con) {
)
if (table_name == "main") {
del_query <- glue::glue("DELETE FROM main WHERE main_key = '{main_key}'")
del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'")
}
if (table_name != "main") {
if (is.null(nested_key)) {
del_query <- glue::glue("DELETE FROM '{table_name}' WHERE main_key = '{main_key}'")
if (is.null(nested_key_value)) {
del_query <- glue::glue("DELETE FROM '{table_name}' WHERE {main_key_id} = '{main_key_value}'")
} else {
del_query <- glue::glue("DELETE FROM '{table_name}' WHERE main_key = '{main_key}' AND nested_key = '{nested_key}'")
del_query <- glue::glue("DELETE FROM '{table_name}' WHERE {main_key_id} = '{main_key_value}' AND {nested_key_id} = '{nested_key_value}'")
}
}
deleted <- DBI::dbExecute(con, del_query)
cli::cli_alert_success("deleted {deleted} rows for '{main_key}' in '{table_name}")
cli::cli_alert_success("deleted {deleted} rows for '{main_key_value}' in '{table_name}")
# записать данные
DBI::dbWriteTable(con, table_name, df, append = TRUE)
# report
cli::cli_alert_success("данные для '{main_key}' в таблице '{table_name}' успешно обновлены")
cli::cli_alert_success("данные для '{main_key_value}' в таблице '{table_name}' успешно обновлены")
}