use yaml_metadata_block for preserve_yaml feature when possible

R/md_document.R

@@ -11,11 +11,11 @@
 #' see the documentation on R Markdown \link[=rmd_metadata]{metadata}.
 #' @inheritParams html_document
 #' @param variant Markdown variant to produce (defaults to "markdown_strict").
-#'   Other valid values are "commonmark", "markdown_github", "markdown_mmd",
-#'   markdown_phpextra", or even "markdown" (which produces pandoc markdown).
-#'   You can also compose custom markdown variants, see the
-#'   \href{https://pandoc.org/MANUAL.html}{pandoc online documentation}
-#'   for details.
+#'   Other valid values are "commonmark", "gfm", "commonmark_x", "markdown_mmd",
+#'   markdown_phpextra", "markdown_github", or even "markdown" (which produces
+#'   pandoc markdown). You can also compose custom markdown variants, see the
+#'   \href{https://pandoc.org/MANUAL.html}{pandoc online documentation} for
+#'   details.
 #' @param preserve_yaml Preserve YAML front matter in final document.
 #' @param fig_retina Scaling to perform for retina displays. Defaults to
 #'   \code{NULL} which performs no scaling. A setting of 2 will work for all
@@ -48,8 +48,9 @@ md_document <- function(variant = "markdown_strict",
                         pandoc_args = NULL,
                         ext = ".md") {
 
+
   # base pandoc options for all markdown output
-  args <- c(if (variant != "markdown" || preserve_yaml) "--standalone")
+  args <- c(if (preserve_yaml) "--standalone")
 
   # table of contents
   args <- c(args, pandoc_toc_args(toc, toc_depth))
@@ -60,8 +61,11 @@ md_document <- function(variant = "markdown_strict",
   # pandoc args
   args <- c(args, pandoc_args)
 
-  # add post_processor for yaml preservation
-  post_processor <- if (preserve_yaml && variant != 'markdown') {
+  # variants
+  variant <- adapt_md_variant(variant, preserve_yaml)
+
+  # add post_processor for yaml preservation if not supported by pandoc
+  post_processor <- if (preserve_yaml && !grepl('yaml_metadata_block', variant, fixed = TRUE)) {
     function(metadata, input_file, output_file, clean, verbose) {
       input_lines <- read_utf8(input_file)
       partitioned <- partition_yaml_front_matter(input_lines)
@@ -88,3 +92,41 @@ md_document <- function(variant = "markdown_strict",
     post_processor = post_processor
   )
 }
+
+adapt_md_variant <- function(variant, preserve_yaml) {
+  variant_base <- gsub("^([^+-]*).*", "\\1", variant)
+  variant_extensions <- gsub(sprintf("^%s", variant_base), "", variant)
+
+  set_extension <- function(format, ext, add = TRUE) {
+    ext <- paste0(ifelse(add, "+", "-"), ext)
+    if (grepl(ext, format, fixed = TRUE)) return(format)
+    paste0(format, ext, collapse = "")
+  }
+
+  add_yaml_block_ext <- function(extensions, preserve_yaml) {
+    set_extension(variant_extensions, "yaml_metadata_block", preserve_yaml)
+  }
+
+  # yaml_metadata_block extension
+  variant_extensions <- switch(
+    variant_base,
+    gfm =,
+    commonmark =,
+    commonmark_x = {
+      if (pandoc_available(2.13)) {
+        add_yaml_block_ext(variant_extensions, preserve_yaml)
+      } else {
+        variant_extensions
+      }
+    },
+    markdown =,
+    markdown_phpextra =,
+    markdown_github =,
+    markdown_mmd =,
+    markdown_strict = add_yaml_block_ext(variant_extensions, preserve_yaml),
+    # do not modified for unknown (yet) md variant
+    variant_extensions
+  )
+
+  paste0(variant_base, variant_extensions, collapse = "")
+}

tests/testthat/_snaps/md_document/yaml-block-markdown-meta.md

@@ -0,0 +1,5 @@
+---
+title: test
+---
+
+content

tests/testthat/_snaps/md_document/yaml-block-markdown.md

@@ -0,0 +1 @@
+content

tests/testthat/_snaps/md_document/yaml-block-markdown_github-meta.md

@@ -0,0 +1,5 @@
+---
+title: test
+---
+
+content

tests/testthat/_snaps/md_document/yaml-block-markdown_github.md

@@ -0,0 +1 @@
+content

tests/testthat/_snaps/md_document/yaml-block-markdown_mmd-meta.md

@@ -0,0 +1,5 @@
+---
+title: test
+---
+
+content

tests/testthat/_snaps/md_document/yaml-block-markdown_mmd.md

@@ -0,0 +1 @@
+content

tests/testthat/_snaps/md_document/yaml-block-markdown_phpextra-meta.md

@@ -0,0 +1,5 @@
+---
+title: test
+---
+
+content

tests/testthat/_snaps/md_document/yaml-block-markdown_phpextra.md

@@ -0,0 +1 @@
+content

tests/testthat/_snaps/md_document/yaml-block-markdown_strict-meta.md

@@ -0,0 +1,5 @@
+---
+title: test
+---
+
+content

tests/testthat/_snaps/md_document/yaml-block-markdown_strict.md

@@ -0,0 +1 @@
+content

tests/testthat/test-md_document.R

@@ -0,0 +1,75 @@
+local_edition(3)
+
+test_that("adapt_md_variant() adds extensions to markdown variants", {
+  expect_identical(adapt_md_variant("markdown", TRUE), "markdown+yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown_phpextra", TRUE), "markdown_phpextra+yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown_mmd", TRUE), "markdown_mmd+yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown_strict", TRUE), "markdown_strict+yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown_github", TRUE), "markdown_github+yaml_metadata_block")
+
+  expect_identical(adapt_md_variant("markdown", FALSE), "markdown-yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown_phpextra", FALSE), "markdown_phpextra-yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown_mmd", FALSE), "markdown_mmd-yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown_strict", FALSE), "markdown_strict-yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown_github", FALSE), "markdown_github-yaml_metadata_block")
+
+  expect_identical(adapt_md_variant("markdown+yaml_metadata_block", TRUE), "markdown+yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown-yaml_metadata_block", TRUE), "markdown-yaml_metadata_block+yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown+yaml_metadata_block", FALSE), "markdown+yaml_metadata_block-yaml_metadata_block")
+  expect_identical(adapt_md_variant("markdown-yaml_metadata_block", FALSE), "markdown-yaml_metadata_block")
+
+  # ignore correctly unsupported variants
+  expect_identical(adapt_md_variant("markdown_new", TRUE), "markdown_new")
+  expect_identical(adapt_md_variant("markdown_new", FALSE), "markdown_new")
+})
+
+test_that("adapt_md_variant() ignored unknown variants", {
+  expect_identical(adapt_md_variant("markdown_new", TRUE), "markdown_new")
+  expect_identical(adapt_md_variant("markdown_new", FALSE), "markdown_new")
+})
+
+test_that("adapt_md_variant() with special variants (pandoc >= 2.13)", {
+  skip_if_not_pandoc('2.13')
+  expect_identical(adapt_md_variant("commonmark", TRUE), "commonmark+yaml_metadata_block")
+  expect_identical(adapt_md_variant("gfm", TRUE), "gfm+yaml_metadata_block")
+  expect_identical(adapt_md_variant("commonmark_x", TRUE), "commonmark_x+yaml_metadata_block")
+  expect_identical(adapt_md_variant("commonmark", FALSE), "commonmark-yaml_metadata_block")
+  expect_identical(adapt_md_variant("gfm", FALSE), "gfm-yaml_metadata_block")
+  expect_identical(adapt_md_variant("commonmark_x", FALSE), "commonmark_x-yaml_metadata_block")
+
+  expect_identical(adapt_md_variant("gfm+yaml_metadata_block", TRUE), "gfm+yaml_metadata_block")
+  expect_identical(adapt_md_variant("gfm-yaml_metadata_block", TRUE), "gfm-yaml_metadata_block+yaml_metadata_block")
+  expect_identical(adapt_md_variant("gfm+yaml_metadata_block", FALSE), "gfm+yaml_metadata_block-yaml_metadata_block")
+  expect_identical(adapt_md_variant("gfm-yaml_metadata_block", FALSE), "gfm-yaml_metadata_block")
+
+})
+
+test_that("adapt_md_variant() with special variants (pandoc < 2.13)", {
+  skip_if_pandoc('2.13')
+  expect_identical(adapt_md_variant("commonmark", TRUE), "commonmark")
+  expect_identical(adapt_md_variant("gfm", TRUE), "gfm")
+  expect_identical(adapt_md_variant("commonmark_x", TRUE), "commonmark_x")
+  expect_identical(adapt_md_variant("commonmark", FALSE), "commonmark")
+  expect_identical(adapt_md_variant("gfm", FALSE), "gfm")
+  expect_identical(adapt_md_variant("commonmark_x", FALSE), "commonmark_x")
+})
+
+test_that("md_document() can preserve yaml", {
+  skip_on_cran() # avoid pandoc issue on CRAN
+  expect_snapshot_md <- function(variant, preserve_yaml) {
+    rmd <- local_rmd_file(c("---", "title: test", "---", "", "content"))
+    res <- render(rmd, md_document(variant, preserve_yaml = preserve_yaml), quiet = TRUE)
+    expect_snapshot_file(res, sprintf("yaml-block-%s%s.md", variant, if (preserve_yaml) "-meta" else ""))
+  }
+  expect_snapshot_md("markdown", preserve_yaml = FALSE)
+  expect_snapshot_md("markdown_phpextra", preserve_yaml = FALSE)
+  expect_snapshot_md("markdown_mmd", preserve_yaml = FALSE)
+  expect_snapshot_md("markdown_strict", preserve_yaml = FALSE)
+  expect_snapshot_md("markdown_github", preserve_yaml = FALSE)
+  expect_snapshot_md("markdown", preserve_yaml = TRUE)
+  expect_snapshot_md("markdown_phpextra", preserve_yaml = TRUE)
+  expect_snapshot_md("markdown_mmd", preserve_yaml = TRUE)
+  expect_snapshot_md("markdown_strict", preserve_yaml = TRUE)
+  expect_snapshot_md("markdown_github", preserve_yaml = TRUE)
+})
+