-
-
Notifications
You must be signed in to change notification settings - Fork 26
/
utils-git.R
349 lines (328 loc) · 13.3 KB
/
utils-git.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
has_git <- function() {
Sys.which("git") != ""
}
# Shamelessly stolen from {pkgdown}, originally authored by Hadley Wickam
git <- function (..., echo_cmd = TRUE, echo = TRUE, error_on_status = TRUE) {
if (!has_git()) stop(cli::format_error("{.pkg git} is not installed"), call. = FALSE)
callr::run("git", c(...), echo_cmd = echo_cmd, echo = echo,
error_on_status = error_on_status)
}
# check if a remote branch exists
# originally authored by Hadley Wickham
git_has_remote_branch <- function (remote, branch) {
git(
"ls-remote", "--quiet", "--exit-code", remote, branch,
echo = FALSE, echo_cmd = FALSE, error_on_status = FALSE
)$status == 0
}
git_fetch_one_branch <- function(remote, branch, repo = ".") {
# NOTE: We only want to fetch ONE branch and ONE branch, only. We apparently
# cannot do this by specifying a refspec for fetch, but we _can_ temporarily
# modify the refspec for for the repo.
# https://stackoverflow.com/a/62264058/2752888
git("remote", "set-branches", remote, branch)
on.exit({
# https://stackoverflow.com/a/47726250/2752888
git("remote", "set-branches", remote, "*")
})
git("fetch", remote, branch)
}
git_clean_everything <- function(repo = ".") {
withr::with_dir(repo, {
tryCatch(git("rm", "-rf", "--quiet", "."), error = function(e) NULL)
})
}
#
# Modified from pkgdown::deploy_to_branch() by Hadley Wickham
#' Setup a git worktree for concurrent manipulation of a separate branch
#'
#' @param path path to the repository
#' @param dest_dir path to the destination directory to contain the work tree
#' @param branch the branch associated with the work tree (default: gh-pages)
#' @param remote the remote name (default: origin)
#' @param throwaway if `TRUE`, the worktree created is in a detached HEAD state
#' from from the remote branch and will not create a new branch in your
#' repository. Defaults to `FALSE`, which will create the branch from upstream.
#' @return an [expression()] that calls `git worktree remove` on the worktree
#' when evaluated.
#' @details
#'
#' This function is used in continuous integration settings where we want to
#' push derived outputs to non-main branches in our repository. We use this to
#' populate the markdown and HTML outputs from the lesson so that we don't have
#' to rebuild the lesson from scratch every time.
#'
#' The logic behind this looks like
#'
#' ```
#' worktree setup
#' [IF BRANCH DOES NOT EXIST]
#' git checkout --orphan <branch>
#' git rm -rf --quiet .
#' git commit --allow-empty -m
#' git push remote HEAD:<branch>
#' git checkout -
#' git fetch <remote> +refs/heads/<branch>:refs/remotes/<remote>/<branch>
#' git worktree add --track -B <branch> /path/to/dir <remote>/<branch>
#' ```
#'
#' @note `git_worktree_setup()` has been modified from the logic in
#' [pkgdown::deploy_to_branch()], by Hadley Wickham.
#'
#' @keywords internal
#' @rdname git_worktree
#' @examplesIf sandpaper:::example_can_run()
#' # Use Worktrees to deploy a lesson -----------------------------------------
#' # This example is a bit inovlved, but it is effectively what we do inside of
#' # the `ci_deploy()` function (after setting up the lesson).
#' #
#' # The setup phase will create a new lesson and a corresponding remote (self
#' # contained, no GitHub authentication required).
#' #
#' # The worktrees will be created for both the markdown and HTML outputs on the
#' # branches "md-outputs" and "gh-pages", respectively.
#' #
#' # After the worktrees are created, we will build the lesson into the
#' # worktrees and display the output of `git_status()` for each of the three
#' # branches: "main", "md-outputs", and "gh-pages"
#' #
#' # During the clean up phase, the output of `git_worktree_setup()` is
#' # evaluated
#' tik <- Sys.time()
#' cli::cli_h1("Set up")
#' cli::cli_h2("Create Lesson")
#' restore_fixture <- sandpaper:::create_test_lesson()
#' res <- getOption("sandpaper.test_fixture")
#' sandpaper:::check_git_user(res)
#' cli::cli_h2("Create Remote")
#' rmt <- fs::file_temp(pattern = "REMOTE-")
#' sandpaper:::setup_local_remote(repo = res, remote = rmt, verbose = FALSE)
#' tok <- Sys.time()
#' cli::cli_alert_info("Elapsed time: {round(tok - tik, 2)} seconds")
#' tik <- Sys.time()
#' cli::cli_h2("Create Worktrees")
#' db <- sandpaper:::git_worktree_setup(res, fs::path(res, "site", "built"),
#' branch = "md-outputs", remote = "sandpaper-local"
#' )
#' ds <- sandpaper:::git_worktree_setup(res, fs::path(res, "site", "docs"),
#' branch = "gh-pages", remote = "sandpaper-local"
#' )
#' tok <- Sys.time()
#' cli::cli_alert_info("Elapsed time: {round(tok - tik, 2)} seconds")
#' tik <- Sys.time()
#' cli::cli_h1("Build Lesson into worktrees")
#' build_lesson(res, quiet = TRUE, preview = FALSE)
#' cli::cli_h2("git status: {gert::git_branch(repo = res)}")
#' print(gert::git_status(repo = res))
#' cli::cli_h2('git status: {gert::git_branch(repo = fs::path(res, "site", "built"))}')
#' print(gert::git_status(repo = fs::path(res, "site", "built")))
#' cli::cli_h2('git status: {gert::git_branch(repo = fs::path(res, "site", "docs"))}')
#' print(gert::git_status(repo = fs::path(res, "site", "docs")))
#' tok <- Sys.time()
#' cli::cli_alert_info("Elapsed time: {round(tok - tik, 2)} seconds")
#' tik <- Sys.time()
#' cli::cli_h1("Clean Up")
#' cli::cli_alert_info("object db is an expression that evaluates to {.code {db}}")
#' eval(db)
#' cli::cli_alert_info("object ds is an expression that evaluates to {.code {ds}}")
#' eval(ds)
#' sandpaper:::remove_local_remote(repo = res)
#' sandpaper:::reset_git_user(res)
#' # remove the test fixture and report
#' tryCatch(fs::dir_delete(res), error = function() FALSE)
#' tok <- Sys.time()
#' cli::cli_alert_info("Elapsed time: {round(tok - tik, 2)} seconds")
git_worktree_setup <- function (path = ".", dest_dir, branch = "gh-pages", remote = "origin", throwaway = FALSE) {
if (!has_git() || !requireNamespace("withr", quietly = TRUE)) {
stop(cli::format_error("{.fn git_worktree_setup} requires {.pkg git} and {.pkg withr}"), call. = FALSE)
}
withr::with_dir(path, {
no_branch <- !git_has_remote_branch(remote, branch)
# create the branch if it doesn't exist
if (no_branch) {
ci_group("Create New Branch")
old_branch <- gert::git_branch(repo = path)
git("checkout", "--orphan", branch)
git("rm", "-rf", "--quiet", ".")
git("commit", "--allow-empty", "-m",
sprintf("Initializing %s branch", branch)
)
git("push", remote, paste0("HEAD:", branch))
git("checkout", old_branch)
cli::cat_line("::endgroup::")
}
ci_group(glue::glue("Fetch {remote}/{branch}"))
git_fetch_one_branch(remote, branch, repo = path)
cli::cat_line("::endgroup::")
ci_group(glue::glue("Add worktree for {remote}/{branch} in site/{fs::path_file(dest_dir)}"))
github_worktree_add(dest_dir, remote, branch, throwaway)
cli::cat_line("::endgroup::")
})
# This allows me to evaluate this expression at the top of the calling
# function.
parse(text = glue::glue("sandpaper:::github_worktree_remove('{dest_dir}', '{path}')"))
}
# Add a branch to a folder as a worktree
# originally authored by Hadley Wickham
github_worktree_add <- function (dir, remote, branch, throwaway = FALSE) {
if (throwaway) {
the_tree <- c("--detach", dir)
} else {
the_tree <- c("--track", "-B", branch, dir)
}
git("worktree", "add", the_tree, paste0(remote, "/", branch))
}
#' @rdname git_worktree
#' @note
#' `github_worktree_commit()`: Modified from `pkgdown:::github_push` by Hadley
#' Wickham
github_worktree_commit <- function (dir, commit_message, remote, branch) {
force(commit_message)
if (requireNamespace("cli", quietly = TRUE))
cli::rule("Committing", line = "c")
# ZNK: add explicit check for withr
if (!requireNamespace("withr", quietly = TRUE))
stop("withr must be installed")
withr::with_dir(dir, {
# ZNK: Change to gert::git_add(); only commit if we have something to add
added <- gert::git_add(".", repo = dir)
if (nrow(added) == 0) {
message(glue::glue("nothing to commit on {branch}!"))
return(NULL)
}
git("commit", "--allow-empty", "-m", commit_message)
cli::rule("Deploying", line = 1)
git("remote", "-v")
git("push", "--force", remote, paste0("HEAD:", branch))
})
}
#' @rdname git_worktree
#' @note
#' `github_worktree_remove()`: Modified from `pkgdown:::github_worktree_remove`
#' by Hadley Wickham
github_worktree_remove <- function (dir, home = NULL) {
if (requireNamespace("cli", quietly = TRUE))
cli::rule("Removing worktree", line = "-")
# ZNK: add --force
if (is.null(home)) home <- root_path(dir)
if (requireNamespace("withr", quietly = TRUE)) {
withr::with_dir(home, git("worktree", "remove", "--force", dir))
}
}
# Generate a commit message that includes information about the source of the
# build.
message_source <- function(commit_message = "", source_branch = "main", dir = ".") {
log <- gert::git_log(ref = source_branch, max = 1L, repo = dir)
paste0(commit_message,
"\n",
"\nAuto-generated via {sandpaper}\n",
"Source : ", log$commit, "\n",
"Branch : ", source_branch, "\n",
"Author : ", log$author, "\n",
"Time : ", UTC_timestamp(log$time), "\n",
"Message : ", log$message
)
}
# NOTE: I believe this should work, but for now, I think the variables should be
# explicitly named in the YAML:
#
# - name: "Generate Artifacts"
# id: generate-artifacts
# run: |
# sandpaper:::ci_bundle_pr_artifacts(
# repo = '${{ github.repository }}',
# pr_number = '${{ github.event.number }}',
# path_md = '${{ env.MD }}',
# path_pr = '${{ env.PR }}',
# path_archive = '${{ env.CHIVE }}',
# branch = "md-outputs"
# )
# shell: Rscript {0}
ci_bundle_pr_artifacts <- function(repo, pr_number,
path_md, path_archive, path_pr,
branch = "md-outputs") {
if (!fs::dir_exists(path_archive)) fs::dir_create(path_archive)
if (!fs::dir_exists(path_pr)) fs::dir_create(path_pr)
writeLines(pr_number, fs::path(path_pr, "NR"))
if (!requireNamespace("withr", quietly = TRUE))
stop("withr must be installed")
withr::with_dir(path_md, {
git("add", "-A", ".", echo_cmd = FALSE, echo = FALSE)
difflist <- git("diff", "--staged", "--compact-summary",
echo = FALSE, echo_cmd = FALSE)$stdout
github_url <- glue::glue("https://github.com/{repo}/compare/")
reality <- glue::glue("{github_url}{branch}")
possibility <- glue::glue("{branch}-PR-{pr_number}")
# Comparing commit-ish chunks on GitHub can use either two dot or three dot
#
# Three dot: compare changes that happened _in that instant_
# Two dot: compare the changes between the branches as they exist today.
#
# https://docs.github.com/en/github/collaborating-with-pull-requests/proposing-changes-to-your-work-with-pull-requests/about-comparing-branches-in-pull-requests#three-dot-and-two-dot-git-diff-comparisons
#
# I was using the two-dot method because that's the only thing I learned,
# but it can be really overwhelming if there are rapid changes. This way,
# only the relevant changes are shown (unless there is a conflict).
copy_template("pr_diff", path_archive, "diff.md",
values = list(
reality = reality,
possibility = possibility,
summary_of_differences = trimws(difflist, which = "right"),
update_time = UTC_timestamp(Sys.time()),
NULL
)
)
if (fs::is_dir(".git")) fs::dir_delete(".git")
})
}
# If the git user is not set, we set a temporary one, note that this is paired
# with reset_git_user()
check_git_user <- function(path, name = "carpenter", email = "team@carpentries.org") {
if (!gert::user_is_configured(path)) {
gert::git_config_set("user.name", name, repo = path)
gert::git_config_set("user.email", email, repo = path)
}
}
# It's clear that we cannot rely on folks having the correct libgit2 version,
# so the way we enforce the main branch is to do it after we make the initial
# commit like so:
#
# 1. create a new branch called "main"
# 2. change "master" to "main" in .git/HEAD (txt file)
# 3. delete "master" branch
#
# If the user HAS set a default branch, we will use that one.
enforce_main_branch <- function(path) {
current <- gert::git_branch(path)
default <- get_default_branch()
if (current != "master") {
# the user set up their init.defaultBranch correctly
return(path)
}
# Create and move to main branch
gert::git_branch_create(default, repo = path)
# modify .git/HEAD file
HFILE <- file.path(path, ".git", "HEAD")
HEAD <- readLines(HFILE, encoding = "UTF-8")
writeLines(sub("master", default, HEAD), HFILE)
# remove master
gert::git_branch_delete("master", repo = path)
}
get_default_branch <- function() {
cfg <- gert::git_config_global()
default <- cfg$value[cfg$name == "init.defaultbranch"]
invalid <- length(default) == 0 || default == "master"
if (invalid) "main" else default
}
# This checks if we have set a temporary git user and then unsets it. It will
# supriously unset a user if they happened to have
# "carpenter <team@carpentries.org>" as their email.
reset_git_user <- function(path) {
cfg <- gert::git_config(path)
it_me <- cfg$value[cfg$name == "user.name"] == "carpenter" &&
cfg$value[cfg$name == "user.email"] == "team@carpentries.org"
if (gert::user_is_configured(path) && it_me) {
gert::git_config_set("user.name", NULL, repo = path)
gert::git_config_set("user.email", NULL, repo = path)
}
}