Refactor config::get to split off two helper functions

NAMESPACE

@@ -1,8 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(print,config)
+export(eval_config)
 export(get)
 export(is_active)
+export(load_config)
 export(merge)
 export(with_config)
 import(yaml)

R/get.R

@@ -1,4 +1,3 @@
-
 #' Read configuration values. Always use as `config::get()`.
 #'
 #' Read from the currently active configuration, retrieving either a
@@ -22,13 +21,7 @@
 #'   the value of the `R_CONFIG_ACTIVE` environment variable
 #'   ("default" if the variable does not exist).
 #'
-#' @param file Configuration file to read from (defaults to
-#'   `"config.yml"`). If the file isn't found at the location
-#'   specified then parent directories are searched for a file
-#'   of the same name.
-#'
-#' @param use_parent `TRUE` to scan parent directories for
-#'   configuration files if the specified config file isn't found.
+#' @inheritParams load_config
 #'
 #' @return The requested configuration value (or all values as
 #'   a list of `NULL` is passed for `value`).
@@ -40,55 +33,20 @@
 #' @example inst/examples/example_get.R
 #'
 #' @export
-get <- function(value = NULL,
-                config = Sys.getenv("R_CONFIG_ACTIVE", "default"),
-                file = Sys.getenv("R_CONFIG_FILE", "config.yml"),
-                use_parent = TRUE) {
-
-  # find the file (scan parent directories above if need be)
-  file <- normalizePath(file, mustWork = FALSE)
-  if (use_parent) {
-    while (!file.exists(file)) {
-      # normalize path
-      file <- normalizePath(file, mustWork = FALSE)
-
-      # check if we are at the end of the search
-      file_dir <- normalizePath(dirname(file), mustWork = FALSE)
-      parent_dir <- normalizePath(dirname(file_dir), mustWork = FALSE)
-      if (file_dir == parent_dir)
-        break
-
-      # search one directory up
-      file <- file.path(parent_dir, basename(file))
-    }
-  }
-
-  # check for file existence
-  if (!file.exists(file)) {
-    stop("Config file ", basename(file), " not found in current working ",
-         "directory", ifelse(use_parent, " or parent directories", ""))
-  }
-
-  # load the yaml
-  config_yaml <- yaml::yaml.load_file(
-    file,
-    eval.expr = FALSE,
-    handlers = list(expr = function(x) {
-      # print(x)
-      parse(text = x)
-    }),
-    readLines.warn = FALSE
-  )
-
+get <- function(
+  value = NULL,
+  config = Sys.getenv("R_CONFIG_ACTIVE", "default"),
+  file = Sys.getenv("R_CONFIG_FILE", "config.yml"),
+  use_parent = TRUE
+) {
+  config_yaml <- load_config(file, use_parent = use_parent)
 
   # get the default config (required)
   default_config <- config_yaml[["default"]]
-  if (is.null(default_config))
-    stop("You must provide a default configuration.")
+  if (is.null(default_config)) stop("You must provide a default configuration.")
 
   # get the value and check for / validate inheritance
   do_get <- function(config, inherited = c()) {
-
     # error if the requested config is already in our inheritance chain
     if (config %in% inherited[-1])
       stop("Configuration ", config, " inherits from itself!", call. = FALSE)
@@ -98,16 +56,19 @@ get <- function(value = NULL,
     # if (config == "shinyapps") browser()
     if (!is.null(active_config$inherits)) {
       inh <- active_config$inherits
-      if (is.expression(active_config$inherits)) {}
-      active_config$inherits <- eval(inh, envir = baseenv())
+      if (is.expression(active_config$inherits)) {
+        active_config$inherits <- eval(inh, envir = baseenv())
+      }
     }
 
     # if it isn't the default configuration then see if it inherits from
     # another configuration. if it does then resolve and merge with it,
     if (!identical(config, "default")) {
       for (cfg in active_config$inherits) {
-        active_config <- merge_lists(do_get(cfg, c(cfg, inherited)),
-                                     active_config)
+        active_config <- merge_lists(
+          do_get(cfg, c(cfg, inherited)),
+          active_config
+        )
       }
     }
 
@@ -118,10 +79,106 @@ get <- function(value = NULL,
   # merge the specified configuration with the default configuration
   active_config <- merge_lists(default_config, do_get(config))
 
-  # check whether any expressions need to be evaluated recursively
+  active_config <- eval_config(active_config)
 
-  eval_issues <- list()
+  # return either the entire config or a requested value
+  if (!is.null(value)) active_config[[value]] else
+    structure(
+      active_config,
+      config = config,
+      file = file,
+      class = c("config", class(active_config))
+    )
+}
+
+#' @export
+print.config <- function(x, ...) {
+  attr(x, "config") <- NULL
+  attr(x, "file") <- NULL
+  class(x) <- class(x)[-1]
+  NextMethod(x)
+}
+
+#' Load a config from a YAML file
+#'
+#' [load_config()] loads a YAML file from the local or parent directory.
+#' @keywords internal
+#' @param file Configuration file to read from (defaults to
+#'   `"config.yml"`). If the file isn't found at the location
+#'   specified then parent directories are searched for a file
+#'   of the same name.
+#'
+#' @param use_parent `TRUE` to scan parent directories for
+#'   configuration files if the specified config file isn't found.
+#'
+#' @inheritParams yaml::yaml.load_file
+#'
+#' @param handlers Passed to [yaml::yaml.load_file()]. Defaults to use [parse()] custom handler for
+#' expressions.
+#' @export
+load_config <- function(
+  file = Sys.getenv("R_CONFIG_FILE", "config.yml"),
+  use_parent = TRUE,
+  eval.expr = FALSE,
+  handlers = list(
+    expr = function(x) {
+      parse(text = x)
+    }
+  )
+) {
+  # find the file (scan parent directories above if need be)
+  file <- normalizePath(file, mustWork = FALSE)
+  if (use_parent) {
+    while (!file.exists(file)) {
+      # normalize path
+      file <- normalizePath(file, mustWork = FALSE)
+
+      # check if we are at the end of the search
+      file_dir <- normalizePath(dirname(file), mustWork = FALSE)
+      parent_dir <- normalizePath(dirname(file_dir), mustWork = FALSE)
+      if (file_dir == parent_dir) break
+
+      # search one directory up
+      file <- file.path(parent_dir, basename(file))
+    }
+  }
+
+  # check for file existence
+  if (!file.exists(file)) {
+    stop(
+      "Config file ",
+      basename(file),
+      " not found in current working ",
+      "directory",
+      ifelse(use_parent, " or parent directories", "")
+    )
+  }
+
+  # load the yaml
+  yaml::yaml.load_file(
+    file,
+    eval.expr = eval.expr,
+    handlers = handlers,
+    readLines.warn = FALSE
+  )
+}
+
+#' Evaluate a config list
+#'
+#' [eval_config()] checks a config list for expressions that need to be
+#' evaluated recursively and evaluates if needed.
+#'
+#' @param x configuration list
+#' @param eval_env evaluation environment
+#' @keywords internal
+#' @export
+eval_config <- function(
+  x,
   eval_env = new.env(parent = baseenv())
+) {
+  # check whether any expressions need to be evaluated recursively
+  eval_issues <- list()
+
   eval_fun <- function(expr, envir) {
     tryCatch(
       eval(expr, envir = envir),
@@ -131,49 +188,37 @@ get <- function(value = NULL,
           paste(deparse(e$call), e$message, sep = ": ")
         )
         NULL
-      })
+      }
+    )
   }
+
   eval_recursively <- function(x, level = 1) {
     is_expr <- vapply(x, is.expression, logical(1))
     is_list <- vapply(x, is.list, logical(1))
 
     if (level == 1) {
       eval_env <- list2env(x[!is_expr & !is_list], envir = eval_env)
     }
-    x[is_expr & !is_list] <- lapply(x[is_expr & !is_list], eval_fun, envir = eval_env)
+    x[is_expr & !is_list] <- lapply(
+      x[is_expr & !is_list],
+      eval_fun,
+      envir = eval_env
+    )
     x[is_list] <- lapply(x[is_list], eval_recursively, level = level + 1)
     x
   }
 
-  active_config <- eval_recursively(active_config)
+  x <- eval_recursively(x)
 
   if (length(eval_issues)) {
-    msg <- paste("Attempt to assign nested list value from expression.",
-                 "Only directly assigned values can be used in expressions.",
-                 ngettext(length(eval_issues), "Original Error:\n",
-                          "Original Errors:\n"),
-                 sep = "\n")
+    msg <- paste(
+      "Attempt to assign nested list value from expression.",
+      "Only directly assigned values can be used in expressions.",
+      ngettext(length(eval_issues), "Original Error:\n", "Original Errors:\n"),
+      sep = "\n"
+    )
     stop(msg, paste("* ", eval_issues, collapse = "\n"), call. = TRUE)
   }
 
-  # return either the entire config or a requested value
-  if (!is.null(value))
-    active_config[[value]]
-  else
-    structure(
-      active_config,
-      config = config,
-      file = file,
-      class = c("config", class(active_config))
-    )
-
+  x
 }
-
-#' @export
-print.config <- function(x, ...) {
-  attr(x, "config") <- NULL
-  attr(x, "file") <- NULL
-  class(x) <- class(x)[-1]
-  NextMethod(x)
-}
-