Merge pull request #139 from carpentries/update-deployments

Add ci_bundle_pr_artifacts()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sandpaper
 Title: Create and Curate Carpentries Lessons
-Version: 0.0.0.9035
+Version: 0.0.0.9036
 Authors@R: c(
     person(given = "Zhian N.",
            family = "Kamvar",
@@ -40,6 +40,7 @@ Imports:
     tools
 Suggests: 
     testthat (>= 3.0.0),
+    brio,
     covr,
     withr,
     jsonlite,

NAMESPACE

@@ -34,6 +34,7 @@ export(template_license)
 export(template_links)
 export(template_pkgdown)
 export(template_placeholder)
+export(template_pr_diff)
 export(template_setup)
 export(update_varnish)
 importFrom(assertthat,validate_that)

NEWS.md

@@ -1,10 +1,22 @@
+# sandpaper 0.0.0.9036
+
+MISC
+----
+
+ - Documentation for `git_worktree_setup()` has been added for future versions
+   of the maintainer and future contributors.
+ - `ci_bundle_pr_artifacts()` is a new internal function that will create
+   artifacts for GitHub to upload upon receipt of a pull request. This will
+   replace clunky shell code that lived inside a YAML configuration file.
+   (@zkamvar, #139)
+
 # sandpaper 0.0.0.9035
 
 MISC
 ----
 
  - Tests for git operations were added to be more robust (@zkamvar, #137)
- - A new test fixture for a local remote repository was added to aid the above
+ - new test fixtures for a local remote repository was added to aid the above
    git tests.
 
 # sandpaper 0.0.0.9034

R/ci_build_markdown.R

@@ -28,14 +28,14 @@ ci_build_markdown <- function(path = ".", branch = "md-outputs", remote = "origi
   del_md <- git_worktree_setup(path, built, 
     branch = branch, remote = remote
   )
-  on.exit(eval(del_md), add = TRUE)
 
   build_markdown(path = path, quiet = TRUE, rebuild = FALSE)
 
   github_worktree_commit(built, 
     message_source("markdown source builds", current, dir = path),
     remote, branch
   )
+  return(del_md)
 }
 
 ci_build_site <- function(path = ".", branch = "gh-pages", md = "md-outputs", remote = "origin") {

R/ci_deploy.R

@@ -25,8 +25,9 @@ ci_deploy <- function(path = ".", md_branch = "md-outputs", site_branch = "gh-pa
 
   built <- path_built(path)
   html  <- fs::path(path_site(path), "docs")
+  has_withr <- requireNamespace("withr", quietly = TRUE)
 
-  if (requireNamespace("withr", quietly = TRUE)) { withr::with_dir(path, {
+  if (has_git() && has_withr) { withr::with_dir(path, {
     # Set up the worktrees and make sure to remove them when the function exits
     # (gracefully or ungracefully so)
     # ------------ markdown worktree
@@ -57,5 +58,6 @@ ci_deploy <- function(path = ".", md_branch = "md-outputs", site_branch = "gh-pa
       remote, site_branch
     )
   })}
+  invisible()
 }
 

R/template.R

@@ -74,3 +74,7 @@ template_pkgdown <- generate_template_function("pkgdown-yaml")
 #' @export
 template_placeholder <- generate_template_function("placeholder")
 
+#' @rdname template
+#' @export
+template_pr_diff <- generate_template_function("pr_diff")
+

R/test-fixtures.R

@@ -88,11 +88,33 @@ setup_local_remote <- function(repo, remote = tempfile(), name = "sandpaper-loca
     fs::dir_create(remote)
   }
   gert::git_clone(repo, path = remote, bare = TRUE)
+  gert::git_remote_remove(remote = "origin", repo = remote)
   gert::git_remote_add(remote, name, repo = repo)
-  gert::git_push(remote = name, set_upstream = TRUE, repo = repo, verbose = FALSE)
+  gert::git_push(remote = name, set_upstream = TRUE, repo = repo, verbose = verbose)
   return(invisible(repo))
 }
 
+# create and clean branches in the local and remote repositories
+make_branch <- function(repo, branch, remote_name = "sandpaper-local", verbose = FALSE) {
+  this_branch <- gert::git_branch(repo = repo)
+  on.exit(gert::git_branch_checkout(this_branch, repo = repo))
+  gert::git_branch_create(branch, repo = repo, checkout = TRUE)
+  gert::git_push(remote = remote_name, repo = repo, verbose = verbose)
+}
+
+clean_branch <- function(repo, nu_branch = NULL, remote_name = "sandpaper-local", verbose = FALSE) {
+  this_branch <- gert::git_branch(repo)
+  if (is.null(nu_branch) || this_branch == nu_branch) {
+    gert::git_branch_checkout("main", repo = repo)
+  }
+  gert::git_branch_delete(nu_branch, repo = repo)
+  rmt_url <- gert::git_remote_list(repo)
+  rmt_url <- rmt_url$url[rmt_url$name == remote_name]
+  if (length(rmt_url) > 0) { 
+    gert::git_branch_delete(nu_branch, repo = rmt_url)
+  }
+}
+
 #' @rdname fixtures
 #' @return (`remove_local_remote()`) FALSE indicating an error or a string 
 #'   indicating the path to the remote