[Feature Request]: Refactor strategies to R6 class that inherits from pkgdepends::pkg_installation_proposal

[averissimo]

Feature description

💡 Idea: Take advantage of the R6 features to organize the code and make the API identical to a pkgdepends::pkg_installation_proposal

As a side effect, it requires one less level of manipulation of a private field (if pkgplan R6 class was exported by pkgdepends then we wouldn't need it at all)

This would need a creation of a parent class that inherits from that one and 3 additional ones for strategies

To execute_ip() would look like:

ip <- min_isolated_deps_installation_proposal$new("../repos/test.repo")
ip$execute(build_args = character(), check_args = character())

# execute method workflow:
#        self$resolve()
#        self$solve()
#        self$download()
#        self$install()
#        check_res <- self$check(build_args, check_args, ...)

Parent class

• Implements custom workflow for download & solve & install for all strategies
• Ensures compatibility with current workflow and runs resolve_ignoring_release_remote() after solving.

# Sample, expand below to see what is defined on the methods
deps_installation_proposal <- R6::R6Class(
  classname = "deps_installation_proposal",
  inherit = pkgdepends::pkg_installation_proposal,
  public = list(
    # solve() # extends on pkgdepends
    # download() # extends on pkgdepends
    # install() # extends on pkgdepends
    # check() # new method
    # execute() # new method
  )
)

⊞ Expand to see code

deps_installation_proposal <- R6::R6Class(
  classname = "deps_installation_proposal",
  inherit = pkgdepends::pkg_installation_proposal,
  public = list(
    solve = function() {
      super$solve()
      resolve_ignoring_release_remote(self)

      invisible(self)
    },
    download = function() {
      super$download()
      super$stop_for_download_error()

      invisible(self)
    },

    install = function() {
      self$install_sysreqs()
      tryCatch(
        super$install(),
        error = function(err) {
          # Print compilation error when installation fails to help debug
          print(err)
          stop(err)
        })

      invisible(self)
    },

    #' @description Executes [`rcmdcheck::rcmdcheck()`] on a local package using `libpath` from the installation plan.
    #'
    #' @param path (`string`) path to the package sources
    #' @param build_args (`string`) value passed as `build_args` argument into [`rcmdcheck::rcmdcheck()`]
    #' @param check_args (`string`) value passed as `args` argument into [`rcmdcheck::rcmdcheck()`]
    #' @param ... other arguments passed to [`rcmdcheck::rcmdcheck()`]
    #'
    #' @inherit rcmdcheck::rcmdcheck return
    #'
    #' @seealso [rcmdcheck::rcmdcheck()] for other configuration possibilities
    #'
    #' @importFrom rcmdcheck rcmdcheck

    check = function(build_args = character(),
                     check_args = character(),
                     ...) {

      rcmdcheck::rcmdcheck(
        private$desc_path,
        libpath = self$get_config()$get("library"),
        args = check_args,
        build_args = build_args,
        error_on = "never",
        ...
      )
    },

    execute = function(build_args = character(),
                       check_args = character(),
                       ...) {
      check_res <- NULL
      try({
        self$resolve()
        self$solve()
        self$download()
        self$install()
        check_res <- self$check(build_args, check_args, ...)
      })

      return(invisible(list(ip = self, check = check_res)))
    }
  ),
  private = list(
    desc_path = NULL
  )
)

Strategy class

Example for min_isolated strategy

# Sample, expand below to see what is defined on the methods
min_isolated_deps_installation_proposal <- R6::R6Class( # nolint objects_length_linter
  classname = "min_isolated_deps_installation_proposal",
  inherit = deps_installation_proposal,
  public = list(
    # initialize() # code from new_min_isolated_deps_installation_proposal()
    # resolve() # code from solve_ip.min_isolated_deps_installation_proposal()
    )

⊞ Expand to see code

#' R6 class for min_isolated strategy
#'
#' @param path Path to DESCRIPTION FILE
#'
#' @examples
#' desc_path <- local_description(list(`formatters (>= 0.5.0)` = "Import"))
#' desc_dir <- tempfile("package-")
#' dir.create(desc_dir)
#' desc_dir <- tempfile("package-")
#' dir.create(desc_dir)
#' desc_new_path <- file.path(desc_dir, "DESCRIPTION")
#' file.rename(desc_path, desc_new_path)
#' ip <- min_isolated_deps_installation_proposal$new(desc_new_path)
#' ip$resolve()
#' ip$solve()
#' ip$download()
#' ip$install()
min_isolated_deps_installation_proposal <- R6::R6Class( # nolint objects_length_linter
  classname = "min_isolated_deps_installation_proposal",
  inherit = deps_installation_proposal,
  public = list(

    #' @param config Configuration options, a named list. See
    #'   ['Configuration'][pkgdepends-config]. It needs to include the package
    #'   library to install to, in `library`.
    #' @param policy Solution policy. See ['The dependency
    #'   solver'][pkg_solution].
    #' @param remote_types Custom remote ref types, this is for advanced
    #'   use, and experimental currently.

    initialize = function(path,
                          config = list(),
                          policy = c("lazy", "upgrade"),
                          remote_types = NULL) {
      path <- normalizePath(path)
      config <- append_config(default_config(), config)

      d <- desc::desc(path)

      refs <- get_refs_from_desc(d)
      # convert github to standard if possible
      new_refs <- lapply(
        refs,
        function(x) {
          version <- version_from_desc(x$package, d)
          if (
            inherits(x, "remote_ref_github") &&
              check_if_on_cran(x, version) &&
              x$commitish == ""
          ) {
            pkgdepends::parse_pkg_ref(x$package)
          } else {
            x
          }
        }
      )

      # for github type - find ref for min version and add it to the GH ref
      new_refs <- lapply(
        new_refs,
        function(x) {
          if (inherits(x, "remote_ref_github")) {
            version <- version_from_desc(x$package, d)
            get_ref_min(x, version$op, version$op_ver)
          } else {
            x
          }
        }
      )
      new_refs_str <- map_key_character(new_refs, "ref")

      d <- desc_cond_set_refs(d, new_refs_str)
      d <- desc_remotes_cleanup(d)

      temp_desc <- tempfile(pattern = "DESCRIPTION-")
      d$write(temp_desc)

      private$desc_path <- path

      super$initialize(
        refs = paste0("deps::", temp_desc),
        config = config,
        policy = policy,
        remote_types = remote_types
      )
    },

    #' @description
    #' Resolve the dependencies of the specified package references. This
    #' usually means downloading metadata from CRAN and Bioconductor,
    #' unless already cached, and also from GitHub if GitHub refs were
    #' included, either directly or indirectly.

    resolve = function() {
      super$resolve()

      res <- self$get_resolution()

      deps <- res[1, "deps"][[1]]
      ## copy op and version to Config\Needs\verdepcheck rows
      deps <- split(deps, as.factor(deps$package))
      deps <- lapply(deps, function(x) {
        x$op <- x$op[1]
        x$version <- x$version[1]
        x
      })
      deps <- do.call(rbind, deps)
      deps <- deps[tolower(deps$type) %in% tolower(res[1, "dep_types"][[1]]), ]

      # Avoid repeating calls to resolve_ppm_snapshot
      deps <- deps[!duplicated(deps[, c("ref", "op", "version")]), ]

      cli_pb_init("min_isolated", total = nrow(deps))

      deps_res <- lapply(seq_len(nrow(deps)), function(i) {
        i_pkg <- deps[i, "package"]

        cli_pb_update(package = i_pkg, n = 4L)

        if (i_pkg %in% base_pkgs()) return(NULL)

        resolve_ppm_snapshot(
          deps[i, "ref"],
          deps[i, "op"],
          deps[i, "version"]
        )
      })

      new_res <- do.call(rbind, deps_res)

      # Keep only top versions in calculated resolution (new_res).
      #  Very large resolution tables can become problematic and take a long to
      #  converge to a solution.
      new_res <- new_res[order(new_res$ref, package_version(new_res$version), decreasing = TRUE), ]
      new_res <- new_res[!duplicated(new_res[, c("ref")]), ]
    
      # Keep res at top
      new_res <- rbind(res[1:2, ], new_res)
      private$plan$.__enclos_env__$private$resolution$result <- new_res
      invisible(self)
    }
  )
)

Code of Conduct

• I agree to follow this project's Code of Conduct.

Contribution Guidelines

• I agree to follow this project's Contribution Guidelines.