r
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

127 lines
3.4KB

  1. `%||%` <- function(x, y) if (is.null(x) || length(x) == 0) y else x
  2. subel <- function(x, name) {
  3. lapply(x, function(x) x[[name]])
  4. }
  5. sort_by <- function(list, by, null_val = NA) {
  6. vals <- unlist(lapply(list, function(x) x[[by]] %||% null_val))
  7. list[order(vals)]
  8. }
  9. na_rm <- function(x) {
  10. x[!is.na(x)]
  11. }
  12. readfile <- function(x) {
  13. readChar(x, file.info(x)$size)
  14. }
  15. file_with_meta_ext <- function(file, meta_ext, ext = tools::file_ext(file)) {
  16. paste(tools::file_path_sans_ext(file),
  17. ".", meta_ext, ".", ext,
  18. sep = ""
  19. )
  20. }
  21. get_parent_env_with <- function(var_names) {
  22. for (frame in rev(sys.frames())[-1]) {
  23. present <- all(vapply(
  24. var_names, exists, logical(1),
  25. envir = frame, inherits = FALSE
  26. ))
  27. if (present) return(frame)
  28. }
  29. stop(
  30. "No parent environment found with ",
  31. paste(var_names, collapse = ", ")
  32. )
  33. }
  34. add_intermediates <- function(new_intermediates) {
  35. render_env <- get_parent_env_with(c(
  36. "intermediates", "intermediates_loc",
  37. "knit_input"
  38. ))
  39. old_intermediates <- get("intermediates", envir = render_env)
  40. assign("intermediates",
  41. c(old_intermediates, new_intermediates),
  42. envir = render_env
  43. )
  44. }
  45. list_subset <- function(list, ...) {
  46. filters <- list(...)
  47. for (i in seq_along(filters)) {
  48. list <- Filter(list,
  49. f = function(x) {
  50. x[[names(filters)[i]]] == filters[[i]]
  51. }
  52. )
  53. }
  54. return(list)
  55. }
  56. #' Convert a document to Pandoc's abstract syntax tree format
  57. #'
  58. #' This is a convenience function for testing and development.
  59. #' @param file the file to convert using pandoc.
  60. #' @param from the format to convert from. If `NULL` (default) File type will be
  61. #' auto-detected by extension. `.Rmd` files will be treated as `.md`.
  62. #' @param tolist whether to return the AST as an R list. If `FALSE`, will
  63. #' return length-1 character vector of raw JSON.
  64. #' @export
  65. #' @importFrom rmarkdown pandoc_convert
  66. #' @importFrom jsonlite fromJSON
  67. #' @return A list containing the structured document
  68. #' @examples
  69. #' ast <- pandoc_ast(redoc_example_docx())
  70. pandoc_ast <- function(file, from = NULL, tolist = TRUE) {
  71. tmp <- tempfile()
  72. if (is.null(from) && tools::file_ext(file) == "Rmd") from <- "markdown"
  73. rmarkdown::pandoc_convert(
  74. input = normalizePath(file),
  75. to = "json",
  76. from = from,
  77. output = tmp
  78. )
  79. if (tolist) {
  80. return(jsonlite::fromJSON(tmp, simplifyVector = FALSE))
  81. } else {
  82. return(readfile(tmp))
  83. }
  84. }
  85. #' @importFrom stringi stri_subset_regex
  86. #' @importFrom utils unzip
  87. get_files_from_zip <- function(zipfile, regex, exdir = ".",
  88. junkpaths = TRUE, overwrite = TRUE) {
  89. files <- unzip(zipfile, list = TRUE)$Name
  90. files <- stri_subset_regex(files, regex)
  91. unzip(zipfile, files = files, exdir = exdir, overwrite = overwrite)
  92. return(file.path(exdir, basename(zipfile)))
  93. }
  94. #' @importFrom stringi stri_subset_regex
  95. #' @importFrom utils unzip
  96. get_con_from_zip <- function(zipfile, regex, open = "",
  97. encoding = getOption("encoding")) {
  98. files <- utils::unzip(zipfile, list = TRUE)$Name
  99. file <- stri_subset_regex(files, regex)
  100. if (length(file) != 1L) {
  101. stop("regex matches ", length(file), " files. Only 1 allowed")
  102. }
  103. unz(zipfile, files, open, encoding)
  104. }
  105. singlequote <- function(text) {
  106. if (stri_sub(text, 1) == "'" && stri_sub(text, -1) == "'") {
  107. return(text)
  108. } else {
  109. text <- stri_c("\"", text, "\"")
  110. class(text) <- "verbatim"
  111. return(text)
  112. }
  113. }