Resolve markdown links to external packages (#1633)

Closes #1612.

Author: gaborcsardi

NEWS.md

@@ -11,18 +11,27 @@
 #' ```
 #' MARKDOWN           LINK TEXT  CODE RD
 #' --------           ---------  ---- --
-#' [fun()]            fun()       T   \\link[=fun]{fun()}
-#' [obj]              obj         F   \\link{obj}
+#' [fun()]            fun()       T   \\link[=fun]{fun()} or
+#'                                    \\link[pkg:file]{pkg::fun()}
+#' [obj]              obj         F   \\link{obj} or
+#'                                    \\link[pkg:file]{pkg::obj}
 #' [pkg::fun()]       pkg::fun()  T   \\link[pkg:file]{pkg::fun()}
 #' [pkg::obj]         pkg::obj    F   \\link[pkg:file]{pkg::obj}
-#' [text][fun()]      text        F   \\link[=fun]{text}
-#' [text][obj]        text        F   \\link[=obj]{text}
+#' [text][fun()]      text        F   \\link[=fun]{text} or
+#'                                    \\link[pkg:file]{text}
+#' [text][obj]        text        F   \\link[=obj]{text} or
+#'                                    \\link[pkg:file]{text}
 #' [text][pkg::fun()] text        F   \\link[pkg:file]{text}
 #' [text][pkg::obj]   text        F   \\link[pkg:file]{text}
-#' [s4-class]         s4          F   \\linkS4class{s4}
+#' [s4-class]         s4          F   \\linkS4class{s4} or
+#'                                    \\link[pkg:file]{s4}
 #' [pkg::s4-class]    pkg::s4     F   \\link[pkg:file]{pkg::s4}
 #' ```
 #'
+#' For the links with two RD variants the first version is used for
+#' within-package links, and the second version is used for cross-package
+#' links.
+#'
 #' The reference links will always look like `R:ref` for `[ref]` and
 #' `[text][ref]`. These are explicitly tested in `test-rd-markdown-links.R`.
 #'
@@ -131,13 +140,15 @@ parse_link <- function(destination, contents, state) {
   is_code <- is_code || (grepl("[(][)]$", destination) && ! has_link_text)
   pkg <- str_match(destination, "^(.*)::")[1,2]
   pkg <- gsub("%", "\\\\%", pkg)
-  if (!is.na(pkg) && pkg == thispkg) pkg <- NA_character_
   fun <- utils::tail(strsplit(destination, "::", fixed = TRUE)[[1]], 1)
   fun <- gsub("%", "\\\\%", fun)
   is_fun <- grepl("[(][)]$", fun)
   obj <- sub("[(][)]$", "", fun)
   s4 <- str_detect(destination, "-class$")
   noclass <- str_match(fun, "^(.*)-class$")[1,2]
+
+  if (is.na(pkg)) pkg <- resolve_link_package(obj, thispkg, state = state)
+  if (!is.na(pkg) && pkg == thispkg) pkg <- NA_character_
   file <- find_topic_filename(pkg, obj, state$tag)
 
   ## To understand this, look at the RD column of the table above
@@ -174,6 +185,103 @@ parse_link <- function(destination, contents, state) {
   }
 }
 
+resolve_link_package <- function(topic, me = NULL, pkgdir = NULL, state = NULL) {
+  me <- me %||% roxy_meta_get("current_package")
+  # this is  from the roxygen2 tests, should not happen on a real package
+  if (is.null(me) || is.na(me) || me == "") return(NA_character_)
+
+  # if it is in the current package, then no need for package name, right?
+  if (has_topic(topic, me)) return(NA_character_)
+
+  # try packages in depends, imports, suggests first, error on name clashes
+  pkgs <- local_pkg_deps(pkgdir)
+
+  pkg_has_topic <- pkgs[map_lgl(pkgs, has_topic, topic = topic)]
+  pkg_has_topic <- map_chr(pkg_has_topic, function(p) {
+    p0 <- find_reexport_source(topic, p)
+    if (is.na(p0)) p else p0
+  })
+  pkg_has_topic <- unique(pkg_has_topic)
+  base <- base_packages()
+  if (length(pkg_has_topic) == 0) {
+    # fall through to check base packages as well
+  } else if (length(pkg_has_topic) == 1) {
+    if (pkg_has_topic %in% base) {
+      return(NA_character_)
+    } else {
+      return(pkg_has_topic)
+    }
+  } else {
+    warn_roxy_tag(state$tag, c(
+      "Topic {.val {topic}} is available in multiple packages: {.pkg {pkg_has_topic}}",
+      i = "Qualify topic explicitly with a package name when linking to it."
+    ))
+    return(NA_character_)
+  }
+
+  # try base packages as well, take the first hit,
+  # there should not be any name clashes, anyway
+  for (bp in base) {
+    if (has_topic(topic, bp)) return(NA_character_)
+  }
+
+  warn_roxy_tag(state$tag, c(
+    "Could not resolve link to topic {.val {topic}} in the dependencies or base packages",
+    "i" = paste(
+      "If you haven't documented {.val {topic}} yet, or just changed its name, this is normal.",
+      "Once {.val {topic}} is documented, this warning goes away."),
+    "i" = "Make sure that the name of the topic is spelled correctly.",
+    "i" = "Always list the linked package as a dependency.",
+    "i" = "Alternatively, you can fully qualify the link with a package name."
+  ))
+
+  NA_character_
+}
+
+# this is mostly from downlit
+is_exported <- function(name, package) {
+  name %in% getNamespaceExports(ns_env(package))
+}
+
+is_reexported <- function(name, package) {
+  if (package == "base") {
+    return(FALSE)
+  }
+  is_imported <- env_has(ns_imports_env(package), name)
+  is_imported && is_exported(name, package)
+}
+
+find_reexport_source <- function(topic, package) {
+  ns <- ns_env(package)
+  if (!env_has(ns, topic, inherit = TRUE)) {
+    return(NA_character_)
+  }
+
+  obj <- env_get(ns, topic, inherit = TRUE)
+  if (is.primitive(obj)) {
+    # primitive functions all live in base
+    "base"
+  } else if (is.function(obj)) {
+    ## For functions, we can just take their environment.
+    ns_env_name(get_env(obj))
+  } else {
+    ## For other objects, we need to check the import env of the package,
+    ## to see where 'topic' is coming from. The import env has redundant
+    ## information. It seems that we just need to find a named list
+    ## entry that contains `topic`.
+    imp <- getNamespaceImports(ns)
+    imp <- imp[names(imp) != ""]
+    wpkgs <- vapply(imp, `%in%`, x = topic, FUN.VALUE = logical(1))
+
+    if (!any(wpkgs)) {
+      return(NA_character_)
+    }
+    pkgs <- names(wpkgs)[wpkgs]
+    # Take the last match, in case imports have name clashes.
+    pkgs[[length(pkgs)]]
+  }
+}
+
 #' Dummy page to test roxygen's markdown formatting
 #'
 #' Links are very tricky, so I'll put in some links here:

R/markdown-link.R

@@ -17,6 +17,8 @@ markdown <- function(text, tag = NULL, sections = FALSE) {
   )
 }
 
