R/quarto_generate.R

In framework: Structured Data Science Project Scaffolding

#' Generate Quarto YAML Configuration
#'
#' @description
#' Generates `_quarto.yml` configuration files for Quarto projects.
#' Files are generated once on project creation and owned by the user thereafter.
#'
#' @param settings List containing Quarto settings (html and/or revealjs format configs)
#' @param format Character. Either "html" or "revealjs"
#' @param project_root Logical. If TRUE, generates project-level config. Default FALSE.
#' @param output_dir Optional output directory for rendered files (relative to file location)
#' 
#' @return Character vector of YAML lines
#' 
#' @details
#' Generated files include:
#' - Auto-generated header comment
#' - Format-specific settings from global defaults or project overrides
#' - Proper YAML structure compatible with Quarto
#'
#' Files are never automatically regenerated to preserve user edits.
#'
#' @keywords internal
#' @noRd
generate_quarto_yml <- function(settings, format = "html", project_root = FALSE, output_dir = NULL) {
  if (!format %in% c("html", "revealjs")) {
    stop("Format must be 'html' or 'revealjs'")
  }

  # Get format-specific settings
  format_settings <- settings[[format]]
  if (is.null(format_settings)) {
    # Fallback to defaults
    format_settings <- get_default_quarto_settings(format)
  }

  # Build header comment
  header <- c(
    "# Auto-generated by Framework on {date}",
    "# This file is yours to customize - Framework will not modify it after creation",
    "# To regenerate: Use GUI 'Regenerate Quarto Configs' button (WARNING: overwrites!)",
    ""
  )
  header <- gsub("\\{date\\}", format(Sys.Date(), "%Y-%m-%d"), header)

  # Build YAML structure
  yaml_lines <- character(0)

  # Project block (root gets type, children may still need output-dir)
  if (project_root || !is.null(output_dir)) {
    yaml_lines <- c(yaml_lines, "project:")
    if (project_root) {
      yaml_lines <- c(yaml_lines, "  type: default")
    }
    if (!is.null(output_dir) && nzchar(output_dir)) {
      yaml_lines <- c(yaml_lines, sprintf("  output-dir: %s", output_dir))
    }
    yaml_lines <- c(yaml_lines, "")
  }

  yaml_lines <- c(yaml_lines, "format:")

  if (format == "html") {
    yaml_lines <- c(
      yaml_lines,
      "  html:",
      sprintf("    theme: %s", format_settings$theme %||% "default"),
      sprintf("    toc: %s", tolower(as.character(format_settings$toc %||% TRUE))),
      sprintf("    toc-depth: %d", format_settings$toc_depth %||% 3),
      sprintf("    code-fold: %s", tolower(as.character(format_settings$code_fold %||% FALSE))),
      sprintf("    code-tools: %s", tolower(as.character(format_settings$code_tools %||% FALSE))),
      sprintf("    embed-resources: %s", tolower(as.character(format_settings$embed_resources %||% TRUE))),
      sprintf("    highlight-style: %s", format_settings$highlight_style %||% "github")
    )
  } else if (format == "revealjs") {
    yaml_lines <- c(
      yaml_lines,
      "  revealjs:",
      sprintf("    theme: %s", format_settings$theme %||% "default"),
      sprintf("    incremental: %s", tolower(as.character(format_settings$incremental %||% FALSE))),
      sprintf("    slide-number: %s", tolower(as.character(format_settings$slide_number %||% TRUE))),
      sprintf("    transition: %s", format_settings$transition %||% "slide"),
      sprintf("    background-transition: %s", format_settings$background_transition %||% "fade"),
      sprintf("    controls: %s", tolower(as.character(format_settings$controls %||% TRUE))),
      sprintf("    progress: %s", tolower(as.character(format_settings$progress %||% TRUE))),
      sprintf("    center: %s", tolower(as.character(format_settings$center %||% TRUE))),
      sprintf("    highlight-style: %s", format_settings$highlight_style %||% "github")
    )
  }

  # Combine header and content
  c(header, yaml_lines)
}

