Merge pull request #12 from r-releases/gitlab-and-cran

GitLab releases and `"branch": "release"` exceptions

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: r.releases.internals
 Title: Internal Infrastructure for An R Universe of Package Releases
 Description: Internal infrastructure for an R universe of package releases.
-Version: 0.0.9
+Version: 0.0.10
 License: MIT + file LICENSE
 URL: https://github.com/r-releases/r.releases.internals
 BugReports: https://github.com/r-releases/r.releases.internals/issues

NAMESPACE

@@ -3,12 +3,12 @@
 export(assert_cran_url)
 export(assert_package)
 export(assert_release_exists)
-export(build_universe)
 export(get_current_versions)
 export(record_versions)
 export(review_pull_request)
 export(review_pull_requests)
 export(try_message)
+export(write_universe_manifest)
 importFrom(gh,gh)
 importFrom(jsonlite,parse_json)
 importFrom(jsonlite,read_json)

NEWS.md

@@ -1,3 +1,9 @@
+# r.releases.internals 0.0.10
+
+* Automatically merge GitLab URLs with non-"upcoming" releases.
+* Rename `build_universe()` to `write_universe_manifest()`. 
+* `write_universe_manifest()` omits `"branch": "release"` from listings originating from a short list of prespecified GitHub/GitLab owners. The new `release_exceptions` can accept `"https://github.com/cran"`, for example.
+
 # r.releases.internals 0.0.9
 
 * Change the package name to `r.releases.internals`.

R/assert_package.R

@@ -31,10 +31,10 @@ assert_package <- function(name, url) {
 
 assert_package_lite <- function(name, url) {
   if (!is_package_name(name)) {
-    return("Invalid package name.")
+    return("Invalid package name")
   }
   if (!is_character_scalar(url)) {
-    return("Invalid package URL.")
+    return("Invalid package URL")
   }
   name <- trimws(name)
   url <- trimws(trim_trailing_slash(url))
@@ -45,7 +45,7 @@ assert_package_lite <- function(name, url) {
     )
   }
   if (!identical(parsed_url[["scheme"]], "https")) {
-    return(paste("Scheme of URL", shQuote(url), "is not https."))
+    return(paste("Scheme of URL", shQuote(url), "is not https"))
   }
 }
 
@@ -78,13 +78,13 @@ assert_package_lints <- function(name, url) {
       paste(
         "URL",
         shQuote(url),
-        "appears to be an owner, not a repository."
+        "appears to be an owner, not a repository"
       )
     )
   }
   owner <- tolower(splits[nzchar(splits)][1L])
   if (identical(owner, "cran")) {
-    return(paste("URL", shQuote(url), "appears to use a CRAN mirror."))
+    return(paste("URL", shQuote(url), "appears to use a CRAN mirror"))
   }
 }
 
@@ -101,58 +101,3 @@ assert_url_exists <- function(url) {
     )
   }
 }
-
-#' @title Check for a release.
-#' @export
-#' @keywords internal
-#' @description Check for a release.
-#' @return A character string if there is a problem with the package entry,
-#'   otherwise `NULL` if there are no issues.
-#' @inheritParams assert_package
-assert_release_exists <- function(url) {
-  if (nanonext::parse_url(url)[["host"]] == "gitlab.com") {
-    return(
-      paste0(
-        "Trying to find a release at ",
-        shQuote(url),
-        ". Unfortunately, GitLab releases are hard to detect automatically."
-      )
-    )
-  }
-  response <- nanonext::ncurl(
-    file.path(url, "releases", "latest"),
-    convert = FALSE
-  )
-  status <- response[["status"]]
-  if (status != 302L) {
-    return(
-      paste(
-        "Checking releases at",
-        shQuote(url),
-        "returned HTTP error",
-        nanonext::status_code(status)
-      )
-    )
-  }
-  found <- identical(
-    dirname(as.character(response$headers$Location)),
-    file.path(url, "releases", "tag")
-  )
-  if (!found) {
-    return(
-      paste0(
-        "No release found at URL ",
-        shQuote(url),
-        ". To bypass manual review and have a smoother package ",
-        "registration experience, you could close this pull request, ",
-        "create a release for your package, ",
-        "and then try submitting another pull request. ",
-        "Please see ",
-        shQuote(
-          "https://github.com/r-lib/gh/releases/tag/v1.4.0"
-        ),
-        " for an example of a release."
-      )
-    )
-  }
-}

R/assert_release_exists.R

