From b6fb6fa3bb807f8d05bec5d3793afe7f8044e929 Mon Sep 17 00:00:00 2001 From: gsamra Date: Thu, 30 Nov 2023 15:25:11 +0100 Subject: [PATCH 1/6] edit-data : ajout arguments "modal_size" et "modal_easy_close" pour le modalDialog() --- R/edit-data-utils.R | 8 ++++++-- R/edit-data.R | 15 ++++++++++++--- examples/edit_data.R | 2 ++ 3 files changed, 20 insertions(+), 5 deletions(-) diff --git a/R/edit-data-utils.R b/R/edit-data-utils.R index 4af009a..e092441 100644 --- a/R/edit-data-utils.R +++ b/R/edit-data-utils.R @@ -13,6 +13,8 @@ #' @param colnames `data.frame` column names #' @param var_edit vector of `character` which allows to choose the editable columns #' @param var_mandatory vector of `character` which allows to choose obligatory fields to fill +#' @param modal_size `character` which allows to choose the size of the modalDialog. One of "s" for small, "m" (the default) for medium, "l" for large, or "xl" for extra large. +#' @param modal_easy_close `boolean` If TRUE, modalDialog can be dismissed by clicking outside the dialog box, or be pressing the Escape key. If FALSE (the default), modalDialog can't be dismissed in those ways; instead it must be dismissed by clicking on a modalButton(), or from a call to removeModal() on the server. #' @param session The `session` object passed to function given to shinyServer #' #' @importFrom shiny showModal modalDialog actionButton @@ -28,6 +30,8 @@ edit_modal <- function(default = list(), colnames = names(data), var_edit, var_mandatory, + modal_size = "m", + modal_easy_close = FALSE, session = getDefaultReactiveDomain()) { ns <- session$ns @@ -52,8 +56,8 @@ edit_modal <- function(default = list(), ) ), footer = NULL, - size = "m", - easyClose = TRUE, + size = modal_size, + easyClose = modal_easy_close, edit_input_form( default = default, data = data, diff --git a/R/edit-data.R b/R/edit-data.R index ff3508c..3415fb3 100644 --- a/R/edit-data.R +++ b/R/edit-data.R @@ -56,9 +56,11 @@ edit_data_ui <- function(id) { #' @param var_mandatory vector of `character` which allows to choose obligatory fields to fill #' @param return_class Class of returned data: `data.frame`, `data.table`, `tbl_df` (tibble) or `raw`. #' @param reactable_options Options passed to [reactable::reactable()]. +#' @param modal_size `character` which allows to choose the size of the modalDialog. One of "s" for small, "m" (the default) for medium, "l" for large, or "xl" for extra large. +#' @param modal_easy_close `boolean` If TRUE, modalDialog can be dismissed by clicking outside the dialog box, or be pressing the Escape key. If FALSE (the default), modalDialog can't be dismissed in those ways; instead it must be dismissed by clicking on a modalButton(), or from a call to removeModal() on the server. #' @param callback_add,callback_update,callback_delete Functions to be executed just before an action (add, update or delete) is performed on the data. #' Functions used must be like `function(data, row) {...}` where : -#' * `data` wil be the data in the table at the moment the function is called +#' * `data` will be the data in the table at the moment the function is called #' * `row` will contain either a new row of data (add), an updated row (update) or the row that will be deleted (delete). #' #' If the return value of a callback function is not truthy (see [shiny::isTruthy()]) then the action is cancelled. @@ -91,10 +93,13 @@ edit_data_server <- function(id, var_mandatory = NULL, return_class = c("data.frame", "data.table", "tbl_df", "raw"), reactable_options = NULL, + modal_size = c("m", "s", "l", "xl"), + modal_easy_close = TRUE, callback_add = NULL, callback_update = NULL, callback_delete = NULL) { return_class <- match.arg(return_class) + modal_size <- match.arg(modal_size) callback_default <- function(...) return(TRUE) if (!is_function(callback_add)) callback_add <- callback_default @@ -199,7 +204,9 @@ edit_data_server <- function(id, data = data_rv$data, colnames = data_rv$colnames, var_edit = data_rv$edit, - var_mandatory = var_mandatory + var_mandatory = var_mandatory, + modal_size = modal_size, + modal_easy_close = modal_easy_close ) }) @@ -279,7 +286,9 @@ edit_data_server <- function(id, data = data, colnames = data_rv$colnames, var_edit = data_rv$edit, - var_mandatory = var_mandatory + var_mandatory = var_mandatory, + modal_size = modal_size, + modal_easy_close = modal_easy_close ) }) diff --git a/examples/edit_data.R b/examples/edit_data.R index 06404c2..8199490 100644 --- a/examples/edit_data.R +++ b/examples/edit_data.R @@ -26,6 +26,8 @@ server <- function(input, output, session) { file_name_export = "datas", # var_edit = c("name", "job", "credit_card_provider", "credit_card_security_code"), var_mandatory = c("name", "job"), + modal_size = "l", + modal_easy_close = TRUE, reactable_options = list( defaultColDef = colDef(filterable = TRUE), selection = "single", From b727150a0febc9b0d34f434fe24a83435ea12c5e Mon Sep 17 00:00:00 2001 From: pvictor Date: Mon, 4 Dec 2023 10:32:27 +0100 Subject: [PATCH 2/6] maj doc --- man/edit-data.Rd | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/man/edit-data.Rd b/man/edit-data.Rd index 2a22e4b..2f92841 100644 --- a/man/edit-data.Rd +++ b/man/edit-data.Rd @@ -21,6 +21,8 @@ edit_data_server( var_mandatory = NULL, return_class = c("data.frame", "data.table", "tbl_df", "raw"), reactable_options = NULL, + modal_size = c("m", "s", "l", "xl"), + modal_easy_close = TRUE, callback_add = NULL, callback_update = NULL, callback_delete = NULL @@ -51,10 +53,14 @@ edit_data_server( \item{reactable_options}{Options passed to \code{\link[reactable:reactable]{reactable::reactable()}}.} +\item{modal_size}{\code{character} which allows to choose the size of the modalDialog. One of "s" for small, "m" (the default) for medium, "l" for large, or "xl" for extra large.} + +\item{modal_easy_close}{\code{boolean} If TRUE, modalDialog can be dismissed by clicking outside the dialog box, or be pressing the Escape key. If FALSE (the default), modalDialog can't be dismissed in those ways; instead it must be dismissed by clicking on a modalButton(), or from a call to removeModal() on the server.} + \item{callback_add, callback_update, callback_delete}{Functions to be executed just before an action (add, update or delete) is performed on the data. Functions used must be like \code{function(data, row) {...}} where : \itemize{ -\item \code{data} wil be the data in the table at the moment the function is called +\item \code{data} will be the data in the table at the moment the function is called \item \code{row} will contain either a new row of data (add), an updated row (update) or the row that will be deleted (delete). } @@ -96,6 +102,8 @@ server <- function(input, output, session) { file_name_export = "datas", # var_edit = c("name", "job", "credit_card_provider", "credit_card_security_code"), var_mandatory = c("name", "job"), + modal_size = "l", + modal_easy_close = TRUE, reactable_options = list( defaultColDef = colDef(filterable = TRUE), selection = "single", From bc7c01026061999741fd2675248e9772bcf6f663 Mon Sep 17 00:00:00 2001 From: pvictor Date: Mon, 4 Dec 2023 11:28:54 +0100 Subject: [PATCH 3/6] edit: remove modal after callback --- R/edit-data.R | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/R/edit-data.R b/R/edit-data.R index 3415fb3..bd19c53 100644 --- a/R/edit-data.R +++ b/R/edit-data.R @@ -225,8 +225,6 @@ edit_data_server <- function(id, } } - removeModal() - results_add <- try({ results_inputs <- lapply( X = setNames(data_rv$edit, data_rv$edit), @@ -250,6 +248,7 @@ edit_data_server <- function(id, data <- rbind(data, new, fill = TRUE) data_rv$data <- data update_table(data, data_rv$colnames) + removeModal() } else { NULL } @@ -307,8 +306,6 @@ edit_data_server <- function(id, } } - removeModal() - results_update <- try({ id <- input$update @@ -330,6 +327,7 @@ edit_data_server <- function(id, data_updated <- data_updated[order(.datamods_id)] data_rv$data <- copy(data_updated) update_table(data_updated, data_rv$colnames) + removeModal() } else { NULL } @@ -387,6 +385,7 @@ edit_data_server <- function(id, data <- data[order(.datamods_id)] data_rv$data <- data update_table(data, data_rv$colnames) + removeModal() } else { NULL } @@ -407,7 +406,6 @@ edit_data_server <- function(id, text = i18n("The row has been deleted") ) } - removeModal() }) observeEvent(input$confirmation_delete_row_no, { notification_info( From 73ad0029b58600bd133c119200434594af535b9d Mon Sep 17 00:00:00 2001 From: pvictor Date: Mon, 4 Dec 2023 14:25:46 +0100 Subject: [PATCH 4/6] edit data: added only_callback and use_notify args --- R/edit-data-utils.R | 68 +++++++++++++++++++++++++-------------------- R/edit-data.R | 48 +++++++++++++++++++++----------- man/edit-data.Rd | 10 +++++-- 3 files changed, 78 insertions(+), 48 deletions(-) diff --git a/R/edit-data-utils.R b/R/edit-data-utils.R index e092441..8da1be2 100644 --- a/R/edit-data-utils.R +++ b/R/edit-data-utils.R @@ -290,7 +290,7 @@ btn_update <- function(inputId) { title = i18n("Click to edit"), ph("pencil-simple-line", height = "1.2em") ) - ) + ) } } @@ -340,7 +340,7 @@ btn_delete <- function(inputId) { title = i18n("Click to delete"), ph("x", height = "1.2em") ) - ) + ) } } @@ -395,36 +395,44 @@ confirmation_window <- function(inputId, ..., title = NULL) { #' @importFrom shinybusy notify_failure notify_success notify_info notify_warning -notification_failure <- function(title, text) { - shinybusy::notify_failure( - title = title, - text = text, - position = "center-top", - clickToClose = TRUE - ) +notification_failure <- function(title, text, use_notify = TRUE) { + if (isTRUE(use_notify)) { + shinybusy::notify_failure( + title = title, + text = text, + position = "center-top", + clickToClose = TRUE + ) + } } -notification_warning <- function(title, text) { - shinybusy::notify_warning( - title = title, - text = text, - position = "center-top", - clickToClose = TRUE - ) +notification_warning <- function(title, text, use_notify = TRUE) { + if (isTRUE(use_notify)) { + shinybusy::notify_warning( + title = title, + text = text, + position = "center-top", + clickToClose = TRUE + ) + } } -notification_success <- function(title, text) { - shinybusy::notify_success( - title = title, - text = text, - position = "center-top", - clickToClose = TRUE - ) +notification_success <- function(title, text, use_notify = TRUE) { + if (isTRUE(use_notify)) { + shinybusy::notify_success( + title = title, + text = text, + position = "center-top", + clickToClose = TRUE + ) + } } -notification_info <- function(title, text) { - shinybusy::notify_info( - title = title, - text = text, - position = "center-top", - clickToClose = TRUE - ) +notification_info <- function(title, text, use_notify = TRUE) { + if (isTRUE(use_notify)) { + shinybusy::notify_info( + title = title, + text = text, + position = "center-top", + clickToClose = TRUE + ) + } } diff --git a/R/edit-data.R b/R/edit-data.R index bd19c53..73392dd 100644 --- a/R/edit-data.R +++ b/R/edit-data.R @@ -62,6 +62,8 @@ edit_data_ui <- function(id) { #' Functions used must be like `function(data, row) {...}` where : #' * `data` will be the data in the table at the moment the function is called #' * `row` will contain either a new row of data (add), an updated row (update) or the row that will be deleted (delete). +#' @param only_callback Only use callbacks, don't alter data within the module. +#' @param use_notify Display information or not to user through [shinybusy::notify()]. #' #' If the return value of a callback function is not truthy (see [shiny::isTruthy()]) then the action is cancelled. #' @@ -97,7 +99,9 @@ edit_data_server <- function(id, modal_easy_close = TRUE, callback_add = NULL, callback_update = NULL, - callback_delete = NULL) { + callback_delete = NULL, + only_callback = FALSE, + use_notify = TRUE) { return_class <- match.arg(return_class) modal_size <- match.arg(modal_size) callback_default <- function(...) return(TRUE) @@ -219,7 +223,8 @@ edit_data_server <- function(id, if (!isTruthy(input[[var]])) { notification_warning( title = i18n("Required field"), - text = i18n("Please fill in the required fields") + text = i18n("Please fill in the required fields"), + use_notify = use_notify ) return(NULL) } @@ -244,7 +249,7 @@ edit_data_server <- function(id, format_edit_data(new, data_rv$colnames, data_rv$internal_colnames) ) - if (isTruthy(res_callback)) { + if (isTruthy(res_callback) & !isTRUE(only_callback)) { data <- rbind(data, new, fill = TRUE) data_rv$data <- data update_table(data, data_rv$colnames) @@ -257,17 +262,20 @@ edit_data_server <- function(id, if (is.null(results_add)) { notification_warning( title = i18n("Warning"), - text = i18n("The row wasn't added to the data") + text = i18n("The row wasn't added to the data"), + use_notify = use_notify ) } else if (inherits(results_add, "try-error")) { notification_failure( title = i18n("Error"), - text = i18n("Unable to add the row, contact the platform administrator") + text = i18n("Unable to add the row, contact the platform administrator"), + use_notify = use_notify ) } else { notification_success( title = i18n("Registered"), - text = i18n("Row has been saved") + text = i18n("Row has been saved"), + use_notify = use_notify ) } }) @@ -300,7 +308,8 @@ edit_data_server <- function(id, if (!isTruthy(input[[var]])) { notification_failure( title = i18n("Required field"), - text = i18n("Please fill in the required fields") + text = i18n("Please fill in the required fields"), + use_notify = use_notify ) return(NULL) } @@ -323,7 +332,7 @@ edit_data_server <- function(id, ) ) - if (isTruthy(res_callback)) { + if (isTruthy(res_callback) & !isTRUE(only_callback)) { data_updated <- data_updated[order(.datamods_id)] data_rv$data <- copy(data_updated) update_table(data_updated, data_rv$colnames) @@ -335,17 +344,20 @@ edit_data_server <- function(id, if (is.null(results_update)) { notification_warning( title = i18n("Warning"), - text = i18n("Data wasn't updated") + text = i18n("Data wasn't updated"), + use_notify = use_notify ) } else if (inherits(results_update, "try-error")) { notification_failure( title = i18n("Error"), - text = i18n("Unable to modify the item, contact the platform administrator") + text = i18n("Unable to modify the item, contact the platform administrator"), + use_notify = use_notify ) } else { notification_success( title = i18n("Registered"), - text = i18n("Item has been modified") + text = i18n("Item has been modified"), + use_notify = use_notify ) } }) @@ -380,7 +392,7 @@ edit_data_server <- function(id, ) ) - if (isTruthy(res_callback)) { + if (isTruthy(res_callback) & !isTRUE(only_callback)) { data <- data[.datamods_id != input$delete] data <- data[order(.datamods_id)] data_rv$data <- data @@ -393,24 +405,28 @@ edit_data_server <- function(id, if (is.null(results_delete)) { notification_warning( title = i18n("Warning"), - text = i18n("Data wasn't deleted") + text = i18n("Data wasn't deleted"), + use_notify = use_notify ) } else if (inherits(results_delete, "try-error")) { notification_failure( title = i18n("Error"), - text = i18n("Unable to delete the row, contact platform administrator") + text = i18n("Unable to delete the row, contact platform administrator"), + use_notify = use_notify ) } else { notification_success( title = i18n("Registered"), - text = i18n("The row has been deleted") + text = i18n("The row has been deleted"), + use_notify = use_notify ) } }) observeEvent(input$confirmation_delete_row_no, { notification_info( title = i18n("Information"), - text = i18n("Row was not deleted") + text = i18n("Row was not deleted"), + use_notify = use_notify ) removeModal() }) diff --git a/man/edit-data.Rd b/man/edit-data.Rd index 2f92841..ea850ac 100644 --- a/man/edit-data.Rd +++ b/man/edit-data.Rd @@ -25,7 +25,9 @@ edit_data_server( modal_easy_close = TRUE, callback_add = NULL, callback_update = NULL, - callback_delete = NULL + callback_delete = NULL, + only_callback = FALSE, + use_notify = TRUE ) } \arguments{ @@ -62,7 +64,11 @@ Functions used must be like \code{function(data, row) {...}} where : \itemize{ \item \code{data} will be the data in the table at the moment the function is called \item \code{row} will contain either a new row of data (add), an updated row (update) or the row that will be deleted (delete). -} +}} + +\item{only_callback}{Only use callbacks, don't alter data within the module.} + +\item{use_notify}{Display information or not to user through \code{\link[shinybusy:notify]{shinybusy::notify()}}. If the return value of a callback function is not truthy (see \code{\link[shiny:isTruthy]{shiny::isTruthy()}}) then the action is cancelled.} } From d00b4c0616a8b09dc9cdafa800185c08447960ff Mon Sep 17 00:00:00 2001 From: pvictor Date: Tue, 5 Dec 2023 09:07:05 +0100 Subject: [PATCH 5/6] edit data: fixed doc --- R/edit-data.R | 3 ++- man/edit-data.Rd | 8 ++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/edit-data.R b/R/edit-data.R index 73392dd..e5bbae2 100644 --- a/R/edit-data.R +++ b/R/edit-data.R @@ -62,10 +62,11 @@ edit_data_ui <- function(id) { #' Functions used must be like `function(data, row) {...}` where : #' * `data` will be the data in the table at the moment the function is called #' * `row` will contain either a new row of data (add), an updated row (update) or the row that will be deleted (delete). +#' +#' If the return value of a callback function is not truthy (see [shiny::isTruthy()]) then the action is cancelled. #' @param only_callback Only use callbacks, don't alter data within the module. #' @param use_notify Display information or not to user through [shinybusy::notify()]. #' -#' If the return value of a callback function is not truthy (see [shiny::isTruthy()]) then the action is cancelled. #' #' #' @return the edited `data.frame` in reactable format with the user modifications diff --git a/man/edit-data.Rd b/man/edit-data.Rd index ea850ac..e524ecc 100644 --- a/man/edit-data.Rd +++ b/man/edit-data.Rd @@ -64,13 +64,13 @@ Functions used must be like \code{function(data, row) {...}} where : \itemize{ \item \code{data} will be the data in the table at the moment the function is called \item \code{row} will contain either a new row of data (add), an updated row (update) or the row that will be deleted (delete). -}} +} -\item{only_callback}{Only use callbacks, don't alter data within the module.} +If the return value of a callback function is not truthy (see \code{\link[shiny:isTruthy]{shiny::isTruthy()}}) then the action is cancelled.} -\item{use_notify}{Display information or not to user through \code{\link[shinybusy:notify]{shinybusy::notify()}}. +\item{only_callback}{Only use callbacks, don't alter data within the module.} -If the return value of a callback function is not truthy (see \code{\link[shiny:isTruthy]{shiny::isTruthy()}}) then the action is cancelled.} +\item{use_notify}{Display information or not to user through \code{\link[shinybusy:notify]{shinybusy::notify()}}.} } \value{ the edited \code{data.frame} in reactable format with the user modifications From 9ad1d847029a6ef3f478b25d88aa88103889b6db Mon Sep 17 00:00:00 2001 From: pvictor Date: Tue, 5 Dec 2023 09:10:47 +0100 Subject: [PATCH 6/6] fixed default callback delete --- R/edit-data.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/edit-data.R b/R/edit-data.R index e5bbae2..3e23353 100644 --- a/R/edit-data.R +++ b/R/edit-data.R @@ -110,8 +110,8 @@ edit_data_server <- function(id, callback_add <- callback_default if (!is_function(callback_update)) callback_update <- callback_default - if (!is_function(callback_add)) - callback_delete <- callback_delete + if (!is_function(callback_delete)) + callback_delete <- callback_default moduleServer( id, function(input, output, session) {