Update pacage installation process

R/checker.R

@@ -82,6 +82,8 @@ checker <- R6::R6Class(
     #' @param restore `logical` value, whether output directory should be
     #'   unlinked before running checks. If `FALSE`, an attempt will me made to
     #'   restore previous progress from the same `output`.
+    #' @param dependencies A vector of length one or a named list.
+    #'  Compatible with [`as_pkg_dependencies`].
     #' @param ... Additional arguments unused
     #'
     #' @return [checker].
@@ -95,6 +97,7 @@ checker <- R6::R6Class(
       lib.loc = .libPaths(),
       repos = getOption("repos"),
       restore = options::opt("restore"),
+      dependencies = TRUE,
       ...
     ) {
       check_past_output(output, restore, ask = interactive())
@@ -111,7 +114,7 @@ checker <- R6::R6Class(
       )
       private$repos <- repos
 
-      self$graph <- task_graph(self$plan, repos)
+      self$graph <- task_graph(self$plan, repos, dependencies = dependencies)
       private$restore_complete_checks()
     },
 

R/pkg_origin.R

@@ -214,7 +214,7 @@ pkg_deps.pkg_origin_local <- function(
 
   indirect_deps <- pkg_dependencies(
     packages = direct_deps$name,
-    dependencies = dependencies,
+    dependencies = "hard",
     db = db
   )
   indirect_deps$depth <- rep.int("indirect", NROW(indirect_deps))

R/plan.R

@@ -7,12 +7,16 @@
 #'
 #' @param path path to the package source.
 #' @param repos repository used to identify reverse dependencies.
+#' @param remotes_dependencies A vector of length one or a named list.
+#'  Compatible with [`as_pkg_dependencies`]. Used to filter out remotes
+#'  dependencies.
 #'
 #' @family plan
 #' @export
 plan_rev_dep_checks <- function(
   path,
-  repos = getOption("repos")
+  repos = getOption("repos"),
+  remotes_dependencies = TRUE
 ) {
   path <- check_path_is_pkg_source(path)
   ap <- available_packages(repos = repos)
@@ -75,7 +79,7 @@ plan_rev_dep_checks <- function(
   g <- task_graph_class(g)
 
   if (remotes_permitted()) {
-    remotes_graph(g)
+    remotes_graph(g, dependencies = remotes_dependencies)
   } else {
     g
   }
@@ -131,6 +135,9 @@ plan_rev_dep_release_check <- function(origin, revdep, repos) {
 #' @param package A path to either package, directory with packages or name
 #'  of the package (details)
 #' @param repos repository used to identify packages when name is provided.
+#' @param remotes_dependencies A vector of length one or a named list.
+#'  Compatible with [`as_pkg_dependencies`]. Used to filter out remotes
+#'  dependencies.
 #'
 #' @details
 #' `package` parameter has two different allowed values:
@@ -145,7 +152,8 @@ plan_rev_dep_release_check <- function(origin, revdep, repos) {
 #' @export
 plan_local_checks <- function(
   package,
-  repos = getOption("repos")
+  repos = getOption("repos"),
+  remotes_dependencies = TRUE
 ) {
 
   task <- meta_task(
@@ -179,7 +187,7 @@ plan_local_checks <- function(
   star_plan_template(c(
     list(task),
     local_checks_tasks
-  ))
+  ), remotes_dependencies)
 }
 
 
@@ -189,11 +197,15 @@ plan_local_checks <- function(
 #'
 #' @param package A path to package source.
 #' @param repos repository used to identify packages when name is provided.
+#' @param remotes_dependencies A vector of length one or a named list.
+#'  Compatible with [`as_pkg_dependencies`]. Used to filter out remotes
+#'  dependencies.
 #'
 #' @family plan
 plan_local_install <- function(
   package,
-  repos = getOption("repos")
+  repos = getOption("repos"),
+  remotes_dependencies = TRUE
 ) {
 
   m_task <- meta_task(
@@ -208,10 +220,10 @@ plan_local_install <- function(
   star_plan_template(list(
     m_task,
     i_task
-  ))
+  ), remotes_dependencies)
 }
 
-star_plan_template <- function(tasks) {
+star_plan_template <- function(tasks, remotes_dependencies) {
   g <- star_graph(
     task = tasks
   )
@@ -221,7 +233,7 @@ star_plan_template <- function(tasks) {
   g <- task_graph_class(g)
 
   if (remotes_permitted()) {
-    remotes_graph(g)
+    remotes_graph(g, dependencies = remotes_dependencies)
   } else {
     g
   }

R/remotes.R

@@ -3,9 +3,14 @@ remotes_graph <- function(x, ...) {
 }
 
 #' @export
-remotes_graph.task_graph <- function(x, ...) {
+remotes_graph.task_graph <- function(x, ..., dependencies = TRUE) {
   vs <- V(x)
-  remotes_subgraphs <- lapply(vs, remotes_graph, vs = vs)
+  remotes_subgraphs <- lapply(
+    vs,
+    remotes_graph,
+    vs = vs,
+    dependencies = dependencies
+  )
 
   task_graph_class(
     suppressWarningsRegex(
@@ -23,13 +28,13 @@ remotes_graph.task_graph <- function(x, ...) {
 
 #' @export
 remotes_graph.integer <- function(x, ..., vs) {
-  remotes_graph(vs[[x]])
+  remotes_graph(vs[[x]], ...)
 }
 
 #' @export
 #' @method remotes_graph igraph.vs
 remotes_graph.igraph.vs <- function(x, ...) {
-  remotes_graph(x$task)
+  remotes_graph(x$task, ...)
 }
 
 #' @export
@@ -40,16 +45,19 @@ remotes_graph.task <- function(x, ...) {
 }
 
 #' @export
-remotes_graph.install_task <- function(x, ...) {
+remotes_graph.install_task <- function(x, ..., dependencies = TRUE) {
   remote_tasks <- get_remote_tasks(x)
   if (length(remote_tasks) == 0) return(igraph::make_empty_graph())
   remote_tasks_names <- vcapply(remote_tasks, package)
 
+  dependencies <- as_pkg_dependencies(dependencies)$direct
   x_deps <- pkg_deps(x$origin)
-  x_remote_deps <- x_deps[
-    x_deps$package == package(x) & x_deps$name %in% remote_tasks_names,
-  ]
-
+  x_remote_deps <- x_deps[x_deps$package == package(x) &
+                            x_deps$name %in% remote_tasks_names &
+                            x_deps$type %in% dependencies, ]
+
+  if (NROW(x_remote_deps) == 0) return(igraph::make_empty_graph())
+
   # Sort tasks according to same key
   remote_tasks <- remote_tasks[order(remote_tasks_names)]
   remote_tasks_types <- x_remote_deps[order(x_remote_deps$name), ]$type

R/task_graph.R

@@ -14,6 +14,8 @@
 #' @param x a `plan` object, containing a list of related steps.
 #' @param repos `repos`, as expected by [`tools::package_dependencies()`] to
 #'   determine package relationships.
+#' @param dependencies A vector of length one or a named list. Compatible with
+#'  [`as_pkg_dependencies`].
 #' @param ... params passed to helper methods.
 #' @return A `data.frame` that can be used to build
 #'   [`igraph::make_graph`] edges.
@@ -26,13 +28,20 @@
 #' @keywords internal
 #'
 #' @importFrom igraph V E
-task_graph <- function(x, repos = getOption("repos"), ...) {
+task_graph <- function(
+  x, repos = getOption("repos"), dependencies = TRUE, ...
+) {
   UseMethod("task_graph")
 }
 
 #' @export
-task_graph.task <- function(x, repos = getOption("repos"), ...) {
-  df <- pkg_deps(x$origin, repos = repos, dependencies = TRUE)
+task_graph.task <- function(
+  x,
+  repos = getOption("repos"),
+  dependencies = TRUE,
+  ...
+) {
+  df <- pkg_deps(x$origin, repos = repos, dependencies = dependencies)
   # Distinguish direct dependencies of the package form possible indirect
   # in the same data.frame which could come from suggested loops. This ensures
   # there is a separate node for the root task.
@@ -47,25 +56,24 @@ task_graph.task <- function(x, repos = getOption("repos"), ...) {
 
   E(g_dep)$relation <- RELATION$dep
   E(g_dep)$type <- DEP[E(g_dep)$type]
-  V(g_dep)$task <- lapply(
-    V(g_dep)$name,
-    function(p) {
-      if (endsWith(p, "-root")) {
-        x
-      } else {
-        origin <- try_pkg_origin_repo(package = p, repos = repos)
-        install_task(origin = origin)
-      }
+  V(g_dep)$task <- lapply(V(g_dep)$name, function(p) {
+    if (endsWith(p, "-root")) {
+      x
+    } else {
+      origin <- try_pkg_origin_repo(package = p, repos = repos)
+      install_task(origin = origin)
     }
-  )
+  })
 
   V(g_dep)$name <- vcapply(V(g_dep)$task, as_vertex_name)
 
   g_dep
 }
 
 #' @export
-task_graph.task_graph <- function(x, repos = getOption("repos"), ...) {
+task_graph.task_graph <- function(
+  x, repos = getOption("repos"), dependencies = TRUE, ...
+) {
   # only use dependency edges when populating graph
   nodes <- V(x)[is_actionable_task(V(x)$task)]
 
@@ -82,7 +90,7 @@ task_graph.task_graph <- function(x, repos = getOption("repos"), ...) {
     subtree <- igraph::induced_subgraph(x, nh)
 
     # build dependency graph, with fallback installation task
-    deps <- task_graph(nh[[1]]$task, repos = repos)
+    deps <- task_graph(nh[[1]]$task, repos = repos, dependencies = dependencies)
 
     # merge trees on package names
     # NOTE: attributes (tasks) are preserved in the order they appear
@@ -94,8 +102,12 @@ task_graph.task_graph <- function(x, repos = getOption("repos"), ...) {
 
     deduplicate_task_graph(subtree)
   })
+
   # then merge all the full check task task trees into a single graph
   g <- graph_dedup_attrs(igraph::union(x, check_task_neighborhoods))
+  # Make sure orphaned packages, so those that do not lead to any meta tasks,
+  # are skipped 
+  g <- task_graph_removed_orphaned(g)
 
   E(g)$type <- DEP[E(g)$type]
   V(g)$status <- STATUS$pending
@@ -138,8 +150,16 @@ deduplicate_task_graph <- function(g) {
       )
     }
   }
-  isolated <- which(igraph::degree(g) == 0)
-  igraph::delete_vertices(g, isolated)
+  g
+}
+
+task_graph_removed_orphaned <- function(g) {
+  # The only package without "in" vertex should be meta tasks
+  vs <- igraph::V(g)
+
+  isolated <- igraph::degree(g, mode = "in") == 0 & !is_meta(vs$task)
+
+  igraph::delete_vertices(g, vs[isolated])
 }
 
 dep_edges <- function(edges, dependencies = TRUE) {

R/utils-deps.R

@@ -23,18 +23,17 @@ as_pkg_dependencies <- function(x) {
       x <- character(0L)
     }
 
-    deptypes <- c("Depends", "Imports", "LinkingTo", "Suggests", "Enhances")
-    if (is.character(x)) {
+    if (is.character(x) || is.factor(x)) {
       x <- switch(x,
-        "all" = deptypes,
-        "most" = c("Depends", "Imports", "LinkingTo", "Suggests"),
-        "hard" = c("Depends", "Imports", "LinkingTo"),
-        "soft" = c("Suggests", "Enhances"),
-        x
+        "all" = DEP,
+        "most" = DEP[c("Depends", "Imports", "LinkingTo", "Suggests")],
+        "hard" = DEP[c("Depends", "Imports", "LinkingTo")],
+        "soft" = DEP[c("Suggests", "Enhances")],
+        DEP[x]
       )
     }
 
-    stopifnot(all(x %in% deptypes))
+    stopifnot(all(x %in% DEP))
 
     x
   }