# parse script ----
zzz_script <- "https://raw.githubusercontent.com/igraph/rigraph/e82993a8312e996ab54572048741f508d64467f1/R/zzz-deprecate.R"
parse_script <- function(path) {
path |>
parse(keep.source = TRUE) |>
xmlparsedata::xml_parse_data(pretty = TRUE) |>
xml2::read_xml()
}
xml <- parse_script(zzz_script)
# extract all calls to deprecated()
deprecated_calls <- xml2::xml_find_all(
xml,
".//SYMBOL_FUNCTION_CALL[text()='deprecated']"
)
tibblify_call <- function(deprecated_call) {
args <- deprecated_call |>
xml2::xml_parent() |>
xml2::xml_siblings() |>
purrr::keep(~xml2::xml_name(.x) == "expr")
old <- xml2::xml_text(args[[1]])
new <- xml2::xml_text(args[[2]])
tibble::tibble(old = gsub('"', '', old), new = new)
}
deprecated_df <- purrr::map_df(deprecated_calls, tibblify_call)
# utils ----
.parse_impl_assignements <- function() {
scripts <- fs::dir_ls(here::here("R")) |>
purrr::keep(~(.x != zzz_script)) |>
purrr::map(parse_script)
parse_script_function_call <- function(xml) {
kiddos <- xml2::xml_children(xml)
candidates <- kiddos[xml2::xml_name(kiddos) == "expr"]
candidates <- candidates[purrr::map_int(candidates, ~length(xml2::xml_children(.x))) == 3]
purrr::map_df(
candidates,
~ tibble::tibble(
left = xml2::xml_children(.x)[[1]] |> xml2::xml_text(),
right = xml2::xml_children(.x)[[3]] |> xml2::xml_text()
)
)
}
purrr::map_df(scripts, parse_script_function_call)
}
parse_impl_assignements <- memoise::memoise(.parse_impl_assignements)
parse_package_defs <- function() {
scripts <- fs::dir_ls(here::here("R")) |>
purrr::keep(~(.x != zzz_script)) |>
purrr::map(parse_script)
parse_script_function_call <- function(script, script_name) {
fns <- xml2::xml_find_all(script, ".//FUNCTION[text()='function']")
is_fn_definition <- function(fn) {
siblings <- fn |> xml2::xml_parent() |> xml2::xml_siblings()
(length(siblings) == 2) && (xml2::xml_name(siblings[[2]]) == "LEFT_ASSIGN")
}
fns <- purrr::keep(fns, is_fn_definition)
parse_function <- function(fn) {
whole_definition <- fn |> xml2::xml_parent()|> xml2::xml_parent()
line1 <- xml2::xml_attr(whole_definition, "line1")
line2 <- xml2::xml_attr(whole_definition, "line2")
name <- whole_definition |> xml2::xml_child() |> xml2::xml_text()
if (name %in% c(
"tk_off",
"get_all_options",
"tkigraph",
".tkigraph.clusters",
"show.communities",
"sortPopup"
)) {
return(
tibble::tibble(
line1 = line1,
line2 = line2,
name = name,
usage = "",
args = ""
)
)
}
args <- xml2::xml_find_all(whole_definition, "./*/SYMBOL_FORMALS") |> xml2::xml_text()
if (length(args) > 0) {
if ("..." %in% args) {
if (length(args) == 1) {
args <- "..."
} else {
args <- toString(c(glue::glue("{args[args!='...']} = {args[args!='...']}"), "..."))
}
} else {
args <- toString(glue::glue("{args} = {args}"))
}
usage_wrap <- xml2::xml_children(whole_definition)[[3]] |> xml2::xml_children()
# TODO use XPath not numbers? although this should work?
usage <- usage_wrap[3:(length(usage_wrap)-2)] |> xml2::xml_text() |> paste(collapse = " ")
} else {
args <- ""
usage <- ""
}
tibble::tibble(
line1 = line1,
line2 = line2,
name = name,
usage = usage,
args = args
)
}
script_df <- purrr::map_df(fns, parse_function)
script_df$script_name <- script_name
script_df
}
purrr::map2_df(scripts, names(scripts), parse_script_function_call)
}
#
# # split zzz-deprecate.R ----
# pkg_defs <- parse_package_defs()
# zzz_lines <- brio::read_lines(zzz_script)
# export_lines <- which(startsWith(zzz_lines, "#' @export "))
# move_one <- function(index, zzz_lines, pkg_defs) {
# lines <- zzz_lines[index:(index+1)]
# new <- trimws(sub(".*,", "", sub("\\)$", "", lines[2])))
#
# script <- system2(
# "grep",
# c("-r", sprintf("'^%s <- '", new), "R"),
# stdout = TRUE
# )
# script <- script[!endsWith(script, new)]
# script <- sub("\\:.*", "", script)
#
# script_lines <- c(
# brio::read_lines(script),
# lines
# )
# brio::write_lines(script_lines, script)
# }
#
# purrr::walk(export_lines, move_one, zzz_lines = zzz_lines, pkg_defs = pkg_defs)
# brio::write_lines(zzz_lines[1:29], zzz_script)
# fs::file_move(zzz_script, "R/aaa-a-deprecate.R")
# zzz_script <- "R/aaa-a-deprecate.R"
# devtools::check()
#
# files <- gert::git_status()[["file"]]
# files <- files[startsWith(files, "R/")]
# gert::git_add(files)
# gert::git_commit("refactor: split zzz-deprecate")
# gert::git_push()
# remove ALL the aliases ----
# to the deprecated functions as they will
# get an actual page
clean_alias <- function(aliases, x) {
output <- gsub(sprintf(" %s ", x), " ", aliases)
output <- gsub(sprintf(" %s$", x), "", output)
output[!grepl("@aliases", output)] <- sub(
"#' ", "#' @aliases ",
output[!grepl("@aliases", output)]
)
output
}
remove_aliases <- function(script, to_be_deprecated) {
lines <- brio::read_lines(script)
which_aliases <- grepl("@aliases", lines) |
(grepl("@aliases", dplyr::lag(lines, 1)) &
grepl("^#' (?!\\@)", lines, perl = TRUE))
aliases_present <- (sum(which_aliases) > 0)
if (aliases_present) {
aliases <- lines[which_aliases]
aliases <- purrr::reduce(
to_be_deprecated,
\(aliases, x) clean_alias(aliases, x ),
.init = aliases
)
lines[which_aliases] <- aliases
lines <- purrr::discard(
lines,
\(x) trimws(x) == "#' @aliases"
)
}
brio::write_lines(lines, script)
}
purrr::walk(
fs::dir_ls(here::here("R")) ,
remove_aliases,
to_be_deprecated = deprecated_df$old,
.progress = TRUE
)
# parse ALL the package scripts ----
# get docs from pkgdown ----
get_title <- function(fn_name) {
if (fn_name == "adjacent_triangles") {
fn_name <- "count_triangles"
}
rd_href <- pkgdown:::get_rd_from_help("igraph", fn_name)
pkgdown:::extract_title(rd_href)
}
topics <- pkgdown::as_pkgdown()[["topics"]]
# treat calls ----
treat_call <- function(old, new, topics) {
if (old %in% c("igraph.eigen.default", "igraph.arpack.default")) {
return()
}
pkg_defs <- parse_package_defs()
template <- paste(readLines(here::here("tools", "deprecate-template.txt")), collapse = "\n")
relevant_row <- pkg_defs[pkg_defs[["name"]] == new,]
if (nrow(relevant_row) == 0) {
relevant_row <- pkg_defs[pkg_defs[["name"]] == sprintf("%s_impl", new),]
}
if (nrow(relevant_row) == 0) {
assignments <- parse_impl_assignements()
actual_def <- assignments[["right"]][assignments[["left"]] == new]
relevant_row <- pkg_defs[pkg_defs[["name"]] == actual_def,]
}
if (nrow(relevant_row) > 1) {
relevant_row <- relevant_row[!grepl("aaa-auto", relevant_row[["script_name"]]),]
}
if (grepl("_impl$", new)) {
new <- sub("_impl$", "", new)
}
if (!nzchar(relevant_row[["args"]])) {
inheritParamsOrNot <- "#'"
} else {
inheritParamsOrNot <- sprintf("#' @inheritParams %s", new)
}
new_text <- whisker::whisker.render(
template,
data = list(
old = old,
new = new,
args = relevant_row[["args"]],
inheritParamsOrNot = inheritParamsOrNot,
new_usage = relevant_row[["usage"]],
new_title = stringr::str_squish(get_title(new))
)
)
new_text <- styler::style_text(new_text)
script <- system2(
"grep",
c("-r", sprintf("'^%s <- '", new), "R"),
stdout = TRUE
)
script <- script[!endsWith(script, new)]
script <- sub("\\:.*", "", script)
script_lines <- brio::read_lines(script)
new_lines <- append(
c("", new_text),
values = script_lines
)
brio::write_lines(new_lines, script)
}
purrr::walk2(
deprecated_df[["old"]],
deprecated_df[["new"]],
treat_call,
topics = topics,
.progress = TRUE
)
# delete deprecated() calls ----
remove_deprecated_calls <- function(script) {
lines <- brio::read_lines(script)
deprecated <- which(startsWith(lines, "deprecated("))
if (length(deprecated) == 0) {
return()
}
lines <- lines[1:(min(deprecated) - 2)]
brio::write_lines(lines, script)
}
purrr::walk(fs::dir_ls(here::here("R")), remove_deprecated_calls)
# add docs for cohesion
cohesive_script <- "R/cohesive.blocks.R"
cohesive_lines <- brio::read_lines(cohesive_script)
index_before_docs <- grep("^graph.cohesion", cohesive_lines) - 3
cohesive_lines <- append(
cohesive_lines,
c("#' @param x x", "#' @param ... passed to `cohesion()`"),
after = index_before_docs
)
cohesive_lines <- cohesive_lines[-index_before_docs]
brio::write_lines(cohesive_lines, cohesive_script)
pajek_script <- "R/cohesive.blocks.R"
pajek_lines <- brio::read_lines(pajek_script)
pajek_lines <- purrr::discard(
pajek_lines,
~.x=="#' exportPajek"
)
brio::write_lines(pajek_lines, pajek_script)
devtools::document()
devtools::check()
gert::git_add("tools/deprecate.R")
gert::git_add("tools/deprecate-template.txt")
gert::git_commit("add tools script and template")
system2("git", c("checkout", "man"))
system2("git", c("checkout", "NAMESPACE"))
system2("git", c("clean", "-f"))
gert::git_push()
# modif by hand -----
graph_script <- "R/make.R"
graph_lines <- brio::read_lines(graph_script)
two_problems <- grep(
', "make\\_graph\\(\\)"',
graph_lines
)
good_lines <- c(
"",
" if (!missing(dir) && missing(directed)) {",
" directed <- dir",
" }",
"",
" if (missing(simplify)) {",
" make_graph(edges = edges, n = n, isolates = isolates, directed = directed, ...)",
" } else {",
" make_graph(edges = edges, n = n, isolates = isolates, directed = directed, simplify = simplify, ...)",
" }"
)
graph_lines <- append(
graph_lines,
good_lines,
after = two_problems[1]
)
two_problems <- grep(
', "make\\_graph\\(\\)"',
graph_lines
)
graph_lines <- append(
graph_lines,
good_lines,
after = two_problems[2]
)
two_problems <- grep(
', "make\\_graph\\(\\)"',
graph_lines
)
graph_lines <- graph_lines[-(two_problems[1] + 1)]
two_problems <- grep(
', "make\\_graph\\(\\)"',
graph_lines
)
graph_lines <- graph_lines[-(two_problems[2] + 1)]
brio::write_lines(graph_lines, graph_script)
devtools::check()
system2("git", c("checkout", "man"))
system2("git", c("checkout", "NAMESPACE"))
system2("git", c("clean", "-f"))
gert::git_branch_create("throwaway")
files <- gert::git_status()[["file"]]
files <- files[startsWith(files, "R/")]
snapshot_file <- function(path) {
gert::git_add(path)
gert::git_commit(sprintf("refactor!: change %s", path))
}
commits <- purrr::map_chr(files, snapshot_file)
# some manual rebasing to delete the deprecated() def last...
gert::git_branch_checkout("zzz-monday")
build_commit <- function(commit) {
message(commit)
message <- trimws(gert::git_commit_info(commit)[["message"]])
gert::git_cherry_pick(commit)
gert::git_reset_soft(gert::git_log(max=2)$commit[2])
devtools::document()
gert::git_add("R/*")
gert::git_add("man/*")
gert::git_commit(message)
}
purrr::walk(commits, build_commit)
fs::file_delete("R/aaa-a-deprecate.R")
gert::git_add("R/aaa-a-deprecate.R")
devtools::document()
gert::git_add("NAMESPACE")
gert::git_commit("refactor: remove the deprecated() function")
gert::git_push()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.