R/wflow_publish.R

In jdblischak/workflowrBeta: A workflow template for creating a research website

#' Publish the site
#'
#' \code{wflow_publish} is the main workflowr function. Use it when you are
#' ready to publish an analysis to your site. \code{wflow_publish} performs
#' three steps: 1) commit the file(s), 2) rebuild the R Markdown file(s), 3)
#' commit the generated website file(s). These steps ensure that the version of
#' the HTML file is created by the latest version of the R Markdown file, which
#' is critical for reproducibility.
#'
#' @param files character (default: NULL). Files to be added and committed with
#'   Git (step 1). Any R Markdown files will also be built (step 2) and their
#'   output HTML and figures will be subsequently committed (step 3). Supports
#'   file \href{https://en.wikipedia.org/wiki/Glob_(programming)}{globbing}.
#' @inheritParams wflow_commit
#' @inheritParams wflow_build
#'
#' @return Returns an object of class \code{wflow_publish}, which is a list with
#'   the following elements:
#'
#'   \itemize{
#'
#'   \item \bold{step1}: An object of class \code{wflow_commit} from the first
#'   step of committing the analysis files.
#'
#'   \item \bold{step2}: An object of class \code{wflow_build} from the second
#'   step of building the HTML files.
#'
#'   \item \bold{step3}: An object of class \code{wflow_commit} from the third
#'   step of committing the HTML files.
#'
#'   }
#'
#' @seealso \code{\link{wflow_commit}}, \code{\link{wflow_build}}
#'
#' @examples
#' \dontrun{
#' # single file
#' wflow_publish("analysis/file.Rmd", "Informative commit message")
#' # All tracked files that have been edited
#' wflow_publish(all = TRUE, message = "Informative commit message")
#' # A new file plus all tracked files that have been edited
#' wflow_publish("analysis/file.Rmd", "Informative commit message", all = TRUE)
#' # Multiple files
#' wflow_publish(c("analysis/file.Rmd", "analysis/another.Rmd"),
#'               "Informative commit message")
#' # All R Markdown files that start with the pattern "new_"
#' wflow_publish("analysis/new_*Rmd", "Informative commit message")
#' # Republish all published files regardless of whether they have been
#' # modified. Useful for changing some universal aspect of the site,
#' # e.g. the theme specifid in _site.yml.
#' wflow_publish("analysis/_site.yml", "Informative commit message",
#'               republish = TRUE)
#'
#' }
#'
#' @import rmarkdown
#' @export
wflow_publish <- function(
  # args to wflow_commit
  files = NULL,
  message = NULL,
  all = FALSE,
  force = FALSE,
  # args to wflow_build
  update = FALSE,
  republish = FALSE,
  view = interactive(),
  seed = 12345,
  # general
  dry_run = FALSE,
  project = "."
  ) {
  # To do:
  # * Warning for cache directories
  # * Warning if files in docs/ included
  # Check for modifications to _site.yml. Refuse to build if it is modified

  # Check input arguments ------------------------------------------------------

  if (!is.null(files)) {
    if (!(is.character(files) && length(files) > 0))
      stop("files must be NULL or a character vector of filenames")
    files <- glob(files)
    if (!all(file.exists(files)))
      stop("Not all files exist. Check the paths to the files")
    # Change filepaths to relative paths
    files <- relative(files)
  }

  if (is.null(message)) {
    message <- deparse(sys.call())
    message <- paste(message, collapse = "\n")
  } else if (is.character(message)) {
    message <- wrap(paste(message, collapse = " "))
  } else {
    stop("message must be NULL or a character vector")
  }

  if (!(is.logical(all) && length(all) == 1))
    stop("all must be a one-element logical vector")

  if (!(is.logical(force) && length(force) == 1))
    stop("force must be a one-element logical vector")

  if (!(is.logical(update) && length(update) == 1))
    stop("update must be a one-element logical vector")

  if (!(is.logical(republish) && length(republish) == 1))
    stop("republish must be a one-element logical vector")

  if (!(is.logical(view) && length(view) == 1))
    stop("view must be a one-element logical vector")

  if (!(is.numeric(seed) && length(seed) == 1))
    stop("seed must be a one element numeric vector")

  if (!(is.logical(dry_run) && length(dry_run) == 1))
    stop("dry_run must be a one-element logical vector")

  if (!(is.character(project) && length(project) == 1))
    stop("project must be a one-element character vector")

  if (!dir.exists(project)) {
    stop("project directory does not exist.")
  }

  project <- absolute(project)

  # Assess project status ------------------------------------------------------

  s0 <- wflow_status(project = project)
  r <- git2r::repository(path = s0$git)
  commit_current <- git2r::commits(r, n = 1)[[1]]

  # Step 1: Commit analysis files ----------------------------------------------

  # Decide if wflow_commit should be run. At least one of the following
  # scenarios must be true:
  #
  # 1) Rmd files were specified and at least one is scratch (untracked) or has
  # unstaged/staged changes
  #
  # 2) `all == TRUE` and at least one tracked file has unstaged/staged changes
  #
  # 3) At least one non-Rmd file was specified
  scenario1 <- !is.null(files) &&
    any(unlist(s0$status[files, c("mod_unstaged", "mod_staged", "scratch")]),
        na.rm = TRUE)
  scenario2 <- all &&
    any(unlist(s0$status[s0$status$tracked, c("mod_unstaged", "mod_staged")]),
        na.rm = TRUE)
  scenario3 <- !is.null(files) &&
    any(!(files %in% rownames(s0$status)))

  if (scenario1 || scenario2 || scenario3) {
    step1 <- wflow_commit(files = files, message = message,
                          all = all, force = force,
                          dry_run = dry_run, project = project)
    # If subsequent steps fail, undo this action by resetting the Git repo to
    # its initial state.
    on.exit(git2r::reset(commit_current, reset_type = "mixed"), add = TRUE)
    s1 <- wflow_status(project = project)
  } else {
    step1 <- NULL
    s1 <- s0
  }

  # Step 2: Build HTML files----------------------------------------------------

  # Determine if there are any files to be built.
  files_to_build <- character()
  # Specified files
  files_to_build <- union(files_to_build,
                          files[files %in% rownames(s1$status)])
  # Files committed in Step 1
  files_to_build <- union(files_to_build,
                          step1$commit_files[
                            step1$commit_files %in% rownames(s1$status)])
  # If `republish == TRUE`, all published files
  if (republish) {
    files_to_build <- union(files_to_build,
                            rownames(s1$status)[s1$status$published])
  }
  # If `update == TRUE`, all published files with committed modifications
  if (update) {
    files_to_build <- union(files_to_build,
                            rownames(s1$status)[s1$status$mod_committed])
  }
  # None of these files can have unstaged/staged changes
  files_to_build <- files_to_build[!s1$status[files_to_build, "mod_unstaged"]]
  files_to_build <- files_to_build[!s1$status[files_to_build, "mod_staged"]]

  if (length(files_to_build) > 0) {
    # Create a backup copy of the docs/ directory
    docs_backup <- tempfile(pattern = sprintf("docs-backup-%s-",
                                              format(Sys.time(),
                                                     "%Y-%m-%d-%Hh-%Mm-%Ss")))
    dir.create(docs_backup)
    docs_backup <- absolute(docs_backup)
    file.copy(from = file.path(s1$docs, "."), to = docs_backup,
              recursive = TRUE, copy.date = TRUE)
    step2 <- wflow_build(files = files_to_build, make = FALSE,
                         update = update, republish = republish,
                         view = view, seed = seed,
                         local = FALSE, dry_run = dry_run, project = project)
    # If something fails in subsequent steps, delete docs/ and restore backup
    on.exit(unlink(s1$docs, recursive = TRUE), add = TRUE)
    on.exit(dir.create(s1$docs), add = TRUE)
    on.exit(file.copy(from = file.path(docs_backup, "."), to = s1$docs,
                      recursive = TRUE, copy.date = TRUE), add = TRUE)
    s2 <- wflow_status(project = project)
  } else {
    step2 <- NULL
    s2 <- s1
  }

  # Step 3 : Commit HTML files -------------------------------------------------

  # Step 3 only needs to be performed if files were built in step 2.
  if (length(step2$built) > 0) {
    site_libs <- file.path(s2$docs, "site_libs")
    dir_figure <- file.path(s2$docs, "figure", basename(step2$built))
    files_to_commit <- c(step2$html, dir_figure, site_libs)

    # Call directly to internal function `wflow_commit_` to bypass input checks.
    # In a dry run, some files may not actually exist yet. Also, not every Rmd
    # file creates figures, but it's easier to just attempt to add figures for
    # every file.
    step3 <- wflow_commit_(files = files_to_commit, message = "Build site.",
                          all = FALSE, force = force,
                          dry_run = dry_run, project = project)
  } else {
    step3 <- NULL
  }

  # Prepare output -------------------------------------------------------------

  o <- list(step1 = step1, step2 = step2, step3 = step3)
  class(o) <- "wflow_publish"

  # If everything worked, erase the on.exit code that would have reset
  # everything.
  on.exit()

  return(o)
}

#' @export
print.wflow_publish <- function(x, ...) {
  cat("Summary from wflow_publish\n\n")

  cat("**Step 1: Commit analysis files**\n\n")
  if (is.null(x$step1)) {
    cat("No files to commit\n\n")
  } else {
    print(x$step1)
  }

  cat("\n**Step 2: Build HTML files**\n\n")
  if (is.null(x$step2)) {
    cat("No files to build\n\n")
  } else {
    print(x$step2)
  }

  cat("\n**Step 3: Commit HTML files**\n\n")
  if (is.null(x$step3)) {
    cat("No HTML files to commit\n\n")
  } else {
    print(x$step3)
  }

  return(invisible(x))
}