Fix duplicated description for R6 classes with methods

R/rd-r6-methods.R

@@ -114,10 +114,13 @@ find_method_for_tag <- function(methods, tag) {
   if (nrow(methods) == 0) {
     return(NA_character_)
   }
-  w <- which(
-    basename(methods$file) == basename(tag$file) &
-      methods$line > tag$line
-  )[1]
+  if (tag$file == "<text>") {
+    # for testing
+    same_file <- TRUE
+  } else {
+    same_file <- basename(methods$file) == basename(tag$file)
+  }
+  w <- which(same_file & methods$line > tag$line)[1]
   methods$name[w]
 }
 

R/rd-r6.R

@@ -1,5 +1,6 @@
 topic_add_r6_methods <- function(rd, block, env, base_path) {
   docs <- r6_class_from_block(block, env)
+  block <- r6_fix_intro(block)
 
   # Add class-level tags
   for (tag in block$tags) {
@@ -20,27 +21,46 @@ topic_add_r6_methods <- function(rd, block, env, base_path) {
   }
 }
 
+# When an R6 class has inline @description tags for methods, parse_description()
+# parser puts the class description into @details instead of @description.
+# This function detects that case and promotes the class-level @details back
+# to @description.
+r6_fix_intro <- function(block) {
+  types <- map_chr(block$tags, \(t) r6_tag_type(t, block))
+  tags <- map_chr(block$tags, \(t) t$tag)
+
+  has_class_desc <- any(tags == "description" & types == "class")
+  has_class_details <- any(tags == "details" & types == "class")
+  has_method_desc <- any(tags == "description" & types == "method")
+
+  if (!has_class_desc && has_class_details && has_method_desc) {
+    # Promote the first class-level @details to @description
+    for (i in seq_along(block$tags)) {
+      if (tags[[i]] == "details" && types[[i]] == "class") {
+        block$tags[[i]]$tag <- "description"
+        break
+      }
+    }
+  }
+
+  block
+}
+
 # Classify an R6 block tag:
 # - "class": top-level Rd (e.g. @title, @description before class body)
 # - "method": inline tag associated with a method
 # - "other": @field/@param tags consumed by field/param extraction
 r6_tag_type <- function(tag, block) {
   inline <- !is.na(tag$line) && tag$line >= block$line
-  method_tags <- c(
-    "description",
-    "details",
-    "param",
-    "return",
-    "returns",
-    "examples"
-  )
-
-  if (tag$tag == "field") {
+  method_tags <- c("description", "details", "return", "returns", "examples")
+
+  if (tag$tag %in% c("field", "name", "title")) {
     "other"
   } else if (tag$tag %in% method_tags && inline) {
     "method"
   } else if (tag$tag == "param") {
-    "other"
+    # class-level @param are used as defaults for all methods
+    if (inline) "method" else "other"
   } else {
     "class"
   }

tests/testthat/test-rd-r6-class.R

@@ -12,6 +12,43 @@ test_that("can construct empty class", {
   expect_equal(docs$active_bindings, rd_r6_bindings())
 })
 
+test_that("class description is not duplicated", {
+  text <- "
+    #' Title
+    #'
+    #' Description
+    foo <- R6::R6Class(
+      public = list(
+        #' @description foo
+        foo = function() {}
+      )
+    )
+  "
+
+  out <- roc_proc_text(rd_roclet(), text)[[1]]
+  expect_equal(out$get_value("description"), "Description")
+})
+
+test_that("title-only class has single description", {
+  out <- roc_proc_text(
+    rd_roclet(),
+    "
+    #' Title
+    foo <- R6::R6Class(cloneable = FALSE)
+  "
+  )[[1]]
+  expect_equal(out$get_value("description"), "Title")
+
+  out <- roc_proc_text(
+    rd_roclet(),
+    "
+    #' @title Title
+    foo <- R6::R6Class(cloneable = FALSE)
+  "
+  )[[1]]
+  expect_equal(out$get_value("description"), "Title")
+})
+
 test_that("class with only active bindings doesn't error (#1610)", {
   text <- "
     #' Class