api, app: Make paths more flexible.

R/api.R

@@ -13,10 +13,22 @@
 ## limitations under the License.
 
 ##' @export
-run <- function(project="",m=NULL,phases=NULL,help=F) {
+##' @param project `character(1)`, a directory containing input data.
+##' @param top_data_dir `character(1)`, a directory contining data
+##'     subdirs.
+##' @param metfrag_db_dir `character(1)`, a directory containing
+##'     MetFrag DBs.
+##' @param m `state`, a Shinyscreen state.
+##' @param phases `character(n)`, a character vector of Shinyscreen
+##'     phases.
+##' @param help `logical(1)`, print help?
+run <- function(project="",
+                top_data_dir="",
+                metfrag_db_dir="",
+                m=NULL,
+                phases=NULL,
+                help=F) {
 
-    ## Get system-wide config.
-    eo = load_envopts()
                         
     
     all_phases=list(setup=setup_phase,
@@ -40,7 +52,14 @@ run <- function(project="",m=NULL,phases=NULL,help=F) {
                                                           stop("Aborting.")
                                                       }
                                                       all_phases[phases]
+
                                                   }
+
+    eo = prepare_paths(project=project,
+                       projects="",
+                       top_data_dir=top_data_dir,
+                       metfrag_db_dir=metfrag_db_dir)
+    
     
     m <- if (nchar(project)!=0) new_project(project,envopts=eo) else if (!is.null(m)) m else stop("(run): Either the YAML config file (project),\n or the starting state (m) must be provided\n as the argument to the run function.")
     ## m$conf$project <- norm_path(m$conf$project) #FIXME: Test in all workflows!
@@ -678,16 +697,74 @@ create_plots <- function(m) {
     m
 }
 
+
+prepare_paths <- function(project,
+                          projects,
+                          top_data_dir,
+                          metfrag_db_dir) {
+
+    ## Get system-wide config.
+    eo = load_envopts()
+
+    ## Figure out how to run.
+
+
+    if (nchar(top_data_dir)>0) {
+        ## Specified `top_data_dir` overrides everything.
+        eo$top_data_dir = norm_path(top_data_dir)
+    } else {
+        ## If no user supplied `top_data_dir`, check if envopts
+        ## top_data_dir is empty.
+        if (nchar(eo$top_data_dir)==0L) {
+            ## If yes, the last attempt is to designate
+            ## `project` dir as `top_data_dir` directory. 
+            if (dir.exists(project)) eo$top_data_dir=norm_path(project)
+        }
+
+    }
+
+
+    ## In case  `project` is a not a zero-length string.
+    if (nchar(project)!=0) {
+        ## The variable `projects` is alwas a super-directory of
+        ## `project`.
+        withr::with_dir(project,{
+            eo$projects=norm_path("..")
+        })
+    } else {
+        if (nchar(projects)!=0) {
+            eo$projects=projects
+        }
+    }
+    
+
+    ## Override the default `db_dir` if `metfrag_db_dir` supplied.
+    if (nchar(metfrag_db_dir)>0) {
+        eo$metfrag$db_dir = norm_path(metfrag_db_dir)
+    } else {
+        ## If no default `db_dir`, try with `project`.
+        if (nchar(eo$metfrag$db_dir)==0L) {
+            eo$metfrag$db_dir = norm_path(project)
+        }
+    }
+    eo
+}
+
 prepare_app <- function(dir_before,
                         projects,
-                        top_data_dir) {
+                        top_data_dir,
+                        metfrag_db_dir) {
 
     ## Information that needs to be availabe to the shiny server.
     init <- list()
     init$dir_before <- dir_before
-    init$top_data_dir <- norm_path(top_data_dir)
-    init$projects <- norm_path(projects)
-    init$envopts = load_envopts()
+    init$envopts = prepare_paths(project="",
+                                 projects=projects,
+                                 top_data_dir=top_data_dir,
+                                 metfrag_db_dir=metfrag_db_dir)
+    init$top_data_dir <- init$envopts$top_data_dir
+    init$projects <- init$envopts$projects
+    
 
     check_dir_absent(init$top_data_dir,what="top-data-dir")
     check_dir_absent(init$projects,what="projects")
@@ -717,18 +794,19 @@ prepare_app <- function(dir_before,
 #'     containing project directories.
 #' @param top_data_dir `character(1)`, a location on the server side
 #'     containing data directories.
+#' @param metfrag_db_dir `character(1)`, a location on the server side
+#'     containing MetFrag databases.
 #' @param shiny_args `list`, optional list of arguments conveyed to
 #'     `rmarkdown::run` `shiny_args` argument.
 #' @param render_args `list`, optional list of arguments conveyed to
 #'     `rmarkdown::run` `render_args` argument.
-#' @param metfrag_db_dir `character(1)`, a location on the server side
-#'     containing MetFrag databases.
 #' @param metfrag_runtime `character(1)`, a location on the server side
 #'     of the MetFrag jar file.
 #' @return Nada.
 #' @author Todor Kondić
-app <- function(projects=getwd(),
-                top_data_dir=getwd(),
+app <- function(projects="",
+                top_data_dir="",
+                metfrag_db_dir="",
                 shiny_args=list(launch.browser=F),
                 render_args=NULL) {
     dir_before = getwd()
@@ -737,7 +815,8 @@ app <- function(projects=getwd(),
     message("projects: ", projects)
     dir_start = prepare_app(dir_before=dir_before,
                             projects=projects,
-                            top_data_dir=top_data_dir)
+                            top_data_dir=top_data_dir,
+                            metfrag_db_dir=metfrag_db_dir)
 
     on.exit(expr=setwd(dir_before))
     setwd(dir_start)
@@ -749,6 +828,8 @@ app <- function(projects=getwd(),
 #' @title serve
 #' @param top_data_dir `character(1)`, a location on the server side
 #'     containing data directories.
+#' @param metfrag_db_dir `character(1)`, a location on the server side
+#'     containing MetFrag DBs.
 #' @param usersdir `character(1)`, a location on the server side
 #'     containing individual user directories.
 #' @param user `character(1)`, subdir of usersdir.
@@ -758,7 +839,7 @@ app <- function(projects=getwd(),
 #'     served.
 #' @return Nada.
 #' @author Todor Kondić
-serve <- function(top_data_dir,usersdir,user,host='0.0.0.0',port=7777) {
+serve <- function(top_data_dir,metfrag_db_dir,usersdir,user,host='0.0.0.0',port=7777) {
     shiny_args <- c(list(launch.browser=F),list(host=host,port=port))
     projects <- file.path(usersdir,user)
     if (!dir.exists(projects)) {
@@ -767,7 +848,10 @@ serve <- function(top_data_dir,usersdir,user,host='0.0.0.0',port=7777) {
     } else {
         message('Using existing projects: ', projects)
     }
-    app(shiny_args=shiny_args,top_data_dir=top_data_dir,projects=projects)
+    app(shiny_args=shiny_args,
+        top_data_dir=top_data_dir,
+        projects=projects,
+        metfrag_db_dir=metfrag_db_dir)
 }
 
 
@@ -862,14 +946,18 @@ report <- function(m) {
 #' @inheritParams envopts
 #' @return Nothing.
 #' @author Todor Kondić
-init <- function(metfrag_db_dir="",
+init <- function(projects="",
+                 top_data_dir="",
+                 metfrag_db_dir="",
                  metfrag_jar="",
                  java_bin=Sys.which("java"),
                  metfrag_max_proc=parallel::detectCores()) {
-    e = envopts(metfrag_db_dir=metfrag_db_dir,
-                metfrag_jar=metfrag_jar,
-                java_bin=java_bin,
-                metfrag_max_proc=metfrag_max_proc)
+    e = envopts(projects = projects,
+                top_data_dir = top_data_dir,
+                metfrag_db_dir = metfrag_db_dir,
+                metfrag_jar = metfrag_jar,
+                java_bin = java_bin,
+                metfrag_max_proc = metfrag_max_proc)
     save_envopts(o=e)
 }
 

R/envopts.R

@@ -23,26 +23,42 @@
 
 
 #' @title Create a `envopts` Object
-#' @details A `envopts` object is Shinyscreen way to store settings
+#' @details An `envopts` object is Shinyscreen way to store settings
 #'     related to a specific computing environment. Information such
 #'     as the run time path to a MetFrag JAR will vary from one to
 #'     another setup and we need to convey this to the `shinyscreen`
 #'     pipeline.
-#' @param metfrag_db_dir `character(1)`, a path to the directory which contains MetFrag databases
-#' @param metfrag_jar  `character(1)`, a path to MetFrag JAR file
+#' @param projects `character(1)`, a directory which contains all
+#'     shinyscreen projects directories. A single project directory
+#'     contains input and output files.
+#' @param top_data_dir `character(1)`, a directory which contains all
+#'     `data` directories. A single `data` directory contains `mzML`
+#'     spectrometry data files.
+#' @param metfrag_db_dir `character(1)`, a path to the directory which
+#'     contains MetFrag databases.
+#' @param metfrag_jar `character(1)`, a path to MetFrag JAR file.
+#' @param java_bin `character(1)`, a path to jave runtime
+#'     (optional). We try to detect this.
 #' @param metfrag_max_proc `integer(1)`, maximum number of CPU cores
 #'     available for MetFrag.
 #' @return An `envopts` object.
 #' @author Todor Kondić
-envopts <- function(metfrag_db_dir="",
+envopts <- function(projects="",
+                    top_data_dir="",
+                    metfrag_db_dir="",
                     metfrag_jar="",
                     java_bin=Sys.which("java"),
                     metfrag_max_proc = parallel::detectCores()) {
     res = list(metfrag=list())
+    
     class(res) = c("envopts","list") #Just to officially make it an
                                      #object.
 
-    check_dir_absent(metfrag_db_dir,what="mf-db-dir")
+    check_dir_absent_nz(projects,what="projects-dir")
+    res$projects = projects
+    check_dir_absent_nz(top_data_dir,what="top-data-dir")
+    res$top_data_dir=top_data_dir
+    check_dir_absent_nz(metfrag_db_dir,what="mf-db-dir")
     res$metfrag$db_dir = norm_path(metfrag_db_dir)
 
     check_file_absent(metfrag_jar,what="mf-jar")

R/errors.R

@@ -23,11 +23,25 @@ check_dir_absent <- function(dir,what) {
     if (nchar(dir)>0L && !dir.exists(dir)) stop(errorCondition(paste0("The ", what, " directory --- ", dir, "--- does not exist, or cannot be found."), class=paste0(what,'-absent')))
 }
 
+check_dir_absent_nz <- function(dir,what) {
+    check_notastring(dir,what)
+    if (nchar(dir)>0L) {
+        check_dir_absent(dir,what)
+    }
+}
+
 check_file_absent <- function(file,what) {
     check_notastring(file,what)
     if (nchar(file)>0L && !file.exists(file)) stop(errorCondition(paste0("The ", what, " file --- ", file, "--- does not exist, or cannot be found."), class=paste0(what,'-absent')))
 }
 
+check_file_absent_nz <- function(file,what) {
+    check_notastring(file,what)
+    if (nchar(file)>0L) {
+        check_file_absent(file,what)
+    }
+}
+
 check_not_one <- function(value,what) {
     if (length(value)!=1L) stop(errorCondition(paste0("Size of", what, " is not one."), class=paste0(what,'-not-one')))
 }

R/state.R

@@ -174,11 +174,7 @@ new_runtime_state <- function(project,envopts,conf=NULL) {
     run$metfrag = .metfrag(project_path)
 
     
-    run$paths$data = if (is.null(conf$paths$data)) {
-        project_path
-    } else {
-        norm_path(conf$paths$data)
-    }
+    run$paths$data = norm_path(file.path(envopts$top_data_dir,conf$paths$data))
     
     check_dir_absent(run$paths$data,"data-dir")
 
@@ -248,18 +244,18 @@ import_project <- function(project,envopts=envopts) {
 ##' @export
 new_rv_state <- function() react_v(m=list2rev(new_state()))
 
-write_conf <- function(m,fn) {
-    m$conf$paths$data <- get_fn_ftab(m)
-    if (NROW(m$input$tab$mzml)>0) tab2file(tab=m$input$tab$mzml,file=file.path(m$run$paths$project,FN_DATA_TAB))
-    yaml::write_yaml(x=m$conf,file=fn)
+## write_conf <- function(m,fn) {
+##     m$conf$paths$data <- get_fn_ftab(m)
+##     if (NROW(m$input$tab$mzml)>0) tab2file(tab=m$input$tab$mzml,file=file.path(m$run$paths$project,FN_DATA_TAB))
+##     yaml::write_yaml(x=m$conf,file=fn)
     
     
     
-}
-write_state <- function(m,fn_conf) {
-    write_conf(m,fn_conf)
-    tab2file(tab=m$input$tab$mzml,file=file.path(m$run$paths$project,FN_DATA_TAB))
-}
+## }
+## write_state <- function(m,fn_conf) {
+##     write_conf(m,fn_conf)
+##     tab2file(tab=m$input$tab$mzml,file=file.path(m$run$paths$project,FN_DATA_TAB))
+## }
 
 label_cmpd_lists <- function (lists) {
     if (length(lists)>0) {