compile.R

              
            
              #' 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 ""
}
            

package.rocco.R

              
            
              #' Literate Documentation For R.
#'
#' @name rocco
#' @import whisker markdown
#' @docType package
NULL
            

rocco.R

              
            
              #' 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"))
}
            

skeleton.R

              
            
              #' 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) }
}
            

staticdocs.R

              
            
              #' 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)
  }
}
            

utils.R

              
            
              `%||%` <- 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)
}