-
Notifications
You must be signed in to change notification settings - Fork 0
/
pkg_unload.R
89 lines (73 loc) · 2.64 KB
/
pkg_unload.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
#' unloads a package, unloading its dependent packages if needed
#'
#' To be able to unload properly a package, all the packages that depend
#' even indirectly on it should be unloaded first.
#'
#' N.B: this function also works for non source packages.
#'
#' @inheritParams params
#' @param loaded the loaded packages, useful for testing.
#' @return a data frame of the unloaded package names, and whether they were
#' attached, invisibly or NULL if the package is not loaded
#' @export
#' @examples
#' \donttest{
#' plan <- pkg_unload('mypkg')
#' }
pkg_unload <- function(pkg_or_name,
src_pkgs = get_srcpkgs(), dry_run = FALSE, loaded = loadedNamespaces(), quiet = FALSE)
{
pkg_name <- as_pkg_name(pkg_or_name)
# is it a srcpkg or not?
plan <- NULL
force(src_pkgs)
if (pkg_name %in% names(src_pkgs)) {
plan <- srcpkg_unload_plan(pkg_name, src_pkgs, loaded = loaded)
} else {
plan <- non_srcpkg_unload_plan(pkg_name, loaded = loaded)
}
if (!dry_run) execute_plan(plan, src_pkgs, quiet = quiet)
invisible(plan)
}
srcpkg_unload_plan <- function(pkg_name, src_pkgs,
loaded = loadedNamespaces(), mat = graph_from_srcpkgs(src_pkgs))
{
if (!pkg_name %in% loaded) return(NULL)
force(mat)
# mat <- sub_graph(mat, loaded)
unload_plan(pkg_name, mat, loaded = loaded)
}
non_srcpkg_unload_plan <- function(pkg_name, loaded = loadedNamespaces())
{
if (!pkg_name %in% loaded) return(NULL)
deps <- find_loaded_packages_namespace_imports(loaded)
deps <- lapply(deps, intersect, loaded)
mat <- graph_from_deps(deps)
unload_plan(pkg_name, mat, loaded = loaded)
}
# plan to unload pkg_names. will not unload packages not loaded
unload_plan <- function(pkg_names, mat, loaded = loadedNamespaces()) {
if (!nrow(mat)) return(NULL)
.deps <- function(x) c(graph_get_all_dependents(mat, x), x)
deps_lst <- lapply(pkg_names, .deps)
# N.B: can not be mepty
deps <- unique(fast_unlist(deps_lst))
ordering <- graph_topo_sort_nodes(mat, deps)
plan <- data.frame(package = ordering, action = 'unload')
plan <- plan[plan$package %in% loaded, , drop = FALSE]
if (!nrow(plan)) return(NULL)
plan
}
# N.B: namespace-imports != description-imports
# find the namespace-imports of all loaded packages (but "base" of course) as a dependency list
# does not report "base" as an import as well
find_loaded_packages_namespace_imports <- function(loaded = loadedNamespaces()) {
pkg_names <- setdiff(loaded, 'base')
.fetch_imports <- function(x) {
y <- pkg_list_ns_imports(x)
reproducible_sort(setdiff(y, 'base'))
}
imports <- lapply(pkg_names, .fetch_imports)
names(imports) <- pkg_names
imports[reproducible_sort(names(imports))]
}