Merge pull request #2 from wlandau/json

Allow custom JSON files

.github/workflows/check.yaml

@@ -1,8 +1,4 @@
-on:
-  push:
-    branches: [main]
-  pull_request:
-    branches: [main]
+on: [push, pull_request]
 
 name: check
 

.github/workflows/lint.yaml

@@ -1,8 +1,4 @@
-on:
-  push:
-    branches: [main]
-  pull_request:
-    branches: [main]
+on: [push, pull_request]
 
 name: lint
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: r.releases.utils
 Title: Utilities for An R Universe of Package Releases
 Description: Utilities for an R universe of package releases.
-Version: 0.0.2.9000
+Version: 0.0.3
 License: MIT + file LICENSE
 URL:
   https://r-releases.github.io/r.releases.utils/,
@@ -32,7 +32,8 @@ Imports:
   gh,
   jsonlite,
   nanonext,
-  pkgsearch
+  pkgsearch,
+  vctrs
 Encoding: UTF-8
 Language: en-US
 Config/testthat/edition: 3

NAMESPACE

@@ -5,7 +5,10 @@ export(assert_package)
 export(build_universe)
 export(review_pull_request)
 export(review_pull_requests)
+export(try_message)
 importFrom(gh,gh)
+importFrom(jsonlite,parse_json)
 importFrom(jsonlite,read_json)
 importFrom(nanonext,parse_url)
 importFrom(pkgsearch,cran_package)
+importFrom(vctrs,vec_rbind)

NEWS.md

@@ -1,8 +1,10 @@
-# r.releases.utils 0.0.2.9000 (development)
+# r.releases.utils 0.0.3
 
 * Checks URL matches the package description for CRAN packages.
 * `check_package()` checks the URL and name directly, not a file.
 * Add more strict URL assertions.
+* Accept custom JSON entries but flag them for manual review.
+* Print progress messages from `build_universe()`.
 
 # r.releases.utils 0.0.2
 

R/assert_package.R

@@ -4,10 +4,26 @@
 #' @description Validate a package entry.
 #' @return A character string if there is a problem with the package entry,
 #'   otherwise `NULL` if there are no issues.
