alternative quarto rendering function

quarto-render2.R

#' Render quarto files
#'
#' Render quarto files
#'
#' @details
#' The `.qmd` input file is copied as a temporary file, which is then used for
#' rendering.  The output of this is then copied over to the intended output
#' file.
#'
#' @inheritParams quarto::quarto_render
#' @param metadata A named list of metadata values
#' @noRd
quarto_render2 <- function(input, output_file = NULL, ...) {
  stopifnot(tools::file_ext(input) == "qmd")

  temp_qmd  <- basename(tempfile(tools::file_path_sans_ext(basename(input)), fileext = ".qmd"))
  temp_qmd  <- file.path(dirname(input), temp_qmd)
  file.copy(input, temp_qmd)
  on.exit(file.remove(temp_qmd))

  temp_html <- tools::file_path_sans_ext(temp_qmd)
  temp_html <- paste0(temp_html, ".html")

  if (is.null(output_file)) {
    output_file <- file.path(
      dirname(input),
      paste0(tools::file_path_sans_ext(intput), ".html")
    )
  }

  quarto_render_(temp_qmd, ...)
  file.rename(temp_html, output_file)
  output_file
}

# mostly quarto::quarto_render() but with metadata
quarto_render_ <- function(
    input                  = NULL,
    output_format          = NULL,
    metadata               = NULL,  # new
    output_file            = NULL,
    execute                = TRUE,
    execute_params         = NULL,
    execute_dir            = NULL,
    execute_daemon         = NULL,
    execute_daemon_restart = FALSE,
    execute_debug          = FALSE,
    use_freezer            = FALSE,
    cache                  = NULL,
    cache_refresh          = FALSE,
    debug                  = FALSE,
    quiet                  = FALSE,
    pandoc_args            = NULL,
    as_job                 = getOption("quarto.render_as_job", "auto")
) {

  # provide default for input
  if (is.null(input)) {
    input <- getwd()
  }
  input <- path.expand(input)

  # get quarto binary
  quarto_bin <- quarto::quarto_path()

  # see if we need to render as a job
  if (identical(as_job, "auto")) {
    as_job <- utils::file_test("-d", input)
  }

  # render as job if requested and running within rstudio
  if (as_job && rstudioapi::isAvailable()) {
    message("Rendering project as backround job (use as_job = FALSE to override)")
    script <- tempfile(fileext = ".R")
    writeLines(
      c("library(quarto)", deparse(sys.call())),
      script
    )
    rstudioapi::jobRunScript(
      script,
      name = "quarto render",
      workingDir = getwd(),
      importEnv = TRUE
    )
    return (invisible(NULL))
  }


  # build args
  args <- c("render", input)
  if (!missing(output_format)) {
    args <- c(args, "--to", paste(output_format, collapse = ","))
  }
  if (!missing(output_file)) {
    args <- c(args, "--output", output_file)
  }
  if (!missing(execute)) {
    args <- c(args, ifelse(isTRUE(execute), "--execute", "--no-execute"))
  }
  if (!missing(execute_params)) {
    params_file <- tempfile(pattern = "quarto-params", fileext = ".yml")
    yaml::write_yaml(execute_params, params_file)
    args <- c(args, "--execute-params", params_file)
  }

  if (!missing(metadata)) {
    meta_names <- names(metadata)
    meta_values <- sapply(metadata, paste, collapse = "")
    metadata <- paste0(meta_names, ":", meta_values)

    for (i in seq_along(metadata)) {
      args <- c(args, "--metadata", metadata[i])
    }
  }

  if (!missing(execute_dir)) {
    args <- c(args, "--execute-dir", execute_dir)
  }
  if (!missing(execute_daemon)) {
    args <- c(args, "--execute-daemon", as.character(execute_daemon))
  }
  if (isTRUE(execute_daemon_restart)) {
    args <- c(args, "--execute-daemon-restart")
  }
  if (isTRUE(execute_debug)) {
    args <- c(args, "--execute-debug")
  }
  if (isTRUE(use_freezer)) {
    args <- c(args, "--use-freezer")
  }
  if (!missing(cache)) {
    args <- c(args, ifelse(isTRUE(cache), "--cache", "--no-cache"))
  }
  if (isTRUE(cache_refresh)) {
    args <- c(args, "--cache-refresh")
  }
  if (isTRUE(debug)) {
    args <- c(args, "--debug")
  }
  if (isTRUE(quiet)) {
    args <- c(args, "--quiet")
  }
  if (!is.null(pandoc_args)) {
    args <- c(args, pandoc_args)
  }

  # run quarto
  processx::run(quarto_bin, args, echo = TRUE)

  # no return value
  invisible(NULL)
}

