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