Improve handling of empty or detached Git repositories.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly2
 Title: Orderly Next Generation
-Version: 1.99.20
+Version: 1.99.21
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),

R/outpack_misc.R

@@ -44,9 +44,19 @@ git_info <- function(path) {
   if (is.null(repo)) {
     return(NULL)
   }
-  list(sha = gert::git_commit_id(repo = repo),
-       branch = gert::git_branch(repo = repo),
-       url = gert::git_remote_list(repo = repo)$url)
+
+  sha <- tryCatch(gert::git_commit_id(repo = repo),
+                  error = function(e) NA)
+
+  branch <- gert::git_branch(repo = repo)
+  if (is.null(branch) || identical(branch, "HEAD")) {
+    # NULL can be returned when working in a repo that has no commits yet.
+    # "HEAD" isn't a valid branch name and instead is what gets returned when a
+    # detached head was checked out.
+    branch <- NA
+  }
+
+  list(sha = sha, branch = branch, url = gert::git_remote_list(repo = repo)$url)
 }
 
 

inst/schema/outpack/README.md

@@ -1,8 +1,8 @@
 # Imported from outpack
 
 * Schema version 0.1.1
-* Imported on 2023-08-17 10:00:21.068664
-* From outpack @ ba2bb5bf44a56b3c0ce78128fa419375df109fe3 (main)
+* Imported on 2024-07-10 10:46:08.587491
+* From outpack @ f521a290636c01c777d6550bca78e0a8e0f051f8 (main)
 
 Do not make changes to files here, they will be overwritten
 Run ./scripts/update_schemas to update

inst/schema/outpack/git.json

@@ -7,17 +7,18 @@
     "type": "object",
     "properties": {
         "sha": {
-            "type": "string",
+            "type": ["string", "null"],
             "pattern": "^[0-9a-f]+$"
         },
         "branch": {
-            "type": "string"
+            "type": ["string", "null"]
         },
         "url": {
             "type": "array",
             "items": {
                 "type": "string"
             }
         }
-    }
+    },
+    "required": ["url", "sha", "branch"]
 }

inst/schema/outpack/metadata.json

@@ -60,7 +60,7 @@
                 "properties": {
                     "path": {
                         "description": "The path of the file",
-                        "type": "string"
+                        "$ref": "relative-path.json"
                     },
                     "hash": {
                         "$ref": "hash.json"
@@ -88,17 +88,16 @@
                     },
                     "files": {
                         "type": "array",
-                        "minItems": 1,
                         "items": {
                             "type": "object",
                             "properties": {
                                 "here": {
                                     "description": "The path of the file in this packet",
-                                    "type": "string"
+                                    "$ref": "relative-path.json"
                                 },
                                 "there": {
                                     "description": "The path of the file within the upstream packet",
-                                    "type": "string"
+                                    "$ref": "relative-path.json"
                                 }
                             },
                             "required": ["here", "there"]

inst/schema/outpack/relative-path.json

@@ -0,0 +1,9 @@
+{
+    "$schema": "http://json-schema.org/draft-07/schema#",
+    "title": "File path",
+    "description": "A relative cross-platform file path",
+    "version": "0.1.1",
+
+    "type": "string",
+    "pattern": "^([^<>:\"/\\\\|?*\\x00-\\x1f]+/)*[^<>:\"/\\\\|?*\\x00-\\x1f]+$"
+}

tests/testthat/test-outpack-git.R

@@ -68,3 +68,48 @@ test_that("store no information into packet, if no git found", {
   expect_true("git" %in% names(meta))
   expect_null(meta$git)
 })
+
+
+test_that("store git information when on a detached HEAD", {
+  root <- create_temporary_root()
+  path_src <- create_temporary_simple_src()
+  git_info <- helper_add_git(path_src)
+
+  ## gert has no API to checkout a particular commit, only named branches
+  ## https://github.com/r-lib/gert/issues/147
+  system2("git", c("-C", path_src, "checkout", "-q", git_info$sha))
+
+  suppressMessages({
+    p <- outpack_packet_start(path_src, "example", root = root)
+    id <- p$id
+    outpack_packet_run(p, "script.R")
+    outpack_packet_end(p)
+  })
+
+  meta <- orderly_metadata(id, root = root$path)
+  expect_mapequal(meta$git,
+                  list(sha = git_info$sha,
+                       branch = NULL,
+                       url = git_info$url))
+})
+
+
+test_that("handle empty git repository correctly", {
+  root <- create_temporary_root()
+  path_src <- create_temporary_simple_src()
+
+  gert::git_init(path_src)
+  gert::git_remote_add("https://example.com/git", repo = path_src)
+
+  suppressMessages({
+    p <- outpack_packet_start(path_src, "example", root = root)
+    id <- p$id
+    outpack_packet_run(p, "script.R")
+    outpack_packet_end(p)
+  })
+
+  meta <- orderly_metadata(id, root = root$path)
+  expect_mapequal(meta$git, list(sha = NULL,
+                                 branch = NULL,
+                                 url = "https://example.com/git"))
+})