Commit ae9898cd authored by mmassaviol's avatar mmassaviol
Browse files

Add input types (shinyFiles)

Update reload (when results_dir is selected)
parent 3c7c7084
......@@ -153,7 +153,7 @@ generate_page_input <- function(res, cnt) {
res <- res + '), selected = "'+cnt$value+'"' + ', width = "'+ 'auto' +'")'
}
if(cnt$type == "file") {
if(cnt$type == "input_file_client") {
res <- res + '\t\tfileInput("'+ cnt$name +'", label = "'+ cnt$label + '"'
......@@ -180,6 +180,21 @@ generate_page_input <- function(res, cnt) {
res <- res + ', multiple = ' + cnt$multiple + ', width = "'+ 'auto' + '")'
}
# output_file_server
if(cnt$type == "input_file_server"){
res <- res + '\t\ttags$label("' + cnt$label + '"),\n'
res <- res + '\t\tfluidRow(\n'
res <- res + '\t\t\tcolumn(4,shinyFilesButton("shinyfiles_' + cnt$name + '",label="Please select a file", title="' + cnt$label + '", multiple=FALSE)),\n'
res <- res + '\t\t\tcolumn(8,textInput("' + cnt$name + '",label=NULL,value=""))\n'
res <- res + '\t\t)\n'
}
if(cnt$type == "input_dir" || cnt$type == "output_dir"){
res <- res + '\t\ttags$label("' + cnt$label + '"),\n'
res <- res + '\t\tfluidRow(\n'
res <- res + '\t\t\tcolumn(4,shinyDirButton("shinydir_' + cnt$name + '",label="Please select a directory", title="' + cnt$label + '")),\n'
res <- res + '\t\t\tcolumn(8,textInput("' + cnt$name + '",label=NULL,value=""))\n'
res <- res + '\t\t)\n'
}
return(res)
}
......@@ -380,21 +395,23 @@ generate_pages_server <- function() {
genR <- ""
if(type == 'text') {
if(cnt$type == 'text' || cnt$type == "input_file_server" || cnt$type == "input_dir" || cnt$type == "output_dir") {
genR <- genR + '\t\tif(!is.na(as.numeric(input$' + id + '))) {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", input$' + id + ', "\\n", sep = " "))\n'
genR <- genR + '\t\t} else {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", paste0(\'\"\', input$' + id + ', \'\"\'), "\\n", sep = " "))\n'
genR <- genR + '\t\t}'
genR <- genR + '\t\n\n'
} else if(type == 'numeric') {
}
if(cnt$type == 'numeric') {
genR <- genR + '\t\tif(!is.na(as.numeric(input$' + id + '))) {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", input$' + id + ', "\\n", sep = " "))\n'
genR <- genR + '\t\t} else {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", paste0(\'\"\', input$' + id + ', \'\"\'), "\\n", sep = " "))\n'
genR <- genR + '\t\t}'
genR <- genR + '\t\n\n'
} else if(cnt$type == "slider") {
}
if(cnt$type == "slider") {
if(length(cnt$value) == 1) {
genR <- genR + '\t\tres = paste0(res, paste("' + id + ':", input$' + id + ', "\\n", sep = " "))'
genR <- genR + '\t\n\n'
......@@ -404,24 +421,28 @@ generate_pages_server <- function() {
genR <- genR + '\t\tres = paste0(res, paste("' + id + '_step:", "' + cnt$step + '", "\\n", sep = " "))\n'
genR <- genR + '\t\n\n'
}
} else if(cnt$type == "select") {
}
if(cnt$type == "select") {
genR <- genR + '\t\tif(!is.na(as.numeric(input$' + id + '))) {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", input$' + id + ', "\\n", sep = " "))\n'
genR <- genR + '\t\t} else {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", paste0(\'\"\', input$' + id + ', \'\"\'), "\\n", sep = " "))\n'
genR <- genR + '\t\t}'
genR <- genR + '\t\n\n'
} else if(cnt$type == "file") {
}
if(cnt$type == "file") {
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", paste0(\'\"\', input$' + id + '$datapath, \'\"\'), "\\n", sep = " "))'
genR <- genR + '\t\n\n'
} else if(cnt$type == "checkbox") {
}
if(cnt$type == "checkbox") {
genR <- genR + '\t\tif(input$' + id + ') {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", "true", "\\n", sep = " "))\n'
genR <- genR + '\t\t} else {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", "false", "\\n", sep = " "))\n'
genR <- genR + '\t\t}'
genR <- genR + '\t\n\n'
} else if(cnt$type == "chooser") {
}
if(cnt$type == "chooser") {
genR <- genR + '\t\tres <- paste0(res, " ' + id + '" + "_left: [")\n'
genR <- genR + '\t\tif(length(input$'+ id +'$left) > 0) {\n'
genR <- genR + '\t\tfor(x in 1:length(input$'+ id +'$left)) {\n'
......@@ -444,7 +465,8 @@ generate_pages_server <- function() {
genR <- genR + '\t\t} \n'
genR <- genR + '\t\tres <- paste0(res, "]", "\\n")\n\n'
} else if(cnt$type == "radio") {
}
if(cnt$type == "radio") {
genR <- genR + '\t\tif(!is.na(as.numeric(input$' + id + '))) {\n'
genR <- genR + '\t\t\tres = paste0(res, paste("' + id + ':", input$' + id + ', "\\n", sep = " "))\n'
genR <- genR + '\t\t} else {\n'
......@@ -602,7 +624,27 @@ generate_pages_server <- function() {
res <- res + '\t\twarning = function(w){\n'
res <- res + '\t\t\tsystem(paste0("touch ",input$results_dir,"/logs/workflow_end.error"),wait = T)\n'
res <- res + '\t\t\treturn(tags$p(paste0("error : ",w$message)))})\n'
res <- res + '\t\t})'
res <- res + '\t\t})\n\n'
for(page in APP$pages){
for(box in page$boxes){
for(cnt in box$content){
volumes = 'c(data="/samples",results="/results")'
if (cnt$type == "input_file_server"){
res <- res + '\t\tshinyFileChoose(input, "shinyfiles_' + cnt$name + '", root=' + volumes + ',session = session)\n'
res <- res + '\t\tobserveEvent({parseFilePaths(' + volumes + ',input$shinyfiles_' + cnt$name + ')$datapath[1]},{\n'
res <- res + '\t\t\tupdateTextInput(session,"' + cnt$name + '",value = parseFilePaths(' + volumes + ',input$shinyfiles_' + cnt$name + ')$datapath[1])\n'
res <- res + '\t\t})\n\n'
}
if (cnt$type == "input_dir" || cnt$type == "output_dir"){
res <- res + '\t\tshinyDirChoose(input, "shinydir_' + cnt$name + '", root=' + volumes + ',session = session)\n'
res <- res + '\t\tobserveEvent({parseDirPath(' + volumes + ',input$shinydir_' + cnt$name + ')},{\n'
res <- res + '\t\t\tupdateTextInput(session,"' + cnt$name + '",value = parseDirPath(' + volumes + ',input$shinydir_' + cnt$name + '))\n'
res <- res + '\t\t})\n\n'
}
}
}
}
write(res, APP$project+"/server/opt_global.R")
}
......@@ -893,39 +935,19 @@ generate_app <- function() {
res <- res + '\trv <- reactiveValues(textstream = c(""), running = FALSE, timer = reactiveTimer(1000))\n\n'
# Observe query to find user and directory
res <- res + 'observeEvent(parseQueryString(session$clientData$url_search),{\n'
res <- res + '\t\tquery <- parseQueryString(session$clientData$url_search)\n'
res <- res + '\t\tif (!is.null(query[[\'nom\']]) & !is.null(query[[\'prenom\']]) & !is.null(query[[\'dossier\']])) {\n'
res <- res + '\t\t\tnom\t<<-\tquery$nom\n'
res <- res + '\t\t\tprenom <<- query$prenom\n'
res <- res + '\t\t\tdossier <<- query$dossier\n'
res <- res + '\t\t}\n'
res <- res + '\t\telse {\n'
res <- res + '\t\t\tnom\t<<-\t"anonym"\n'
res <- res + '\t\t\tprenom <<- "anonym"\n'
res <- res + '\t\t\tdossier <<- format(Sys.time(), "%d-%m-%Y_%H-%M-%S")\n'
res <- res + '\t\t\t \n'
res <- res + '\t\t}\n'
res <- res + '\t\tprefix_path = "/results"\n'
res <- res + '\t\tdossierAnalyse = paste0(prefix_path,"/",dossier)\n'
res <- res + '\t\tif (dir.exists(dossierAnalyse)){\n'
res <- res + '\t\t\treload(dossierAnalyse,session,output)\n'
res <- res + '\t\t\tupdateTextInput(session, "results_dir", value = dossierAnalyse)\n'
res <- res + 'observeEvent(input$results_dir,{\n'
res <- res + '\t\tif (dir.exists(input$results_dir)){\n'
res <- res + '\t\t\treload(input$results_dir,session,output)\n'
res <- res + '\t\t\tshinyjs::disable("results_dir")\n'
res <- res + '\t\t\tif (file.exists(paste0(dossierAnalyse,"/logs/workflow.running"))){\n'
res <- res + '\t\t\tif (file.exists(paste0(input$results_dir,"/logs/workflow.running"))){\n'
res <- res + '\t\t\t\trv$running = TRUE\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t}\n'
res <- res + '\t\telse{\n'
res <- res + '\t\t\t# create new dir\n'
res <- res + '\t\t\tdossierAnalyse = paste0(prefix_path,"/",dossier)\n'
res <- res + '\t\t\tupdateTextInput(session, "results_dir", value = dossierAnalyse)\n'
res <- res + '\t\t\tshinyjs::disable("results_dir")\n'
res <- res + '\t\t\tdir.create(dossierAnalyse)\n'
res <- res + '\t\t\toutput$RULEGRAPH_svg = renderUI(tagList(h3("No rule graph found, press the rule graph button to generate one.")))\n'
res <- res + '\t\t\toutput$report_html = renderUI(tags$h3("No report found, run the pipeline to produce a report"))\n'
res <- res + '\t\t}\n'
res <- res + '\t})\n'
res <- res + '})\n'
# Observe if the workflow is running
res <- res + '\tobserve({\n'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment