Skip to content

Adding a few knitr helpers #6

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
dgkf wants to merge 8 commits into
base: main
Choose a base branch
from
Open

Adding a few knitr helpers #6

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
d979556
feat(knitr-extras): adding mutable header and extra logging features
dgkf Jan 27, 2026
f6fa6cc
chore: update NAMESPACE
dgkf Jan 27, 2026
81ff316
feat(knitr-extras): Adding another that was missed in the first pass
dgkf Jan 27, 2026
cd25d46
chore: add tests; apply review feedback
dgkf Jan 28, 2026
7fac550
chore: adding tests, adding note about exports
dgkf Jan 29, 2026
512e8dd
chore: add requiresNamespace check for suggests deps, fix yaml header…
dgkf Jan 29, 2026
28ec1cf
chore: make style of logging output dependent on whether quarto or kn…
dgkf Jan 29, 2026
cb6435f
chore: document new style parameter
dgkf Jan 29, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,11 +17,13 @@ Imports:
methods,
htmltools,
quarto (>= 1.4.4),
reactable
reactable,
yaml
Suggests:
knitr,
riskmetric (>= 0.2.4),
rmarkdown,
S7,
spelling,
testthat (>= 3.0.0),
withr (>= 3.0.2)
Expand Down
9 changes: 9 additions & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,10 +4,19 @@ export(assessment)
export(check_reporter)
export(environ_report)
export(is_risk_error)
export(knit_print.knitr_log)
export(knitr_logger)
export(knitr_mutable_header)
export(knitr_update_options)
export(options_report)
export(package_report)
export(summary_table)
importFrom(htmltools,div)
importFrom(methods,is)
importFrom(tools,check_packages_in_dir_details)
importFrom(utils,capture.output)
importFrom(utils,getFromNamespace)
importFrom(utils,head)
importFrom(utils,packageName)
importFrom(utils,tail)
importFrom(yaml,yaml.load)
250 changes: 140 additions & 110 deletions R/reporter.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,139 +2,169 @@
#'
#' @param package_name Package name.
#' @param package_version Package version number.
#' @param package Path where to find a package source to retrieve name and version number.
#' @param template_path Path to a directory with one quarto template file (and the files required for rendering it).
#' @param package Path where to find a package source to retrieve name and
#' version number.
#' @param template_path Path to a directory with one quarto template file (and
#' the files required for rendering it).
#' @param output_format Output format for the report. Default is "all".
#' @param params A list of execute parameters passed to the template
#' @param ... Additional arguments passed to `quarto::quarto_render()`
#'
#' @return A path to the reports generated, called by its side effects.
#' @details Please include source as part of `params` content. Source is returned after
#' calling function `riskmetric::pkg_ref` before the risk assessment is executed
#' @export
#'
#' @details Please include source as part of `params` content. Source is
#' returned after calling function `riskmetric::pkg_ref` before the risk
#' assessment is executed
#'
#' @examples
#' options("valreport_output_dir" = tempdir())
#' pr <- package_report(
#' package_name = "dplyr",
#' package_version = "1.1.4",
#' params = list(
#' assessment_path = system.file("assessments/dplyr.rds", package = "val.report"),
#' assessment_path =
#' system.file("assessments/dplyr.rds", package = "val.report"),
#' image = "rhub/ref-image"),
#' quiet = FALSE
#' )
#' pr
#' file.remove(pr)
#'
#' @export
package_report <- function(
package_name,
package_version,
package = NULL,
template_path = system.file("report/package", package = "val.report"),
output_format = "all",
params = list(),
...
package_name,
package_version,
package = NULL,
template_path = system.file("report/package", package = "val.report"),
output_format = "all",
params = list(),
...
) {
empty_pkg_info <- is.empty(package_name) && is.empty(package_version)
if (empty_pkg_info && !is.empty(package)) {
package_name <- basename(package)
desc <- read.dcf(file.path(package, "DESCRIPTION"))

stopifnot("Mismatch between path and DESCRIPTION name" = package_name == desc[, "Package"])
package_version <- desc[, "Version"]
params$package <- package
Sys.setenv("INPUT_REPORT_PKG_DIR" = package)
} else if (empty_pkg_info && is.empty(package)) {
stop("Package information missing for the report")
} else {
params$package <- package_name
}

full_name <- paste0(package_name, "_v", package_version)
output_file <- paste0("validation_report_", full_name, ".qmd")

params$package_name <- package_name
params$package_version <- package_version
params$image <- get_image_name(params)

if (is.null(template_path) || !nzchar(template_path)) {
template_path <- system.file("report/package",
package = "val.report")
} else if (!dir.exists(template_path)) {
stop("Template directory is not available")
}

params$package <- normalizePath(params$package, mustWork = FALSE, winslash = "/")
if (length(params$assessment_path) == 1L && !nzchar(params$assessment_path)) {
params$assessment_path <- normalizePath(params$assessment_path, mustWork = TRUE, winslash = "/")
}

# Bug on https://github.com/quarto-dev/quarto-cli/issues/5765
v <- quarto::quarto_version()
if (v < package_version("1.7.13")) {
warning("Please install the latest (devel) version of Quarto")
}

if (is.null(params$source)) warning("Please provide the source of the package assessment")

# https://github.com/quarto-dev/quarto-r/issues/81#issuecomment-1375691267
# quarto rendering happens in the same place as the file/project
# To avoid issues copy to a different place and render there.
render_dir <- output_dir()
empty_pkg_info <- is.empty(package_name) && is.empty(package_version)
if (empty_pkg_info && !is.empty(package)) {
package_name <- basename(package)
desc <- read.dcf(file.path(package, "DESCRIPTION"))

stopifnot(
"Mismatch between path and DESCRIPTION name" = package_name ==
desc[, "Package"]
)
package_version <- desc[, "Version"]
params$package <- package
Sys.setenv("INPUT_REPORT_PKG_DIR" = package)
} else if (empty_pkg_info && is.empty(package)) {
stop("Package information missing for the report")
} else {
params$package <- package_name
}

full_name <- paste0(package_name, "_v", package_version)
output_file <- paste0("validation_report_", full_name, ".qmd")

params$package_name <- package_name
params$package_version <- package_version
params$image <- get_image_name(params)

if (is.null(template_path) || !nzchar(template_path)) {
template_path <- system.file("report/package", package = "val.report")
} else if (!dir.exists(template_path)) {
stop("Template directory is not available")
}

params$package <- normalizePath(
params$package,
mustWork = FALSE,
winslash = "/"
)
if (length(params$assessment_path) == 1L && !nzchar(params$assessment_path)) {
params$assessment_path <- normalizePath(
params$assessment_path,
mustWork = TRUE,
winslash = "/"
)
}

# Bug on https://github.com/quarto-dev/quarto-cli/issues/5765
v <- quarto::quarto_version()
if (v < package_version("1.7.13")) {
warning("Please install the latest (devel) version of Quarto")
}

if (is.null(params$source)) {
warning("Please provide the source of the package assessment")
}

# https://github.com/quarto-dev/quarto-r/issues/81#issuecomment-1375691267
# quarto rendering happens in the same place as the file/project
# To avoid issues copy to a different place and render there.
render_dir <- output_dir()
if (!dir.exists(render_dir)) {
render_dir <- paste0(render_dir, "/")
if (!dir.exists(render_dir)) {
render_dir <- paste0(render_dir, "/")
if (!dir.exists(render_dir)) {
stop("Render directory doesn't exists. Please check the 'getOptions(\"valreport_output_dir\")' and sys.getEnv(\"VALREPORT_OUTPUT_DIR\")" )
}
}
files_to_copy <- list.files(template_path, full.names = TRUE)
fc <- file.copy(from = files_to_copy,
to = render_dir,
overwrite = TRUE,
copy.date = TRUE)

if (any(!fc)) {
stop("Copying to the rendering directory failed.")
}

template_all_files <- list.files(render_dir, full.names = TRUE)
template <- template_all_files[endsWith(template_all_files, "qmd")]

if (length(template) > 1) {
stop("There are more than one template!\n",
"Please have only one quarto file on the directory.")
}

file_template <- file.path(render_dir,
paste0("validation_report_", full_name, ".qmd"))
file.rename(template, file_template)

# replace the title of the place header by the package name and header
top_page_file <- readLines(file.path(render_dir, "top_page.html"))
title_line <- grep("<p", top_page_file)
top_page_file[title_line] <- htmltools::p(paste0("Validation Report - ", package_name, "@", package_version)) |>
as.character()
writeLines(top_page_file, file.path(render_dir, "top_page.html"))

pre_rendering <- list.files(render_dir, full.names = TRUE)

suppressMessages({suppressWarnings({
out <- quarto::quarto_render(
input = file_template,
output_format = output_format,
execute_params = params,
...
stop(
"Render directory doesn't exists. Please check the 'getOptions(\"valreport_output_dir\")' and sys.getEnv(\"VALREPORT_OUTPUT_DIR\")"
)
})})
}
}
files_to_copy <- list.files(template_path, full.names = TRUE)
fc <- file.copy(
from = files_to_copy,
to = render_dir,
overwrite = TRUE,
copy.date = TRUE
)

if (any(!fc)) {
stop("Copying to the rendering directory failed.")
}

template_all_files <- list.files(render_dir, full.names = TRUE)
template <- template_all_files[endsWith(template_all_files, "qmd")]

if (length(template) > 1) {
stop(
"There are more than one template!\n",
"Please have only one quarto file on the directory."
)
}

file_template <- file.path(
render_dir,
paste0("validation_report_", full_name, ".qmd")
)
file.rename(template, file_template)

# replace the title of the place header by the package name and header
top_page_file <- readLines(file.path(render_dir, "top_page.html"))
title_line <- grep("<p", top_page_file)
top_page_file[title_line] <- htmltools::p(paste0(
"Validation Report - ",
package_name,
"@",
package_version
)) |>
as.character()
writeLines(top_page_file, file.path(render_dir, "top_page.html"))

pre_rendering <- list.files(render_dir, full.names = TRUE)

out <- quarto::quarto_render(
input = file_template,
output_format = output_format,
execute_params = params,
...
)

post_rendering <- list.files(render_dir, full.names = TRUE)
post_rendering <- list.files(render_dir, full.names = TRUE)

files_to_remove <- intersect(pre_rendering, post_rendering)
fr <- file.remove(files_to_remove)
if (any(!fr)) {
warning("Failed to remove the quarto template used from the directory.")
}
files_to_remove <- intersect(pre_rendering, post_rendering)
fr <- file.remove(files_to_remove)
if (any(!fr)) {
warning("Failed to remove the quarto template used from the directory.")
}

output_files <- setdiff(post_rendering, pre_rendering)
invisible(output_files)
output_files <- setdiff(post_rendering, pre_rendering)
invisible(output_files)
}

is.empty <- function(x) {
Expand Down
Loading