Added method to set/get pipeline preferences

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: raveio
 Type: Package
 Title: File-System Toolbox for RAVE Project
-Version: 0.9.0.62
+Version: 0.9.0.63
 Language: en-US
 Authors@R: c(
     person("Zhengjia", "Wang", email = "[email protected]", role = c("aut", "cre", "cph")),

NAMESPACE

@@ -152,7 +152,6 @@ export(get_module_description)
 export(get_modules_registries)
 export(get_projects)
 export(get_val2)
-export(global_preferences)
 export(glue)
 export(h5_names)
 export(h5_valid)
@@ -202,6 +201,8 @@ export(pipeline_eval)
 export(pipeline_find)
 export(pipeline_fork)
 export(pipeline_from_path)
+export(pipeline_get_preferences)
+export(pipeline_has_preferences)
 export(pipeline_hasname)
 export(pipeline_install_github)
 export(pipeline_install_local)
@@ -213,6 +214,7 @@ export(pipeline_root)
 export(pipeline_run)
 export(pipeline_run_bare)
 export(pipeline_save_extdata)
+export(pipeline_set_preferences)
 export(pipeline_settings_get)
 export(pipeline_settings_set)
 export(pipeline_setup_rmd)
@@ -264,7 +266,6 @@ export(test_hdspeed)
 export(time_diff2)
 export(update_local_snippet)
 export(url_neurosynth)
-export(use_global_preferences)
 export(validate_raw_file)
 export(validate_subject)
 export(validate_time_window)

R/class-pipeline_tools.R

@@ -37,7 +37,11 @@ PipelineTools <- R6::R6Class(
       private$.pipeline_path <- pipeline_find(pipeline_name, root_path = pipeline_root(paths, temporary = temporary))
       private$.pipeline_name <- attr(private$.pipeline_path, "target_name")
       private$.settings_file <- settings_file
-      private$.preferences <- dipsaus::fastmap2()
+      private$.preferences <- global_preferences(
+        .prefix_whitelist = c("global", self$pipeline_name),
+        # TODO: add type-explicit
+        .type_whitelist = NULL
+      )
 
       pipeline_settings_path <- file.path(
         private$.pipeline_path,
@@ -496,60 +500,78 @@ PipelineTools <- R6::R6Class(
                             pipe_dir = self$pipeline_path, ...)
     },
 
-    #' @description load persistent preference settings from the pipeline.
+    #' @description set persistent preferences from the pipeline.
     #' The preferences should not affect how pipeline is working, hence usually
     #' stores minor variables such as graphic options. Changing preferences
     #' will not invalidate pipeline cache.
     #' @param name preference name, must contain only letters, digits,
     #' underscore, and hyphen, will be coerced to lower case (case-insensitive)
-    #' @param ...,.initial_prefs key-value pairs of initial preference values
-    #' @param .overwrite whether to overwrite the initial preference values
-    #' if they exist.
-    #' @param .verbose whether to verbose the preferences to be saved; default
-    #' is false; turn on for debug use
-    #' @returns A persistent map, see \code{\link[dipsaus]{rds_map}}
-    load_preferences = function(name, ..., .initial_prefs = list(), .overwrite = FALSE, .verbose = FALSE) {
-      stopifnot2(
-        grepl(pattern = "^[a-zA-Z0-9_-]+$",
-              x = name),
-        msg = "preference `name` must only contain letters (a-z), digits (0-9), underscore (_), and hyphen (-)"
-      )
-      name <- tolower(name)
-
-      pref_path <- file.path(self$preference_path, name)
-
-      if(name %in% names(private$.preferences)) {
-        preference <- private$.preferences[[name]]
-      } else {
-        preference <- dipsaus::rds_map(pref_path)
-        private$.preferences[[name]] <- preference
-      }
-
-      # avoid evaluating dots
-      dot_names <- ...names()
-      list_names <- names(.initial_prefs)
-      nms <- c(dot_names, list_names)
-      nms <- nms[!nms %in% ""]
-      if(!length(nms)) { return( preference ) }
-      if(!.overwrite) {
-        nms <- nms[ !nms %in% preference$keys() ]
-        if(!length(nms)) { return( preference ) }
-      }
-
-      if( .verbose ) {
-        catgl("Initializing the following preference(s): \n{ paste(nms, collapse = '\n') }", level = "DEBUG")
-      }
+    #' @param ...,.list key-value pairs of initial preference values. The keys
+    #' must start with 'global' or the module ID, followed by dot and preference
+    #' type and names. For example \code{'global.graphics.continuous_palette'}
+    #' for setting palette colors for continuous heat-map; "global" means the
+    #' settings should be applied to all 'RAVE' modules. The module-level
+    #' preference, \code{'power_explorer.export.default_format'} sets the
+    #' default format for power-explorer export dialogue.
+    #' @returns A list of key-value pairs
+    set_preferences = function(..., .list = NULL) {
+      pipeline_set_preferences(..., .list = .list,
+                               .preference_instance = private$.preferences)
+    },
 
-      default_vals <- as.list(.initial_prefs[list_names %in% nms])
-      nms <- nms[nms %in% dot_names]
-      if(length(nms)) {
-        for(nm in nms) {
-          default_vals[[nm]] <- ...elt(which(dot_names == nm))
-        }
-      }
+    #' @description get persistent preferences from the pipeline.
+    #' @param keys characters to get the preferences
+    #' @param simplify whether to simplify the results when length of key is 1;
+    #' default is true; set to false to always return a list of preferences
+    #' @param ifnotfound default value when the key is missing
+    #' @param validator \code{NULL} or function to validate the values; see
+    #' 'Examples'
+    #' @param ... passed to \code{validator} if \code{validator} is a function
+    #' @returns A list of the preferences. If \code{simplify} is true and length
+    #' if keys is 1, then returns the value of that preference
+    #' @examples
+    #'
+    #' library(raveio)
+    #' if(interactive() && length(pipeline_list()) > 0) {
+    #'   pipeline <- pipeline("power_explorer")
+    #'
+    #'   # set dummy preference
+    #'   pipeline$set_preferences("global.example.dummy_preference" = 1:3)
+    #'
+    #'   # get preference
+    #'   pipeline$get_preferences("global.example.dummy_preference")
+    #'
+    #'   # get preference with validator to ensure the value length to be 1
+    #'   pipeline$get_preferences(
+    #'     "global.example.dummy_preference",
+    #'     validator = function(value) {
+    #'       stopifnot(length(value) == 1)
+    #'     },
+    #'     ifnotfound = 100
+    #'   )
+    #'
+    #'   pipeline$has_preferences("global.example.dummy_preference")
+    #' }
+    #'
+    get_preferences = function(keys, simplify = TRUE, ifnotfound = NULL,
+                               validator = NULL, ...) {
+      pipeline_get_preferences(
+        keys = keys,
+        simplify = simplify,
+        ifnotfound = ifnotfound,
+        validator = validator,
+        ...,
+        .preference_instance = private$.preferences
+      )
+    },
 
-      preference$mset(.list = default_vals)
-      preference
+    #' @description whether pipeline has preference keys
+    #' @param keys characters name of the preferences
+    #' @param ... passed to internal methods
+    #' @returns logical whether the keys exist
+    has_preferences = function(keys, ...) {
+      pipeline_has_preferences(keys = keys, ...,
+                               .preference_instance = private$.preferences)
     }
 
   ),

R/pipeline-docs.R

@@ -4,8 +4,8 @@
 #' internal development use. The infrastructure will be deployed to 'RAVE' in
 #' the future to facilitate the "self-expanding" aim. Please check the official
 #' 'RAVE' website.
-#' @param pipe_dir where the pipeline directory is; can be set via system
-#' environment \code{Sys.setenv("RAVE_PIPELINE"=...)}
+#' @param pipe_dir,.pipe_dir where the pipeline directory is; can be set via
+#' system environment \code{Sys.setenv("RAVE_PIPELINE"=...)}
 #' @param quick whether to skip finished targets to save time
 #' @param skip_names hint of target names to fast skip provided they are
 #' up-to-date; only used when \code{quick=TRUE}. If missing, then
@@ -27,6 +27,8 @@
 #' @param names the names of pipeline targets that are to be executed; default
 #' is \code{NULL}, which runs all targets; use \code{pipeline_target_names}
 #' to check all your available target names.
+#' @param keys preference keys
+#' @param validator \code{NULL} or function to validate values
 #' @param return_values whether to return pipeline target values; default is
 #' true; only works in \code{pipeline_run_bare} and will be ignored by
 #' \code{pipeline_run}
@@ -84,7 +86,8 @@
 #' @param error_if_missing,default_if_missing what to do if the extended data
 #' is not found
 #' @param data extended data to be saved
-#' @param ... other parameters, targets, etc.
+#' @param ...,.list other parameters, targets, etc.
+#' @param .preference_instance internally used
 #' @returns \describe{
 #' \item{\code{pipeline_root}}{the root directories of the pipelines}
 #' \item{\code{pipeline_list}}{the available pipeline names under \code{pipeline_root}}

R/pipeline-tools.R

@@ -1387,3 +1387,85 @@ pipeline_py_module <- function(
 
   py_module
 }
+
+
+#' @rdname rave-pipeline
+#' @export
+pipeline_set_preferences <- function(
+    ..., .list = NULL,
+    .pipe_dir = Sys.getenv("RAVE_PIPELINE", "."),
+    .preference_instance = NULL) {
+  prefs <- c(list(...), .list)
+  if(!length(prefs)) { return(invisible()) }
+  # preferences must be `global/module_id`.`type (graphics, ...)`.`key`.dtype
+  nms <- names(prefs)
+  if(length(nms) != length(prefs) || any(nms == "")) {
+    stop("All preferences must be named")
+  }
+
+  if(missing(.preference_instance) || is.null(.preference_instance)) {
+    pipe_dir <- activate_pipeline(.pipe_dir)
+    pipeline_name <- attr(pipe_dir, "target_name")
+    instance <- global_preferences(.prefix_whitelist = c("global", pipeline_name))
+  } else {
+    instance <- .preference_instance
+  }
+
+  instance$mset(.list = prefs)
+
+  invisible(prefs)
+
+}
+
+#' @rdname rave-pipeline
+#' @export
+pipeline_get_preferences <- function(
+    keys, simplify = TRUE, ifnotfound = NULL, validator = NULL, ...,
+    .preference_instance = NULL) {
+
+  if(missing(.preference_instance) || is.null(.preference_instance)) {
+    instance <- global_preferences()
+  } else {
+    instance <- .preference_instance
+  }
+
+
+  if(is.function(validator)) {
+    args <- list(...)
+    force(ifnotfound)
+    re <- structure(
+      names = keys,
+      lapply(keys, function(key) {
+        if(instance$has(key)) {
+          value <- instance$get(key, missing_default = ifnotfound)
+          tryCatch({
+            do.call(validator, c(list(value), args))
+            return(value)
+          }, error = function(e) {
+            ifnotfound
+          })
+        } else {
+          ifnotfound
+        }
+      })
+    )
+  } else {
+    re <- instance$mget(keys, missing_default = ifnotfound)
+  }
+  if(simplify && length(keys) == 1) {
+    re <- re[[1]]
+  }
+  return(re)
+}
+
+#' @rdname rave-pipeline
+#' @export
+pipeline_has_preferences <- function(keys, ..., .preference_instance = NULL) {
+  if(missing(.preference_instance) || is.null(.preference_instance)) {
+    instance <- global_preferences()
+  } else {
+    instance <- .preference_instance
+  }
+  instance$has(keys, ...)
+}
+