#' Get Default Quarto Settings
#'
#' @param format Character. Either "html" or "revealjs"
#' @return List of default settings for the format
#' @keywords internal
#' @noRd
get_default_quarto_settings <- function(format = "html") {
  if (format == "html") {
    list(
      format = "html",
      embed_resources = TRUE,
      theme = "default",
      toc = TRUE,
      toc_depth = 3,
      code_fold = FALSE,
      code_tools = FALSE,
      highlight_style = "github"
    )
  } else {
    list(
      format = "revealjs",
      theme = "default",
      incremental = FALSE,
      slide_number = TRUE,
      transition = "slide",
      background_transition = "fade",
      controls = TRUE,
      progress = TRUE,
      center = TRUE,
      highlight_style = "github"
    )
  }
}

#' Determine Format for Render Directory
#'
#' @param dir_key Character. Directory key name (e.g., "slides", "notebooks")
#' @param project_type Character. Project type ("project", "course", etc.)
#' @return Character. Either "html" or "revealjs"
#'
#' @details
#' Format selection rules:
#' - "slides" → revealjs
#' - All other directories → html
#' - Presentation project type at root → revealjs
#'
#' @keywords internal
#' @noRd
determine_render_format <- function(dir_key, project_type = NULL) {
  # Slides always use revealjs
  if (grepl("slides?", dir_key, ignore.case = TRUE)) {
    return("revealjs")
  }

  # Presentation project at root uses revealjs
  if (!is.null(project_type) && project_type == "presentation" && dir_key == "root") {
    return("revealjs")
  }

  # Everything else uses HTML
  "html"
}

#' Write Quarto Configuration File
#'
#' @param yaml_lines Character vector of YAML lines
#' @param path Character. Full path where to write the file
#' @return Logical. TRUE if successful, FALSE otherwise
#'
#' @keywords internal
#' @noRd
write_quarto_yml <- function(yaml_lines, path) {
  tryCatch({
    # Ensure directory exists
    dir_path <- dirname(path)
    if (!dir.exists(dir_path)) {
      dir.create(dir_path, recursive = TRUE, showWarnings = FALSE)
    }

    # Write file
    writeLines(yaml_lines, path)
    TRUE
  }, error = function(e) {
    warning("Failed to write _quarto.yml to ", path, ": ", e$message)
    FALSE
  })
}

#' Generate Quarto Configurations for Project
#'
#' @description
#' Main entry point for generating all `_quarto.yml` files in a project.
#' Generates root config and directory-specific configs based on project type.
#'
#' @param project_path Character. Path to project root
#' @param project_type Character. One of "project", "project_sensitive", "course", "presentation"
#' @param render_dirs Named list. Render directories with their paths
#' @param quarto_settings List. Quarto settings (html and revealjs configs)
#' @param directories Named list. Source directories keyed the same as render_dirs
#' @param root_output_dir Optional output directory to set on the root _quarto.yml
#' 
#' @return List with success status and paths of generated files
#' 
#' @export
quarto_generate_all <- function(project_path,
                                project_type,
                                render_dirs = NULL,
                                quarto_settings = NULL,
                                directories = NULL,
                                root_output_dir = NULL) {
  if (!dir.exists(project_path)) {
    stop("Project path does not exist: ", project_path)
  }

  generated_files <- character(0)

  # Get quarto settings (from project or global defaults)
  if (is.null(quarto_settings)) {
    quarto_settings <- list(
      html = get_default_quarto_settings("html"),
      revealjs = get_default_quarto_settings("revealjs")
    )
  }

  # 1. Generate root _quarto.yml
  root_format <- if (project_type == "presentation") "revealjs" else "html"
  root_yaml <- generate_quarto_yml(
    quarto_settings,
    format = root_format,
    project_root = TRUE,
    output_dir = NULL
  )
  root_path <- file.path(project_path, "_quarto.yml")

  if (write_quarto_yml(root_yaml, root_path)) {
    generated_files <- c(generated_files, root_path)
  }

  # 2. Generate directory-specific _quarto.yml files
  if (!is.null(render_dirs) && length(render_dirs) > 0) {
    for (dir_key in names(render_dirs)) {
      target_dir <- render_dirs[[dir_key]]
      if (is.null(target_dir) || target_dir == "") next

      # Source directory defaults to the directory key unless provided
      source_dir <- NULL
      if (!is.null(directories) && dir_key %in% names(directories)) {
        source_dir <- directories[[dir_key]]
      } else {
        source_dir <- dir_key
      }
      if (is.null(source_dir) || source_dir == "") next

      source_dir_path <- file.path(project_path, source_dir)
      target_dir_path <- file.path(project_path, target_dir)

      # Ensure source path exists
      if (!dir.exists(source_dir_path)) dir.create(source_dir_path, recursive = TRUE, showWarnings = FALSE)

      # Determine format based on directory type
      format <- determine_render_format(dir_key, project_type)

      # Compute output-dir relative to the source directory
      output_dir_rel <- tryCatch({
        fs::path_rel(target_dir_path, start = source_dir_path)
      }, error = function(e) {
        target_dir
      })

      # Generate YAML
      dir_yaml <- generate_quarto_yml(
        quarto_settings,
        format = format,
        project_root = FALSE,
        output_dir = output_dir_rel
      )

      # Write to source directory
      quarto_path <- file.path(source_dir_path, "_quarto.yml")

      if (write_quarto_yml(dir_yaml, quarto_path)) {
        generated_files <- c(generated_files, quarto_path)
      }
    }
  }

  list(
    success = length(generated_files) > 0,
    files = generated_files,
    count = length(generated_files)
  )
}

