"%||%" <- function(x, y) {
if (length(x)) x else y
}
# verify that the package exists and find the latest version (if not specified)
resolve_pkg <- function(pkg) {
url <- paste0("https://unpkg.com/", pkg)
res <- httr::GET(url)
con <- httr::content(res)
if (httr::http_error(res) && grepl("Cannot find package", con)) {
stop(con, call = FALSE)
}
httr::warn_for_status(res)
base_url <- sub("/$", "", strextract(res$url, "https://unpkg.com/[^/]*[/]?"))
pieces <- strsplit(base_url, "@")[[1]]
list(
url = base_url,
name = sub("https://unpkg.com/", "", pieces[[1]]),
version = pieces[[2]],
main = sub("https://unpkg.com/[^/]*/", "", res$url)
)
}
# download hyperlink(s) and turn into an htmldependency
dependify <- function(files = NULL, name = NULL, version = NULL) {
if (!length(files)) stop("files must be provided", call. = FALSE)
href_root <- sprintf("https://unpkg.com/%s@%s", name, version)
hrefs <- file.path(href_root, files)
file_root <- file.path(runpkg_path(), paste0(name, "@", version))
files_full <- file.path(file_root, files)
## TODO: support more content types?
#types <- vapply(hrefs, content_type, character(1))
#type_ok <- types %in% c("application/javascript", "application/json", "text/css")
#if (!all(type_ok)) {
# browser()
# warning(
# "Only files with content-type 'application/javascript', 'application/json', and 'text/css' ",
# " are supported at the moment. \n",
# sprintf("These files have a different content-type: '%s'",
# paste(hrefs[!type_ok], collapse = "', '")),
# call. = FALSE
# )
#}
Map(download_file_, hrefs, files_full)
# TODO: it's almost surely wrong to assume most everything is a script
types <- vapply(hrefs, content_type, character(1))
is_style <- grepl("text/css", types, fixed = TRUE)
# htmlDependify
htmltools::htmlDependency(
name = name,
version = version,
src = c(href = href_root, file = file_root),
# TODO: how to determine attachments?
script = files[!is_style] %||% NULL,
stylesheet = files[is_style] %||% NULL,
all_files = FALSE
)
}
runpkg_path <- function() {
# TODO: why is this set to knitr false by knitr???
#if (!capabilities("cledit")) {
# stop(
# "Can't automatically determine a directory to download files on your machine. ",
# "Set `options(runpkg.path = 'a/suitable/path')`.", call. = FALSE
# )
#}
path <- getOption("runpkg.path", file.path(path.expand("~"), ".runkpg_cache"))
if (!dir_exists(path)) dir.create(path)
path
}
download_file_ <- function(url, destfile) {
destdir <- dirname(destfile)
if (!dir_exists(destdir)) dir.create(destdir, recursive = TRUE)
download.file(url, destfile)
}
# find the content-type of a hyperlink
content_type <- function(href) {
httr::HEAD(href)$headers$`content-type`
}
dir_exists <- function(paths) {
utils::file_test("-d", paths)
}
strextract <- function(str, pattern) {
regmatches(str, regexpr(pattern, str))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.