#' Compile a Rocco Page From a Template.
#'
#' @param pkg_dir character. A package directory with rocco-documented R files.
#' @param template character. The whisker template to use.
#' @param out_file character. The output file.
compile <- function(pkg_dir, template, out_file) {
writeLines(whisker::whisker.render(
template, rocco_data(pkg_dir)
), out_file)
}
rocco_data <- function(pkg_dir) {
list(
package_description = gsub("[[:space:]]+", " ", package_description(pkg_dir)),
package_title = package_title(pkg_dir),
rocco_version = as.character(packageVersion('rocco')),
sections = package_sections(pkg_dir)
)
}
package_sections <- function(pkg_dir) {
do.call(c, lapply(
list.files(file.path(pkg_dir, "R"), full.names = TRUE),
file_section
))
}
file_section <- function(file) {
lines <- readLines(file)
c(
list(file_header(file)),
rocco_sections(lines)
)
}
file_header <- function(file) {
list(commentary = markdown_to_html(paste0("# ", basename(file))), code = "")
}
rocco_sections <- function(lines) {
rocco_lines <- rocco_lines(lines)
unname(tapply(
lines,
cumsum(diff(c(FALSE, rocco_lines)) == 1),
FUN = rocco_section
))
}
rocco_regex <- "^[[:space:]]*##( |$)"
rocco_lines <- function(lines) {
grepl(rocco_regex, lines)
}
rocco_section <- function(lines) {
section <- split(lines, rocco_lines(lines))
list(
commentary = rocco_commentary(section$`TRUE` %||% character(0)),
code = paste(section$`FALSE` %||% character(0), collapse = "\n")
)
}
rocco_commentary <- function(lines) {
markdown_to_html(paste(gsub(rocco_regex, "", lines), collapse = "\n"))
}
markdown_to_html <- function(text) {
if (length(text) > 0 && nzchar(text)) {
markdown::markdownToHTML(text = text, fragment.only = TRUE)
} else ""
}
#' Literate Documentation For R.
#'
#' @name rocco
#' @import whisker markdown
#' @docType package
NULL
#' Apply Rocco Documentation to a Package.
#'
#' Given a local package directory, turn the package's R files
#' into a literately documented website.
#'
#' @param directory character. The package directory to document.
#' @param output_dir character. The directory to output the static HTML site.
#' By default, an extemporaneously-generated temporary directory.
#' @param browse logical. Whether or not to launch the documentation
#' immediately for browsing. This will be set to \code{\link{interactive}()},
#' that is, TRUE if the R session is running interactive and FALSE
#' otherwise.
#' @param rocco logical. Whether or not to create rocco docs. Defaults to \code{TRUE}.
#' @param staticdocs logical. Whether or not to create staticdocs. Staticdocs are
#' from Hadley's \href{https://github.com/hadley/staticdocs}{staticdocs package}.
#" Defaults to \code{TRUE}.
#' @param gh_pages logical. If set to true, rocco docs will be served on
#' your gh-pages branch.
#' @export
#' @return TRUE, plus additional side effects are the creation of the
#' documentation in the \code{output_dir} and the launching of the browser if
#' \code{browse = TRUE}.
#' @examples
#' \dontrun{
#' rocco("/path/to/package") # Will create a temporary directory and
#' # display literate documentation for everything in the R directory
#' # of the package at /path/to/package.
#'
#' # The below will simply create a static HTML site without opening it.
#' rocco("/path/to/package", output_dir = "/my/html/dir", browse = FALSE)
#' }
rocco <- function(directory, output_dir = tempdir(), browse = interactive(),
rocco = TRUE, staticdocs = TRUE, gh_pages = FALSE) {
if (missing(directory)) directory <- "."
stopifnot(is.character(directory), length(directory) == 1,
is.character(output_dir), length(output_dir) == 1,
is_package_directory(directory))
if (isTRUE(staticdocs)) { write_staticdocs(directory) }
if (isTRUE(rocco)) { write_rocco_docs(directory, output_dir) }
if (isTRUE(gh_pages) && isTRUE(rocco)) {
#TODO: Be able to push *just* staticdocs to gh-pages.
commit_to_gh_pages(directory, output_dir)
}
if (isTRUE(browse)) {
if (isTRUE(rocco)) { browseURL(file.path(output_dir, "index.html")) }
if (isTRUE(staticdocs)) { browseURL(file.path(output_dir, "staticdocs", "index.html")) }
}
invisible(TRUE)
}
write_rocco_docs <- function(directory, output) {
rocco_skeleton(directory, output)
template <- readLines(file.path(output, "index.html"))
compile(directory, template, file.path(output, "index.html"))
}
#' Create a Skeleton for Rocco Documentation.
#'
#' Given a target directory, this will copy over the necessary assets to
#' create the initial docco template.
#'
#' @param directory character. The directory Rocco is running in.
#' @param output character. The directory to create the skeleton in.
rocco_skeleton <- function(directory, output) {
dir.create(output, showWarnings = FALSE, recursive = TRUE)
List of existing files and where they should be moved to.
file_map <- c(
rocco_file(file.path("www", "github-markdown-css", "github-markdown.css")),
file.path(output, "stylesheets", "github-markdown.css"),
rocco_file(file.path("www", "highlight", "highlight.pack.js")),
file.path(output, "assets", "highlight.pack.js"),
rocco_file(file.path("www", "highlight", "styles", "docco.css")),
file.path(output, "stylesheets", "rocco.css"),
rocco_file(file.path("templates", "index.html")),
file.path(output, "index.html")
)
destinations <- file_map[c(FALSE, TRUE)]
sources <- file_map[c(TRUE, FALSE)]
lapply(destinations, unlink, force = TRUE, recursive = TRUE)
lapply(unique(dirname(destinations)), dir.create, recursive = TRUE, showWarnings = FALSE)
suppressWarnings(Map(file.copy, sources, destinations, overwrite = TRUE))
if (staticdocs_exist(directory)) { load_staticdocs(directory, output) }
}
#' Writes staticdocs if they don't already exist.
#' @param package_dir character. The directory of the package to write staticdocs for.
write_staticdocs <- function(package_dir) {
check_for_staticdocs_package()
devtools::document(package_dir)
if (!inst_exists(package_dir)) { create_inst(package_dir) }
if (!staticdocs_index_exists(package_dir)) { create_staticdocs_index(package_dir) }
if (!staticdocs_folder_exists(package_dir)) { create_staticdocs_folder(package_dir) }
staticdocs::build_site(package_dir, launch = FALSE)
}
#' Add staticdocs into the Rocco directory.
#'
#' Since Rocco and Staticdocs conflict for gh-pages and we often want both,
#' this will resolve the tension and create one harmonious site with rocco
#' docs located at index.html and staticdocs located at staticdocs/index.html.
#'
#' @param directory character. The directory Rocco is running in.
#' @param output character. The directory to create the skeleton in.
load_staticdocs <- function(directory, output) {
create_staticdoc_directory <- function(dir) {
unlink(dir, recursive = TRUE, force = TRUE)
dir.create(dir, showWarnings = FALSE)
}
create_staticdoc_folder_tree <- function(dir, subdirs) {
subdirs <- lapply(subdirs, function(subdir) file.path(dir, subdir))
unlink(subdirs, recursive = TRUE, force = TRUE)
lapply(subdirs, dir.create, showWarnings = FALSE)
}
determine_dir <- function(dir, file) {
dir_split <- strsplit(file, "/")[[1]]
if (length(dir_split) > 1) {
file.path(dir, dir_split[[1]])
} else { dir }
}
create_staticdoc_files <- function(files, source_dir, destination) {
from_files <- lapply(files, function(file) file.path(source_dir, file))
destination <- file.path(destination, "staticdocs")
to_dirs <- Map(determine_dir, rep(destination, length(files)), files)
Map(file.copy, from_files, to_dirs, overwrite = TRUE)
}
staticdoc_dir <- file.path(output, "staticdocs")
create_staticdoc_directory(staticdoc_dir)
web_dir <- file.path(directory, "inst", "web")
staticdoc_subdirs <- grep(".html", dir(web_dir), value = TRUE,
fixed = FALSE, invert = TRUE)
create_staticdoc_folder_tree(staticdoc_dir, staticdoc_subdirs)
staticdoc_files <- dir(web_dir, recursive = TRUE)
create_staticdoc_files(staticdoc_files, source_dir = web_dir, destination = output)
}
#' Check to see if a directory exists within the package.
#' @param directory character. The directory of the package to check for staticdocs.
#' @param ... list. The folder structure to pass to \code{file.path}.
dir_exists <- function(directory, ...) {
file.exists(file.path(directory, ...))
}
#' Create a directory if it doesn't exist.
#' @inheritParams dir_exists
dir_create <- function(directory, ...) {
dir.create(file.path(directory, ...), showWarnings = FALSE)
}
#' Check whether the inst folder exists.
#' @inheritParams dir_exists
inst_exists <- function(directory) { dir_exists(directory, "inst") }
#' Create the inst directory.
#' @inheritParams dir_exists
create_inst <- function(directory) { dir_create(directory, "inst") }
#' Check whether the staticdocs folder exists.
#' @inheritParams dir_exists
staticdocs_folder_exists <- function(directory) {
dir_exists(directory, "inst", "staticdocs")
}
#' Create the staticdocs directory.
#' @inheritParams dir_exists
create_staticdocs_folder <- function(directory) {
dir_create(directory, "inst", "staticdocs")
}
#' Check whether a staticdoc index file exists.
#' @inheritParams dir_exists
staticdocs_index_exists <- function(directory) {
staticdocs_folder_exists(directory) &&
dir_exists(directory, "inst", "staticdocs", "index.r")
}
#' Create the staticdocs index.
#' @inheritParams dir_exists
create_staticdocs_index <- function(directory) {
dir_create(directory, "inst", "staticdocs", "index.r")
}
#' Check whether staticdoc files have been written.
#' @inheritParams dir_exists
staticdocs_written <- function(directory) {
dir_exists(directory, "inst", "web", "index.html")
}
#' Check whether staticdocs exist.
#' @inheritParams dir_exists
staticdocs_exist <- function(directory) {
staticdocs_index_exists(directory) && staticdocs_written(directory)
}
#' Checks that the staticdocs package is installed.
check_for_staticdocs_package <- function() {
if (!(is.element("staticdocs", utils::installed.packages()[, 1]))) {
stop("You must install the staticdocs package to run staticdocs. ",
"You can get it from https://github.com/hadley/staticdocs.", call. = FALSE)
}
}
`%||%` <- function(x, y) if (is.null(x)) y else x
isFALSE <- function(x) identical(x, FALSE)
is_package_directory <- function(dir) {
all(file.exists(file.path(dir, c("DESCRIPTION", "R"))))
}
rocco_file <- function(file) {
system.file(file, package = "rocco")
}
package_description <- function(pkg_path) {
description_file_attribute(pkg_path, "Description")
}
package_title <- function(pkg_path) {
description_file_attribute(pkg_path, "Title")
}
description_file_attribute <- function(pkg_path, attribute) {
as.character(read.dcf(file.path(pkg_path, "DESCRIPTION"))[1, attribute])
}
commit_to_gh_pages <- function(directory, dir) {
A little bit of git magic
Now that we have the docs, we need to transfer them to the gh-pages branch of the repo, commit and push. Switch to gh-pages branch
cur_branch <- system('git rev-parse --abbrev-ref HEAD', intern = TRUE)
on.exit({
system(paste('git checkout', cur_branch))
})
st <- system2('git', 'checkout gh-pages')
if (st == 1) system2('git', 'checkout -b gh-pages')
Copy the docs to the repo folder, and push them upstream
system(paste0('cp -rf ', dir, "/* ", directory))
in_dir(directory, {
system('git add -A .')
system('git commit -m "Updated Rocco docs."')
system('git push origin gh-pages')
})
invisible(TRUE)
}
Don't want to import devtools because of in_dir
in_dir <- function(new, code) {
old <- setwd(new)
on.exit(setwd(old))
force(code)
}