quarto_render2_ <- function(
    input                  = getwd(),
    output_format          = NULL,
    metadata               = NULL,
    output_file            = NULL,
    execute                = TRUE,
    execute_params         = NULL,
    execute_dir            = NULL,
    execute_daemon         = NULL,
    execute_daemon_restart = FALSE,
    execute_debug          = FALSE,
    use_freezer            = FALSE,
    cache                  = NULL,
    cache_refresh          = FALSE,
    debug                  = FALSE,
    quiet                  = FALSE,
    pandoc_args            = NULL,
    as_job                 = getOption("quarto.render_as_job","auto")
) {
  .Deprecated("quarto_render2")

  # helpers ----

  true <- function(x, y = character(), z = NULL) {
    if (isTRUE(x)) y else z
  }

  format_args <- function(...) {
    args <- list(...)
    args <- args[!vapply(args, is.null, NA)]                   # remove NULL arguments
    nms <- gsub("_", "-", trimws(names(args)))                 # tidy up names
    args <- vapply(args, paste, NA_character_, collapse = " ") # collapse
    paste(trimws(paste0("--", nms)), args, collapse = " ")     # collapse again!
  }

  format_format_params <- function(x = NULL) {
    if (is.null(x)) {
      return(NULL)
    }

    if (is.character(x)) {
      return(x[1])
    }

    stopifnot(
      is.list(x),
      vapply(x, is.list, NA),
      (nms <- names(x)) %in% c("html", "pdf")
    )

    out <- sapply(x, function(i) {
      ind <- vapply(i, is.logical, NA)
      i[ind] <- lapply(i[ind], tolower)
      ind <- lengths(ind) > 1
      i[ind] <- lapply(i[ind], paste, collapse = " ")
      sprintf("--%s:%s", gsub("_", "-", names(i)), as.character(i))
    })

    paste(nms, paste(out, collapse = " "), collapse = ", --to ")
  }

  format_key_value <- function(x) {
    nm <- names(x)
    vals <- sapply(x, paste0, collapse = "")
    vals <- paste0('"', vals, '"')
    paste0(nm, ":", vals, collapse = " ")
  }

  try_remove_file <- function(x) {
    if (!file.exists(x)) {
      return(invisible())
    }

    suppressWarnings(try(file.remove(x), silent = TRUE))
  }

  norm_path <- function(x, check = FALSE) {
    normalizePath(x, .Platform$file.sep, mustWork = check)
  }

  ## body ----

  input <- norm_path(input, check = TRUE)

  if (identical(as_job, "auto")) {
    as_job <- utils::file_test("-d", input)
  }

  # borrowed from original function
  if (as_job && rstudioapi::isAvailable()) {
    message("Rendering project as backround job (use as_job = FALSE to override)")
    script <- tempfile(fileext = ".R")
    writeLines(c("library(quarto)", deparse(sys.call())), script)
    rstudioapi::jobRunScript(
      script,
      name = "quarto render",
      workingDir = getwd(),
      importEnv = TRUE
    )

    return(invisible(NULL))
  }

  if (is.null(execute_dir) & isFALSE(file.info(input)$isdir)) {
    execute_dir <- dirname(input)
  }

  # normalize path to use a separate output and a separate temporary file
  output_file <- norm_path(output_file)
  temp_file <- basename(tempfile(tools::file_path_sans_ext(basename(output_file)), fileext = ".html"))
  temp_file <- norm_path(file.path(execute_dir, temp_file))
  on.exit(try_remove_file(temp_file), add = TRUE)

  # create new variable
  if (!is.null(execute_params)) {
    params_file <- tempfile(pattern = "quarto-params", fileext = ".yml")
    yaml::write_yaml(execute_params, params_file)
    params_file <- norm_path(params_file, check = TRUE)
  } else {
    params_file <- NULL
  }


  # format arguments -- removes any that are NULL
  args <- format_args(
    to                     = format_format_params(output_format),
    output                 = temp_file,
    # metadata               = format_key_value(metadata),
    metadata               = NULL,
    execute                = true(execute),
    no_execute             = true(!execute),
    execute_params         = params_file,
    execute_dir            = NULL,
    execute_daemon         = execute_daemon,
    execute_daemon_restart = true(execute_daemon_restart),
    execute_debug          = true(execute_debug),
    use_freezer            = true(use_freezer),
    cache                  = true(cache),
    no_cache               = if (!isTRUE(cache)) character(),
    cache_refresh          = true(cache_refresh),
    debug                  = true(debug),
    quiet                  = true(quiet),
    pandoc_args            = if (!is.null(pandoc_args)) pandoc_args
  )

  # use an error file
  error_file <- tempfile()
  on.exit(try_remove_file(error_file), add = TRUE)

  # use system2() over processx::run()
  quarto_path <- norm_path(quarto::quarto_path(), check = TRUE)
  if (!quiet) writeLines(paste(quarto_path, "render", input, args))
  browser()
  system2(quarto_path, c("render", input, args))

  # try to copy the files over
  # try(file.copy(temp_file, output_file, copy.mode = TRUE, copy.date = TRUE, overwrite = TRUE), silent = TRUE)

  # return the file that is created
  # output_file
  temp_file
}