-assert_package <- function(name, url) {
-  if (!is_character_scalar(name)) {
+#' @param name Character of length 1, package name.
+#' @param url Usually a character of length 1 with the package URL.
+#'   Can also be a custom JSON string with the package URL and other metadata,
+#'   but this is for rare cases and flags the package for manual review.
+#' @param assert_cran_url Logical of length 1, whether to check
+#'   the alignment between the specified URL and the CRAN URL.
+assert_package <- function(name, url, assert_cran_url = TRUE) {
+  if (!is_package_name(name)) {
     return("Invalid package name.")
   }
+  json <- try(jsonlite::parse_json(json = url), silent = TRUE)
+  if (!inherits(json, "try-error")) {
+    return(
+      paste(
+        "Entry of package",
+        shQuote(name),
+        "looks like custom JSON"
+      )
+    )
+  }
   if (!is_character_scalar(url)) {
     return("Invalid package URL.")
   }
@@ -57,5 +73,14 @@ assert_package <- function(name, url) {
   if (identical(owner, "cran")) {
     return(paste("URL", shQuote(url), "appears to use a CRAN mirror."))
   }
-  assert_cran_url(name = name, url = url)
+  if (assert_cran_url) {
+    return(assert_cran_url(name = name, url = url))
+  }
+}
+
+is_package_name <- function(name) {
+  is_character_scalar(name) && grepl(
+    pattern = "^[a-zA-Z][a-zA-Z0-9.]*[a-zA-Z0-9]$",
+    x = trimws(name)
+  )
 }

R/build_universe.R

@@ -13,24 +13,87 @@ build_universe <- function(input = getwd(), output = "packages.json") {
   assert_character_scalar(output, "invalid output")
   assert_file(input)
   packages <- list.files(input, all.files = FALSE, full.names = TRUE)
-  contents <- lapply(X = packages, FUN = read_package_entry)
-  out <- data.frame(
-    package = trimws(basename(packages)),
-    url = trimws(unlist(contents, use.names = FALSE)),
-    branch = "*release"
-  )
+  message("Processing ", length(packages), " package entries.")
+  entries <- lapply(X = packages, FUN = read_package_entry)
+  message("Aggregating ", length(entries), " package entries.")
+  aggregated <- do.call(what = vctrs::vec_rbind, args = entries)
   if (!file.exists(dirname(output))) {
     dir.create(dirname(output))
   }
-  jsonlite::write_json(x = out, path = output)
+  message("Writing packages.json.")
+  jsonlite::write_json(x = aggregated, path = output)
   invisible()
 }
 
 read_package_entry <- function(package) {
-  out <- readLines(con = package, warn = FALSE)
-  message <- assert_package(name = basename(package), url = out)
+  message("Processing package entry ", package)
+  name <- trimws(basename(package))
+  lines <- readLines(con = package, warn = FALSE)
+  out <- try(jsonlite::parse_json(lines), silent = TRUE)
+  if (inherits(out, "try-error")) {
+    package_entry_url(name = name, url = lines)
+  } else {
+    package_entry_json(name = name, json = out)
+  }
+}
+
+package_entry_url <- function(name, url) {
+  message <- assert_package(
+    name = name,
+    url = url,
+    assert_cran_url = FALSE # Prevents massive slowdown from 20000+ packages.
+  )
   if (!is.null(message)) {
     stop(message, call. = FALSE)
   }
-  out
+  data.frame(
+    package = trimws(name),
+    url = trimws(url),
+    branch = "*release"
+  )
+}
+
+package_entry_json <- function(name, json) {
+  fields <- names(json)
+  good_fields <- identical(
+    sort(fields),
+    sort(c("package", "url", "branch", "subdir"))
+  )
+  if (!good_fields) {
+    stop(
+      "Custom JSON entry for package ",
+      shQuote(name),
+      " must have fields 'packages', 'url', 'branch', and 'subdir' ",
+      "and no other fields.",
+      call. = FALSE
+    )
+  }
+  if (!identical(name, json$package)) {
+    stop(
+      "The 'packages' field disagrees with the package name ",
+      shQuote(name),
+      call. = FALSE
+    )
+  }
+  if (!identical(json$branch, "*release")) {
+    stop(
+      "The 'branch' field of package ",
+      shQuote(name),
+      "is not \"*release\".",
+      call. = FALSE
+    )
+  }
+  for (field in names(json)) {
+    assert_character_scalar(
+      x = json[[field]],
+      message = paste(
+        "Invalid value in field",
+        shQuote(field),
+        "in the JSON entry for package name",
+        shQuote(name)
+      )
+    )
+    json[[field]] <- trimws(json[[field]])
+  }
+  as.data.frame(json)
 }

R/package.R

@@ -3,7 +3,8 @@
 #' @name r.releases.utils-package
 #' @family help
 #' @importFrom gh gh
-#' @importFrom jsonlite read_json
+#' @importFrom jsonlite parse_json read_json
 #' @importFrom nanonext parse_url
 #' @importFrom pkgsearch cran_package
+#' @importFrom vctrs vec_rbind
 NULL

R/review_pull_request.R

@@ -8,6 +8,7 @@
 #'   2. Add a bad URL (manual review).
 #'   3. Change a URL (manual review).
 #'   4. Add a file in a forbidden place (close).
+#'   5. Add a custom JSON file which can be parsed (manual review).
 #' @return `NULL` (invisibly).
 #' @param owner Character of length 1, name of the universe repository owner.
 #' @param repo Character of length 1, name of the universe repository.

R/utils_assert.R

@@ -30,6 +30,13 @@ is_positive_scalar <- function(x) {
     all(x > 0)
 }
 
+#' @title Get try error message
+#' @export
+#' @keywords internal
+#' @description Get the error message of an error object from `try()`.
+#' @param try_error `try()` error object.
+#' @param collapse Character of length 1, delimiter for the
+#'   lines of the message.
 try_message <- function(try_error, collapse = " ") {
   paste(conditionMessage(attr(try_error, "condition")), collapse = collapse)
 }

README.md

@@ -3,6 +3,6 @@
 [![check](https://github.com/r-releases/r.releases.utils/actions/workflows/check.yaml/badge.svg)](https://github.com/r-releases/r.releases.utils/actions?query=workflow%3Acheck)
 [![lint](https://github.com/r-releases/r.releases.utils/actions/workflows/lint.yaml/badge.svg)](https://github.com/r-releases/r.releases.utils/actions?query=workflow%3Alint)
 
-This R package contains helper functions for the front-end infrastructure to create the `r-releases` `r-universe`. To install it locally, run `install.packages("r.releases.utils", repos = "https://r-releases.r-universe.dev")`.
+`r.releases.utils` is an R package to support automation for the `r-releases` project.
 
-Please report bugs to https://github.com/r-releases/help/issues and send other feedback and questions to https://github.com/r-releases/help/discussions. 
+For all matters please refer to https://github.com/r-releases/help.

tests/test-assert_package.R

@@ -1,30 +1,52 @@
 stopifnot(
   grepl(
     "Invalid package name",
-    r.releases.utils::assert_package(name = letters, url = "x"),
+    r.releases.utils::assert_package(name = letters, url = "xy"),
     fixed = TRUE
   )
 )
 
 stopifnot(
   grepl(
-    "Invalid package URL",
-    r.releases.utils::assert_package(name = "x", url = letters),
+    "Invalid package name",
+    r.releases.utils::assert_package(
+      name = ".gh",
+      url = "https://github.com/r-lib/gh"
+    ),
     fixed = TRUE
   )
 )
 
 stopifnot(
   grepl(
-    "Found invalid package name",
+    "looks like custom JSON",
     r.releases.utils::assert_package(
-      name = ".gh",
-      url = "https://github.com/r-lib/gh"
+      name = "xy",
+      url = "{\"branch\": \"release\"}"
+    ),
+    fixed = TRUE
+  )
+)
+
+stopifnot(
+  grepl(
+    "Invalid package URL",
+    r.releases.utils::assert_package(
+      name = "xy",
+      url = letters
     ),
     fixed = TRUE
   )
 )
 
+stopifnot(
+  grepl(
+    "Invalid package URL",
+    r.releases.utils::assert_package(name = "xy", url = letters),
+    fixed = TRUE
+  )
+)
+
 stopifnot(
   grepl(
     "Found malformed URL",