From f00deb0b1c9bcc6f593edf40654f0e7633b7f4c9 Mon Sep 17 00:00:00 2001 From: dgkf <18220321+dgkf@users.noreply.github.com> Date: Thu, 22 Jan 2026 11:35:25 -0500 Subject: [PATCH] wip(val.meter): various exploratory enhancements to adopt val.meter --- NAMESPACE | 5 + R/check.R | 8 +- R/render_utils.R | 126 ++++++++++ R/reporter.R | 229 ++++++++++-------- R/session.R | 17 ++ inst/report/package/pkg_template.qmd | 348 ++++++++------------------- man/knit_print.knitr_log.Rd | 11 + man/knitr_logger.Rd | 12 + man/knitr_mutable_header.Rd | 13 + man/knitr_update_options.Rd | 13 + man/package_report.Rd | 14 +- 11 files changed, 443 insertions(+), 353 deletions(-) create mode 100644 R/session.R create mode 100644 man/knit_print.knitr_log.Rd create mode 100644 man/knitr_logger.Rd create mode 100644 man/knitr_mutable_header.Rd create mode 100644 man/knitr_update_options.Rd diff --git a/NAMESPACE b/NAMESPACE index 0e24e4a..b295c9a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,8 +4,13 @@ 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(session) export(summary_table) importFrom(htmltools,div) importFrom(methods,is) diff --git a/R/check.R b/R/check.R index 599024a..16408f2 100644 --- a/R/check.R +++ b/R/check.R @@ -1,5 +1,3 @@ - - #' Reports check results #' #' Experimental function to use the default log to create a report. @@ -13,9 +11,9 @@ #' # Requires the package to be installed (or be in inst/ folder) #' # check_reporter("checks/riskmetric.Rcheck") #' -check_reporter <- function(path){ +check_reporter <- function(path) { log <- file.path(path, "00check.log") - lines <- readLines(log) + readLines(log) } @@ -68,7 +66,5 @@ check_summary <- function(path) { } check_packages <- function(path) { - check_packages_in_dir_details(path) - } diff --git a/R/render_utils.R b/R/render_utils.R index 2eaf721..ccbd8d5 100644 --- a/R/render_utils.R +++ b/R/render_utils.R @@ -88,3 +88,129 @@ get_image_name <- function(params) { } else if (is_empty(image)) image <- default_image image } + +#' Handler for complex option passing through from a quarto parameter +#' +#' Importantly, handles S7 objects which cannot be passed through as a quarto +#' parameter because they can not be deparsed. Allows passing arbitrary +#' expressions using the `!expr` prefix used by `yaml`. +#' +#' @export +knitr_update_options <- function(opts) { + opts <- as.list(opts) + opt_is_char <- vapply(opts, is.character, logical(1L)) + opt_is_expr <- opt_is_char + opt_is_expr[opt_is_char] <- startsWith(as.character(opts[opt_is_char]), "!expr") + opts[opt_is_expr] <- lapply( + opts[opt_is_expr], + function(expr) eval(parse(text = sub("^!expr", "", expr))) + ) + + do.call(options, opts) + opts +} + +#' Create mutable header object +#' +#' Inject a custom document rendering hook into the knitr engine and return +#' a mutable environment that we can modify, which will be used to update the +#' knitr document header upon render completion. +#' +#' @export +knitr_mutable_header <- function() { + header <- new.env(parent = emptyenv()) + + knitr::knit_hooks$set(document = local({ + default_document_hook <- knitr::knit_hooks$get("document") + function(x, output) { + # extract and split our document front-matter and body + fm <- knitr:::yaml_front_matter(strsplit(x, "\n")[[1L]]) + body <- sub("\\s*---.*---", "", x) + + # pragmatically update front-matter at build-time + fm <- yaml::yaml.load(fm) + for (name in names(header)) { + fm[[name]] <- header[[name]] + } + + # rebuild our document + x <- paste0(c("---", yaml::as.yaml(fm), "---", body), collapse = "\n") + default_document_hook(x) + } + })) + + header +} + +#' Special handler for emitting knitr logs +#' +#' @export +knit_print.knitr_log <- local({ + prefix <- " \u205A " # vertical two dot punctuation + last_log_trailing_newline <- FALSE + + function(x, ...) { + # prefix newline only for the first message in each chunk + knitr_log_env <- environment(knitr_logger) + first_chunk_log <- knitr_log_env$first_chunk_log + knitr_log_env$first_chunk_log <- FALSE + + # split content on non-character (or AsIs) objects + is_char <- vapply(x, is.character, logical(1L)) + is_asis <- vapply(x, inherits, logical(1L), "AsIs") + is_char <- is_char & !is_asis + chunks <- cumsum(!is_char | c(FALSE, tail(is_char, -1) & !head(is_char, -1))) + is_char_chunk <- vapply(split(is_char, chunks), any, logical(1L)) + + # if output is a string, join them for pretty printing; otherwise capture + # console output for logging + x <- Map( + function(chunk, is_char) { + if (is_char) { + paste(chunk, collapse = "") + } else { + paste(capture.output(chunk[[1L]]), collapse = "\n") + } + }, + chunk = split(x, chunks), + is_char = is_char_chunk + ) + + # determine where to inject newline prefixes + x <- paste0(x, collapse = "") + x <- strsplit(x, "(?<=\n)", perl = TRUE)[[1L]] + prefixed <- if (first_chunk_log || last_log_trailing_newline) TRUE else -1L + x[prefixed] <- paste0(prefix, x[prefixed]) + x <- paste0(x, collapse = "") + last_log_trailing_newline <<- endsWith(x[[length(x)]], "\n") + + # emit to stderr so that we see it immediately + if (first_chunk_log) cat("\n", file = stderr(), sep = "") + cat(x, file = stderr(), sep = "") + } +}) + +#' Create a knitr log function +#' +#' Sets necessary knitr hooks and returns a logging function that will emit +#' messages to the console during knitting. +#' +#' @export +knitr_logger <- local({ + first_chunk_log <- TRUE + + function() { + # reset our chunk start flag on chunk output + knitr::knit_hooks$set(chunk = local({ + default_chunk_hook <- knitr::knit_hooks$get("chunk") + function(x, options) { + first_chunk_log <<- TRUE + default_chunk_hook(x, options) + } + })) + + function(...) { + knitr::knit_print(structure(list(...), class = c("knitr_log", "list"))) + } + } +}) diff --git a/R/reporter.R b/R/reporter.R index d33e41d..f5116e3 100644 --- a/R/reporter.R +++ b/R/reporter.R @@ -1,136 +1,165 @@ #' Reports about a package #' +#' @details Please include source as part of `params` content. Source is +#' returned after calling function `riskmetric::pkg_ref` before the risk +#' assessment is executed +#' #' @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 package Path where to find a package source to retrieve name and +#' version number. #' @param template_path Path to a custom quarto template file #' @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 #' @examples +#' pkg_rds_path <- system.file("assessments/dplyr.rds", package = "val.report") #' pr <- package_report( #' package_name = "dplyr", #' package_version = "1.1.4", -#' params = list( -#' assessment_path = system.file("assessments/dplyr.rds", package = "val.report"), -#' image = "rhub/ref-image") +#' params = list(assessment_path = pkg_rds_path, image = "rhub/ref-image") #' ) +#' #' pr #' file.remove(pr) 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)) { - template_path <- system.file("report/pkg_template.qmd", - package = "val.report") - } - - params$package <- normalizePath(params$package, mustWork = FALSE) - if (!is.null(params$assessment_path)) { - params$assessment_path <- normalizePath(params$assessment_path, mustWork = TRUE) - } - # 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)) { + template_path <- system.file( + "report/pkg_template.qmd", + package = "val.report" + ) + } + + params$package <- normalizePath(params$package, mustWork = FALSE) + if (!is.null(params$assessment_path)) { + params$assessment_path <- normalizePath( + params$assessment_path, + mustWork = TRUE + ) + } + # 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.") + 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(" + as.character() + writeLines(top_page_file, file.path(render_dir, "top_page.html")) - 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(" - as.character() - writeLines(top_page_file, file.path(render_dir, "top_page.html")) - - pre_rendering <- list.files(render_dir, full.names = TRUE) + pre_rendering <- list.files(render_dir, full.names = TRUE) - suppressMessages({suppressWarnings({ + suppressMessages({ + suppressWarnings({ 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) { diff --git a/R/session.R b/R/session.R new file mode 100644 index 0000000..85acc02 --- /dev/null +++ b/R/session.R @@ -0,0 +1,17 @@ +#' @export +session <- function() { + # NOTE: data that is provided as named character vectors are coerced to + # lists because the names otherwise get lost when passed as a quarto parameter + + list( + time = Sys.time(), + r_version = unclass(R.version), + session_info = sessionInfo(), + platform = .Platform, + machine = .Machine, + rng_kind = RNGkind(), + capabilities = as.list(capabilities()), + external_software = as.list(extSoftVersion()), + graphics_software = as.list(grSoftVersion()) + ) +} diff --git a/inst/report/package/pkg_template.qmd b/inst/report/package/pkg_template.qmd index a4151e9..7ea325f 100644 --- a/inst/report/package/pkg_template.qmd +++ b/inst/report/package/pkg_template.qmd @@ -1,16 +1,40 @@ --- -title: "This report is fully automated and builds on [`r params$image`](`r paste('https://hub.docker.com/r', params$image, sep = '/')`) image." date-format: "YYYY-MM-DD hh:mm:ss" date: today -published-title: "" +published-title: "Report Created" params: - package_name: dplyr - package_version: 1.0.0 + # A value that can be `S7::convert`'ed into a `val.meter::pkg` + # + # Common inputs include: + # + # - DESCRIPTION (or PACKAGES) file string + # - PACKAGES file string + # - a package name (to be sourced from a repository) + # - a list of package metadata and metrics + # - an Rds file generated from a val.meter::pkg object + # package: NULL - image: "rhub/ref-image" - assessment_path: "assessments/dplyr.rds" + + # Additional options to set during evaluation. + # + # These may be especially useful if the report is used for performing package + # evaluations, in which case you may consider passing `?val.meter::options` to + # enable addition evaluation permissions. + # + # To set options using R code, pass a string prefixed with "!expr". + # + options: NULL + + # Session info to attach to the report + # + # When empty, defaults to `val.report::session()` captured during report + # generation. If you wish to provide information captured from previous + # execution, provide `val.report::session()` from that session as a parameter. + # + session: NULL + + image: "rocker/rver" hide_reverse_deps: true - source: "pgk_install" format: html: toc: true @@ -34,267 +58,107 @@ filters: --- ```{r setup, include = FALSE} -options(width = 80L, covr.record_tests = TRUE) +options( + width = 80L, + covr.record_tests = TRUE +) knitr::opts_chunk$set( - echo = FALSE, - eval = TRUE, - error = TRUE, - cache = FALSE + echo = FALSE, + eval = TRUE, + error = TRUE, + cache = FALSE ) -library("tools") -library("knitr") -library("val.report") -``` -# Context +library(S7) +library(tools) +library(knitr) +library(val.meter) +library(val.report) - -```{r loading} -pkg <- params$package -pkg_name <- params$package_name -pkg_version <- params$package_version -risk_path <- params$assessment_path -image <- params$image +header <- val.report::knitr_mutable_header() +log <- val.report::knitr_logger() ``` -Documents the installation of this package on an open source R environment, focusing on: - -- Installation environment description -- Testing coverage - -It is limited to assess whether unit tests and documentation are present and can execute without error. -An assessment would be required that the tests and documentation are meaningful. - - -# Package `r basename(pkg)` - -## Metric based risk assessment - -The following metrics are derived from the `riskmetric` R package. - -```{r read-riskmetric, warning=FALSE} -d_riskmetric <- readRDS(risk_path) - -# Required fields -required_fields <- c("r_cmd_check", "license", "remote_checks", "covr_coverage") - -# Missing fields -missing_fields <- setdiff(required_fields, names(d_riskmetric)) +# Context -# Assign default error structure for missing fields to avoid errors -for (field in missing_fields) { - d_riskmetric[[field]] <- structure(NA, class = "risk_metric_error") +```{r loading, include = FALSE} +if (is.null(params$package)) { + stop( + "The `package` parameter is required. At a minimum pass a package ", + "name, which will be discovered from installed packages or sourced from a ", + "repository. For details, see `?val.report::report()`." + ) } -``` - -```{r create_r_riskmetric, warning=FALSE} -# Assesment produces a data.frame with one row -r_riskmetric <- val.report::assessment(d_riskmetric) -is_na <- sapply(r_riskmetric, function(x) { - is.na(x) || (is.character(x) && startsWith(x, "no applicable")) -}) -r_riskmetric$origin <- val.report:::get_pkg_origin(params$source) -``` +# parse options, handling expression strings +opts <- knitr_update_options(params$options) +log("parsed `params$options` as:\n", opts, "\n\n") -::: {.content-visible when-format="html"} +# parse provided parameter session info or default to current session +session <- params$session %||% val.report::session() +log( + "using ", if (is.null(params$session)) "current" else "param", + " session captured at: ", format(as.POSIXct(session$time)), "\n\n" +) -```{r info_cards} -val.report:::create_metrics_cards(r_riskmetric) -``` +# derive a package object from parameter value +pkg <- convert(params$package, val.meter::pkg) +log("parsed `params$package` into pkg from:\n", pkg@resource, "\n\n") -::: +# calculate package metrics +met <- metrics(pkg) +log("evaluated metrics:\n", met, "\n\n") -::: {.content-hidden when-format="html"} - -```{r simple_cards} -simple_cards <- data.frame( - "Downloads 1 year" = as.character(r_riskmetric$downloads_1yr), - "Reverse dependencies" = r_riskmetric$reverse_dependencies, - "License" = as.character(r_riskmetric$license), - "Origin" = r_riskmetric$origin -) -r_riskmetric$origin <- NULL -knitr::kable(simple_cards) +header$title <- paste0(pkg$name, " (v", pkg$version, ")") ``` -::: - -```{r prepare_tables_namespace} -namespace_table <- val.report:::prepare_namespace_table(d_riskmetric) -``` +## Package `R CMD check` +_The following metrics are derived from the `val.meter` R package._ ::: {.content-visible when-format="html"} - -```{r prepare_tables_dependencies} -deps <- d_riskmetric$dependencies -deps$package <- gsub("\\n", " ", deps$package) -row.names(deps) <- NULL -dependencies_table <- htmltools::div( - htmltools::span( - "Overall the package has these dependencies:" - ), - reactable::reactable( - deps, - class = "metrics-table" - ) +::: {.callout-note appearance="minimal" collapse="true" title="R CMD check summary"} +```{r r_cmd_check_results, results = 'asis'} +library(rcmdcheck) +options(width = 80L, crayon.enabled = TRUE, cli.ansi = TRUE) +htmltools::tags$div( + style = cli::ansi_html_style(colors = 8L), + htmltools::tags$pre(htmltools::HTML(cli::ansi_html(paste(capture.output(pkg$r_cmd_check), collapse = "\n")))) ) ``` - ::: -```{r prepare_tables_reverse_dependencies} -reverse_dependencies <- paste(d_riskmetric$reverse_dependencies, collapse = ", ") -``` - -```{r prepare_tables_examples} -examples_content <- paste0( - "There are ", - if (!is_na["has_examples"]) sum(d_riskmetric$has_examples), - " examples from ", - if (!is_na["has_examples"]) length(d_riskmetric$has_examples), - " help pages (", - if (!is_na["has_examples"]) { - sprintf("%.2f%%", sum(d_riskmetric$has_examples) / length(d_riskmetric$has_examples) * 100) - } else { - "?" - }, - ")." -) -``` - -```{r prepare_tables_news} -news_content <- paste0( - "The package has ", - if ("has_news" %in% names(d_riskmetric) && !is.null(d_riskmetric$has_news)) d_riskmetric$has_news, - " NEWS file and it is ", - if (is.null(d_riskmetric$news_current) && !d_riskmetric$news_current) "not", - "current." -) -``` - -```{r general-riskmetric, warning=FALSE} -#| tab.cap: "**Package general assessment:** Coverage, check results, size, -#| download the last year, reverse dependencies and number of dependencies." - -summary_data <- summary_table(r_riskmetric[, !is.na(as.vector(r_riskmetric))]) - -values_collapsed_rows <- c( - "Has news", - "Exported namespace", - "Dependencies", - "Reverse dependencies", - "Has examples" -) - -indexes_collapsed_rows <- which(summary_data$Section %in% values_collapsed_rows) - -is_html <- knitr::is_html_output(excludes = "markdown") - -# Certain rows of this table are collapsible, containing detailed information. -if (isTRUE(is_html)) { - reactable::reactable( - summary_data, - rownames = FALSE, - pagination = FALSE, - details = function(index) { - if(index %in% indexes_collapsed_rows) { - collapsed_content <- switch(summary_data$Section[index], - "Exported namespace" = namespace_table, - "Dependencies" = dependencies_table, - "Reverse dependencies" = reverse_dependencies, - "Has examples" = examples_content, - "Has news" = news_content - ) - htmltools::div( - style = "padding: 1rem;", - collapsed_content - ) - } - }, - columns = list( - Section = reactable::colDef( - name = "" - ), - Values = reactable::colDef( - name = "", - cell = function(value) { - if (value == "Yes") { - # Green 'Yes' - htmltools::span(value, style = "color:var(--bs-success); font-weight: bold;") - } else if (value == "No") { - # Red 'No' - htmltools::span(value, style = "color: var(--bs-danger); font-weight: bold;") - } else { - htmltools::span(value, style = "color: var(--bs-body-color); font-weight: bold;") - } - }, - align = "center" - ) - ), - class = "metrics-table" -) -} else { - knitr::kable(summary_data) +::: {.callout-note appearance="minimal" collapse="true" title="R CMD check execution logs"} +```{r r_cmd_check_html} +if (!is.null(log <- pkg@logs[["r_cmd_check"]])) { + format(log, style = "html") } ``` - -::: {.content-hidden unless-meta=`r !is_risk_error(d_riskmetric[["license"]])`} - -## License - -The package uses `r if ("license" %in% names(d_riskmetric) && !is.null(d_riskmetric$license)) cat(d_riskmetric$license)`. - ::: - -::: {.content-hidden unless-meta=`r !is_risk_error(d_riskmetric[["r_cmd_check"]]) || !is_risk_error(d_riskmetric[["remote_checks"]])`} - -## Code checks - -Code checks for this package are: - -```{r r_cmd_check, eval=!is_risk_error(d_riskmetric[["r_cmd_check"]])} -d_riskmetric[["r_cmd_check"]] -``` - - - -```{r remote_checks, eval=!is_risk_error(d_riskmetric[["remote_checks"]])} -d_riskmetric[["remote_checks"]] -``` - ::: -::: {.content-hidden unless-meta=`r !is_risk_error(d_riskmetric[["covr_coverage"]])`} - -## Code coverage - -Code coverage for this package is: - -```{r covr_coverage} -d_riskmetric[["covr_coverage"]] +::: {.content-hidden when-format="html"} +```{r r_cmd_check_text, results = 'asis'} +cat(format(pkg@logs[["r_cmd_check"]], style = "text"), "\n") ``` - ::: -# Installation environment - - ## System Info ```{r execution_info} #| tab.cap: "**System information**. Table about the system used to check the package." + tt_sys_info_df <- data.frame( - Field = c("Image", "OS", "Platform", "System", "Execution Time"), + Field = c("OS", "Platform", "System", "R Version", "Execution Time"), Value = c( - image, - sessionInfo()$running, - R.version$platform, - R.version$system, - format(Sys.time(), tz = "UTC", usetz = TRUE) - )) + session$session_info$running, + session$r_version$platform, + session$r_version$system, + session$r_version$version.string, + format(as.POSIXct(session$time), tz = "UTC", usetz = TRUE) + ) +) knitr::kable(tt_sys_info_df) ``` @@ -312,37 +176,39 @@ The advantage of the foldable_code lua filter is that the code is printed exactl ## R Session Info ```{r session_info, attr.output='.details summary="Session info"'} -sessionInfo() +session$session_info ``` ```{r Platform, attr.output='.details summary="Platform"'} -unlist(.Platform) +unlist(session$platform) ``` ```{r capabilities, attr.output='.details summary="R\'s capabilities"'} -capabilities() +unlist(session$capabilities) ``` ```{r external-software, attr.output='.details summary="External software"'} -extSoftVersion() +unlist(session$external_software) ``` -```{r graphic-software, attr.output='.details summary="Graphics external software"'} -grSoftVersion() +```{r graphic-software, attr.output='.details summary="External graphics software"'} +unlist(session$graphics_software) ``` ```{r machine, attr.output='.details summary="Numerical characteristics of the machine"'} -unlist(.Machine) +unlist(session$machine) ``` ```{r RNGKind, attr.output='.details summary="Random number generation process"'} -RNGkind() +session$rng_kind ``` ## Information about the environment -Environmental and options variables affect how package checks and software in it might behave. -```{r computing, attr.output='.details summary="Environmental variables when running this report"'} +Environment variables and R options affect how package checks and software in it +might behave. + +```{r computing, attr.output='.details summary="Environment variables when running this report"'} val.report::environ_report(exclude = c("APPDATA", "GITHUB", "GITHUB_PAT", "GITHUB_PAT_GITHUB_COM", "GITLAB", "GITLAB_PAT", "ProgramFiles", "ProgramFiles(x86)", "R_DptShare", "R_USER", "USERDNSDOMAIN", "USERDOMAIN", "USERDOMAIN_ROAMINGPROFILE", diff --git a/man/knit_print.knitr_log.Rd b/man/knit_print.knitr_log.Rd new file mode 100644 index 0000000..1830d5e --- /dev/null +++ b/man/knit_print.knitr_log.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/render_utils.R +\name{knit_print.knitr_log} +\alias{knit_print.knitr_log} +\title{Special handler for emitting knitr logs} +\usage{ +knit_print.knitr_log(x, ...) +} +\description{ +Special handler for emitting knitr logs +} diff --git a/man/knitr_logger.Rd b/man/knitr_logger.Rd new file mode 100644 index 0000000..c8d3b8b --- /dev/null +++ b/man/knitr_logger.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/render_utils.R +\name{knitr_logger} +\alias{knitr_logger} +\title{Create a knitr log function} +\usage{ +knitr_logger() +} +\description{ +Sets necessary knitr hooks and returns a logging function that will emit +messages to the console during knitting. +} diff --git a/man/knitr_mutable_header.Rd b/man/knitr_mutable_header.Rd new file mode 100644 index 0000000..b61f0ff --- /dev/null +++ b/man/knitr_mutable_header.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/render_utils.R +\name{knitr_mutable_header} +\alias{knitr_mutable_header} +\title{Create mutable header object} +\usage{ +knitr_mutable_header() +} +\description{ +Inject a custom document rendering hook into the knitr engine and return +a mutable environment that we can modify, which will be used to update the +knitr document header upon render completion. +} diff --git a/man/knitr_update_options.Rd b/man/knitr_update_options.Rd new file mode 100644 index 0000000..d778f0f --- /dev/null +++ b/man/knitr_update_options.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/render_utils.R +\name{knitr_update_options} +\alias{knitr_update_options} +\title{Handler for complex option passing through from a quarto parameter} +\usage{ +knitr_update_options(opts) +} +\description{ +Importantly, handles S7 objects which cannot be passed through as a quarto +parameter because they can not be deparsed. Allows passing arbitrary +expressions using the \code{!expr} prefix used by \code{yaml}. +} diff --git a/man/package_report.Rd b/man/package_report.Rd index 2416e7f..7ccde4c 100644 --- a/man/package_report.Rd +++ b/man/package_report.Rd @@ -19,7 +19,8 @@ package_report( \item{package_version}{Package version number.} -\item{package}{Path where to find a package source to retrieve name and version number.} +\item{package}{Path where to find a package source to retrieve name and +version number.} \item{template_path}{Path to a custom quarto template file} @@ -36,17 +37,18 @@ A path to the reports generated, called by its side effects. Reports about a package } \details{ -Please include source as part of \code{params} content. Source is returned after -calling function \code{riskmetric::pkg_ref} before the risk assessment is executed +Please include source as part of \code{params} content. Source is +returned after calling function \code{riskmetric::pkg_ref} before the risk +assessment is executed } \examples{ +pkg_rds_path <- system.file("assessments/dplyr.rds", package = "val.report") pr <- package_report( package_name = "dplyr", package_version = "1.1.4", - params = list( - assessment_path = system.file("assessments/dplyr.rds", package = "val.report"), - image = "rhub/ref-image") + params = list(assessment_path = pkg_rds_path, image = "rhub/ref-image") ) + pr file.remove(pr) }