if (dir.exists("../../../RSQLite")) {
writeLines(
c(
"# Generated by helper-dev.R, do not edit by hand",
"",
"skip_if_not_installed(\"RSQLite\")",
"skip_if_not_installed(\"nanoarrow\")",
"",
"# helper-DBItest.R",
readLines("../../../RSQLite/tests/testthat/helper-DBItest.R"),
"",
"# test-DBItest.R",
readLines("../../../RSQLite/tests/testthat/test-DBItest.R")
),
"test-DBItest.R"
)
}
if (Sys.getenv("CI") == "") {
r <- rprojroot::is_r_package$make_fix_file()
rd_db <- tools::Rd_db(dir = r())
Links <- tools::findHTMLlinks()
html_topic <- function(name) {
rd <- rd_db[[paste0(name, ".Rd")]]
conn <- textConnection(NULL, "w")
on.exit(close(conn))
# tools::Rd2HTML(rd, conn, Links = Links)
tools::Rd2HTML(rd, conn)
textConnectionValue(conn)
}
create_xml_topic <- function(name, patcher) {
html <- html_topic(name)
x <- xml2::read_html(paste(html, collapse = "\n"))
# No idea why this is necessary when embedding HTML in Markdown
codes <- x %>% xml2::xml_find_all("//code[contains(., '$')]")
xml2::xml_text(codes) <- gsub("[$]", "\\\\$", xml2::xml_text(codes))
xx <- x %>% xml2::xml_find_first("/html/body")
xx %>% xml2::xml_find_first("//table") %>% xml2::xml_remove()
xx %>% xml2::xml_find_all("//pre") %>% xml2::xml_set_attr("class", "r")
patcher(xx)
}
patch_package_doc <- function(x) {
x %>%
xml2::xml_find_first("//h3") %>%
xml2::xml_remove()
remove_see_also_section(x)
remove_authors_section(x)
x %>%
xml2::xml_find_first("div") %>%
xml2::xml_children() %>%
as.list()
}
move_contents_of_usage_section <- function(x) {
# https://stackoverflow.com/a/3839299/946850
usage_contents <-
x %>%
xml2::xml_find_all(
"//h3[.='Usage']/following-sibling::node() [not(self::h3)] [count(preceding-sibling::h3)=2]")
usage_text <-
usage_contents %>%
xml2::xml_find_first("//pre") %>%
xml2::xml_text()
h3 <- x %>% xml2::xml_find_first("//h3")
intro_text <-
xml2::read_xml(
paste0(
"<p>This section describes the behavior of the following method",
if (length(grep("[(]", strsplit(usage_text, "\n")[[1]])) > 1) "s" else "",
":</p>")
)
xml2::xml_add_sibling(
h3,
intro_text,
.where = "before")
lapply(usage_contents, xml2::xml_add_sibling, .x = h3, .copy = FALSE, .where = "before")
x %>% xml2::xml_find_first("//h3[.='Usage']") %>% xml2::xml_remove()
x
}
move_additional_arguments_section <- function(x) {
# https://stackoverflow.com/a/3839299/946850 and some trial and error
additional_arguments <- x %>%
xml2::xml_find_all(
"//h3[.='Additional arguments'] | //h3[.='Additional arguments']/following-sibling::node()[following-sibling::h3]")
after_arg <- x %>% xml2::xml_find_first("//h3[text()='Arguments']/following-sibling::h3")
lapply(additional_arguments, xml2::xml_add_sibling, .x = after_arg, .copy = FALSE, .where = "before")
x
}
patch_lifecycle_badges <- function(x) {
img <-
x %>% xml2::xml_find_all("//img[@src='../help/figures/lifecycle-experimental.svg']")
xml2::xml_set_attr(img, "src", "https://dbi.r-dbi.org/reference/figures/lifecycle-experimental.svg")
}
remove_see_also_section <- function(x) {
# https://stackoverflow.com/a/3839299/946850 and some trial and error
x %>%
xml2::xml_find_all(
"//h3[.='See Also'] | //h3[.='See Also']/following-sibling::node()[following-sibling::h3]") %>%
xml2::xml_remove()
x
}
remove_authors_section <- function(x) {
# https://stackoverflow.com/a/3839299/946850 and some trial and error
x %>%
xml2::xml_find_all(
"//h3[.='Author(s)'] | //h3[.='Author(s)']/following-sibling::node()[following-sibling::h3]") %>%
xml2::xml_remove()
x
}
patch_method_doc <- function(x) {
move_contents_of_usage_section(x)
remove_see_also_section(x)
move_additional_arguments_section(x)
patch_lifecycle_badges(x)
x %>%
xml2::xml_find_first("div") %>%
xml2::xml_children()
}
topics <- c(
"dbDataType",
"dbConnect",
"dbDisconnect",
"dbSendQuery",
"dbFetch",
"dbClearResult",
"dbBind",
"dbGetQuery",
"dbSendStatement",
"dbExecute",
"dbQuoteString",
"dbQuoteIdentifier",
"dbReadTable",
"dbWriteTable",
"dbListTables",
"dbExistsTable",
"dbRemoveTable",
"dbListFields",
"dbIsValid",
"dbHasCompleted",
"dbGetStatement",
"dbGetRowCount",
"dbGetRowsAffected",
"dbColumnInfo",
"transactions",
"dbWithTransaction",
"dbGetInfo",
NULL
)
xml <- c(
list(create_xml_topic("DBI-package", patcher = patch_package_doc)),
lapply(topics, create_xml_topic, patcher = patch_method_doc)
)
html <- unlist(lapply(xml, as.character))
temp_html <- r("vignettes/spec.html")
temp_md <- r("vignettes/spec.md")
# temp_html <- "out.html"
# temp_md <- "out.md"
# html <- '<html><body><pre class="r">\na\nb\n</pre></body></html>'
writeLines(html, temp_html)
rmarkdown::pandoc_convert(temp_html, "gfm", verbose = FALSE, output = temp_md)
writeLines(readLines(temp_md), temp_md)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.