Add new urls to metadata (#795)

* Add new `urls` to metadata * Redocument * Update tests * Add URLs to Connect preview * Update NEWS * Update html bundle tests * Apply suggestions from code review Co-authored-by: Hadley Wickham <h.wickham@gmail.com> * Only run these tests for inputs once (not every backend) * Back to using {{{urls}}} in html preview * Update tests * Remove unnecessary parens --------- Co-authored-by: Hadley Wickham <h.wickham@gmail.com>
rstudio · Oct 19, 2023 · f6c6f50 · f6c6f50
1 parent 1f61a84
commit f6c6f50
Show file tree

Hide file tree

Showing 21 changed files with 60 additions and 106 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -9,6 +9,8 @@
 * Removed content and user caches for Connect altogether. Now, we look up 
   usernames and content on the Connect server every time (#793).
 
+* Added new `urls` item to metadata for a pin (#795).
+
 # pins 1.2.2
 
 * Fixed how dots are checked in `pin_write()` to make user-facing messages more 

diff --git a/R/board_connect_bundle.R b/R/board_connect_bundle.R
@@ -60,6 +60,8 @@ rsc_bundle_preview_index <- function(board, name, x, metadata) {
     pin_files = paste0("<a href=\"", metadata$file, "\">", metadata$file, "</a>", collapse = ", "),
     data_preview = jsonlite::toJSON(data_preview, auto_unbox = TRUE),
     data_preview_style = if (is.data.frame(x)) "" else "display:none",
+    urls = paste0("<a href=\"", metadata$urls, "\">", metadata$urls, "</a>", collapse = ", "),
+    url_preview_style = if (!is.null(metadata$urls)) "" else "display:none",
     pin_name = paste0(owner, "/", name$name),
     pin_metadata = list(
       as_yaml = yaml::as.yaml(metadata),

diff --git a/R/meta.R b/R/meta.R
@@ -36,7 +36,8 @@ standard_meta <- function(paths,
                           type,
                           title = NULL,
                           description = NULL,
-                          tags = NULL) {
+                          tags = NULL,
+                          urls = NULL) {
   list(
     file = fs::path_file(paths),
     file_size = as.integer(fs::file_size(paths)),
@@ -45,6 +46,7 @@ standard_meta <- function(paths,
     title = title,
     description = description,
     tags = if (is.null(tags)) tags else as.list(tags),
+    urls = if (is.null(urls)) urls else as.list(urls),
     created = format(Sys.time(), "%Y%m%dT%H%M%SZ", tz = "UTC"),
     api_version = 1L
   )

diff --git a/R/pin-meta.R b/R/pin-meta.R
@@ -12,6 +12,7 @@
 #'   * `$title` - pin title
 #'   * `$description` - pin description
 #'   * `$tags` - pin tags
+#'   * `$urls` - URLs for more info on pin
 #'   * `$created` - date this (version of the pin) was created
 #'   * `$api_version` - API version used by pin
 #'
@@ -97,12 +98,13 @@ empty_local_meta <- local_meta(x = NULL, name = NULL, dir = NULL)
 
 test_api_meta <- function(board) {
   testthat::test_that("can round-trip pin metadata", {
-    name <- local_pin(board, 1, title = "title", description = "desc", metadata = list(a = "a"), tags = c("tag1", "tag2"))
+    name <- local_pin(board, 1, title = "title", description = "desc", metadata = list(a = "a"), tags = c("tag1", "tag2"), urls = "https://posit.co/")
     meta <- pin_meta(board, name)
     testthat::expect_equal(meta$name, name)
     testthat::expect_equal(meta$title, "title")
     testthat::expect_equal(meta$description, "desc")
     testthat::expect_equal(meta$tags, c("tag1", "tag2"))
+    testthat::expect_equal(meta$urls, "https://posit.co/")
     testthat::expect_equal(meta$user$a, "a")
   })
 
@@ -129,15 +131,6 @@ test_api_meta <- function(board) {
     )
   })
 
-  testthat::test_that("metadata checking functions give correct errors", {
-    testthat::expect_snapshot_error(
-      local_pin(board, 1, title = "title", tags = list(a = "a"))
-    )
-    testthat::expect_snapshot_error(
-      local_pin(board, 1, title = "title", metadata = c("tag1", "tag2"))
-    )
-  })
-
   testthat::test_that("pin_meta() returns pins_meta object", {
     name <- local_pin(board, 1)
 

diff --git a/R/pin-read-write.R b/R/pin-read-write.R
@@ -64,6 +64,8 @@ pin_read <- function(board, name, version = NULL, hash = NULL, ...) {
 #'   use the default for `board`
 #' @param tags A character vector of tags for the pin; most important for
 #'   discoverability on shared boards.
+#' @param urls A character vector of URLs for more info on the pin, such as a
+#'   link to a wiki or other documentation.
 #' @param force_identical_write Store the pin even if the pin contents are
 #'   identical to the last version (compared using the hash). Only the pin
 #'   contents are compared, not the pin metadata. Defaults to `FALSE`.
@@ -78,6 +80,7 @@ pin_write <- function(board, x,
                       metadata = NULL,
                       versioned = NULL,
                       tags = NULL,
+                      urls = NULL,
                       force_identical_write = FALSE) {
   check_board(board, "pin_write", "pin")
   dots <- list2(...)
@@ -96,6 +99,7 @@ pin_write <- function(board, x,
   }
   check_metadata(metadata)
   check_character(tags, allow_null = TRUE)
+  check_character(urls, allow_null = TRUE)
   if (!is_string(name)) {
     abort("`name` must be a string")
   }
@@ -114,7 +118,8 @@ pin_write <- function(board, x,
     type = type,
     title = title %||% default_title(name, data = x),
     description = description,
-    tags = tags
+    tags = tags,
+    urls = urls
   )
   meta$user <- metadata
 

diff --git a/inst/preview/index.html b/inst/preview/index.html
@@ -44,7 +44,12 @@ <h3>{{{pin_name}}}</h3>
          <pre>{{{as_yaml}}}</pre>
        </details>
        {{/pin_metadata}}
-     </section>
+    </section>
+
+    <section style="{{url_preview_style}}">
+      <h3>Learn more about this pin at:</h3>
+      <p>{{{urls}}}</p>
+    </section>
 
     <section>
     <h3>R Code</h3>

diff --git a/man/pin_meta.Rd b/man/pin_meta.Rd
diff --git a/man/pin_read.Rd b/man/pin_read.Rd
diff --git a/tests/testthat/_snaps/board_azure_adls2.md b/tests/testthat/_snaps/board_azure_adls2.md
@@ -12,22 +12,6 @@
     Output
       [1] "AzureStor"
 
-# metadata checking functions give correct errors
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
----
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
 # can deparse
 
     Code

diff --git a/tests/testthat/_snaps/board_azure_blob.md b/tests/testthat/_snaps/board_azure_blob.md
@@ -12,22 +12,6 @@
     Output
       [1] "AzureStor"
 
-# metadata checking functions give correct errors
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
----
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
 # can deparse
 
     Code

diff --git a/tests/testthat/_snaps/board_azure_file.md b/tests/testthat/_snaps/board_azure_file.md
@@ -12,22 +12,6 @@
     Output
       [1] "AzureStor"
 
-# metadata checking functions give correct errors
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
----
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
 # can deparse
 
     Code

diff --git a/tests/testthat/_snaps/board_connect.md b/tests/testthat/_snaps/board_connect.md
@@ -5,14 +5,6 @@
     Output
       [1] "rsconnect"
 
-# metadata checking functions give correct errors
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
 # get useful error for rebranding
 
     `board_rsconnect()` was deprecated in pins 1.1.0.

diff --git a/tests/testthat/_snaps/board_connect_bundle.md b/tests/testthat/_snaps/board_connect_bundle.md
@@ -38,7 +38,7 @@
              <b>Format:</b> rds &bull;
              <b>API:</b> v1.0
            </p>
-           <p></p>
+           <p>Some simple data to test with</p>
            <p>Download data: <a href="test.csv">test.csv</a></p>
            <details>
              <summary>Raw metadata</summary>
@@ -47,14 +47,22 @@
     pin_hash: 77fee172a9275a62
     type: rds
     title: 'test: a pinned 2 x 2 data frame'
-    desctiption: Some simple data to test with
+    description: Some simple data to test with
+    urls:
+    - https://posit.co/
+    - https://www.tidyverse.org/
     created: 20211111T113956Z
     api_version: '1.0'
     user:
       my_meta: User defined metadata
     </pre>
            </details>
-         </section>
+        </section>
+
+        <section style="">
+          <h3>Learn more about this pin at:</h3>
+          <p><a href="https://posit.co/">https://posit.co/</a>, <a href="https://www.tidyverse.org/">https://www.tidyverse.org/</a></p>
+        </section>
 
         <section>
         <h3>R Code</h3>

diff --git a/tests/testthat/_snaps/board_folder.md b/tests/testthat/_snaps/board_folder.md
@@ -5,14 +5,6 @@
     Output
       character(0)
 
-# metadata checking functions give correct errors
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
 # has useful print method
 
     Code

diff --git a/tests/testthat/_snaps/board_gcs.md b/tests/testthat/_snaps/board_gcs.md
@@ -12,14 +12,6 @@
     Output
       [1] "googleCloudStorageR"
 
-# metadata checking functions give correct errors
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
 # can deparse
 
     Code

diff --git a/tests/testthat/_snaps/board_gdrive.md b/tests/testthat/_snaps/board_gdrive.md
@@ -5,11 +5,3 @@
     Output
       [1] "googledrive"
 
-# metadata checking functions give correct errors
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
diff --git a/tests/testthat/_snaps/board_s3.md b/tests/testthat/_snaps/board_s3.md
@@ -12,14 +12,6 @@
     Output
       [1] "paws.storage"
 
-# metadata checking functions give correct errors
-
-    `tags` must be a character vector or `NULL`, not a list.
-
----
-
-    `metadata` must be a list or `NULL`, not a character vector.
-
 # can deparse
 
     Code

diff --git a/tests/testthat/_snaps/meta.md b/tests/testthat/_snaps/meta.md
@@ -1,13 +1,14 @@
 # standard metadata is useful
 
-    List of 9
+    List of 10
      $ file       : chr "df.rds"
      $ file_size  : int 200
      $ pin_hash   : chr "db696042be80dbb4"
      $ type       : chr "arrow"
      $ title      : chr "title"
      $ description: NULL
      $ tags       : NULL
+     $ urls       : NULL
      $ created    : chr "<TODAY>"
      $ api_version: int 1
 

diff --git a/tests/testthat/_snaps/pin-read-write.md b/tests/testthat/_snaps/pin-read-write.md
@@ -34,6 +34,21 @@
     Condition
       Error in `pin_write()`:
       ! `metadata` must be a list or `NULL`, not the number 1.
+    Code
+      pin_write(board, mtcars, title = "title", tags = list(a = "a"))
+    Condition
+      Error in `pin_write()`:
+      ! `tags` must be a character vector or `NULL`, not a list.
+    Code
+      pin_write(board, mtcars, title = "title", urls = list(a = "a"))
+    Condition
+      Error in `pin_write()`:
+      ! `urls` must be a character vector or `NULL`, not a list.
+    Code
+      pin_write(board, mtcars, title = "title", metadata = c("tag1", "tag2"))
+    Condition
+      Error in `pin_write()`:
+      ! `metadata` must be a list or `NULL`, not a character vector.
 
 # pin_write() noisily generates name and type
 

diff --git a/tests/testthat/test-board_connect_bundle.R b/tests/testthat/test-board_connect_bundle.R
@@ -28,7 +28,8 @@ test_that("generates index files", {
     pin_hash = "77fee172a9275a62",
     type = "rds",
     title = "test: a pinned 2 x 2 data frame",
-    desctiption = "Some simple data to test with",
+    description = "Some simple data to test with",
+    urls = c("https://posit.co/", "https://www.tidyverse.org/"),
     created = "20211111T113956Z",
     api_version = "1.0",
     user = list(my_meta = "User defined metadata")

diff --git a/tests/testthat/test-pin-read-write.R b/tests/testthat/test-pin-read-write.R
@@ -44,6 +44,9 @@ test_that("useful errors on bad inputs", {
     pin_write(board, mtcars, name = "mtcars", "json")
     pin_write(board, mtcars, name = "mtcars", type = "froopy-loops")
     pin_write(board, mtcars, name = "mtcars", metadata = 1)
+    pin_write(board, mtcars, title = "title", tags = list(a = "a"))
+    pin_write(board, mtcars, title = "title", urls = list(a = "a"))
+    pin_write(board, mtcars, title = "title", metadata = c("tag1", "tag2"))
   })
 })