render_report.R

#' @rdname render_reports
#' @inheritParams bookdown::render_book
#' @export
render_report <- function(input,
                          output_dir,
                          output_format = Sys.getenv("BOOKDOWN_FORMAT", "bookdown::gitbook"),
                          clean_cache = FALSE,
                          ...) {

  stopifnot(output_format %in% c("bookdown::gitbook", "bookdown::pdf_book"))

  if (output_format == "bookdown::pdf_book") {
    if (!requireNamespace("tinytex", quietly = TRUE)) install.packages("tinytex")
    if (dir.exists(input)) {
      babel_lang <- yaml::read_yaml(file.path(input, "_bookdown.yml"))$babel_lang
      if (!is.null(babel_lang)) {
        tinytex_install_babel_language_support(babel_lang)
      }
    }
  }
  message("output_format=", output_format)

  if (clean_cache) {
    cache_dir <- list.files(path = input,
                            pattern = "_cache$",
                            include.dirs = TRUE,
                            full.names = TRUE)
    unlink(cache_dir, recursive = TRUE)
  }
  on.exit({unlink(file.path(input, "templates"), recursive = TRUE)})
  copy_templates(input)
  cfg_bookdown <-
    yaml::read_yaml(file.path(input, "_bookdown.yml"))
  unlink(file.path(input, paste0(cfg_bookdown$book_filename, ".*")))
  attached_packages <- (.packages())
  here:::do_refresh_here(input)
  bookdown::render_book(input,
                        output_format =  output_format,
                        output_dir = output_dir,
                        envir =  new.env(),
                        ...)
  # detach all packages used in the knit
  sapply(
    setdiff((.packages()), attached_packages),
    function(x) detach(paste0("package:", x),
                       unload = TRUE,
                       character.only = TRUE))
  invisible()
}

copy_templates <- function(input) {
  if (file.exists(input) && !dir.exists(input)) {
    # Remove index.Rmd or whatever the file to get the folder
    template <- basename(template)
  }
  templates_path <- file.path(input, "templates")
  dir.create(templates_path, showWarnings = FALSE)
  template_dependencies <- get_template_dependencies(input)
  templates <- lapply(template_dependencies, function(x) {
    get_template_location(x)
  })
  sapply(templates, function(template) {
    ok <- file.copy(
      from = template["path"],
      to = templates_path,
      recursive = TRUE
    )
    if (!ok) stop("Error when copying template '", template["name"], "'\n",
                  "From: ", template["path"], "\n",
                  "To: ", templates_path)
  })
  invisible()
}

get_template_location <- function(template, err_msg = "") {
  if (!grepl("^[a-zA-Z0-9_]*\\:[a-zA-Z0-9_]*$", template)) {
    stop(err_msg,
         "`template` should be in the format `[package]:[template_name]`, ",
         "found: ", template)
  }
  template_location <- strsplit(template, ":", fixed = TRUE)[[1]]
  names(template_location) <- c("pkg", "name")
  template_path <- file.path(fs::path_package(template_location["pkg"]),
                             "templates")
  if (!dir.exists(template_path)) {
    stop(err_msg,
         "'templates' folder not found in the package '", template_location["pkg"], "'\n",
         "Complete folder: ", template_path)
  }
  template_folder <- file.path(template_path, template_location["name"])
  if (!dir.exists(template_folder)) {
    stop(err_msg,
         "template '", template_location["name"],"'' not found in the package '",
         template_location["pkg"], "'\n",
         "Complete folder: ", template_folder)
  }
  return(c(template_location, path = template_folder))
}