1
# Repository -------------------------------------------------------------------
2
git_repo <- function() {
3 1
  check_uses_git()
4 1
  proj_get()
5
}
6

7
uses_git <- function() {
8 1
  repo <- tryCatch(
9 1
    gert::git_find(proj_get()),
10 1
    error = function(e) NULL
11
  )
12 1
  !is.null(repo)
13
}
14

15
check_uses_git <- function() {
16 1
  if (uses_git()) {
17 1
    return(invisible())
18
  }
19

20 1
  ui_stop(c(
21 1
    "Cannot detect that project is already a Git repository.",
22 1
    "Do you need to run {ui_code('use_git()')}?"
23
  ))
24
}
25

26
git_init <- function() {
27 1
  gert::git_init(proj_get())
28
}
29

30
# Config -----------------------------------------------------------------------
31

32
# `where = "de_facto"` means look at the values that are "in force", i.e. where
33
# local repo variables override global user-level variables, when both are
34
# defined
35
#
36
# `where = "local"` is strict, i.e. it only returns a value that is in the local
37
# config
38
git_cfg_get <- function(name, where = c("de_facto", "local", "global")) {
39 1
  where <- match.arg(where)
40 1
  if (where == "global" || !uses_git()) {
41 1
    dat <- gert::git_config_global()
42
  } else {
43 1
    dat <- gert::git_config(repo = git_repo())
44
  }
45 1
  if (where == "local") {
46 1
    dat <- dat[dat$level == "local", ]
47
  }
48 1
  out <- dat$value[dat$name == name]
49 1
  if (length(out) > 0) out else NULL
50
}
51

52
# Status------------------------------------------------------------------------
53
git_status <- function(untracked) {
54 1
  stopifnot(is_true(untracked) || is_false(untracked))
55 1
  st <- gert::git_status(repo = git_repo())
56 1
  if (!untracked) {
57 0
    st <- st[st$status != "new", ]
58
  }
59 1
  st
60
}
61

62
# Commit -----------------------------------------------------------------------
63
git_ask_commit <- function(message, untracked, paths = NULL) {
64 1
  if (!is_interactive() || !uses_git()) {
65 1
    return(invisible())
66
  }
67

68
  # this is defined here to encourage all commits to route through this function
69 0
  git_commit <- function(paths, message) {
70 0
    repo <- git_repo()
71 0
    ui_done("Adding files")
72 0
    gert::git_add(paths, repo = repo)
73 0
    ui_done("Making a commit with message {ui_value(message)}")
74 0
    gert::git_commit(message, repo = repo)
75
  }
76

77 0
  uncommitted <- git_status(untracked)$file
78 0
  if (is.null(paths)) {
79 0
    paths <- uncommitted
80
  } else {
81 0
    paths <- intersect(paths, uncommitted)
82
  }
83 0
  n <- length(paths)
84 0
  if (n == 0) {
85 0
    return(invisible())
86
  }
87

88 0
  paths <- sort(paths)
89 0
  ui_paths <- map_chr(paths, ui_path)
90 0
  if (n > 10) {
91 0
    ui_paths <- c(ui_paths[1:10], "...")
92
  }
93

94 0
  if (n == 1) {
95 0
    file_hint <- "There is 1 uncommitted file:"
96
  } else {
97 0
    file_hint <- "There are {n} uncommitted files:"
98
  }
99 0
  ui_line(c(
100 0
    file_hint,
101 0
    paste0("* ", ui_paths)
102
  ))
103

104 0
  if (ui_yeah("Is it ok to commit {if (n == 1) 'it' else 'them'}?")) {
105 0
    git_commit(paths, message)
106
  }
107 0
  invisible()
108
}
109

110
git_uncommitted <- function(untracked = FALSE) {
111 1
  nrow(git_status(untracked)) > 0
112
}
113