+mddata <- new.env(parent = emptyenv())
+
 #' Expand the embedded inline code
 #'
 #' @details
@@ -68,6 +70,7 @@ markdown <- function(text, tag = NULL, sections = FALSE) {
 #' @keywords internal
 
 markdown_pass1 <- function(text) {
+  rm(list = ls(envir = mddata), envir = mddata)
   text <- paste(text, collapse = "\n")
   mdxml <- xml_ns_strip(md_to_mdxml(text, sourcepos = TRUE))
   code_nodes <- xml_find_all(mdxml, ".//code | .//code_block")

R/markdown.R

@@ -66,6 +66,7 @@ load_options <- function(base_path = ".") {
     markdown = FALSE,
     r6 = TRUE,
     current_package = NA_character_,
+    current_package_dir = NA_character_,
     rd_family_title = list(),
     knitr_chunk_options = NULL,
     restrict_image_formats = TRUE
@@ -94,6 +95,7 @@ load_options_description <- function(base_path = ".") {
   }
 
   opts$current_package <- dcf[[1, 2]]
+  opts$current_package_dir <- normalizePath(base_path)
   opts
 }
 

R/options.R

@@ -182,3 +182,29 @@ auto_quote <- function(x) {
 is_syntactic <- function(x) make.names(x) == x
 has_quotes <- function(x) str_detect(x, "^(`|'|\").*\\1$")
 strip_quotes <- function(x) str_replace(x, "^(`|'|\")(.*)\\1$", "\\2")
+
+base_packages <- function() {
+  if (getRversion() >= "4.4.0") {
+    asNamespace("tools")$standard_package_names()[["base"]]
+  } else {
+    c("base", "compiler", "datasets",
+      "graphics", "grDevices", "grid", "methods", "parallel",
+      "splines", "stats", "stats4", "tcltk", "tools", "utils"
+    )
+  }
+}
+
+# Note that this caches the result regardless of
+# pkgdir! pkgdir is mainly for testing, in which case you
+# need to clear the cache manually.
+
+local_pkg_deps <- function(pkgdir = NULL) {
+  if (!is.null(mddata[["deps"]])) {
+    return(mddata[["deps"]])
+  }
+  pkgdir <- pkgdir %||% roxy_meta_get("current_package_dir")
+  deps <- desc::desc_get_deps(pkgdir)
+  deps <- deps[deps$package != "R", ]
+  deps <- deps[deps$type %in% c("Depends", "Imports", "Suggests"), ]
+  deps$package
+}

R/utils.R

@@ -36,3 +36,43 @@
     Message
       x <text>:4: @description refers to unavailable topic stringr::bar111.
 
+# resolve_link_package
+
+    Code
+      resolve_link_package("roxygenize", "roxygen2", test_path("testMdLinks2"))
+    Output
+      [1] NA
+    Code
+      resolve_link_package("UseMethod", "roxygen2", test_path("testMdLinks2"))
+    Output
+      [1] NA
+    Code
+      resolve_link_package("cli_abort", "roxygen2", test_path("testMdLinks2"))
+    Output
+      [1] "cli"
+
+---
+
+    Code
+      resolve_link_package("aa3bc042880aa3b64fef1a9", "roxygen2", test_path(
+        "testMdLinks2"), list(tag = tag))
+    Message
+      x foo.R:10: @title (automatically generated) Could not resolve link to topic "aa3bc042880aa3b64fef1a9" in the dependencies or base packages.
+      i If you haven't documented "aa3bc042880aa3b64fef1a9" yet, or just changed its name, this is normal. Once "aa3bc042880aa3b64fef1a9" is documented, this warning goes away.
+      i Make sure that the name of the topic is spelled correctly.
+      i Always list the linked package as a dependency.
+      i Alternatively, you can fully qualify the link with a package name.
+    Output
+      [1] NA
+
+# resolve_link_package name clash
+
+    Code
+      resolve_link_package("pkg_env", "roxygen2", test_path("testMdLinks2"), list(
+        tag = tag))
+    Message
+      x foo.R:10: @title (automatically generated) Topic "pkg_env" is available in multiple packages: pkgload and rlang.
+      i Qualify topic explicitly with a package name when linking to it.
+    Output
+      [1] NA
+

tests/testthat/_snaps/markdown-link.md

@@ -477,3 +477,41 @@ test_that("percents are escaped in link targets", {
     foo <- function() {}")[[1]]
   expect_equivalent_rd(out1, out2)
 })
+
+test_that("resolve_link_package", {
+  rm(list = ls(envir = mddata), envir = mddata)
+  expect_snapshot({
+    resolve_link_package("roxygenize", "roxygen2", test_path("testMdLinks2"))
+    resolve_link_package("UseMethod", "roxygen2", test_path("testMdLinks2"))
+    resolve_link_package("cli_abort", "roxygen2", test_path("testMdLinks2"))
+  })
+
+  tag <- roxy_tag("title", NULL, NULL, file = "foo.R", line = 10)
+  expect_snapshot({
+    resolve_link_package("aa3bc042880aa3b64fef1a9", "roxygen2", test_path("testMdLinks2"), list(tag = tag))
+  })
+  # re-exported topics are identified
+  rm(list = ls(envir = mddata), envir = mddata)
+  expect_equal(
+    resolve_link_package("process", "testthat", test_path("testMdLinks")),
+    "processx"
+  )
+})
+
+test_that("resolve_link_package name clash", {
+  # skip in case pkgload/rlang changes this
+  skip_on_cran()
+  tag <- roxy_tag("title", NULL, NULL, file = "foo.R", line = 10)
+  expect_snapshot({
+    resolve_link_package("pkg_env", "roxygen2", test_path("testMdLinks2"), list(tag = tag))
+  })
+})
+
+test_that("is_reexported", {
+  expect_false(is_reexported("process", "processx"))
+  expect_true(is_reexported("process", "callr"))
+})
+
+test_that("find_reexport_source", {
+  expect_equal(find_reexport_source("process", "callr"), "processx")
+})

tests/testthat/test-markdown-link.R

@@ -263,4 +263,3 @@ test_that("complains about bad usage", {
   "
   expect_snapshot(. <- roc_proc_text(rd_roclet(), block))
 })
-

tests/testthat/test-rd-describe-in.R

@@ -1,5 +1,8 @@
 skip_if_not_installed("rmarkdown")
 
+# clear some state
+roxy_meta_clear()
+
 test_that("invalid syntax gives useful warning", {
   block <- "
     #' @includeRmd

tests/testthat/test-rd-include-rmd.R

@@ -0,0 +1,58 @@
+Package: testthat
+Title: Unit Testing for R
+Version: 3.2.1.9000
+Authors@R: c(
+    person("Hadley", "Wickham", , "[email protected]", role = c("aut", "cre")),
+    person("Posit Software, PBC", role = c("cph", "fnd")),
+    person("R Core team", role = "ctb",
+           comment = "Implementation of utils::recover()")
+  )
+Description: Software testing is important, but, in part because it is
+    frustrating and boring, many of us avoid it. 'testthat' is a testing
+    framework for R that is easy to learn and use, and integrates with
+    your existing 'workflow'.
+License: MIT + file LICENSE
+URL: https://testthat.r-lib.org, https://github.com/r-lib/testthat
+BugReports: https://github.com/r-lib/testthat/issues
+Depends: 
+    R (>= 3.6.0)
+Imports:
+    brio (>= 1.1.3),
+    callr (>= 3.7.3),
+    cli (>= 3.6.1),
+    desc (>= 1.4.2),
+    digest (>= 0.6.33),
+    evaluate (>= 0.21),
+    jsonlite (>= 1.8.7),
+    lifecycle (>= 1.0.3),
+    magrittr (>= 2.0.3),
+    methods,
+    pkgload (>= 1.3.2.1),
+    praise (>= 1.0.0),
+    processx (>= 3.8.2),
+    ps (>= 1.7.5),
+    R6 (>= 2.5.1),
+    rlang (>= 1.1.1),
+    utils,
+    waldo (>= 0.5.1),
+    withr (>= 2.5.0)
+Suggests: 
+    covr,
+    curl (>= 0.9.5),
+    diffviewer (>= 0.1.0),
+    knitr,
+    rmarkdown,
+    rstudioapi,
+    shiny,
+    usethis,
+    vctrs (>= 0.1.0),
+    xml2
+VignetteBuilder: 
+    knitr
+Config/Needs/website: tidyverse/tidytemplate
+Config/testthat/edition: 3
+Config/testthat/parallel: true
+Config/testthat/start-first: watcher, parallel*
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE, r6 = FALSE)
+RoxygenNote: 7.2.3