use pkgdepends syntax for gitlab remotes with pak

NEWS.md

@@ -1,6 +1,13 @@
 
 # renv (development version)
 
+* `renv::install()` and `renv::restore()` with pak enabled can now handle
+  packages hosted on a self-hosted GitLab instance. renv previously handed
+  pak remotes of the form `gitlab@<host>::<group>/<project>`, which pak was
+  unable to parse; renv now translates these into pkgdepends' own syntax,
+  `gitlab::https://<host>/<group>/<project>`. GitLab sub-directories are
+  likewise translated to pkgdepends' `/-/<subdir>` syntax. (#2180)
+
 * `renv::remove()` gains a `prompt` argument, and now asks for confirmation
   before removing packages from a library other than the project library --
   for example, when called without an activated renv project, where the

R/pak.R

@@ -100,6 +100,35 @@ renv_pak_update <- function(project, library, prompt) {
 
 }
 
+# translate a user-provided remote spec into one which pak understands;
+# specs which are already pak-compatible are returned as-is
+renv_pak_remote <- function(spec) {
+
+  remote <- catch(renv_remotes_parse(spec))
+  if (inherits(remote, "error"))
+    return(spec)
+
+  if (!identical(remote$type, "gitlab"))
+    return(spec)
+
+  # we have no way of expressing a merge request with pkgdepends' syntax;
+  # pass the spec through unchanged, so pak can report the problem itself
+  if (!is.null(remote$pull))
+    return(spec)
+
+  record <- list(
+    Package        = remote$package,
+    RemoteHost     = remote$host,
+    RemoteUsername = remote$user,
+    RemoteRepo     = remote$repo,
+    RemoteSubdir   = remote$subdir,
+    RemoteRef      = remote$ref
+  )
+
+  renv_record_format_remote_pak_gitlab(record, versioned = FALSE)
+
+}
+
 renv_pak_install <- function(packages,
                              library,
                              type,
@@ -159,12 +188,17 @@ renv_pak_install <- function(packages,
     return(renv_pak_update(project, library, prompt))
   }
 
+  # renv's GitLab remote syntax (e.g. 'gitlab@host::group/project') isn't
+  # understood by pak, so translate those specs into pkgdepends' own syntax
+  # https://github.com/rstudio/renv/issues/2180
+  packages <- map_chr(packages, renv_pak_remote)
+
   # pak doesn't support ':' as a sub-directory separator, so try to
   # repair that here
   # https://github.com/rstudio/renv/issues/2011
   pattern <- "(?<!:):([^/#@:]+)"
   packages <- gsub(pattern, "/\\1", packages, perl = TRUE)
-  
+
   # build parameters. explicitly-requested packages always get 'reinstall',
   # so they are installed even when already current -- matching renv's non-pak
   # installer, which always (re)installs explicitly-requested packages. with

R/records.R

@@ -166,6 +166,12 @@ renv_record_format_remote <- function(record,
   subdir <- record[["RemoteSubdir"]]
   subdirsep <- if (pak) "/" else ":"
 
+  # renv's 'gitlab@host::' syntax isn't understood by pak (pkgdepends), and its
+  # sub-directory syntax differs as well, so format those remotes separately
+  # https://github.com/rstudio/renv/issues/2180
+  if (pak && (identical(source, "gitlab") || identical(type, "gitlab")))
+    return(renv_record_format_remote_pak_gitlab(record, versioned = versioned))
+
   # skip type and host if they're defaults
   if (identical(type, "github")) {
     if (is.null(host) || identical(host, "api.github.com")) {
@@ -228,6 +234,46 @@ renv_record_format_remote <- function(record,
   return(remote)
 }
 
+# format a GitLab record using pkgdepends' own remote syntax, as used by pak:
+#
+#   [<package>=]gitlab::[<protocol>://<host>/]<group>/<project>[/-/<subdir>][@<ref>]
+#
+renv_record_format_remote_pak_gitlab <- function(record, versioned = TRUE) {
+
+  package <- record[["Package"]]
+  host    <- record[["RemoteHost"]] %||% config$gitlab.host()
+  user    <- record[["RemoteUsername"]]
+  repo    <- record[["RemoteRepo"]]
+  ref     <- record[["RemoteRef"]]
+  sha     <- record[["RemoteSha"]]
+  subdir  <- record[["RemoteSubdir"]]
+
+  stk <- stack(mode = "character")
+
+  # pkgdepends infers the package name from the last path component, which is
+  # wrong whenever a sub-directory is involved, so be explicit when we can
+  if (!is.null(package) && !identical(package, repo))
+    stk$push(package, "=")
+
+  # note that the host has to be spelled as a URL; pkgdepends would otherwise
+  # parse it as the leading component of the project path
+  stk$push("gitlab::", renv_retrieve_origin(host), "/")
+
+  stk$push(user, "/", repo)
+
+  # pkgdepends uses GitLab's own '/-/<path>' syntax for sub-directories
+  if (!is.null(subdir) && nzchar(subdir))
+    stk$push("/-/", subdir)
+
+  if (versioned)
+    stk$push("@", sha %||% ref %||% "HEAD")
+  else if (length(ref))
+    stk$push("@", ref)
+
+  paste(stk$data(), collapse = "")
+
+}
+
 renv_record_format_short <- function(record, versioned = FALSE) {
 
   if (is.null(record))

tests/testthat/test-pak.R

@@ -147,6 +147,77 @@ test_that("install() appends reinstall to specs that already carry a query", {
 
 })
 
+test_that("install() translates renv's gitlab remote syntax for pak (#2180)", {
+
+  skip_on_cran()
+  skip_on_windows()
+  skip_if_not_installed("pak")
+  pak <- renv_namespace_load("pak")
+  renv_scope_options(renv.config.pak.enabled = TRUE)
+  renv_tests_scope()
+
+  args <- NULL
+  local_mocked_bindings(renv_pak_init = function(...) invisible(NULL))
+  local_mocked_bindings(
+    .package = "pak",
+    pkg_install = function(pkg, ...) {
+      args <<- pkg
+      invisible(data.frame(package = character()))
+    }
+  )
+
+  # pak (pkgdepends) doesn't understand 'gitlab@host::', and expects
+  # sub-directories to be separated with '/-/'
+  quietly(install("gitlab@gitlab.example.de::bioinf/rlib/testpackage"))
+  expect_equal(unname(args), "gitlab::https://gitlab.example.de/bioinf/rlib/testpackage?reinstall")
+
+  quietly(install("gitlab::group/repo:subdir@main"))
+  expect_equal(unname(args), "gitlab::https://gitlab.com/group/repo/-/subdir@main?reinstall")
+
+})
+
+test_that("restore() translates gitlab remotes for pak (#2180)", {
+
+  skip_on_cran()
+  skip_on_windows()
+  skip_if_not_installed("pak")
+  pak <- renv_namespace_load("pak")
+  renv_scope_options(renv.config.pak.enabled = TRUE)
+  renv_tests_scope()
+
+  args <- NULL
+  local_mocked_bindings(
+    .package = "pak",
+    pkg_install = function(pkg, ...) {
+      args <<- pkg
+      invisible(data.frame(package = character()))
+    }
+  )
+
+  lockfile <- list(
+    Packages = list(
+      testpackage = list(
+        Package        = "testpackage",
+        Version        = "0.1.0",
+        Source         = "GitLab",
+        RemoteType     = "gitlab",
+        RemoteHost     = "gitlab.example.de",
+        RemoteUsername = "bioinf",
+        RemoteRepo     = "rlib/testpackage",
+        RemoteSubdir   = "",
+        RemoteRef      = "main",
+        RemoteSha      = "babda05db8146b37a552c77651e2cd084a05ce98"
+      )
+    )
+  )
+
+  renv_pak_restore(lockfile)
+
+  expected <- "testpackage=gitlab::https://gitlab.example.de/bioinf/rlib/testpackage@babda05db8146b37a552c77651e2cd084a05ce98"
+  expect_equal(unname(args), expected)
+
+})
+
 test_that("install() does not upgrade transitively-pulled recommended packages (#2329)", {
 
   skip_on_cran()

tests/testthat/test-records.R

@@ -210,6 +210,45 @@ test_that("remote hosts are included when formatting", {
 
 })
 
+test_that("gitlab remotes are formatted using pkgdepends syntax for pak (#2180)", {
+
+  record <- list(
+    Package        = "testpackage",
+    Version        = "0.1.0",
+    Source         = "GitLab",
+    RemoteType     = "gitlab",
+    RemoteHost     = "gitlab.example.de",
+    RemoteUsername = "bioinf",
+    RemoteRepo     = "rlib/testpackage",
+    RemoteSubdir   = "",
+    RemoteRef      = "main",
+    RemoteSha      = "babda05db8146b37a552c77651e2cd084a05ce98"
+  )
+
+  # renv's own 'gitlab@host::' syntax is retained for display
+  remote <- renv_record_format_remote(record)
+  expect_equal(remote, "testpackage=gitlab@gitlab.example.de::bioinf/rlib/testpackage@babda05db8146b37a552c77651e2cd084a05ce98")
+
+  # ... but pak requires the host to be spelled as a URL
+  remote <- renv_record_format_remote(record, pak = TRUE)
+  expect_equal(remote, "testpackage=gitlab::https://gitlab.example.de/bioinf/rlib/testpackage@babda05db8146b37a552c77651e2cd084a05ce98")
+
+  # the default host is included as well, so that a sub-directory can never
+  # be mistaken for the project name
+  record$RemoteHost <- NULL
+  record$RemoteUsername <- "group"
+  record$RemoteRepo <- "repo"
+  record$RemoteSubdir <- "testpackage"
+
+  remote <- renv_record_format_remote(record, pak = TRUE)
+  expect_equal(remote, "testpackage=gitlab::https://gitlab.com/group/repo/-/testpackage@babda05db8146b37a552c77651e2cd084a05ce98")
+
+  # unversioned remotes use the ref, if any
+  remote <- renv_record_format_remote(record, pak = TRUE, versioned = FALSE)
+  expect_equal(remote, "testpackage=gitlab::https://gitlab.com/group/repo/-/testpackage@main")
+
+})
+
 test_that("renv_record_source infers 'repository' from Repository field", {
 
   # a record with Source explicitly set uses that