From 584af2a39aa9b8367fe858e9d3133c0ecc36c839 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Fri, 18 Nov 2022 13:17:46 -0700 Subject: [PATCH] Add new `write_board_manifest()` function (#661) * New `board_manifest()` function * Add methods for writeable boards (except Connect) * Redocument * Add test * Bump to updated version of GH actions * Update NEWS * Vectorize `append_slash()` * Fix typo * Coerce to character in test * Redocument * Fix function name in example * Fix methods * Add tests for manifest file * Update tests * Namespace for testing * Document behavior with yaml file name * Only test contents of manifest for local board * Update tests for manifest * Update docs about bad behavior * More unspecified behavior * `_pins.yaml` is not a pin * Update NEWS * Update `azure_ls()` to only look for dirs * One function now works for all container types * Fix `azure_dir_exist()` * Document no versioning for manifest * Fix `azure_dir_exist()` but MORE * Update pkgdown * Update NEWS * Apply suggestions from code review Co-authored-by: Hadley Wickham * Code review on docs, return * Redocument * More than one version in manifest test Co-authored-by: Hadley Wickham --- NAMESPACE | 8 +++ NEWS.md | 5 ++ R/board.R | 93 +++++++++++++++++++++++++ R/board_azure.R | 24 +++++-- R/board_folder.R | 8 +++ R/board_ms365.R | 12 +++- R/board_s3.R | 49 +++++++------ R/board_url.R | 7 +- R/testthat.R | 17 +++++ R/utils.R | 6 ++ _pkgdown.yml | 1 + man/write_board_manifest.Rd | 54 ++++++++++++++ man/write_board_manifest_yaml.Rd | 25 +++++++ tests/testthat/test-board_azure_adls2.R | 1 + tests/testthat/test-board_azure_blob.R | 1 + tests/testthat/test-board_azure_file.R | 1 + tests/testthat/test-board_folder.R | 29 ++++++++ tests/testthat/test-board_ms365.R | 1 + tests/testthat/test-board_s3.R | 1 + tests/testthat/test-utils.R | 7 ++ 20 files changed, 321 insertions(+), 29 deletions(-) create mode 100644 man/write_board_manifest.Rd create mode 100644 man/write_board_manifest_yaml.Rd diff --git a/NAMESPACE b/NAMESPACE index 5ef13bb2d..9aab11fca 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -134,6 +134,12 @@ S3method(required_pkgs,pins_board_ms365) S3method(required_pkgs,pins_board_rsconnect) S3method(required_pkgs,pins_board_s3) S3method(str,pins_hidden) +S3method(write_board_manifest_yaml,default) +S3method(write_board_manifest_yaml,pins_board_azure) +S3method(write_board_manifest_yaml,pins_board_folder) +S3method(write_board_manifest_yaml,pins_board_ms365) +S3method(write_board_manifest_yaml,pins_board_s3) +S3method(write_board_manifest_yaml,pins_board_url) export("%>%") export(board_azure) export(board_browse) @@ -216,6 +222,8 @@ export(pin_write) export(required_pkgs) export(ui_addin_pin_find) export(ui_connection_create) +export(write_board_manifest) +export(write_board_manifest_yaml) import(rlang) importFrom(generics,required_pkgs) importFrom(glue,glue) diff --git a/NEWS.md b/NEWS.md index 9979b1d08..16999ab5b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -15,6 +15,11 @@ of files on disk. This means caches will no longer persist between sessions but will be much less likely to end up in a broken state (#667). +* Added `write_board_manifest()` to write a manifest file `_pins.yaml` + recording all pins and their versions to the board's root directory. + This function only works for boards that are not read-only + (#661, based on work of @ijlyttle). + # pins 1.0.3 diff --git a/R/board.R b/R/board.R index bbc2da549..c2335d629 100644 --- a/R/board.R +++ b/R/board.R @@ -160,6 +160,99 @@ board_deparse.pins_board <- function(board, ...) { abort("This board doesn't support deparsing") } +#' Write board manifest file to board's root directory +#' +#' A board manifest file records all the pins, along with their +#' versions, stored on a board. +#' This can be useful for a board built using, for example, +#' [board_folder()] or [board_s3()], then served as a website, +#' such that others can consume using [board_url()]. +#' The manifest file is _not_ versioned like a pin is, and this function +#' will overwrite any existing `_pins.yaml` file on your board. It is +#' your responsibility as the user to keep the manifest up to date. +#' +#' @details This function is not supported for read-only boards. +#' It is called for the side-effect of writing a manifest file, +#' `_pins.yaml`, to the root directory of the `board`. (This will +#' not work in the unlikely event that you attempt to create a pin +#' called `"_pins.yaml"`.) +#' +#' The behavior of the legacy API (for example, [pin_find()]) is unspecified +#' once you have written a board manifest file to a board's root directory. +#' We recommend you only use `write_board_manifest()` with modern boards. +#' +#' @param board A pin board that is *not* read-only. +#' @inheritParams pin_read +#' +#' @return The board, invisibly +#' @export +#' +#' @examples +#' board <- board_temp() +#' pin_write(board, mtcars, "mtcars-csv", type = "csv") +#' pin_write(board, mtcars, "mtcars-json", type = "json") +#' +#' write_board_manifest(board) +#' +#' # see the manifest's format: +#' fs::path(board$path, "_pins.yaml") %>% readLines() %>% cat(sep = "\n") +#' +#' # if you write another pin, the manifest file is out of date: +#' pin_write(board, 1:10, "nice-numbers", type = "json") +#' +#' # you decide when to update the manifest: +#' write_board_manifest(board) +#' +write_board_manifest <- function(board, ...) { + manifest <- make_manifest(board) + write_board_manifest_yaml(board, manifest, ...) + pins_inform("Manifest file written to root folder of board, as `{manifest_pin_yaml_filename}`") + invisible(board) +} + +manifest_pin_yaml_filename <- "_pins.yaml" + +make_manifest <- function(board) { + # given board, return named list: + # - names are pin names + # - values are relative paths to version directories + + pin_names <- pin_list(board) + + result <- map( + pin_names, + ~fs::path(.x, pin_versions(board, name = .x)$version) %>% + append_slash() %>% # versions usually don't include slash + as.list() + ) + names(result) <- pin_names + + result +} + +#' Write a manifest YAML file for a board +#' +#' This is a low-level function that powers [write_board_manifest()]. It is +#' needed primarily for folks developing new board types, and should not +#' generally be called directly. +#' +#' @return `write_board_manifest_yaml()` is called for its side-effect of +#' writing a manifest YAML file. +#' @export +#' @keywords internal +#' @inheritParams write_board_manifest +#' @param manifest Contents to be written to the manifest file, as a list. +#' +write_board_manifest_yaml <- function(board, manifest, ...) { + ellipsis::check_dots_used() + UseMethod("write_board_manifest_yaml") +} + +#' @export +write_board_manifest_yaml.default <- function(board, manifest, ...) { + abort(glue::glue("Manifest not supported for {class(board)[[1]]}")) +} + # helpers ----------------------------------------------------------------- diff --git a/R/board_azure.R b/R/board_azure.R index 64bf4536c..1bef74a93 100644 --- a/R/board_azure.R +++ b/R/board_azure.R @@ -201,6 +201,24 @@ board_deparse.pins_board_azure <- function(board, ...) { expr(board_azure(!!container, path = !!board$path)) } +#' @export +write_board_manifest_yaml.pins_board_azure <- function(board, manifest, ...) { + + paths <- AzureStor::list_storage_files(board$container, info = "name") + + if (manifest_pin_yaml_filename %in% paths) { + AzureStor::delete_storage_file( + board$container, + manifest_pin_yaml_filename, + confirm = FALSE + ) + } + + temp_file <- withr::local_tempfile() + yaml::write_yaml(manifest, file = temp_file) + azure_upload_file(board, src = temp_file, dest = manifest_pin_yaml_filename) +} + #' @rdname required_pkgs.pins_board #' @export required_pkgs.pins_board_azure <- function(x, ...) { @@ -226,13 +244,11 @@ azure_ls <- function(board, dir = "") { paths <- AzureStor::list_storage_files( board$container, dir = dir, - recursive = FALSE, - info = "name" + recursive = FALSE ) - unique(fs::path_file(paths)) + unique(fs::path_file(paths$name[paths$isdir] %||% character(0))) } -# TODO: implement this in AzureStor azure_dir_exists <- function(board, path) { dir <- azure_normalize_path(board, path) AzureStor::storage_dir_exists(board$container, dir) diff --git a/R/board_folder.R b/R/board_folder.R index 530dbb548..ff27710e6 100644 --- a/R/board_folder.R +++ b/R/board_folder.R @@ -124,3 +124,11 @@ board_deparse.pins_board_folder <- function(board, ...) { path <- check_board_deparse(board, "path") expr(board_folder(path = !!as.character(path))) } + +#' @export +write_board_manifest_yaml.pins_board_folder <- function(board, manifest, ...) { + yaml::write_yaml( + manifest, + file = fs::path(board$path, manifest_pin_yaml_filename) + ) +} diff --git a/R/board_ms365.R b/R/board_ms365.R index e5e1e530a..c0703d07f 100644 --- a/R/board_ms365.R +++ b/R/board_ms365.R @@ -94,7 +94,8 @@ board_ms365 <- function(drive, path, versioned = TRUE, cache = NULL, delete_by_i } cache <- cache %||% board_cache_path(paste0("ms365-", hash(folder$properties$id))) - new_board_v1("pins_board_ms365", + new_board_v1( + "pins_board_ms365", folder = folder, path = path, cache = cache, @@ -215,6 +216,13 @@ pin_store.pins_board_ms365 <- function(board, name, paths, metadata, name } +#' @export +write_board_manifest_yaml.pins_board_ms365 <- function(board, manifest, ...) { + temp_file <- withr::local_tempfile() + yaml::write_yaml(manifest, file = temp_file) + board$folder$upload(temp_file, manifest_pin_yaml_filename) +} + #' @rdname required_pkgs.pins_board #' @export required_pkgs.pins_board_ms365 <- function(x, ...) { @@ -222,7 +230,7 @@ required_pkgs.pins_board_ms365 <- function(x, ...) { "Microsoft365R" } -# helpers +# Helpers ----------------------------------------------------------------- # list all the directories inside 'path', which is assumed to live in the board folder ms365_list_dirs <- function(board, path = "") { diff --git a/R/board_s3.R b/R/board_s3.R index 991575acb..dc5fbd046 100644 --- a/R/board_s3.R +++ b/R/board_s3.R @@ -85,17 +85,17 @@ #' #' } board_s3 <- function( - bucket, - prefix = NULL, - versioned = TRUE, - access_key = NULL, - secret_access_key = NULL, - session_token = NULL, - credential_expiration = NULL, - profile = NULL, - region = NULL, - endpoint = NULL, - cache = NULL) { + bucket, + prefix = NULL, + versioned = TRUE, + access_key = NULL, + secret_access_key = NULL, + session_token = NULL, + credential_expiration = NULL, + profile = NULL, + region = NULL, + endpoint = NULL, + cache = NULL) { check_installed("paws.storage") @@ -118,12 +118,12 @@ board_s3 <- function( cache <- cache %||% board_cache_path(paste0("s3-", bucket)) new_board_v1("pins_board_s3", - name = "s3", - bucket = bucket, - prefix = prefix, - svc = svc, - cache = cache, - versioned = versioned + name = "s3", + bucket = bucket, + prefix = prefix, + svc = svc, + cache = cache, + versioned = versioned ) } @@ -134,11 +134,11 @@ board_s3_test <- function(...) { ) board_s3("pins-test-hadley", - region = "us-east-2", - cache = tempfile(), - access_key = Sys.getenv("PINS_AWS_ACCESS_KEY"), - secret_access_key = Sys.getenv("PINS_AWS_SECRET_ACCESS_KEY"), - ... + region = "us-east-2", + cache = tempfile(), + access_key = Sys.getenv("PINS_AWS_ACCESS_KEY"), + secret_access_key = Sys.getenv("PINS_AWS_SECRET_ACCESS_KEY"), + ... ) } @@ -258,6 +258,11 @@ empty_string_to_null <- function(x) { if (is.null(x) || nchar(x) == 0) NULL else x } +#' @export +write_board_manifest_yaml.pins_board_s3 <- function(board, manifest, ...) { + s3_upload_yaml(board, key = manifest_pin_yaml_filename, yaml = manifest, ...) +} + #' @rdname required_pkgs.pins_board #' @export required_pkgs.pins_board_s3 <- function(x, ...) { diff --git a/R/board_url.R b/R/board_url.R index e15fb5d31..8e7161917 100644 --- a/R/board_url.R +++ b/R/board_url.R @@ -137,7 +137,12 @@ pin_delete.pins_board_url <- function(board, names, ...) { #' @export pin_store.pins_board_url <- function(board, name, paths, metadata, - versioned = NULL, ...) { + versioned = NULL, ...) { + abort_board_read_only("board_url") +} + +#' @export +write_board_manifest_yaml.pins_board_url <- function(board, manifest, ...) { abort_board_read_only("board_url") } diff --git a/R/testthat.R b/R/testthat.R index c5118c422..01d009de2 100644 --- a/R/testthat.R +++ b/R/testthat.R @@ -175,6 +175,23 @@ test_api_versioning <- function(board) { } +test_api_manifest <- function(board) { + # assume that test_api_basic() has passed + name1 <- local_pin(board, 1:10, type = "csv") + name2 <- local_pin(board, 11:20, type = "json") + write_board_manifest(board) + + testthat::test_that("manifest is not a pin", { + testthat::expect_false(pin_exists(board, manifest_pin_yaml_filename)) + testthat::expect_false(manifest_pin_yaml_filename %in% pin_list(board)) + testthat::expect_error( + pin_meta(board, manifest_pin_yaml_filename), + class = "pins_pin_missing" + ) + }) + +} + # errors live here for now since they're closely bound to the tests abort_pin_missing <- function(name) { diff --git a/R/utils.R b/R/utils.R index 24fa387a2..e5199c38c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -21,6 +21,12 @@ is_url <- function(x) { grepl("^http://|^https://", x) } +append_slash <- function(x) { + has_slash <- grepl("/$", x) + x[!has_slash] <- paste0(x[!has_slash], "/") + x +} + is_testing <- function() { identical(Sys.getenv("TESTTHAT"), "true") } diff --git a/_pkgdown.yml b/_pkgdown.yml index 032022c54..6694275d2 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -36,6 +36,7 @@ reference: - title: Other functions contents: - cache_browse + - write_board_manifest - title: Legacy API desc: > diff --git a/man/write_board_manifest.Rd b/man/write_board_manifest.Rd new file mode 100644 index 000000000..5a13568db --- /dev/null +++ b/man/write_board_manifest.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/board.R +\name{write_board_manifest} +\alias{write_board_manifest} +\title{Write board manifest file to board's root directory} +\usage{ +write_board_manifest(board, ...) +} +\arguments{ +\item{board}{A pin board that is \emph{not} read-only.} + +\item{...}{Additional arguments passed on to methods for a specific board.} +} +\value{ +The board, invisibly +} +\description{ +A board manifest file records all the pins, along with their +versions, stored on a board. +This can be useful for a board built using, for example, +\code{\link[=board_folder]{board_folder()}} or \code{\link[=board_s3]{board_s3()}}, then served as a website, +such that others can consume using \code{\link[=board_url]{board_url()}}. +The manifest file is \emph{not} versioned like a pin is, and this function +will overwrite any existing \verb{_pins.yaml} file on your board. It is +your responsibility as the user to keep the manifest up to date. +} +\details{ +This function is not supported for read-only boards. +It is called for the side-effect of writing a manifest file, +\verb{_pins.yaml}, to the root directory of the \code{board}. (This will +not work in the unlikely event that you attempt to create a pin +called \code{"_pins.yaml"}.) + +The behavior of the legacy API (for example, \code{\link[=pin_find]{pin_find()}}) is unspecified +once you have written a board manifest file to a board's root directory. +We recommend you only use \code{write_board_manifest()} with modern boards. +} +\examples{ +board <- board_temp() +pin_write(board, mtcars, "mtcars-csv", type = "csv") +pin_write(board, mtcars, "mtcars-json", type = "json") + +write_board_manifest(board) + +# see the manifest's format: +fs::path(board$path, "_pins.yaml") \%>\% readLines() \%>\% cat(sep = "\n") + +# if you write another pin, the manifest file is out of date: +pin_write(board, 1:10, "nice-numbers", type = "json") + +# you decide when to update the manifest: +write_board_manifest(board) + +} diff --git a/man/write_board_manifest_yaml.Rd b/man/write_board_manifest_yaml.Rd new file mode 100644 index 000000000..33a19acaf --- /dev/null +++ b/man/write_board_manifest_yaml.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/board.R +\name{write_board_manifest_yaml} +\alias{write_board_manifest_yaml} +\title{Write a manifest YAML file for a board} +\usage{ +write_board_manifest_yaml(board, manifest, ...) +} +\arguments{ +\item{board}{A pin board that is \emph{not} read-only.} + +\item{manifest}{Contents to be written to the manifest file, as a list.} + +\item{...}{Additional arguments passed on to methods for a specific board.} +} +\value{ +\code{write_board_manifest_yaml()} is called for its side-effect of +writing a manifest YAML file. +} +\description{ +This is a low-level function that powers \code{\link[=write_board_manifest]{write_board_manifest()}}. It is +needed primarily for folks developing new board types, and should not +generally be called directly. +} +\keyword{internal} diff --git a/tests/testthat/test-board_azure_adls2.R b/tests/testthat/test-board_azure_adls2.R index 6e2f03d84..7c1fa2e69 100644 --- a/tests/testthat/test-board_azure_adls2.R +++ b/tests/testthat/test-board_azure_adls2.R @@ -2,6 +2,7 @@ board_adls <- board_azure_test(path = "", type = "dfs") test_api_basic(board_adls) test_api_versioning(board_adls) test_api_meta(board_adls) +test_api_manifest(board_adls) board_adls <- board_azure_test(path = "test/path", type = "dfs") test_api_basic(board_adls) diff --git a/tests/testthat/test-board_azure_blob.R b/tests/testthat/test-board_azure_blob.R index 5c8825b95..12acea3d9 100644 --- a/tests/testthat/test-board_azure_blob.R +++ b/tests/testthat/test-board_azure_blob.R @@ -2,6 +2,7 @@ board_blob <- board_azure_test(path = "", type = "blob") test_api_basic(board_blob) test_api_versioning(board_blob) test_api_meta(board_blob) +test_api_manifest(board_blob) board_blob2 <- board_azure_test(path = "test/path", type = "blob") test_api_basic(board_blob2) diff --git a/tests/testthat/test-board_azure_file.R b/tests/testthat/test-board_azure_file.R index 63dba4e81..e4ed5a1c0 100644 --- a/tests/testthat/test-board_azure_file.R +++ b/tests/testthat/test-board_azure_file.R @@ -2,6 +2,7 @@ board_file <- board_azure_test(path = "", type = "file") test_api_basic(board_file) test_api_versioning(board_file) test_api_meta(board_file) +test_api_manifest(board_file) board_file2 <- board_azure_test(path = "test/path", type = "file") test_api_basic(board_file2) diff --git a/tests/testthat/test-board_folder.R b/tests/testthat/test-board_folder.R index 82d906833..d803c0437 100644 --- a/tests/testthat/test-board_folder.R +++ b/tests/testthat/test-board_folder.R @@ -1,6 +1,7 @@ test_api_basic(board_temp()) test_api_versioning(board_temp(versioned = TRUE)) test_api_meta(board_temp()) +test_api_manifest(board_temp()) test_that("has useful print method", { path <- withr::local_tempfile() @@ -43,6 +44,34 @@ test_that("can deparse", { ) }) +test_that("contents of manifest match", { + b <- board_folder(withr::local_tempfile(), versioned = TRUE) + pin_write(b, mtcars, "mtcars-csv", type = "csv") + pin_write(b, head(mtcars), "mtcars-csv", type = "csv") + pin_write(b, mtcars, "mtcars-json", type = "json") + write_board_manifest(b) + + # names are correct + manifest <- yaml::read_yaml(fs::path(b$path, manifest_pin_yaml_filename)) + expect_identical(names(manifest), pin_list(b)) + + # numbers of versions are correct + expect_identical( + map(manifest, length), + list(`mtcars-csv` = 2L, `mtcars-json` = 1L) + ) + + # values (relative paths to versions) are correct + imap( + manifest, + ~ expect_identical( + .x, + append_slash(as.character(fs::path(.y, pin_versions(b, .y)$version))) + ) + ) +}) + + test_that("generates useful messages", { ui_loud() b <- board_temp() diff --git a/tests/testthat/test-board_ms365.R b/tests/testthat/test-board_ms365.R index 876bcec9a..41dffb0f2 100644 --- a/tests/testthat/test-board_ms365.R +++ b/tests/testthat/test-board_ms365.R @@ -2,6 +2,7 @@ board <- board_ms365_test_charpath(delete_by_item = TRUE) test_api_basic(board) test_api_versioning(board) test_api_meta(board) +test_api_manifest(board) board2 <- board_ms365_test_driveitem(delete_by_item = TRUE) test_api_basic(board2) diff --git a/tests/testthat/test-board_s3.R b/tests/testthat/test-board_s3.R index e3bf6cb41..2d016342b 100644 --- a/tests/testthat/test-board_s3.R +++ b/tests/testthat/test-board_s3.R @@ -2,6 +2,7 @@ test_api_basic(board_s3_test()) test_api_versioning(board_s3_test()) test_api_meta(board_s3_test()) test_api_basic(board_s3_test(prefix = "prefixed/")) +test_api_manifest(board_s3_test()) test_that("can deparse", { board <- board_s3_test() diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index e71a8cd78..801d54bc9 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -11,3 +11,10 @@ test_that("write_yaml can write non-UTF8 data", { y <- yaml::read_yaml(path) expect_equal(y, list("fa\u00e7ile" = "fa\u00e7ile")) }) + +test_that("can append slash if needed", { + expect_identical(append_slash("foo"), "foo/") + expect_identical(append_slash("foo/"), "foo/") + expect_identical(append_slash(c("foo/", "bar")), c("foo/", "bar/")) + expect_identical(append_slash(c("foo", "bar/")), c("foo/", "bar/")) +})