tests/testthat/helper-dump_bib.R

In bibtex: Bibtex Parser

# Writes out a bibentry as read.bib() built it: any attributes and class other
# than the default, then the type, key and every field of each entry, with
# each person split into its name parts. It stands in for snapshotting
# print(), which renders through tools::toRd() and tools::Rd2txt() and changes
# between R releases ("\&" unescaped in 4.5.3; field order, chapters and math
# in 4.6.0; Unicode dashes and math again in R-devel). Vectors are written as
# c(...), so the snapshot shows how names were split, e.g.
# given = c("Donald", "E.") rather than "Donald E.", which print() only hints
# at through initials and toBibtex() does not show at all.
dump_bib <- function(bib) {
  extra <- setdiff(names(attributes(bib)), "names")
  if (identical(class(bib), "bibentry")) {
    extra <- setdiff(extra, "class")
  }
  entries <- vapply(unclass(bib), dump_entry, "")
  writeLines(c(
    dump_attributes(bib, extra, ""),
    paste(entries, collapse = "\n\n")
  ))
}

dump_entry <- function(entry) {
  extra <- setdiff(names(attributes(entry)), c("names", "bibtype", "key"))
  key <- paste(attr(entry, "key"), collapse = "")
  lines <- c(
    sprintf("@%s{%s}", attr(entry, "bibtype"), key),
    dump_attributes(entry, extra, "  "),
    unlist(lapply(names(entry), function(f) dump_field(f, entry[[f]])))
  )
  paste(lines, collapse = "\n")
}

dump_attributes <- function(x, which, indent) {
  values <- vapply(attributes(x)[which], dump_value, "")
  sprintf("%sattr(%s) = %s", indent, which, values)
}

dump_field <- function(field, value) {
  if (!inherits(value, "person")) {
    return(sprintf("  %s = %s", field, dump_value(value)))
  }
  people <- vapply(unclass(value), function(p) {
    p <- Filter(length, p)
    paste(names(p), vapply(p, dump_value, ""), sep = " = ", collapse = " | ")
  }, "")
  c(sprintf("  %s:", field), paste0("    ", people))
}

dump_value <- function(x) {
  type <- if (is.character(x)) NULL else sprintf("<%s> ", class(x)[1L])
  x <- unlist(x)
  out <- encodeString(as.character(x), quote = "\"")
  if (!is.null(names(x))) {
    named <- nzchar(names(x))
    out[named] <- paste(names(x)[named], out[named], sep = " = ")
  }
  if (length(out) != 1L || !is.null(names(x))) {
    out <- sprintf("c(%s)", paste(out, collapse = ", "))
  }
  paste0(type, out)
}