/
utils.R
223 lines (203 loc) · 6.22 KB
/
utils.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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
#' Check Min RStudio Version
#'
#' Return error if minimum version requirement not met.
#'
#' @param version string of min required version number
#' @export
#' @return path string to RStudio `rstudio-prefs.json` file
#' @author Daniel D. Sjoberg
#'
#' @examples
#' if (interactive()) {
#' check_min_rstudio_version()
#' }
check_min_rstudio_version <- function(version) {
if (rstudioapi::getVersion() < version) {
paste("RStudio version", version, "or greater required.") %>%
rlang::abort()
}
}
#' RStudio Config Path
#'
#' Copy of the internal function `usethis:::rstudio_config_path()`
#'
#' @param ... strings added to the RStudio config path
#'
#' @export
#' @return path string to RStudio `rstudio-prefs.json` file
#' @author Daniel D. Sjoberg
#'
#' @examples
#' if (interactive()) {
#' rstudio_config_path()
#' }
rstudio_config_path <- function(...) {
if (is_windows()) {
base <- rappdirs::user_config_dir("RStudio", appauthor = NULL)
}
else {
base <- rappdirs::user_config_dir("rstudio", os = "unix")
}
fs::path(base, ...)
}
#' Is OS Windows?
#'
#' Copy of the internal function `usethis:::is_windows()`
#'
#' @param ... no used
#'
#' @return logical
#' @keywords internal
#' @noRd
is_windows <- function(...) {
.Platform$OS.type == "windows"
}
#' Check Validity of User-passed Preferences
#'
#' Function performs some checks of the user inputs, e.g. the name of the
#' preference is checked against the table from
#' `fetch_rstudio_prefs()`...if name is not found a warning
#' message is printed. The type/class of the input is also checked against
#' the expected class (again taken from `fetch_rstudio_prefs()`)
#'
#' @param x list of user-passed preferences to update/modify
#' @keywords internal
#' @noRd
check_prefs_consistency <- function(x) {
# check for duplicate names --------------------------------------------------
if (names(x) %>% duplicated() %>% any()) {
paste(
"Duplicate preferences passed:",
paste(names(x)[names(x) %>% duplicated() %>% which()] %>% unique(),
collapse = ", ")
) %>%
rlang::abort()
}
# check for prefs not listed -------------------------------------------------
# first grab df of all prefs
df_all_prefs <- fetch_rstudio_prefs()
bad_pref_names <- names(x) %>% setdiff(df_all_prefs$property)
if (length(bad_pref_names) > 0L) {
paste(
"{.val {paste(bad_pref_names, sep = ', ')}}",
"may not be valid RStudio preference names.",
"Proceed with caution."
) %>%
cli::cli_alert_danger()
}
# check passed types ---------------------------------------------------------
purrr::iwalk(
x,
function(.x, .y) {
pref_def_list <-
df_all_prefs %>%
dplyr::filter(.data$property %in% .y) %>%
as.list()
# if pref is not found in table, move on to the next checks
if (rlang::is_empty(pref_def_list$property)) {
return(invisible(NULL))
}
# checking passed arguments against expected types
if (pref_def_list$class %in% "logical" && !rlang::is_logical(.x)) {
paste("Expecting {.field {.y}} to be type {.val logical}, but it is not.",
"Proceed with caution.") %>%
cli::cli_alert_danger()
}
else if (pref_def_list$class %in% "character" && !rlang::is_character(.x)) {
paste("Expecting {.field {.y}} to be type {.val character}, but it is not.",
"Proceed with caution.") %>%
cli::cli_alert_danger()
}
else if (pref_def_list$class %in% "integer" && !rlang::is_integerish(.x)) {
paste("Expecting {.field {.y}} to be type {.val integer}, but it is not.",
"Proceed with caution.") %>%
cli::cli_alert_danger()
}
else if (pref_def_list$class %in% "numeric" && !is.numeric(.x)) {
paste("Expecting {.field {.y}} to be type {.val numeric}, but it is not.",
"Proceed with caution.") %>%
cli::cli_alert_danger()
}
if (pref_def_list$is_scalar && length(.x) > 1) {
paste("Expecting {.field {.y}} to be length one, but it is not.",
"Proceed with caution.") %>%
cli::cli_alert_danger()
}
}
)
invisible(NULL)
}
#' Create a back-up copy of a file
#'
#' Function copies the file, and adds today's date to the end of the file name.
#'
#' @param file path and file location.
#' @param quiet logical
#' @keywords internal
#' @noRd
backup_file <- function(file, quiet = FALSE) {
# if file does not exist, print msg and skip backup
if (!fs::file_exists(file)) {
if (!quiet) {
cli::cli_alert_info("File {.val {file}} dose not exist. No backup created.")
}
return(invisible(NULL))
}
path_dir <- fs::path_dir(file)
path_ext <- paste0(".", fs::path_ext(file))
new_file_name <-
fs::path_file(file) %>% {
gsub(
pattern = path_ext,
replacement = paste0(" ", Sys.Date(), path_ext),
x = .,
fixed = TRUE
)
}
if (fs::file_exists(fs::path(path_dir, new_file_name))) {
if (!quiet) {
paste(
"Aboring backup;",
"file {.val {fs::path(path_dir, new_file_name)}} already exists."
) %>%
cli::cli_alert_danger()
}
return(invisible(NULL))
}
fs::file_copy(
path = file,
new_path = fs::path(path_dir, new_file_name),
overwrite = FALSE
)
if (!quiet) {
cli::cli_alert_success("File {.val {fs::path(path_dir, new_file_name)}} saved as backup.")
}
}
#' Write JSON file
#'
#' Simple wrapper for `jsonlite::write_json()`, where path directory is created
#' if it does not already exist. The `jsonlite::write_json()` includes arguments
#' `pretty = TRUE` and `auto_unbox = TRUE`
#'
#' @inheritParams jsonlite::write_json
#'
#' @return NULL
#' @keywords internal
#' @noRd
write_json <- function(x, path, .backup) {
# backup file if requested ---------------------------------------------------
if (isTRUE(.backup)) backup_file(path)
# if folder does not exist, create folder
if(!fs::dir_exists(fs::path_dir(path))) {
fs::dir_create(fs::path_dir(path))
}
# write JSON file
jsonlite::write_json(
x,
path = path,
pretty = TRUE,
auto_unbox = TRUE
)
cli::cli_alert_success("File {.val {path}} updated.")
cli::cli_ul("Restart RStudio for updates to take effect.")
}