make_uploadfile <- function(accept) {
if (getOption("radiant.shinyFiles", FALSE)) {
shinyFiles::shinyFilesButton("uploadfile", "Load", "Load data", multiple = TRUE, icon = icon("upload", verify_fa = FALSE))
} else {
fileInput("uploadfile", NULL, multiple = TRUE, accept = accept)
}
}
output$ui_fileUpload <- renderUI({
req(input$dataType)
if (input$dataType == "csv") {
make_uploadfile(
accept = c(
"text/csv", "text/comma-separated-values",
"text/tab-separated-values", "text/plain", ".csv", ".tsv"
)
)
} else if (input$dataType %in% c("rda", "rds")) {
make_uploadfile(accept = c(".rda", ".rds", ".rdata"))
} else if (input$dataType == "feather") {
make_uploadfile(accept = ".feather")
} else if (input$dataType == "url_rds") {
with(tags, table(
tr(
td(textInput("url_rds", NULL, "")),
td(actionButton("url_rds_load", "Load", icon = icon("upload", verify_fa = FALSE)), class = "top_small")
)
))
} else if (input$dataType == "url_csv") {
with(tags, table(
tr(
td(textInput("url_csv", NULL, "")),
td(actionButton("url_csv_load", "Load", icon = icon("upload", verify_fa = FALSE)), class = "top_small")
)
))
}
})
output$ui_state_upload <- renderUI({
fileInput("state_upload", "Upload radiant state file:", accept = ".rda")
})
output$refreshOnLoad <- renderUI({
# req(input$state_load)
req(pressed(input$state_load) || pressed(input$state_upload))
if (pressed(input$state_load)) {
if (getOption("radiant.shinyFiles", FALSE)) {
if (is.integer(input$state_load)) {
return()
}
path <- shinyFiles::parseFilePaths(sf_volumes, input$state_load)
if (inherits(path, "try-error") || is.empty(path$datapath)) {
return()
}
path <- path$datapath
sname <- basename(path)
} else {
path <- input$state_load$datapath
sname <- input$state_load$name
}
} else {
path <- input$state_upload$datapath
sname <- input$state_upload$name
}
if (is.empty(path)) {
invisible()
} else {
withProgress(message = "Loading state file", value = 1, {
refreshOnLoad(path, sname)
})
## Joe Cheng: https://groups.google.com/forum/#!topic/shiny-discuss/Olr8m0JwMTo
tags$script("window.location.reload();")
}
})
output$ui_state_upload <- renderUI({
fileInput("state_upload", "Upload radiant state file:", accept = ".rda")
})
refreshOnLoad <- function(path, sname) {
tmpEnv <- new.env(parent = emptyenv())
load(path, envir = tmpEnv)
if (is.null(tmpEnv$r_state) && is.null(tmpEnv$r_data)) {
## don't destroy session when attempting to load a
## file that is not a state file
showModal(
modalDialog(
title = "Restore radiant state failed",
span(
"Unable to restore radiant state from the selected file.
Choose another state file or select 'rds | rda | rdata' from the 'Load
data of type' dropdown to load an R-data file and try again"
),
footer = modalButton("OK"),
size = "m",
easyClose = TRUE
)
)
return(invisible())
}
## remove characters that may cause problems in shinyAce from r_state
## https://stackoverflow.com/questions/22549146/ace-text-editor-displays-text-characters-in-place-of-spaces
if (!is.null(tmpEnv$r_state)) {
for (i in names(tmpEnv$r_state)) {
if (is.character(tmpEnv$r_state[[i]])) {
tmpEnv$r_state[[i]] %<>% fix_smart()
}
}
}
## remove characters that may cause problems in shinyAce from r_data
if (!is.null(tmpEnv$r_data)) {
for (i in names(tmpEnv$r_data)) {
if (is.character(tmpEnv$r_data[[i]])) {
tmpEnv$r_data[[i]] %<>% fix_smart()
}
}
}
## remove characters that may cause problems in shinyAce from r_info
if (!is.null(tmpEnv$r_info)) {
for (i in names(tmpEnv$r_info)) {
if (is.character(tmpEnv$r_info[[i]])) {
tmpEnv$r_info[[i]] %<>% fix_smart()
}
}
}
## storing statename for later use if needed
tmpEnv$r_state$radiant_state_name <- sname
r_sessions[[r_ssuid]] <- list(
r_data = tmpEnv$r_data,
r_info = tmpEnv$r_info,
r_state = tmpEnv$r_state,
timestamp = Sys.time()
)
rm(tmpEnv)
}
output$ui_Manage <- renderUI({
data_types_in <- c(
"rds | rda | rdata" = "rds", "csv" = "csv",
"clipboard" = "clipboard", "examples" = "examples",
"rds (url)" = "url_rds", "csv (url)" = "url_csv",
"feather" = "feather", "from global workspace" = "from_global",
"radiant state file" = "state"
)
data_types_out <- c(
"rds" = "rds", "rda" = "rda", "csv" = "csv",
"clipboard" = "clipboard", "feather" = "feather",
"to global workspace" = "to_global", "radiant state file" = "state"
)
if (!isTRUE(getOption("radiant.local"))) {
data_types_in <- data_types_in[-which(data_types_in == "from_global")]
data_types_out <- data_types_out[-which(data_types_out == "to_global")]
}
if (!("feather" %in% rownames(utils::installed.packages()))) {
data_types_in <- data_types_in[-which(data_types_in == "feather")]
data_types_out <- data_types_out[-which(data_types_out == "feather")]
}
tagList(
wellPanel(
selectInput("dataType", label = "Load data of type:", data_types_in, selected = "rds"),
conditionalPanel(
condition = "input.dataType != 'clipboard' &&
input.dataType != 'examples'",
conditionalPanel(
"input.dataType == 'csv' || input.dataType == 'url_csv'",
with(tags, table(
td(checkboxInput("man_header", "Header", TRUE)),
td(HTML(" ")),
td(checkboxInput("man_str_as_factor", "Str. as Factor", TRUE))
)),
with(tags, table(
td(selectInput("man_sep", "Separator:", c(Comma = ",", Semicolon = ";", Tab = "\t"), ",", width = "100%")),
td(selectInput("man_dec", "Decimal:", c(Period = ".", Comma = ","), ".", width = "100%")),
width = "100%"
)),
numericInput(
"man_n_max",
label = "Maximum rows to read:",
value = Inf, max = Inf, step = 1000
)
),
uiOutput("ui_fileUpload")
),
conditionalPanel(
condition = "input.dataType == 'clipboard'",
uiOutput("ui_clipboard_load")
),
conditionalPanel(
condition = "input.dataType == 'from_global'",
uiOutput("ui_from_global")
),
conditionalPanel(
condition = "input.dataType == 'examples'",
actionButton("loadExampleData", "Load", icon = icon("upload", verify_fa = FALSE))
),
conditionalPanel(
condition = "input.dataType == 'state'",
uiOutput("ui_state_load"),
uiOutput("ui_state_upload"),
uiOutput("refreshOnLoad")
)
)
)
})