Rmd/qmd YAML header scanning (incomplete)

R/scan-deps-queries.R

@@ -156,7 +156,9 @@ q_deps_rmd <- function() {
       (#match? @header "^[{]")
     )',
     inline =
-      '(inline) @inline'
+      '(inline) @inline',
+    header =
+      '(minus_metadata) @metadata'
   )
 }
 

R/scan-deps.R

@@ -676,11 +676,15 @@ scan_path_deps_do_rmd <- function(code, path) {
   inl_pat <- hits$patterns$id[hits$patterns$name == "inline"]
   inl_hits <- hits$matched_captures[
     hits$matched_captures$pattern %in% inl_pat, ]
+  hdr_pat <- hits$patterns$id[hits$patterns$name == "header"]
+  hdr_hits <- hits$matched_captures[
+    hits$matched_captures$pattern %in% hdr_pat, ]
   blk_hits <- hits$matched_captures[
-    ! hits$matched_captures$pattern %in% inl_pat, ]
+    ! hits$matched_captures$pattern %in% c(inl_pat, hdr_pat), ]
   rbind(
     if (nrow(inl_hits)) scan_path_deps_do_inline_hits(code, inl_hits, path),
-    if (nrow(blk_hits)) scan_path_deps_do_block_hits(code, blk_hits, path)
+    if (nrow(blk_hits)) scan_path_deps_do_block_hits(code, blk_hits, path),
+    if (nrow(hdr_hits)) scan_path_deps_do_header_hits(code, hdr_hits, path)
   )
 }
 
@@ -730,3 +734,75 @@ scan_path_deps_do_block_hits <- function(code, blk_hits, path) {
   r_ranges <- blk_hits[wcnd, range_cols]
   scan_path_deps_do_r(code, path = path, ranges = r_ranges)
 }
+
+scan_path_deps_do_header_hits <- function(code, hdr_hits, path) {
+  browser()
+  code <- hdr_hits$code
+  code <- trimws(code)
+  code <- sub("^---", "", code)
+  code <- sub("---$", "", code)
+  code <- trimws(code)
+  hdr <- yaml::yaml.load(code, handlers = list(r = function(yaml) {
+    attr(yaml, "type") <- "r"
+    yaml
+  }))
+  pkgs <- character()
+  # shiny runtime
+  runtime <- hdr[["runtime"]]
+  server <- hdr[["server"]]
+  if (grepl("shiny", runtime %||% "") || identical(server, "shiny") ||
+      (is.list(server) && identical(server[["type"]], "shiny"))) {
+    pkgs <- c(pkgs, "shiny")
+  }
+
+  # find pkg::fun entries anywhere, including names
+  strs <- character()
+  chk <- function(x) {
+    if (!is.null(names(x))) {
+      strs <<- c(strs, names(x))
+    }
+    if (is.list(x)) {
+      lapply(x, chk)
+    } else if (is.character(x)) {
+      strs <<- c(strs, x)
+    }
+  }
+  chk(hdr)
+  for (s in strs) {
+    expr <- tryCatch(
+      parse(text = s, keep.source = FALSE)[[1]],
+      error = function(e) NULL
+    )
+    if (length(expr) == 3 && is.call(expr) &&
+        (identical(expr[[1]], quote(`::`)) ||
+         identical(expr[[1]], quote(`:::`)))) {
+     pkgs <- c(pkgs, as.character(expr[[2]]))
+    }
+  }
+
+  # bslib
+  tryCatch({
+    theme <- hdr[[c("output", "html_document", "theme")]]
+    if (is.list(theme)) {
+      pkgs <- c(pkgs, "bslib")
+    }
+  }, error = function(...) NULL)
+
+  # parameterized documents
+  params <- hdr[["params"]]
+  if (is.list(params)) {
+    # shiny is always needed, apparently
+    pkgs <- c(pkgs, "shiny")
+    for (p in params) {
+      if (identical(attr(p, "type", exact = TRUE),"r")) {
+        r_deps <- scan_path_deps_do_r(p, path)
+        pkgs <- c(pkgs, r_deps[["package"]])
+      }
+    }
+  }
+
+  if (length(pkgs) > 0) {
+    return(unique(pkgs))
+  }
+  NULL
+}

R/tree-sitter.R

@@ -1,6 +1,6 @@
-ts_languages <- c(r = 0L, markdown = 1L, "markdown-inline" = 2L)
+ts_languages <- c(r = 0L, markdown = 1L, "markdown-inline" = 2L, yaml = 3L)
 
-s_expr <- function(code, language = c("r", "markdown", "markdown-inline"),
+s_expr <- function(code, language = c("r", "markdown", "markdown-inline", "yaml"),
                    ranges = NULL) {
   language <- tolower(language)
   language <- ts_languages[match.arg(language)]
@@ -9,7 +9,7 @@ s_expr <- function(code, language = c("r", "markdown", "markdown-inline"),
 }
 
 code_query <- function(code = NULL, query, file = NULL,
-                       language = c("r", "markdown", "markdown-inline"),
+                       language = c("r", "markdown", "markdown-inline", "yaml"),
                        ranges = NULL) {
   language <- tolower(language)
   language <- ts_languages[match.arg(language)]

src/Makevars

@@ -9,7 +9,9 @@ tree-sitter-files = \
 	tree-sitter/markdown/parser.o \
 	tree-sitter/markdown/scanner.o \
 	tree-sitter/markdown-inline/parser.o \
-	tree-sitter/markdown-inline/scanner.o
+	tree-sitter/markdown-inline/scanner.o \
+        tree-sitter/yaml/parser.o \
+        tree-sitter/yaml/scanner.o
 
 lib-files = \
         init.o cleancall.o tree-sitter.o

src/tree-sitter.c

@@ -9,6 +9,7 @@
 extern const TSLanguage *tree_sitter_r(void);
 extern const TSLanguage *tree_sitter_markdown(void);
 extern const TSLanguage *tree_sitter_markdown_inline(void);
+extern const TSLanguage *tree_sitter_yaml(void);
 
 static void r_free(void *data) {
   free(data);
@@ -17,11 +18,13 @@ static void r_free(void *data) {
 static const TSLanguage *r_lang = NULL;
 static const TSLanguage *markdown_lang = NULL;
 static const TSLanguage *markdown_inline_lang = NULL;
+static const TSLanguage *yaml_lang = NULL;
 
 enum ts_language_t {
   TS_LANGUAGE_R = 0,
   TS_LANGUAGE_MARKDOWN,
-  TS_LANGUAGE_MARKDOWN_INLINE
+  TS_LANGUAGE_MARKDOWN_INLINE,
+  TS_LANGUAGE_YAML
 };
 
 static const TSLanguage *get_language(int code) {
@@ -41,6 +44,11 @@ static const TSLanguage *get_language(int code) {
       markdown_inline_lang = tree_sitter_markdown_inline();
     }
     return markdown_inline_lang;
+  case TS_LANGUAGE_YAML:
+    if (yaml_lang == NULL) {
+      yaml_lang = tree_sitter_yaml();
+    }
+    return yaml_lang;
   default:
     Rf_error("Unknonwn tree-sitter language code");
   }

src/tree-sitter/markdown-inline/scanner.c

@@ -366,7 +366,7 @@ static bool scan(Scanner *s, TSLexer *lexer, const bool *valid_symbols) {
     return false;
 }
 
-void *tree_sitter_markdown_inline_external_scanner_create() {
+void *tree_sitter_markdown_inline_external_scanner_create(void) {
     Scanner *s = (Scanner *)malloc(sizeof(Scanner));
     deserialize(s, NULL, 0);
     return s;