0.15.0 (2026-04-07)

CHANGELOG.md

@@ -1,5 +1,6 @@
-### 0.??.?
+### 0.15.0
 ##### features
+- added `description_header` form type;
 - added checkboxes input form;
 - added button to reset data in forms;
 - added option to export input data to `.docx` format (installed pandoc is required), using `reference.docx` template;
@@ -11,9 +12,8 @@
   - in other cases - show warnings;
 
 ##### fixes
-
 - fixed not erasing inputs while loading empty values (with checkboxes, radiobuttons);
-- +number input validation
+- number input validation
 - fix validation errors (2025-03-18);
 - fixes to db work: properly closing connection (2025-03-18);
 
@@ -22,8 +22,8 @@
 - some code refactoring;
 - replacing NumberImput to TextInput due to correct implement validation;
 - added options to enable/disable auth module (disabled on default) (2025-03-17);
-
+- (breaking) replacing inner_tables (via `rhandsometable`) with nested_forms (rendering by shiny modal dialog feature)
-
+- (breaking) renaming `main.xlsx` to `schema.xlsx`, schemas for nested forms now in seperate sheets in this file;
 
 ### 0.14.1 2024-10-14
 

README.md

@@ -4,7 +4,7 @@
 
 Данный проект представляет собой shiny-приложение (написанное на языке программирования R), для заполнения каких-то данных и возможностью последующего экспорта данных в `.xlsx`.
 
-Структура полей для заполнения (соответственно и базы) описывается файлом `main.xlsx`, что позволяет быстро и читаемо сформировать необходимую для себя структуру.
+Структура полей для заполнения (соответственно и базы) описывается файлом `schema.xlsx`, что позволяет быстро и читаемо сформировать необходимую для себя структуру.
 
 Заполненные данные хранятся локально с использованием `SQLite`. Так же возможно использование других баз данных (например `PostgreSQL`), однако это требует некоторой модификации кода.
 
@@ -13,7 +13,7 @@
 ...
 
 
-# Cтруктура `main.xlsx`
+# Cтруктура `schema.xlsx`
 
 Файл, формирующий структуру всей формы, представляет собой таблицу в формате `.xlsx`, состоящий из следующих столбцов:
 
@@ -21,6 +21,7 @@
 - `subgroup` - группировка второго уровня (колонки);
 - `form_id` - id;
 - `form_label` - Название формы;
+- `form_description` - Описание формы;
 - `form_type` - тип формы, в настоящее время доступные следующие варианты:
   - `text` - простой текст;
   - `number` - число;
@@ -30,9 +31,11 @@
   - `radio` - выбор одного варианта (radio buttons);
   - `checkboxes` - выбор нескольких вариантов (checkboxes); 
   - `description` - описание (отображение текста, без формы выбора/ввода);
-  - `inline_table` - вложенная таблица (rhandsometables);
+  - `description_header` - для отображение заголовка;
+  - `nested_form` - вложенная форма;
 - `choices` - варианты выбора (если предполагаются типом формы ввода);
 - `condition` - условие, при котором форма ввода будет отображаться;
+- `required` - проверка заполненности поля: пустое значение - нет проверки, 1 - есть проверка
 
 # Как пользоваться
 

modules/data_validation.R

