-
Notifications
You must be signed in to change notification settings - Fork 46
/
Copy pathdrive_examples.R
148 lines (133 loc) · 3.92 KB
/
drive_examples.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
#' Example files
#'
#' googledrive makes a variety of example files -- both local and remote --
#' available for use in examples and reprexes. These functions help you access
#' the example files. See `vignette("example-files", package = "googledrive")`
#' for more.
#'
#' @param matches A regular expression that matches the name of the desired
#' example file(s). This argument is optional for the plural forms
#' (`drive_examples_local()` and `drive_examples_remote()`) and, if provided,
#' multiple matches are allowed. The single forms (`drive_example_local()` and
#' `drive_example_remote()`) require this argument and require that there is
#' exactly one match.
#'
#' @returns
#' * For `drive_example_local()` and `drive_examples_local()`, one or more local
#' filepaths.
#' * For `drive_example_remote()` and `drive_examples_remote()`, a `dribble`.
#' @name drive_examples
#' @examples
#' drive_examples_local() %>% basename()
#' drive_examples_local("chicken") %>% basename()
#' drive_example_local("imdb")
#'
#' @examplesIf drive_has_token()
#' drive_examples_remote()
#' drive_examples_remote("chicken")
#' drive_example_remote("chicken_doc")
NULL
#' @rdname drive_examples
#' @export
drive_examples_local <- function(matches) {
out <- many_files(
needle = matches,
haystack = local_example_files(),
where = "local"
)
out$path
}
#' @rdname drive_examples
#' @export
drive_examples_remote <- function(matches) {
many_files(
needle = matches,
haystack = remote_example_files(),
where = "remote"
)
}
#' @rdname drive_examples
#' @export
drive_example_local <- function(matches) {
out <- one_file(
needle = matches,
haystack = local_example_files(),
where = "local"
)
out$path
}
#' @rdname drive_examples
#' @export
drive_example_remote <- function(matches) {
one_file(
needle = matches,
haystack = remote_example_files(),
where = "remote"
)
}
many_files <- function(needle, haystack, where = c("local", "remote")) {
where <- match.arg(where)
out <- haystack
if (!missing(needle)) {
check_needle(needle)
sel <- grepl(needle, haystack$name, ignore.case = TRUE)
if (!any(sel)) {
drive_abort(
"Can't find a {where} example file with a name that matches \\
\"{needle}\".")
}
out <- haystack[sel, ]
}
out
}
one_file <- function(needle, haystack, where) {
out <- many_files(needle = needle, haystack = haystack, where = where)
if (nrow(out) > 1) {
drive_abort(c(
"Found multiple matching {where} files:",
bulletize(gargle_map_cli(out$name)),
i = "Make the {.arg matches} regular expression more specific."
))
}
out
}
local_example_files <- function() {
# inlining env_cache() logic, so I don't need bleeding edge rlang
if (!env_has(.googledrive, "local_example_files")) {
pths <- list.files(
system.file(
"extdata", "example_files",
package = "googledrive", mustWork = TRUE
),
full.names = TRUE
)
env_poke(
.googledrive,
"local_example_files",
tibble(name = basename(pths), path = pths)
)
}
env_get(.googledrive, "local_example_files")
}
remote_example_files <- function() {
# inlining env_cache() logic, so I don't need bleeding edge rlang
if (!env_has(.googledrive, "remote_example_files")) {
inventory_id <- "1XiwJJdoqoZ876OoSTjsnBZ5SxxUg6gUC"
if (!drive_has_token()) { # don't trigger auth just for this
local_drive_quiet()
local_deauth()
}
dat_string <- drive_read_string(as_id(inventory_id), encoding = "UTF-8")
dat <- utils::read.csv(text = dat_string, stringsAsFactors = FALSE)
env_poke(.googledrive, "remote_example_files", as_dribble(as_id(dat$id)))
}
env_get(.googledrive, "remote_example_files")
}
check_needle <- function(needle) {
if (is_string(needle)) {
return()
}
drive_abort(c(
"{.arg matches} must be a string, not {.cls class(needle)}"
))
}