/
setup.R
executable file
·387 lines (355 loc) · 13.1 KB
/
setup.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
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
if (getRversion() >= "2.15.1") utils::globalVariables(c(".", ":="))
#' Set up the projects folder
#'
#' Creates or restores the projects folder at the user-specified path.
#'
#' The \code{\link[=projects-package]{projects}} package remembers where the
#' \link[=projects_folder]{projects folder} is located by storing its file path
#' in a \link{.Renviron} file (the home .Renviron file by default). The entry is
#' named \code{PROJECTS_FOLDER_PATH}.
#'
#' Note that changing the \code{.Renviron_path} argument may create an .Renviron
#' file that R will not notice or use. See \link{Startup} for more details.
#'
#' @section Default contents: The \link[=projects_folder]{projects folder}
#' automatically contains the subdirectories \emph{.metadata} and
#' \emph{.templates}, which are hidden by default on some operating systems.
#'
#' The \emph{.metadata} folder and its contents should \strong{never} be
#' manually moved or modified.
#'
#' The \emph{.templates} folder is where template project files and folders
#' should be stored. When this function is successfully run, the default
#' projects folder template is created (as "default_folder") alongside a few
#' other template files. When a new project is created,
#' \code{\link{new_project}()} looks here for the folder named by its
#' \code{template_folder} argument (\code{"default_folder"} by default), and
#' this folder is copied into the \link[=projects_folder]{projects folder}
#' (with name specified by the \code{folder_name} argument) as the new project
#' folder. Users are able and encouraged to customize the
#' \code{default_folder} to suit their research needs, and may even create
#' multiple project folder templates for different situations.
#'
#' The default templates are in the folder located at the path produced by
#' running: \code{\link{system.file}("templates", package = "projects")}
#'
#' @section Behavior when projects folder already exists: If \code{overwrite =
#' TRUE}, the function will run no matter what. Use with caution.
#'
#' If the user has a pre-existing \link[=projects_folder]{projects folder} and
#' runs this command with the pre-existing projects folder's path, nothing
#' will be deleted.
#'
#' \strong{Therefore}, if the user "broke" the projects folder (e.g., by
#' deleting metadata; by changing the "PROJECTS_FOLDER_PATH" line in the
#' \emph{.Renviron} file), the user can "fix" the projects folder to some
#' degree by running this function with the folder's actual file path (e.g.,
#' restore all default templates; restore missing metadata files).
#'
#' @param path The file path of the \strong{directory inside of which} the user
#' would like the projects folder to be created. Do not include the name of
#' the projects folder itself (i.e., the value of the argument
#' \code{folder_name} below).
#' @param folder_name The name of the projects folder that will be created in
#' the directory specified by the argument \code{path} above. Defaults to
#' \code{"projects"}.
#' @param overwrite Logical indicating whether or not to abandon any previously
#' stored projects folders stored in the system.
#' @param make_directories Logical indicating whether or not the function should
#' write any directories specified in the \code{path} argument that don't
#' already exist.
#' @param .Renviron_path The full file path of the .Renviron file where the user
#' would like to store the \code{\link{projects_folder}()} path. Default is
#' the home .Renviron file. If the file doesn't exist it will be created.
#'
#' @examples
#' #############################################################################
#' # Setup
#' # Any existing "projects" folder is left totally untouched,
#' # and the user's home directory and .Renviron file are also left untouched.
#' old_home <- Sys.getenv("HOME")
#' old_ppath <- Sys.getenv("PROJECTS_FOLDER_PATH")
#' temp_dir <- tempfile("dir")
#' dir.create(temp_dir)
#' Sys.setenv(HOME = temp_dir)
#' Sys.unsetenv("PROJECTS_FOLDER_PATH")
#' #############################################################################
#'
#' # Creating the projects folder
#' setup_projects(path = temp_dir)
#'
#' # Viewing the projects folder path:
#' path1 <- projects_folder()
#'
#' # Viewing the contents of the projects folder:
#' list.files(path1, full.names = TRUE, recursive = TRUE, all.files = TRUE)
#'
#' # Create an arbitrary subfolder in temp_dir:
#' subfolder_path <- file.path(temp_dir, "test")
#' dir.create(subfolder_path)
#'
#'
#' # Wrapped in if (interactive()) because it requires user input
#' if (interactive()) {
#' # The function won't let the user abandon the old projects folder...
#' setup_projects(path = subfolder_path)
#'
#' # ...unless overwrite = TRUE
#' setup_projects(path = file.path(temp_dir, "test"), overwrite = TRUE)
#'
#' # Even then, only the stored location of the projects folder is overwritten.
#' # The old projects folder still exists:
#' list.files(path1, full.names = TRUE, recursive = TRUE, all.files = TRUE)
#'
#' # Giving the "projects" folder a different name:
#' setup_projects(path = temp_dir, folder_name = "studies", overwrite = TRUE)
#' }
#'
#' #############################################################################
#' # Cleanup
#' # (or, the user can just restart R)
#' Sys.setenv(HOME = old_home, PROJECTS_FOLDER_PATH = old_ppath)
#' #############################################################################
#' @return The project folder's path, invisibly.
#'
#' @seealso \code{\link{new_project}()} for information on templates
#'
#' \link{Startup} for more information on how \emph{.Renviron} files work.
#'
#' @export
setup_projects <- function(path,
folder_name = "projects",
overwrite = FALSE,
make_directories = FALSE,
.Renviron_path =
file.path(Sys.getenv("HOME"), ".Renviron")) {
folder_name <- folder_name %>%
validate_single_string(na.ok = FALSE, zero.chars.ok = FALSE)
if (folder_name != fs::path_sanitize(folder_name)) {
stop(
"\nThe folder_name:\n",
folder_name,
"\ncontains invalid characters for a folder name."
)
}
path <- path %>%
validate_directory(p_path = NULL, make_directories = make_directories) %>%
fs::path(folder_name)
old_path <- Sys.getenv("PROJECTS_FOLDER_PATH")
# If overwite = TRUE, function will run no matter what, overwriting any
# pre-existing value of PROJECTS_FOLDER_PATH in the home .Renviron file.
#
# If overwrite = FALSE, function will still run UNLESS a
# PROJECTS_FOLDER_PATH value already exists and does not match up with the
# user-specified path.
if (old_path != "" && old_path != path && !overwrite) {
message(
"\nThe environment variable PROJECTS_FOLDER_PATH indicates",
'\nthat a "projects" folder already exists at:\n',
old_path,
'\n\nRerun with that path OR set overwrite = TRUE'
)
return(invisible(old_path))
}
if (validate_Renviron(.Renviron_path)) {
if (old_path != "" && old_path != path) {
user_prompt(
msg =
paste0(
"\nThe environment variable PROJECTS_FOLDER_PATH indicates",
"\nthat a projects folder already exists at:\n",
old_path,
"\n\nAre you sure you want to create a new one at:\n",
path,
"\n\nand put the line:\nPROJECTS_FOLDER_PATH='",
path,
"'\n\nin the .Renviron file at:\n",
.Renviron_path,
"\n\n? (y/n)"
),
n_msg = paste0("\nProjects folder remains at\n", old_path)
)
}
set_Renviron(path, .Renviron_path)
} else if (old_path != path && old_path != "") {
user_prompt(
msg =
paste0(
"\nThe environment variable PROJECTS_FOLDER_PATH indicates",
"\nthat a projects folder already exists at:\n",
old_path,
"\n\nAre you sure you want to create a new one at:\n",
path,
"\n\n? (y/n)"
),
n_msg = paste0("\nProjects folder remains at\n", old_path)
)
}
create_projects_folder(path)
setup_messages(path, old_path)
invisible(path)
}
set_Renviron <- function(projects_folder_path, .Renviron_path) {
# If a home .Renviron file already exists, it is overwritten with its original
# contents, minus any old values of PROJECTS_FOLDER_PATH, plus the new value
# of PROJECTS_FOLDER_PATH.
Renviron_entries <-
c(
if (fs::file_exists(.Renviron_path)) {
grep(
pattern = "^PROJECTS_FOLDER_PATH",
x = readr::read_lines(.Renviron_path),
value = TRUE,
invert = TRUE
)
},
paste0(
"PROJECTS_FOLDER_PATH='",
gsub(projects_folder_path, pattern = "'", replacement = "\\\\'"),
"'"
)
)
readr::write_lines(Renviron_entries, .Renviron_path)
Sys.setenv(PROJECTS_FOLDER_PATH = projects_folder_path)
}
create_projects_folder <- function(projects_folder_path) {
fs::dir_create(fs::path(projects_folder_path, ".metadata"))
fs::dir_create(
fs::path(
projects_folder_path,
".templates/default_folder",
c("data", "data_raw", "progs", "figures", "manuscript")
)
)
restore_templates(projects_folder_path)
restore_metadata(projects_folder_path)
}
restore_templates <- function(projects_folder_path) {
purrr::pwalk(
.l =
list(
template_name =
c(
"CONSORT_protocol.Rmd",
"STROBE_protocol.Rmd",
"pXXXX.Rproj",
"01_protocol.Rmd",
"02_datawork.Rmd",
"03_analysis.Rmd",
"04_report.Rmd",
"style.css",
"styles.docx",
"citations.bib"
),
template_source =
c(
"CONSORT_protocol.Rmd",
"STROBE_protocol.Rmd",
"pXXXX.Rproj",
"STROBE_protocol.Rmd",
"02_datawork.Rmd",
"03_analysis.Rmd",
"04_report.Rmd",
"style.css",
"styles.docx",
"citations.bib"
),
subfolder =
c(
"",
"",
"default_folder",
"default_folder/progs",
"default_folder/progs",
"default_folder/progs",
"default_folder/progs",
"default_folder/progs",
"default_folder/progs",
"default_folder/progs"
)
),
.f =
function(template_name, template_source, subfolder) {
template_path <-
fs::path(projects_folder_path, ".templates", subfolder, template_name)
if (!fs::file_exists(template_path)) {
template_source <-
system.file(
"templates",
template_source,
package = "projects",
mustWork = TRUE
)
fs::file_copy(template_source, template_path)
}
}
)
}
restore_metadata <- function(path) {
purrr::walk2(
.x = c("projects", "authors", "affiliations",
"project_author_assoc", "author_affiliation_assoc"),
.y = list(
# projects
tibble::tibble(
id = integer(),
title = character(),
short_title = character(),
current_owner = new_projects_author(),
status = character(),
deadline_type = character(),
deadline = lubridate::as_datetime(character()),
stage = new_projects_stage(),
path = character(),
corresp_auth = new_projects_author(),
creator = new_projects_author()
),
# authors
tibble::tibble(
id = integer(),
last_name = character(),
given_names = character(),
title = character(),
degree = character(),
email = character(),
phone = character()
),
# affiliations
tibble::tibble(
id = integer(),
department_name = character(),
institution_name = character(),
address = character()),
# project_author_assoc
tibble::tibble(id1 = integer(), id2 = integer()),
# author_affiliation_assoc
tibble::tibble(id1 = integer(), id2 = integer())),
.f =
function(rds_name, tibble) {
rds_path <- make_rds_path(rds_name, path)
if (fs::file_exists(rds_path)) {
tibble <- vec_rbind(readRDS(rds_path), tibble)
}
readr::write_rds(tibble, rds_path)
}
)
}
setup_messages <- function(projects_folder_path, old_path) {
if (old_path == "") {
message(
'projects folder created at\n', projects_folder_path,
'\n\nAdd affiliations with new_affiliation(),',
'\nthen add authors with new_author(),',
'\nthen create projects with new_project()'
)
}
else if (old_path == projects_folder_path) {
message('projects folder restored at\n', projects_folder_path)
}
else {
message(
'projects folder is now at\n', projects_folder_path,
'\n\nThe projects folder at\n', old_path, '\nhas been abandoned.'
)
}
}