Add tags to metadata

R/meta.R

@@ -32,14 +32,19 @@ write_meta <- function(x, path) {
 
 # pin metadata ------------------------------------------------------------
 
-standard_meta <- function(paths, type, title = NULL, description = NULL) {
+standard_meta <- function(paths,
+                          type,
+                          title = NULL,
+                          description = NULL,
+                          tags = NULL) {
   list(
     file = fs::path_file(paths),
     file_size = as.integer(fs::file_size(paths)),
     pin_hash = pin_hash(paths),
     type = type,
     title = title,
     description = description,
+    tags = tags,
     created = format(Sys.time(), "%Y%m%dT%H%M%SZ", tz = "UTC"),
     api_version = 1
   )
@@ -80,16 +85,17 @@ default_title <- function(name, data = NULL, path = NULL) {
 
   paste0(name, ": ", desc)
 }
+
 friendly_type <- function(x) {
   switch(typeof(x),
-    logical = "logical vector",
-    integer = "integer vector",
-    numeric = ,
-    double = "double vector",
-    complex = "complex vector",
-    character = "character vector",
-    raw = "raw vector",
-    list = "list",
-    typeof(x)
+         logical = "logical vector",
+         integer = "integer vector",
+         numeric = ,
+         double = "double vector",
+         complex = "complex vector",
+         character = "character vector",
+         raw = "raw vector",
+         list = "list",
+         typeof(x)
   )
 }

R/pin-meta.R

@@ -8,9 +8,10 @@
 #'   * `$file` - names of files stored in the pin.
 #'   * `$file_size` - size of each file.
 #'   * `$pin_hash` - hash of pin contents.
-#'   * `$type` - type of pin, "rds", "csv", etc
+#'   * `$type` - type of pin: "rds", "csv", etc
 #'   * `$title` - pin title
 #'   * `$description` - pin description
+#'   * `$tags` - pin tags
 #'   * `$created` - date this (version of the pin) was created
 #'   * `$api_version` - API version used by pin
 #'
@@ -35,6 +36,11 @@
 #' b %>% pin_meta("mtcars")
 #' # Get path to underlying data
 #' b %>% pin_download("mtcars")
+#'
+#' # Use tags instead
+#' b %>% pin_write(head(mtcars), "mtcars", tags = c("fuel-efficiency", "automotive"))
+#' b %>% pin_meta("mtcars")
+#'
 pin_meta <- function(board, name, version = NULL, ...) {
   check_board(board, "pin_meta()", "pin_info()")
   UseMethod("pin_meta")
@@ -85,11 +91,12 @@ local_meta <- function(x, name, dir, url = NULL, version = 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"))
+    name <- local_pin(board, 1, title = "title", description = "desc", metadata = list(a = "a"), tags = c("tag1", "tag2"))
     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$user$a, "a")
   })
 
@@ -110,6 +117,15 @@ 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)
 
@@ -127,6 +143,7 @@ test_api_meta <- function(board) {
     testthat::expect_vector(meta$user, list())
     testthat::expect_vector(meta$local, list())
   })
+
 }
 
 #' @export

R/pin-read-write.R

@@ -60,6 +60,8 @@ pin_read <- function(board, name, version = NULL, hash = NULL, ...) {
 #'   lists and rds for everything else.
 #' @param versioned Should the pin be versioned? The default, `NULL`, will
 #'   use the default for `board`
+#' @param tags A character vector of tags for the pin; most important for
+#'   discoverability on shared boards.
 #' @rdname pin_read
 #' @export
 pin_write <- function(board, x,
@@ -69,6 +71,7 @@ pin_write <- function(board, x,
                       description = NULL,
                       metadata = NULL,
                       versioned = NULL,
+                      tags = NULL,
                       ...) {
   ellipsis::check_dots_used()
   check_board(board, "pin_write()", "pin()")
@@ -83,6 +86,7 @@ pin_write <- function(board, x,
     }
   }
   check_metadata(metadata)
+  check_tags(tags)
   if (!is_string(name)) {
     abort("`name` must be a string")
   }
@@ -100,7 +104,8 @@ pin_write <- function(board, x,
     paths = path,
     type = type,
     title = title %||% default_title(name, data = x),
-    description = description
+    description = description,
+    tags = tags
   )
   meta$user <- metadata
 
@@ -248,7 +253,12 @@ check_name <- function(x) {
 }
 check_metadata <- function(x) {
   if (!is.null(x) && !is_bare_list(x)) {
-    abort("`metadata` must be a list")
+    abort("`metadata` must be a list.")
+  }
+}
+check_tags <- function(x) {
+  if (!is.null(x) && !is_character(x)) {
+    abort("`tags` must be a character vector.")
   }
 }
 check_hash <- function(meta, hash) {

tests/testthat/_snaps/board_azure_adls2.md

@@ -12,6 +12,22 @@
     Output
       [1] "AzureStor"
 
+# metadata checking functions give correct errors
+
+    `tags` must be a character vector.
+
+---
+
+    `metadata` must be a list.
+
+---
+
+    `tags` must be a character vector.
+
+---
+
+    `metadata` must be a list.
+
 # can deparse
 
     Code

tests/testthat/_snaps/board_azure_blob.md

@@ -12,6 +12,22 @@
     Output
       [1] "AzureStor"
 
+# metadata checking functions give correct errors
+
+    `tags` must be a character vector.
+
+---
+
+    `metadata` must be a list.
+
+---
+
+    `tags` must be a character vector.
+
+---
+
+    `metadata` must be a list.
+
 # can deparse
 
     Code

tests/testthat/_snaps/board_azure_file.md

@@ -12,6 +12,22 @@
     Output
       [1] "AzureStor"
 
+# metadata checking functions give correct errors
+
+    `tags` must be a character vector.
+
+---
+
+    `metadata` must be a list.
+
+---
+
+    `tags` must be a character vector.
+
+---
+
+    `metadata` must be a list.
+
 # can deparse
 
     Code

tests/testthat/_snaps/board_folder.md

@@ -5,6 +5,14 @@
     Output
       character(0)
 
+# metadata checking functions give correct errors
+
+    `tags` must be a character vector.
+
+---
+
+    `metadata` must be a list.
+
 # has useful print method
 
     Code

tests/testthat/_snaps/board_s3.md

@@ -12,6 +12,14 @@
     Output
       [1] "paws.storage"
 
+# metadata checking functions give correct errors
+
+    `tags` must be a character vector.
+
+---
+
+    `metadata` must be a list.
+
 # can deparse
 
     Code

tests/testthat/_snaps/meta.md

@@ -1,12 +1,13 @@
 # standard metadata is useful
 
-    List of 8
+    List of 9
      $ file       : chr "df.rds"
      $ file_size  : int 200
      $ pin_hash   : chr "db696042be80dbb4"
      $ type       : chr "arrow"
      $ title      : chr "title"
      $ description: NULL
+     $ tags       : NULL
      $ created    : chr "<TODAY>"
      $ api_version: num 1
 

tests/testthat/_snaps/pin-read-write.md

@@ -28,7 +28,7 @@
       pin_write(board, mtcars, name = "mtcars", metadata = 1)
     Condition
       Error in `check_metadata()`:
-      ! `metadata` must be a list
+      ! `metadata` must be a list.
 
 # pin_write() noisily generates name and type