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 (!file.exists(input)) {
    stop("input path not found: ", input)
  }
  input_index <- ""
  if (!dir.exists(input)) {
    # The input is a file, we need the path to work in it
    input <- dirname(input)
    input_index <- basename(input)
  }
  if (clean_cache) {
    clean_cache_report(input)
  }
  owd <- setwd(input)
  on.exit({setwd(owd)})
  input <- getwd()

  add_before_chapter_script(input)

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

  writeLines("options(knitr.duplicate.label = 'allow')", ".Rprofile")
  on.exit({
    unlink(file.path(input, c(".Rprofile", "templates")),
           recursive = TRUE)
  }, add = TRUE)
  args <- list(
    input = file.path(input, input_index),
    output_format =  output_format,
    output_dir = output_dir
  )
  args <- c(args, list(...))
  xfun::Rscript_call(
    fun = bookdown::render_book,
    args = args
  )

  invisible()
}

#' @rdname render_reports
#' @export
render_report_setup <- function(input = getwd(), clean_cache = FALSE) {
  if (clean_cache) {
    clean_cache_report(input)
  }
  copy_templates(input)
  cfg_bookdown <-
    yaml::read_yaml(file.path(input, "_bookdown.yml"))
  unlink(file.path(input, paste0(cfg_bookdown$book_filename, ".*")))
  options(knitr.duplicate.label = "allow")
  template <- yaml::read_yaml(file.path(input, "_fairify.yml"))$template
  source_template_setup(template)
}

copy_templates <- function(input) {
  templates_path <- file.path(input, "templates")
  dir.create(templates_path, showWarnings = FALSE)
  template_dependencies <- get_template_dependencies(input)
  templates <- lapply(template_dependencies, function(template) {
    get_template_location(template)
  })
  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))
}

clean_cache_report <- function(input) {
  cache_dir <- list.files(path = input,
                          pattern = "_cache$",
                          include.dirs = TRUE,
                          full.names = TRUE)
  unlink(cache_dir, recursive = TRUE)
}

add_before_chapter_script <- function(input) {
  stopifnot(file.exists(file.path(input, "_bookdown.yml")))
  cfg_bd <- yaml::read_yaml(file.path(input, "_bookdown.yml"))
  if (is.null(cfg_bd$before_chapter_script)) {
    cfg_bd$before_chapter_script = "setup.R"
    yaml::write_yaml(cfg_bd, file.path(input, "_bookdown.yml"))
  }
}