-
Notifications
You must be signed in to change notification settings - Fork 12
/
cassettes.R
134 lines (120 loc) · 3.72 KB
/
cassettes.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
#' List cassettes, get current cassette, etc.
#'
#' @export
#' @param on_disk (logical) Check for cassettes on disk + cassettes in session
#' (`TRUE`), or check for only cassettes in session (`FALSE`). Default: `TRUE`
#' @param verb (logical) verbose messages
#' @details
#'
#' - `cassettes()`: returns cassettes found in your R session, you can toggle
#' whether we pull from those on disk or not
#' - `current_cassette()`: returns an empty list when no cassettes are in use,
#' while it returns the current cassette (a `Cassette` object) when one is
#' in use
#' - `cassette_path()`: just gives you the current directory path where
#' cassettes will be stored
#'
#' @examples
#' vcr_configure(dir = tempdir())
#'
#' # list all cassettes
#' cassettes()
#' cassettes(on_disk = FALSE)
#'
#' # list the currently active cassette
#' insert_cassette("stuffthings")
#' current_cassette()
#' eject_cassette()
#'
#' cassettes()
#' cassettes(on_disk = FALSE)
#'
#' # list the path to cassettes
#' cassette_path()
#' vcr_configure(dir = file.path(tempdir(), "foo"))
#' cassette_path()
#'
#' vcr_configure_reset()
cassettes <- function(on_disk = TRUE, verb = FALSE){
# combine cassettes on disk with cassettes in session
if (on_disk) {
out <- unlist(list(
lapply(get_cassette_data_paths(), read_cassette_meta, verbose = verb),
cassettes_session()
), FALSE)
out[!duplicated(names(out))]
} else {
cassettes_session()
}
}
#' @export
#' @rdname cassettes
current_cassette <- function() {
tmp <- last(cassettes(FALSE))
if (length(tmp) == 0) return(list())
tmp <- if (length(tmp) == 1) tmp[[1]] else tmp
return(tmp)
}
#' @export
#' @rdname cassettes
cassette_path <- function() vcr_c$dir
cassette_exists <- function(x) x %in% get_cassette_names()
read_cassette_meta <- function(x, verbose = TRUE, ...){
tmp <- yaml::yaml.load_file(x, ...)
if (!inherits(tmp, "list") | !"http_interactions" %in% names(tmp)) {
if (verbose) message(x, " not found, missing data, or malformed")
return(list())
} else {
structure(tmp$http_interactions[[1]], class = "cassette")
}
}
get_cassette_meta_paths <- function(){
metafiles <- names(grep("metadata", vapply(cassette_files(), basename, ""),
value = TRUE))
as.list(stats::setNames(metafiles, unname(sapply(metafiles, function(x)
yaml::yaml.load_file(x)$name))))
}
cassette_files <- function(){
path <- path.expand(cassette_path())
check_create_path(path)
list.files(path, full.names = TRUE)
}
get_cassette_path <- function(x){
if ( x %in% get_cassette_names() ) get_cassette_data_paths()[[x]]
}
is_path <- function(x) file.exists(path.expand(x))
get_cassette_names <- function(){
tmp <- vcr_files()
if (length(tmp) == 0) return("")
sub("\\.yml|\\.yaml|\\.json", "", basename(tmp))
}
vcr_files <- function() {
# remove some file types
files <- names(grep("metadata|rs-graphics|_pkgdown|travis|appveyor",
vapply(cassette_files(), basename, ""),
invert = TRUE, value = TRUE))
# include only certain file types
tokeep <- switch(vcr_c$serialize_with, yaml = "yml|yaml", json = "json")
names(grep(tokeep, vapply(cassette_files(), basename, ""),
value = TRUE))
}
get_cassette_data_paths <- function() {
files <- vcr_files()
if (length(files) == 0) return(list())
as.list(stats::setNames(files, get_cassette_names()))
}
check_create_path <- function(x){
if (file.exists(x)) dir.create(x, recursive = TRUE, showWarnings = FALSE)
}
cassettes_session <- function(x) {
xx <- ls(envir = vcr_cassettes)
if (length(xx) > 0) {
stats::setNames(lapply(xx, get, envir = vcr_cassettes), xx)
} else {
list()
}
}
include_cassette <- function(cassette) {
# assign cassette to bucket of cassettes in session
assign(cassette$name, cassette, envir = vcr_cassettes)
}