@@ -0,0 +1,67 @@
+#' @title Check for a release.
+#' @export
+#' @keywords internal
+#' @description Check for a release.
+#' @return A character string if there is a problem with the package entry,
+#'   otherwise `NULL` if there are no issues.
+#' @inheritParams assert_package
+assert_release_exists <- function(url) {
+  host <- url_parse(url)[["host"]]
+  if (host == "github.com") {
+    assert_release_github(url)
+  } else if (host == "gitlab.com") {
+    assert_release_gitlab(url)
+  }
+}
+
+assert_release_github <- function(url) {
+  parsed_url <- url_parse(url)
+  releases <- try(
+    gh::gh(
+      endpoint = "/repos/:owner/:repo/releases",
+      owner = basename(dirname(parsed_url[["path"]])),
+      repo = basename(parsed_url[["path"]])
+    ),
+    silent = TRUE
+  )
+  if (inherits(releases, "try-error")) {
+    return(try_message(releases))
+  }
+  releases <- Filter(
+    f = function(release) {
+      !isTRUE(release$prerelease)
+    },
+    x = releases
+  )
+  if (!length(releases)) {
+    return(paste("No full release found at URL", shQuote(url)))
+  }
+}
+
+assert_release_gitlab <- function(url) {
+  parsed_url <- url_parse(url)
+  owner <- basename(dirname(parsed_url[["path"]]))
+  repo <- basename(parsed_url[["path"]])
+  endpoint <- sprintf(
+    "https://gitlab.com/api/v4/projects/%s%s%s/releases",
+    owner,
+    "%2F",
+    repo
+  )
+  releases <- try(
+    suppressWarnings(
+      jsonlite::stream_in(
+        con = gzcon(url(endpoint)),
+        simplifyVector = TRUE,
+        simplifyDataFrame = TRUE
+      )
+    ),
+    silent = TRUE
+  )
+  if (inherits(releases, "try-error")) {
+    return(try_message(releases))
+  }
+  if (!nrow(releases) || !any(!releases$upcoming_release)) {
+    return(paste("No full release found at URL", shQuote(url)))
+  }
+}

R/utils_url.R

@@ -1,5 +1,9 @@
 url_parse <- function(url) {
-  nanonext::parse_url(trim_trailing_slash(url))
+  nanonext::parse_url(trim_url(url))
+}
+
+trim_url <- function(url) {
+  trim_trailing_slash(trimws(url))
 }
 
 trim_trailing_slash <- function(url) {

R/build_universe.R → R/write_universe_manifest.R

@@ -1,40 +1,55 @@
-#' @title Build the universe.
+#' @title Build the `packages.json` manifest for the universe.
 #' @export
 #' @keywords internal
-#' @description Create the `r-universe` `packages.json` file
+#' @description Create the R-universe `packages.json` file
 #'   from constituent text files with URLs.
 #' @return NULL (invisibly)
 #' @param input Character of length 1, directory path with the
 #'   text file listings of R releases.
 #' @param output Character of length 1, file path where the
-#'   `r-universe` `packages.json` file will be written.
-build_universe <- function(input = getwd(), output = "packages.json") {
+#'   R-universe `packages.json` file will be written.
+#' @param release_exceptions Character vector of URLs of GitHub owners
+#'   where `"branch": "*release"` should be omitted. Example:
+#'   `"https://github.com/cran"`.
+write_universe_manifest <- function(
+  input = getwd(),
+  output = "packages.json",
+  release_exceptions = character(0L)
+) {
   assert_character_scalar(input, "invalid input")
   assert_character_scalar(output, "invalid output")
   assert_file(input)
   packages <- list.files(input, all.files = FALSE, full.names = TRUE)
   message("Processing ", length(packages), " package entries.")
-  entries <- lapply(X = packages, FUN = read_package_entry)
+  entries <- lapply(
+    X = packages,
+    FUN = read_package_entry,
+    release_exceptions = release_exceptions
+  )
   message("Aggregating ", length(entries), " package entries.")
   aggregated <- do.call(what = vctrs::vec_rbind, args = entries)
   if (!file.exists(dirname(output))) {
     dir.create(dirname(output))
   }
-  message("Writing packages.json.")
+  message("Writing ", output)
   jsonlite::write_json(x = aggregated, path = output, pretty = TRUE)
   invisible()
 }
 
-read_package_entry <- function(package) {
+read_package_entry <- function(package, release_exceptions) {
   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)
+  json <- try(jsonlite::parse_json(lines), silent = TRUE)
+  if (inherits(json, "try-error")) {
+    json <- package_entry_url(name = name, url = lines)
   } else {
-    package_entry_json(name = name, json = out)
+    json <- package_entry_json(name = name, json = json)
   }
+  decide_release_exceptions(
+    json = json,
+    release_exceptions = release_exceptions
+  )
 }
 
 package_entry_url <- function(name, url) {
@@ -97,3 +112,10 @@ package_entry_json <- function(name, json) {
   }
   as.data.frame(json)
 }
+
+decide_release_exceptions <- function(json, release_exceptions) {
+  if (dirname(trim_url(json$url)) %in% trim_url(release_exceptions)) {
+    json$branch <- NULL
+  }
+  json
+}

tests/test-assert_package.R

@@ -164,20 +164,21 @@ stopifnot(
 
 stopifnot(
   grepl(
-    "No release found at URL",
+    "No full release found at URL",
     r.releases.internals::assert_package(
-      name = "dllreprex",
-      url = "https://github.com/wlandau/dllreprex"
+      name = "test.no.release",
+      url = "https://github.com/wlandau/test.no.release"
     ),
     fixed = TRUE
   )
 )
 
 stopifnot(
   grepl(
-    "GitLab releases are hard to detect automatically",
-    r.releases.internals::assert_release_exists(
-      url = "https://gitlab.com/owner/repo"
+    "No full release found at URL",
+    r.releases.internals::assert_package(
+      name = "test.no.release",
+      url = "https://gitlab.com/wlandau/test.no.release"
     ),
     fixed = TRUE
   )
@@ -192,6 +193,15 @@ stopifnot(
   )
 )
 
+stopifnot(
+  is.null(
+    r.releases.internals::assert_package(
+      name = "test",
+      url = "https://gitlab.com/wlandau/test"
+    )
+  )
+)
+
 stopifnot(
   is.null(
     r.releases.internals::assert_cran_url(