From 4273f994c67fd2d2484ebebafe73dacf8f1a675d Mon Sep 17 00:00:00 2001
From: Jeroen Ooms <jeroenooms@gmail.com>
Date: Fri, 29 Nov 2024 12:16:38 +0100
Subject: [PATCH] Show error message as GHA annotation

---
 Dockerfile    |  2 +-
 R/monorepos.R | 18 +++++++++++-------
 R/registry.R  | 16 ++++++++++++++++
 3 files changed, 28 insertions(+), 8 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index 7b482b0..59161ee 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -5,6 +5,6 @@ COPY entrypoint.sh /entrypoint.sh
 
 RUN installr -d -t "openssl-dev libgit2-dev" -a "openssl libgit2 git" rlang local::/pkg
 
-RUN echo 'options(error=rlang::entrace)' >> "$(R RHOME)/etc/Rprofile.site"
+RUN echo 'rlang::global_entrace()' >> "$(R RHOME)/etc/Rprofile.site"
 
 ENTRYPOINT ["sh","/entrypoint.sh"]
diff --git a/R/monorepos.R b/R/monorepos.R
index ba31c1a..c8809c5 100644
--- a/R/monorepos.R
+++ b/R/monorepos.R
@@ -113,7 +113,7 @@ sync_from_registry <- function(monorepo_url = Sys.getenv('MONOREPO_URL')){
   }
   check_new_release_tags()
   skiplist <- submodules_up_to_date(skip_broken = FALSE)
-  print_message("Submodules up-to-date:\n %s", paste(skiplist, collapse = '\n '))
+  print_message("Submodules up-to-date:\n %d", length(skiplist))
   dirty <- Filter(function(x){is.na(match(x$package, skiplist))}, registry[!registry_dups])
   results1 <- lapply(dirty, try_update_package, update_pkg_remotes = TRUE)
 
@@ -150,7 +150,9 @@ sync_from_registry <- function(monorepo_url = Sys.getenv('MONOREPO_URL')){
 
   if(length(failures) > 0){
     pkgs <- vapply(failures, function(x){
-      message(sprintf("\nERROR updating %s from %s (%s)\n", x$package, x$url, attr(x, 'error')))
+      errmsg <- sprintf("ERROR updating %s from %s (%s)", x$package, x$url, attr(x, 'error'))
+      cat(sprintf("::error file=%s::%s\n", x$package, gsub("\\s+", " ", errmsg)))
+      #message(errmsg)
       x$package
     }, character(1))
     stop("Failed to update packages: ", paste(pkgs, collapse = ', '))
@@ -223,7 +225,7 @@ update_one_package <- function(x, update_pkg_remotes = FALSE, cleanup_after = FA
   if(submodule$status != 0){
     print_message("Adding new package '%s' from: %s", pkg_dir, pkg_url)
     branch_args <- if(!identical(pkg_branch, 'HEAD')) c('-b', pkg_branch)
-    sys::exec_wait("git", c("submodule", "add", branch_args, "--force", pkg_url, pkg_dir))
+    git_cmd_assert("submodule", "add", branch_args, "--force", pkg_url, pkg_dir)
     if(pkg_branch == '*release')
       pkg_branch <- update_release_branch(pkg_dir, pkg_url)
     gert::git_submodule_set_to(submodule = pkg_dir, ref = pkg_branch)
@@ -231,7 +233,7 @@ update_one_package <- function(x, update_pkg_remotes = FALSE, cleanup_after = FA
     submodule_head <- sub("^[+-]", "", sys::as_text(submodule$stdout))
     if(pkg_branch == '*release')
       pkg_branch <- update_release_branch(pkg_dir, pkg_url)
-    out <- sys::exec_internal('git', c("ls-remote", pkg_url, pkg_branch))
+    out <- git_cmd_assert("ls-remote", pkg_url, pkg_branch)
     if(length(out$stdout)){
       remote_head <- strsplit(sys::as_text(out$stdout), '\\W')[[1]][1]
     } else {
@@ -252,8 +254,8 @@ update_one_package <- function(x, update_pkg_remotes = FALSE, cleanup_after = FA
       return()
     }
     print_message("Updating package '%s' from: %s", pkg_dir, pkg_url)
-    sys::exec_wait("git", c("update-index", "--cacheinfo", "160000", remote_head, pkg_dir))
-    sys::exec_wait("git", c("submodule", "update", "--init", "--recommend-shallow", pkg_dir))
+    git_cmd_assert("update-index", "--cacheinfo", "160000", remote_head, pkg_dir)
+    git_cmd_assert("submodule", "update", "--init", "--recommend-shallow", pkg_dir)
   }
   gert::git_add(pkg_dir)
   if(!any(gert::git_status()$staged)){
@@ -517,7 +519,9 @@ get_description_data <- function(pkg_dir){
 }
 
 read_description_file <- function(path){
-  desc <- as.list(tools:::.read_description(path))
+  desc <- tryCatch(as.list(tools:::.read_description(path)), error = function(err){
+    stop("Failed to read DESCRIPTION: ", err)
+  })
   names(desc) <- tolower(names(desc))
   if(!length(desc[['maintainer']]) || identical(tolower(desc$maintainer), 'orphaned')){
     authors <- desc[['authors@r']]
diff --git a/R/registry.R b/R/registry.R
index 0bed057..4564be4 100644
--- a/R/registry.R
+++ b/R/registry.R
@@ -92,6 +92,22 @@ git_cmd <- function(..., std_err = TRUE, timeout = 60){
   sys::exec_wait('git', args = c(...), std_err = std_err, timeout = timeout)
 }
 
+git_cmd_assert <- function(..., timeout = 60){
+  args <- c(...)
+  res <- sys::exec_internal('git', args = args, timeout = timeout, error = FALSE)
+  errtxt <- sys::as_text(res$stderr)
+  lapply(errtxt, cat, file = stderr(), "\n")
+  if(!identical(res$status, 0L)){
+    fatal_error <- grep('fatal', errtxt, value = TRUE)
+    if(length(fatal_error)){
+      errtxt <- sub("fatal:", "", fatal_error[1])
+    } else {
+    }
+    stop(sprintf('git %s: %s', args[1], paste(errtxt, collapse = "\n")))
+  }
+  return(res)
+}
+
 git_clone <- function(url, dest = NULL){
   for(i in 1:3){
     if(!git_cmd('clone', '--depth', '1', url, dest)){