From 1e22396d9c9e9dba32c499974aabbeae9a7908ce Mon Sep 17 00:00:00 2001 From: pvictor Date: Sun, 21 Apr 2024 17:23:46 +0200 Subject: [PATCH] updated import file UI + generate code --- NAMESPACE | 2 -- R/import-file.R | 44 ++++++++++++++++++++++++++++---------------- examples/from-file.R | 5 +++++ man/import-file.Rd | 5 +++++ man/import-modal.Rd | 2 +- 5 files changed, 39 insertions(+), 19 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e17cda7..9dd04fd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -136,7 +136,6 @@ importFrom(shiny,reactiveValuesToList) importFrom(shiny,removeModal) importFrom(shiny,removeUI) importFrom(shiny,renderPlot) -importFrom(shiny,renderTable) importFrom(shiny,renderUI) importFrom(shiny,req) importFrom(shiny,selectizeInput) @@ -145,7 +144,6 @@ importFrom(shiny,singleton) importFrom(shiny,sliderInput) importFrom(shiny,tabPanel) importFrom(shiny,tabPanelBody) -importFrom(shiny,tableOutput) importFrom(shiny,tabsetPanel) importFrom(shiny,tagList) importFrom(shiny,tags) diff --git a/R/import-file.R b/R/import-file.R index 997794b..e111c29 100644 --- a/R/import-file.R +++ b/R/import-file.R @@ -13,10 +13,11 @@ #' #' @name import-file #' -#' @importFrom shiny NS fileInput tableOutput actionButton icon +#' @importFrom shiny NS fileInput actionButton icon #' @importFrom htmltools tags tagAppendAttributes css tagAppendChild #' @importFrom shinyWidgets pickerInput numericInputIcon textInputIcon dropMenu #' @importFrom phosphoricons ph +#' @importFrom toastui datagridOutput2 #' #' @example examples/from-file.R import_file_ui <- function(id, @@ -48,16 +49,16 @@ import_file_ui <- function(id, ), class = "mb-0" ), - tags$p(phosphoricons::ph("gear", title = "parameters"), i18n("Parameters")), fluidRow( column( width = 6, numericInputIcon( inputId = ns("skip_rows"), - label = i18n("Number of rows to skip before reading data:"), + label = i18n("Rows to skip before reading data:"), value = 0, min = 0, icon = list("n ="), + size = "sm", width = "100%" ), tagAppendChild( @@ -66,6 +67,7 @@ import_file_ui <- function(id, label = i18n("Missing values character(s):"), value = ",NA", icon = list("NA"), + size = "sm", width = "100%" ), shiny::helpText(ph("info"), "if several use a comma (',') to separate them") @@ -78,6 +80,7 @@ import_file_ui <- function(id, label = i18n("Decimal separator:"), value = ".", icon = list("0.00"), + size = "sm", width = "100%" ), textInputIcon( @@ -85,6 +88,7 @@ import_file_ui <- function(id, label = i18n("Encoding:"), value = "UTF-8", icon = phosphoricons::ph("text-aa"), + size = "sm", width = "100%" ) ) @@ -110,10 +114,7 @@ import_file_ui <- function(id, ) ), if (isTRUE(preview_data)) { - tagAppendAttributes( - tableOutput(outputId = ns("table")), - class = "datamods-table-container" - ) + datagridOutput2(outputId = ns("table")) }, uiOutput( outputId = ns("container_confirm_btn"), @@ -147,13 +148,14 @@ import_file_ui <- function(id, #' #' @importFrom shiny moduleServer #' @importFrom htmltools tags tagList -#' @importFrom shiny reactiveValues reactive observeEvent removeUI req renderTable +#' @importFrom shiny reactiveValues reactive observeEvent removeUI req #' @importFrom shinyWidgets updatePickerInput #' @importFrom readxl excel_sheets #' @importFrom rio import #' @importFrom rlang exec fn_fmls_names is_named is_function #' @importFrom tools file_ext #' @importFrom utils head +#' @importFrom toastui renderDatagrid2 datagrid #' #' @rdname import-file import_file_server <- function(id, @@ -227,6 +229,7 @@ import_file_server <- function(id, ) parameters <- parameters[which(names(parameters) %in% fn_fmls_names(read_fns[[extension]]))] imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE) + code <- call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name))) } else { if (is_excel(input$file$datapath)) { req(input$sheet) @@ -252,10 +255,13 @@ import_file_server <- function(id, ) } imported <- try(rlang::exec(rio::import, !!!parameters), silent = TRUE) + code <- call2("import", !!!modifyList(parameters, list(file = input$file$name)), .ns = "rio") } - if (inherits(imported, "try-error")) + if (inherits(imported, "try-error")) { imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE) + code <- call2("import", !!!list(file = input$file$name), .ns = "rio") + } if (inherits(imported, "try-error") || NROW(imported) < 1) { @@ -264,6 +270,7 @@ import_file_server <- function(id, temporary_rv$status <- "error" temporary_rv$data <- NULL temporary_rv$name <- NULL + temporary_rv$code <- NULL } else { @@ -282,6 +289,7 @@ import_file_server <- function(id, temporary_rv$status <- "success" temporary_rv$data <- imported temporary_rv$name <- input$file$name + temporary_rv$code <- code } }, ignoreInit = TRUE) @@ -289,30 +297,34 @@ import_file_server <- function(id, show_data(temporary_rv$data, title = i18n("Imported data"), type = show_data_in) }) - output$table <- renderTable({ + output$table <- renderDatagrid2({ req(temporary_rv$data) - data <- head(temporary_rv$data, 5) - classes <- get_classes(data) - classes <- sprintf("%s", classes) - names(data) <- paste(names(data), classes, sep = "
") - data - }, striped = TRUE, bordered = TRUE, sanitize.colnames.function = identity, spacing = "xs") + datagrid( + data = head(temporary_rv$data, 5), + theme = "striped", + colwidths = "guess", + minBodyHeight = 250 + ) + }) observeEvent(input$confirm, { imported_rv$data <- temporary_rv$data imported_rv$name <- temporary_rv$name + imported_rv$code <- temporary_rv$code }) if (identical(trigger_return, "button")) { return(list( status = reactive(temporary_rv$status), name = reactive(imported_rv$name), + code = reactive(imported_rv$code), data = reactive(as_out(imported_rv$data, return_class)) )) } else { return(list( status = reactive(temporary_rv$status), name = reactive(temporary_rv$name), + code = reactive(temporary_rv$code), data = reactive(as_out(temporary_rv$data, return_class)) )) } diff --git a/examples/from-file.R b/examples/from-file.R index d154d61..94d70a5 100644 --- a/examples/from-file.R +++ b/examples/from-file.R @@ -19,6 +19,8 @@ ui <- fluidPage( verbatimTextOutput(outputId = "status"), tags$b("Name:"), verbatimTextOutput(outputId = "name"), + tags$b("Code:"), + verbatimTextOutput(outputId = "code"), tags$b("Data:"), verbatimTextOutput(outputId = "data") ) @@ -47,6 +49,9 @@ server <- function(input, output, session) { output$name <- renderPrint({ imported$name() }) + output$code <- renderPrint({ + imported$code() + }) output$data <- renderPrint({ imported$data() }) diff --git a/man/import-file.Rd b/man/import-file.Rd index a488f51..a31c624 100644 --- a/man/import-file.Rd +++ b/man/import-file.Rd @@ -97,6 +97,8 @@ ui <- fluidPage( verbatimTextOutput(outputId = "status"), tags$b("Name:"), verbatimTextOutput(outputId = "name"), + tags$b("Code:"), + verbatimTextOutput(outputId = "code"), tags$b("Data:"), verbatimTextOutput(outputId = "data") ) @@ -125,6 +127,9 @@ server <- function(input, output, session) { output$name <- renderPrint({ imported$name() }) + output$code <- renderPrint({ + imported$code() + }) output$data <- renderPrint({ imported$data() }) diff --git a/man/import-modal.Rd b/man/import-modal.Rd index b7c9793..9577870 100644 --- a/man/import-modal.Rd +++ b/man/import-modal.Rd @@ -86,7 +86,7 @@ library(datamods) ui <- fluidPage( # Try with different Bootstrap version - # theme = bslib::bs_theme(version = 5, preset = "bootstrap"), + theme = bslib::bs_theme(version = 5, preset = "bootstrap"), fluidRow( column( width = 4,