#' Regenerate Quarto Configurations
#'
#' @description
#' Regenerates all `_quarto.yml` files in a project.
#' **WARNING: This will overwrite any manual edits.**
#' Should only be called when user explicitly requests regeneration.
#'
#' @param project_path Character. Path to project root
#' @param backup Logical. If TRUE, backs up existing files before overwriting. Default TRUE.
#'
#' @return List with success status, backed up files, and regenerated files
#'
#' @export
quarto_regenerate <- function(project_path, backup = TRUE) {
  if (!dir.exists(project_path)) {
    stop("Project path does not exist: ", project_path)
  }

  # Read project config to get settings
  settings_path <- file.path(project_path, "settings.yml")
  config_path <- if (file.exists(settings_path)) settings_path else file.path(project_path, "config.yml")

  if (!file.exists(config_path)) {
    stop("Project settings.yml/config.yml not found")
  }

  # Use settings_read() to properly resolve split files
wd <- getwd()
  on.exit(setwd(wd), add = TRUE)
  setwd(project_path)
  config <- settings_read(config_path)

  project_type <- config$project_type %||% "project"
  render_dirs <- config$render_dirs
  directories <- config$directories
  quarto_settings <- config$quarto
  root_output_dir <- quarto_settings$render_dir

  # Backup existing files if requested
  backed_up <- character(0)
  if (backup) {
    backup_dir <- file.path(project_path, ".quarto_backups", format(Sys.time(), "%Y%m%d_%H%M%S"))
    dir.create(backup_dir, recursive = TRUE, showWarnings = FALSE)

    # Find all existing _quarto.yml files
    existing_files <- list.files(
      project_path,
      pattern = "^_quarto\\.yml$",
      recursive = TRUE,
      full.names = TRUE
    )

    for (file in existing_files) {
      rel_path <- sub(paste0("^", project_path, "/?"), "", file)
      backup_path <- file.path(backup_dir, rel_path)
      backup_path_dir <- dirname(backup_path)

      if (!dir.exists(backup_path_dir)) {
        dir.create(backup_path_dir, recursive = TRUE, showWarnings = FALSE)
      }

      if (file.copy(file, backup_path, overwrite = TRUE)) {
        backed_up <- c(backed_up, rel_path)
      }
    }
  }

  # Regenerate
  result <- quarto_generate_all(
    project_path,
    project_type,
    render_dirs,
    quarto_settings,
    directories = directories,
    root_output_dir = root_output_dir
  )

  list(
    success = result$success,
    backed_up = backed_up,
    backup_location = if (backup) backup_dir else NULL,
    regenerated = result$files,
    count = result$count
  )
}

# Null-coalescing operator helper
`%||%` <- function(x, y) {
  if (is.null(x)) y else x
}