Merge pull request #145 from openpharma/devel

Add renv lockfiles into object and use renv::install for external deps if inside renv environment

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: staged.dependencies
 Type: Package
 Title: Install R packages from Particular Git Branches
-Version: 0.2.4
+Version: 0.2.5
 Authors@R: c(
   person("Adrian", "Waddell", email = "[email protected]", role = c("aut", "cre")),
   person("Maximilian", "Mordig", email = "[email protected]", role = "aut"),
@@ -16,6 +16,7 @@ Imports:
     git2r,
     glue,
     httr,
+    jsonlite,
     methods,
     rcmdcheck,
     remotes,
@@ -32,11 +33,13 @@ Description: When developing multiple dependent packages, it is often useful to
 License: file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.0
+Roxygen: list(markdown = TRUE)
 Suggests: 
     knitr,
     miniUI,
     mockery,
+    renv,
     rmarkdown,
     rstudioapi,
     shiny,
@@ -52,6 +55,7 @@ Collate:
     'graph_methods.R'
     'host.R'
     'ref_strategy.R'
+    'renv.R'
     'rstudio_jobs.R'
     'rstudio_addins.R'
     'utils.R'

NEWS.md

@@ -1,4 +1,7 @@
-# staged.dependencies 0.2.5 (unreleased)
+# staged.dependencies 0.2.5 
+
+* Added `renv_files` element into `dependency_structure` object to capture (in JSON) the renv.lock files from internal dependencies for future processing. The `renv_profile` argument to `dependency_table` allows you to choose which renv profile to include if not using the default one.
+* Use `renv::install` to install external dependencies if inside an `renv` environment so that the renv cache is used
 
 # staged.dependencies 0.2.4
 

R/caching.R

@@ -96,8 +96,10 @@ copy_local_repo_to_cachedir <- function(local_dir, repo, host, select_ref_rule,
 
   lapply(fs::dir_ls(local_dir, type = "directory", all = TRUE), function(dir) {
     directory_to_copy <- utils::tail(strsplit(dir, .Platform$file.sep)[[1]], 1)
-    if(directory_to_copy != "renv") {
+    if (directory_to_copy != "renv") {
       fs::dir_copy(dir, repo_dir)
+    } else {
+      copy_renv_profiles(dir, repo_dir)
     }
   })
 
@@ -149,6 +151,26 @@ copy_local_repo_to_cachedir <- function(local_dir, repo, host, select_ref_rule,
               sha = get_short_sha(repo_dir), accessible = TRUE))
 }
 
+
+# we need to copy lock files for different profiles which are stored
+# within the renv folder but not copy all the libraries
+copy_renv_profiles <- function(renv_directory, repo_dir) {
+  renv_sub_directories <- fs::dir_ls(renv_directory, type = "directory", all = TRUE)
+  if ("profiles" %in% fs::path_file(renv_sub_directories)) {
+    renv_profiles <- fs::dir_ls(fs::path_join(c(renv_directory, "profiles")),
+                                type = "directory", all = TRUE)
+    lapply(renv_profiles, function(x) {
+      fs::dir_create(fs::path_join(c(repo_dir, "renv", "profiles", fs::path_file(x))), recurse = TRUE)
+      if (fs::file_exists(fs::path_join(c(x, "renv.lock")))) {
+        fs::file_copy(
+          path = fs::path_join(c(x, "renv.lock")),
+          new_path = fs::path_join(c(repo_dir, "renv", "profiles", fs::path_file(x), "renv.lock"))
+        )
+      }
+    })
+  }
+}
+
 # local_repos: data.frame that maps repo and host to local directory
 # returns named character vector mapping hashed repo and host to the directory
 get_hashed_repo_to_dir_mapping <- function(local_repos) {

R/dependencies.R

@@ -23,6 +23,8 @@
 #'   either "upstream","downstream" or "all".
 #' @param fallback_branch (`character`) the default branch to try to use if
 #'   no other matches found
+#' @param renv_profile (`character`) the name of the renv profile of the `renv.lock` files
+#'   to be included from the repos. The standard `renv.lock` file uses the default `NULL` argument here.
 #' @param verbose (`numeric`) verbosity level, incremental;
 #'   (0: None, 1: packages that get installed + high-level git operations,
 #'   2: includes git checkout infos)
@@ -44,6 +46,8 @@
 #'               R packages found in the description files of the internal packages. It is a dataframe
 #'               of the form returned by `desc::desc_get_deps`}
 #'   \item{direction}{`direction` argument used to create object}
+#'   \item{renv_files}{`named list` containing the json of the renv.lock files for the chosen profile for
+#'                     each repo. An entry to the list is `NULL` if a repos does not have the required lock file}
 #' }
 #' @md
 #' @export
@@ -64,6 +68,7 @@ dependency_table <- function(project = ".",
                              local_repos = if ((project_type) == "local") get_local_pkgs_from_config() else NULL,
                              direction = "all",
                              fallback_branch = "main",
+                             renv_profile = NULL,
                              verbose = 1) {
 
   # validate arguments
@@ -129,7 +134,6 @@ dependency_table <- function(project = ".",
   # deps is ordered topologically
   deps <- get_true_deps_graph(internal_deps, graph_directions = "all")
 
-
   current_pkg <- internal_deps$package_name[
     internal_deps$repo == repo_to_process[[1]]$repo &
       internal_deps$host == repo_to_process[[1]]$host
@@ -174,14 +178,19 @@ dependency_table <- function(project = ".",
   internal_deps$install_index <- vapply(internal_deps$package_name,
                                         function(y) which(names(deps[["upstream_deps"]]) == y),
                                         FUN.VALUE = numeric(1))
+
+  renv_files <- lapply(internal_deps$cache_dir, get_renv_lock_from_repo_dir, renv_profile = renv_profile)
+  names(renv_files) <- internal_deps$package_name
+
   structure(
     list(
       project = if (project_type == "local") fs::path_abs(project) else project,
       project_type = project_type,
       current_pkg = current_pkg,
       table = internal_deps,
       deps = deps,
-      direction = direction
+      direction = direction,
+      renv_files = renv_files
     ),
     class = "dependency_structure"
   )
@@ -317,14 +326,17 @@ plot.dependency_structure <- function(x, y, ...){
 #' @param install_direction "upstream", "downstream" or "all"; which packages
 #'   to install (according to dependency structure). By default this is only "upstream"
 #' @param install_external_deps logical to describe whether to install
-#'   external dependencies of packages using `remotes::install_deps`.
-#' @param upgrade argument passed to `remotes::install_deps`, defaults to 'never'.
+#'   external dependencies of package using [remotes::install_deps()] (or [renv::install()] if
+#'   inside an renv environment) .
+#' @param upgrade argument passed to [remotes::install_deps()], defaults to `'never'`. Ignored
+#'   if inside an `renv` environment.
 #' @param package_list (`character`) If not NULL, an additional filter, only packages on this
 #'   list will be considered and their dependencies installed if needed (advanced usage only).
 #' @param dry (`logical`) dry run that outputs what would happen without actually
 #'   doing it.
 #' @param verbose verbosity level, incremental; from 0 (none) to 2 (high)
-#' @param ... Additional args passed to `remotes::install_deps.
+#' @param ... Additional args passed to [remotes::install_deps()]. Ignored
+#'   if inside an `renv` environment.
 #'
 #' @return `data.frame` of performed actions
 #'

R/dependencies_app.R

@@ -14,6 +14,8 @@
 #' @param default_ref (`character`) default ref (branch/tag), see also the parameter
 #'   `ref` of `\link{dependency_table}`. If `NULL` this must be entered by app user
 #'   and can always be changed by the user.
+#' @param renv_profile (`character`) the name of the `renv` profile of the `renv.lock` files
+#'   to be included from the repos. The standard `renv.lock` file uses the default `NULL` argument here.
 #' @param fallback_branch (`character`) the default branch to try to use if
 #'   no other matches found
 #' @param run_gadget (`logical`) whether to run the app as a gadget
@@ -31,6 +33,7 @@ install_deps_app <- function(default_repo = NULL,
                              fallback_branch = "main",
                              run_gadget = TRUE, run_as_job = TRUE,
                              verbose = 1, install_external_deps = TRUE,
+                             renv_profile = NULL,
                              upgrade = "never", ...) {
   require_pkgs(c("shiny", "miniUI", "visNetwork"))
 
@@ -89,7 +92,7 @@ install_deps_app <- function(default_repo = NULL,
           }
           dependency_table(project = paste(input$repo, input$host, sep = "@"),
                            project_type = "repo@host", ref = input$ref, fallback_branch = fallback_branch,
-                           local_repos = NULL, verbose = 2)},
+                           local_repos = NULL, renv_profile = renv_profile, verbose = 2)},
           error = function(cond){
             error_rv(paste0("Cannot create dependency graph:\n", cond$message))
             NULL
@@ -151,7 +154,7 @@ install_deps_app <- function(default_repo = NULL,
             # this could be changed by using the importEnv argument
             # to jobRunScript and creating an install_deps job if dep_structure already exists in env
             install_deps_job(project = paste(input$repo, input$host, sep = "@"),  project_type = "repo@host", verbose = verbose,
-                             create_args = list(local_repos = NULL, ref = input$ref),
+                             create_args = list(local_repos = NULL, ref = input$ref, renv_profile = renv_profile),
                              dependency_packages = dependency_packages, fallback_branch = fallback_branch,
                              install_external_deps = install_external_deps,
                              install_direction = "all",

R/dependencies_helper.R

@@ -13,15 +13,18 @@
 #' @param internal_pkg_deps packages to not install (when `install_external_deps = TRUE`)
 #' @param dry logical, if `FALSE` (default) run the actions, if `TRUE` do not
 #' @param install_external_deps logical to describe whether to install
-#'   external dependencies of package using `remotes::install_deps`.
-#' @param upgrade argument passed to `remotes::install_deps`, defaults to 'never'.
+#'   external dependencies of package using [remotes::install_deps()] (or [renv::install()] if
+#'   inside an `renv` environment) .
+#' @param upgrade argument passed to [remotes::install_deps()], defaults to `'never'`. Ignored
+#'   if inside an `renv` environment.
 #' @param rcmd_args list with names `build`, `check`,
 #'   `install` which are vectors that are passed as separate arguments
 #'   to the `R CMD` commands
 #' @param artifact_dir directory to store log files, only when actions include
 #'   `build`; action `test` only outputs to the console
 #' @param verbose verbosity level, incremental - from 0 (none) to 2 (high)
-#' @param ... Additional args passed to `remotes::install_deps.
+#' @param ... Additional args passed to [remotes::install_deps()] Ignored
+#'   if inside an `renv` environment.
 run_package_actions <- function(pkg_actions, internal_pkg_deps,
                                 dry = FALSE,
                                 install_external_deps = TRUE,

R/git_tools.R

@@ -163,8 +163,9 @@ checkout_repo <- function(repo_dir, repo_url, select_ref_rule, token_envvar = NU
 # Install the external deps required for a package
 # does not install dependencies that appear in `internal_pkg_deps`
 install_external_deps <- function(repo_dir, internal_pkg_deps, ...) {
-  # `remotes::install_deps` only makes use of the package DESCRIPTION file via
-  # `remotes:::load_pkg_description`
+
+  # `remotes::install_deps` (and renv::install)
+  #  only makes use of the package DESCRIPTION file
   # So we create a temp directory containing this file and then call this function
   repo_dir_external <- tempfile(paste0(basename(repo_dir), "_externalDeps"))
   fs::dir_create(repo_dir_external)
@@ -174,10 +175,15 @@ install_external_deps <- function(repo_dir, internal_pkg_deps, ...) {
   # remove internal_pkg_deps from DESCRIPTION file
   desc_obj <- desc::desc(file.path(repo_dir_external, "DESCRIPTION"))
   new_deps <- desc_obj$get_deps()[!desc_obj$get_deps()$package %in% internal_pkg_deps,]
+
   desc_obj$set_deps(new_deps)
   desc_obj$write()
 
-  remotes::install_deps(repo_dir_external, ...)
+  if (!is.null(Sys.getenv("RENV_PROJECT")) && Sys.getenv("RENV_PROJECT") != "" && requireNamespace("renv", quietly = TRUE)) {
+    renv::install(repo_dir_external)
+  } else {
+    remotes::install_deps(repo_dir_external, ...)
+  }
 }
 
 

R/renv.R

@@ -0,0 +1,20 @@
+get_renv_lock_from_repo_dir <- function(repo_dir, renv_profile = NULL) {
+  if (!is.null(renv_profile)) {
+    renv_file <- fs::path_join(c(repo_dir, "renv", "profiles", renv_profile, "renv.lock"))
+  } else {
+    renv_file <- fs::path_join(c(repo_dir, "renv.lock"))
+  }
+
+
+  if (!fs::file_exists(renv_file)) {
+    return(NULL)
+  }
+
+  renv_lock <- tryCatch(
+    jsonlite::read_json(renv_file),
+    error = function(cond) {
+      warning(paste("Unable to open renv.lock file", renv_file, "so it will be ignored"))
+      NULL
+    })
+  return(renv_lock)
+}

R/rstudio_jobs.R

@@ -24,7 +24,8 @@ run_job <- function(text, tempfile_prefix = "file", jobname_prefix = "Job", ...)
 #' install_deps_job(create_args = list(direction = "all"))
 #' install_deps_job(dry_install = TRUE)
 #' }
-install_deps_job <- function(project = ".", project_type = "local", verbose = 1, create_args = list(), ...) {
+install_deps_job <- function(project = ".", project_type = "local", verbose = 1,
+                             create_args = list(renv_profile = Sys.getenv("RENV_PROFILE")), ...) {
   if (project_type == "local") {
     project <- normalize_path(project)
   }
@@ -58,7 +59,8 @@ install_deps_job <- function(project = ".", project_type = "local", verbose = 1,
 #'                      list(create_arg = list(ref = "6_makegraph@main")))
 #' check_downstream_job(only_tests = TRUE)
 #' }
-check_downstream_job <- function(project = ".", verbose = 1, create_args = list(), ...) {
+check_downstream_job <- function(project = ".", verbose = 1,
+                                 create_args = list(renv_profile = Sys.getenv("RENV_PROFILE")), ...) {
   project <- normalize_path(project)
   create_args <- c(list(project = project, verbose = verbose), create_args)
   create_args_str <- paste(deparse(create_args), collapse = "\n")