tests/testthat/test-split_to_tbl.R

In lightparser: From 'Rmarkdown' and 'Quarto' Files to Tibble and Back

# WARNING - Generated by {fusen} from dev/flat_split_combine.Rmd: do not edit by hand

file <- system.file("dev-template-parsing.Rmd",
  package = "lightparser"
)
# debugonce(split_to_tbl)
tbl_rmd <- split_to_tbl(file)

# split_to_tbl works as expected ----
test_that("split_to_tbl gets yaml header data", {
  expect_equal(sum(tbl_rmd[["type"]] == "yaml"), 1)
  w_yaml <- which(tbl_rmd[["type"]] == "yaml")
  expect_equal(
    tbl_rmd[["params"]][[w_yaml]]$title,
    "dev_history.Rmd for working package"
  )
  expect_equal(tbl_rmd[["params"]][[w_yaml]]$author, "statnmap")
  expect_equal(tbl_rmd[["params"]][[w_yaml]]$date, "2023-10-12")
})

# Find all headings ----
headings <- c(
  "Description of your package",
  "Read data",
  "Calculate the median of a vector",
  "Calculate the mean of a vector",
  "Use sub-functions in the same chunk",
  "Inflate your package"
)

test_that("split_to_tbl gets titles in markdown part only", {
  expect_equal(sum(tbl_rmd[["type"]] == "heading"), 6)
  expect_equal(tbl_rmd[["heading"]][!is.na(tbl_rmd[["heading"]])], headings)
  expect_equal(
    tbl_rmd[["heading_level"]][!is.na(tbl_rmd[["heading"]])],
    c(1, 1, 1, 1, 2, 1)
  )
})

test_that("split_to_tbl gets proper sections with headings", {
  expect_equal(
    tbl_rmd[["section"]],
    rep(
      c(NA, headings),
      times = c(4, 4, 4, 8, 1, 9, 5)
    )
  )
})

test_that("split_to_tbl gets text parts without titles", {
  expect_equal(sum(tbl_rmd[["type"]] == "inline"), 16)
  expect_equal(
    sum(tbl_rmd[["type"]] == "inline"),
    length(tbl_rmd[["text"]][!is.na(tbl_rmd[["text"]])]) -
      sum(tbl_rmd[["type"]] == "heading")
  )
  expect_length(tbl_rmd[tbl_rmd[["type"]] == "inline", ][["text"]][[1]], 0)
  expect_equal(
    tbl_rmd[tbl_rmd[["type"]] == "inline", ][["text"]][[3]],
    c("", "This will fill the description of your package.", "-->")
  )
  # Verify there is no title in the lists
  expect_false(any(headings %in%
    unlist(tbl_rmd[tbl_rmd[["type"]] == "inline", ][["text"]])))
})

test_that("split_to_tbl gets R-only chunks with label and options", {
  expect_equal(sum(tbl_rmd[["type"]] == "block"), 12)
  # labels
  expect_equal(
    tbl_rmd[["label"]][tbl_rmd[["type"]] == "block"],
    c(
      "development", "description", "development-2",
      "function", "examples", "tests",
      "function-1", "examples-1", "tests-1",
      "development-1", "unnamed-chunk-1", "unnamed-chunk-2"
    )
  )
  # options
  expect_equal(
    tbl_rmd[["params"]][tbl_rmd[["type"]] == "block"][[1]],
    list(label = "development", include = FALSE)
  )
  expect_equal(
    tbl_rmd[["params"]][tbl_rmd[["type"]] == "block"][[4]],
    list(label = "function")
  )
  # qmd-like options format
  expect_equal(
    tbl_rmd[["params"]][tbl_rmd[["type"]] == "block"][[7]],
    list(label = "function-1", filename = "the_median_file")
  )
})

test_that("split_to_tbl - chunk code extracted contains R code only", {
  expect_equal(
    as.character(tbl_rmd[["code"]][tbl_rmd[["type"]] == "block"][[5]]),
    c("my_median(1:12)")
  )
  # No remaining chunk params in the code extracted
  expect_equal(
    as.character(tbl_rmd[["code"]][tbl_rmd[["type"]] == "block"][[7]])[1],
    c("#' My Other median")
  )
})

test_that(
  "split_to_tbl does not increment unnamed-chunks id when run a 2nd time",
  {
    tbl_rmd <- split_to_tbl(file)
    tbl_rmd <- split_to_tbl(file) # 2nd time
    expect_equal(sum(tbl_rmd[["type"]] == "block"), 12)
    expect_equal(
      tbl_rmd[["label"]][tbl_rmd[["type"]] == "block"],
      c(
        "development", "description", "development-2",
        "function", "examples", "tests",
        "function-1", "examples-1", "tests-1",
        "development-1", "unnamed-chunk-1", "unnamed-chunk-2"
      )
    )
  }
)

test_that("split_to_tbl can be run from within a Rmd file", {
  temprmd <- tempfile(fileext = ".Rmd")
  tempoutput <- tempfile(fileext = ".html")

  cat(
    "---",
    "title: split inside Rmd",
    "output: html_document",
    "---",
    "",
    "\x60``{r}",
    "library(lightparser)",
    "file <- system.file('dev-template-parsing.Rmd', package = 'lightparser')",
    "tbl_rmd <- split_to_tbl(file)",
    "\x60``",
    sep = "\n",
    file = temprmd
  )

  expect_error(
    rmarkdown::render(temprmd, output_file = tempoutput, quiet = TRUE),
    regexp = NA
  )

  output_lines <- readLines(tempoutput)
  # there should be a message about knitting
  expect_true(
    any(grepl(
      "It seems you are currently knitting a Rmd/Qmd file.",
      output_lines
    ))
  )
  # this message should be after the call to split_to_tbl
  expect_true(
    grepl(
      "It seems you are currently knitting a Rmd/Qmd file.",
      output_lines[grep("split_to_tbl", output_lines) + 1]
    )
  )
})