source("tools.R")
library(yaml)
path_yml <- "/home/mbb/Documents/waw/workflows/RADseq_ref/sag.yaml"
#path_tools <- "/home/mbb/Documents/waw/tools"
APP <<- yaml.load_file(path_yml)$App
generate_added_styles <- function () {
path_css = APP$project + "/www/added_styles.css"
file.replace(path_css)
}
#============================================================
generate_page_input <- function(res, cnt) {
if(cnt$type == "button") {
if(cnt$icon == "") {
res <- res + '\t\tactionButton("' + cnt$name + '", "'+ cnt$label +'", class="'+ cnt$class +'")'
} else {
res <- res + '\t\tactionButton("' + cnt$name + '", "'+ cnt$label +'", icon("'+ cnt$icon +'"), class="'+ cnt$class +'")'
}
}
if(cnt$type == "text") {
res <- res + '\t\ttextInput("'+ cnt$name +'", label = "'+ cnt$label +'", value = "'+ cnt$value +'", width = "'+ 'auto' +'")'
}
if(cnt$type == "numeric") {
res <- res + '\t\tnumericInput("'+ cnt$name +'", label = "'+ cnt$label +'", min = '+ cnt$min +', max = '+ cnt$max +', step = '+ cnt$step +', width = "'+ 'auto' +'", value = '+ cnt$value +')'
}
if(cnt$type == "slider") {
if(length(cnt$value) == 1) {
res <- res + '\t\tsliderInput("'+ cnt$name +'", label = "'+ cnt$label +'", min = '+ cnt$min +', max = '+ cnt$max +', step = '+ cnt$step +', width = "'+ 'auto' +'", value = '+ cnt$value +')'
} else {
res <- res + '\t\tsliderInput("'+ cnt$name +'", label = "'+ cnt$label +'", min = '+ cnt$min +', max = '+ cnt$max +', step = '+ cnt$step +', width = "'+ 'auto' +'", value = c('+ cnt$value[1] + ',' + cnt$value[2] + '))'
}
}
if(cnt$type == "help") {
res <- res + '\t\tp("'+cnt$label+'")'
}
if(cnt$type == "link") {
res <- res + '\t\tp("'+cnt$label+'",a(href="'+cnt$href+'","'+cnt$href+'"))'
}
if(cnt$type == "select") {
res <- res + '\t\tselectInput("'+ cnt$name +'", label = "'+ cnt$label +'", choices = list('
cpt = 1
if(length(cnt$choices) > 0) {
for(ch in cnt$choices){
if(cpt < length(cnt$choices)) {
res <- res + '"' + names(ch) + '" = "' + ch[names(ch)] + '", '
} else {
res <- res + '"' + names(ch) + '" = "' + ch[names(ch)] + '"), '
}
cpt = cpt + 1
}
}
res <- res + ' selected = "'+cnt$value+'"' + ', width = "'+ 'auto' +'")'
}
if(cnt$type == "radio") {
res <- res + '\t\tradioButtons("'+ cnt$name +'", label = "'+ cnt$label +'", choices = list('
cpt = 1
if(length(cnt$choices) > 0) {
for(ch in cnt$choices){
if(cpt < length(cnt$choices)) {
res <- res + '"' + names(ch) + '" = "' + ch[names(ch)] + '", '
} else {
res <- res + '"' + names(ch) + '" = "' + ch[names(ch)] + '"), '
}
cpt = cpt + 1
}
}
res <- res + ' selected = "'+cnt$value+'"' + ', width = "'+ 'auto' +'")'
}
if(cnt$type == "checkbox") {
res <- res + '\t\tcheckboxInput("'+ cnt$name +'", label = "'+ cnt$label +'", value = ' + cnt$value + ')'
}
if(cnt$type == "chooser") {
vl <- 'c('
vr <- 'c('
if(length(cnt$value_left) > 0) {
for(x in 1:length(cnt$value_left)) {
vl <- vl + '"' + cnt$value_left[[x]] + '"'
if(x < length(cnt$value_left)) {
vl <- vl + ', '
}
}
}
vl <- vl + ')'
if(length(cnt$value_right) > 0) {
vr <- "c("
for(x in 1:length(cnt$value_right)) {
vr <- vr + '"' + cnt$value_right[[x]] + '"'
if(x < length(cnt$value_right)) {
vr <- vr + ', '
}
}
}
vr <- vr + ')'
res <- res + '\t\tchooserInput("' + cnt$name + '", "Available", "Selected", ' + vl + ', ' + vr + ', size = ' + cnt$size + ', multiple = ' + cnt$multiple + ')'
}
if(cnt$type == "checkboxGroupInput") {
res <- res + '\t\tcheckboxGroupInput("'+ cnt$name +'",label = "'+ cnt$label +'", choices = list('
if(length(cnt$choices) > 0) {
for(ch in 1:length(cnt$choices)){
choices = cnt$choices[[ch]]
value = choices$value
if(is.character(choices$value)) {
value = '"' + choices$value + '"'
}
if(ch < length(cnt$choices)) {
res <- res + '"' + choices$label + '"' + ' = ' + value + ', '
} else {
res <- res + '"' + choices$label + '"' + ' = ' + value
}
}
}
res <- res + '), selected = "'+cnt$value+'"' + ', width = "'+ 'auto' +'")'
}
if(cnt$type == "file") {
res <- res + '\t\tfileInput("'+ cnt$name +'", label = "'+ cnt$label + '"'
if(length(cnt$accept) > 0) {
res <- res + ", accept = c("
for(a in 1:length(cnt$accept)){
form <- cnt$accept[[a]]
res <- res + '"' + form + '"'
if(a < length(cnt$accept)) {
res <- res + ', '
} else {
res <- res + ')'
}
}
}
res <- res + ', multiple = ' + cnt$multiple + ', width = "'+ 'auto' + '")'
}
return(res)
}
generate_page_box <- function(panel, box, res) {
res <- res + 'box(title = "' + box$title + '", width = 12, status = "' + box$status + '", collapsible = TRUE, solidHeader = TRUE'
panel_content = box$content
if(length(panel_content) > 0) {
res <- res + ',\n'
for(z in 1:length(panel_content)) {
res <- generate_page_input(res, panel_content[[z]])
if(z < length(panel_content)) {
res <- res + ','
}
res <- res + '\n\n'
}
}
res <- res + '\t)'
return(res)
}
#============================================================
generate_pages_server <- function() {
resG <- ""
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
resG <- resG + "\t# \tPage : " + name + "\n"
path_page = APP$project+"/pages/pages_def_"+tolower(name)+".R"
file.replace(path_page)
res <- 'tab'+ name + ' = fluidPage(\n\n'
res <- res + 'box(title = "Parameters :", width = 12, status = "primary", collapsible = TRUE, solidHeader = TRUE'
content <- APP$pages[[x]]
if(length(content) > 0) {
res <- res + ',\n\n'
boxes = content$boxes
if(length(boxes) > 0) {
if(length(boxes) > 1){
res <- res + '\tselectInput("select' + content$name + '", label = "Select the tool to use : ", selected = "' + content$default + '", choices = list('
for(b in 1:length(boxes)) { # construction list box tools
res <- res + '"' + boxes[[b]]$name +'" = "' + boxes[[b]]$name + '"'
if(b < length(boxes)) {
res <- res + ', '
}
}
res <- res + ')),\n'
}
else{
res <- res + '\thidden(textInput("select' + content$name + '", label = "", value="'+ boxes[[1]]$name +'")),'
}
for(b in 1:length(boxes)) { # draw boxes
box <- boxes[[b]]
if(length(boxes) > 1){
res <- res + "\nconditionalPanel(condition = \"input.select"+content$name+" == '"+box$name+"'\","
}
#if(box$defined == TRUE) {
# box <- get_predefined_box(box, APP$pages[[x]]$name)
#}
res <- generate_page_box(panel, box, res)
if(length(boxes) > 1){
res <- res + ")"
}
if(b < length(boxes)){
res <- res + ","
}
}
}
}
res <- res + '))\n\n'
write(res, file=path_page)
path_opt = APP$project+"/server/opt_"+tolower(name)+".R"
#file.replace(path_opt)
res <- ""
content <- APP$pages[[x]]
# if(length(content) > 0) {
# boxes = content$boxes
# if(length(boxes) > 0) {
# for(b in 1:length(boxes)) {
# box <- boxes[[b]]
# #if(box$defined == TRUE) {
# # box <- get_predefined_box(box, APP$pages[[x]]$name)
# #}
# panel_content = box$content
# if(length(panel_content) > 0) {
# for(z in 1:length(panel_content)) {
# cnt <- panel_content[[z]]
# type <- cnt$type
# id <- cnt$name
# if(type == "button") {
# res <- res + '#\' Event when use '+ id +' button\n'
# res <- res + 'observeEvent(input$'+id+', {\n\n'
# res <- res + '})\n\n'
# }
# }
# }
# }
# }
# }
run <- APP$run
if(length(run$options) > 0) {
# res <- res + '#\' Event when use '+ run$shiny_button$name +' button\n'
# res <- res + 'observeEvent(input$'+ run$shiny_button$name+', {\n\n'
# page_path <- APP$project + '/params/' + 'params_' + APP$pages[[x]]$name + '.yml'
# file.replace(page_path)
# res <- res + '# Params \n'
# res <- res + '\tpath_param <- "' + page_path + '"\n\n'
# res <- res + '\tres <- ""\n'
# res <- res + '\n\t# Page : ' + APP$pages[[x]]$name+ '\n'
boxes = APP$pages[[x]]$boxes
if(length(boxes) > 0) {
resG <- resG + '\t\tres = paste0(res , paste("'+APP$pages[[x]]$name + ':", paste0(\'\"\', input$select' + APP$pages[[x]]$name + ', \'\"\'), "\\n", sep = " "))\n'
for(b in 1:length(boxes)) { # list boxes
box <- boxes[[b]]
# res <- res + '\n\t# Tool : ' + box$name+ '\n'
# if (length(boxes) > 1){
# verif = "input$select" + APP$pages[[x]]$name + ' == "' + box$name + '"'
# }
# else{
# verif = "TRUE"
# }
# res <- res + '\n\tif('+verif+') {\n'
panel_content = box$content
if(length(panel_content) > 0) {
for(z in 1:length(panel_content)) {
cnt <- panel_content[[z]]
type <- cnt$type
id <- cnt$name
genR <- ""
if(type == 'text') {
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') {
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(length(cnt$value) == 1) {
genR <- genR + '\t\tres = paste0(res, paste("' + id + ':", input$' + id + ', "\\n", sep = " "))'
genR <- genR + '\t\n\n'
} else {
genR <- genR + '\t\tres = paste0(res, paste("' + id + '_min:", input$' + id + '[1], "\\n", sep = " "))\n'
genR <- genR + '\t\tres = paste0(res, paste("' + id + '_max:", input$' + id + '[2], "\\n", sep = " "))\n'
genR <- genR + '\t\tres = paste0(res, paste("' + id + '_step:", "' + cnt$step + '", "\\n", sep = " "))\n'
genR <- genR + '\t\n\n'
}
} else 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") {
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") {
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") {
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'
genR <- genR + '\t\t\tres <- paste0(res, \'"\', input$'+ id +'$left[[x]], \'"\')\n'
genR <- genR + '\t\t\tif(x < length(input$'+ id +'$left)) {\n'
genR <- genR + '\t\t\t\tres <- paste0(res, ", ")\n'
genR <- genR + '\t\t\t}\n'
genR <- genR + '\t\t}\n'
genR <- genR + '\t\t} \n'
genR <- genR + '\t\tres <- paste0(res, "]", "\\n")\n\n'
genR <- genR + '\t\tres <- paste0(res, " ' + id + '" + "_right: [")\n'
genR <- genR + '\t\tif(length(input$'+ id +'$right) > 0) {\n'
genR <- genR + '\t\tfor(x in 1:length(input$'+ id +'$right)) {\n'
genR <- genR + '\t\t\tres <- paste0(res, \'"\', input$'+ id +'$right[[x]], \'"\')\n'
genR <- genR + '\t\t\tif(x < length(input$'+ id +'$right)) {\n'
genR <- genR + '\t\t\t\tres <- paste0(res, ", ")\n'
genR <- genR + '\t\t\t}\n'
genR <- genR + '\t\t}\n'
genR <- genR + '\t\t} \n'
genR <- genR + '\t\tres <- paste0(res, "]", "\\n")\n\n'
} else 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'
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 {
#TODO
}
# res <- res + genR
resG <- resG + genR
}
}
# res <- res + '\t}\n'
# res <- res + '\n'
}
}
# res <- res + '\twrite(res, file=path_param)'
# res <- res + '\n\n'
# res <- res + '})\n\n'
}
#write(res, file=path_opt)
}
save_params <- "save_params <- function(path_param){\n"
save_params <- save_params + '\tres = ""'
save_params <- save_params + resG
save_params <- save_params + '\t\tres = paste0(res, paste("final_step:", paste0(\'\"\', input$final_step, \'\"\'), "\\n", sep = " "))\n\n'
save_params <- save_params + '\ta = yaml.load_file("/workflow/params.total.yml")\n'
save_params <- save_params + '\tb = yaml.load(res)\n'
save_params <- save_params + '\tanotb = subset(names(a), !(names(a)%in%names(b)))\n'
save_params <- save_params + '\tc = c(a[anotb],b)\n'
save_params <- save_params + '\tlogical = function(x) {\n'
save_params <- save_params + '\t\tresult <- ifelse(x, "True", "False")\n'
save_params <- save_params + '\t\tclass(result) <- "verbatim"\n'
save_params <- save_params + '\t\treturn(result)\n'
save_params <- save_params + '\t}\n'
save_params <- save_params + '\tsamples = yaml.load(system(paste0("python3 /workflow/get_samples.py ",input$sample_dir," /samples/groups.csv"),intern = T))\n'
save_params <- save_params + '\tc$samples = names(samples)\n'
save_params <- save_params + '\tnames(samples) = NULL\n'
save_params <- save_params + '\tc$groups = unlist(samples)\n'
save_params <- save_params + '\twrite_yaml(c,path_param,handlers=list(logical = logical))\n'
save_params <- save_params + '\t}\n\n'
res <- save_params
# Compare parameters (give rules that need to be re-runned)
res <- res + 'compare_params = function(dossierAnalyse){\n'
res <- res + '\tif (!file.exists(paste0(dossierAnalyse,"/lastrun/params.yml"))){\n'
res <- res + '\t\treturn(c())\n'
res <- res + '\t}\n'
res <- res + '\telse{\n'
res <- res + '\t\tnew_params = yaml.load_file(paste0(dossierAnalyse,"/params.yml"))\n'
res <- res + '\t\told_params = yaml.load_file(paste0(dossierAnalyse,"/workflow/params.yml"))\n'
res <- res + '\t\tchanged = new_params[!(new_params %in% old_params)]\n'
res <- res + '\t\trules = c()\n'
res <- res + '\t\tif (length(changed)>=1){\n'
res <- res + '\t\t\tfor (param in names(changed)){\n'
res <- res + '\t\t\t\tif (!grepl("_threads$",param)){\n'
res <- res + '\t\t\t\t\trules = c(rules, new_params$params_info[[param]]$rule)\n'
res <- res + '\t\t\t\t}\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t}\n'
res <- res + '\t\treturn(unique(rules))\n'
res <- res + '\t}\n'
res <- res + '}\n'
file.replace(APP$project+"/server/opt_global.R")
#res <- ""
# Event RULEGRAPH
if ("RULEGRAPH" %in% names(APP)){
res <- res + '#\' Event when use RULEGRAPH button\n'
res <- res + 'observeEvent({c(input$sidebarmenu,input$refresh_rg)}, {\n\n'
res <- res + '\tif(input$sidebarmenu=="RULEGRAPH"){\n'
res <- res + '\t\tinput_list <- reactiveValuesToList(input)\n'
res <- res + '\t\ttoggle_inputs(input_list,F,F)\n'
res <- res + '\t\tpath_param <- paste0(input$results_dir,"/params.yml")\n\n'
res <- res + '\t\tsave_params(path_param)\n'
res <- res + '\t\ti = sample.int(1000,size = 1)\n\n'
res <- res + '\t\tsystem(paste0("rm ",input$results_dir,"/rulegraph*"))\n\n'
res <- res + '\t\toutUI = tryCatch({\n'
res <- res + '\t\t\tsystem(paste0("snakemake -s /workflow/Snakefile --configfile ",input$results_dir,"/params.yml -d ",input$results_dir," all --rulegraph > ",input$results_dir,"/rulegraph",i,".dot"),intern=T)\n'
res <- res + '\t\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\t\ttagList(img(src = paste0("results/rulegraph",i,".svg") ,alt = "Rulegraph of Snakemake jobs",style="max-width: 100%;height: auto;display: block;margin: auto"))},\n'
res <- res + '\t\terror = function(e){\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 : ",e$message)))},\n'
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\taddResourcePath("results", input$results_dir)\n'
res <- res + '\t\toutput$RULEGRAPH_svg = renderUI(outUI)\n'
res <- res + '\t\ttoggle_inputs(input_list,T,F)\n'
res <- res + '}})\n'
}
# Event Run
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'
res <- res + '\tupdateTabsetPanel(session, "sidebarmenu", selected = "run_out")\n'
#panel_path <- APP$project + '/params/' + 'params_' + APP$pages[[x]]$name + '.yml'
res <- res + '\tpath_param <- paste0(input$results_dir,"/params.yml")\n\n'
res <- res + '\t\tsave_params(path_param)\n'
res <- res + '\n\n'
res <- res + '\toutUI = tryCatch({\n'
res <- res + '\t\tif (!dir.exists(paste0(input$results_dir,"/logs"))){\n'
res <- res + '\t\t\tdir.create(paste0(input$results_dir,"/logs"))\n'
res <- res + '\t\t}\n'
res <- res + '\t\tif (!file.exists(paste0(input$results_dir,"/logs/runlog.txt"))){\n'
res <- res + '\t\t\tfile.create(paste0(input$results_dir,"/logs/runlog.txt"))\n'
res <- res + '\t\t}\n'
res <- res + '\t\tforcerun = compare_params(input$results_dir)\n'
res <- res + '\t\tif (length(forcerun>1)){\n'
res <- res + '\t\t\trules = paste(forcerun, collapse=" ")\n'
res <- res + '\t\t\tforcerun = paste(" --forcerun ",rules)\n'
res <- res + '\t\t\tshowModal(modalDialog(\n'
res <- res + '\t\t\t\ttitle = "Params have changed since the last run",\n'
res <- res + '\t\t\t\tforcerun\n'
res <- res + '\t\t\t))\n'
res <- res + '\t\t}\n'
res <- res + '\t\telse{\n'
res <- res + '\t\t\tforcerun = ""\n'
res <- res + '\t\t}\n'
res <- res + '\t\tsystem(paste0("touch ",input$results_dir,"/logs/workflow.running"),wait = T)\n'
res <- res + '\t\tsystem2("python3",paste0("-u -m snakemake -s /workflow/Snakefile --configfile ", paste0(input$results_dir,"/params.yml") ,\t" -d ", input$results_dir ,\t" --cores ", input$cores, " all ", forcerun),wait = FALSE, stdout = paste0(input$results_dir,"/logs/runlog.txt"), stderr = paste0(input$results_dir,"/logs/runlog.txt"))\n'
res <- res + '\t\ttags$iframe(src="results/multiqc_report.html",width="100%", height="900px")},\n'
res <- res + '\t\terror = function(e){\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 : ",e$message)))},\n'
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})'
write(res, APP$project+"/server/opt_global.R")
}
#============================================================
generate_menu <- function() {
path_file = APP$project + "/R/menugauche.R"
file.replace(path_file)
res <- ""
res <- res + 'MenuGauche = sidebarMenu(id="sidebarmenu",\n\n'
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
icon <- APP$pages[[x]]$icon
menu <- APP$pages[[x]]$label
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 + '\tmenuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n\n'
}
res <- res + '\ttags$br(),\n\n'
res <- res + '\tnumericInput("cores", label = "Threads available", min = 1, max = NA, step = 1, width = "auto", value = 4),\n'
# select step to reach
choices = "list("
for(step in APP$pages[2:length(APP$pages)]){ # all steps but remove global_params page
choices <- choices + "'" + step$label + "'='" + step$name + "',"
}
res <- res + 'selectInput("final_step", label = "Select the step to reach : ", selected = "all", choices = '+choices+'"All"="all")),'
#
res <- res + '\ttags$br(),\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 + '\tactionButton("StopPipeline", "Stop pipeline", icon("stop"), class="btn btn-secondary"),\n'
res <- res + '\ttags$br(),\n'
res <- res + '\ttags$br(),\n'
res <- res + '\tmenuItem("Running Workflow output", tabName="run_out", icon=icon("terminal", lib="font-awesome"), newtab=FALSE),\n'
if("Report" %in% names(APP)){
name <- "Report"
icon <- "file"
menu <- "Final report"
res <- res + '\tmenuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n\n'
}
res <- res + '\ttags$br(),\n'
res <- res + '\tactionButton("close_session", "Close session", icon("times"), class="btn btn-primary"),\n'
if("download" %in% names(APP)){
res <- res + '\ttags$br(),\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 + '\ttags$br(),tags$br(),\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'
write(res, file = path_file)
}
#============================================================
dir.create.not.exist <- function(path) {
if(!dir.exists(path)) {
dir.create(path)
}
}
#============================================================
generate_rproj <- function(path) {
file.replace(path)
res <- ""
res <- res + "Version: 1.0\n"
res <- res + " \n"
res <- res + "RestoreWorkspace: Default\n"
res <- res + "SaveWorkspace: Default\n"
res <- res + "AlwaysSaveHistory: Default\n"
res <- res + " \n"
res <- res + "EnableCodeIndexing: Yes\n"
res <- res + "UseSpacesForTab: Yes\n"
res <- res + "NumSpacesForTab: 2\n"
res <- res + "Encoding: UTF-8\n"
res <- res + " \n"
res <- res + "RnwWeave: Sweave\n"
res <- res + "LaTeX: pdfLaTeX\n"
res <- res + " \n"
write(res, path)
}
#============================================================
generate <- function() {
print("Generate Start")
#YML_TOOLS <<- get_predefined_tool(files_tools)
if(dir.exists(APP$project)) {
#unlink(APP$project, recursive=TRUE)
}
dir.create.not.exist(APP$project)
generate_app()
dir.create.not.exist(APP$project + "/R")
generate_menu()
dir.create.not.exist(APP$project + "/pages")
dir.create.not.exist(APP$project + "/server")
#dir.create.not.exist(APP$project + "/params")
generate_pages_server()
dir.create.not.exist(APP$project + "/www")
path_rproj = APP$project + "/" + basename(APP$project) + ".Rproj"
generate_rproj(path_rproj)
generate_added_styles()
file.copy("./tools/chooser.R", APP$project + "/R/")
file.copy("./tools/chooser-binding.js", APP$project + "/www/")
print("Generate End")
}
#============================================================
file.replace <- function(path) {
if(file.exists(path)) {
file.remove(path)
}
file.create(path)
}
#============================================================
generate_app <- function() {
path_project = APP$project + "/app.R"
main = APP$general
file.replace(path_project)
res <- "#@author jimmy.lopez@univ-montp2.fr\n\n\n\n"
res <- res + 'library(shiny)\n'
res <- res + 'library(shinydashboard)\n'
res <- res + 'library(shinyjs)\n'
res <- res + 'library(yaml)\n'
res <- res + 'library(stringr)\n'
res <- res + 'library(shinyFiles)\n'
res <- res + 'library(tools)\n'
res <- res + 'library(knitr)\n'
res <- res + 'library(DT)\n'
res <- res + '\n\n'
res <- res + 'source("./R/chooser.R", local=T)\n\n'
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
res <- res + 'source("./pages/pages_def_'+tolower(name)+'.R", local=T)\n'
}
if("RULEGRAPH" %in% names(APP)){
res <- res + "tabRULEGRAPH = fluidPage(box(title = 'Rule Graph :', width = 12, status = 'primary', collapsible = TRUE, solidHeader = TRUE, uiOutput('RULEGRAPH_svg'),actionButton('refresh_rg', 'Refresh', icon('sync'), class='btn btn-info')))\n"
}
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'
res <- res + '\n\n'
res <- res + 'style <- tags$style(HTML(readLines("www/added_styles.css")))\n\n'
res <- res + 'UI <- dashboardPage(\n\n'
res <- res + ' skin="' + main$skin + '",\n\n'
res <- res + ' dashboardHeader(title="'+ main$title + '", titleWidth='+main$menu_width+'),\n\n'
res <- res + ' dashboardSidebar(width='+main$menu_width+', MenuGauche),\n\n'
res <- res + ' dashboardBody(\n\n'
res <- res + ' shinyjs::useShinyjs(),\n\n'
res <- res + ' tags$head(tags$link(rel="stylesheet", type="text/css", href="bootstrap.min.readable.css")),\n\n'
#tags$head(tags$script(src="message-handler.js")),
res <- res + 'tags$head(style),\n\n'
res <- res + '\ttabItems(\n\n'
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
res <- res + '\ttabItem(tabName = "' + name + '", tab'+ name +')'
if(x < length(APP$pages)) {
res <- res + ",\n\n"
} else {
res <- res + "\n\n"
}
}
if("RULEGRAPH" %in% names(APP)){
res <- res + '\t,tabItem(tabName = "RULEGRAPH", tabRULEGRAPH)\n'
}
if("Report" %in% names(APP)){
res <- res + '\t,tabItem(tabName = "Report", tabReport)\n'
}
res <- res + '\t,tabItem(tabName = "run_out", tabRUN)\n'
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_info)){\n'
res <- res + '\t\t\tif (params$params_info[[param]]$type == "text"){\n'
res <- res + '\t\t\t\tupdateTextInput(session, param, value = params[[param]])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\tif (params$params_info[[param]]$type == "numeric"){\n'
res <- res + '\t\t\t\tupdateNumericInput(session, param, value = params[[param]])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\tif (params$params_info[[param]]$type == "radio"){\n'
res <- res + '\t\t\t\tupdateRadioButtons(session, param, selected = params[[param]])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\tif (params$params_info[[param]]$type == "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\tfor (step in params$steps){\n'
res <- res + '\t\t\tupdateSelectInput(session, paste0("select",step$name), selected = params[[step$name]])\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",style="max-width: 100%;height: auto;display: block;margin: auto")))\n'
res <- res + '\t}\n'
res <- res + '\telse{\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}\n'
res <- res + '\t# if report show it\n'
res <- res + '\tif (file.exists(paste0(dossierAnalyse,"/multiqc_report.html"))){\n'
res <- res + '\t\taddResourcePath("results", dossierAnalyse)\n'
res <- res + '\t\toutput$report_html = renderUI(tags$iframe(src=paste0("results/multiqc_report.html"),width="100%", height="900px"))\n'
res <- res + '\t}\n'
res <- res + '\telse{\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}\n'
res <- res + '}\n'
res <- res + '\n\n'
res <- res + 'server <- function( input, output, session) {\n\n'
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 + '\t\t\tshinyjs::disable("results_dir")\n'
res <- res + '\t\t\tif (file.exists(paste0(dossierAnalyse,"/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'
# Observe if the workflow is running
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(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 = "
")\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(input$results_dir,"/logs/workflow_end.ok"))){\n'
res <- res + '\t\t\t\tisolate({rv$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/multiqc_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(input$results_dir,"/logs/workflow_end.ok"))\n'
res <- res + '\t\t\t\tfile.remove(paste0(input$results_dir,"/logs/workflow.running"))\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t\telse if (file.exists(paste0(input$results_dir,"/logs/workflow_end.error"))){\n'
res <- res + '\t\t\t\tisolate({rv$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 = "
")))\n'
res <- res + '\t\t\t\tfile.remove(paste0(input$results_dir,"/logs/workflow_end.error"))\n'
res <- res + '\t\t\t\tfile.remove(paste0(input$results_dir,"/logs/workflow.running"))\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 + '\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 + '\tshinyjs::enable("StopPipeline")\n'
res <- res + '\tshinyjs::enable("close_session")\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'
res <- res + '\t\tPE <- which(sapply(names(input_list),function(x) {any(grepl("_PE$",x))}))\n'
res <- res + '\t\tfor (element in SE){\n'
res <- res + '\t\t\tif (input$SeOrPe == "PE")\n'
res <- res + '\t\t\t\tshinyjs::hide(names(input_list)[element])\n'
res <- res + '\t\t\telse{\n'
res <- res + '\t\t\t\tshinyjs::show(names(input_list)[element])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t}\n'
res <- res + '\t\tfor (element in PE){\n'
res <- res + '\t\tif (input$SeOrPe == "SE")\n'
res <- res + '\t\t\t\tshinyjs::hide(names(input_list)[element])\n'
res <- res + '\t\t\telse{\n'
res <- res + '\t\t\t\tshinyjs::show(names(input_list)[element])\n'
res <- res + '\t\t\t}\n'
res <- res + '\t\t}\n'
res <- res + '\t})\n'
res <- res + 'observeEvent(input$StopPipeline,{\n'
res <- res + '\t\tsystem("pkill -f snakemake")\n'
res <- res + '\t\tif (file.exists(paste0(input$results_dir,"/logs/workflow.running"))){\n'
res <- res + '\t\t\tfile.remove(paste0(input$results_dir,"/logs/workflow.running"))\n'
res <- res + '\t\t}\n'
res <- res + '\t})\n'
res <- res + 'observeEvent(input$close_session,{\n'
res <- res + '\t\tsession$close();\n'
res <- res + '\t})\n'
res <- res + 'source("./server/opt_global.R", local=T)\n'
#for(x in 1:length(APP$pages)) {
# name <- APP$pages[[x]]$name
# res <- res + 'source("./server/opt_'+tolower(name)+'.R", local=T)\n'
#}
res <- res + '\n\n'
res <- res + '}\n\n'
res <- res + '\n\n'
res <- res + 'shinyApp(ui = UI, server = server)'
write(res, path_project)
}
#============================================================
generate()