From d0f8255acad62061f3ad695a0649157a255011ae Mon Sep 17 00:00:00 2001 From: Arnaud Gallou <67476099+arnaudgallou@users.noreply.github.com> Date: Sun, 25 Aug 2024 23:23:47 +0200 Subject: [PATCH] Add support for `.yml` and `.yaml` files (#83) --- NEWS.md | 2 + R/checkers.R | 8 ++-- R/plume-quarto.R | 22 +++++---- R/utils-list.R | 6 +++ R/utils.R | 5 ++ R/yaml.R | 74 ++++++++++++++++------------- README.Rmd | 4 +- README.md | 10 ++-- man/PlumeQuarto.Rd | 17 +++---- tests/testthat/_snaps/initialize.md | 2 +- tests/testthat/_snaps/to-yaml.md | 11 +++++ tests/testthat/test-to-yaml.R | 15 ++++++ vignettes/plume.Rmd | 8 ++-- 13 files changed, 117 insertions(+), 67 deletions(-) diff --git a/NEWS.md b/NEWS.md index bedc48b..926b6d2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # plume (development version) +* `PlumeQuarto` now supports `.yml` and `.yaml` files (#82). + # plume 0.2.4 * Tweak some examples in the vignettes and expand the `Contributions` section in `vignette("plume")`. diff --git a/R/checkers.R b/R/checkers.R index 5a9747c..3768dea 100644 --- a/R/checkers.R +++ b/R/checkers.R @@ -293,15 +293,15 @@ file_ext <- function(x) { str_extract(x, "(?<=\\.)[^.]+$") } -check_file <- function(x, extension, ..., param = caller_arg(x)) { +check_file <- function(x, extensions, ..., param = caller_arg(x)) { check_string(x, allow_empty = FALSE, param = param) ext <- file_ext(x) - if (is_not_na(ext) && vec_in(ext, extension)) { + if (is_not_na(ext) && vec_in(ext, extensions)) { check_path(x, param = param) return(invisible()) } - extension <- wrap(predot(extension), "`") - abort_check(paste("a", extension, "file"), ..., param = param) + extensions <- enumerate(wrap(predot(extensions), "`"), last = " or ") + abort_check(paste("a", extensions, "file"), ..., param = param) } is_glueish <- function(x) { diff --git a/R/plume-quarto.R b/R/plume-quarto.R index bfa5fb2..d4dbb2a 100644 --- a/R/plume-quarto.R +++ b/R/plume-quarto.R @@ -11,8 +11,8 @@ )) #' @title PlumeQuarto class -#' @description Class that pushes author metadata in the YAML header -#' of Quarto files. +#' @description Class that pushes author metadata in YAML files or the YAML +#' header of Quarto files. #' @examples #' # Create a simple temporary file with a YAML header #' # containing a title @@ -53,7 +53,7 @@ PlumeQuarto <- R6Class( public = list( #' @description Create a `PlumeQuarto` object. #' @param data A data frame containing author-related data. - #' @param file A `.qmd` file to insert author data into. + #' @param file A `.qmd`, `.yml` or `.yaml` file to insert author data into. #' @param names A vector of key-value pairs specifying custom names to use, #' where keys are default names and values their respective replacements. #' @param roles A vector of key-value pairs defining roles where keys @@ -76,18 +76,19 @@ PlumeQuarto <- R6Class( initials_given_name = FALSE, by = NULL ) { - check_file(file, extension = "qmd") + check_file(file, extensions = c("qmd", "yml", "yaml")) super$initialize(data, names, roles, credit_roles, initials_given_name, by = by) private$file <- file private$id <- private$pick("id") }, - #' @description Push or update author information in a YAML header. The - #' generated YAML complies with Quarto's `r link("quarto_schemas")`. + #' @description Push or update author information in a YAML file or YAML + #' header. The generated YAML complies with Quarto's + #' `r link("quarto_schemas")`. #' @details - #' If missing, `to_yaml()` pushes author information into a YAML header. If - #' already existing, the function replaces old `author` and `affiliations` - #' values with the ones provided in the input data. + #' If missing, `to_yaml()` inserts author information into the desired file. + #' Otherwise, the function replaces old `author` and `affiliations` values + #' with the ones provided in the input data. #' @return The input `file` invisibly. to_yaml = function() { yaml_push(private$get_template(), file = private$file) @@ -105,10 +106,11 @@ PlumeQuarto <- R6Class( }, get_template = function() { - list( + out <- list( author = private$author_tbl(), affiliations = private$affiliation_tbl() ) + add_class(out, cls = file_ext(private$file)) }, author_tbl = function() { diff --git a/R/utils-list.R b/R/utils-list.R index d161d9d..04c2cbf 100644 --- a/R/utils-list.R +++ b/R/utils-list.R @@ -47,3 +47,9 @@ list_replace <- function(x, y) { } x } + +list_drop_empty <- function(x) { + are_empty <- map_vec(x, \(.x) is_empty(.x)) + x[are_empty] <- NULL + x +} diff --git a/R/utils.R b/R/utils.R index aa66c07..5383894 100644 --- a/R/utils.R +++ b/R/utils.R @@ -192,3 +192,8 @@ unstructure <- function(x) { attributes(x) <- NULL x } + +add_class <- function(x, cls) { + class(x) <- c(cls, class(x)) + x +} diff --git a/R/yaml.R b/R/yaml.R index f7b5b42..41b04e0 100644 --- a/R/yaml.R +++ b/R/yaml.R @@ -1,17 +1,30 @@ -schemas_are_up_to_date <- function(current, new) { - current <- current[c("author", "affiliations")] - identical(current, new) +eol <- function() { + if (.Platform$OS.type == "unix") "\n" else "\r\n" # nocov } -json_update <- function(x, json) { - x <- yaml.load(x) - if (is.null(x)) { - return(json) - } - if (schemas_are_up_to_date(x, json)) { +as_verbatim_lgl <- function(x) { + x <- if_else(x, "true", "false") + structure(x, class = "verbatim") +} + +.yaml_args <- list( + line.sep = eol(), + indent.mapping.sequence = TRUE, + handlers = list(logical = as_verbatim_lgl) +) + +schemas_are_up_to_date <- function(old, new) { + old <- old[c("author", "affiliations")] + identical(old, new) +} + +json_update <- function(old, new) { + new <- as_json(new) + if (schemas_are_up_to_date(old, new)) { return() } - list_assign(x, !!!json) + out <- if (is.null(old)) new else list_assign(old, !!!new) + list_drop_empty(out) } as_json <- function(x) { @@ -23,28 +36,10 @@ separate_yaml_header <- function(x) { str_split_1(x, "(?m:^|\\R\\K)-{3}(?:\\R|$)") } -as_verbatim_lgl <- function(x) { - x <- if_else(x, "true", "false") - structure(x, class = "verbatim") -} - -get_eol <- function() { - if (.Platform$OS.type == "unix") "\n" else "\r\n" # nocov -} - yaml_inject <- function(x, lines) { - eol <- get_eol() - if (is_empty(x$affiliations)) { - x$affiliations <- NULL - } - yaml <- as.yaml( - x, - line.sep = eol, - indent.mapping.sequence = TRUE, - handlers = list(logical = as_verbatim_lgl) - ) + yaml <- do.call(as.yaml, c(list(x), .yaml_args)) out <- replace(lines, 2, yaml) - collapse(out, paste0("---", eol)) + collapse(out, paste0("---", eol())) } has_yaml <- function(x) { @@ -80,15 +75,28 @@ add_yaml_header <- function(x) { c("", "", x) } -yaml_push <- function(what, file) { +yaml_push <- function(x, file) { + UseMethod("yaml_push") +} + +yaml_push.default <- function(x, file) { + old <- yaml::read_yaml(file) + json <- json_update(old, x) + if (is.null(json)) { + return(invisible()) + } + do.call(yaml::write_yaml, c(list(json), file, .yaml_args)) +} + +yaml_push.qmd <- function(x, file) { text <- read_file(file) check_has_yaml(text) items <- separate_yaml_header(text) if (yaml_has_strippable(items[[2]])) { items <- add_yaml_header(items) } - json <- as_json(what) - json <- json_update(items[[2]], json) + old <- yaml.load(items[[2]]) + json <- json_update(old, x) if (is.null(json)) { return(invisible()) } diff --git a/README.Rmd b/README.Rmd index 30b0b56..b1b3824 100644 --- a/README.Rmd +++ b/README.Rmd @@ -26,7 +26,7 @@ knitr::opts_chunk$set( plume provides tools for handling and generating author-related information for scientific writing in R Markdown and Quarto. The package implements two R6 classes: -- `PlumeQuarto`: class that allows you to push author metadata in the YAML header of Quarto files. The generated YAML complies with Quarto's [author and affiliations schemas](https://quarto.org/docs/journals/authors.html). This is the class to use if you work with journal templates. +- `PlumeQuarto`: class that allows you to push author metadata in YAML files or the YAML header of Quarto files. The generated YAML complies with Quarto's [author and affiliations schemas](https://quarto.org/docs/journals/authors.html). This is the class to use if you work with journal templates. - `Plume`: class that generates author lists and other author-related information as character strings. This is an easy and convenient solution when you don't need preformatted documents. @@ -64,7 +64,7 @@ tmp_file <- withr::local_tempfile( ) ``` -`PlumeQuarto` lets you push author metadata in the YAML header of any `.qmd` file using the `to_yaml()` method. +`PlumeQuarto` lets you push author metadata in YAML files or the YAML header of any `.qmd` file using the `to_yaml()` method. Consider the following example: diff --git a/README.md b/README.md index 78c180d..b16ef66 100644 --- a/README.md +++ b/README.md @@ -18,9 +18,9 @@ plume provides tools for handling and generating author-related information for scientific writing in R Markdown and Quarto. The package implements two R6 classes: -- `PlumeQuarto`: class that allows you to push author metadata in the - YAML header of Quarto files. The generated YAML complies with Quarto’s - [author and affiliations +- `PlumeQuarto`: class that allows you to push author metadata in YAML + files or the YAML header of Quarto files. The generated YAML complies + with Quarto’s [author and affiliations schemas](https://quarto.org/docs/journals/authors.html). This is the class to use if you work with journal templates. @@ -74,8 +74,8 @@ Plume$new(encyclopedists) #> # ℹ 2 more variables: affiliation , role ``` -`PlumeQuarto` lets you push author metadata in the YAML header of any -`.qmd` file using the `to_yaml()` method. +`PlumeQuarto` lets you push author metadata in YAML files or the YAML +header of any `.qmd` file using the `to_yaml()` method. Consider the following example: diff --git a/man/PlumeQuarto.Rd b/man/PlumeQuarto.Rd index 947401d..73ec525 100644 --- a/man/PlumeQuarto.Rd +++ b/man/PlumeQuarto.Rd @@ -4,8 +4,8 @@ \alias{PlumeQuarto} \title{PlumeQuarto class} \description{ -Class that pushes author metadata in the YAML header -of Quarto files. +Class that pushes author metadata in YAML files or the YAML +header of Quarto files. } \examples{ # Create a simple temporary file with a YAML header @@ -87,7 +87,7 @@ Create a \code{PlumeQuarto} object. \describe{ \item{\code{data}}{A data frame containing author-related data.} -\item{\code{file}}{A \code{.qmd} file to insert author data into.} +\item{\code{file}}{A \code{.qmd}, \code{.yml} or \code{.yaml} file to insert author data into.} \item{\code{names}}{A vector of key-value pairs specifying custom names to use, where keys are default names and values their respective replacements.} @@ -116,16 +116,17 @@ A \code{PlumeQuarto} object. \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PlumeQuarto-to_yaml}{}}} \subsection{Method \code{to_yaml()}}{ -Push or update author information in a YAML header. The -generated YAML complies with Quarto's \href{https://quarto.org/docs/journals/authors.html}{author and affiliations schemas}. +Push or update author information in a YAML file or YAML +header. The generated YAML complies with Quarto's +\href{https://quarto.org/docs/journals/authors.html}{author and affiliations schemas}. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{PlumeQuarto$to_yaml()}\if{html}{\out{
}} } \subsection{Details}{ -If missing, \code{to_yaml()} pushes author information into a YAML header. If -already existing, the function replaces old \code{author} and \code{affiliations} -values with the ones provided in the input data. +If missing, \code{to_yaml()} inserts author information into the desired file. +Otherwise, the function replaces old \code{author} and \code{affiliations} values +with the ones provided in the input data. } \subsection{Returns}{ diff --git a/tests/testthat/_snaps/initialize.md b/tests/testthat/_snaps/initialize.md index 4f4cca5..ce367d5 100644 --- a/tests/testthat/_snaps/initialize.md +++ b/tests/testthat/_snaps/initialize.md @@ -146,7 +146,7 @@ Output Error: - ! `file` must be a `.qmd` file. + ! `file` must be a `.qmd`, `.yml` or `.yaml` file. Code (expect_error(PlumeQuarto$new(basic_df, file = "~/test.qmd"))) Output diff --git a/tests/testthat/_snaps/to-yaml.md b/tests/testthat/_snaps/to-yaml.md index 8f35fd6..deb4f8c 100644 --- a/tests/testthat/_snaps/to-yaml.md +++ b/tests/testthat/_snaps/to-yaml.md @@ -220,6 +220,17 @@ Vivamus quis --- +# to_yaml() can push data into YAML files + + Code + read_test_file(tmp_file) + Output + title: foo + author: + - name: + given: Zip + family: Zap + # to_yaml() errors if no YAML headers is found Code diff --git a/tests/testthat/test-to-yaml.R b/tests/testthat/test-to-yaml.R index a25006b..1cdb14d 100644 --- a/tests/testthat/test-to-yaml.R +++ b/tests/testthat/test-to-yaml.R @@ -113,6 +113,21 @@ test_that("to_yaml() writes in a separate header to preserve strippable data (#5 expect_snapshot(read_test_file(tmp_file)) }) +test_that("to_yaml() can push data into YAML files", { + tmp_file <- withr::local_tempfile( + lines = "title: foo", + fileext = ".yaml" + ) + + aut <- PlumeQuarto$new( + data.frame(given_name = "Zip", family_name = "Zap"), + tmp_file + ) + aut$to_yaml() + + expect_snapshot(read_test_file(tmp_file)) +}) + # Errors ---- test_that("to_yaml() errors if no YAML headers is found", { diff --git a/vignettes/plume.Rmd b/vignettes/plume.Rmd index 1e69ce2..1ab944c 100644 --- a/vignettes/plume.Rmd +++ b/vignettes/plume.Rmd @@ -202,9 +202,9 @@ aut$set_corresponding_authors(everyone()) aut ``` -## Pushing data into YAML headers +## Pushing data into a YAML or Quarto file -`PlumeQuarto` allows you to inject author metadata directly into the YAML header of `.qmd` files. +`PlumeQuarto` allows you to inject author metadata directly into YAML files or the YAML header of `.qmd` files. Consider the following Quarto document: @@ -219,7 +219,7 @@ tmp_file <- withr::local_tempfile( cat(read_file(tmp_file)) ``` -You can push information from the input data into the YAML header using the `to_yaml()` method: +You can push information from the input data into the YAML or Quarto file using the `to_yaml()` method: ```{r, eval = FALSE} aut <- PlumeQuarto$new( @@ -237,7 +237,7 @@ cat(read_file(tmp_file)) Authors are listed in the order they're defined in the input data. -If the YAML header already has an `author` and `affiliations` keys, `to_yaml()` replaces old values with new ones. +If the YAML or Quarto file already has an `author` and `affiliations` keys, `to_yaml()` replaces old values with new ones. ```{r, eval = FALSE} aut <- PlumeQuarto$new(