render_report.R

#' @rdname render_reports
#' @inheritParams bookdown::render_book
#' @param output_format output format, see [bookdown::render_book]. Only
#' `"bookdown::gitbook"` and `"bookdown::pdf_book"` are currently handled
#' @param clean_cache [logical] clean Rmarkdown cache files
#' @param allow_duplicate_labels [logical] if `TRUE`, allow code chunks to have
#' duplicate labels (set the option `knitr.duplicate.label = "allow"`)
#' @export
render_report <- function(input,
                          output_dir,
                          output_format = Sys.getenv("BOOKDOWN_FORMAT", "bookdown::gitbook"),
                          clean_cache = FALSE,
                          allow_duplicate_labels = 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()

  if (file.exists(file.path(input, "setup.R"))) {
    add_before_chapter_script(input)
  }

  if (output_format == "bookdown::pdf_book") {
    if (!requireNamespace("tinytex", quietly = TRUE)) {
      stop("For rendering report in PDF format, you should install tinytex first:\n",
           "`install.packages('tinytex')`\n",
           "`tinytex::install_tinytex()`")
    }
    if (file.exists(file.path(input, "_bookdown.yml"))) {
      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)

  if (clean_cache) {
    clean_cache_report(input)
  }
  file_bookdown <- file.path(input, "_bookdown.yml")
  book_filename <- NULL
  if (file.exists(file_bookdown)) {
    book_filename <-
      yaml::read_yaml(file_bookdown)$book_filename
  }
  if (is.null(book_filename)) book_filename <- "_main"
  unlink(file.path(input, paste0(book_filename, ".*")))
  file_fairify <- file.path(input, "_fairify.yml")
  if (file.exists(file_fairify)) {
    copy_templates(input)
  }
  args <- list(
    input = file.path(input, input_index),
    output_format =  output_format,
    output_dir = output_dir,
    allow_duplicate_labels = allow_duplicate_labels
  )
  args <- c(args, list(...))
  file.copy(system.file("_render_book.R", package = "fairify"),
            file.path(input, "_render_book.R"))
  saveRDS(args, file.path(input, "_render_book.RDS"))
  ret <- xfun::Rscript(shQuote(c(file.path(input, "_render_book.R"), input)))
  if (ret != 0) {
    stop("render_report has raised an error (See message above)")
  }
  unlink(c(file.path(input, "templates"),
           file.path(input, "_render_book.R"),
           file.path(input, "_render_book.RDS")),
         recursive = TRUE)
  output_main <- file.path(output_dir, "_main.html")
  if (file.exists(output_main)) {
    file.rename(output_main, file.path(output_dir, "index.html"))
  }

  invisible()
}

#' @rdname render_reports
#' @export
render_report_setup <- function(input = getwd(), clean_cache = FALSE) {
  file_fairify <- file.path(input, "_fairify.yml")
  if (file.exists(file_fairify)) {
    template <- yaml::read_yaml(file_fairify)$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|_files)$",
                          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"))
  }
}