From 383ccf5240432102e07bab20634911bdeda14299 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 19 Feb 2024 11:20:56 +0100 Subject: [PATCH 01/39] Fixed #212 --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index c60c97c..3f00537 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,6 +13,7 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.2 Depends: + R (>= 3.5.0), shiny, shinydashboard, shinyWidgets, From 0f3282406b3b995cdb483f07eb144b9254585e50 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 19 Feb 2024 11:34:59 +0100 Subject: [PATCH 02/39] Partial #228 --- R/kitems_buttons_ui.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/kitems_buttons_ui.R b/R/kitems_buttons_ui.R index 5e747f7..9a717b1 100644 --- a/R/kitems_buttons_ui.R +++ b/R/kitems_buttons_ui.R @@ -15,7 +15,8 @@ create_BTN <- function(id){ # namespace - ns <- NS(id) + # ns <- NS(id) + ns <- session$ns(id) # UI uiOutput(ns("create_btn_output"), inline = TRUE) From ce7d7187563774b86f66729337703f2cd94c25b7 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 19 Feb 2024 17:16:41 +0100 Subject: [PATCH 03/39] Fixed #228 (docs) --- R/kitems_buttons_ui.R | 3 +-- README.Rmd | 21 +++++++++++++++++++++ README.md | 21 +++++++++++++++++++++ 3 files changed, 43 insertions(+), 2 deletions(-) diff --git a/R/kitems_buttons_ui.R b/R/kitems_buttons_ui.R index 9a717b1..5e747f7 100644 --- a/R/kitems_buttons_ui.R +++ b/R/kitems_buttons_ui.R @@ -15,8 +15,7 @@ create_BTN <- function(id){ # namespace - # ns <- NS(id) - ns <- session$ns(id) + ns <- NS(id) # UI uiOutput(ns("create_btn_output"), inline = TRUE) diff --git a/README.Rmd b/README.Rmd index b9d40a0..f18c545 100644 --- a/README.Rmd +++ b/README.Rmd @@ -375,6 +375,27 @@ tabItem(tabName = "my_data", kitems::admin_ui("my_data")))) ``` +### Nested module considerations + +In case the kitemsManager_Server module server function is called from +inside a module (i.e. as a nested module), then it is not possible to +call the UI functions from the main app with the nested module id. + +From there, two options are available: + +- wrap the package UI functions into functions from the calling module + (encapsulation)\ + For example, you could create an action_BTN function that would + implement create_BTN, update_BTN and delete_BTN into a single UI + +- call the package UI functions directly from the main app using + multiple namespaces:\ + (as specified in the shiny::NS function) + +```{r nested_module, eval=FALSE} + kitems::admin_ui(c("module_id", "nested_module_id")) +``` + ## Import & migration When the module server is initialized with data.model = NULL, an import diff --git a/README.md b/README.md index d4594f4..01615c0 100644 --- a/README.md +++ b/README.md @@ -345,6 +345,27 @@ tabItem(tabName = "my_data", kitems::admin_ui("my_data")))) ``` +### Nested module considerations + +In case the kitemsManager_Server module server function is called from +inside a module (i.e. as a nested module), then it is not possible to +call the UI functions from the main app with the nested module id. + +From there, two options are available: + +- wrap the package UI functions into functions from the calling module + (encapsulation) + For example, you could create an action_BTN function that would + implement create_BTN, update_BTN and delete_BTN into a single UI + +- call the package UI functions directly from the main app using + multiple namespaces: + (as specified in the shiny::NS function) + +``` r + kitems::admin_ui(c("module_id", "nested_module_id")) +``` + ## Import & migration When the module server is initialized with data.model = NULL, an import From b3511d2adb0cd47789e72f1faec7f56b11eb55c4 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 19 Feb 2024 17:18:55 +0100 Subject: [PATCH 04/39] udpate version --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3f00537..3536e8b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: kitems -Title: Framework to manage data.frame items -Version: 0.4.0.0000 +Title: Framework To Manage Data.frame Items +Version: 0.4.2 Authors@R: person(given = "philippe", family = "peret", From d1ad030e71bcba8d6863e2b3135676460802af11 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 19 Feb 2024 17:58:35 +0100 Subject: [PATCH 05/39] Fixed #238 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3536e8b..b55c1a2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,7 +11,7 @@ License: GPL (>=3) Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.2 +RoxygenNote: 7.3.1 Depends: R (>= 3.5.0), shiny, From a0bf63cdab5ce4b17418b1d8c97921ed54d3046e Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 19 Feb 2024 18:21:57 +0100 Subject: [PATCH 06/39] Fixed #224 --- R/kitems_module_server.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index a05e70c..e6531bc 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -305,6 +305,10 @@ kitemsManager_Server <- function(id, r, path, if(!is.null(filter_date)) items <- items[items$date >= filter_date[1] & items$date <= filter_date[2], ] + # -- Apply ordering + if(!is.null(filter_date)) + items <- items[order(items$date, decreasing = TRUE), ] + cat(MODULE, "ouput dim =", dim(items), "\n") # -- Return From c1e54900a8da6d62d50d3e9f007c90255087011d Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Wed, 21 Feb 2024 16:29:20 +0100 Subject: [PATCH 07/39] Fixed #237 --- R/kitems_module_server.R | 18 ++++++++++++++++++ R/kitems_names.R | 13 +++++++++++++ README.Rmd | 1 + README.md | 1 + 4 files changed, 33 insertions(+) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index e6531bc..66eeb7a 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -68,12 +68,14 @@ kitemsManager_Server <- function(id, r, path, r_items <- items_name(id) r_filtered_items <- filtered_items_name(id) r_selected_items <- selected_items_name(id) + r_clicked_column <- clicked_column_name(id) r_filter_date <- filter_date_name(id) # -- Declare reactive objects (for external use) r[[r_items]] <- reactiveVal(NULL) r[[r_filtered_items]] <- reactiveVal(NULL) r[[r_selected_items]] <- reactiveVal(NULL) + r[[r_clicked_column]] <- reactiveVal(NULL) r[[r_filter_date]] <- reactiveVal(NULL) # -- Build triggers names from module id @@ -433,6 +435,22 @@ kitemsManager_Server <- function(id, r, path, }, ignoreNULL = FALSE) + # -- Filtered view + observeEvent(input$filtered_view_cell_clicked$col, { + + # -- Get table col names (need to apply masks to get correct columns, hence sending only first row) + cols <- colnames(view_apply_masks(r[[r_data_model]](), head(r[[r_filtered_items]](), n = 1))) + + # -- Get name of the clicked column + col_clicked <- cols[input$filtered_view_cell_clicked$col + 1] + cat(MODULE, "Clicked column (filtered view) =", col_clicked, "\n") + + # -- Store + r[[r_clicked_column]](col_clicked) + + }, ignoreNULL = TRUE) + + # -------------------------------------------------------------------------- # Declare outputs: Inputs # -------------------------------------------------------------------------- diff --git a/R/kitems_names.R b/R/kitems_names.R index 35fd117..c400ac3 100644 --- a/R/kitems_names.R +++ b/R/kitems_names.R @@ -52,6 +52,19 @@ filtered_items_name <- function(id){paste0(id, "_filtered_items")} selected_items_name <- function(id){paste0(id, "_selected_items")} +#' Clicked column name +#' +#' @param id the id of the module server instance +#' +#' @return the name of the corresponding reactive value +#' @export +#' +#' @examples +#' clicked_column_name(id = "mydata") + +clicked_column_name <- function(id){paste0(id, "_clicked_column")} + + #' Filter date name #' #' @param id the id of the module server instance diff --git a/README.Rmd b/README.Rmd index f18c545..7224e8e 100644 --- a/README.Rmd +++ b/README.Rmd @@ -98,6 +98,7 @@ from the r object passed as an argument of the module server): - r[[items]] - r[[filtered_items]] - r[[selected_items]] +- r[[clicked_column]] - r[[filter_date]] - r[[trigger_add]] - r[[trigger_update]] diff --git a/README.md b/README.md index 01615c0..bb0cecf 100644 --- a/README.md +++ b/README.md @@ -73,6 +73,7 @@ from the r object passed as an argument of the module server): - r\[[items](#items)\] - r\[\[filtered_items\]\] - r\[\[selected_items\]\] +- r\[\[clicked_column\]\] - r\[\[filter_date\]\] - r\[\[trigger_add\]\] - r\[\[trigger_update\]\] From f2a45a29c37b9fe5750be10450d9691a7185b462 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Wed, 21 Feb 2024 16:45:34 +0100 Subject: [PATCH 08/39] Fixed #240 --- R/kitems_module_server.R | 3 +++ tests/testthat/test-kitemsManager_Server.R | 18 ++++++++++++++++++ 2 files changed, 21 insertions(+) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 66eeb7a..abe8966 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -31,6 +31,9 @@ kitemsManager_Server <- function(id, r, path, create = TRUE, autosave = TRUE) { moduleServer(id, function(input, output, session) { + # -- check reactive #240 + stopifnot(class(r) == "reactivevalues") + # -- Check path (to avoid connection problems if missing folder) if(!dir.exists(path)) dir.create(path) diff --git a/tests/testthat/test-kitemsManager_Server.R b/tests/testthat/test-kitemsManager_Server.R index 482048a..8d10f3d 100644 --- a/tests/testthat/test-kitemsManager_Server.R +++ b/tests/testthat/test-kitemsManager_Server.R @@ -1250,3 +1250,21 @@ test_that("Import data without id works", { # -------------------------------------------------------------------------- clean_all(testdata_path) + + +test_that("r not reactive fails", { + + # -- dummy + dummy <- 1 + + # -- declare arguments + params <- list(id = module_id, + r = dummy, + path = testdata_path, + create = FALSE, + autosave = FALSE) + + # -- module server call + expect_error(testServer(kitemsManager_Server, args = params)) + +}) From 1a0e816f70c1bd381666f4ddaa22063a250d9098 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Wed, 21 Feb 2024 18:49:37 +0100 Subject: [PATCH 09/39] Fixed #223 #242 --- R/kitems_inputs_ui.R | 4 +++- R/kitems_module_server.R | 13 ++++++++++++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/R/kitems_inputs_ui.R b/R/kitems_inputs_ui.R index 975bb31..13bf30f 100644 --- a/R/kitems_inputs_ui.R +++ b/R/kitems_inputs_ui.R @@ -18,6 +18,8 @@ date_slider_INPUT <- function(id){ ns <- NS(id) # UI - uiOutput(ns("date_slider")) + fluidRow( + column(width = 6, uiOutput(ns("date_slider"))), + column(width = 6, uiOutput(ns("date_slider_strategy")))) } diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index abe8966..3b07899 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -458,6 +458,14 @@ kitemsManager_Server <- function(id, r, path, # Declare outputs: Inputs # -------------------------------------------------------------------------- + # -- date slider options + output$date_slider_strategy <- renderUI(radioButtons(inputId = ns("date_slider_strategy"), + label = "Strategy", + choices = c("this-year", "keep-range"), + selected = "this-year", + inline = TRUE)) + + # -- Declare output: output$date_slider <- renderUI({ @@ -482,7 +490,8 @@ kitemsManager_Server <- function(id, r, path, # -- Set value # implement this_year strategy by default #211 - value <- if(is.null(range)) + # keep this year after item is added #223 & #242 + value <- if(is.null(input$date_slider_strategy) || input$date_slider_strategy == "this-year") ktools::date_range(min, max, type = "this_year") else value <- range @@ -499,12 +508,14 @@ kitemsManager_Server <- function(id, r, path, }) + # -- Observe: date_slider observeEvent(input$date_slider, { cat(MODULE, "Date sliderInput has been updated: \n") cat("-- values =", input$date_slider, "\n") + # -- store r[[r_filter_date]](input$date_slider) }) From bb6538c462943b5348e5be3051b6622d3362a752 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 8 Apr 2024 21:50:08 +0200 Subject: [PATCH 10/39] Fixed #245 --- R/kitems_module_server.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 3b07899..b3e9bdd 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -367,9 +367,10 @@ kitemsManager_Server <- function(id, r, path, # -- colClasses for admin # setting rownames = FALSE #209 + # setting dom = "tpl" instead of "t" #245 output$data_model <- DT::renderDT(dm_table_mask(r[[r_data_model]]()), rownames = FALSE, - options = list(lengthMenu = c(5, 10, 15), pageLength = 10, dom = "t", scrollX = TRUE), + options = list(lengthMenu = c(5, 10, 15), pageLength = 10, dom = "tpl", scrollX = TRUE), selection = list(mode = 'single', target = "row", selected = isolate(input$data_model_rows_selected))) From 2b0f9817d3485ca1b8471abb0ef9f44cec1115e8 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Sat, 13 Apr 2024 10:19:56 +0200 Subject: [PATCH 11/39] Fixed #252 --- R/kitems_module_server.R | 9 +++++++-- R/kitems_names.R | 13 +++++++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index b3e9bdd..aeef37f 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -86,16 +86,19 @@ kitemsManager_Server <- function(id, r, path, trigger_update <- trigger_update_name(id) trigger_delete <- trigger_delete_name(id) trigger_save <- trigger_save_name(id) + trigger_create <- trigger_create_name(id) # -- Declare reactive objects (for external use) r[[trigger_add]] <- reactiveVal(NULL) r[[trigger_update]] <- reactiveVal(NULL) r[[trigger_delete]] <- reactiveVal(NULL) r[[trigger_save]] <- reactiveVal(0) + r[[trigger_create]] <- reactiveVal(0) cat(MODULE, "trigger_add available @", trigger_add, "\n") cat(MODULE, "trigger_update available @", trigger_update, "\n") cat(MODULE, "trigger_delete available @", trigger_delete, "\n") cat(MODULE, "trigger_save available @", trigger_save, "\n") + cat(MODULE, "trigger_create available @", trigger_create, "\n") # -------------------------------------------------------------------------- @@ -1118,8 +1121,10 @@ kitemsManager_Server <- function(id, r, path, output$create_btn_output <- renderUI(actionButton(inputId = ns("create_btn"), label = "Create")) - # -- Observe: create_btn - observeEvent(input$create_btn, { + # -- Observe: create_btn & r[[trigger_create]] + # Add trigger to fire observer without implementing the button in UI #252 + observeEvent({input$create_btn + r[[trigger_create]]()}, { showModal(modalDialog(inputList(ns, item = NULL, update = FALSE, data.model = r[[r_data_model]]()), title = "Create", diff --git a/R/kitems_names.R b/R/kitems_names.R index c400ac3..b8fd847 100644 --- a/R/kitems_names.R +++ b/R/kitems_names.R @@ -128,3 +128,16 @@ trigger_save_name <- function(id){paste0(id, "_trigger_save")} #' trigger_update_name(id = "mydata") trigger_update_name <- function(id){paste0(id, "_trigger_update")} + + +#' Trigger create name +#' +#' @param id the id of the module server instance +#' +#' @return the name of the corresponding reactive value +#' @export +#' +#' @examples +#' trigger_create_name(id = "mydata") + +trigger_create_name <- function(id){paste0(id, "_trigger_create")} From 06cb90c54f1db0ee52c65198b2f3e04826cd11a9 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Sat, 13 Apr 2024 10:27:02 +0200 Subject: [PATCH 12/39] documentation #252 --- NAMESPACE | 2 ++ man/clicked_column_name.Rd | 20 ++++++++++++++++++++ man/trigger_create_name.Rd | 20 ++++++++++++++++++++ 3 files changed, 42 insertions(+) create mode 100644 man/clicked_column_name.Rd create mode 100644 man/trigger_create_name.Rd diff --git a/NAMESPACE b/NAMESPACE index 1058bc3..01690d3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand export(admin_ui) +export(clicked_column_name) export(create_BTN) export(data_model) export(date_slider_INPUT) @@ -38,6 +39,7 @@ export(kitemsManager_Server) export(runExample) export(selected_items_name) export(trigger_add_name) +export(trigger_create_name) export(trigger_delete_name) export(trigger_save_name) export(trigger_update_name) diff --git a/man/clicked_column_name.Rd b/man/clicked_column_name.Rd new file mode 100644 index 0000000..d2d28ea --- /dev/null +++ b/man/clicked_column_name.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/kitems_names.R +\name{clicked_column_name} +\alias{clicked_column_name} +\title{Clicked column name} +\usage{ +clicked_column_name(id) +} +\arguments{ +\item{id}{the id of the module server instance} +} +\value{ +the name of the corresponding reactive value +} +\description{ +Clicked column name +} +\examples{ +clicked_column_name(id = "mydata") +} diff --git a/man/trigger_create_name.Rd b/man/trigger_create_name.Rd new file mode 100644 index 0000000..8dd37c3 --- /dev/null +++ b/man/trigger_create_name.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/kitems_names.R +\name{trigger_create_name} +\alias{trigger_create_name} +\title{Trigger create name} +\usage{ +trigger_create_name(id) +} +\arguments{ +\item{id}{the id of the module server instance} +} +\value{ +the name of the corresponding reactive value +} +\description{ +Trigger create name +} +\examples{ +trigger_create_name(id = "mydata") +} From 54d44c333066a413c51fe66c8c379e06311e15c7 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Sun, 14 Apr 2024 12:51:02 +0200 Subject: [PATCH 13/39] Add ignoreInit #252 --- R/kitems_module_server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index aeef37f..567f6c7 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -1132,7 +1132,7 @@ kitemsManager_Server <- function(id, r, path, modalButton("Cancel"), actionButton(ns("confirm_create_btn"), "Create")))) - }) + }, ignoreInit = TRUE) # -- Observe: confirm_create_btn observeEvent(input$confirm_create_btn, { From d268cee6ecf8335d6330b01bef95912e6223ac77 Mon Sep 17 00:00:00 2001 From: thekangaroofactory Date: Mon, 29 Jul 2024 19:54:26 +0200 Subject: [PATCH 14/39] Fixed #256 --- R/kitems_module_server.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 567f6c7..50a49e4 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -1126,11 +1126,17 @@ kitemsManager_Server <- function(id, r, path, observeEvent({input$create_btn r[[trigger_create]]()}, { - showModal(modalDialog(inputList(ns, item = NULL, update = FALSE, data.model = r[[r_data_model]]()), - title = "Create", - footer = tagList( - modalButton("Cancel"), - actionButton(ns("confirm_create_btn"), "Create")))) + cat("************************************* \n") + str(r[[trigger_create]]()) + str(input$create_btn) + + if(r[[trigger_create]]() != 0 | input$create_btn != 0) + + showModal(modalDialog(inputList(ns, item = NULL, update = FALSE, data.model = r[[r_data_model]]()), + title = "Create", + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_create_btn"), "Create")))) }, ignoreInit = TRUE) From 4a005c33dcf963c242424ffd8b10e98c9494f420 Mon Sep 17 00:00:00 2001 From: thekangaroofactory Date: Mon, 29 Jul 2024 19:54:53 +0200 Subject: [PATCH 15/39] comment --- R/kitems_module_server.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 50a49e4..1cc85c2 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -1126,10 +1126,7 @@ kitemsManager_Server <- function(id, r, path, observeEvent({input$create_btn r[[trigger_create]]()}, { - cat("************************************* \n") - str(r[[trigger_create]]()) - str(input$create_btn) - + # -- check to avoid modal to fire at startup #256 if(r[[trigger_create]]() != 0 | input$create_btn != 0) showModal(modalDialog(inputList(ns, item = NULL, update = FALSE, data.model = r[[r_data_model]]()), From a23dc850c1e4754cd71666924efc5062063b9270 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Sat, 31 Aug 2024 22:21:06 +0200 Subject: [PATCH 16/39] Fixed #257 --- R/kitems_module_server.R | 70 +++++++++++++++---------------- inst/shiny-examples/demo/server.R | 16 +++---- 2 files changed, 43 insertions(+), 43 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 1cc85c2..1daf989 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -68,14 +68,14 @@ kitemsManager_Server <- function(id, r, path, # -- Build object names from module id (to access outside module) r_data_model <- dm_name(id) - r_items <- items_name(id) + # r_items <- items_name(id) r_filtered_items <- filtered_items_name(id) r_selected_items <- selected_items_name(id) r_clicked_column <- clicked_column_name(id) r_filter_date <- filter_date_name(id) # -- Declare reactive objects (for external use) - r[[r_items]] <- reactiveVal(NULL) + # r[[r_items]] <- reactiveVal(NULL) r[[r_filtered_items]] <- reactiveVal(NULL) r[[r_selected_items]] <- reactiveVal(NULL) r[[r_clicked_column]] <- reactiveVal(NULL) @@ -188,7 +188,7 @@ kitemsManager_Server <- function(id, r, path, r[[r_data_model]] <- reactiveVal(data.model) # -- Store items - r[[r_items]]<- reactiveVal(items) + k_items <- reactiveVal(items) # Increment the progress bar, and update the detail text. incProgress(4/4, detail = "done") @@ -217,10 +217,10 @@ kitemsManager_Server <- function(id, r, path, # -- Check parameter & observe items if(autosave) - observeEvent(r[[r_items]](), { + observeEvent(k_items(), { # -- Write - item_save(data = r[[r_items]](), + item_save(data = k_items(), file = items_url, path = path) @@ -239,8 +239,8 @@ kitemsManager_Server <- function(id, r, path, # -- add item to list & store cat(MODULE, "[TRIGGER] Add item \n") - item_list <- item_add(r[[r_items]](), r[[trigger_add]]()) - r[[r_items]](item_list) + item_list <- item_add(k_items(), r[[trigger_add]]()) + k_items(item_list) # -- notify if(is_running) @@ -254,8 +254,8 @@ kitemsManager_Server <- function(id, r, path, # -- add item to list & store cat(MODULE, "[TRIGGER] Update item \n") - item_list <- item_update(r[[r_items]](), r[[trigger_update]]()) - r[[r_items]](item_list) + item_list <- item_update(k_items(), r[[trigger_update]]()) + k_items(item_list) # -- notify if(is_running) @@ -270,8 +270,8 @@ kitemsManager_Server <- function(id, r, path, # -- add item to list & store cat(MODULE, "[TRIGGER] Delete item(s) \n") cat("-- Item(s) to be deleted =", as.character(r[[trigger_delete]]()), "\n") - item_list <- item_delete(r[[r_items]](), r[[trigger_delete]]()) - r[[r_items]](item_list) + item_list <- item_delete(k_items(), r[[trigger_delete]]()) + k_items(item_list) # -- notify if(is_running) @@ -284,7 +284,7 @@ kitemsManager_Server <- function(id, r, path, observeEvent(r[[trigger_save]](), { # -- Write - item_save(data = r[[r_items]](), + item_save(data = k_items(), file = items_url, path = path) @@ -306,7 +306,7 @@ kitemsManager_Server <- function(id, r, path, cat(MODULE, "Updating filtered item view \n") # -- Get items - items <- r[[r_items]]() + items <- k_items() # -- Apply date filter filter_date <- r[[r_filter_date]]() @@ -358,13 +358,13 @@ kitemsManager_Server <- function(id, r, path, # -------------------------------------------------------------------------- # -- Raw view for admin - output$raw_item_table <- DT::renderDT(r[[r_items]](), + output$raw_item_table <- DT::renderDT(k_items(), rownames = FALSE, options = list(lengthMenu = c(5, 10, 15), pageLength = 5, dom = "t", scrollX = TRUE), selection = list(mode = 'single', target = "row", selected = NULL)) # -- Masked view for admin (reuse of r_view_items) - output$view_item_table <- DT::renderDT(view_apply_masks(r[[r_data_model]](), r[[r_items]]()), + output$view_item_table <- DT::renderDT(view_apply_masks(r[[r_data_model]](), k_items()), rownames = FALSE, selection = list(mode = 'single', target = "row", selected = NULL)) @@ -382,7 +382,7 @@ kitemsManager_Server <- function(id, r, path, # -------------------------------------------------------------------------- # -- Default view (reuse of r_view_items, includes dm masks) - output$default_view <- DT::renderDT(view_apply_masks(r[[r_data_model]](), r[[r_items]]()), + output$default_view <- DT::renderDT(view_apply_masks(r[[r_data_model]](), k_items()), rownames = FALSE, selection = list(mode = 'multiple', target = "row", selected = NULL)) @@ -408,7 +408,7 @@ kitemsManager_Server <- function(id, r, path, cat(MODULE, "Selected rows (default view) =", input$default_view_rows_selected, "\n") # -- Get item ids from the default view - ids <- r[[r_items]]()[input$default_view_rows_selected, ]$id + ids <- k_items()[input$default_view_rows_selected, ]$id cat("-- ids =", as.character(ids), "\n") } @@ -477,10 +477,10 @@ kitemsManager_Server <- function(id, r, path, if(hasDate(r[[r_data_model]]())){ # -- Get min/max - if(dim(r[[r_items]]())[1] > 0){ + if(dim(k_items())[1] > 0){ - min <- min(r[[r_items]]()$date) - max <- max(r[[r_items]]()$date) + min <- min(k_items()$date) + max <- max(k_items()$date) } else { @@ -727,7 +727,7 @@ kitemsManager_Server <- function(id, r, path, items <- item_check_integrity(items = items, data.model = data.model) # -- Store items & data model - r[[r_items]](items) + k_items(items) r[[r_data_model]](data.model) # -- notify @@ -803,9 +803,9 @@ kitemsManager_Server <- function(id, r, path, removeModal() # -- drop column! & store - items <- r[[r_items]]() + items <- k_items() items[input$dm_dz_att_name] <- NULL - r[[r_items]](items) + k_items(items) # -- update data model & store dm <- r[[r_data_model]]() @@ -886,7 +886,7 @@ kitemsManager_Server <- function(id, r, path, create = TRUE) # -- store items - r[[r_items]](items) + k_items(items) }) @@ -936,12 +936,12 @@ kitemsManager_Server <- function(id, r, path, value <- dm_get_default(data.model = dm, name = input$dm_att_name) # -- Add column to items & store - items <- item_add_attribute(r[[r_items]](), name = input$dm_att_name, type = input$dm_att_type, fill = value) - r[[r_items]](items) + items <- item_add_attribute(k_items(), name = input$dm_att_name, type = input$dm_att_type, fill = value) + k_items(items) # -- update form # in case an attribute from template was added, it's necessary to drop it from available choices - output$dm_att_form <- dm_inputs_ui(names = TEMPLATE_DATA_MODEL$name[!TEMPLATE_DATA_MODEL$name %in% colnames(r[[r_items]]())], + output$dm_att_form <- dm_inputs_ui(names = TEMPLATE_DATA_MODEL$name[!TEMPLATE_DATA_MODEL$name %in% colnames(k_items())], types = OBJECT_CLASS, ns = ns) @@ -958,10 +958,10 @@ kitemsManager_Server <- function(id, r, path, if(is.null(row)){ # -- update form (creation mode, only if r_items not NULL) - if(is.null(r[[r_items]]())) + if(is.null(k_items())) output$dm_att_form <- NULL else - output$dm_att_form <- dm_inputs_ui(names = TEMPLATE_DATA_MODEL$name[!TEMPLATE_DATA_MODEL$name %in% colnames(r[[r_items]]())], + output$dm_att_form <- dm_inputs_ui(names = TEMPLATE_DATA_MODEL$name[!TEMPLATE_DATA_MODEL$name %in% colnames(k_items())], types = OBJECT_CLASS, ns = ns) @@ -1052,12 +1052,12 @@ kitemsManager_Server <- function(id, r, path, observeEvent(input$dm_order_cols, { # -- Check - req(length(input$dm_order_cols) == dim(r[[r_items]]())[2]) + req(length(input$dm_order_cols) == dim(k_items())[2]) cat("[BTN] Reorder column \n") # -- Reorder items & store - r[[r_items]](r[[r_items]]()[input$dm_order_cols]) + k_items(k_items()[input$dm_order_cols]) # -- Reorder data model & store dm <- r[[r_data_model]]() @@ -1180,7 +1180,7 @@ kitemsManager_Server <- function(id, r, path, cat(MODULE, "[EVENT] Update item \n") # -- Get selected item - item <- r[[r_items]]()[r[[r_items]]()$id == r[[r_selected_items]](), ] + item <- k_items()[k_items()$id == r[[r_selected_items]](), ] # -- Dialog showModal(modalDialog(inputList(ns, item = item, update = TRUE, data.model = r[[r_data_model]]()), @@ -1262,11 +1262,11 @@ kitemsManager_Server <- function(id, r, path, # -------------------------------------------------------------------------- - # Sandbox: + # Module server return value: # -------------------------------------------------------------------------- - - + # -- the reference (not the value!) + k_items }) } diff --git a/inst/shiny-examples/demo/server.R b/inst/shiny-examples/demo/server.R index b35966c..256370d 100644 --- a/inst/shiny-examples/demo/server.R +++ b/inst/shiny-examples/demo/server.R @@ -25,13 +25,13 @@ shinyServer( # ------------------------------------- # -- start module server: data - kitems::kitemsManager_Server(id = "data", r = r, path = demo_dir, - create = TRUE, autosave = FALSE) + data <- kitems::kitemsManager_Server(id = "data", r = r, path = demo_dir, + create = TRUE, autosave = FALSE) # -- start module server: data_2 - kitems::kitemsManager_Server(id = "data_2", r = r, path = demo_dir, - create = TRUE, autosave = FALSE) + data_2 <- kitems::kitemsManager_Server(id = "data_2", r = r, path = demo_dir, + create = TRUE, autosave = FALSE) # ------------------------------------- @@ -39,16 +39,16 @@ shinyServer( # ------------------------------------- # -- data - observeEvent(r$data_items(), { + observeEvent(data(), { - cat("Main application server observeEvent: data_items() has just been updated \n") + cat("Main application server observeEvent: data_1() has just been updated \n") }) # -- data_2 - observeEvent(r$data_2_items(), { + observeEvent(data_2(), { - cat("Main application server observeEvent: data2_items() has just been updated \n") + cat("Main application server observeEvent: data_2() has just been updated \n") }) From d33973bc406228e811012bce6e21ff8b420dbcbb Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Sun, 1 Sep 2024 20:13:01 +0200 Subject: [PATCH 17/39] data_model (Fixed #258) --- R/dm_get_list.R | 26 ---------- R/dynamic_sidebar.R | 11 ++-- R/kitems_module_server.R | 83 +++++++++++++++---------------- inst/shiny-examples/demo/server.R | 8 +-- 4 files changed, 49 insertions(+), 79 deletions(-) delete mode 100644 R/dm_get_list.R diff --git a/R/dm_get_list.R b/R/dm_get_list.R deleted file mode 100644 index f54abfa..0000000 --- a/R/dm_get_list.R +++ /dev/null @@ -1,26 +0,0 @@ - - -#' Available data models -#' -#' @param r the shared reactive communication object -#' -#' @return a list with the names (ids) of the data models available in session -#' -#' @examples -#' \dontrun{ -#' dm_get_list(r) -#' } - - -dm_get_list <- function(r){ - - # -- Get data models from r - values <- isolate(reactiveValuesToList(r)) - values <- names(values) - values <- values[grep("_data_model", values)] - values <- strsplit(values, "_data_model") - - # -- Return - values - -} diff --git a/R/dynamic_sidebar.R b/R/dynamic_sidebar.R index b9e1bec..88d9478 100644 --- a/R/dynamic_sidebar.R +++ b/R/dynamic_sidebar.R @@ -2,21 +2,18 @@ #' Generate dynamic menuItem #' -#' @param r the reactive shared communication object +#' @param names a list of the data model names #' #' @return a sidebarMenu menuItem object with one menuSubItem per data model #' @export #' #' @examples #' \dontrun{ -#' dynamic_sidebar(r) +#' dynamic_sidebar(names = list("data", "data2")) #' } -dynamic_sidebar <- function(r){ - - # -- Get data model list - dm_list <- dm_get_list(r = r) +dynamic_sidebar <- function(names){ # -- Helper: return sub item helper <- function(name){ @@ -24,7 +21,7 @@ dynamic_sidebar <- function(r){ icon = shiny::icon("angle-double-right"))} # -- Apply helper - subitems <- lapply(dm_list, FUN = helper) + subitems <- lapply(names, FUN = helper) # -- Return sidebar sidebarMenu( diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 1daf989..449d7d2 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -67,8 +67,6 @@ kitemsManager_Server <- function(id, r, path, items_url <- file.path(path, paste0(items_name(id), ".csv")) # -- Build object names from module id (to access outside module) - r_data_model <- dm_name(id) - # r_items <- items_name(id) r_filtered_items <- filtered_items_name(id) r_selected_items <- selected_items_name(id) r_clicked_column <- clicked_column_name(id) @@ -185,7 +183,7 @@ kitemsManager_Server <- function(id, r, path, # ------------------------------------------------------------------------ # -- Store data model (either content of the RDS or the server function input) - r[[r_data_model]] <- reactiveVal(data.model) + k_data_model <- reactiveVal(data.model) # -- Store items k_items <- reactiveVal(items) @@ -202,10 +200,10 @@ kitemsManager_Server <- function(id, r, path, # -- Check parameter & observe data model if(autosave) - observeEvent(r[[r_data_model]](), { + observeEvent(k_data_model(), { # -- Write & notify - saveRDS(r[[r_data_model]](), file = dm_url) + saveRDS(k_data_model(), file = dm_url) cat(MODULE, "[EVENT] Data model has been (auto) saved \n") }, ignoreInit = TRUE) @@ -364,14 +362,14 @@ kitemsManager_Server <- function(id, r, path, selection = list(mode = 'single', target = "row", selected = NULL)) # -- Masked view for admin (reuse of r_view_items) - output$view_item_table <- DT::renderDT(view_apply_masks(r[[r_data_model]](), k_items()), + output$view_item_table <- DT::renderDT(view_apply_masks(k_data_model(), k_items()), rownames = FALSE, selection = list(mode = 'single', target = "row", selected = NULL)) # -- colClasses for admin # setting rownames = FALSE #209 # setting dom = "tpl" instead of "t" #245 - output$data_model <- DT::renderDT(dm_table_mask(r[[r_data_model]]()), + output$data_model <- DT::renderDT(dm_table_mask(k_data_model()), rownames = FALSE, options = list(lengthMenu = c(5, 10, 15), pageLength = 10, dom = "tpl", scrollX = TRUE), selection = list(mode = 'single', target = "row", selected = isolate(input$data_model_rows_selected))) @@ -382,12 +380,12 @@ kitemsManager_Server <- function(id, r, path, # -------------------------------------------------------------------------- # -- Default view (reuse of r_view_items, includes dm masks) - output$default_view <- DT::renderDT(view_apply_masks(r[[r_data_model]](), k_items()), + output$default_view <- DT::renderDT(view_apply_masks(k_data_model(), k_items()), rownames = FALSE, selection = list(mode = 'multiple', target = "row", selected = NULL)) # -- Filtered view - output$filtered_view <- DT::renderDT(view_apply_masks(r[[r_data_model]](), r[[r_filtered_items]]()), + output$filtered_view <- DT::renderDT(view_apply_masks(k_data_model(), r[[r_filtered_items]]()), rownames = FALSE, selection = list(mode = 'multiple', target = "row", selected = NULL)) @@ -446,7 +444,7 @@ kitemsManager_Server <- function(id, r, path, observeEvent(input$filtered_view_cell_clicked$col, { # -- Get table col names (need to apply masks to get correct columns, hence sending only first row) - cols <- colnames(view_apply_masks(r[[r_data_model]](), head(r[[r_filtered_items]](), n = 1))) + cols <- colnames(view_apply_masks(k_data_model(), head(r[[r_filtered_items]](), n = 1))) # -- Get name of the clicked column col_clicked <- cols[input$filtered_view_cell_clicked$col + 1] @@ -474,7 +472,7 @@ kitemsManager_Server <- function(id, r, path, output$date_slider <- renderUI({ # -- check data model - if(hasDate(r[[r_data_model]]())){ + if(hasDate(k_data_model())){ # -- Get min/max if(dim(k_items())[1] > 0){ @@ -535,7 +533,7 @@ kitemsManager_Server <- function(id, r, path, output$admin_dm_tab <- renderUI({ # -- check NULL data model - if(is.null(r[[r_data_model]]())){ + if(is.null(k_data_model())){ # -- display create / import btns fluidRow(column(width = 12, @@ -573,7 +571,7 @@ kitemsManager_Server <- function(id, r, path, output$admin_raw_tab <- renderUI({ # -- check NULL data model - if(!is.null(r[[r_data_model]]())){ + if(!is.null(k_data_model())){ # -- display raw table fluidRow(column(width = 2, @@ -593,7 +591,7 @@ kitemsManager_Server <- function(id, r, path, output$admin_view_tab <- renderUI({ # -- check NULL data model - if(!is.null(r[[r_data_model]]())){ + if(!is.null(k_data_model())){ # -- display view table fluidRow(column(width = 2, @@ -728,7 +726,7 @@ kitemsManager_Server <- function(id, r, path, # -- Store items & data model k_items(items) - r[[r_data_model]](data.model) + data_model(data.model) # -- notify if(is_running) @@ -749,7 +747,7 @@ kitemsManager_Server <- function(id, r, path, output$dm_danger_btn <- renderUI( # -- Check for NULL data model - if(!is.null(r[[r_data_model]]())) + if(!is.null(k_data_model())) shinyWidgets::materialSwitch(inputId = ns("adm_dz_toggle"), label = "Danger zone", value = FALSE, @@ -770,7 +768,7 @@ kitemsManager_Server <- function(id, r, path, # -- select attribute name selectizeInput(inputId = ns("dm_dz_att_name"), label = "Name", - choices = r[[r_data_model]]()$name, + choices = k_data_model()$name, selected = NULL, options = list(create = FALSE, placeholder = 'Type or select an option below', @@ -808,9 +806,9 @@ kitemsManager_Server <- function(id, r, path, k_items(items) # -- update data model & store - dm <- r[[r_data_model]]() + dm <- k_data_model() dm <- dm[dm$name != input$dm_dz_att_name, ] - r[[r_data_model]](dm) + data_model(dm) }) @@ -876,7 +874,7 @@ kitemsManager_Server <- function(id, r, path, skip = skip) # -- store - r[[r_data_model]](dm) + data_model(dm) # -- init items cat(MODULE, "-- Init data \n") @@ -920,7 +918,7 @@ kitemsManager_Server <- function(id, r, path, # Add attribute to the data model & store - dm <- r[[r_data_model]]() + dm <- k_data_model() dm <- dm_add_attribute(data.model = dm, name = input$dm_att_name, type = input$dm_att_type, @@ -930,7 +928,7 @@ kitemsManager_Server <- function(id, r, path, filter = FALSE) # -- store - r[[r_data_model]](dm) + data_model(dm) # -- get default value value <- dm_get_default(data.model = dm, name = input$dm_att_name) @@ -968,7 +966,7 @@ kitemsManager_Server <- function(id, r, path, } else { # -- get attribute to update - attribute <- r[[r_data_model]]()[row, ] + attribute <- k_data_model()[row, ] # -- update form (update mode) output$dm_att_form <- dm_inputs_ui(update = TRUE, attribute = attribute, ns = ns) @@ -990,7 +988,7 @@ kitemsManager_Server <- function(id, r, path, row <- input$data_model_rows_selected # -- get data model - dm <- r[[r_data_model]]() + dm <- k_data_model() # -- default val & fun if(input$dm_default_choice == "none"){ @@ -1020,7 +1018,7 @@ kitemsManager_Server <- function(id, r, path, skip = skip) # -- store - r[[r_data_model]](dm) + data_model(dm) }) @@ -1033,7 +1031,7 @@ kitemsManager_Server <- function(id, r, path, output$dm_sort_buttons <- renderUI( # -- check NULL data model - if(is.null(r[[r_data_model]]())) + if(is.null(k_data_model())) NULL else { @@ -1043,8 +1041,8 @@ kitemsManager_Server <- function(id, r, path, # order attribute name selectizeInput(inputId = ns("dm_order_cols"), label = "Select cols order", - choices = r[[r_data_model]]()$name, - selected = r[[r_data_model]]()$name, + choices = k_data_model()$name, + selected = k_data_model()$name, multiple = TRUE))}) @@ -1060,9 +1058,9 @@ kitemsManager_Server <- function(id, r, path, k_items(k_items()[input$dm_order_cols]) # -- Reorder data model & store - dm <- r[[r_data_model]]() + dm <- k_data_model() dm <- dm[match(input$dm_order_cols, dm$name), ] - r[[r_data_model]](dm) + data_model(dm) }) @@ -1075,13 +1073,13 @@ kitemsManager_Server <- function(id, r, path, output$adm_filter_buttons <- renderUI( # -- check NULL data model - if(is.null(r[[r_data_model]]())) + if(is.null(k_data_model())) NULL else { # -- init params - filter_cols <- dm_filter(r[[r_data_model]]()) + filter_cols <- dm_filter(k_data_model()) onInitialize <- if(is.null(filter_cols)) I('function() { this.setValue(""); }') @@ -1091,7 +1089,7 @@ kitemsManager_Server <- function(id, r, path, # -- define input selectizeInput(inputId = ns("adm_filter_col"), label = "Filter columns", - choices = r[[r_data_model]]()$name, + choices = k_data_model()$name, selected = filter_cols, multiple = TRUE, options = list(create = FALSE, @@ -1103,12 +1101,12 @@ kitemsManager_Server <- function(id, r, path, observeEvent(input$adm_filter_col, { cat("[BTN] Filter columns:", input$adm_filter_col, "\n") - dm <- r[[r_data_model]]() + dm <- k_data_model() # -- Check NULL data model if(!is.null(dm)){ dm <- dm_filter_set(data.model = dm, filter = input$adm_filter_col) - r[[r_data_model]](dm)} + data_model(dm)} }, ignoreInit = TRUE, ignoreNULL = FALSE) @@ -1129,7 +1127,7 @@ kitemsManager_Server <- function(id, r, path, # -- check to avoid modal to fire at startup #256 if(r[[trigger_create]]() != 0 | input$create_btn != 0) - showModal(modalDialog(inputList(ns, item = NULL, update = FALSE, data.model = r[[r_data_model]]()), + showModal(modalDialog(inputList(ns, item = NULL, update = FALSE, data.model = k_data_model()), title = "Create", footer = tagList( modalButton("Cancel"), @@ -1147,11 +1145,11 @@ kitemsManager_Server <- function(id, r, path, # -- get list of input values & name it cat("-- Get list of input values \n") - input_values <- get_input_values(input, dm_colClasses(r[[r_data_model]]())) + input_values <- get_input_values(input, dm_colClasses(k_data_model())) # -- create item based on input list cat("-- Create item \n") - item <- item_create(values = input_values, data.model = r[[r_data_model]]()) + item <- item_create(values = input_values, data.model = k_data_model()) # -- call trigger r[[trigger_add]](item) @@ -1183,7 +1181,7 @@ kitemsManager_Server <- function(id, r, path, item <- k_items()[k_items()$id == r[[r_selected_items]](), ] # -- Dialog - showModal(modalDialog(inputList(ns, item = item, update = TRUE, data.model = r[[r_data_model]]()), + showModal(modalDialog(inputList(ns, item = item, update = TRUE, data.model = k_data_model()), title = "Update", footer = tagList( modalButton("Cancel"), @@ -1201,14 +1199,14 @@ kitemsManager_Server <- function(id, r, path, # -- get list of input values & name it cat("-- Get list of input values \n") - input_values <- get_input_values(input, dm_colClasses(r[[r_data_model]]())) + input_values <- get_input_values(input, dm_colClasses(k_data_model())) # -- update id (to replace selected item) input_values$id <- r[[r_selected_items]]() # -- create item based on input list cat("-- Create item \n") - item <- item_create(values = input_values, data.model = r[[r_data_model]]()) + item <- item_create(values = input_values, data.model = k_data_model()) # -- update item & store cat("-- Call update trigger \n") @@ -1266,7 +1264,8 @@ kitemsManager_Server <- function(id, r, path, # -------------------------------------------------------------------------- # -- the reference (not the value!) - k_items + list(items = k_items, + data_model = k_data_model) }) } diff --git a/inst/shiny-examples/demo/server.R b/inst/shiny-examples/demo/server.R index 256370d..1185847 100644 --- a/inst/shiny-examples/demo/server.R +++ b/inst/shiny-examples/demo/server.R @@ -26,7 +26,7 @@ shinyServer( # -- start module server: data data <- kitems::kitemsManager_Server(id = "data", r = r, path = demo_dir, - create = TRUE, autosave = FALSE) + create = TRUE, autosave = FALSE) # -- start module server: data_2 @@ -39,14 +39,14 @@ shinyServer( # ------------------------------------- # -- data - observeEvent(data(), { + observeEvent(data$items(), { cat("Main application server observeEvent: data_1() has just been updated \n") }) # -- data_2 - observeEvent(data_2(), { + observeEvent(data_2$items(), { cat("Main application server observeEvent: data_2() has just been updated \n") @@ -58,7 +58,7 @@ shinyServer( # ------------------------------------- # -- adding pkg::fun() call #205 - output$menu <- renderMenu(kitems::dynamic_sidebar(r)) + output$menu <- renderMenu(kitems::dynamic_sidebar(names = list("data", "data_2"))) } From 716d634a3a389cacc58aa416aaa96bc775a854e5 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 10:28:28 +0200 Subject: [PATCH 18/39] update doc --- man/dm_get_list.Rd | 22 ---------------------- man/dynamic_sidebar.Rd | 6 +++--- 2 files changed, 3 insertions(+), 25 deletions(-) delete mode 100644 man/dm_get_list.Rd diff --git a/man/dm_get_list.Rd b/man/dm_get_list.Rd deleted file mode 100644 index 5ad6091..0000000 --- a/man/dm_get_list.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dm_get_list.R -\name{dm_get_list} -\alias{dm_get_list} -\title{Available data models} -\usage{ -dm_get_list(r) -} -\arguments{ -\item{r}{the shared reactive communication object} -} -\value{ -a list with the names (ids) of the data models available in session -} -\description{ -Available data models -} -\examples{ -\dontrun{ -dm_get_list(r) -} -} diff --git a/man/dynamic_sidebar.Rd b/man/dynamic_sidebar.Rd index 3a78d31..9e7abcc 100644 --- a/man/dynamic_sidebar.Rd +++ b/man/dynamic_sidebar.Rd @@ -4,10 +4,10 @@ \alias{dynamic_sidebar} \title{Generate dynamic menuItem} \usage{ -dynamic_sidebar(r) +dynamic_sidebar(names) } \arguments{ -\item{r}{the reactive shared communication object} +\item{names}{a list of the data model names} } \value{ a sidebarMenu menuItem object with one menuSubItem per data model @@ -17,6 +17,6 @@ Generate dynamic menuItem } \examples{ \dontrun{ -dynamic_sidebar(r) +dynamic_sidebar(names = list("data", "data2")) } } From 0bcdede7fa00c694539acefd6658e7742e700f3a Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 10:29:06 +0200 Subject: [PATCH 19/39] Fixed #259 --- R/item_add.R | 19 +++++++++++++------ R/kitems_module_server.R | 34 +++++++++++++++++----------------- 2 files changed, 30 insertions(+), 23 deletions(-) diff --git a/R/item_add.R b/R/item_add.R index b6fca0e..f8cd777 100644 --- a/R/item_add.R +++ b/R/item_add.R @@ -3,19 +3,26 @@ #' Add item #' #' @param item an item data.frame to be added -#' @param items the items data.frame +#' @param items the reference! of the reactive value carrying the items +#' @param name an optional character string to display along with the notification (basically the name of the item) #' -#' @return the updated items data.frame #' @export #' #' @examples #' \dontrun{ -#' item_add(items = myitems, item = mynewitem) +#' item_add(items = myitems, item = mynewitem, name = "myitem") #' } -item_add <- function(items, item){ +item_add <- function(items, item, name = NULL){ - # -- rbind - items <- rbind(items, item) + # -- check items + stopifnot("reactiveVal" %in% class(items)) + + # -- rbind & store + items(rbind(items(), item)) + + # -- notify + if(shiny::isRunning()) + showNotification(paste(name, "Item created."), type = "message") } diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 449d7d2..f9919a9 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -73,26 +73,25 @@ kitemsManager_Server <- function(id, r, path, r_filter_date <- filter_date_name(id) # -- Declare reactive objects (for external use) - # r[[r_items]] <- reactiveVal(NULL) r[[r_filtered_items]] <- reactiveVal(NULL) r[[r_selected_items]] <- reactiveVal(NULL) r[[r_clicked_column]] <- reactiveVal(NULL) r[[r_filter_date]] <- reactiveVal(NULL) # -- Build triggers names from module id - trigger_add <- trigger_add_name(id) + # trigger_add <- trigger_add_name(id) trigger_update <- trigger_update_name(id) trigger_delete <- trigger_delete_name(id) trigger_save <- trigger_save_name(id) trigger_create <- trigger_create_name(id) # -- Declare reactive objects (for external use) - r[[trigger_add]] <- reactiveVal(NULL) + # r[[trigger_add]] <- reactiveVal(NULL) r[[trigger_update]] <- reactiveVal(NULL) r[[trigger_delete]] <- reactiveVal(NULL) r[[trigger_save]] <- reactiveVal(0) r[[trigger_create]] <- reactiveVal(0) - cat(MODULE, "trigger_add available @", trigger_add, "\n") + # cat(MODULE, "trigger_add available @", trigger_add, "\n") cat(MODULE, "trigger_update available @", trigger_update, "\n") cat(MODULE, "trigger_delete available @", trigger_delete, "\n") cat(MODULE, "trigger_save available @", trigger_save, "\n") @@ -233,18 +232,18 @@ kitemsManager_Server <- function(id, r, path, # -------------------------------------------------------------------------- # -- Observe: trigger_add - observeEvent(r[[trigger_add]](), { - - # -- add item to list & store - cat(MODULE, "[TRIGGER] Add item \n") - item_list <- item_add(k_items(), r[[trigger_add]]()) - k_items(item_list) - - # -- notify - if(is_running) - showNotification(paste(MODULE, "Item created."), type = "message") - - }, ignoreInit = TRUE) + # observeEvent(r[[trigger_add]](), { + # + # # -- add item to list & store + # cat(MODULE, "[TRIGGER] Add item \n") + # item_list <- item_add(k_items(), r[[trigger_add]]()) + # k_items(item_list) + # + # # -- notify + # if(is_running) + # showNotification(paste(MODULE, "Item created."), type = "message") + # + # }, ignoreInit = TRUE) # -- Observe: trigger_update @@ -1152,7 +1151,8 @@ kitemsManager_Server <- function(id, r, path, item <- item_create(values = input_values, data.model = k_data_model()) # -- call trigger - r[[trigger_add]](item) + # r[[trigger_add]](item) + item_add(k_items, item, name = "xxx") }) From 19f15d9b0cade9dcee6efdd89d70d287001d1cbf Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 11:16:55 +0200 Subject: [PATCH 20/39] cleanup #259 --- R/kitems_module_server.R | 23 ++--------------------- 1 file changed, 2 insertions(+), 21 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index f9919a9..1e8e236 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -79,19 +79,16 @@ kitemsManager_Server <- function(id, r, path, r[[r_filter_date]] <- reactiveVal(NULL) # -- Build triggers names from module id - # trigger_add <- trigger_add_name(id) trigger_update <- trigger_update_name(id) trigger_delete <- trigger_delete_name(id) trigger_save <- trigger_save_name(id) trigger_create <- trigger_create_name(id) # -- Declare reactive objects (for external use) - # r[[trigger_add]] <- reactiveVal(NULL) r[[trigger_update]] <- reactiveVal(NULL) r[[trigger_delete]] <- reactiveVal(NULL) r[[trigger_save]] <- reactiveVal(0) r[[trigger_create]] <- reactiveVal(0) - # cat(MODULE, "trigger_add available @", trigger_add, "\n") cat(MODULE, "trigger_update available @", trigger_update, "\n") cat(MODULE, "trigger_delete available @", trigger_delete, "\n") cat(MODULE, "trigger_save available @", trigger_save, "\n") @@ -231,21 +228,6 @@ kitemsManager_Server <- function(id, r, path, # Triggers: # -------------------------------------------------------------------------- - # -- Observe: trigger_add - # observeEvent(r[[trigger_add]](), { - # - # # -- add item to list & store - # cat(MODULE, "[TRIGGER] Add item \n") - # item_list <- item_add(k_items(), r[[trigger_add]]()) - # k_items(item_list) - # - # # -- notify - # if(is_running) - # showNotification(paste(MODULE, "Item created."), type = "message") - # - # }, ignoreInit = TRUE) - - # -- Observe: trigger_update observeEvent(r[[trigger_update]](), { @@ -1150,9 +1132,8 @@ kitemsManager_Server <- function(id, r, path, cat("-- Create item \n") item <- item_create(values = input_values, data.model = k_data_model()) - # -- call trigger - # r[[trigger_add]](item) - item_add(k_items, item, name = "xxx") + # -- update reactive + item_add(k_items, item, name = id) }) From 383c96bc939f73df406c041e54781a84975e5600 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 11:17:56 +0200 Subject: [PATCH 21/39] update --- man/item_add.Rd | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/man/item_add.Rd b/man/item_add.Rd index 85e6bf3..bb40ba0 100644 --- a/man/item_add.Rd +++ b/man/item_add.Rd @@ -4,21 +4,20 @@ \alias{item_add} \title{Add item} \usage{ -item_add(items, item) +item_add(items, item, name = NULL) } \arguments{ -\item{items}{the items data.frame} +\item{items}{the reference! of the reactive value carrying the items} \item{item}{an item data.frame to be added} -} -\value{ -the updated items data.frame + +\item{name}{an optional character string to display along with the notification (basically the name of the item)} } \description{ Add item } \examples{ \dontrun{ -item_add(items = myitems, item = mynewitem) +item_add(items = myitems, item = mynewitem, name = "myitem") } } From 02efafdb23246e70be9a72022c912b7237403542 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 11:27:50 +0200 Subject: [PATCH 22/39] Fixed #260 --- R/kitems_module_server.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 1e8e236..1ebb5ac 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -1245,7 +1245,8 @@ kitemsManager_Server <- function(id, r, path, # -------------------------------------------------------------------------- # -- the reference (not the value!) - list(items = k_items, + list(id = id, + items = k_items, data_model = k_data_model) }) From 6ba999195e67dbc46660fc1548f0b1663aaf1295 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 14:06:00 +0200 Subject: [PATCH 23/39] Fixed #261 --- R/item_update.R | 27 ++++++++++++++++----------- R/kitems_module_server.R | 31 ++++++++++++++----------------- man/item_update.Rd | 13 ++++++------- 3 files changed, 36 insertions(+), 35 deletions(-) diff --git a/R/item_update.R b/R/item_update.R index 7766992..52c4e6c 100644 --- a/R/item_update.R +++ b/R/item_update.R @@ -2,10 +2,10 @@ #' Update item #' -#' @param items a data.frame of the items -#' @param item the items to be updated +#' @param items the reference! of the reactiveVal carrying the data.frame of the items +#' @param item the item to be updated +#' @param name a character string used inside the notification (typically the name of the items) #' -#' @return an updated data.frame of the items #' @export #' #' @details @@ -13,19 +13,24 @@ #' #' @examples #' \dontrun{ -#' item_update(items = myitems, item = myupdateditem) +#' item_update(items = myitems, item = myupdateditem, name = "myitem") #' } -item_update <- function(items, item){ +item_update <- function(items, item, name = NULL){ - # -- get target item id - id <- item$id + # -- check items + stopifnot("reactiveVal" %in% class(items)) - # -- update row - items[items$id == id, ] <- item + # -- get value & update + x <- items() + x[x$id == item$id, ] <- item - # -- return - items + # -- store + items(x) + + # -- notify + if(shiny::isRunning()) + showNotification(paste(name, "Item updated."), type = "message") } diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 1ebb5ac..f1d56ee 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -79,17 +79,14 @@ kitemsManager_Server <- function(id, r, path, r[[r_filter_date]] <- reactiveVal(NULL) # -- Build triggers names from module id - trigger_update <- trigger_update_name(id) trigger_delete <- trigger_delete_name(id) trigger_save <- trigger_save_name(id) trigger_create <- trigger_create_name(id) # -- Declare reactive objects (for external use) - r[[trigger_update]] <- reactiveVal(NULL) r[[trigger_delete]] <- reactiveVal(NULL) r[[trigger_save]] <- reactiveVal(0) r[[trigger_create]] <- reactiveVal(0) - cat(MODULE, "trigger_update available @", trigger_update, "\n") cat(MODULE, "trigger_delete available @", trigger_delete, "\n") cat(MODULE, "trigger_save available @", trigger_save, "\n") cat(MODULE, "trigger_create available @", trigger_create, "\n") @@ -229,18 +226,18 @@ kitemsManager_Server <- function(id, r, path, # -------------------------------------------------------------------------- # -- Observe: trigger_update - observeEvent(r[[trigger_update]](), { - - # -- add item to list & store - cat(MODULE, "[TRIGGER] Update item \n") - item_list <- item_update(k_items(), r[[trigger_update]]()) - k_items(item_list) - - # -- notify - if(is_running) - showNotification(paste(MODULE, "Item updated."), type = "message") - - }, ignoreInit = TRUE) + # observeEvent(r[[trigger_update]](), { + # + # # -- add item to list & store + # cat(MODULE, "[TRIGGER] Update item \n") + # item_list <- item_update(k_items(), r[[trigger_update]]()) + # k_items(item_list) + # + # # -- notify + # if(is_running) + # showNotification(paste(MODULE, "Item updated."), type = "message") + # + # }, ignoreInit = TRUE) # -- Observe: trigger_delete @@ -1190,8 +1187,8 @@ kitemsManager_Server <- function(id, r, path, item <- item_create(values = input_values, data.model = k_data_model()) # -- update item & store - cat("-- Call update trigger \n") - r[[trigger_update]](item) + cat("-- Update item \n") + item_update(k_items, item, name = id) }) diff --git a/man/item_update.Rd b/man/item_update.Rd index 41aab47..b72af00 100644 --- a/man/item_update.Rd +++ b/man/item_update.Rd @@ -4,15 +4,14 @@ \alias{item_update} \title{Update item} \usage{ -item_update(items, item) +item_update(items, item, name = NULL) } \arguments{ -\item{items}{a data.frame of the items} +\item{items}{the reference! of the reactiveVal carrying the data.frame of the items} -\item{item}{the items to be updated} -} -\value{ -an updated data.frame of the items +\item{item}{the item to be updated} + +\item{name}{a character string used inside the notification (typically the name of the items)} } \description{ Update item @@ -22,6 +21,6 @@ The item$id value will be used to replace the corresponding item in the items da } \examples{ \dontrun{ -item_update(items = myitems, item = myupdateditem) +item_update(items = myitems, item = myupdateditem, name = "myitem") } } From 3722db4017296bd480cd28ff3fd1914dcf100d31 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 14:38:31 +0200 Subject: [PATCH 24/39] Fixed #262 --- R/item_delete.R | 24 +++++++++++++++++++----- R/kitems_module_server.R | 38 ++------------------------------------ 2 files changed, 21 insertions(+), 41 deletions(-) diff --git a/R/item_delete.R b/R/item_delete.R index 3360037..9dfbff9 100644 --- a/R/item_delete.R +++ b/R/item_delete.R @@ -2,21 +2,35 @@ #' Delete item #' -#' @param items a data.frame of the items +#' @param items the reference! of the reactive value carrying the items #' @param id the id of the item to delete +#' @param name a character string used inside the notification (typically the name of the items) #' #' @return an updated data.frame of the items #' @export #' #' @examples #' \dontrun{ -#' item_delete(items = myitems, id = 123456789) +#' item_delete(items = myitems, id = 123456789, name = "myitems") #' } -item_delete <- function(items, id){ +item_delete <- function(items, id, name = NULL){ - # -- drop item - items[!items$id %in% id, ] + # -- check items + stopifnot("reactiveVal" %in% class(items)) + + # -- trace + MODULE <- paste0("[", ifelse(is.null(name), "kitems", name), "]") + cat(MODULE, "Delete item(s) \n") + cat("-- Item(s) to be deleted =", as.character(id), "\n") + + # -- drop item & store + x <- items()[!items()$id %in% id, ] + items(x) + + # -- notify + if(shiny::isRunning()) + showNotification(paste(MODULE, "Item(s) deleted."), type = "message") } diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index f1d56ee..a8a0b30 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -79,15 +79,12 @@ kitemsManager_Server <- function(id, r, path, r[[r_filter_date]] <- reactiveVal(NULL) # -- Build triggers names from module id - trigger_delete <- trigger_delete_name(id) trigger_save <- trigger_save_name(id) trigger_create <- trigger_create_name(id) # -- Declare reactive objects (for external use) - r[[trigger_delete]] <- reactiveVal(NULL) r[[trigger_save]] <- reactiveVal(0) r[[trigger_create]] <- reactiveVal(0) - cat(MODULE, "trigger_delete available @", trigger_delete, "\n") cat(MODULE, "trigger_save available @", trigger_save, "\n") cat(MODULE, "trigger_create available @", trigger_create, "\n") @@ -225,37 +222,6 @@ kitemsManager_Server <- function(id, r, path, # Triggers: # -------------------------------------------------------------------------- - # -- Observe: trigger_update - # observeEvent(r[[trigger_update]](), { - # - # # -- add item to list & store - # cat(MODULE, "[TRIGGER] Update item \n") - # item_list <- item_update(k_items(), r[[trigger_update]]()) - # k_items(item_list) - # - # # -- notify - # if(is_running) - # showNotification(paste(MODULE, "Item updated."), type = "message") - # - # }, ignoreInit = TRUE) - - - # -- Observe: trigger_delete - observeEvent(r[[trigger_delete]](), { - - # -- add item to list & store - cat(MODULE, "[TRIGGER] Delete item(s) \n") - cat("-- Item(s) to be deleted =", as.character(r[[trigger_delete]]()), "\n") - item_list <- item_delete(k_items(), r[[trigger_delete]]()) - k_items(item_list) - - # -- notify - if(is_running) - showNotification(paste(MODULE, "Item(s) deleted."), type = "message") - - }, ignoreInit = TRUE) - - # -- Observe: trigger_save (items) observeEvent(r[[trigger_save]](), { @@ -1230,9 +1196,9 @@ kitemsManager_Server <- function(id, r, path, # -- close modal removeModal() - # -- get selected items (ids) & call trigger + # -- get selected items (ids) & delete ids <- r[[r_selected_items]]() - r[[trigger_delete]](ids) + item_delete(k_items, ids, name = id) }) From 14800766c2f40c7e5b1f7eb47cef7614ae49e56f Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 15:12:55 +0200 Subject: [PATCH 25/39] Fixed #265 --- R/item_save.R | 15 +++++---------- R/kitems_module_server.R | 28 ++-------------------------- 2 files changed, 7 insertions(+), 36 deletions(-) diff --git a/R/item_save.R b/R/item_save.R index 1b3ebb7..3304817 100644 --- a/R/item_save.R +++ b/R/item_save.R @@ -3,8 +3,7 @@ #' Save data #' #' @param data a data.frame containing the data to be saved -#' @param file an optional file name (including .csv extension) -#' @param path an optional path to the file +#' @param file the url of the file (including path & .csv extension) #' #' @export #' @@ -14,22 +13,18 @@ #' @examples #' \dontrun{ #' # -- File connector: -#' item_save(data = mydata, file = "mydata.csv", path = "path/to/my/data") +#' item_save(data = mydata, file = "path/to/my/data/mydata.csv") #' } -item_save <- function(data, file = NULL, path = NULL){ +item_save <- function(data, file = NULL){ # ---------------------------------------------------------------------------- # Connector: file (.csv) # ---------------------------------------------------------------------------- - if(!is.null(file)) - - # -- Write - kfiles::write_data(data = data, - file = file, - path = path) + if(!is.null(file)) + kfiles::write_data(data, file) # ---------------------------------------------------------------------------- diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index a8a0b30..a7e9a05 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -79,13 +79,10 @@ kitemsManager_Server <- function(id, r, path, r[[r_filter_date]] <- reactiveVal(NULL) # -- Build triggers names from module id - trigger_save <- trigger_save_name(id) trigger_create <- trigger_create_name(id) # -- Declare reactive objects (for external use) - r[[trigger_save]] <- reactiveVal(0) r[[trigger_create]] <- reactiveVal(0) - cat(MODULE, "trigger_save available @", trigger_save, "\n") cat(MODULE, "trigger_create available @", trigger_create, "\n") @@ -208,9 +205,7 @@ kitemsManager_Server <- function(id, r, path, observeEvent(k_items(), { # -- Write - item_save(data = k_items(), - file = items_url, - path = path) + item_save(data = k_items(), file = items_url) # -- Notify cat(MODULE, "[EVENT] Item list has been (auto) saved \n") @@ -218,26 +213,6 @@ kitemsManager_Server <- function(id, r, path, }, ignoreInit = TRUE) - # -------------------------------------------------------------------------- - # Triggers: - # -------------------------------------------------------------------------- - - # -- Observe: trigger_save (items) - observeEvent(r[[trigger_save]](), { - - # -- Write - item_save(data = k_items(), - file = items_url, - path = path) - - # -- Notify - cat(MODULE, "[TRIGGER] Item list has been saved \n") - if(is_running) - showNotification(paste(MODULE, "Items saved."), type = "message") - - }, ignoreInit = TRUE) - - # -------------------------------------------------------------------------- # Declare filtered items: # -------------------------------------------------------------------------- @@ -1209,6 +1184,7 @@ kitemsManager_Server <- function(id, r, path, # -- the reference (not the value!) list(id = id, + url = items_url, items = k_items, data_model = k_data_model) From 649bfbe16084598da43237af4202f4d3cb699fd1 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Mon, 2 Sep 2024 15:14:41 +0200 Subject: [PATCH 26/39] update doc --- man/item_delete.Rd | 8 +++++--- man/item_save.Rd | 8 +++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/man/item_delete.Rd b/man/item_delete.Rd index 9526984..6be5592 100644 --- a/man/item_delete.Rd +++ b/man/item_delete.Rd @@ -4,12 +4,14 @@ \alias{item_delete} \title{Delete item} \usage{ -item_delete(items, id) +item_delete(items, id, name = NULL) } \arguments{ -\item{items}{a data.frame of the items} +\item{items}{the reference! of the reactive value carrying the items} \item{id}{the id of the item to delete} + +\item{name}{a character string used inside the notification (typically the name of the items)} } \value{ an updated data.frame of the items @@ -19,6 +21,6 @@ Delete item } \examples{ \dontrun{ -item_delete(items = myitems, id = 123456789) +item_delete(items = myitems, id = 123456789, name = "myitems") } } diff --git a/man/item_save.Rd b/man/item_save.Rd index 74b9b70..8ded6fa 100644 --- a/man/item_save.Rd +++ b/man/item_save.Rd @@ -4,14 +4,12 @@ \alias{item_save} \title{Save data} \usage{ -item_save(data, file = NULL, path = NULL) +item_save(data, file = NULL) } \arguments{ \item{data}{a data.frame containing the data to be saved} -\item{file}{an optional file name (including .csv extension)} - -\item{path}{an optional path to the file} +\item{file}{the url of the file (including path & .csv extension)} } \description{ Save data @@ -22,6 +20,6 @@ File connector: if file is not NULL, then data is saved to .csv \examples{ \dontrun{ # -- File connector: -item_save(data = mydata, file = "mydata.csv", path = "path/to/my/data") +item_save(data = mydata, file = "path/to/my/data/mydata.csv") } } From 239875284ecd3f7c9113513ef58553cc3a94fed3 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Tue, 3 Sep 2024 14:22:18 +0200 Subject: [PATCH 27/39] Drop trigger_create #266 --- R/kitems_module_server.R | 19 +++---------------- 1 file changed, 3 insertions(+), 16 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index a7e9a05..5a7680b 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -78,13 +78,6 @@ kitemsManager_Server <- function(id, r, path, r[[r_clicked_column]] <- reactiveVal(NULL) r[[r_filter_date]] <- reactiveVal(NULL) - # -- Build triggers names from module id - trigger_create <- trigger_create_name(id) - - # -- Declare reactive objects (for external use) - r[[trigger_create]] <- reactiveVal(0) - cat(MODULE, "trigger_create available @", trigger_create, "\n") - # -------------------------------------------------------------------------- # Initialize data model and items: @@ -1038,21 +1031,15 @@ kitemsManager_Server <- function(id, r, path, output$create_btn_output <- renderUI(actionButton(inputId = ns("create_btn"), label = "Create")) - # -- Observe: create_btn & r[[trigger_create]] - # Add trigger to fire observer without implementing the button in UI #252 - observeEvent({input$create_btn - r[[trigger_create]]()}, { - - # -- check to avoid modal to fire at startup #256 - if(r[[trigger_create]]() != 0 | input$create_btn != 0) + # -- Observe: create_btn + observeEvent(input$create_btn, showModal(modalDialog(inputList(ns, item = NULL, update = FALSE, data.model = k_data_model()), title = "Create", footer = tagList( modalButton("Cancel"), - actionButton(ns("confirm_create_btn"), "Create")))) + actionButton(ns("confirm_create_btn"), "Create"))))) - }, ignoreInit = TRUE) # -- Observe: confirm_create_btn observeEvent(input$confirm_create_btn, { From f4a95cd0b35ad872a8639d7048d6a7a4a24c4399 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 19 Sep 2024 17:18:40 +0200 Subject: [PATCH 28/39] Fixed #267 --- R/kitems_module_server.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 5a7680b..bed307f 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -638,7 +638,7 @@ kitemsManager_Server <- function(id, r, path, # -- Store items & data model k_items(items) - data_model(data.model) + k_data_model(data.model) # -- notify if(is_running) @@ -720,7 +720,7 @@ kitemsManager_Server <- function(id, r, path, # -- update data model & store dm <- k_data_model() dm <- dm[dm$name != input$dm_dz_att_name, ] - data_model(dm) + k_data_model(dm) }) @@ -786,7 +786,7 @@ kitemsManager_Server <- function(id, r, path, skip = skip) # -- store - data_model(dm) + k_data_model(dm) # -- init items cat(MODULE, "-- Init data \n") @@ -840,7 +840,7 @@ kitemsManager_Server <- function(id, r, path, filter = FALSE) # -- store - data_model(dm) + k_data_model(dm) # -- get default value value <- dm_get_default(data.model = dm, name = input$dm_att_name) @@ -930,7 +930,7 @@ kitemsManager_Server <- function(id, r, path, skip = skip) # -- store - data_model(dm) + k_data_model(dm) }) @@ -972,7 +972,7 @@ kitemsManager_Server <- function(id, r, path, # -- Reorder data model & store dm <- k_data_model() dm <- dm[match(input$dm_order_cols, dm$name), ] - data_model(dm) + k_data_model(dm) }) @@ -1018,7 +1018,7 @@ kitemsManager_Server <- function(id, r, path, # -- Check NULL data model if(!is.null(dm)){ dm <- dm_filter_set(data.model = dm, filter = input$adm_filter_col) - data_model(dm)} + k_data_model(dm)} }, ignoreInit = TRUE, ignoreNULL = FALSE) From 84345bfac9527b8139e3ceb75b304ddbc061a815 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Tue, 24 Sep 2024 13:52:57 +0200 Subject: [PATCH 29/39] Support ISO8601 datetime #269 --- R/item_load.R | 38 ++++++++++++++++++++++++++++++++++++++ R/item_save.R | 15 +++++++++++++++ 2 files changed, 53 insertions(+) diff --git a/R/item_load.R b/R/item_load.R index 63183a7..7ce3980 100644 --- a/R/item_load.R +++ b/R/item_load.R @@ -29,6 +29,20 @@ item_load <- function(data.model, file = NULL, path = NULL, create = TRUE){ col.classes <- dm_colClasses(data.model) + # ---------------------------------------------------------------------------- + # Ensure timezone continuity #269 + # ---------------------------------------------------------------------------- + # datetime will be read as character (and converted later) + + # -- get datetime index + idx_ct <- which(col.classes %in% "POSIXct") + idx_lt <- which(col.classes %in% c("POSIXlt")) + + # -- convert classes + if(length(c(idx_ct, idx_lt)) > 0) + col.classes[c(idx_ct, idx_lt)] <- "character" + + # ---------------------------------------------------------------------------- # Connector: file (.csv) # ---------------------------------------------------------------------------- @@ -47,6 +61,30 @@ item_load <- function(data.model, file = NULL, path = NULL, create = TRUE){ if(all(dim(items) == c(0,0))) items <- NULL + else { + + # -------------------------------------------------------------------------- + # Ensure timezone continuity #269 + # -------------------------------------------------------------------------- + # convert ISO 8601 character vector to POSIXct, POSIXlt + # output will get an extra tzone attribute compared to original object, + # but values are the same + + DEBUG_items <<- items + + # -- POSIXct + if(length(idx_ct) > 0){ + cat("[item_load] Converting attribute(s) to POSIXct =", names(col.classes[idx_ct]), "\n") + items[idx_ct] <- lapply(items[idx_ct], function(x) as.POSIXct(x, format = "%Y-%m-%dT%H:%M:%S%z", tz = ""))} + + # -- POSIXlt + if(length(idx_lt) > 0){ + cat("[item_load] Converting attribute(s) to POSIXlt =", names(col.classes[idx_lt]), "\n") + items[idx_lt] <- lapply(items[idx_lt], function(x) as.POSIXct(x, format = "%Y-%m-%dT%H:%M:%S%z", tz = ""))} + + } + + # -- return items diff --git a/R/item_save.R b/R/item_save.R index 3304817..c211d0f 100644 --- a/R/item_save.R +++ b/R/item_save.R @@ -19,6 +19,21 @@ item_save <- function(data, file = NULL){ + # -------------------------------------------------------------------------- + # Ensure timezone continuity #269 + # -------------------------------------------------------------------------- + + # -- get datetime index + # To avoid adding data.model to the function signature, get classes from data + classes <- lapply(data, function(x) class(x)[1]) + idx <- which(classes %in% c("POSIXct", "POSIXlt")) + + # -- convert to ISO 8601 character format + if(length(idx) > 0){ + cat("[item_save] Convert datetime attribute(s) to ISO-8601 =", names(data[idx]), "\n") + data[idx] <- format(data[idx], "%FT%H:%M:%S%z")} + + # ---------------------------------------------------------------------------- # Connector: file (.csv) # ---------------------------------------------------------------------------- From bd05c32a9d17c911434f544c8587318b711af900 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Tue, 24 Sep 2024 13:52:57 +0200 Subject: [PATCH 30/39] Support ISO8601 datetime #269 --- R/item_load.R | 36 ++++++++++++++++++++++++++++++++++++ R/item_save.R | 15 +++++++++++++++ 2 files changed, 51 insertions(+) diff --git a/R/item_load.R b/R/item_load.R index 63183a7..e0d8cc1 100644 --- a/R/item_load.R +++ b/R/item_load.R @@ -29,6 +29,20 @@ item_load <- function(data.model, file = NULL, path = NULL, create = TRUE){ col.classes <- dm_colClasses(data.model) + # ---------------------------------------------------------------------------- + # Ensure timezone continuity #269 + # ---------------------------------------------------------------------------- + # datetime will be read as character (and converted later) + + # -- get datetime index + idx_ct <- which(col.classes %in% "POSIXct") + idx_lt <- which(col.classes %in% c("POSIXlt")) + + # -- convert classes + if(length(c(idx_ct, idx_lt)) > 0) + col.classes[c(idx_ct, idx_lt)] <- "character" + + # ---------------------------------------------------------------------------- # Connector: file (.csv) # ---------------------------------------------------------------------------- @@ -47,6 +61,28 @@ item_load <- function(data.model, file = NULL, path = NULL, create = TRUE){ if(all(dim(items) == c(0,0))) items <- NULL + else { + + # -------------------------------------------------------------------------- + # Ensure timezone continuity #269 + # -------------------------------------------------------------------------- + # convert ISO 8601 character vector to POSIXct, POSIXlt + # output will get an extra tzone attribute compared to original object, + # but values are the same + + # -- POSIXct + if(length(idx_ct) > 0){ + cat("[item_load] Converting attribute(s) to POSIXct =", names(col.classes[idx_ct]), "\n") + items[idx_ct] <- lapply(items[idx_ct], function(x) as.POSIXct(x, format = "%Y-%m-%dT%H:%M:%S%z", tz = ""))} + + # -- POSIXlt + if(length(idx_lt) > 0){ + cat("[item_load] Converting attribute(s) to POSIXlt =", names(col.classes[idx_lt]), "\n") + items[idx_lt] <- lapply(items[idx_lt], function(x) as.POSIXct(x, format = "%Y-%m-%dT%H:%M:%S%z", tz = ""))} + + } + + # -- return items diff --git a/R/item_save.R b/R/item_save.R index 3304817..c211d0f 100644 --- a/R/item_save.R +++ b/R/item_save.R @@ -19,6 +19,21 @@ item_save <- function(data, file = NULL){ + # -------------------------------------------------------------------------- + # Ensure timezone continuity #269 + # -------------------------------------------------------------------------- + + # -- get datetime index + # To avoid adding data.model to the function signature, get classes from data + classes <- lapply(data, function(x) class(x)[1]) + idx <- which(classes %in% c("POSIXct", "POSIXlt")) + + # -- convert to ISO 8601 character format + if(length(idx) > 0){ + cat("[item_save] Convert datetime attribute(s) to ISO-8601 =", names(data[idx]), "\n") + data[idx] <- format(data[idx], "%FT%H:%M:%S%z")} + + # ---------------------------------------------------------------------------- # Connector: file (.csv) # ---------------------------------------------------------------------------- From a92651f8bdb77fb19c0643f71912d9ac2aedfd3a Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 15:51:33 +0200 Subject: [PATCH 31/39] Fixed #249 --- R/kitems_module_server.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index bed307f..503fcc5 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -774,14 +774,16 @@ kitemsManager_Server <- function(id, r, path, # Implement template #220 template <- TEMPLATE_DATA_MODEL[TEMPLATE_DATA_MODEL$name == "id", ] colClasses <- c("id" = template$type) + default_val <- c("id" = template$default.val) + default_fun <- c("id" = template$default.fun) filter <- if(template$filter) c("id") else NULL skip <- if(template$skip) c("id") else NULL # -- init data model & store cat(MODULE, "-- Building data model \n") dm <- data_model(colClasses = colClasses, - default.val = template$default.val, - default.fun = template$default.fun, + default.val = default_val, + default.fun = default_fun, filter = filter, skip = skip) From cfb285c7837cc6b178d0db09ace6629f913a9aa2 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 16:01:04 +0200 Subject: [PATCH 32/39] Fixed #271 --- R/kitems_module_server.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 503fcc5..89685d5 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -791,11 +791,12 @@ kitemsManager_Server <- function(id, r, path, k_data_model(dm) # -- init items + # create = autosave : so that file won't be created if autosave is FALSE #271 cat(MODULE, "-- Init data \n") items <- kfiles::read_data(file = items_url, path = path, colClasses = colClasses, - create = TRUE) + create = autosave) # -- store items k_items(items) From 543a455ba12426ef31df897c9ae5312e7b0fab58 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 16:16:24 +0200 Subject: [PATCH 33/39] Fixed #248 --- R/kitems_module_server.R | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 89685d5..bab6d5a 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -906,18 +906,31 @@ kitemsManager_Server <- function(id, r, path, dm <- k_data_model() # -- default val & fun - if(input$dm_default_choice == "none"){ - default_val <- NA - default_fun <- NA + # check: in case of id, attribute has no default choice + # hence input$dm_default_choice is not reliable in this case #248 + if(dm[row, ]$name != "id"){ - } else { - if(input$dm_default_choice == "val"){ - default_val <- input$dm_att_default_detail - default_fun <- NULL + if(input$dm_default_choice == "none"){ + default_val <- NA + default_fun <- NA } else { - default_val <- NULL - default_fun <- input$dm_att_default_detail}} + + if(input$dm_default_choice == "val"){ + default_val <- input$dm_att_default_detail + default_fun <- NULL + + } else { + default_val <- NULL + default_fun <- input$dm_att_default_detail}} + + } else { + + # -- when attribute is id + default_val <- NULL + default_fun <- input$dm_att_default_detail + + } # -- skip (force for id) skip <- if(dm[row, ]$name != "id") From 2d0b9ed13d592d0274e93157ec4e13cd44ef50bf Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 16:41:46 +0200 Subject: [PATCH 34/39] Fixed #246 --- R/inputList.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/inputList.R b/R/inputList.R index 97a4b95..f2aa75f 100644 --- a/R/inputList.R +++ b/R/inputList.R @@ -78,6 +78,10 @@ inputList <- function(ns, item = NULL, update = FALSE, data.model){ if(is.character(value)) value <- as.logical(value) + # -- check NA (in case no default has been set) #246 + if(is.na(value)) + value <- FALSE + # -- input input <- checkboxInput(inputId = ns(names(colClasses)), label = "logical", From 29729ce618b0a977653fb40ecf97a0eed60edd0b Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 16:49:21 +0200 Subject: [PATCH 35/39] Fixed #247 --- R/inputList.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/inputList.R b/R/inputList.R index f2aa75f..605ace6 100644 --- a/R/inputList.R +++ b/R/inputList.R @@ -84,7 +84,7 @@ inputList <- function(ns, item = NULL, update = FALSE, data.model){ # -- input input <- checkboxInput(inputId = ns(names(colClasses)), - label = "logical", + label = names(colClasses), value = value, width = NULL) } From afa9604866e0fc13d0e238d6395b1e2d066e92e7 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 16:49:21 +0200 Subject: [PATCH 36/39] Fixed #243 --- R/inputList.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/inputList.R b/R/inputList.R index f2aa75f..605ace6 100644 --- a/R/inputList.R +++ b/R/inputList.R @@ -84,7 +84,7 @@ inputList <- function(ns, item = NULL, update = FALSE, data.model){ # -- input input <- checkboxInput(inputId = ns(names(colClasses)), - label = "logical", + label = names(colClasses), value = value, width = NULL) } From 69618ad41b8829b587a9b13aea70bc3fd9e6292d Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 17:04:33 +0200 Subject: [PATCH 37/39] Fixed #243 --- R/inputList.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/inputList.R b/R/inputList.R index 605ace6..97699f4 100644 --- a/R/inputList.R +++ b/R/inputList.R @@ -99,6 +99,11 @@ inputList <- function(ns, item = NULL, update = FALSE, data.model){ cat(" - Filter out attributes to skip:", skip, "\n") colClasses <- colClasses[!names(colClasses) %in% skip] + # -- check + # when id is the only attribute, colClasses will be empty #243 + if(length(colClasses) == 0) + return("Warning: there is no attribute that requires an input value (all attributes are skipped!).") + # -- Define default input values if(update){ From 1236b2b3c8ba153df1b4fc3a118527169c5b083a Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 17:10:44 +0200 Subject: [PATCH 38/39] Fixed #244 --- R/kitems_module_server.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index bab6d5a..239da55 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -281,9 +281,11 @@ kitemsManager_Server <- function(id, r, path, # -- colClasses for admin # setting rownames = FALSE #209 # setting dom = "tpl" instead of "t" #245 + # allowing display all #244 output$data_model <- DT::renderDT(dm_table_mask(k_data_model()), rownames = FALSE, - options = list(lengthMenu = c(5, 10, 15), pageLength = 10, dom = "tpl", scrollX = TRUE), + options = list(lengthMenu = list(c(20, 50, -1), c('20', '50', 'All')), + pageLength = 20, dom = "tpl", scrollX = TRUE), selection = list(mode = 'single', target = "row", selected = isolate(input$data_model_rows_selected))) From 41887be7b9259b6e6ae0acd9208a1e3f0c6e9077 Mon Sep 17 00:00:00 2001 From: thekangaroofactory <67638275+thekangaroofactory@users.noreply.github.com> Date: Thu, 26 Sep 2024 18:46:33 +0200 Subject: [PATCH 39/39] Fixed #272 --- R/kitems_module_server.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/R/kitems_module_server.R b/R/kitems_module_server.R index 239da55..6aa9555 100644 --- a/R/kitems_module_server.R +++ b/R/kitems_module_server.R @@ -715,11 +715,13 @@ kitemsManager_Server <- function(id, r, path, removeModal() # -- drop column! & store + cat(MODULE, "Drop attribute from all items \n") items <- k_items() items[input$dm_dz_att_name] <- NULL k_items(items) # -- update data model & store + cat(MODULE, "Drop attribute from data model \n") dm <- k_data_model() dm <- dm[dm$name != input$dm_dz_att_name, ] k_data_model(dm) @@ -869,6 +871,12 @@ kitemsManager_Server <- function(id, r, path, # -- get selected row row <- input$data_model_rows_selected + # -- check out of limit value #272 + # If last row is selected and attribute is deleted, a crash would occur + if(!is.null(row)) + if(row > nrow(k_data_model())) + row <- NULL + # -- check NULL (no row selected) if(is.null(row)){ @@ -890,7 +898,7 @@ kitemsManager_Server <- function(id, r, path, } - }, ignoreNULL = FALSE) + }, ignoreNULL = FALSE, ignoreInit = TRUE) # -- observe upd_att button