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
|
#' Download snapshots from GitHub
#'
#' @description
#' If your snapshots fail on GitHub, it can be a pain to figure out exactly
#' why, or to incorporate them into your local package. This function makes it
#' easy, only requiring you to interactively select which job you want to
#' take the artifacts from.
#'
#' Note that you should not generally need to use this function manually;
#' instead copy and paste from the hint emitted on GitHub. This hint is only
#' emitted when running in a job named "R-CMD-check", since that's where the
#' testthat artifact is typically uploaded.
#'
#' @param repository Repository owner/name, e.g. `"r-lib/testthat"`.
#' @param run_id Run ID, e.g. `"47905180716"`. You can find this in the action url.
#' @param dest_dir Package root directory. Defaults to the current directory.
#' @export
snapshot_download_gh <- function(repository, run_id, dest_dir = ".") {
check_string(repository)
check_string(run_id)
check_string(dest_dir)
check_installed("gh")
dest_snaps <- file.path(dest_dir, "tests", "testthat", "_snaps")
if (!dir.exists(dest_snaps)) {
cli::cli_abort("No snapshot directory found in {.file {dest_dir}}.")
}
job_id <- gh_find_job(repository, run_id)
artifact_id <- gh_find_artifact(repository, job_id)
path <- withr::local_tempfile(pattern = "gh-snaps-")
gh_download_artifact(repository, artifact_id, path)
files <- dir(path, full.names = TRUE)
if (length(files) != 1) {
cli::cli_abort("Unexpected artifact format.")
}
inner_dir <- files[[1]]
src_snaps <- file.path(inner_dir, "tests", "testthat", "_snaps")
dir_copy(src_snaps, dest_snaps)
}
gh_find_job <- function(repository, run_id) {
jobs_json <- gh::gh(
"/repos/{repository}/actions/runs/{run_id}/jobs",
repository = repository,
run_id = run_id
)
jobs <- data.frame(
id = map_dbl(jobs_json$jobs, \(x) x$id),
name = map_chr(jobs_json$jobs, \(x) x$name)
)
jobs <- jobs[order(jobs$name), ]
idx <- utils::menu(jobs$name, title = "Which job?")
if (idx == 0) {
cli::cli_abort("Selection cancelled.")
}
jobs$id[[idx]]
}
gh_find_artifact <- function(repository, job_id) {
job_logs <- gh::gh(
"GET /repos/{repository}/actions/jobs/{job_id}/logs",
repository = repository,
job_id = job_id,
.send_headers = c("Accept" = "application/vnd.github.v3+json")
)
log_lines <- strsplit(job_logs$message, "\r?\n")[[1]]
matches <- re_match(log_lines, "Artifact download URL: (?<artifact_url>.*)")
matches <- matches[!is.na(matches$artifact_url), ]
if (nrow(matches) == 0) {
cli::cli_abort("Failed to find artifact.")
}
# Take last artifact URL; if the job has failed the previous artifact will
# be the R CMD check logs
artifact_url <- matches$artifact_url[nrow(matches)]
basename(artifact_url)
}
gh_download_artifact <- function(repository, artifact_id, path) {
zip_path <- withr::local_tempfile(pattern = "gh-zip-")
gh::gh(
"/repos/{repository}/actions/artifacts/{artifact_id}/{archive_format}",
repository = repository,
artifact_id = artifact_id,
archive_format = "zip",
.destfile = zip_path
)
utils::unzip(zip_path, exdir = path)
invisible(path)
}
# Directory helpers ------------------------------------------------------------
dir_create <- function(paths) {
for (path in paths) {
dir.create(path, recursive = TRUE, showWarnings = FALSE)
}
invisible(paths)
}
dir_copy <- function(src_dir, dst_dir) {
# First create directories
dirs <- list.dirs(src_dir, recursive = TRUE, full.names = FALSE)
dir_create(file.path(dst_dir, dirs))
# Then copy files
files <- dir(src_dir, recursive = TRUE)
src_files <- file.path(src_dir, files)
dst_files <- file.path(dst_dir, files)
same <- map_lgl(seq_along(files), \(i) {
same_file(src_files[[i]], dst_files[[i]])
})
n_new <- sum(!same)
if (n_new == 0) {
cli::cli_inform(c(i = "No new snapshots."))
} else {
cli::cli_inform(c(
v = "Copying {n_new} new snapshots: {.file {files[!same]}}."
))
}
file.copy(src_files[!same], dst_files[!same], overwrite = TRUE)
invisible()
}
same_file <- function(x, y) {
file.exists(x) && file.exists(y) && hash_file(x) == hash_file(y)
}
on_gh <- function() {
Sys.getenv("GITHUB_ACTIONS") == "true"
}
|
