Navbar components shouldn't be merged recursively (#2689)

* Add a test so I don't break it again!
* Finish off passing around caller to get correct call in error

Fixes #2673

R/navbar.R

@@ -1,4 +1,4 @@
-data_navbar <- function(pkg = ".", depth = 0L) {
+data_navbar <- function(pkg = ".", depth = 0L, call = caller_env()) {
   pkg <- as_pkgdown(pkg)
 
   navbar <- config_pluck(pkg, "navbar")
@@ -13,7 +13,7 @@ data_navbar <- function(pkg = ".", depth = 0L) {
     )
   }
 
-  links <- navbar_links(pkg, depth = depth)
+  links <- navbar_links(pkg, depth = depth, call = call)
 
   c(style, links)
 }
@@ -43,12 +43,31 @@ navbar_structure <- function() {
   ))
 }
 
-navbar_links <- function(pkg, depth = 0L) {
-  # Combine default components with user supplied
-  components <- modify_list(
-    navbar_components(pkg),
-    config_pluck(pkg, "navbar.components")
+navbar_links <- function(pkg, depth = 0L, call = caller_env()) {
+  components <- navbar_link_components(pkg, call = call)
+
+  list(
+    left = render_navbar_links(
+      components$left,
+      depth = depth,
+      pkg = pkg,
+      side = "left"
+    ),
+    right = render_navbar_links(
+      components$right,
+      depth = depth,
+      pkg = pkg,
+      side = "right"
+    )
   )
+}
+
+navbar_link_components <- function(pkg, call = caller_env()) {
+  # Combine default components with user supplied: must not merge recursively
+  components <- navbar_components(pkg)
+  components_meta <- config_pluck(pkg, "navbar.components", default = list())
+  components[names(components_meta)] <- components_meta
+  components <- purrr::compact(components)
 
   # Combine default structure with user supplied
   # (must preserve NULLs in yaml to mean display nothing)
@@ -57,31 +76,18 @@ navbar_links <- function(pkg, depth = 0L) {
     config_pluck(pkg, "navbar.structure")
   )
   right_comp <- intersect(
-    config_pluck_character(pkg, "navbar.structure.right"),
+    config_pluck_character(pkg, "navbar.structure.right", call = call),
     names(components)
   )
   left_comp <- intersect(
-    config_pluck_character(pkg, "navbar.structure.left"),
+    config_pluck_character(pkg, "navbar.structure.left", call = call),
     names(components)
   )
   # Backward compatibility
   left <- config_pluck(pkg, "navbar.left") %||% components[left_comp]
   right <- config_pluck(pkg, "navbar.right") %||% components[right_comp]
 
-  list(
-    left = render_navbar_links(
-      left,
-      depth = depth,
-      pkg = pkg,
-      side = "left"
-    ),
-    right = render_navbar_links(
-      right,
-      depth = depth,
-      pkg = pkg,
-      side = "right"
-    )
-  )
+  list(left = left, right = right)
 }
 
 render_navbar_links <- function(x, depth = 0L, pkg, side = c("left", "right")) {

tests/testthat/_snaps/navbar.md

@@ -170,7 +170,7 @@
     Code
       data_navbar_(navbar = list(structure = list(left = 1)))
     Condition
-      Error in `navbar_links()`:
+      Error in `data_navbar_()`:
       ! In _pkgdown.yml, navbar.structure.left must be a character vector, not the number 1.
     Code
       data_navbar_(navbar = list(right = "github"))

tests/testthat/test-navbar.R

@@ -66,6 +66,19 @@ test_that("can control articles navbar through articles meta", {
 
 })
 
+test_that("can control articles navbar through navbar meta", {
+  pkg <- local_pkgdown_site(meta = list(
+    navbar = list(
+      components = list(articles = menu_submenu("Hi!", list(menu_heading("Hi"))))
+    )
+  ))
+  pkg <- pkg_add_file(pkg, "vignettes/a.Rmd", pkg_vignette())
+  pkg <- pkg_add_file(pkg, "vignettes/b.Rmd", pkg_vignette())
+
+  navbar <- navbar_link_components(pkg)
+  expect_equal(navbar$left$articles$text, "Hi!")
+})
+
 test_that("data_navbar() works by default", {
   pkg <- local_pkgdown_site(meta = list(
     repo = list(url = list(home = "https://github.com/r-lib/pkgdown/"))