R/build_markdown.R

In zkamvar/sandpaper: Create and Curate Carpentries Lessons

#' Build plain markdown from the RMarkdown episodes
#'
#' In the spirit of `{hugodown}`, This function will build plain markdown files
#' as a minimal R package in the `site/` folder of your `{sandpaper}` lesson
#' repository tagged with the hash of your file to ensure that only files that
#' have changed are rebuilt.
#'
#' @param path the path to your repository (defaults to your current working
#' directory)
#' @param rebuild if `TRUE`, everything will be built from scratch as if there
#' was no cache. Defaults to `FALSE`, which will only build markdown files that
#' haven't been built before.
#'
#' @return `TRUE` if it was successful, a character vector of issues if it was
#'   unsuccessful.
#'
#' @keywords internal
#' @seealso [build_episode_md()]
build_markdown <- function(path = ".", rebuild = FALSE, quiet = FALSE, slug = NULL) {

  # step 1: build the markdown vignettes and site (if it doesn't exist)
  if (rebuild) {
    reset_site(path)
  } else {
    create_site(path)
  }
  # check if the lesson needs to be reset
  lsn <- this_lesson(path)

  outdir <- path_built(path)

  # Determine build status for the episodes ------------------------------------
  sources <- get_build_sources(path, outdir, slug, quiet)

  no_renv_needed <- !any(fs::path_ext(sources) %in% c("Rmd", "rmd"))

  if (no_renv_needed) {
    op <- getOption("sandpaper.use_renv")
    on.exit(options(sandpaper.use_renv = op), add = TRUE)
    options(sandpaper.use_renv = FALSE)
  }

  # If the user accidentally used rmarkdown::render(), then they would end up
  # with an html artifact in here and it will clog up the machinery. Best to
  # remove it at the source.
  remove_rendered_html(sources)

  db_path <- fs::path(outdir, "md5sum.txt")
  rebuild <- renv_should_rebuild(path, rebuild, db_path)
  db      <- build_status(sources, db_path, rebuild, write = FALSE)
  update  <- FALSE

  on.exit({
    if (update) write_build_db(db$new, db_path)
  }, add = TRUE)

  # Copy the files to the assets directory -------------------------------------
  copy_build_assets(path, outdir, overview = lsn$overview)

  # Remove detritus ------------------------------------------------------------
  remove <- db$remove
  if (length(remove)) {
    # Remove previously built files
    tryCatch(fs::file_delete(remove), error = function(e) {})
    # Also remove any figures generated by those files
    for (built_slug in get_slug(remove)) {
      figs <- get_figs(path, built_slug)
      if (length(figs)) fs::file_delete(figs)
    }
  }

  cli::cli_div(theme = sandpaper_cli_theme())
  # Only build if there are markdown sources to be built.
  needs_building <- fs::path_ext(db$build) %in% c("md", "Rmd")
  if (any(needs_building)) {
    # Render the episode files to the built directory --------------------------
    renv_check_consent(path, quiet, sources)
    # determine if we need to fail when errors are triggered
    fail_on_error <- this_metadata$get()[["fail_on_error"]]
    # this is `error` in the knitr sense of `error = TRUE` means
    # fail_on_error = FALSE.
    error <- is.null(fail_on_error) || !fail_on_error
    # exclude files that do not need to be rebuilt
    build_me <- db$build[needs_building]
    slugs    <- get_slug(build_me)
    if (!error && !quiet) {
      cli::cli_alert_info("{.code fail_on_error: true}. Use {.code error=TRUE} in code chunks for demonstrative errors")
    }

    for (i in seq_along(build_me)) {
      build_episode_md(
        path    = build_me[i],
        outdir  = outdir,
        workdir = outdir,
        quiet   = quiet,
        error   = error
      )
    }

    handout <- this_metadata$get()[["handout"]]

    # produces the default headings, challenges, code, etc
    # TODO: this needs improving to allow users to choose what to include based
    # on a yaml list
    handout <- if (is.null(handout)) FALSE else handout
    should_build_handout <- !isFALSE(handout)
    if (should_build_handout) {
      build_handout(path, out = handout)
    }
  } else {
    if (!quiet) {
      cli::cli_alert_success("All files up-to-date; nothing to rebuild!")
    }
  }
  cli::cli_end()

  # Update hash of `{renv}` file if it exists ------------------------------------
  if (getOption("sandpaper.use_renv")) {
    hash <- renv_lockfile_hash(path, db_path)
    lf_hash <- fs::path_file(db$new$file) == "renv.lock"
    lf_exists <- !is.na(hash$new)
    lf_updated <- !isTRUE(hash$new == db$new$checksum[lf_hash])
    if (lf_exists && lf_updated) {
      db$new$checksum[lf_hash] <- hash$new
    }
  }


  # Update metadata ------------------------------------------------------------
  if (length(db$build) > 0) {
    # The config triggers a rebuild of the pkgdown yaml file, otherwise the
    # timestamp is updated.
    if (any(fs::path_file(db$build) == "config.yaml")) {
      write_pkgdown_yaml(create_pkgdown_yaml(path), path)
    } else {
      update_site_timestamp(path)
    }
  }

  # We've made it this far, so the database can be updated
  update <- TRUE
  invisible(db$build)
}

copy_build_assets <- function(path, outdir, overview = FALSE) {
  path <- root_path(path)
  # get all the non-markdown files
  known_folders <- c("episodes", "learners", "instructors", "profiles")
  artifacts <- get_source_artifacts(path, known_folders)
  resource_folders <- c("data", "files", "fig")
  # enforce dir will create a directory if it doesn't exist, so that it's
  # always available for the user, even if git is not tracking it.
  to_copy <- vapply(known_folders,
    FUN = function(f) {
      enforce_dir(fs::path(path, f, resource_folders))
    },
    FUN.VALUE = character(3)
  )
  to_copy <- c(as.vector(to_copy), artifacts)
  if (overview) {
    # overview lessons are special, so we are going to explicitly search the top
    # directory for the resource folders and then copy them only if they exist
    needed  <- fs::dir_ls(path, type = "directory")
    needed  <- needed[fs::path_file(needed) %in% resource_folders]
    to_copy <- c(needed, to_copy)
  }
  for (f in to_copy) {
    copy_assets(f, outdir)
  }
}

remove_rendered_html <- function(episodes) {
  htmls <- fs::path_ext_set(episodes, "html")
  exists <- fs::file_exists(htmls)
  if (any(exists)) {
    fs::file_delete(unique(htmls[exists]))
  }
}


# Get a vector of markdown files to build with names.
get_build_sources <- function(path, outdir, slug = NULL, quiet) {
  source_list <- .resources$get() %||% get_resource_list(path, warn = !quiet)
  # filter out the assets (e.g. child files) from the source list
  no_asset <- names(source_list) %nin% c("files", "data", "fig")
  sources <- unlist(source_list[no_asset], use.names = FALSE)
  names(sources) <- get_slug(sources)
  if (is.null(slug)) {
    copy_maybe(sources[["config"]], fs::path(outdir, "config.yaml"))
    copy_lockfile(sources, fs::path(outdir, "renv.lock"))
  } else {
    sources <- sources[slug]
  }
  return(sources)
}