@@ -15,7 +15,7 @@ init_val <- function(scheme, ns) {
 
   # формируем список id - тип
   inputs_simple_list <- scheme |>
-    dplyr::filter(!form_type %in% c("inline_table", "inline_table2","description", "description_header")) |>
+    dplyr::filter(!form_type %in% c("nested_forms","description", "description_header")) |>
     dplyr::distinct(form_id, form_type) |>
     tibble::deframe()
 
@@ -42,6 +42,8 @@ init_val <- function(scheme, ns) {
           if (check_for_empty_data(x)) {
             return(NULL)
           }
+          # хак для пропуска значений
+          if (x == "NA") return(NULL)
           # check for numeric
           # if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
           if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
@@ -60,14 +62,16 @@ init_val <- function(scheme, ns) {
               x_input_id,
               function(x) {
 
-                # замена разделителя десятичных цифр
-                x <- stringr::str_replace(x, ",", ".")
-
                 # exit if empty
                 if (check_for_empty_data(x)) {
                   return(NULL)
                 }
 
+                if (x == "NA") return(NULL)
+
+                # замена разделителя десятичных цифр
+                x <- stringr::str_replace(x, ",", ".")
+
                 # check for currect value
                 if (dplyr::between(as.double(x), ranges[1], ranges[2])) {
                   NULL

modules/db.R

@@ -38,11 +38,25 @@ check_if_table_is_exist_and_init_if_not <- function(
 
   } else {
 
-    dummy_df <- dplyr::mutate(get_dummy_df(forms_id_type_list), id = "dummy")
+    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
+        )
+    }
 
     # write dummy df into base, then delete dummy row
     DBI::dbWriteTable(con, table_name, dummy_df, append = TRUE)
-    DBI::dbExecute(con, "DELETE FROM main WHERE id = 'dummy'")
+    DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE main_key = 'dummy'"))
 
     cli::cli_alert_success("таблица '{table_name}' успешно создана")
   }
@@ -86,34 +100,43 @@ compare_existing_table_with_schema <- function(
   con = rlang::env_get(rlang::caller_env(), nm = "con")
 ) {
 
+  forms_id_type_list_names <- names(forms_id_type_list)
+
+  if (table_name == "main") {
+    forms_id_type_list_names <- c("main_key", forms_id_type_list_names)
+  } else {
+    forms_id_type_list_names <- c("main_key", "nested_key", forms_id_type_list_names)
+  }
+
   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)), names(forms_id_type_list))) {
+  if (identical(colnames(DBI::dbReadTable(con, table_name)), forms_id_type_list_names)) {
     # ...
   } else {
 
     df_to_rewrite <- DBI::dbReadTable(con, table_name)
-    form_base_difference <- setdiff(names(forms_id_type_list), colnames(df_to_rewrite))
+    form_base_difference <- setdiff(forms_id_type_list_names, colnames(df_to_rewrite))
-    base_form_difference <- setdiff(colnames(df_to_rewrite), names(forms_id_type_list))
+    base_form_difference <- setdiff(colnames(df_to_rewrite), forms_id_type_list_names)
 
     # if lengths are equal
-    if (length(names(forms_id_type_list)) == length(colnames(df_to_rewrite)) &&
+    if (length(forms_id_type_list_names) == length(colnames(df_to_rewrite)) &&
           length(form_base_difference) == 0 &&
           length(base_form_difference) == 0) {
-      warning("changes in scheme file detected: assuming order changed only")
+      cli::cli_warn("changes in scheme file detected: assuming order changed only")
+      print(forms_id_type_list_names)
     }
 
-    if (length(names(forms_id_type_list)) == length(colnames(df_to_rewrite)) &&
+    if (length(forms_id_type_list_names) == length(colnames(df_to_rewrite)) &&
           length(form_base_difference) != 0 &&
           length(base_form_difference) != 0) {
-      stop("changes in scheme file detected: structure has been changed")
+      cli::cli_abort("changes in scheme file detected: structure has been changed")
     }
 
-    if (length(names(forms_id_type_list)) > length(colnames(df_to_rewrite)) && length(form_base_difference) != 0) {
+    if (length(forms_id_type_list_names) > length(colnames(df_to_rewrite)) && length(form_base_difference) != 0) {
-      warning("changes in scheme file detected: new inputs form was added")
+      cli::cli_warn("changes in scheme file detected: new inputs form was added")
-      warning("trying to adapt database")
+      cli::cli_warn("trying to adapt database")
 
       # add empty data for each new input form
       for (i in form_base_difference) {
@@ -123,15 +146,76 @@ compare_existing_table_with_schema <- function(
 
       # reorder due to scheme
       df_to_rewrite <- df_to_rewrite |>
-        dplyr::select(dplyr::all_of(names(forms_id_type_list)))
+        dplyr::select(dplyr::all_of(forms_id_type_list_names))
 
       DBI::dbWriteTable(con, table_name, df_to_rewrite, overwrite = TRUE)
-      DBI::dbExecute(con, "DELETE FROM main WHERE id = 'dummy'")
+      DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE main_key = 'dummy'"))
     }
 
-    if (length(names(forms_id_type_list)) < length(colnames(df_to_rewrite))) {
+    if (length(forms_id_type_list_names) < length(colnames(df_to_rewrite))) {
-      stop("changes in scheme file detected: some of inputs form was deleted! it may cause data loss!")
+      cli::cli_abort("changes in scheme file detected: some of inputs form was deleted! it may cause data loss!")
     }
     
   }
 }
+
+#' @export
+write_df_to_db <- function(df, table_name, main_key, nested_key, con) {
+
+  # if(!missing(nested_key)) del_query <- glue::glue("DELETE FROM {table_name} WHERE key = '{key}'")
+  if (table_name == "main") {
+    del_query <- glue::glue("DELETE FROM main WHERE main_key = '{main_key}'")
+    DBI::dbExecute(con, del_query)
+  }
+
+  if (table_name != "main") {
+    del_query <- glue::glue("DELETE FROM '{table_name}' WHERE main_key = '{main_key}' AND nested_key = '{nested_key}'")
+    DBI::dbExecute(con, del_query)
+  }
+
+  # записать данные
+  DBI::dbWriteTable(con, table_name, df, append = TRUE)
+
+  # report
+  cli::cli_alert_success("данные для '{main_key}' в таблице '{table_name}' успешно обновлены")
+
+}
+
+#' @export
+#' reading tables from db by name and id ========
+read_df_from_db_by_id <- function(table_name, main_key, nested_key, con) {
+
+  # check if this table exist
+  if (table_name == "main") {
+    query <- glue::glue("
+      SELECT * 
+      FROM main
+      WHERE main_key = '{main_key}'
+    ")
+  }
+
+  if (table_name != "main") {
+    query <- glue::glue("
+      SELECT * 
+      FROM {table_name}
+      WHERE main_key = '{main_key}' AND nested_key = '{nested_key}'
+    ")
+  }
+  DBI::dbGetQuery(con, query)
+}
+
+#' @export
+get_keys_from_table <- function(table_name, con) {
+
+  DBI::dbGetQuery(con, glue::glue("SELECT DISTINCT main_key FROM {table_name}")) |>
+    dplyr::pull()
+
+}
+
+#' @export
+get_nested_keys_from_table <- function(table_name, main_key, con) {
+
+  DBI::dbGetQuery(con, glue::glue("SELECT DISTINCT nested_key FROM {table_name} WHERE main_key == '{main_key}'")) |>
+    dplyr::pull()
+
+}

modules/utils.R

@@ -49,7 +49,8 @@ render_forms <- function(
   form <- NULL
 
   # параметры только для этой формы
-  filterd_line <- dplyr::filter(main_scheme, form_id == {{form_id}})
+  filterd_line <- main_scheme |>
+    dplyr::filter(form_id == {{form_id}})
 
   # если передана ns() функция то подмеяем id для каждой формы в соответствии с пространством имен
   if (!missing(ns)) {
@@ -178,12 +179,8 @@ render_forms <- function(
     )
   }
 
-  # вложенная таблица
+  # вложенная форма
-  if (form_type == "inline_table") {
+  if (form_type == "nested_forms") {
-    form <- rhandsontable::rHandsontableOutput(outputId = form_id)
-  }
-
-  if (form_type == "inline_table2") {
     form <- shiny::actionButton(inputId = form_id, label = label)
   }
 
@@ -235,75 +232,104 @@ get_empty_data <- function(type) {
 #' @param value - value to update;
 #' @param local_delimeter - delimeter to split file
 update_forms_with_data <- function(
-  id,
+  form_id,
-  type,
+  form_type,
   value,
-  local_delimeter = getOption("SYMBOL_DELIM")
+  local_delimeter = getOption("SYMBOL_DELIM"),
+  ns
 ) {
 
-  if (type == "text") {
+  # если передана ns() функция то подмеяем id для каждой формы в соответствии с пространством имен
-    shiny::updateTextAreaInput(inputId = id, value = value)
+  if (!missing(ns) & !is.null(ns)) {
+    form_id <- ns(form_id)
   }
 
-  if (type == "number") {
+  if (form_type == "text") {
-    shiny::updateTextAreaInput(inputId = id, value = value)
+    shiny::updateTextAreaInput(inputId = form_id, value = value)
+  }
+
+  if (form_type == "number") {
+    shiny::updateTextAreaInput(inputId = form_id, value = value)
   }
 
   # supress warnings when applying NA or NULL to date input form
-  if (type == "date") {
+  if (form_type == "date") {
     suppressWarnings(
-      shiny::updateDateInput(inputId = id, value = value)
+      shiny::updateDateInput(inputId = form_id, value = value)
     )
   }
 
   # select_one
-  if (type == "select_one") {
+  if (form_type == "select_one") {
     # update choices
-    # old_choices <- subset(scheme, form_id == id, choices) |> dplyr::pull()
+    # old_choices <- subset(scheme, form_id == form_id, choices) |> dplyr::pull()
     # new_choices <- unique(c(old_choices, value))
     # new_choices <- new_choices[!is.na(new_choices)]
 
-    # shiny::updateSelectizeInput(inputId = id, selected = value, choices = new_choices)
+    # shiny::updateSelectizeInput(inputId = form_id, selected = value, choices = new_choices)
-    shiny::updateSelectizeInput(inputId = id, selected = value)
+    shiny::updateSelectizeInput(inputId = form_id, selected = value)
   }
 
   # select_multiple
   # check if value is not NA and split by delimetr
-  if (type == "select_multiple" && !is.na(value)) {
+  if (form_type == "select_multiple" && !is.na(value)) {
     vars <- stringr::str_split_1(value, local_delimeter)
 
     # update choices
-    # old_choices <- subset(scheme, form_id == id, choices) |> dplyr::pull()
+    # old_choices <- subset(scheme, form_id == form_id, choices) |> dplyr::pull()
     # new_choices <- unique(c(old_choices, vars))
     # new_choices <- new_choices[!is.na(new_choices)]
 
-    # shiny::updateSelectizeInput(inputId = id, selected = vars, choices = new_choices)
+    # shiny::updateSelectizeInput(inputId = form_id, selected = vars, choices = new_choices)
-    shiny::updateSelectizeInput(inputId = id, selected = vars)
+    shiny::updateSelectizeInput(inputId = form_id, selected = vars)
   }
 
   # in other case fill with `character(0)` to proper reseting form
-  if (type == "select_multiple" && is.na(value)) {
+  if (form_type == "select_multiple" && is.na(value)) {
-    shiny::updateSelectizeInput(inputId = id, selected = character(0))
+    shiny::updateSelectizeInput(inputId = form_id, selected = character(0))
   }
 
   # radio buttons
-  if (type == "radio" && !is.na(value)) {
+  if (form_type == "radio" && !is.na(value)) {
-    shiny::updateRadioButtons(inputId = id, selected = value)
+    shiny::updateRadioButtons(inputId = form_id, selected = value)
   }
-  if (type == "radio" && is.na(value)) {
+  if (form_type == "radio" && is.na(value)) {
-    shiny::updateRadioButtons(inputId = id, selected = character(0))
+    shiny::updateRadioButtons(inputId = form_id, selected = character(0))
   }
 
   # checkboxes
-  if (type == "checkbox" && !is.na(value)) {
+  if (form_type == "checkbox" && !is.na(value)) {
     vars <- stringr::str_split_1(value, local_delimeter)
-    shiny::updateCheckboxGroupInput(inputId = id, selected = vars)
+    shiny::updateCheckboxGroupInput(inputId = form_id, selected = vars)
   }
-  if (type == "checkbox" && is.na(value)) {
+  if (form_type == "checkbox" && is.na(value)) {
-    shiny::updateCheckboxGroupInput(inputId = id, selected = character(0))
+    shiny::updateCheckboxGroupInput(inputId = form_id, selected = character(0))
   }
 
   # if (type == "inline_table") {
   #   message("EMPTY")
   # }
 }
+
+#' @export
+clean_forms <- function(id_and_types_list, ns) {
+
+ # если передана ns() функция то подмеяем id для каждой формы в соответствии с пространством имен
+  if (missing(ns)) ns <- NULL
+    
+  purrr::walk2(
+    .x = id_and_types_list,
+    .y = names(id_and_types_list),
+    .f = \(x_type, x_id) {
+      
+      # using function to update forms
+      update_forms_with_data(
+        form_id   = x_id,
+        form_type = x_type,
+        value     = get_empty_data(x_type),
+        ns = ns
+      )
+    }
+  )
+  
+}

renv.lock

@@ -530,6 +530,16 @@
       ],
       "Hash": "b29cf3031f49b04ab9c852c912547eef"
     },
+    "here": {
+      "Package": "here",
+      "Version": "1.0.1",
+      "Source": "Repository",
+      "Repository": "RSPM",
+      "Requirements": [
+        "rprojroot"
+      ],
+      "Hash": "24b224366f9c2e7534d2344d10d59211"
+    },
     "highr": {
       "Package": "highr",
       "Version": "0.11",
@@ -612,28 +622,6 @@
       ],
       "Hash": "0080607b4a1a7b28979aecef976d8bc2"
     },
-    "janitor": {
-      "Package": "janitor",
-      "Version": "2.2.0",
-      "Source": "Repository",
-      "Repository": "RSPM",
-      "Requirements": [
-        "R",
-        "dplyr",
-        "hms",
-        "lifecycle",
-        "lubridate",
-        "magrittr",
-        "purrr",
-        "rlang",
-        "snakecase",
-        "stringi",
-        "stringr",
-        "tidyr",
-        "tidyselect"
-      ],
-      "Hash": "5baae149f1082f466df9d1442ba7aa65"
-    },
     "jquerylib": {
       "Package": "jquerylib",
       "Version": "0.1.4",
@@ -730,19 +718,6 @@
       ],
       "Hash": "b8552d117e1b808b09a832f589b79035"
     },
-    "lubridate": {
-      "Package": "lubridate",
-      "Version": "1.9.2",
-      "Source": "Repository",
-      "Repository": "RSPM",
-      "Requirements": [
-        "R",
-        "generics",
-        "methods",
-        "timechange"
-      ],
-      "Hash": "e25f18436e3efd42c7c590a1c4c15390"
-    },
     "magrittr": {
       "Package": "magrittr",
       "Version": "2.0.3",
@@ -1019,6 +994,16 @@
       ],
       "Hash": "3854c37590717c08c32ec8542a2e0a35"
     },
+    "rprojroot": {
+      "Package": "rprojroot",
+      "Version": "2.0.4",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R"
+      ],
+      "Hash": "4c8415e0ec1e29f3f4f6fc108bef0144"
+    },
     "sass": {
       "Package": "sass",
       "Version": "0.4.9",
@@ -1128,18 +1113,6 @@
       ],
       "Hash": "fe6e75a1c1722b2d23cb4d4dbe1006df"
     },
-    "snakecase": {
-      "Package": "snakecase",
-      "Version": "0.11.1",
-      "Source": "Repository",
-      "Repository": "RSPM",
-      "Requirements": [
-        "R",
-        "stringi",
-        "stringr"
-      ],
-      "Hash": "58767e44739b76965332e8a4fe3f91f1"
-    },
     "sourcetools": {
       "Package": "sourcetools",
       "Version": "0.1.7-1",
@@ -1245,17 +1218,6 @@
       ],
       "Hash": "79540e5fcd9e0435af547d885f184fd5"
     },
-    "timechange": {
-      "Package": "timechange",
-      "Version": "0.2.0",
-      "Source": "Repository",
-      "Repository": "RSPM",
-      "Requirements": [
-        "R",
-        "cpp11"
-      ],
-      "Hash": "8548b44f79a35ba1791308b61e6012d7"
-    },
     "tinytex": {
       "Package": "tinytex",
       "Version": "0.46",