Add update_topics()

r-multiverse · Dec 3, 2024 · 56c4628 · 56c4628
1 parent 37103b7
commit 56c4628
Show file tree

Hide file tree

Showing 9 changed files with 201 additions and 5 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: multiverse.internals
 Title: Internal Infrastructure for R-multiverse
 Description: R-multiverse requires this internal infrastructure package to
   automate contribution reviews and populate universes.
-Version: 0.2.21
+Version: 0.3.0
 License: MIT + file LICENSE
 URL:
   https://r-multiverse.org/multiverse.internals/,

diff --git a/NAMESPACE b/NAMESPACE
@@ -22,6 +22,7 @@ export(review_pull_requests)
 export(try_message)
 export(update_staging)
 export(update_status)
+export(update_topics)
 importFrom(base64enc,base64decode)
 importFrom(desc,description)
 importFrom(gh,gh)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+# multiverse.internals 0.3.0
+
+* Add `update_topics()`.
+
 # multiverse.internals 0.2.21
 
 * Add back HTML line breaks in `update_status()`.

diff --git a/R/update_topics.R b/R/update_topics.R
@@ -0,0 +1,80 @@
+#' @title Update topics
+#' @export
+#' @family topics
+#' @description Update the list of packages for each
+#'   R-multiverse topic.
+#' @return `NULL` (invisibly). Called for its side effects.
+#' @inheritParams update_staging
+#' @param path Character string,
+#'   local file path to the topics repository source code.
+#' @param repo Character string, URL of the Community universe.
+update_topics <- function(
+  path,
+  repo = "https://community.r-multiverse.org",
+  mock = NULL
+) {
+  meta <- mock$meta %||% meta_packages(repo, fields = c("Title", "URL"))
+  meta <- meta[, c("package", "title", "url")]
+  unlink(file.path(path, "*.html"))
+  topics <- setdiff(
+    list.files(path),
+    c(".gitignore", "README.md", "LICENSE.md")
+  )
+  for (topic in topics) {
+    update_topic(topic, path, meta)
+  }
+  topic_urls <- file.path(
+    "https://r-multiverse.org/topics", paste0(topics, ".html")
+  )
+  topic_list <- paste0(
+    "<li>",
+    topics,
+    ": <a href=\"",
+    topic_urls,
+    "\">",
+    topic_urls,
+    "</a>",
+    "</li>"
+  )
+  topic_text <- paste(topic_list, collapse = "\n")
+  template <- system.file(
+    file.path("topics", "index.html"),
+    package = "multiverse.internals",
+    mustWork = TRUE
+  )
+  text <- readLines(template)
+  text <- gsub(pattern = "TOPICS", replacement = topic_text, x = text)
+  writeLines(text, file.path(path, "index.html"))
+}
+
+update_topic <- function(topic, path, meta) {
+  url <- file.path("https://r-multiverse.org/topics", paste0(topic, ".html"))
+  meta <- meta[grepl(pattern = url, x = meta$url, fixed = TRUE), ]
+  about <- readLines(file.path(path, topic))
+  template <- system.file(
+    file.path("topics", "topic.html"),
+    package = "multiverse.internals",
+    mustWork = TRUE
+  )
+  line <- paste0(
+    "<li>",
+    "<a href=\"https://community.r-multiverse.org/PACKAGE\">PACKAGE</a>: ",
+    "TITLE",
+    "</li>"
+  )
+  packages <- character(0L)
+  for (row in seq_len(nrow(meta))) {
+    package <- meta$package[row]
+    title <- meta$title[row]
+    element <- line
+    element <- gsub(pattern = "PACKAGE", replacement = package, x = element)
+    element <- gsub(pattern = "TITLE", replacement = title, x = element)
+    packages <- c(packages, element)
+  }
+  packages <- paste(packages, collapse = "\n")
+  text <- readLines(template)
+  text <- gsub(pattern = "ABOUT", replacement = about, x = text)
+  text <- gsub(pattern = "PACKAGES", replacement = packages, x = text)
+  text <- gsub(pattern = "TOPIC", replacement = topic, x = text)
+  writeLines(text, file.path(path, paste0(topic, ".html")))
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -24,11 +24,14 @@ reference:
   - record_issues
   - record_nonstandard_licenses
   - record_versions
-- title: Package status repository
-  contents:
-  - interpret_status
-  - update_status
 - title: Staging
   contents:
   - update_staging
   - propose_snapshot
+- title: Package status
+  contents:
+  - interpret_status
+  - update_status
+- title: Topics
+  contents:
+  - update_topics
diff --git a/inst/topics/index.html b/inst/topics/index.html
@@ -0,0 +1,31 @@
+<!doctype html>
+<html>
+  <head><title>R-multiverse topics</title></head>
+  <body>
+    <h2>About R-multiverse topics</h2>
+    <p>
+      An R-multiverse topic is a list of packages that share a subject
+      matter domain (for example, packages that fit Bayesian models).
+    </p>
+    <p>
+      To contribute a new package to an existing topic, add the topic URL
+      to the URL field of the DESCRIPTION file
+      (<a href="https://github.com/ropensci/stantargets/blob/db7d119ea0599eac3ce01a42bee27c9908754943/DESCRIPTION#L22">example here</a>),
+      then create a new GitHub/GitLab release of the package.
+    </p>
+    <p>
+      To contribute a new topic, submit a pull request to
+      <a href="https://github.com/r-multiverse/topics">https://github.com/r-multiverse/topics</a>
+      to add a new text file (with no file extension) whose name is the topic name
+      and whose contents describe the topic.
+      An automated workflow periodically creates HTML pages from these
+      text files.
+    </p>
+    <h2>List of R-multiverse topics</h2>
+    <p>
+      <ul>
+      TOPICS
+      </ul>
+    </p>
+  </body>
+</html>
diff --git a/inst/topics/topic.html b/inst/topics/topic.html
@@ -0,0 +1,14 @@
+<!doctype html>
+<html>
+  <head><title>TOPIC</title></head>
+  <body>
+    <h2>Topic: TOPIC</h2>
+    <p>ABOUT</p>
+    <h2>Packages</h2>
+    <p>
+      <ul>
+        PACKAGES
+      </ul>
+    </p>
+  </body>
+</html>
diff --git a/man/update_topics.Rd b/man/update_topics.Rd
diff --git a/tests/testthat/test-update_topics.R b/tests/testthat/test-update_topics.R
@@ -0,0 +1,38 @@
+test_that("update_topics()", {
+  path <- tempfile()
+  on.exit(unlink(path))
+  dir.create(path, recursive = TRUE)
+  writeLines("bayesian description", file.path(path, "bayesian"))
+  writeLines("hpc description", file.path(path, "hpc"))
+  meta <- data.frame(
+    package = c("nope", "crew", "stantargets", "jagstargets"),
+    title = c("x", "crew-title", "stantargets-title", "jagstargets-title"),
+    url = c(
+      "https://asdf",
+      "https://r-multiverse.org/topics/hpc.html, https://crew",
+      "https://url, https://r-multiverse.org/topics/bayesian.html",
+      "https://url,\nhttps://r-multiverse.org/topics/bayesian.html"
+    )
+  )
+  update_topics(
+    path = path,
+    mock = list(meta = meta)
+  )
+  expect_equal(
+    sort(list.files(path)),
+    sort(c("bayesian", "bayesian.html", "hpc", "hpc.html", "index.html"))
+  )
+  out <- readLines(file.path(path, "index.html"))
+  expect_true(any(grepl("bayesian.html", out, fixed = TRUE)))
+  expect_true(any(grepl("hpc.html", out, fixed = TRUE)))
+  out <- readLines(file.path(path, "hpc.html"))
+  expect_false(any(grepl("nope", out, fixed = TRUE)))
+  expect_true(any(grepl("crew", out, fixed = TRUE)))
+  expect_false(any(grepl("stantargets", out, fixed = TRUE)))
+  expect_false(any(grepl("jagstargets", out, fixed = TRUE)))
+  out <- readLines(file.path(path, "bayesian.html"))
+  expect_false(any(grepl("nope", out, fixed = TRUE)))
+  expect_false(any(grepl("crew", out, fixed = TRUE)))
+  expect_true(any(grepl("stantargets", out, fixed = TRUE)))
+  expect_true(any(grepl("jagstargets", out, fixed = TRUE)))
+})