Add ability to install latest release from gitlab

NAMESPACE

@@ -15,6 +15,10 @@ S3method(github_resolve_ref,"NULL")
 S3method(github_resolve_ref,default)
 S3method(github_resolve_ref,github_pull)
 S3method(github_resolve_ref,github_release)
+S3method(gitlab_resolve_ref,"NULL")
+S3method(gitlab_resolve_ref,default)
+S3method(gitlab_resolve_ref,github_pull)
+S3method(gitlab_resolve_ref,github_release)
 S3method(print,package_deps)
 S3method(remote_download,bioc_git2r_remote)
 S3method(remote_download,bioc_xgit_remote)
@@ -71,6 +75,8 @@ export(github_pull)
 export(github_release)
 export(github_remote)
 export(gitlab_pat)
+export(gitlab_pull)
+export(gitlab_release)
 export(install_bioc)
 export(install_bitbucket)
 export(install_cran)

R/gitlab.R

@@ -0,0 +1,25 @@
+gitab_GET <- function(path, ..., host = "gitlab.com", pat = gitlab_pat(), use_curl = !is_standalone() && pkg_installed("curl")) {
+
+  url <- build_url(host, "api", "v4", path)
+
+  if (isTRUE(use_curl)) {
+    h <- curl::new_handle()
+    headers <- c(
+      if (!is.null(pat)) {
+        c("Authorization" = paste0("token ", pat))
+      }
+    )
+    curl::handle_setheaders(h, .list = headers)
+    res <- curl::curl_fetch_memory(url, handle = h)
+
+    if (res$status_code >= 300) {
+      stop("Error downloading from gitlab")
+    }
+    json$parse(raw_to_char_utf8(res$content))
+  } else {
+    tmp <- tempfile()
+    download(tmp, url, auth_token = pat)
+
+    json$parse_file(tmp)
+  }
+}

R/install-gitlab.R

@@ -52,12 +52,12 @@ install_gitlab <- function(repo,
                   ...)
 }
 
-gitlab_remote <- function(repo, subdir = NULL,
+gitlab_remote <- function(repo, ref = "HEAD", subdir = NULL,
                        auth_token = gitlab_pat(), sha = NULL,
                        host = "gitlab.com", ...) {
 
   meta <- parse_git_repo(repo)
-  meta$ref <- meta$ref %||% "HEAD"
+  meta <- gitlab_resolve_ref(meta$ref %||% ref, meta, host = host, auth_token = auth_token)
 
   remote("gitlab",
     host = host,
@@ -108,6 +108,72 @@ remote_metadata.gitlab_remote <- function(x, bundle = NULL, source = NULL, sha =
   )
 }
 
+#' GitLab references
+#'
+#' Use as `ref` parameter to [install_gitlab()].
+#' Allows installing a specific pull request or the latest release.
+#'
+#' @param pull The pull request to install
+#' @seealso [install_gitlab()]
+#' @rdname gitlab_refs
+#' @export
+gitlab_pull <- function(pull) structure(pull, class = "gitlab_pull")
+
+#' @rdname gitlab_refs
+#' @export
+gitlab_release <- function() structure(NA_integer_, class = "gitlab_release")
+
+gitlab_resolve_ref <- function(x, params, ...) UseMethod("gitlab_resolve_ref")
+
+#' @export
+gitlab_resolve_ref.default <- function(x, params, ...) {
+  params$ref <- x
+  params
+}
+
+#' @export
+gitlab_resolve_ref.NULL <- function(x, params, ...) {
+  params$ref <- "HEAD"
+  params
+}
+
+#' @export
+gitlab_resolve_ref.github_pull <- function(x, params, ..., host, auth_token = gitlab_pat()) {
+
+}
+
+# Retrieve the ref for the latest release
+#' @export
+gitlab_resolve_ref.github_release <- function(x, params, ..., host, auth_token = gitlab_pat()) {
+  # GET /projects/:user%2F:repo
+  path <- paste("projects",
+    utils::URLencode(paste0(params$username, "/", params$repo), reserved = TRUE),
+    sep = "/")
+  response <- tryCatch(
+    gitab_GET(path, host = host, pat = auth_token),
+    error = function(e) e
+  )
+
+  # GET /projects/:id/:releases
+  path <- paste("projects", response$id, "releases", sep = "/")
+  response <- tryCatch(
+    gitab_GET(path, host = host, pat = auth_token),
+    error = function(e) e
+  )
+
+  if (methods::is(response, "error") || !is.null(response$message)) {
+    stop("Cannot find repo ", params$username, "/", params$repo, ".", "\n",
+      response$message)
+  }
+
+  if (length(response) == 0L)
+    stop("No releases found for repo ", params$username, "/", params$repo, ".")
+
+  params$ref <- response[[1L]]$tag_name
+  params
+
+}
+
 #' @export
 remote_package_name.gitlab_remote <- function(remote, ...) {
 

R/install-remote.R

@@ -27,7 +27,7 @@ install_remote <- function(remote,
                            ...) {
 
   stopifnot(is.remote(remote))
-
+  
   package_name <- remote_package_name(remote)
   local_sha <- local_sha(package_name)
   remote_sha <- remote_sha(remote, local_sha)