1# gert -------------------------------------------------------------------------
2
3gert_shush <- function(expr, regexp) {
4  stopifnot(is.character(regexp))
5  withCallingHandlers(
6    gertMessage = function(cnd) {
7      m <- map_lgl(regexp, ~ grepl(.x, cnd_message(cnd), perl = TRUE))
8      if (any(m)) {
9        cnd_muffle(cnd)
10      }
11    },
12    expr
13  )
14}
15
16# Repository -------------------------------------------------------------------
17git_repo <- function() {
18  check_uses_git()
19  proj_get()
20}
21
22uses_git <- function() {
23  repo <- tryCatch(
24    gert::git_find(proj_get()),
25    error = function(e) NULL
26  )
27  !is.null(repo)
28}
29
30check_uses_git <- function() {
31  if (uses_git()) {
32    return(invisible())
33  }
34
35  ui_stop(c(
36    "Cannot detect that project is already a Git repository.",
37    "Do you need to run {ui_code('use_git()')}?"
38  ))
39}
40
41git_init <- function() {
42  gert::git_init(proj_get())
43}
44
45# Config -----------------------------------------------------------------------
46
47# `where = "de_facto"` means look at the values that are "in force", i.e. where
48# local repo variables override global user-level variables, when both are
49# defined
50#
51# `where = "local"` is strict, i.e. it only returns a value that is in the local
52# config
53git_cfg_get <- function(name, where = c("de_facto", "local", "global")) {
54  where <- match.arg(where)
55  if (where == "global" || !uses_git()) {
56    dat <- gert::git_config_global()
57  } else {
58    dat <- gert::git_config(repo = git_repo())
59  }
60  if (where == "local") {
61    dat <- dat[dat$level == "local", ]
62  }
63  out <- dat$value[dat$name == name]
64  if (length(out) > 0) out else NULL
65}
66
67# Status------------------------------------------------------------------------
68git_status <- function(untracked) {
69  stopifnot(is_true(untracked) || is_false(untracked))
70  st <- gert::git_status(repo = git_repo())
71  if (!untracked) {
72    st <- st[st$status != "new", ]
73  }
74  st
75}
76
77# Commit -----------------------------------------------------------------------
78git_ask_commit <- function(message, untracked, paths = NULL) {
79  if (!is_interactive() || !uses_git()) {
80    return(invisible())
81  }
82
83  # this is defined here to encourage all commits to route through this function
84  git_commit <- function(paths, message) {
85    repo <- git_repo()
86    ui_done("Adding files")
87    gert::git_add(paths, repo = repo)
88    ui_done("Making a commit with message {ui_value(message)}")
89    gert::git_commit(message, repo = repo)
90  }
91
92  uncommitted <- git_status(untracked)$file
93  if (is.null(paths)) {
94    paths <- uncommitted
95  } else {
96    paths <- intersect(paths, uncommitted)
97  }
98  n <- length(paths)
99  if (n == 0) {
100    return(invisible())
101  }
102
103  paths <- sort(paths)
104  ui_paths <- map_chr(paths, ui_path)
105  if (n > 10) {
106    ui_paths <- c(ui_paths[1:10], "...")
107  }
108
109  if (n == 1) {
110    file_hint <- "There is 1 uncommitted file:"
111  } else {
112    file_hint <- "There are {n} uncommitted files:"
113  }
114  ui_line(c(
115    file_hint,
116    paste0("* ", ui_paths)
117  ))
118
119  if (ui_yeah("Is it ok to commit {if (n == 1) 'it' else 'them'}?")) {
120    git_commit(paths, message)
121  }
122  invisible()
123}
124
125git_uncommitted <- function(untracked = FALSE) {
126  nrow(git_status(untracked)) > 0
127}
128
129challenge_uncommitted_changes <- function(untracked = FALSE, msg = NULL) {
130  if (!uses_git()) {
131    return(invisible())
132  }
133
134  if (rstudioapi::hasFun("documentSaveAll")) {
135    rstudioapi::documentSaveAll()
136  }
137
138  default_msg <- "
139    There are uncommitted changes, which may cause problems or be lost when \\
140    we push, pull, switch, or compare branches"
141  msg <- glue(msg %||% default_msg)
142  if (git_uncommitted(untracked = untracked)) {
143    if (ui_yeah("{msg}\nDo you want to proceed anyway?")) {
144      return(invisible())
145    } else {
146      ui_stop("Uncommitted changes. Please commit before continuing.")
147    }
148  }
149}
150
151git_conflict_report <- function() {
152  st <- git_status(untracked = FALSE)
153  conflicted <- st$file[st$status == "conflicted"]
154  n <- length(conflicted)
155  if (n == 0) {
156    return(invisible())
157  }
158
159  conflicted_paths <- map_chr(conflicted, ui_path)
160  ui_line(c(
161    "There are {n} conflicted files:",
162    paste0("* ", conflicted_paths)
163  ))
164
165  msg <- glue("
166    Are you ready to sort this out?
167    If so, we will open the conflicted files for you to edit.")
168  yes <- "Yes, I'm ready to resolve the merge conflicts."
169  no <- "No, I want to abort this merge."
170  if (ui_yeah(msg, yes = yes, no = no, shuffle = FALSE)) {
171    ui_silence(purrr::walk(conflicted, edit_file))
172    ui_stop("
173      Please fix each conflict, save, stage, and commit.
174      To back out of this merge, run {ui_code('gert::git_merge_abort()')} \\
175      (in R) or {ui_code('git merge --abort')} (in the shell).")
176  } else {
177    gert::git_merge_abort(repo = git_repo())
178    ui_stop("Abandoning the merge, since it will cause merge conflicts")
179  }
180}
181
182# Remotes ----------------------------------------------------------------------
183## remref --> remote, branch
184git_parse_remref <- function(remref) {
185  regex <- paste0("^", names(git_remotes()), collapse = "|")
186  regex <- glue("({regex})/(.*)")
187  list(remote = sub(regex, "\\1", remref), branch = sub(regex, "\\2", remref))
188}
189
190remref_remote <- function(remref) git_parse_remref(remref)$remote
191remref_branch <- function(remref) git_parse_remref(remref)$branch
192
193# Pull -------------------------------------------------------------------------
194# Pull from remref or upstream tracking. If neither given/exists, do nothing.
195# Therefore, this does less than `git pull`.
196git_pull <- function(remref = NULL, verbose = TRUE) {
197  repo <- git_repo()
198  branch <- git_branch()
199  remref <- remref %||% git_branch_tracking(branch)
200  if (is.na(remref)) {
201    if (verbose) {
202      ui_done("No remote branch to pull from for {ui_value(branch)}")
203    }
204    return(invisible())
205  }
206  stopifnot(is_string(remref))
207  if (verbose) {
208    ui_done("Pulling from {ui_value(remref)}")
209  }
210  gert::git_fetch(
211    remote = remref_remote(remref),
212    refspec = remref_branch(remref),
213    repo = repo,
214    verbose = FALSE
215  )
216  # this is pretty brittle, because I've hard-wired these messages
217  # https://github.com/r-lib/gert/blob/master/R/merge.R
218  # but at time of writing, git_merge() offers no verbosity control
219  gert_shush(
220    regexp = c(
221      "Already up to date, nothing to merge",
222      "Performing fast-forward merge, no commit needed"
223    ),
224    gert::git_merge(remref, repo = repo)
225  )
226  st <- git_status(untracked = TRUE)
227  if (any(st$status == "conflicted")) {
228    git_conflict_report()
229  }
230
231  invisible()
232}
233
234# Branch ------------------------------------------------------------------
235git_branch <- function() {
236  info <- gert::git_info(repo = git_repo())
237  branch <- info$shorthand
238  if (identical(branch, "HEAD")) {
239    ui_stop("Detached head; can't continue")
240  }
241  if (is.na(branch)) {
242    ui_stop("On an unborn branch -- do you need to make an initial commit?")
243  }
244  branch
245}
246
247git_branch_tracking <- function(branch = git_branch()) {
248  repo <- git_repo()
249  if (!gert::git_branch_exists(branch, local = TRUE, repo = repo)) {
250    ui_stop("There is no local branch named {ui_value(branch)}")
251  }
252  gbl <- gert::git_branch_list(local = TRUE, repo = repo)
253  sub("^refs/remotes/", "", gbl$upstream[gbl$name == branch])
254}
255
256git_branch_compare <- function(branch = git_branch(), remref = NULL) {
257  remref <- remref %||% git_branch_tracking(branch)
258  gert::git_fetch(
259    remote = remref_remote(remref),
260    refspec = remref_branch(remref),
261    repo = git_repo(),
262    verbose = FALSE
263  )
264  out <- gert::git_ahead_behind(upstream = remref, ref = branch, repo = git_repo())
265  list(local_only = out$ahead, remote_only = out$behind)
266}
267
268# Checks ------------------------------------------------------------------
269check_default_branch <- function() {
270  default_branch <- git_branch_default()
271  ui_done("
272    Checking that current branch is default branch ({ui_value(default_branch)})")
273  actual <- git_branch()
274  if (actual == default_branch) {
275    return(invisible())
276  }
277  ui_stop("
278    Must be on branch {ui_value(default_branch)}, not {ui_value(actual)}.")
279}
280
281challenge_non_default_branch <- function(details = "Are you sure you want to proceed?") {
282  actual <- git_branch()
283  default_branch <- git_branch_default()
284  if (nzchar(details)) {
285    details <- paste0("\n", details)
286  }
287  if (actual != default_branch) {
288    if (ui_nope("
289      Current branch ({ui_value(actual)}) is not repo's default \\
290      branch ({ui_value(default_branch)}){details}")) {
291      ui_stop("Aborting")
292    }
293  }
294}
295
296# examples of remref: upstream/master, origin/foofy
297check_branch_up_to_date <- function(direction = c("pull", "push"),
298                                    remref = NULL,
299                                    use = NULL) {
300  direction <- match.arg(direction)
301  branch <- git_branch()
302  remref <- remref %||% git_branch_tracking(branch)
303  use <- use %||% switch(direction, pull = "git pull", push = "git push")
304
305  if (is.na(remref)) {
306    ui_done("Local branch {ui_value(branch)} is not tracking a remote branch.")
307    return(invisible())
308  }
309
310  if (direction == "pull") {
311    ui_done("
312      Checking that local branch {ui_value(branch)} has the changes \\
313      in {ui_value(remref)}")
314  } else {
315    ui_done("
316      Checking that remote branch {ui_value(remref)} has the changes \\
317      in {ui_value(branch)}")
318  }
319
320  comparison <- git_branch_compare(branch, remref)
321
322  # TODO: properly pluralize "commit(s)" when I switch to cli
323  if (direction == "pull") {
324    if (comparison$remote_only == 0) {
325      return(invisible())
326    } else {
327      ui_stop("
328        Local branch {ui_value(branch)} is behind {ui_value(remref)} by \\
329        {comparison$remote_only} commit(s).
330        Please use {ui_code(use)} to update.")
331    }
332  } else {
333    if (comparison$local_only == 0) {
334      return(invisible())
335    } else {
336      # TODO: consider offering to push for them?
337      ui_stop("
338        Local branch {ui_value(branch)} is ahead of {ui_value(remref)} by \\
339        {comparison$local_only} commit(s).
340        Please use {ui_code(use)} to update.")
341    }
342  }
343}
344
345check_branch_pulled <- function(remref = NULL, use = NULL) {
346  check_branch_up_to_date(direction = "pull", remref = remref, use = use)
347}
348
349check_branch_pushed <- function(remref = NULL, use = NULL) {
350  check_branch_up_to_date(direction = "push", remref = remref, use = use)
351}
352