-
Notifications
You must be signed in to change notification settings - Fork 58
/
Copy pathstaticimports.R
141 lines (121 loc) · 4.5 KB
/
staticimports.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
# Generated by staticimports; do not edit by hand.
# ======================================================================
# Imported from pkg:staticimports
# ======================================================================
`%||%` <- function(a, b) {
if (is.null(a)) b else a
}
# Borrowed from pkgload:::dev_meta, with some modifications.
# Returns TRUE if `pkg` was loaded with `devtools::load_all()`.
devtools_loaded <- function(pkg) {
ns <- .getNamespace(pkg)
if (is.null(ns) || is.null(ns$.__DEVTOOLS__)) {
return(FALSE)
}
TRUE
}
get_package_version <- function(pkg) {
# `utils::packageVersion()` can be slow, so first try the fast path of
# checking if the package is already loaded.
ns <- .getNamespace(pkg)
if (is.null(ns)) {
utils::packageVersion(pkg)
} else {
as.package_version(ns$.__NAMESPACE__.$spec[["version"]])
}
}
is_installed <- function(pkg, version = NULL) {
installed <- isNamespaceLoaded(pkg) || nzchar(system_file_cached(package = pkg))
if (is.null(version)) {
return(installed)
}
installed && isTRUE(get_package_version(pkg) >= version)
}
is_string <- function(x) {
is.character(x) && length(x) == 1 && !is.na(x)
}
register_upgrade_message <- function(pkg, version, error = FALSE) {
msg <- sprintf(
"This version of '%s' is designed to work with '%s' >= %s.
Please upgrade via install.packages('%s').",
environmentName(environment(register_upgrade_message)),
pkg, version, pkg
)
cond <- if (error) stop else packageStartupMessage
if (pkg %in% loadedNamespaces() && !is_installed(pkg, version)) {
cond(msg)
}
# Always register hook in case pkg is loaded at some
# point the future (or, potentially, but less commonly,
# unloaded & reloaded)
setHook(
packageEvent(pkg, "onLoad"),
function(...) {
if (!is_installed(pkg, version)) cond(msg)
}
)
}
# Borrowed from pkgload::shim_system.file, with some modifications. This behaves
# like `system.file()`, except that (1) for packages loaded with
# `devtools::load_all()`, it will return the path to files in the package's
# inst/ directory, and (2) for other packages, the directory lookup is cached.
# Also, to keep the implementation simple, it doesn't support specification of
# lib.loc or mustWork.
system_file <- function(..., package = "base") {
if (!devtools_loaded(package)) {
return(system_file_cached(..., package = package))
}
if (!is.null(names(list(...)))) {
stop("All arguments other than `package` must be unnamed.")
}
# If package was loaded with devtools (the package loaded with load_all),
# also search for files under inst/, and don't cache the results (it seems
# more likely that the package path will change during the development
# process)
pkg_path <- find.package(package)
# First look in inst/
files_inst <- file.path(pkg_path, "inst", ...)
present_inst <- file.exists(files_inst)
# For any files that weren't present in inst/, look in the base path
files_top <- file.path(pkg_path, ...)
present_top <- file.exists(files_top)
# Merge them together. Here are the different possible conditions, and the
# desired result. NULL means to drop that element from the result.
#
# files_inst: /inst/A /inst/B /inst/C /inst/D
# present_inst: T T F F
# files_top: /A /B /C /D
# present_top: T F T F
# result: /inst/A /inst/B /C NULL
#
files <- files_top
files[present_inst] <- files_inst[present_inst]
# Drop cases where not present in either location
files <- files[present_inst | present_top]
if (length(files) == 0) {
return("")
}
# Make sure backslashes are replaced with slashes on Windows
normalizePath(files, winslash = "/")
}
# A wrapper for `system.file()`, which caches the results, because
# `system.file()` can be slow. Note that because of caching, if
# `system_file_cached()` is called on a package that isn't installed, then the
# package is installed, and then `system_file_cached()` is called again, it will
# still return "".
system_file_cached <- local({
pkg_dir_cache <- character()
function(..., package = "base") {
if (!is.null(names(list(...)))) {
stop("All arguments other than `package` must be unnamed.")
}
not_cached <- is.na(match(package, names(pkg_dir_cache)))
if (not_cached) {
pkg_dir <- system.file(package = package)
pkg_dir_cache[[package]] <<- pkg_dir
} else {
pkg_dir <- pkg_dir_cache[[package]]
}
file.path(pkg_dir, ...)
}
})