Use roxygen2 parser for roxy comments + lightparser for figure and tbl captions

DESCRIPTION

@@ -35,9 +35,11 @@ Suggests:
     curl,
     gert,
     gt,
-    pillar,
     magick,
+    pillar,
+    roxygen2,
     testthat (>= 3.2.1),
+    tidyr,
     withr
 Config/testthat/edition: 3
 Encoding: UTF-8

R/escape-inline-markup.R

@@ -118,7 +118,9 @@ replace_r_var <- function(x) {
 #'
 #' @examples
 #' replace_r_var("i{gt_var} in {{gt_var}} in gt_var in {.file {gt_var}}.")
-#' # last instance taken care of with escape_markup with a different strategy
 #' #> "{{gt_var}} in {{gt_var}} in gt_var in {.file {gt_var}}."
+#' # last instance taken care of with escape_markup with a different strategy
 #' escape_markup("{gt_var} in {{gt_var}} in gt_var in {.file {gt_var}}.")
 #' #> "{{gt_var}} in {{gt_var}} in gt_var in {.file gt_var}."
+#'
+NULL

R/open.R

@@ -255,7 +255,8 @@ active_rs_doc_delete <- function() {
   if (isTRUE(will_delete_decision)) {
     cli::cli_inform(c(
       "v" = "Deleted the active document {.val {elems$rel_path}} because {reasons_deleting}.",
-      "i" = cli::col_grey("The deleted file {.path {elems$full_path}} contents are returned invisibly in case you need them.")
+      # FIXME (upstream) the color div doesn't go all the way r-lib/cli#694
+      "i" = paste(cli::col_grey("The deleted file"),  "{.path {elems$full_path}}", cli::col_grey("contents are returned invisibly in case you need them."))
     ))
     contents <- readLines(elems$full_path, encoding = "UTF-8")
     fs::file_delete(elems$full_path)

R/outline-criteria.R

@@ -29,7 +29,7 @@ o_is_roxygen_comment <- function(x, file_ext = NULL) {
     return(FALSE)
   }
 
-  ifelse(rep(is_r_file, length.out = length(x)), stringr::str_starts(x, "#'\\s"), FALSE)
+  ifelse(rep(is_r_file, length.out = length(x)), stringr::str_detect(x, "^#'\\s|^#'$"), FALSE)
 }
 
 o_is_todo_fixme <- function(x) {
@@ -121,15 +121,35 @@ define_outline_criteria <- function(.data, print_todo) {
   x$file_ext <- s_file_ext(x$file)
   x$is_md <- x$file_ext %in% c("qmd", "md", "Rmd", "Rmarkdown")
   x$is_news <- x$is_md & grepl("NEWS.md", x$file, fixed = TRUE)
-  x$is_md <- x$is_md & !x$is_news # treating news and other md files differently.
+  x$is_roxygen_comment <- o_is_roxygen_comment(x$content, x$file_ext)
+  x$is_md <- (x$is_md | x$is_roxygen_comment) & !x$is_news # treating news and other md files differently.
   x$is_test_file <- grepl("tests/testthat", x$file, fixed = TRUE)
   x$is_snap_file <- grepl("_snaps", x$file, fixed = TRUE)
+  if (any(x$is_roxygen_comment)) {
+    rlang::check_installed(c("roxygen2", "tidyr"), "to create roxygen2 comments outline.")
+    files_with_roxy_comments <- unique(x[x$is_roxygen_comment, "file", drop = TRUE])
+    files_with_roxy_comments <- rlang::set_names(files_with_roxy_comments, files_with_roxy_comments)
+    parsed_files <- suppressMessages( # roxygen2 messages
+      # TRICK purrr::safely creates an error object, while possible is better.
+      purrr::map(files_with_roxy_comments, purrr::possibly(roxygen2::parse_file))
+    )
+    # if roxygen2 cannot parse a file, let's just forget about it.
+    unparsed_files <- files_with_roxy_comments[which(is.null(parsed_files))]
+    # browser()
+    if (length(unparsed_files) > 0) {
+      cli::cli_inform("Could not parse roxygen comments in {.file {unparsed_files}}")
+    }
+    parsed_files <- purrr::compact(parsed_files)
+    outline_roxy <- join_roxy_fun(parsed_files)
+  } else {
+    outline_roxy <- NULL
+  }
 
   x <- dplyr::mutate(
-    x,
+    x |> dplyr::filter(!is_roxygen_comment) |> dplyr::bind_rows(outline_roxy),
     # Problematic when looking inside functions
     # maybe force no leading space.
-    # TODO strip is_cli_info in Package? only valid for EDA
+    # TODO strip is_cli_info in Package? only valid for EDA (currently not showcased..)
     is_cli_info = o_is_cli_info(content, is_snap_file, file),
     is_doc_title = stringr::str_detect(content, "(?<![-(#\\s?)_])title\\:.{4,100}") & !stringr::str_detect(content, "Ttitle|Subtitle") &
       !stringr::str_detect(dplyr::lag(content, default = "nothing to detect"), "```yaml"),
@@ -156,11 +176,19 @@ define_outline_criteria <- function(.data, print_todo) {
     is_cross_ref = stringr::str_detect(content, "docs_links?\\(") & !stringr::str_detect(content, "@param|\\{\\."),
     is_function_def = grepl("<- function(", content, fixed = TRUE) & !stringr::str_starts(content, "\\s*#")
   )
+  if (!"before_and_after_empty" %in% names(x)) {
+    x$before_and_after_empty <- NA
+  }
   x <- dplyr::mutate(
     x,
-    before_and_after_empty = line_id == 1 | !nzchar(dplyr::lead(content, default = "")) & !nzchar(dplyr::lag(content)),
+    before_and_after_empty = ifelse(
+      !is.na(before_and_after_empty),
+      line == 1 | !nzchar(dplyr::lead(content, default = "")) & !nzchar(dplyr::lag(content)),
+      before_and_after_empty
+      ),
     .by = file
   )
+  #browser()
   x
 }
 

R/outline-roxy.R

@@ -0,0 +1,234 @@
+#' Extract roxygen tag
+#'
+#' Tell me what this does
+#'
+#' # Section to extract
+#'
+#' Well this is a section
+#'
+#' @noRd
+#' @param file A list of roxy blocks
+#' @returns A named list with name = file:line, and element is the section title
+#' @examples
+#' extract_roxygen_tag_location(tag = "title")
+
+extract_roxygen_tag_location <- function(file, tag) {
+  # suppressMessages(aa <- roxygen2::parse_file(file))
+  # browser()
+  aa <- file
+  pos <- purrr::map(aa, \(x) roxygen2::block_get_tags(x, tags = tag))
+  # browser()
+  if (all(lengths(pos) == 0L)) {
+    return(character(0L))
+  }
+  aa <- aa[lengths(pos) > 0L]
+  pos <- purrr::list_flatten(pos)
+  objects <- purrr::map(
+    aa,
+    \(x) x$object$topic
+  )
+  if (any(lengths(objects) == 0)) {
+    name_tag <- purrr::map(
+      aa,
+      \(x) roxygen2::block_get_tag_value(x, "name")
+    )
+    for (i in seq_along(objects)) {
+      if (is.null(objects[[i]])) {
+        if (!is.null(name_tag[[i]])) {
+          objects[[i]] <- name_tag[[i]]
+        } else {
+          objects[[i]] <- "no-topic"
+        }
+      }
+    }
+    if (any(lengths(objects) == 0)) {
+      # should not happen. I chose "no-topic" instead.
+      cli::cli_abort("Could not resolve object or topic names.")
+    }
+  }
+
+
+  # browser()
+  pos <- purrr::set_names(pos, pos$file)
+
+  # browser()
+  val <- withCallingHandlers(
+    purrr::map2(pos, objects, \(x, obj_name) {
+    el <- x$val
+    el_has_names <- !is.null(names(el))
+
+    if (length(el) == 1 && !el_has_names) {
+      el <- paste0(
+        el, "____", obj_name
+      )
+      names(el) <- x$line
+      return(el)
+    }
+    if (tag %in% c("description", "details") && !el_has_names) {
+      # TODO when stable delete
+      # print(x$val)
+      # print(el_has_names)
+      # cli::cli_inform("return early (no headings)")
+      return(NULL)
+    }
+    # use raw instead
+    lines <- stringr::str_split_1(x$raw, "\n")
+    # browser()
+    keep <- which(o_is_section_title(lines))
+
+    if (length(keep) == 0L) {
+      # TODO Delete when stable debugging
+      # cli::cli_inform(" No section title detected")
+      return(NULL)
+    }
+    # line position.
+    line_pos <- x$line + seq_along(lines) - 1L
+    final_lines_to_include <- lines[keep]
+    # Will not make this transformation and will consider roxygen comments to be
+    # final_lines_to_include <- stringr::str_remove(final_lines_to_include, "^#+\\s")
+
+    final_lines_to_include <- paste0(final_lines_to_include, "____", obj_name)
+    names(final_lines_to_include) <- line_pos[keep]
+    # TODO Delete when stable for debugging
+    # if (length(final_lines_to_include) != 1) {
+    #   cli::cli_warn("el resulted to {.val {final_lines_to_include}}", "using first element for now")
+    # }
+    final_lines_to_include
+  }),
+  error = function(e) {
+    cli::cli_abort(
+      "For tag = {tag}, obj_name = {objects}, wrong size, should be {length(pos)}"
+    )
+
+  })
+
+  # rlang::set_names(val, nam)
+  # merge line number and file name
+  # I wonder if purrr make it easy to do tidyverse/purrr#1064
+  # list(x = c(el1 = 1), x = c(el2 = 2, el3 = 3))
+  #> list(x = c(el1 = 1, el2 = 2, el3 = 3))
+  val <- val |> purrr::compact()
+
+  if (FALSE) {
+    val <- unlist(val)
+    names(val) <- stringr::str_replace(names(val), "\\.(\\d+)$", ":\\1")
+  } else {
+    # purrr::list_flatten(
+    #  name_spec = "{outer}:{inner}"
+    # )
+    val <- vctrs::list_unchop(
+      val,
+      name_spec = "{outer}:{inner}",
+      ptype = "character"
+    )
+  }
+
+
+  # hack to keep tag
+  if (length(val) > 0) {
+    names(val) <- paste0(names(val), "____", tag)
+  }
+  val
+}
+
+join_roxy_fun <- function(file) {
+  # don't parse noRd tags
+  parsed_files <- purrr::discard(file, \(x) roxygen2::block_has_tags(x, "noRd"))
+  # Return early if no roxy tags
+  if (length(parsed_files) == 0) {
+    return(character(0L))
+  }
+  if (is.null(names(parsed_files))) {
+     # browser()
+    parsed_files <- parsed_files |> purrr::set_names(purrr::map_chr(parsed_files, \(x) x$file))
+    # cli::cli_abort("parsed files must be named at this point.")
+  }
+  # parsed_files <- set_names(parsed_files, \(x))
+  titles_list <- purrr::map(parsed_files, \(x) extract_roxygen_tag_location(x, tag = "title"))
+
+  section_list <- purrr::map(parsed_files, \(x) extract_roxygen_tag_location(x, tag = "section"))
+  subsection_list <- purrr::map(parsed_files, \(x) extract_roxygen_tag_location(x, tag = "subsection"))
+
+  desc_list <- purrr::map(parsed_files, \(x) extract_roxygen_tag_location(x, tag = "description"))
+
+  details_list <- purrr::map(parsed_files, \(x) extract_roxygen_tag_location(x, tag = "details"))
+
+  family_list <- purrr::map(parsed_files, \(x) extract_roxygen_tag_location(x, tag = "family"))
+  concept_list <- purrr::map(parsed_files, \(x) extract_roxygen_tag_location(x, tag = "concept"))
+  roxy_parsed <- vctrs::vec_c(
+    titles_list,
+    section_list,
+    subsection_list,
+    desc_list,
+    details_list,
+    family_list,
+    concept_list#,
+    #.name_spec = "{outer}:::::{inner}",
+  ) |>
+    vctrs::list_unchop(
+      name_spec = "{outer}.....{inner}"
+    ) |>
+    tibble::enframe() |>
+    tidyr::separate_wider_delim(
+      cols = name,
+      names = c("file_line", "tag"),
+      delim = "____"
+    )
+
+  roxy_parsed <- roxy_parsed |>
+    tidyr::separate_wider_delim(
+      cols = value,
+      delim = "____",
+      names = c("content", "topic"),
+    )
+  if (!all(grepl("\\.{5}", roxy_parsed$file_line, fixed = F))) {
+    problems <- which(!grepl("\\.{5}", roxy_parsed$file_line, fixed = F))
+    #rowser()
+    # roxy_parsed
+    cli::cli_abort("Malformed file line at {problems}.")
+  }
+  roxy_parsed <- roxy_parsed |>
+    tidyr::separate_wider_delim(
+      file_line,
+      delim = ".....",
+      names = c("file", "line")
+    )
+  roxy_parsed |>
+    dplyr::mutate(
+      #file = fs::path_real(file) |> as.character(),
+      #file_line = paste0(file, ":", line)
+    ) |>
+    dplyr::relocate(
+      file, topic, content, line, tag
+    ) |>
+    dplyr::mutate(
+      is_md = tag %in% c("subsection", "details", "description", "section"),
+      # content = paste0("#' ", outline_el),
+      is_object_title = tag == "title",
+      line = as.integer(line),
+      file_ext = "R",
+      tile_el = NA_character_,
+      title_el_line = NA_integer_,
+      is_news = FALSE,
+      is_roxygen_comment = TRUE,
+      is_test_file = FALSE,
+      is_snap_file = FALSE,
+      before_and_after_empty = TRUE,
+      is_section_title = TRUE,
+      is_section_title_source = TRUE,
+      is_saved_doc = TRUE,
+      has_inline_markup = FALSE # let's not mess with inline markup
+    ) |>
+    dplyr::filter(
+      content != "NULL"
+    )
+}
+
+# helper for interactive checking -----------
+
+
+active_doc_parse <- function(doc = active_rs_doc()) {
+  doc <- purrr::set_names(doc)
+  parsed <- purrr::map(doc, roxygen2::parse_file)
+  parsed |> join_roxy_fun()
+}