Git utilities

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pacta.workflow.utils
 Title: Utility functions for PACTA workflows
-Version: 0.0.0.9002
+Version: 0.0.0.9003
 Authors@R: 
     c(person(given = "Alex",
              family = "Axthelm",
@@ -17,13 +17,13 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
 Imports: 
     digest,
+    gert,
     jsonlite,
     logger,
     pkgdepends,
     pkgload
 Suggests: 
     devtools,
-    gert,
     pak,
     testthat (>= 3.0.0),
     withr

R/get_package_info.R

@@ -80,6 +80,7 @@ get_individual_package_info <- function(packagename) {
     package_dev_dir <- pkgload::pkg_path(
       path = dirname(system.file("DESCRIPTION", package = packagename))
     )
+    git_info <- get_git_info(repo = package_dev_dir)
     pkg_details <- list(
       package = pkgload::pkg_name(package_dev_dir),
       version = paste("DEV", pkgload::pkg_version(package_dev_dir)),
@@ -91,7 +92,8 @@ get_individual_package_info <- function(packagename) {
       remotetype = "pkgload",
       remotepkgref = normalizePath(package_dev_dir),
       remoteref = NA_character_,
-      remotesha = NA_character_
+      remotesha = NA_character_,
+      git = git_info
     )
   } else {
     if (packagename %in% utils::installed.packages()[, "Package"]) {
@@ -122,6 +124,25 @@ get_individual_package_info <- function(packagename) {
       )
     )
     pkg_details[["library_index"]] <- lib_index
+    if (is.null(pkg_details[["remotepkgref"]])) {
+      is_local_pkg <- FALSE
+    } else {
+      is_local_pkg <- grepl(
+        x = pkg_details[["remotepkgref"]],
+        pattern = "^local::"
+      )
+    }
+    if (is_local_pkg) {
+      git_info <- get_git_info(
+        repo = gsub(
+          x = pkg_details[["remotepkgref"]],
+          pattern = "local::",
+          replacement = "",
+          fixed = TRUE
+        )
+      )
+      pkg_details[["git"]] <- git_info
+    }
   }
   details_list <- list(
     package = pkg_details[["package"]],
@@ -135,12 +156,17 @@ get_individual_package_info <- function(packagename) {
     remotetype = pkg_details[["remotetype"]],
     remotepkgref = pkg_details[["remotepkgref"]],
     remoteref = pkg_details[["remoteref"]],
-    remotesha = pkg_details[["remotesha"]]
+    remotesha = pkg_details[["remotesha"]],
+    git = pkg_details[["git"]]
   )
   clean_details_list <- lapply(
     X = details_list,
     FUN = function(x) {
-      ifelse(is.null(x), NA_character_, x)
+      if (is.null(x)) {
+        NA_character_
+      } else {
+        x
+      }
     }
   )
   return(clean_details_list)

R/git.R

@@ -0,0 +1,157 @@
+get_git_info <- function(repo) {
+  log_trace("checking that directory \"{repo}\"exists.")
+  if (is_git_path(repo)) {
+    git_repo <- gert::git_find(path = repo)
+    info <- gert::git_info(repo = git_repo)
+    latest_commit <- info[["commit"]]
+    if (is.na(latest_commit)) {
+      log_debug("No commits found in repo.")
+      latest_commit <- NULL
+    }
+    changed_files <- git_changed_files(repo = git_repo)
+    # cleaning path for older versions of R on windows
+    repo_path <- gsub(
+      x = normalizePath(info[["path"]]),
+      pattern = "[\\]+$", # nolint: nonportable_path_linter
+      replacement = ""
+    )
+    out <- list(
+      repo = repo_path,
+      is_git = TRUE,
+      commit = latest_commit,
+      clean = (length(changed_files) == 0L),
+      branch = git_branch_info(repo = git_repo),
+      changed_files = changed_files,
+      tags = git_tag_info(repo = git_repo)
+    )
+  } else {
+    log_warn("Directory \"{repo}\" is not a git repository.")
+    warning("Specified path is not in a git repository.")
+    out <- NULL
+  }
+  return(out)
+}
+
+is_git_path <- function(path) {
+  log_trace("checking that path \"{path}\" is in a git repository.")
+  if (file.exists(path)) {
+    log_trace("path \"{path}\" exists.")
+    git_path <- tryCatch({
+      gert::git_find(path = path)
+    }, error = function(e) {
+      log_trace("error while finding git repo in parent tree for \"{path}\".")
+      NULL
+    })
+    if (is.null(git_path)) {
+      log_trace("no git repo found in parent tree for \"{path}\".")
+      is_git_path <- FALSE
+    } else {
+      log_trace("git repo found in parent tree for \"{path}\".")
+      is_git_path <- dir.exists(git_path)
+    }
+  } else {
+    # dir does not exist
+    log_error("path \"{path}\" does not exist.")
+    stop("Cannot find git information for path which does not exist.")
+  }
+  return(is_git_path)
+}
+
+git_branch_info <- function(repo) {
+  log_trace("checking branch information for repo \"{repo}\".")
+  if (is_git_path(repo)) {
+    git_repo <- gert::git_find(path = repo)
+    active_branch <- gert::git_branch(repo = git_repo)
+    if (is.null(active_branch)) {
+      log_debug("No active branch found.")
+      return(NULL)
+    }
+    log_debug("active branch: \"{active_branch}\".")
+    branch_list <- gert::git_branch_list(repo = git_repo)
+    active_index <- which(branch_list[["name"]] == active_branch)
+    active_commit <- branch_list[[active_index, "commit"]]
+    active_upstream <- branch_list[[active_index, "upstream"]]
+    if (is.na(active_upstream)) {
+      log_debug("Branch \"{active_branch}\" has no upstream.")
+      active_upstream <- NULL
+      up_to_date <- NULL
+      upstream_commit <- NULL
+      remote_url <- NULL
+    } else {
+      log_trace(
+        "Branch \"{active_branch}\" has an upstream: \"{active_upstream}\"."
+      )
+      active_upstream <- gsub(
+        pattern = "refs/heads/", # nolint: nonportable_path_linter
+        replacement = "",
+        x = active_upstream
+      )
+      upstream_index <- which(branch_list[["ref"]] == active_upstream)
+      upstream_commit <- branch_list[[upstream_index, "commit"]]
+      up_to_date <- active_commit == upstream_commit
+      # format of remote ref: refs/remotes/origin/branch
+      remote_name <- strsplit(
+        x = active_upstream,
+        split = "/",
+        fixed = TRUE
+      )[[1L]][[3L]]
+      remote_info <- gert::git_remote_info(
+        repo = git_repo,
+        remote = remote_name
+      )
+      remote_url <- remote_info[["url"]]
+    }
+    out <- list(
+      name = active_branch,
+      commit = active_commit,
+      upstream = active_upstream,
+      remote_url = remote_url,
+      up_to_date = up_to_date,
+      upstream_commit = upstream_commit
+    )
+  } else {
+    log_warn("Directory \"{repo}\" is not a git repository.")
+    warning("Specified path is not in a git repository.")
+    out <- NULL
+  }
+  return(out)
+}
+
+git_changed_files <- function(repo) {
+  log_trace("checking for changed files in repo \"{repo}\".")
+  if (is_git_path(repo)) {
+    git_repo <- gert::git_find(path = repo)
+    status <- gert::git_status(repo = git_repo)
+    changed_files <- list()
+    for (f in status[["file"]]) {
+      changed_files[[f]] <- status[["status"]][status[["file"]] == f]
+    }
+    return(changed_files)
+  } else {
+    log_debug("Specified path is not in a git repository.")
+    return(NULL)
+  }
+}
+
+git_tag_info <- function(repo) {
+  log_trace("checking for tags in repo \"{repo}\".")
+  if (is_git_path(repo)) {
+    git_repo <- gert::git_find(path = repo)
+    tags_df <- gert::git_tag_list(repo = git_repo)
+    tags <- list()
+    for (i in seq_along(tags_df[["name"]])) {
+      tag_name <- tags_df[["name"]][i]
+      tag_commit <- tags_df[["commit"]][i]
+      tag_pointer <- gert::git_commit_info(repo = git_repo, ref = tag_commit)
+      tags[[tag_name]] <- list(
+        name = tag_name,
+        commit = tag_commit,
+        points_to = tag_pointer[["id"]]
+      )
+    }
+    return(tags)
+  } else {
+    log_debug("Specified path is not in a git repository.")
+    return(NULL)
+  }
+}

tests/testthat/helper-git_config.R

@@ -0,0 +1,8 @@
+testing_git_config <- function(repo) {
+  gert::git_config_set(repo = repo, name = "user.name", value = "testthat")
+  gert::git_config_set(
+    repo = repo,
+    name = "user.email",
+    value = "PACTATesting@rmi.org"
+  )
+}

tests/testthat/helper-remote_package.R

@@ -0,0 +1,12 @@
+remote_package <- list(
+  name = "minimal.r.package",
+  version = "0.0.0.9001",
+  old_version = "0.0.0.9000",
+  gh_repo = "RMI-PACTA/minimal.r.package", #nolint: nonportable_path_linter
+  gh_repo_old = "RMI-PACTA/minimal.r.package@28c716f", #nolint: nonportable_path_linter
+  branch = "main",
+  upstream = "refs/remotes/origin/main", #nolint: nonportable_path_linter
+  url = "https://github.com/RMI-PACTA/minimal.r.package.git",
+  sha = "f31fa0e5675b675fb778e15fcf1501aecec8cf94",
+  old_sha = "28c716face8bbf8787c32ae392f246177f111c00"
+)