From fe02331d43585e3042c1f9d4f9427f758e3ad488 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <kontrapunkt@uclmail.net>
Date: Sat, 18 Feb 2023 11:48:00 +0100
Subject: [PATCH] api, envopts: Update configuration handling.
Also, adapt code affected by this elsewhere.
---
R/api.R | 84 +++++++++++------
R/envopts.R | 122 +++++++++++++++----------
R/errors.R | 3 +-
R/shiny-ui-base.R | 6 +-
inst/rmd/app.Rmd | 4 +-
tests/testthat/_snaps/api.md | 87 ++++++++++++++++++
tests/testthat/helper.R | 27 +++++-
tests/testthat/test-api.R | 169 ++++++++++++++++++++++++++++++-----
tests/testthat/test-state.R | 8 --
9 files changed, 394 insertions(+), 116 deletions(-)
create mode 100644 tests/testthat/_snaps/api.md
diff --git a/R/api.R b/R/api.R
index 577ec70..2ac2679 100644
--- a/R/api.R
+++ b/R/api.R
@@ -746,7 +746,7 @@ app <- function(envopts,
dir_before = getwd()
message("dir_before: ", dir_before)
message("top_data_dir: ", envopts$top_data_dir)
- message("projects: ", evnopts$projects)
+ message("projects: ", envopts$projects)
dir_start = prepare_app(dir_before=dir_before,
envopts=envopts)
@@ -882,52 +882,78 @@ report <- function(m) {
#' configuration.
#' @param save `logical(1)`, optional. If T, save configuration,
#' otherwise just return the Shinyscreen environment options.
+#' @param conf_dir `character(1)`, optional. Place where the
+#' configuration resides. Changing this usually only makes sense
+#' for testing.
#' @return An `envopts` object.
#' @author Todor Kondić
#' @export
init <- function(projects=NULL,
top_data_dir=NULL,
+ users_dir=NULL,
metfrag_db_dir=NULL,
metfrag_jar=NULL,
java_bin=NULL,
metfrag_max_proc=NULL,
merge=T,
- save=F) {
-
-
+ save=F,
+ conf_dir=tools::R_user_dir(package="shinyscreen",
+ which="config")) {
+
+ ## The function will usually return a merge between the saved
+ ## configuration and arguments provided by the user. This is why
+ ## we need to know which arguments have been actually changed by
+ ## the user. In order to do this, all `envopts'-like arguments to
+ ## `init' have been created with an illegal default value, NULL.
+
+ ## Therefore, any argument with an user-supplied _valid_ value
+ ## will be non-NULL. We can browse through the function
+ ## environment, pick out these non-NULLs and then override the
+ ## saved config with them.
+
+ ## So, get the function environment.
env = environment()
- eargs = list()
- ## Merge into the untouched (NULLs), only.
+
+ ## Get the list of all possible arguments from the simpletst
+ ## `envopts' constructor.
+ eargs = formalArgs(empty_envopts)
+
+ ## Check which are NULLs and retain only those which are
+ ## not.
+ evals = lapply(eargs,function(ca) env[[ca]])
+ ennull = sapply(evals,is.null,USE.NAMES=F)
+ eargs = eargs[!ennull]
+ evals = evals[!ennull]
+ names(evals) = eargs
+ ## Now call the empty envopts constructor only with non-NULL
+ ## arguments.
+ enew = do.call(empty_envopts,evals)
+ ## If merging should occur.
if (merge) {
- ## Merge with old values
- eold = load_envopts()
- cargs = formalArgs(envopts)
- if (length(eold)>0L) {
- for (a in cargs) {
- if (is.null(env[[a]])) eargs[[a]] = eold[[a]] else eargs[[a]]=env[[a]]
- }
- }
- }
- ## Default values = "" .
- chrargs = c("projects","top_data_dir","metfrag_db_dir")
+ ## Get saved values.
+ eold = load_envopts(dir=conf_dir)
+ if (length(eold)>0L) {
- for (ca in chrargs) {
- if (is.null(eargs[[ca]])) eargs[[ca]]=""
- }
+ ## First, merge on non-metfrag keys. Overwrite only NULLs.
+ simplekeys = setdiff(names(enew),"metfrag")
+ for (a in simplekeys) {
+ if (is.null(enew[[a]])) enew[[a]] = eold[[a]]
+ }
- if (is.null(java_bin)) {
- eargs[["java_bin"]]= Sys.which("java")
+ ## Now, metfrag. Do the same.
+ mfkeys = names(enew$metfrag)
+ for (a in mfkeys) {
+ if (is.null(enew$metfrag[[a]])) enew$metfrag[[a]] = eold$metfrag[[a]]
+ }
+ }
+
}
- if (is.null(metfrag_max_proc)) {
- eargs$metfrag_max_proc = parallel::detectCores()
- }
-
- e = do.call(envopts,eargs)
-
+ ## Replace the remaining NULL values with actual defaults.
+ e = seal_envopts(enew)
- if (save) save_envopts(o=e)
+ if (save) save_envopts(o=e,dir=conf_dir)
e
}
diff --git a/R/envopts.R b/R/envopts.R
index f4beb66..bd18372 100644
--- a/R/envopts.R
+++ b/R/envopts.R
@@ -21,21 +21,13 @@
-
-mk_envopts <- function() {
- res = list()
- class(res) = c("envopts","list") #Just to officially make it an
- #object.
- res
-}
-
-
-#' @title Create a `envopts` Object
+#' @title Create an Empty `envopts` Object
#' @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 projects `character(1)`, a directory which contains all
#' shinyscreen projects directories. A single project directory
#' contains input and output files.
@@ -47,47 +39,78 @@ mk_envopts <- function() {
#' @param metfrag_jar `character(1)`, a path to MetFrag JAR file.
#' @param users_dir `character(1)`, a location on the server side
#' containing individual user directories.
-#' @param java_bin `character(1)`, a path to jave runtime
-#' (optional). We try to detect this.
+#' @param java_bin `character(1)`, a path to java runtime. If no path
+#' has been supplied, we will try to detect it.
#' @param metfrag_max_proc `integer(1)`, maximum number of CPU cores
-#' available for MetFrag.
+#' available for MetFrag. If no number has been supplied, we will
+#' try to detect the number of logical CPUs and go with that.
#' @return An `envopts` object.
#' @author Todor Kondić
-envopts <- function(projects="",
- top_data_dir="",
- metfrag_db_dir="",
- metfrag_jar="",
- users_dir="",
- java_bin=Sys.which("java"),
- metfrag_max_proc = parallel::detectCores()) {
- res = mk_envopts()
- res = list(metfrag=list())
+empty_envopts <- function(projects=NULL,
+ top_data_dir=NULL,
+ users_dir=NULL,
+ metfrag_db_dir=NULL,
+ metfrag_jar=NULL,
+ java_bin=NULL,
+ metfrag_max_proc=NULL) {
+
+ ## Creates an empty `envopts' object. Works in conjunction with
+ ## shinyscreen::init().
+ res = list(projects=projects,
+ top_data_dir=top_data_dir,
+ users_dir=users_dir,
+ metfrag=list(db_dir=metfrag_db_dir,
+ jar=metfrag_jar,
+ java_bin=java_bin,
+ max_proc=metfrag_max_proc))
+ class(res) = c("envopts","list") #Just to officially make it an
+ #object.
+ res
+}
+
+
+
+seal_envopts <- function(o) {
+
+
+ ## Assign defaults to `envopts'. Works in conjunction with
+ ## `shinyscreen::init()'.
+ zero_str = c("projects","top_data_dir","users_dir")
+ for (z in zero_str) {
+ if (is.null(o[[z]])) o[[z]]=""
+ }
+
+ if (is.null(o$metfrag$db_dir)) o$metfrag$db_dir=""
+
+ if (is.null(o$metfrag$java_bin)) o$metfrag$java_bin=Sys.which("java")
+ if (is.null(o$metfrag$jar)) o$metfrag$jar = ""
+ if (is.null(o$metfrag$max_proc)) o$metfrag$max_proc = parallel::detectCores()
-
- check_dir_absent(projects,what="projects-dir")
- res$projects = projects
- check_dir_absent(top_data_dir,what="top-data-dir")
- res$top_data_dir=top_data_dir
+ check_dir_absent(o$projects,what="projects-dir")
+ o$projects = norm_path(o$projects)
+
+ check_dir_absent(o$top_data_dir,what="top-data-dir")
+ o$top_data_dir=norm_path(o$top_data_dir)
- check_dir_absent(users_dir,what="users-dir")
- res$users_dir=users_dir
+ check_dir_absent(o$users_dir,what="users-dir")
+ o$users_dir=norm_path(o$users_dir)
- check_dir_absent(metfrag_db_dir,what="mf-db-dir")
- res$metfrag$db_dir = norm_path(metfrag_db_dir)
+ check_dir_absent(o$metfrag$db_dir,what="mf-db-dir")
+ o$metfrag$db_dir = norm_path(o$metfrag$db_dir)
- check_file_absent(metfrag_jar,what="mf-jar")
+ check_file_absent(o$metfrag$jar,what="mf-jar")
+ if (nchar(o$metfrag$jar)>0) o$metfrag$jar = norm_path(o$metfrag$jar)
- check_not_integer(value=metfrag_max_proc,
- what="metfrag_max_proc")
+ check_not_integer(value=o$metfrag$max_proc,
+ what="metfrag-max-proc")
- res$metfrag$jar = norm_path(metfrag_jar)
- res$metfrag$max_proc = metfrag_max_proc
- if (nchar(res$metfrag$jar)>0L) {
- check_file_absent(java_bin,"java-bin")
- res$metfrag$java_bin = java_bin
+
+
+ if (nchar(o$metfrag$jar)>0L) {
+ check_file_absent(o$metfrag$java_bin,"java-bin")
}
- res
+ o
}
@@ -100,20 +123,21 @@ is_metfrag_local_available <- function(e) {
}
-get_envopts_fn <- function() {
- file.path(tools::R_user_dir(package="shinyscreen",
- which="config"),
- FN_ENVOPTS)
+get_envopts_fn <- function(dir=tools::R_user_dir(package="shinyscreen",
+ which="config")) {
+ file.path(dir,FN_ENVOPTS)
}
-load_envopts <- function() {
- cfgfile = get_envopts_fn()
- if (file.exists(cfgfile)) readRDS(cfgfile) else mk_envopts()
+load_envopts <- function(dir=tools::R_user_dir(package="shinyscreen",
+ which="config")) {
+ cfgfile = get_envopts_fn(dir=dir)
+ if (file.exists(cfgfile)) readRDS(cfgfile) else empty_envopts()
}
-save_envopts <- function(o) {
- cfgfile = get_envopts_fn()
+save_envopts <- function(o,dir=tools::R_user_dir(package="shinyscreen",
+ which="config")) {
+ cfgfile = get_envopts_fn(dir=dir)
dr = dirname(cfgfile)
dir.create(path = dr, showWarnings = F, recursive=T)
saveRDS(o,cfgfile)
diff --git a/R/errors.R b/R/errors.R
index 5d0f71a..4eccb83 100644
--- a/R/errors.R
+++ b/R/errors.R
@@ -58,8 +58,7 @@ check_extension <- function(extfileval,what) {
}
check_not_integer <- function(value,what) {
- if (!is.integer(value)) stop(errorCondition(paste0("The value of `", what,"' must be an integer.")),
- class = paste0(what,'-not-an-int'))
+ if (!is.integer(value)) stop(errorCondition(paste0("The value (",value,") of `", what,"' must be an integer."), class = paste0(what,'-not-an-int')))
}
check_key_absent <- function(keys,l,what) {
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index 710e3d8..63c7b01 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -1137,8 +1137,7 @@ mk_shinyscreen_server <- function(projects,init) {
if (rv_extr_flag()) {
rv_extr_flag(F)
rvs$m = run(m=rvs$m,
- top_data_dir=init$envopts$top_data_dir,
- metfrag_db_dir=init$envopts$metfrag$db_dir,
+ envopts=init$envopts,
phases=c("setup","comptab","extract"))
rvs$status$is_extracted_stat = "Yes."
rvs$status$is_qa_stat = "No."
@@ -1188,8 +1187,7 @@ mk_shinyscreen_server <- function(projects,init) {
rv_presc_flag(F)
## If user changed prescreening params.
rvs$m = run(m=rvs$m,
- top_data_dir=init$envopts$top_data_dir,
- metfrag_db_dir=init$envopts$metfrag$db_dir,
+ envopts=init$envopts,
phases="prescreen")
rvs$status$is_qa_stat = "Yes."
shinymsg("Prescreening has been completed.")
diff --git a/inst/rmd/app.Rmd b/inst/rmd/app.Rmd
index 30f25c8..ad9a1b6 100644
--- a/inst/rmd/app.Rmd
+++ b/inst/rmd/app.Rmd
@@ -58,8 +58,8 @@ rv_rtrange <- reactiveValues(min=def_state$conf$rt_min,
rv_mzrange <- reactiveValues(min=NA,
max=NA)
-projects <- list.dirs(path=init$projects, full.names = F, recursive = F)
-inputdirs <- list.dirs(path=init$top_data_dir, full.names = F, recursive = F)
+projects <- list.dirs(path=init$envopts$projects, full.names = F, recursive = F)
+inputdirs <- list.dirs(path=init$envopts$top_data_dir, full.names = F, recursive = F)
```
<style type="text/css">
diff --git a/tests/testthat/_snaps/api.md b/tests/testthat/_snaps/api.md
new file mode 100644
index 0000000..8a51151
--- /dev/null
+++ b/tests/testthat/_snaps/api.md
@@ -0,0 +1,87 @@
+# Test basic initialisation.
+
+ Code
+ y
+ Output
+ $projects
+ [1] "projects"
+
+ $top_data_dir
+ [1] "topdatadir"
+
+ $users_dir
+ [1] "users"
+
+ $metfrag
+ $metfrag$db_dir
+ [1] "mfdb"
+
+ $metfrag$jar
+ [1] "metfrag.jar"
+
+ $metfrag$java_bin
+ [1] "java"
+
+ $metfrag$max_proc
+ [1] 3
+
+
+
+# Test saving configuration.
+
+ Code
+ y
+ Output
+ $projects
+ [1] "projects"
+
+ $top_data_dir
+ [1] "topdatadir"
+
+ $users_dir
+ [1] "users"
+
+ $metfrag
+ $metfrag$db_dir
+ [1] "mfdb"
+
+ $metfrag$jar
+ [1] "metfrag.jar"
+
+ $metfrag$java_bin
+ [1] "java"
+
+ $metfrag$max_proc
+ [1] 3
+
+
+
+# Test merging configuration.
+
+ Code
+ y
+ Output
+ $projects
+ [1] "projects"
+
+ $top_data_dir
+ [1] "topdatadir"
+
+ $users_dir
+ [1] "users"
+
+ $metfrag
+ $metfrag$db_dir
+ [1] "mfdb"
+
+ $metfrag$jar
+ [1] "metfrag.jar"
+
+ $metfrag$java_bin
+ [1] "java"
+
+ $metfrag$max_proc
+ [1] 5
+
+
+
diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
index ab43777..6d1d1d9 100644
--- a/tests/testthat/helper.R
+++ b/tests/testthat/helper.R
@@ -3,15 +3,26 @@ ok_return_val <- function(fun_name,...) {
}
gen_test_dirs <- function() {
-
+ ## Create shinyscreen directories.
tname = tempfile("shiny_test_dirs")
dirs = list(metfrag_db_dir = file.path(tname,"mfdb"))
+
dirs$top_data_dir = file.path(tname,"topdatadir")
dirs$projects = file.path(tname,"projects")
+ dirs$users_dir = file.path(tname,"users")
+ dirs$mfjardir = file.path(tname,"jardir")
+
dir.create(tname)
for (dr in dirs) dir.create(dr)
dirs$root = tname
fn_db = system.file("testdata","example_db.csv",package="shinyscreen")
+
+ mfjar = file.path(dirs$mfjardir,"metfrag.jar")
+ mfjava = file.path(dirs$mfjardir,"java")
+ saveRDS(NULL,file=mfjar)
+ saveRDS(NULL,file=mfjava)
+
+ file.copy(fn_db,dirs$top_data_dir)
dirs
}
@@ -22,3 +33,17 @@ gen_test_project <- function() {
dir.create(project)
}
+
+trim_tmp_paths_envopts <- function(x) {
+ y=list()
+ for (n in setdiff(names(x),"metfrag")) {
+ y[[n]] = basename(x[[n]])
+ }
+
+ mfchrs = setdiff(names(x$metfrag),"max_proc")
+ for (n in mfchrs) {
+ y$metfrag[[n]]=basename(x$metfrag[[n]])
+ }
+ y$metfrag$max_proc = x$metfrag$max_proc
+ y
+}
diff --git a/tests/testthat/test-api.R b/tests/testthat/test-api.R
index 5968750..b7a2b16 100644
--- a/tests/testthat/test-api.R
+++ b/tests/testthat/test-api.R
@@ -1,23 +1,150 @@
-test_that("Preparation for app start",{withr::with_tempdir({
- dbef = "bef"
- dir.create("bef")
- ddata = "topdata"
- dir.create(ddata)
- dproj = "proj"
- dir.create(dproj)
- ddbdir = "dbdir"
- dir.create(ddbdir)
- mrt = "mrt.fake.jar"
- saveRDS("",file=mrt)
- expect_error(prepare_app(dir_before=dbef,
- projects="absent",
- top_data_dir=ddata,
- metfrag_db_dir=""),
- class="projects-absent")
- expect_error(prepare_app(dir_before=dbef,
- projects=dproj,
- top_data_dir="absent",
- metfrag_db_dir=""),
+test_that("Test basic initialisation.",{
+ dirs = gen_test_dirs()
+
+ ## This is how it is supposed to work.
+ x = init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir=dirs$users_dir,
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=F)
+
+ ## Function `gen_test_dirs' creates shinyscreen root structure in
+ ## a temp dir. We need to strip the random part for comparison.
+ y = trim_tmp_paths_envopts(x)
+ expect_snapshot(y)
+
+ ## What happens if directories are wrong.
+ expect_error(init(projects="absent",
+ top_data_dir=dirs$top_data_dir,
+ users_dir=dirs$users_dir,
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=F),
+ class="projects-dir-absent")
+ expect_error(init(projects=dirs$projects,
+ top_data_dir="absent",
+ users_dir=dirs$users_dir,
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=F),
class="top-data-dir-absent")
+ expect_error(init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir="absent",
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=F),
+ class="users-dir-absent")
+
+ expect_error(init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir="absent",
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=F),
+ class="users-dir-absent")
+
+ expect_error(init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir=dirs$users_dir,
+ metfrag_db_dir="absent",
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=F),
+ class="mf-db-dir-absent")
+
+ expect_error(init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir=dirs$users_dir,
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = "absent",
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=F),
+ class="mf-jar-absent")
+
+ expect_error(init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir=dirs$users_dir,
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = "absent",
+ metfrag_max_proc=3L,
+ merge=F,
+ save=F),
+ class="java-bin-absent")
+
+ expect_error(init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir=dirs$users_dir,
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = dirs$metfrag_db_dir,
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3.45,
+ merge=F,
+ save=F),
+ class="metfrag-max-proc-not-an-int")
+
+
+
+})
+
+test_that("Test saving configuration.",{
+ dirs = gen_test_dirs()
+ troot = dirs$root
+
+ e = init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir=dirs$users_dir,
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=T,
+ conf_dir=troot)
+
+ eold = load_envopts(dir=troot)
+ y = trim_tmp_paths_envopts(eold)
+ expect_snapshot(y)
+})
+
+
+test_that("Test merging configuration.",{
+ dirs = gen_test_dirs()
+ troot = dirs$root
+
+ e = init(projects=dirs$projects,
+ top_data_dir=dirs$top_data_dir,
+ users_dir=dirs$users_dir,
+ metfrag_db_dir=dirs$metfrag_db_dir,
+ metfrag_jar = file.path(dirs$mfjardir,"metfrag.jar"),
+ java_bin = file.path(dirs$mfjardir,"java"),
+ metfrag_max_proc=3L,
+ merge=F,
+ save=T,
+ conf_dir=troot)
-})})
+ enew = init(metfrag_max_proc=5L,conf_dir=troot)
+ y = trim_tmp_paths_envopts(x=enew)
+ expect_snapshot(y)
+})
diff --git a/tests/testthat/test-state.R b/tests/testthat/test-state.R
index dc26280..5272d9b 100644
--- a/tests/testthat/test-state.R
+++ b/tests/testthat/test-state.R
@@ -1,11 +1,3 @@
-test_that("Test envopts",{
- ## Test bad mf db dir.
- expect_error(envopts(metfrag_db_dir="notexist"),class="mf-db-dir-absent")
-
- ## Test bad mf db jar.
- expect_error(envopts(metfrag_jar="notexist"),class="mf-jar-absent")
-})
-
test_that("Test empty project creation.",{
withr::with_tempdir({
--
GitLab