implement several GitLab functions

NAMESPACE

@@ -32,6 +32,9 @@ export(wood_github_latest)
 export(wood_github_packages)
 export(wood_github_tags)
 export(wood_github_versions)
+export(wood_gitlab_dependencies)
+export(wood_gitlab_latest)
+export(wood_gitlab_packages)
 export(wood_local_dependencies)
 export(wood_local_packages)
 export(wood_local_versions)

NEWS.md

@@ -3,7 +3,7 @@
 * Reimplemented the code, replacing {httr} with {httr2}.
 * Updated code to reflect API changes in Bioconductor and R-universe.
 * Bioconductor data for releases 1.5-1.7 is no longer available.
-* Dropped support for older R versions (< 4.1.0) because they increase maintenance complexity significantly.
+* Dropped support for older R versions (< 4.1.0) because they increased maintenance complexity significantly.
 
 # woodendesc 0.1.0
 

R/github-packages.R

@@ -26,7 +26,7 @@ wood_github_packages <- function(user, include_forks = FALSE) {
 
   repos <- github_packages_cache(user)
   if (!include_forks) {
-    repos <- Filter(Negate(is_fork), repos)
+    repos <- Filter(Negate(is_github_fork), repos)
   }
   repos <- Filter(is_github_R_repo, repos)
   vapply(repos, `[[`, character(1), "name")

R/github-utils.R

@@ -16,7 +16,7 @@ is_github_R_repo <- function(repo) {
   ret[["exists"]]
 }
 
-is_fork <- function(repo) {
+is_github_fork <- function(repo) {
   repo[["fork"]]
 }
 

R/gitlab-dependencies.R

@@ -0,0 +1,62 @@
+#' Get dependencies of a package on GitLab
+#'
+#' @description This function queries GitLab for dependencies of the selected
+#' tagged commit of a repo. By default, it queries the latest commit instead.
+#'
+#' @template package
+#' @template git-user
+#' @param tag `character(1)`\cr
+#'  Tag of a commit on GitLab or `"latest"` for the latest (possibly untagged)
+#'  commit.
+#'
+#' @return A data frame with three columns, all in string format:
+#' * `package` (package name),
+#' * `version` (minimum version requirement or `NA` if none),
+#' * `type` (dependency type, e.g. `"Imports"`).
+#'
+#' @examples
+#' \donttest{
+#' wood_gitlab_dependencies("limonaid", "r-packages")
+#' wood_gitlab_dependencies("rock", "r-packages", tag = "0.6.3")
+#' }
+#'
+#' @family gitlab
+#' @family dependencies
+#' @export
+wood_gitlab_dependencies <- function(package, user, tag = "latest") {
+  assert_param_package(package)
+  assert_param_git_user(user)
+  assert_param_tag(tag)
+
+  desc <- gitlab_description_cache(package, user, tag)
+  desc <- read_dcf(desc)[[package]]
+  extract_dependencies(desc)
+}
+
+gitlab_description_cache <- function(package, user, tag) {
+  if (tag == "latest") {
+    ret <- with_cache({
+      content <- guess_default_branch_gl(user, package, "DESCRIPTION") |>
+        httr2::resp_body_string()
+      list(exists = TRUE, content = content)
+    }, "DESCRIPTION", "gitlab", user, package)
+    ret[["content"]]
+  } else {
+    with_cache({
+      rlang::try_fetch({
+        httr2::request("https://gitlab.com") |>
+          httr2::req_url_path_append(user, package, "-", "raw", tag, "DESCRIPTION") |>
+          httr2::req_perform() |>
+          httr2::resp_body_string()
+      }, httr2_http_429 = function(cnd) {
+        abort_gl_rate_limit(cnd)
+      }, httr2_http_404 = function(cnd) {
+        rlang::abort(
+          c(sprintf("Can't find DESCRIPTION file in `%1$s/%2$s` repository on Gitlab.", user, package),
+            "i" = sprintf("Is `%1$s` a valid tag?", tag)),
+          parent = cnd
+        )
+      })
+    }, "DESCRIPTION", "gitlab", user, package, tag)
+  }
+}

R/gitlab-latest.R

@@ -0,0 +1,31 @@
+#' Get current package version on GitLab
+#'
+#' @description This function queries GitLab for the code of the current package
+#' version. This may reference a non-tagged commit; for the analysis of tagged
+#' commits only, see [wood_gitlab_versions()].
+#'
+#' @template package
+#' @template git-user
+#'
+#' @return A character vector of version codes.
+#'
+#' @examples
+#' \donttest{
+#' # Latest version code is returned
+#' wood_gitlab_latest("rock", "r-packages")
+#'
+#' # To get the latest *tagged* version code instead, use:
+#' codes <- wood_gitlab_versions("rock", "r-packages")
+#' versionsort::ver_latest(codes)
+#' }
+#'
+#' @family gitlab
+#' @family versions
+#' @export
+wood_gitlab_latest <- function(package, user) {
+  assert_param_package(package)
+  assert_param_git_user(user)
+
+  desc <- gitlab_description_cache(package, user, "latest")
+  read_dcf_one_value(desc, "Version")
+}

R/gitlab-packages.R

@@ -0,0 +1,58 @@
+#' List available package on a Gitlab account
+#'
+#' @description This function finds packages among repositories belonging to a
+#' selected account. They are returned as a vector of strings, each element
+#' being a repository (and in most cases, package) name.
+#'
+#' @template git-user
+#' @param include_forks `logical(1)`\cr
+#'  Whether to include packages forked from other accounts.
+#'
+#' @return A character vector of available packages.
+#'
+#' @examples
+#' \donttest{
+#' wood_gitlab_packages("r-packages")
+#' # The function takes care of differentiating
+#' # between users and groups internally
+#' wood_gitlab_packages("matherion")
+#' }
+#'
+#' @family gitlab
+#' @family packages
+#' @export
+wood_gitlab_packages <- function(user, include_forks = FALSE) {
+  assert_param_git_user(user)
+  assert_param_include_forks(include_forks)
+
+  repos <- gitlab_packages_cache(user)
+  if (!include_forks) {
+    repos <- Filter(Negate(is_gitlab_fork), repos)
+  }
+  repos <- Filter(is_gitlab_R_repo, repos)
+  vapply(repos, `[[`, character(1), "path")
+}
+
+gitlab_packages_cache <- function(user) {
+  with_cache({
+    rlang::try_fetch({
+      api_path <- if (is_gitlab_user(user)) "users" else "groups"
+      httr2::request("https://gitlab.com") |>
+        httr2::req_url_path_append("api", "v4", api_path, user, "projects") |>
+        httr2::req_url_query(per_page = 100) |>
+        httr2::req_perform_iterative(
+          next_req = httr2::iterate_with_link_url(rel = "next"),
+          # There isn't much point in returning incomplete data
+          on_error = "stop"
+        ) |>
+        httr2::resps_data(httr2::resp_body_json)
+    }, httr2_http_429 = function(cnd) {
+      abort_gl_rate_limit(cnd)
+    }, httr2_http_404 = function(cnd) {
+      rlang::abort(
+        sprintf("Can't find user or group `%1$s` on GitLab.", user),
+        parent = cnd
+      )
+    })
+  }, "repos", "gitlab", user)
+}

R/gitlab-utils.R

@@ -0,0 +1,49 @@
+is_gitlab_user <- function(user) {
+  with_cache({
+    rlang::try_fetch({
+      content <- httr2::request("https://gitlab.com") |>
+        httr2::req_url_path_append("api", "v4", "users") |>
+        httr2::req_url_query(username = user) |>
+        httr2::req_perform() |>
+        httr2::resp_body_json()
+      # If is GitLab user, then the response is not empty
+      length(content) > 0
+    }, httr2_http_403 = function(cnd) {
+      abort_gh_rate_limit(cnd)
+    })
+  }, "user", "gitlab", user)
+}
+
+is_gitlab_R_repo <- function(repo) {
+  owner <- repo[["namespace"]][["path"]]
+  name <- repo[["path"]]
+  branch <- repo[["default_branch"]]
+  ret <- with_cache({
+    rlang::try_fetch({
+      content <- httr2::request("https://gitlab.com") |>
+        httr2::req_url_path_append(owner, name, "-", "raw", branch, "DESCRIPTION") |>
+        httr2::req_perform() |>
+        httr2::resp_body_string()
+      list(exists = TRUE, content = content)
+    }, error = function(cnd) {
+      list(exists = FALSE, content = NULL)
+    })
+  }, "DESCRIPTION", "gitlab", owner, name)
+  ret[["exists"]]
+}
+
+is_gitlab_fork <- function(repo) {
+  !is.null(repo[["forked_from_project"]])
+}
+
+guess_default_branch_gl <- function(user, package, ...) {
+  ret <- guess_default_branch("gitlab", user, package, ..., branches = c("master", "main", "dev", "prod"))
+
+  if (!is.null(ret)) {
+    return(ret)
+  }
+
+  rlang::abort(
+    sprintf("Can't find repository `%1$s/%2$s` on Gitlab.", user, package)
+  )
+}

R/utils-error.R

@@ -10,3 +10,10 @@ abort_gh_rate_limit <- function(cnd) {
     parent = cnd
   )
 }
+
+abort_gl_rate_limit <- function(cnd) {
+  rlang::abort(
+    "Exceeded GitLab API limit.",
+    parent = cnd
+  )
+}