diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index e439754..bb1194f 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -1,8 +1,4 @@ -on: - push: - branches: [main] - pull_request: - branches: [main] +on: [push, pull_request] name: check diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index c2e6d0b..a3f3f23 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -1,8 +1,4 @@ -on: - push: - branches: [main] - pull_request: - branches: [main] +on: [push, pull_request] name: lint diff --git a/DESCRIPTION b/DESCRIPTION index 808ad85..4fce850 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index 8551c1b..6bd490d 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index baaa2a8..5c5e96c 100644 --- a/NEWS.md +++ b/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 diff --git a/R/assert_package.R b/R/assert_package.R index b1b42c0..645bbea 100644 --- a/R/assert_package.R +++ b/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) + ) } diff --git a/R/build_universe.R b/R/build_universe.R index bc86467..6a2e402 100644 --- a/R/build_universe.R +++ b/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) } diff --git a/R/package.R b/R/package.R index aac3edc..704c66f 100644 --- a/R/package.R +++ b/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 diff --git a/R/review_pull_request.R b/R/review_pull_request.R index bb5441d..ea51ada 100644 --- a/R/review_pull_request.R +++ b/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. diff --git a/R/utils_assert.R b/R/utils_assert.R index 05cd20f..c722ede 100644 --- a/R/utils_assert.R +++ b/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) } diff --git a/README.md b/README.md index f1416a7..66a5b18 100644 --- a/README.md +++ b/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. diff --git a/man/assert_package.Rd b/man/assert_package.Rd index 1f13740..9551cca 100644 --- a/man/assert_package.Rd +++ b/man/assert_package.Rd @@ -4,7 +4,17 @@ \alias{assert_package} \title{Validate a Package Entry} \usage{ -assert_package(name, url) +assert_package(name, url, assert_cran_url = TRUE) +} +\arguments{ +\item{name}{Character of length 1, package name.} + +\item{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.} + +\item{assert_cran_url}{Logical of length 1, whether to check +the alignment between the specified URL and the CRAN URL.} } \value{ A character string if there is a problem with the package entry, diff --git a/man/review_pull_request.Rd b/man/review_pull_request.Rd index 94b00a2..fb1e8bc 100644 --- a/man/review_pull_request.Rd +++ b/man/review_pull_request.Rd @@ -28,6 +28,7 @@ Testing of this function unfortunately needs to be manual. Test cases: \item Add a bad URL (manual review). \item Change a URL (manual review). \item Add a file in a forbidden place (close). +\item Add a custom JSON file which can be parsed (manual review). } } diff --git a/man/review_pull_requests.Rd b/man/review_pull_requests.Rd index e52bbc0..3ee0741 100644 --- a/man/review_pull_requests.Rd +++ b/man/review_pull_requests.Rd @@ -25,6 +25,7 @@ Testing of this function unfortunately needs to be manual. Test cases: \item Add a bad URL (manual review). \item Change a URL (manual review). \item Add a file in a forbidden place (close). +\item Add a custom JSON file which can be parsed (manual review). } } diff --git a/man/try_message.Rd b/man/try_message.Rd new file mode 100644 index 0000000..0d9669b --- /dev/null +++ b/man/try_message.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_assert.R +\name{try_message} +\alias{try_message} +\title{Get try error message} +\usage{ +try_message(try_error, collapse = " ") +} +\arguments{ +\item{try_error}{\code{try()} error object.} + +\item{collapse}{Character of length 1, delimiter for the +lines of the message.} +} +\description{ +Get the error message of an error object from \code{try()}. +} +\keyword{internal} diff --git a/tests/test-assert_package.R b/tests/test-assert_package.R index 3eac478..6048333 100644 --- a/tests/test-assert_package.R +++ b/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", diff --git a/tests/test-build_universe.R b/tests/test-build_universe.R index a4b6a2e..5dbc721 100644 --- a/tests/test-build_universe.R +++ b/tests/test-build_universe.R @@ -1,3 +1,4 @@ +# Success test case for ordinary URLs. packages <- tempfile() dir.create(packages) writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) @@ -24,6 +25,7 @@ stopifnot(identical(json, exp)) unlink(packages, recursive = TRUE) unlink(universe) +# One of the URLs is malformed. packages <- tempfile() dir.create(packages) writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) @@ -39,3 +41,130 @@ out <- try( stopifnot(inherits(out, "try-error")) unlink(packages, recursive = TRUE) unlink(universe) + +# Acceptable custom JSON. +packages <- tempfile() +dir.create(packages) +writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) +writeLines( + c( + "{", + " \"package\": \"paws.analytics\",", + " \"url\": \"https://github.com/paws-r/paws\",", + " \"subdir\": \"cran/paws.analytics\",", + " \"branch\": \"*release\"", + "}" + ), + file.path(packages, "paws.analytics") +) +universe <- file.path(tempfile(), "out") +r.releases.utils::build_universe(input = packages, output = universe) +out <- jsonlite::read_json(path = universe) +exp <- list( + list( + package = "gh", + url = "https://github.com/r-lib/gh", + branch = "*release" + ), + list( + package = "paws.analytics", + url = "https://github.com/paws-r/paws", + branch = "*release", + subdir = "cran/paws.analytics" + ) +) +stopifnot(identical(out, exp)) +unlink(packages, recursive = TRUE) +unlink(universe) + +# Missing branch field +packages <- tempfile() +dir.create(packages) +writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) +writeLines( + c( + "{", + " \"package\": \"paws.analytics\",", + " \"url\": \"https://github.com/paws-r/paws\",", + " \"subdir\": \"cran/paws.analytics\"", + "}" + ), + file.path(packages, "paws.analytics") +) +universe <- file.path(tempfile(), "out") +out <- try( + r.releases.utils::build_universe(input = packages, output = universe), + silent = TRUE +) +stopifnot(inherits(out, "try-error")) +stopifnot( + grepl( + pattern = "JSON entry for package 'paws.analytics' must have fields", + x = r.releases.utils::try_message(out), + fixed = TRUE + ) +) +unlink(packages, recursive = TRUE) +unlink(universe) + +# Disagreeing package field +packages <- tempfile() +dir.create(packages) +writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) +writeLines( + c( + "{", + " \"package\": \"paws.analytics2\",", + " \"url\": \"https://github.com/paws-r/paws\",", + " \"subdir\": \"cran/paws.analytics\",", + " \"branch\": \"*release\"", + "}" + ), + file.path(packages, "paws.analytics") +) +universe <- file.path(tempfile(), "out") +out <- try( + r.releases.utils::build_universe(input = packages, output = universe), + silent = TRUE +) +stopifnot(inherits(out, "try-error")) +stopifnot( + grepl( + pattern = "The 'packages' field disagrees with the package name", + x = r.releases.utils::try_message(out), + fixed = TRUE + ) +) +unlink(packages, recursive = TRUE) +unlink(universe) + +# Bad branch field +packages <- tempfile() +dir.create(packages) +writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) +writeLines( + c( + "{", + " \"package\": \"paws.analytics\",", + " \"url\": \"https://github.com/paws-r/paws\",", + " \"subdir\": \"cran/paws.analytics\",", + " \"branch\": \"development\"", + "}" + ), + file.path(packages, "paws.analytics") +) +universe <- file.path(tempfile(), "out") +out <- try( + r.releases.utils::build_universe(input = packages, output = universe), + silent = TRUE +) +stopifnot(inherits(out, "try-error")) +stopifnot( + grepl( + pattern = "The 'branch' field of package", + x = r.releases.utils::try_message(out), + fixed = TRUE + ) +) +unlink(packages, recursive = TRUE) +unlink(universe)