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", tags = c("tag1", "tag2"), metadata = list(a = "a"))
     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")
   })
 
@@ -127,6 +134,7 @@ test_api_meta <- function(board) {
     testthat::expect_vector(meta$user, list())
     testthat::expect_vector(meta$local, list())
   })
+
 }
 
 #' @export

R/pin-read-write.R

@@ -52,6 +52,8 @@ pin_read <- function(board, name, version = NULL, hash = NULL, ...) {
 #'   others can understand what the pin contains. If omitted, a brief
 #'   description of the contents will be automatically generated.
 #' @param description A detailed description of the pin contents.
+#' @param tags A character vector of tags for the pin; most important for
+#'   discoverability on shared boards.
 #' @param metadata A list containing additional metadata to store with the pin.
 #'   When retrieving the pin, this will be stored in the `user` key, to
 #'   avoid potential clashes with the metadata that pins itself uses.
@@ -67,6 +69,7 @@ pin_write <- function(board, x,
                       type = NULL,
                       title = NULL,
                       description = NULL,
+                      tags = NULL,
                       metadata = NULL,
                       versioned = NULL,
                       ...) {
@@ -82,6 +85,7 @@ pin_write <- function(board, x,
       abort("Must supply `name` when `x` is an expression")
     }
   }
+  check_tags(tags)
   check_metadata(metadata)
   if (!is_string(name)) {
     abort("`name` must be a string")
@@ -100,6 +104,7 @@ pin_write <- function(board, x,
     paths = path,
     type = type,
     title = title %||% default_title(name, data = x),
+    tags = tags,
     description = description
   )
   meta$user <- metadata
@@ -246,6 +251,11 @@ check_name <- function(x) {
     abort("`name` must not contain slashes", class = "pins_check_name")
   }
 }
+check_tags <- function(x) {
+  if (!is.null(x) && !is_character(x)) {
+    abort("`tags` must be a character vector")
+  }
+}
 check_metadata <- function(x) {
   if (!is.null(x) && !is_bare_list(x)) {
     abort("`metadata` must be a list")

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