r-lib / pkgconfig
1

2
## This is the environment that stores all parameters
3

4
config <- new.env()
5

6
## ----------------------------------------------------------------------
7

8
#' Query a configuration parameter key
9
#'
10
#' Query a configuration parameter key, and return the value
11
#' set in the calling package(s).
12
#'
13
#' @details
14
#' This function is meant to be called from the package whose
15
#' behavior depends on it. It searches for the given configuration
16
#' key, and if it exists, it checks which package(s) it was called
17
#' from and returns the configuration setting for that package.
18
#'
19
#' If the key is not set in any calling package, but it is set in
20
#' the global environment (i.e. at the R prompt), then it returns that
21
#' setting.
22
#'
23
#' If the key is not set anywhere, then it returns \code{NULL}.
24
#'
25
#' @param key The name of the parameter to query.
26
#' @param fallback Fallback if the parameter id not found anywhere.
27
#' @return The value of the parameter, or the fallback value if not found.
28
#'
29
#' @export
30

31
get_config <- function(key, fallback = NULL) {
32 2
  result <- get_from_session(key)
33 2
  if (is.null(result)) fallback else result[[1]]
34
}
35

36
get_from_session <- function(key) {
37 2
  value <- config[[key]]
38 2
  if (is.null(value)) return(NULL)
39

40 2
  pkgs <- sys.frames()
41 2
  pkgs <- lapply(pkgs, parent.env)
42 2
  pkgs <- Filter(pkgs, f = isNamespace)
43 2
  pkgs <- vapply(pkgs, environmentName, "")
44 2
  pkgs <- unique(pkgs)
45

46 2
  for (p in rev(pkgs)) {
47 2
    if (p %in% names(value)) return(value[p])
48
  }
49

50 2
  if ("R_GlobalEnv" %in% names(value)) {
51 2
    return(value["R_GlobalEnv"])
52
  }
53

54 2
  NULL
55
}
56

57
## ----------------------------------------------------------------------
58

59
#' Set a configuration parameter
60
#'
61
#' Set a configuration parameter, for the package we are calling from.
62
#' If called from the R prompt and not from a package, then it sets
63
#' the parameter for global environment.
64
#'
65
#' @param ... Parameters to set, they should be all named.
66
#' @return Nothing.
67
#'
68
#' @export
69
#' @seealso \code{\link{set_config_in}}
70

71
set_config <- function(...) {
72 2
  set_config_in(..., .in = parent.frame())
73
}
74

75
check_named_args <- function(...) {
76 2
  nn <- names(list(...))
77 2
  if (is.null(nn) || any(nn == "")) {
78 2
    stop("Some parameters are not named")
79
  }
80
}
81

82
#' Set a configuration parameter for a package
83
#'
84
#' This is a more flexible variant of \code{link{set_config}},
85
#' and it allows creating an custom API in the package that
86
#' uses \code{pkgconfig} for its configuration.
87
#'
88
#' @details
89
#' This function is identical to \code{\link{set_config}}, but it allows
90
#' supplying the environment that is used as the package the configuration
91
#' is set for. This makes it possible to create an API for setting
92
#' (and getting) configuration parameters.
93
#'
94
#' @param ... Parameters to set, they should be all named.
95
#' @param .in An environment, typically belonging to a package.
96
#' @return Nothing.
97
#'
98
#' @export
99
#' @seealso \code{\link{set_config}}
100
#' @importFrom utils packageName
101

102
set_config_in <- function(..., .in = parent.frame()) {
103 2
  check_named_args(...)
104 2
  who <- packageName(env = .in) %||% "R_GlobalEnv"
105 2
  set_config_session(who = who, ...)
106
}
107

108
set_config_session <- function(who, ...) {
109 2
  l <- list(...)
110 2
  for (n in names(l)) {
111 2
    key <- config[[n]] %||% list()
112 2
    key[[who]] <- l[[n]]
113 2
    config[[n]] <- key
114
  }
115
}

Read our documentation on viewing source code .

Loading