From 5a44d34bd12eb2777252579a9e003bdec4442423 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <kontrapunkt@uclmail.net>
Date: Thu, 16 Feb 2023 16:49:10 +0100
Subject: [PATCH] api, app: Make paths more flexible.
---
R/api.R | 126 ++++++++++++++++++++++++++++++++++++++++++++--------
R/envopts.R | 26 ++++++++---
R/errors.R | 14 ++++++
R/state.R | 24 +++++-----
4 files changed, 152 insertions(+), 38 deletions(-)
diff --git a/R/api.R b/R/api.R
index 5b4c063..dd9b24a 100644
--- a/R/api.R
+++ b/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)
}
diff --git a/R/envopts.R b/R/envopts.R
index 8d58fd8..cfccd2e 100644
--- a/R/envopts.R
+++ b/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")
diff --git a/R/errors.R b/R/errors.R
index 18db2d8..32e69d9 100644
--- a/R/errors.R
+++ b/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')))
}
diff --git a/R/state.R b/R/state.R
index 7ffa75d..466f597 100644
--- a/R/state.R
+++ b/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) {
--
GitLab