insightsengineering / insightsengineering/verdepcheck

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

Open
#30 0 comments 0 reactions 0 assignees View on GitHub
core enhancement
Dominant language
R
Stars
9
Forks
0
PR merge metrics
No merged PRs in 30d

Description

### 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:

```R
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.

```R
# 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

```R
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

```R
# 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

```R

#' 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

- [X] I agree to follow this project's Code of Conduct.

### Contribution Guidelines

- [X] I agree to follow this project's Contribution Guidelines.

Contributor guide

Open the contributing guide

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.