Commit 7c6e72b9 authored by mmassaviol's avatar mmassaviol
Browse files

Big Update

- add reload of an existing workflow
- show running workflow in a tab
parent f525b299
......@@ -566,15 +566,13 @@ generate_pages_server <- function() {
res <- res + 'observeEvent(input$RULEGRAPH, {\n\n'
res <- res + '\tinput_list <- reactiveValuesToList(input)\n'
res <- res + '\ttoggle_inputs(input_list,F,F)\n'
res <- res + '\tpath_param <- "/results/params.yml' + '"\n\n'
res <- res + '\tpath_param <- paste0(input$results_dir,"/params.yml")\n\n'
res <- res + '\tres <- ""'
res <- res + resG
res <- res + '\ta = yaml.load_file("/workflow/params.total.yml")\n'
res <- res + '\tb = yaml.load(res)\n'
res <- res + '\tanotb = subset(names(a), !(names(a)%in%names(b)))\n'
res <- res + '\tc = c(a[anotb],b)\n'
res <- res + '\tlogical = function(x) {\n'
res <- res + '\t\tresult <- ifelse(x, "True", "False")\n'
res <- res + '\t\tclass(result) <- "verbatim"\n'
......@@ -585,19 +583,19 @@ generate_pages_server <- function() {
res <- res + '\tc$samples = names(samples)\n'
res <- res + '\tnames(samples) = NULL\n'
res <- res + '\tc$groups = unlist(samples)\n'
res <- res + '\twrite_yaml(c,"/results/params.yml",handlers=list(logical = logical))\n'
res <- res + '\twrite_yaml(c,path_param,handlers=list(logical = logical))\n'
res <- res + '\ti = sample.int(1000,size = 1)\n\n'
res <- res + '\tsystem("rm /results/rulegraph*")\n\n'
res <- res + '\tsystem(paste0("rm ",input$results_dir,"/rulegraph*"))\n\n'
res <- res + '\toutUI = tryCatch({\n'
res <- res + '\t\tsystem(paste0("snakemake -s /workflow/Snakefile --configfile /results/params.yml -d /results --rulegraph > /results/rulegraph",i,".dot"),intern=T)\n'
res <- res + '\t\tsystem(paste0("cat /results/rulegraph",i,".dot | dot -Tsvg -Gratio=0.75 > /results/rulegraph",i,".svg"),intern=T)\n'
res <- res + '\t\tsystem(paste0("snakemake -s /workflow/Snakefile --configfile ",input$results_dir,"/params.yml -d ",input$results_dir," --rulegraph > ",input$results_dir,"/rulegraph",i,".dot"),intern=T)\n'
res <- res + '\t\tsystem(paste0("cat ",input$results_dir,"/rulegraph",i,".dot | dot -Tsvg -Gratio=0.75 > ",input$results_dir,"/rulegraph",i,".svg"),intern=T)\n'
res <- res + '\t\ttagList(img(src = paste0("results/rulegraph",i,".svg") ,alt = "Rulegraph of Snakemake jobs",width="100%",height="auto"))},\n'
res <- res + '\terror = function(e){return(tags$p(paste0("error : ",e$message)))},\n'
res <- res + '\twarning = function(w){return(tags$p(paste0("warning : ",w$message)))})\n'
res <- res + '\taddResourcePath("results", "/results")\n'
res <- res + '\taddResourcePath("results", input$results_dir)\n'
res <- res + '\toutput$RULEGRAPH_svg = renderUI(outUI)\n'
res <- res + '\ttoggle_inputs(input_list,T,F)\n'
res <- res + '})\n'
......@@ -607,11 +605,12 @@ generate_pages_server <- function() {
res <- res + '#\' Event when use '+ run$shiny_button$name +' button\n'
res <- res + 'observeEvent(input$'+run$shiny_button$name+', {\n\n'
res <- res + '\trv$running = T\n'
res <- res + '\tinput_list <- reactiveValuesToList(input)\n'
res <- res + '\ttoggle_inputs(input_list,F,F)\n'
panel_path <- APP$project + '/params/' + 'params_' + APP$pages[[x]]$name + '.yml'
res <- res + '\tpath_param <- "/results/' + 'params.yml' + '"\n\n'
res <- res + '\tpath_param <- paste0(input$results_dir,"/params.yml")\n\n'
res <- res + '\tres <- ""'
res <- res + resG # Add content
......@@ -620,10 +619,8 @@ generate_pages_server <- function() {
res <- res + '\ta = yaml.load_file("/workflow/params.total.yml")\n'
res <- res + '\tb = yaml.load(res)\n'
res <- res + '\tanotb = subset(names(a), !(names(a)%in%names(b)))\n'
res <- res + '\tc = c(a[anotb],b)\n'
res <- res + '\tlogical = function(x) {\n'
res <- res + '\t\tresult <- ifelse(x, "True", "False")\n'
res <- res + '\t\tclass(result) <- "verbatim"\n'
......@@ -633,7 +630,7 @@ generate_pages_server <- function() {
res <- res + '\tc$samples = names(samples)\n'
res <- res + '\tnames(samples) = NULL\n'
res <- res + '\tc$groups = unlist(samples)\n'
res <- res + '\twrite_yaml(c,"/results/params.yml",handlers=list(logical = logical))\n'
res <- res + '\twrite_yaml(c,paste0(input$results_dir,"/params.yml"),handlers=list(logical = logical))\n'
res <- res + '\t '
......@@ -644,43 +641,18 @@ generate_pages_server <- function() {
res <- res + '\toutUI = tryCatch({\n'
res <- res + '\t\tsystem(paste(" '
res <- res + run$program + '", '
for(o in 1:length(run$options)) {
option = run$options[[o]]
if(option$type == "value") {
res <- res + '"' + option$name + '", "' + option$value + '" '
} else if (option$type == "shiny") {
res <- res + '"' + option$name + '", input$' + option$value + ' '
} else if(option$type == "shiny-file") {
res <- res + '"' + option$name + '", input$' + option$value + '$datapath '
} else if(option$type == "panel") {
res <- res + '"' + option$name + '", "' + APP$project + '/params/params_' + APP$pages[[x]]$name + '.yml"'
}
if(o < length(run$options)) {
res <- res + ', '
}
}
res <- res + '\t\tif (!dir.exists(paste0(input$results_dir,"/logs"))){\n'
res <- res + '\t\tdir.create(paste0(input$results_dir,"/logs"))\n'
res <- res + '\t}\n'
res <- res + '\tif (!file.exists(paste0(input$results_dir,"/logs/runlog.txt"))){\n'
res <- res + '\t\tfile.create(paste0(input$results_dir,"/logs/runlog.txt"))\n'
res <- res + '\t}\n'
res <- res + '\t\tsystem2("python3",paste("-u -m snakemake", "-s", "/workflow/Snakefile" ,\t"--configfile", paste0(input$results_dir,"/params.yml") ,\t"-d", input$results_dir ,\t"--cores", input$cores , sep = " " ),wait = FALSE, stdout = paste0(input$results_dir,"/logs/runlog.txt"), stderr = paste0(input$results_dir,"/logs/runlog.txt"))\n'
res <- res + ', sep = " " ),intern=T)\n'
res <- res + '\t\ttags$iframe(src="results/report.html",width="100%", height="900px")},\n'
res <- res + '\terror = function(e){return(tags$p(paste0("error : ",e$message)))},\n'
res <- res + '\twarning = function(w){return(tags$p(paste0("warning : ",w$message)))})\n'
res <- res + '\taddResourcePath("results", "/results")\n'
res <- res + '\toutput$report_html = renderUI(outUI)\n\n'
res <- res + '\n\n'
res <- res + '\ttoggle_inputs(input_list,T,F)\n'
res <- res + '})\n\n'
......@@ -703,52 +675,55 @@ generate_menu <- function() {
name <- APP$pages[[x]]$name
icon <- APP$pages[[x]]$icon
menu <- APP$pages[[x]]$label
res <- res + ' menuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n\n'
res <- res + '\tmenuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n\n'
}
if("RULEGRAPH" %in% names(APP)){
name <- "RULEGRAPH"
icon <- "gear"
menu <- "Rule Graph"
res <- res + ' menuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n\n'
res <- res + '\tmenuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n\n'
}
res <- res + ' tags$br(),\n\n'
res <- res + '\ttags$br(),\n\n'
res <- res + ' numericInput("cores", label = "Threads available", min = 1, max = NA, step = 1, width = "auto", value = 4),\n'
res <- res + '\tnumericInput("cores", label = "Threads available", min = 1, max = NA, step = 1, width = "auto", value = 4),\n'
if("RULEGRAPH" %in% names(APP)){
res <- res + ' tags$br(),\n\n'
res <- res + '\ttags$br(),\n\n'
res <- res + ' actionButton("RULEGRAPH", "Rule Graph", icon("gear") , class="btn btn-info"),\n\n'
res <- res + '\tactionButton("RULEGRAPH", "Rule Graph", icon("gear") , class="btn btn-info"),\n\n'
}
res <- res + ' tags$br(),\n'
res <- res + '\ttags$br(),\n'
res <- res + ' actionButton("'+ APP$run$shiny_button$name +'", "'+ APP$run$shiny_button$label +'", icon("'+ APP$run$shiny_button$icon +'"), class="'+ APP$run$shiny_button$class +'"),\n\n'
res <- res + '\tactionButton("'+ APP$run$shiny_button$name +'", "'+ APP$run$shiny_button$label +'", icon("'+ APP$run$shiny_button$icon +'"), class="'+ APP$run$shiny_button$class +'"),\n\n'
res <- res + '\ttags$br(),\n'
res <- res + '\ttags$br(),\n'
res <- res + '\tmenuItem("Run out", tabName="run_out", icon=icon("file", lib="font-awesome"), newtab=FALSE),'
if("Report" %in% names(APP)){
res <- res + ' tags$br(),\n'
res <- res + ' tags$br(),\n'
name <- "Report"
icon <- "file"
menu <- "Report"
res <- res + ' menuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n\n'
res <- res + '\tmenuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n\n'
}
if("download" %in% names(APP)){
res <- res + ' tags$br(),\n\n'
res <- res + '\ttags$br(),\n\n'
res <- res + ' downloadButton("'+ APP$download$shiny_button$name +'", "'+ APP$download$shiny_button$label +'", class="'+ APP$download$shiny_button$class +'", style="color:black;margin: 6px 5px 6px 15px;"),\n\n'
res <- res + '\tdownloadButton("'+ APP$download$shiny_button$name +'", "'+ APP$download$shiny_button$label +'", class="'+ APP$download$shiny_button$class +'", style="color:black;margin: 6px 5px 6px 15px;"),\n\n'
}
res <- res + ' tags$br(),tags$br(),\n\n'
res <- res + '\ttags$br(),tags$br(),\n\n'
res <- res + ' menuItem("Powered by mbb", href="http://mbb.univ-montp2.fr/MBB/index.php", newtab=TRUE, icon=icon("book", lib="font-awesome"), selected=NULL)\n\n'
res <- res + '\tmenuItem("Powered by mbb", href="http://mbb.univ-montp2.fr/MBB/index.php", newtab=TRUE, icon=icon("book", lib="font-awesome"), selected=NULL)\n\n'
res <- res + ')\n\n'
......@@ -869,6 +844,8 @@ generate_app <- function() {
if("Report" %in% names(APP)){
res <- res + "tabReport = fluidPage(box(title = 'Report :', width = 12, status = 'primary', collapsible = TRUE, solidHeader = TRUE, uiOutput('report_html')))\n"
}
res <- res + 'tabRUN = fluidPage(box(title = \'Run :\', width = 12 , status = \'primary\', collapsible = TRUE, solidHeader = TRUE, uiOutput(\'run_out\',style = \'overflow-y: scroll; height: 600px\')))\n'
res <- res + 'source("./R/menugauche.R", local=T)\n\n'
......@@ -909,30 +886,136 @@ generate_app <- function() {
if("Report" %in% names(APP)){
res <- res + '\t,tabItem(tabName = "Report", tabReport)'
}
res <- res + '\t,tabItem(tabName = "run_out", tabRUN)'
res <- res + ' )\n\n'
res <- res + ')\n\n'
res <- res + ')\n\n'
# function to reload params, rulegraph and report if they exists
res <- res + 'reload = function(dossierAnalyse,session,output){\n'
res <- res + '\t# if params exists reload them\n'
res <- res + '\tif (file.exists(paste0(dossierAnalyse,"/params.yml"))){\n'
res <- res + '\t\tparams = read_yaml(paste0(dossierAnalyse,"/params.yml"))\n'
res <- res + '\t\tfor (param in names(params$params_types)){\n'
res <- res + '\t\t\tprint(params[param])\n'
res <- res + '\t\t\tif (params$params_types[[param]] == "text"){\n'
res <- res + '\t\t\t\tupdateTextInput(session, param, value = params[[param]])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\telse if (params$params_types[[param]] == "numeric"){\n'
res <- res + '\t\t\t\tupdateNumericInput(session, param, value = params[[param]])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\telse if (params$params_types[[param]] == "radio"){\n'
res <- res + '\t\t\t\tupdateRadioButtons(session, param, selected = params[[param]])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\telse if (params$params_types[[param]] == "select"){\n'
res <- res + '\t\t\t\tupdateSelectInput(session, param, selected = params[[param]])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t}\n'
res <- res + '\t}\n'
res <- res + '\t# if rulegraph show it\n'
res <- res + '\trulegraph = list.files(path=dossierAnalyse,pattern="rulegraph[[:digit:]]+.svg")\n'
res <- res + '\tif (length(rulegraph) == 1)\n'
res <- res + '\t\taddResourcePath("results", dossierAnalyse)\n'
res <- res + '\t\toutput$RULEGRAPH_svg = renderUI(tagList(img(src = paste0("results/",rulegraph) ,alt = "Rulegraph of Snakemake jobs",width="100%",height="auto")))\n'
res <- res + '\n'
res <- res + '\t# if report show it\n'
res <- res + '\tif (file.exists(paste0(dossierAnalyse,"/report.html"))){\n'
res <- res + '\t\taddResourcePath("results", dossierAnalyse)\n'
res <- res + '\t\toutput$report_html = renderUI(tags$iframe(src=paste0("/results/report.html"),width="100%", height="900px"))\n'
res <- res + '\t}\n'
res <- res + '}\n'
res <- res + '\n\n'
res <- res + 'server <- function( input, output, session) {\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}\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 + '\t\t\tshinyjs::disable("results_dir")\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\tprint(dossierAnalyse)\n'
res <- res + '\t\t}\n'
res <- res + '\t})\n'
# Observe if the workflow is running
res <- res + '\trv <- reactiveValues(textstream = c(""), running = FALSE, timer = reactiveTimer(1000))\n'
res <- res + '\n'
res <- res + '\tobserve({\n'
res <- res + '\t\trv$timer()\n'
res <- res + '\t\tif (isolate(rv$running)){\n'
res <- res + '\t\t\tif (file.exists(paste0(isolate(input$results_dir),"/logs/runlog.txt"))){\n'
res <- res + '\t\t\t\trv$textstream <- paste(readLines(paste0(input$results_dir,"/logs/runlog.txt"),warn=F), collapse = "<br/>")\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\telse{\n'
res <- res + '\t\t\t\tif (!dir.exists(paste0(input$results_dir,"/logs"))){\n'
res <- res + '\t\t\t\t\tdir.create(paste0(input$results_dir,"/logs"))\n'
res <- res + '\t\t\t\t}\n'
res <- res + '\t\t\t\tfile.create(paste0(input$results_dir,"/logs/runlog.txt"))\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\tif (file.exists(paste0(isolate(input$results_dir),"/logs/workflow_end.ok"))){\n'
res <- res + '\t\t\t\trv$running = F\n'
res <- res + '\t\t\t\ttoggle_inputs(reactiveValuesToList(input),T,F)\n'
res <- res + '\t\t\t\taddResourcePath("results", input$results_dir)\n'
res <- res + '\t\t\t\toutUI = tags$iframe(src=paste0("/results/report.html"),width="100%", height="900px")\n'
res <- res + '\t\t\t\toutput$report_html = renderUI(outUI)\n'
res <- res + '\t\t\t\tfile.remove(paste0(paste0(input$results_dir,"/logs/workflow_end.ok")))\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\telse if (file.exists(paste0(isolate(input$results_dir),"/logs/workflow_end.error"))){\n'
res <- res + '\t\t\t\trv$running = F\n'
res <- res + '\t\t\t\ttoggle_inputs(reactiveValuesToList(input),T,F)\n'
res <- res + '\t\t\t\toutput$report_html = renderUI(HTML(paste(readLines(paste0(input$results_dir,"/logs/workflow_end.error"),warn=F), collapse = "<br/>")))\n'
res <- res + '\t\t\t\tfile.remove(paste0(paste0(input$results_dir,"/logs/workflow_end.error")))\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\tshinyjs::runjs(\n'
res <- res + '\t\t\t\t"var objDiv = document.getElementById(\'run_out\'); objDiv.scrollTop = objDiv.scrollHeight;"\n'
res <- res + '\t\t\t)\n'
res <- res + '\t\t}\n'
res <- res + '\t})\n'
res <- res + '\toutput$run_out <- renderUI({\n'
res <- res + '\t\tHTML(rv$textstream)\n'
res <- res + '\t})\n'
res <- res + '\n'
# function to disable inputs when the workflow the running
res <- res + 'toggle_inputs <- function(input_list,enable_inputs=T,only_buttons=FALSE)\n'
res <- res + '{\n'
res <- res + '\t# Subset if only_buttons is TRUE.\n'
res <- res + '\tif(only_buttons){\n'
res <- res + '\t\tbuttons <- which(sapply(input_list,function(x) {any(grepl("Button",attr(x,"class")))}))\n'
res <- res + '\t\tinput_list = input_list[buttons]\n'
res <- res + '\t}\n\n'
res <- res + '\t# Toggle elements\n'
res <- res + '\tfor(x in names(input_list))\n'
res <- res + '\t\tif(enable_inputs){\n'
res <- res + '\t\t\tshinyjs::enable(x)} else {\n'
res <- res + '\t\t\t\tshinyjs::disable(x) }\n'
res <- res + '}\n\n'
res <- res + '\t{\n'
res <- res + '\t\t# Subset if only_buttons is TRUE.\n'
res <- res + '\t\tif(only_buttons){\n'
res <- res + '\t\t\tbuttons <- which(sapply(input_list,function(x) {any(grepl("Button",attr(x,"class")))}))\n'
res <- res + '\t\t\tinput_list = input_list[buttons]\n'
res <- res + '\t\t}\n'
res <- res + '\n'
res <- res + '\t\t# Toggle elements\n'
res <- res + '\t\tfor(x in setdiff(names(input_list),"results_dir")){\n'
res <- res + '\t\t\tif(enable_inputs){\n'
res <- res + '\t\t\t\tshinyjs::enable(x)} else {\n'
res <- res + '\t\t\t\t\tshinyjs::disable(x) }\n'
res <- res + '\t\t}\n'
res <- res + '\t}\n'
# observe SeOrPe and hide or show SE or PE inputs
res <- res + '\tobserveEvent(input$SeOrPe,{\n'
res <- res + '\t\tinput_list <- reactiveValuesToList(input)\n'
res <- res + '\t\tSE <- which(sapply(names(input_list),function(x) {any(grepl("_SE$",x))}))\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