Fix duplicated description for R6 classes with methods (#1823)

The first bug arises because `parse_description()` thinks the method `@description` belongs to the class, so the second line of text becomes the details. There's no easy way to change this without significant changes to the parser, so the simplest approach seems to be to patch it up after the fact.

The second bug arises about because we were adding the default title twice.

Fixes #1504

Author: hadley

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