114
check_no_uncommitted_changes <- function(untracked = FALSE) {
115 1
  if (!uses_git()) {
116 1
    return(invisible())
117
  }
118

119 0
  if (rstudioapi::hasFun("documentSaveAll")) {
120 0
    rstudioapi::documentSaveAll()
121
  }
122

123
  # TODO: present a more useful overview of the situation?
124 0
  if (git_uncommitted(untracked = untracked)) {
125 0
    if (ui_yeah("
126 0
          There are uncommitted changes, which may cause problems when \\
127 0
          we push, pull, or switch branches.
128 0
          Do you want to proceed anyway?")) {
129 0
      return(invisible())
130
    } else {
131 0
      ui_stop("Uncommitted changes. Please commit before continuing.")
132
    }
133
  }
134
}
135

136
git_conflict_report <- function() {
137 0
  st <- git_status(untracked = FALSE)
138 0
  conflicted <- st$file[st$status == "conflicted"]
139 0
  n <- length(conflicted)
140 0
  if (n == 0) {
141 0
    return(invisible())
142
  }
143

144 0
  conflicted_paths <- map_chr(conflicted, ui_path)
145 0
  ui_line(c(
146 0
    "There are {n} conflicted files:",
147 0
    paste0("* ", conflicted_paths)
148
  ))
149

150 0
  msg <- glue("
151 0
    Are you ready to sort this out?
152 0
    If so, we will open the conflicted files for you to edit.")
153 0
  yes <- "Yes, I'm ready to resolve the merge conflicts."
154 0
  no <- "No, I want to abort this merge."
155 0
  if (ui_yeah(msg, yes = yes, no = no, shuffle = FALSE)) {
156 0
    ui_silence(purrr::walk(conflicted, edit_file))
157 0
    ui_stop("
158 0
      Please fix each conflict, save, stage, and commit.
159 0
      To back out of this merge, run {ui_code('gert::git_merge_abort()')} \\
160 0
      (in R) or {ui_code('git merge --abort')} (in the shell).")
161
  } else {
162 0
    gert::git_merge_abort(repo = git_repo())
163 0
    ui_stop("Abandoning the merge, since it will cause merge conflicts")
164
  }
165
}
166

167
# Remotes ----------------------------------------------------------------------
168
## remref --> remote, branch
169
git_parse_remref <- function(remref) {
170 0
  regex <- paste0("^", names(git_remotes()), collapse = "|")
171 0
  regex <- glue("({regex})/(.*)")
172 0
  list(remote = sub(regex, "\\1", remref), branch = sub(regex, "\\2", remref))
173
}
174

175 0
remref_remote <- function(remref) git_parse_remref(remref)$remote
176 0
remref_branch <- function(remref) git_parse_remref(remref)$branch
177

178
# Pull -------------------------------------------------------------------------
179
# Pull from remref or upstream tracking. If neither given/exists, do nothing.
180
# Therefore, this does less than `git pull`.
181
git_pull <- function(remref = NULL, verbose = TRUE) {
182 0
  repo <- git_repo()
183 0
  branch <- git_branch()
184 0
  remref <- remref %||% git_branch_tracking(branch)
185 0
  if (is.na(remref)) {
186 0
    if (verbose) {
187 0
      ui_done("No remote branch to pull from for {ui_value(branch)}")
188
    }
189 0
    return(invisible())
190
  }
191 0
  stopifnot(is_string(remref))
192 0
  if (verbose) {
193 0
    ui_done("Pulling from {ui_value(remref)}")
194
  }
195 0
  gert::git_fetch(
196 0
    remote = remref_remote(remref),
197 0
    refspec = remref_branch(branch),
198 0
    repo = repo,
199 0
    verbose = FALSE
200
  )
201
  # TODO: silence this when possible
202 0
  gert::git_merge(remref, repo = repo)
203 0
  st <- git_status(untracked = TRUE)
204 0
  if (any(st$status == "conflicted")) {
205 0
    git_conflict_report()
206
  }
207

208 0
  invisible()
209
}
210

211
# Branch ------------------------------------------------------------------
212
git_branch <- function() {
213 1
  info <- gert::git_info(repo = git_repo())
214 1
  branch <- info$shorthand
215 1
  if (identical(branch, "HEAD")) {
216 0
    ui_stop("Detached head; can't continue")
217
  }
218 1
  if (is.na(branch)) {
219 1
    ui_stop("On an unborn branch -- do you need to make an initial commit?")
220
  }
221 1
  branch
222
}
223

224
git_branch_tracking <- function(branch = git_branch()) {
225 0
  info <- gert::git_branch_list(repo = git_repo())
226 0
  this <- info$local & info$name == branch
227 0
  if (sum(this) < 1) {
228 0
    ui_stop("There is no local branch named {ui_value(branch}")
229
  }
230 0
  sub("^refs/remotes/", "", info$upstream[this])
231
}
232

233
git_branch_compare <- function(branch = git_branch(), remref = NULL) {
234 0
  remref <- remref %||% git_branch_tracking(branch)
235 0
  gert::git_fetch(
236 0
    remote = remref_remote(remref),
237 0
    refspec = remref_branch(remref),
238 0
    repo = git_repo(),
239 0
    verbose = FALSE
240
  )
241 0
  out <- gert::git_ahead_behind(upstream = remref, ref = branch, repo = git_repo())
242 0
  list(local_only = out$ahead, remote_only = out$behind)
243
}
244

245
# Checks ------------------------------------------------------------------
246
check_default_branch <- function() {
247 0
  default_branch <- git_branch_default()
248 0
  ui_done("
249 0
    Checking that current branch is default branch ({ui_value(default_branch)})")
250 0
  actual <- git_branch()
251 0
  if (actual == default_branch) {
252 0
    return(invisible())
253
  }
254 0
  ui_stop("
255 0
    Must be on branch {ui_value(default_branch)}, not {ui_value(actual)}.")
256
}
257

258
challenge_non_default_branch <- function(details = "Are you sure you want to proceed?") {
259 0
  actual <- git_branch()
260 0
  default_branch <- git_branch_default()
261 0
  if (nzchar(details)) {
262 0
    details <- paste0("\n", details)
263
  }
264 0
  if (actual != default_branch) {
265 0
    if (ui_nope("
266 0
      Current branch ({ui_value(actual)}) is not repo's default \\
267 0
      branch ({ui_value(default_branch)}){details}")) {
268 0
      ui_stop("Aborting")
269
    }
270
  }
271
}
272

273
# examples of remref: upstream/master, origin/foofy
274
check_branch_up_to_date <- function(direction = c("pull", "push"),
275
                                    remref = NULL,
276
                                    use = NULL) {
277 0
  direction <- match.arg(direction)
278 0
  branch <- git_branch()
279 0
  remref <- remref %||% git_branch_tracking(branch)
280 0
  use <- use %||% switch(direction, pull = "git pull", push = "git push")
281

282 0
  if (is.na(remref)) {
283 0
    ui_done("Local branch {ui_value(branch)} is not tracking a remote branch.")
284 0
    return(invisible())
285
  }
286

287 0
  if (direction == "pull") {
288 0
    ui_done("
289 0
      Checking that local branch {ui_value(branch)} has the changes \\
290 0
      in {ui_value(remref)}")
291
  } else {
292 0
    ui_done("
293 0
      Checking that remote branch {ui_value(remref)} has the changes \\
294 0
      in {ui_value(branch)}")
295
  }
296

297 0
  comparison <- git_branch_compare(branch, remref)
298

299
  # TODO: properly pluralize "commit(s)" when I switch to cli
300 0
  if (direction == "pull") {
301 0
    if (comparison$remote_only == 0) {
302 0
      return(invisible())
303
    } else {
304 0
      ui_stop("
305 0
        Local branch {ui_value(branch)} is behind {ui_value(remref)} by \\
306 0
        {comparison$remote_only} commit(s).
307 0
        Please use {ui_code(use)} to update.")
308
    }
309
  } else {
310 0
    if (comparison$local_only == 0) {
311 0
      return(invisible())
312
    } else {
313
      #TODO: consider offering to push for them?
314 0
      ui_stop("
315 0
        Local branch {ui_value(branch)} is ahead of {ui_value(remref)} by \\
316 0
        {comparison$local_only} commit(s).
317 0
        Please use {ui_code(use)} to update.")
318
    }
319
  }
320
}
321

322
check_branch_pulled <- function(remref = NULL, use = NULL) {
323 0
  check_branch_up_to_date(direction = "pull", remref = remref, use = use)
324
}
325

326
check_branch_pushed <- function(remref = NULL, use = NULL) {
327 0
  check_branch_up_to_date(direction = "push", remref = remref, use = use)
328
}

Read our documentation on viewing source code .

Loading