From a3e85e858b9d46fc0f1d7eb406f016d3dd3d903e Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Sat, 2 Sep 2023 14:03:33 -0500 Subject: [PATCH 01/19] Rename to group related files. --- R/{01-info_contact.R => info-01-contact.R} | 0 R/{01-info_license.R => info-01-license.R} | 0 R/{02-info.R => info-zz-info.R} | 0 R/{01-server_variable.R => servers-01-server_variable.R} | 0 ...server_variable_list.R => servers-02-server_variable_list.R} | 0 R/{03-servers.R => servers-zz-servers.R} | 0 R/{99-rapid.R => zz-rapid.R} | 0 man/api_contact.Rd | 2 +- man/api_info.Rd | 2 +- man/api_license.Rd | 2 +- man/rapid.Rd | 2 +- man/server_variable.Rd | 2 +- man/server_variable_list.Rd | 2 +- man/servers.Rd | 2 +- .../testthat/_snaps/{01-info_contact.md => info-01-contact.md} | 0 .../testthat/_snaps/{01-info_license.md => info-01-license.md} | 0 tests/testthat/_snaps/{02-info.md => info-zz-info.md} | 0 .../{01-server_variable.md => servers-01-server_variable.md} | 0 ...rver_variable_list.md => servers-02-server_variable_list.md} | 0 tests/testthat/_snaps/{03-servers.md => servers-zz-servers.md} | 0 tests/testthat/_snaps/{99-rapid.md => zz-rapid.md} | 0 .../testthat/{test-01-info_contact.R => test-info-01-contact.R} | 0 .../testthat/{test-01-info_license.R => test-info-01-license.R} | 0 tests/testthat/{test-02-info.R => test-info-zz-info.R} | 0 ...t-01-server_variable.R => test-servers-01-server_variable.R} | 0 ...r_variable_list.R => test-servers-02-server_variable_list.R} | 0 tests/testthat/{test-03-servers.R => test-servers-zz-servers.R} | 0 tests/testthat/{test-99-rapid.R => test-zz-rapid.R} | 0 28 files changed, 7 insertions(+), 7 deletions(-) rename R/{01-info_contact.R => info-01-contact.R} (100%) rename R/{01-info_license.R => info-01-license.R} (100%) rename R/{02-info.R => info-zz-info.R} (100%) rename R/{01-server_variable.R => servers-01-server_variable.R} (100%) rename R/{02_server_variable_list.R => servers-02-server_variable_list.R} (100%) rename R/{03-servers.R => servers-zz-servers.R} (100%) rename R/{99-rapid.R => zz-rapid.R} (100%) rename tests/testthat/_snaps/{01-info_contact.md => info-01-contact.md} (100%) rename tests/testthat/_snaps/{01-info_license.md => info-01-license.md} (100%) rename tests/testthat/_snaps/{02-info.md => info-zz-info.md} (100%) rename tests/testthat/_snaps/{01-server_variable.md => servers-01-server_variable.md} (100%) rename tests/testthat/_snaps/{02_server_variable_list.md => servers-02-server_variable_list.md} (100%) rename tests/testthat/_snaps/{03-servers.md => servers-zz-servers.md} (100%) rename tests/testthat/_snaps/{99-rapid.md => zz-rapid.md} (100%) rename tests/testthat/{test-01-info_contact.R => test-info-01-contact.R} (100%) rename tests/testthat/{test-01-info_license.R => test-info-01-license.R} (100%) rename tests/testthat/{test-02-info.R => test-info-zz-info.R} (100%) rename tests/testthat/{test-01-server_variable.R => test-servers-01-server_variable.R} (100%) rename tests/testthat/{test-02_server_variable_list.R => test-servers-02-server_variable_list.R} (100%) rename tests/testthat/{test-03-servers.R => test-servers-zz-servers.R} (100%) rename tests/testthat/{test-99-rapid.R => test-zz-rapid.R} (100%) diff --git a/R/01-info_contact.R b/R/info-01-contact.R similarity index 100% rename from R/01-info_contact.R rename to R/info-01-contact.R diff --git a/R/01-info_license.R b/R/info-01-license.R similarity index 100% rename from R/01-info_license.R rename to R/info-01-license.R diff --git a/R/02-info.R b/R/info-zz-info.R similarity index 100% rename from R/02-info.R rename to R/info-zz-info.R diff --git a/R/01-server_variable.R b/R/servers-01-server_variable.R similarity index 100% rename from R/01-server_variable.R rename to R/servers-01-server_variable.R diff --git a/R/02_server_variable_list.R b/R/servers-02-server_variable_list.R similarity index 100% rename from R/02_server_variable_list.R rename to R/servers-02-server_variable_list.R diff --git a/R/03-servers.R b/R/servers-zz-servers.R similarity index 100% rename from R/03-servers.R rename to R/servers-zz-servers.R diff --git a/R/99-rapid.R b/R/zz-rapid.R similarity index 100% rename from R/99-rapid.R rename to R/zz-rapid.R diff --git a/man/api_contact.Rd b/man/api_contact.Rd index 2f9b287..3455cb0 100644 --- a/man/api_contact.Rd +++ b/man/api_contact.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/01-info_contact.R +% Please edit documentation in R/info-01-contact.R \name{api_contact} \alias{api_contact} \title{Contact information for the API} diff --git a/man/api_info.Rd b/man/api_info.Rd index f10fbbe..855ee7d 100644 --- a/man/api_info.Rd +++ b/man/api_info.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/02-info.R +% Please edit documentation in R/info-zz-info.R \name{api_info} \alias{api_info} \title{Information about the API} diff --git a/man/api_license.Rd b/man/api_license.Rd index 253d29d..0da9855 100644 --- a/man/api_license.Rd +++ b/man/api_license.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/01-info_license.R +% Please edit documentation in R/info-01-license.R \name{api_license} \alias{api_license} \title{License information for the API} diff --git a/man/rapid.Rd b/man/rapid.Rd index 07c0b29..453b123 100644 --- a/man/rapid.Rd +++ b/man/rapid.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/99-rapid.R +% Please edit documentation in R/zz-rapid.R \name{rapid} \alias{rapid} \title{R API definition object} diff --git a/man/server_variable.Rd b/man/server_variable.Rd index 2c4f4ee..2d77093 100644 --- a/man/server_variable.Rd +++ b/man/server_variable.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/01-server_variable.R +% Please edit documentation in R/servers-01-server_variable.R \name{server_variable} \alias{server_variable} \title{A server variable for server URL template substitution} diff --git a/man/server_variable_list.Rd b/man/server_variable_list.Rd index 192ae77..f3cd33f 100644 --- a/man/server_variable_list.Rd +++ b/man/server_variable_list.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/02_server_variable_list.R +% Please edit documentation in R/servers-02-server_variable_list.R \name{server_variable_list} \alias{server_variable_list} \title{A collection of server variables for multiple servers} diff --git a/man/servers.Rd b/man/servers.Rd index 9b38496..826e2b2 100644 --- a/man/servers.Rd +++ b/man/servers.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/03-servers.R +% Please edit documentation in R/servers-zz-servers.R \name{servers} \alias{servers} \title{A collection of server variables for multiple servers} diff --git a/tests/testthat/_snaps/01-info_contact.md b/tests/testthat/_snaps/info-01-contact.md similarity index 100% rename from tests/testthat/_snaps/01-info_contact.md rename to tests/testthat/_snaps/info-01-contact.md diff --git a/tests/testthat/_snaps/01-info_license.md b/tests/testthat/_snaps/info-01-license.md similarity index 100% rename from tests/testthat/_snaps/01-info_license.md rename to tests/testthat/_snaps/info-01-license.md diff --git a/tests/testthat/_snaps/02-info.md b/tests/testthat/_snaps/info-zz-info.md similarity index 100% rename from tests/testthat/_snaps/02-info.md rename to tests/testthat/_snaps/info-zz-info.md diff --git a/tests/testthat/_snaps/01-server_variable.md b/tests/testthat/_snaps/servers-01-server_variable.md similarity index 100% rename from tests/testthat/_snaps/01-server_variable.md rename to tests/testthat/_snaps/servers-01-server_variable.md diff --git a/tests/testthat/_snaps/02_server_variable_list.md b/tests/testthat/_snaps/servers-02-server_variable_list.md similarity index 100% rename from tests/testthat/_snaps/02_server_variable_list.md rename to tests/testthat/_snaps/servers-02-server_variable_list.md diff --git a/tests/testthat/_snaps/03-servers.md b/tests/testthat/_snaps/servers-zz-servers.md similarity index 100% rename from tests/testthat/_snaps/03-servers.md rename to tests/testthat/_snaps/servers-zz-servers.md diff --git a/tests/testthat/_snaps/99-rapid.md b/tests/testthat/_snaps/zz-rapid.md similarity index 100% rename from tests/testthat/_snaps/99-rapid.md rename to tests/testthat/_snaps/zz-rapid.md diff --git a/tests/testthat/test-01-info_contact.R b/tests/testthat/test-info-01-contact.R similarity index 100% rename from tests/testthat/test-01-info_contact.R rename to tests/testthat/test-info-01-contact.R diff --git a/tests/testthat/test-01-info_license.R b/tests/testthat/test-info-01-license.R similarity index 100% rename from tests/testthat/test-01-info_license.R rename to tests/testthat/test-info-01-license.R diff --git a/tests/testthat/test-02-info.R b/tests/testthat/test-info-zz-info.R similarity index 100% rename from tests/testthat/test-02-info.R rename to tests/testthat/test-info-zz-info.R diff --git a/tests/testthat/test-01-server_variable.R b/tests/testthat/test-servers-01-server_variable.R similarity index 100% rename from tests/testthat/test-01-server_variable.R rename to tests/testthat/test-servers-01-server_variable.R diff --git a/tests/testthat/test-02_server_variable_list.R b/tests/testthat/test-servers-02-server_variable_list.R similarity index 100% rename from tests/testthat/test-02_server_variable_list.R rename to tests/testthat/test-servers-02-server_variable_list.R diff --git a/tests/testthat/test-03-servers.R b/tests/testthat/test-servers-zz-servers.R similarity index 100% rename from tests/testthat/test-03-servers.R rename to tests/testthat/test-servers-zz-servers.R diff --git a/tests/testthat/test-99-rapid.R b/tests/testthat/test-zz-rapid.R similarity index 100% rename from tests/testthat/test-99-rapid.R rename to tests/testthat/test-zz-rapid.R From e2c6cbd17379711c3c382d76441ce4fd273c5d13 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Sat, 2 Sep 2023 15:35:52 -0500 Subject: [PATCH 02/19] Implement as_* functions. --- NAMESPACE | 5 ++ R/00-properties.R | 6 +- R/info-01-contact.R | 47 +++++++++++- R/info-zz-info.R | 14 ++-- R/rapid-package.R | 4 + R/servers-02-server_variable_list.R | 2 +- R/servers-zz-servers.R | 6 +- R/zz-rapid.R | 4 +- man/api_contact.Rd | 6 +- man/api_info.Rd | 14 ++-- man/as_api_contact.Rd | 24 ++++++ man/rapid.Rd | 4 +- man/servers.Rd | 6 +- tests/testthat/_snaps/info-01-contact.md | 51 +++++++++++++ tests/testthat/test-info-01-contact.R | 96 ++++++++++++++++++++++++ 15 files changed, 255 insertions(+), 34 deletions(-) create mode 100644 man/as_api_contact.Rd diff --git a/NAMESPACE b/NAMESPACE index 8001673..c7a82e6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,11 +9,16 @@ S3method(length,"rapid::servers") export(api_contact) export(api_info) export(api_license) +export(as_api_contact) export(rapid) export(server_variable) export(server_variable_list) export(servers) if (getRversion() < "4.3.0") importFrom("S7", "@") +importFrom(S7,class_any) +importFrom(S7,class_character) +importFrom(S7,class_list) +importFrom(S7,class_missing) importFrom(glue,glue) importFrom(rlang,"%||%") importFrom(rlang,check_dots_empty) diff --git a/R/00-properties.R b/R/00-properties.R index abccde4..c1b2e9d 100644 --- a/R/00-properties.R +++ b/R/00-properties.R @@ -2,7 +2,7 @@ character_scalar_property <- function(x_arg, ...) { S7::new_property( - class = S7::class_character, + class = class_character, setter = function(self, value) { # TODO: Watch S7 dev to see if this can be less hacky. call <- rlang::caller_env(3) @@ -22,7 +22,7 @@ character_scalar_property <- function(x_arg, ...) { character_property <- function(x_arg, ...) { S7::new_property( - class = S7::class_character, + class = class_character, setter = function(self, value) { # TODO: Watch S7 dev to see if this can be less hacky. call <- rlang::caller_env(3) @@ -52,7 +52,7 @@ url_property <- function(x_arg) { enum_property <- function(x_arg) { S7::new_property( - class = S7::class_list, + class = class_list, setter = function(self, value) { call <- rlang::caller_env(3) if (!is.null(value) && !is.list(value)) { diff --git a/R/info-01-contact.R b/R/info-01-contact.R index f9bd0e9..f11b40e 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -29,9 +29,9 @@ api_contact <- S7::new_class( ), url = url_scalar_property("url") ), - constructor = function(name = S7::class_missing, - email = S7::class_missing, - url = S7::class_missing, + constructor = function(name = class_missing, + email = class_missing, + url = class_missing, ...) { S7::new_object(NULL, name = name, email = email, url = url) } @@ -41,3 +41,44 @@ api_contact <- S7::new_class( `length.rapid::api_contact` <- function(x) { .prop_length_max(x) } + +#' Coerce lists and character vectors to api_contacts +#' +#' `as_api_contact()` turns an existing object into an `api_contact`. This is in +#' contrast with [api_contact()], which builds an `api_contact` from individual +#' properties. +#' +#' @param x The object to coerce. Must be empty or have names "name", "email", +#' and/or "url". Extra names are ignored. +#' +#' @return An `api_contact` as returned by [api_contact()]. +#' @export +#' +#' @examples +#' as_api_contact() +#' as_api_contact(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +as_api_contact <- S7::new_generic("as_api_contact", dispatch_args = "x") + +S7::method(as_api_contact, class_list | class_character) <- function(x) { + if ( + length(x) && + (!rlang::is_named(x) || !any(names(x) %in% c("name", "email", "url"))) + ) { + cli::cli_abort(c( + "{.arg x} must have names {.val name}, {.val email}, and/or {.val url}.", + "*" = "Any other names are ignored." + )) + } + x <- as.list(x) + api_contact(name = x[["name"]], email = x[["email"]], url = x[["url"]]) +} + +S7::method(as_api_contact, class_missing) <- function(x) { + api_contact() +} + +S7::method(as_api_contact, class_any) <- function(x) { + cli::cli_abort( + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls api_contact}." + ) +} diff --git a/R/info-zz-info.R b/R/info-zz-info.R index 2818c09..837028f 100644 --- a/R/info-zz-info.R +++ b/R/info-zz-info.R @@ -45,13 +45,13 @@ api_info <- S7::new_class( title = character_scalar_property("title"), version = character_scalar_property("version") ), - constructor = function(contact = S7::class_missing, - description = S7::class_missing, - license = S7::class_missing, - summary = S7::class_missing, - terms_of_service = S7::class_missing, - title = S7::class_missing, - version = S7::class_missing, + constructor = function(contact = class_missing, + description = class_missing, + license = class_missing, + summary = class_missing, + terms_of_service = class_missing, + title = class_missing, + version = class_missing, ..., apid_list = NULL) { if (!is.null(apid_list)) { diff --git a/R/rapid-package.R b/R/rapid-package.R index 99da5f4..b6528a5 100644 --- a/R/rapid-package.R +++ b/R/rapid-package.R @@ -3,6 +3,10 @@ #' @importFrom rlang %||% #' @importFrom rlang check_dots_empty #' @importFrom rlang check_dots_used +#' @importFrom S7 class_any +#' @importFrom S7 class_character +#' @importFrom S7 class_list +#' @importFrom S7 class_missing #' @importFrom stbl stabilize_chr_scalar #' @importFrom stbl to_chr_scalar ## usethis namespace: end diff --git a/R/servers-02-server_variable_list.R b/R/servers-02-server_variable_list.R index 6db6376..5db6596 100644 --- a/R/servers-02-server_variable_list.R +++ b/R/servers-02-server_variable_list.R @@ -18,7 +18,7 @@ server_variable_list <- S7::new_class( "server_variable_list", package = "rapid", - parent = S7::class_list, + parent = class_list, constructor = function(..., apid_list = NULL) { if (!is.null(apid_list)) { return(S7::new_object( diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index f1e481d..a8d8ee0 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -49,9 +49,9 @@ servers <- S7::new_class( description = character_property("description"), variables = server_variable_list ), - constructor = function(url = S7::class_missing, - description = S7::class_missing, - variables = S7::class_missing, + constructor = function(url = class_missing, + description = class_missing, + variables = class_missing, ..., apid_list = NULL) { if (!is.null(apid_list) && !is.null(apid_list$servers)) { diff --git a/R/zz-rapid.R b/R/zz-rapid.R index 1ab61c2..902447a 100644 --- a/R/zz-rapid.R +++ b/R/zz-rapid.R @@ -39,8 +39,8 @@ rapid <- S7::new_class( info = api_info, servers = servers ), - constructor = function(info = S7::class_missing, - servers = S7::class_missing, + constructor = function(info = class_missing, + servers = class_missing, ..., apid_url = NULL, apid_list = NULL) { diff --git a/man/api_contact.Rd b/man/api_contact.Rd index 3455cb0..fbbfcca 100644 --- a/man/api_contact.Rd +++ b/man/api_contact.Rd @@ -5,9 +5,9 @@ \title{Contact information for the API} \usage{ api_contact( - name = S7::class_missing, - email = S7::class_missing, - url = S7::class_missing, + name = class_missing, + email = class_missing, + url = class_missing, ... ) } diff --git a/man/api_info.Rd b/man/api_info.Rd index 855ee7d..fa07712 100644 --- a/man/api_info.Rd +++ b/man/api_info.Rd @@ -5,13 +5,13 @@ \title{Information about the API} \usage{ api_info( - contact = S7::class_missing, - description = S7::class_missing, - license = S7::class_missing, - summary = S7::class_missing, - terms_of_service = S7::class_missing, - title = S7::class_missing, - version = S7::class_missing, + contact = class_missing, + description = class_missing, + license = class_missing, + summary = class_missing, + terms_of_service = class_missing, + title = class_missing, + version = class_missing, ..., apid_list = NULL ) diff --git a/man/as_api_contact.Rd b/man/as_api_contact.Rd new file mode 100644 index 0000000..318b07d --- /dev/null +++ b/man/as_api_contact.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/info-01-contact.R +\name{as_api_contact} +\alias{as_api_contact} +\title{Coerce lists and character vectors to api_contacts} +\usage{ +as_api_contact(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or have names "name", "email", +and/or "url". Extra names are ignored.} +} +\value{ +An \code{api_contact} as returned by \code{\link[=api_contact]{api_contact()}}. +} +\description{ +\code{as_api_contact()} turns an existing object into an \code{api_contact}. This is in +contrast with \code{\link[=api_contact]{api_contact()}}, which builds an \code{api_contact} from individual +properties. +} +\examples{ +as_api_contact() +as_api_contact(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +} diff --git a/man/rapid.Rd b/man/rapid.Rd index 453b123..0fcda4c 100644 --- a/man/rapid.Rd +++ b/man/rapid.Rd @@ -5,8 +5,8 @@ \title{R API definition object} \usage{ rapid( - info = S7::class_missing, - servers = S7::class_missing, + info = class_missing, + servers = class_missing, ..., apid_url = NULL, apid_list = NULL diff --git a/man/servers.Rd b/man/servers.Rd index 826e2b2..45b2993 100644 --- a/man/servers.Rd +++ b/man/servers.Rd @@ -5,9 +5,9 @@ \title{A collection of server variables for multiple servers} \usage{ servers( - url = S7::class_missing, - description = S7::class_missing, - variables = S7::class_missing, + url = class_missing, + description = class_missing, + variables = class_missing, ..., apid_list = NULL ) diff --git a/tests/testthat/_snaps/info-01-contact.md b/tests/testthat/_snaps/info-01-contact.md index 2d3981e..58284f6 100644 --- a/tests/testthat/_snaps/info-01-contact.md +++ b/tests/testthat/_snaps/info-01-contact.md @@ -91,3 +91,54 @@ @ email: chr(0) @ url : chr(0) +# as_api_contact() errors informatively for unnamed or misnamed input + + Code + as_api_contact(letters) + Condition + Error: + ! `x` must have names "name", "email", and/or "url". + * Any other names are ignored. + +--- + + Code + as_api_contact(list(a = "Jon", b = "jonthegeek@gmail.com")) + Condition + Error: + ! `x` must have names "name", "email", and/or "url". + * Any other names are ignored. + +--- + + Code + as_api_contact(c(a = "Jon", b = "jonthegeek@gmail.com")) + Condition + Error: + ! `x` must have names "name", "email", and/or "url". + * Any other names are ignored. + +# as_api_contact() errors informatively for bad classes + + Code + as_api_contact(1:2) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_api_contact(mean) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_api_contact(TRUE) + Condition + Error: + ! Can't coerce `x` to . + diff --git a/tests/testthat/test-info-01-contact.R b/tests/testthat/test-info-01-contact.R index 7513bf2..43f9a92 100644 --- a/tests/testthat/test-info-01-contact.R +++ b/tests/testthat/test-info-01-contact.R @@ -91,3 +91,99 @@ test_that("length() of an api_contact reports the overall length", { expect_equal(length(api_contact()), 0) expect_equal(length(api_contact(name = "A")), 1) }) + +test_that("as_api_contact() errors informatively for unnamed or misnamed input", { + expect_snapshot( + as_api_contact(letters), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_api_contact(list(a = "Jon", b = "jonthegeek@gmail.com")), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_api_contact(c(a = "Jon", b = "jonthegeek@gmail.com")), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_api_contact() errors informatively for bad classes", { + expect_snapshot( + as_api_contact(1:2), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_api_contact(mean), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_api_contact(TRUE), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_api_contact() returns expected objects", { + expect_identical( + as_api_contact( + c( + name = "Jon", + email = "jonthegeek@gmail.com", + url = "https://jonthegeek.com" + ) + ), + api_contact( + name = "Jon", + email = "jonthegeek@gmail.com", + url = "https://jonthegeek.com" + ) + ) + expect_identical( + as_api_contact( + c( + name = "Jon", + email = "jonthegeek@gmail.com", + x = "https://jonthegeek.com" + ) + ), + api_contact( + name = "Jon", + email = "jonthegeek@gmail.com" + ) + ) + expect_identical( + as_api_contact( + c( + email = "jonthegeek@gmail.com", + name = "Jon", + x = "https://jonthegeek.com" + ) + ), + api_contact( + name = "Jon", + email = "jonthegeek@gmail.com" + ) + ) + expect_identical( + as_api_contact( + list( + name = "Jon", + email = "jonthegeek@gmail.com", + x = "https://jonthegeek.com" + ) + ), + api_contact( + name = "Jon", + email = "jonthegeek@gmail.com" + ) + ) + expect_identical( + as_api_contact(list()), + api_contact() + ) +}) From be4d15dce95aba6c93833a2a511eb38a28a387c4 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Wed, 6 Sep 2023 15:28:07 -0500 Subject: [PATCH 03/19] Remove api_ prefixes. --- NAMESPACE | 14 ++--- R/info-01-contact.R | 36 +++++------ R/info-01-license.R | 12 ++-- R/info-zz-info.R | 26 ++++---- R/zz-rapid.R | 12 ++-- man/as_api_contact.Rd | 24 -------- man/as_contact.Rd | 24 ++++++++ man/{api_contact.Rd => contact.Rd} | 15 ++--- man/{api_info.Rd => info.Rd} | 18 +++--- man/{api_license.Rd => license.Rd} | 17 ++---- man/rapid.Rd | 6 +- principles.md | 7 +-- tests/testthat/_snaps/info-01-contact.md | 72 +++++++++++----------- tests/testthat/_snaps/info-01-license.md | 66 ++++++++++---------- tests/testthat/_snaps/info-zz-info.md | 42 ++++++------- tests/testthat/_snaps/zz-rapid.md | 34 +++++------ tests/testthat/test-info-01-contact.R | 78 ++++++++++++------------ tests/testthat/test-info-01-license.R | 63 +++++++++++-------- tests/testthat/test-info-zz-info.R | 32 +++++----- tests/testthat/test-zz-rapid.R | 6 +- 20 files changed, 303 insertions(+), 301 deletions(-) delete mode 100644 man/as_api_contact.Rd create mode 100644 man/as_contact.Rd rename man/{api_contact.Rd => contact.Rd} (74%) rename man/{api_info.Rd => info.Rd} (88%) rename man/{api_license.Rd => license.Rd} (78%) diff --git a/NAMESPACE b/NAMESPACE index c7a82e6..3a0fbda 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,15 +1,15 @@ # Generated by roxygen2: do not edit by hand -S3method(length,"rapid::api_contact") -S3method(length,"rapid::api_info") -S3method(length,"rapid::api_license") +S3method(length,"rapid::contact") +S3method(length,"rapid::info") +S3method(length,"rapid::license") S3method(length,"rapid::rapid") S3method(length,"rapid::server_variable") S3method(length,"rapid::servers") -export(api_contact) -export(api_info) -export(api_license) -export(as_api_contact) +export(as_contact) +export(contact) +export(info) +export(license) export(rapid) export(server_variable) export(server_variable_list) diff --git a/R/info-01-contact.R b/R/info-01-contact.R index f11b40e..e98a85c 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -9,17 +9,17 @@ #' @param email The email address of the contact person/organization. This #' *must* be in the form of an email address. #' -#' @return An `api_contact` S7 object, with fields `name`, `email`, and `url`. +#' @return An `contact` S7 object, with fields `name`, `email`, and `url`. #' @export #' #' @examples -#' api_contact( +#' contact( #' "API Support", #' "support@example.com", #' "https://www.example.com/support" #' ) -api_contact <- S7::new_class( - "api_contact", +contact <- S7::new_class( + "contact", package = "rapid", properties = list( name = character_scalar_property("name"), @@ -38,28 +38,28 @@ api_contact <- S7::new_class( ) #' @export -`length.rapid::api_contact` <- function(x) { +`length.rapid::contact` <- function(x) { .prop_length_max(x) } -#' Coerce lists and character vectors to api_contacts +#' Coerce lists and character vectors to contacts #' -#' `as_api_contact()` turns an existing object into an `api_contact`. This is in -#' contrast with [api_contact()], which builds an `api_contact` from individual +#' `as_contact()` turns an existing object into an `contact`. This is in +#' contrast with [contact()], which builds an `contact` from individual #' properties. #' #' @param x The object to coerce. Must be empty or have names "name", "email", #' and/or "url". Extra names are ignored. #' -#' @return An `api_contact` as returned by [api_contact()]. +#' @return An `contact` as returned by [contact()]. #' @export #' #' @examples -#' as_api_contact() -#' as_api_contact(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) -as_api_contact <- S7::new_generic("as_api_contact", dispatch_args = "x") +#' as_contact() +#' as_contact(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +as_contact <- S7::new_generic("as_contact", dispatch_args = "x") -S7::method(as_api_contact, class_list | class_character) <- function(x) { +S7::method(as_contact, class_list | class_character) <- function(x) { if ( length(x) && (!rlang::is_named(x) || !any(names(x) %in% c("name", "email", "url"))) @@ -70,15 +70,15 @@ S7::method(as_api_contact, class_list | class_character) <- function(x) { )) } x <- as.list(x) - api_contact(name = x[["name"]], email = x[["email"]], url = x[["url"]]) + contact(name = x[["name"]], email = x[["email"]], url = x[["url"]]) } -S7::method(as_api_contact, class_missing) <- function(x) { - api_contact() +S7::method(as_contact, class_missing) <- function(x) { + contact() } -S7::method(as_api_contact, class_any) <- function(x) { +S7::method(as_contact, class_any) <- function(x) { cli::cli_abort( - "Can't coerce {.arg x} {.cls {class(x)}} to {.cls api_contact}." + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls contact}." ) } diff --git a/R/info-01-license.R b/R/info-01-license.R index 13b50d7..9c3a456 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -13,21 +13,21 @@ #' @param url A URL to the license used for the API. This *must* be in the form #' of a URL. The `url` field is mutually exclusive of the `identifier` field. #' -#' @return An `api_license` S7 object, with fields `name`, `identifier`, and +#' @return An `license` S7 object, with fields `name`, `identifier`, and #' `url`. #' @export #' #' @examples -#' api_license( +#' license( #' "Apache 2.0", #' identifier = "Apache-2.0" #' ) -#' api_license( +#' license( #' "Apache 2.0", #' url = "https://opensource.org/license/apache-2-0/" #' ) -api_license <- S7::new_class( - "api_license", +license <- S7::new_class( + "license", package = "rapid", properties = list( name = character_scalar_property("name"), @@ -50,6 +50,6 @@ api_license <- S7::new_class( ) #' @export -`length.rapid::api_license` <- function(x) { +`length.rapid::license` <- function(x) { length(x@name) } diff --git a/R/info-zz-info.R b/R/info-zz-info.R index 837028f..25cc971 100644 --- a/R/info-zz-info.R +++ b/R/info-zz-info.R @@ -6,12 +6,12 @@ #' #' @inheritParams .shared-parameters #' @param contact The contact information for the exposed API, generated via -#' [api_contact()]. +#' [contact()]. #' @param description A description of the API. [CommonMark #' syntax](https://spec.commonmark.org/) *may* be used for rich text #' representation. #' @param license The license information for the exposed API, generated via -#' [api_license()]. +#' [license()]. #' @param summary A short summary of the API. #' @param terms_of_service A URL to the Terms of Service for the API. This #' *must* be in the form of a URL when provided. @@ -19,27 +19,27 @@ #' @param version The version of the API document (which is distinct from the #' OpenAPI Specification version or the API implementation version). #' -#' @return An `api_info` S7 object. +#' @return An `info` S7 object. #' @export #' @examples -#' api_info() -#' api_info( +#' info() +#' info( #' title = "My Cool API", -#' license = api_license( +#' license = license( #' name = "Apache 2.0", #' url = "https://opensource.org/license/apache-2-0/" #' ) #' ) -api_info <- S7::new_class( - "api_info", +info <- S7::new_class( + "info", package = "rapid", # Design choice: These are strictly alphabetized, since we allow any to be # empty. May later want to order them to match the validated version, where # required parameters will come first (before ... during construction). properties = list( - contact = api_contact, + contact = contact, description = character_scalar_property("description"), - license = api_license, + license = license, summary = character_scalar_property("summary"), terms_of_service = url_scalar_property("terms_of_service"), title = character_scalar_property("title"), @@ -55,9 +55,9 @@ api_info <- S7::new_class( ..., apid_list = NULL) { if (!is.null(apid_list)) { - contact <- rlang::inject(api_contact(!!!apid_list$info$contact)) + contact <- rlang::inject(contact(!!!apid_list$info$contact)) description <- apid_list$info$description - license <- rlang::inject(api_license(!!!apid_list$info$license)) + license <- rlang::inject(license(!!!apid_list$info$license)) summary <- apid_list$info$summary terms_of_service <- apid_list$info$terms_of_service title <- apid_list$info$title @@ -77,6 +77,6 @@ api_info <- S7::new_class( ) #' @export -`length.rapid::api_info` <- function(x) { +`length.rapid::info` <- function(x) { .prop_length_max(x) } diff --git a/R/zz-rapid.R b/R/zz-rapid.R index 902447a..b091121 100644 --- a/R/zz-rapid.R +++ b/R/zz-rapid.R @@ -3,7 +3,7 @@ #' An object that represents an API. #' #' @inheritParams .shared-parameters -#' @param info An `api_info` object defined by [api_info()]. +#' @param info An `info` object defined by [info()]. #' @param servers A `servers` object defined by [servers()]. #' #' @return A `rapid` S7 object, with properties `info` and `servers`. @@ -12,13 +12,13 @@ #' @examples #' rapid() #' rapid( -#' info = api_info(title = "A", version = "1"), +#' info = info(title = "A", version = "1"), #' servers( #' url = "https://development.gigantic-server.com/v1" #' ) #' ) #' rapid( -#' info = api_info(title = "A", version = "1"), +#' info = info(title = "A", version = "1"), #' servers( #' url = c( #' "https://development.gigantic-server.com/v1", @@ -36,7 +36,7 @@ rapid <- S7::new_class( "rapid", package = "rapid", properties = list( - info = api_info, + info = info, servers = servers ), constructor = function(info = class_missing, @@ -52,7 +52,7 @@ rapid <- S7::new_class( apid_list <- yaml::read_yaml(apid_url) } if (!is.null(apid_list)) { - info <- api_info(apid_list = apid_list) + info <- info(apid_list = apid_list) servers <- servers(apid_list = apid_list) } S7::new_object(NULL, info = info, servers = servers) @@ -61,7 +61,7 @@ rapid <- S7::new_class( validate_lengths( self, key = "info", - # In this case the max length is redundant, since api_info can only have + # In this case the max length is redundant, since info can only have # length 0 or 1. key_max_length = 1, optional_any = "servers" diff --git a/man/as_api_contact.Rd b/man/as_api_contact.Rd deleted file mode 100644 index 318b07d..0000000 --- a/man/as_api_contact.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/info-01-contact.R -\name{as_api_contact} -\alias{as_api_contact} -\title{Coerce lists and character vectors to api_contacts} -\usage{ -as_api_contact(x, ...) -} -\arguments{ -\item{x}{The object to coerce. Must be empty or have names "name", "email", -and/or "url". Extra names are ignored.} -} -\value{ -An \code{api_contact} as returned by \code{\link[=api_contact]{api_contact()}}. -} -\description{ -\code{as_api_contact()} turns an existing object into an \code{api_contact}. This is in -contrast with \code{\link[=api_contact]{api_contact()}}, which builds an \code{api_contact} from individual -properties. -} -\examples{ -as_api_contact() -as_api_contact(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) -} diff --git a/man/as_contact.Rd b/man/as_contact.Rd new file mode 100644 index 0000000..aebe69f --- /dev/null +++ b/man/as_contact.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/info-01-contact.R +\name{as_contact} +\alias{as_contact} +\title{Coerce lists and character vectors to contacts} +\usage{ +as_contact(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or have names "name", "email", +and/or "url". Extra names are ignored.} +} +\value{ +An \code{contact} as returned by \code{\link[=contact]{contact()}}. +} +\description{ +\code{as_contact()} turns an existing object into an \code{contact}. This is in +contrast with \code{\link[=contact]{contact()}}, which builds an \code{contact} from individual +properties. +} +\examples{ +as_contact() +as_contact(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +} diff --git a/man/api_contact.Rd b/man/contact.Rd similarity index 74% rename from man/api_contact.Rd rename to man/contact.Rd index fbbfcca..28bdf23 100644 --- a/man/api_contact.Rd +++ b/man/contact.Rd @@ -1,15 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/info-01-contact.R -\name{api_contact} -\alias{api_contact} +\name{contact} +\alias{contact} \title{Contact information for the API} \usage{ -api_contact( - name = class_missing, - email = class_missing, - url = class_missing, - ... -) +contact(name = class_missing, email = class_missing, url = class_missing, ...) } \arguments{ \item{name}{The identifying name of the contact person/organization.} @@ -23,13 +18,13 @@ form of a URL.} \item{...}{Catch-all for unimplemented properties.} } \value{ -An \code{api_contact} S7 object, with fields \code{name}, \code{email}, and \code{url}. +An \code{contact} S7 object, with fields \code{name}, \code{email}, and \code{url}. } \description{ Validate the contact information for an API. } \examples{ -api_contact( +contact( "API Support", "support@example.com", "https://www.example.com/support" diff --git a/man/api_info.Rd b/man/info.Rd similarity index 88% rename from man/api_info.Rd rename to man/info.Rd index fa07712..6516bae 100644 --- a/man/api_info.Rd +++ b/man/info.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/info-zz-info.R -\name{api_info} -\alias{api_info} +\name{info} +\alias{info} \title{Information about the API} \usage{ -api_info( +info( contact = class_missing, description = class_missing, license = class_missing, @@ -18,13 +18,13 @@ api_info( } \arguments{ \item{contact}{The contact information for the exposed API, generated via -\code{\link[=api_contact]{api_contact()}}.} +\code{\link[=contact]{contact()}}.} \item{description}{A description of the API. \href{https://spec.commonmark.org/}{CommonMark syntax} \emph{may} be used for rich text representation.} \item{license}{The license information for the exposed API, generated via -\code{\link[=api_license]{api_license()}}.} +\code{\link[=license]{license()}}.} \item{summary}{A short summary of the API.} @@ -42,7 +42,7 @@ OpenAPI Specification version or the API implementation version).} an OAS document with \code{\link[yaml:read_yaml]{yaml::read_yaml()}}.} } \value{ -An \code{api_info} S7 object. +An \code{info} S7 object. } \description{ The object provides metadata about the API. The metadata \emph{may} be used by the @@ -50,10 +50,10 @@ clients if needed, and \emph{may} be presented in editing or documentation generation tools for convenience. } \examples{ -api_info() -api_info( +info() +info( title = "My Cool API", - license = api_license( + license = license( name = "Apache 2.0", url = "https://opensource.org/license/apache-2-0/" ) diff --git a/man/api_license.Rd b/man/license.Rd similarity index 78% rename from man/api_license.Rd rename to man/license.Rd index 0da9855..9d7eb17 100644 --- a/man/api_license.Rd +++ b/man/license.Rd @@ -1,15 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/info-01-license.R -\name{api_license} -\alias{api_license} +\name{license} +\alias{license} \title{License information for the API} \usage{ -api_license( - name = character(), - ..., - identifier = character(), - url = character() -) +license(name = character(), ..., identifier = character(), url = character()) } \arguments{ \item{name}{The license name used for the API.} @@ -25,18 +20,18 @@ exclusive of the \code{url} field.} of a URL. The \code{url} field is mutually exclusive of the \code{identifier} field.} } \value{ -An \code{api_license} S7 object, with fields \code{name}, \code{identifier}, and +An \code{license} S7 object, with fields \code{name}, \code{identifier}, and \code{url}. } \description{ Validate the license information for an API. } \examples{ -api_license( +license( "Apache 2.0", identifier = "Apache-2.0" ) -api_license( +license( "Apache 2.0", url = "https://opensource.org/license/apache-2-0/" ) diff --git a/man/rapid.Rd b/man/rapid.Rd index 0fcda4c..7bbb6c2 100644 --- a/man/rapid.Rd +++ b/man/rapid.Rd @@ -13,7 +13,7 @@ rapid( ) } \arguments{ -\item{info}{An \code{api_info} object defined by \code{\link[=api_info]{api_info()}}.} +\item{info}{An \code{info} object defined by \code{\link[=info]{info()}}.} \item{servers}{A \code{servers} object defined by \code{\link[=servers]{servers()}}.} @@ -33,13 +33,13 @@ An object that represents an API. \examples{ rapid() rapid( - info = api_info(title = "A", version = "1"), + info = info(title = "A", version = "1"), servers( url = "https://development.gigantic-server.com/v1" ) ) rapid( - info = api_info(title = "A", version = "1"), + info = info(title = "A", version = "1"), servers( url = c( "https://development.gigantic-server.com/v1", diff --git a/principles.md b/principles.md index 8c84d42..f6e1fcf 100644 --- a/principles.md +++ b/principles.md @@ -5,11 +5,10 @@ ## Class names I've gone back and forth between "api_{class}" and "{class}" for the class names. -The rule that seems to be emerging is to add "api_" when necessary, but try not to do so. -This rule still might change. +I am currently settled on using "{class}", because the only function I conflict with is `base::license()`, which just prints info about the R license. I also belatedly noticed that I had `server()` (singular) where the OAS specification has `servers()`. -I have belatedly updated that. -Be careful to match the class names to the pluralization in the specification. +I have updated that. +Be careful to match the class names to the pluralization in the specification! ## Specification extensions diff --git a/tests/testthat/_snaps/info-01-contact.md b/tests/testthat/_snaps/info-01-contact.md index 58284f6..4443f1d 100644 --- a/tests/testthat/_snaps/info-01-contact.md +++ b/tests/testthat/_snaps/info-01-contact.md @@ -1,100 +1,100 @@ -# api_contact() errors informatively for bad name +# contact() errors informatively for bad name Code - api_contact(name = mean) + contact(name = mean) Condition - Error in `api_contact()`: + Error in `contact()`: ! Can't coerce `name` to . --- Code - api_contact(name = c("A", "B")) + contact(name = c("A", "B")) Condition - Error in `api_contact()`: + Error in `contact()`: ! `name` must be a single . x `name` has 2 values. -# api_contact() errors informatively for bad url +# contact() errors informatively for bad url Code - api_contact(name = "A", url = mean) + contact(name = "A", url = mean) Condition - Error in `api_contact()`: + Error in `contact()`: ! Can't coerce `url` to . --- Code - api_contact(name = "A", url = c("A", "B")) + contact(name = "A", url = c("A", "B")) Condition - Error in `api_contact()`: + Error in `contact()`: ! `url` must be a single . x `url` has 2 values. --- Code - api_contact(name = "A", url = "not a real url") + contact(name = "A", url = "not a real url") Condition - Error in `api_contact()`: + Error in `contact()`: ! `url` must match the provided regex pattern. x Some values do not match. * Locations: 1 -# api_contact() errors informatively for bad email +# contact() errors informatively for bad email Code - api_contact(name = "A", url = "https://example.com", email = mean) + contact(name = "A", url = "https://example.com", email = mean) Condition - Error in `api_contact()`: + Error in `contact()`: ! Can't coerce `email` to . --- Code - api_contact(name = "A", url = "https://example.com", email = c("A", "B")) + contact(name = "A", url = "https://example.com", email = c("A", "B")) Condition - Error in `api_contact()`: + Error in `contact()`: ! `email` must be a single . x `email` has 2 values. --- Code - api_contact(name = "A", url = "https://example.com", email = "not a real email") + contact(name = "A", url = "https://example.com", email = "not a real email") Condition - Error in `api_contact()`: + Error in `contact()`: ! `email` must match the provided regex pattern. x Some values do not match. * Locations: 1 -# api_contact() returns a contact when everything is ok +# contact() returns a contact when everything is ok Code - test_result <- api_contact(name = "A", url = "https://example.com", email = "real.email@address.place") + test_result <- contact(name = "A", url = "https://example.com", email = "real.email@address.place") test_result Output - + @ name : chr "A" @ email: chr "real.email@address.place" @ url : chr "https://example.com" -# api_contact() without args returns an empty api_contact +# contact() without args returns an empty contact Code - test_result <- api_contact() + test_result <- contact() test_result Output - + @ name : chr(0) @ email: chr(0) @ url : chr(0) -# as_api_contact() errors informatively for unnamed or misnamed input +# as_contact() errors informatively for unnamed or misnamed input Code - as_api_contact(letters) + as_contact(letters) Condition Error: ! `x` must have names "name", "email", and/or "url". @@ -103,7 +103,7 @@ --- Code - as_api_contact(list(a = "Jon", b = "jonthegeek@gmail.com")) + as_contact(list(a = "Jon", b = "jonthegeek@gmail.com")) Condition Error: ! `x` must have names "name", "email", and/or "url". @@ -112,33 +112,33 @@ --- Code - as_api_contact(c(a = "Jon", b = "jonthegeek@gmail.com")) + as_contact(c(a = "Jon", b = "jonthegeek@gmail.com")) Condition Error: ! `x` must have names "name", "email", and/or "url". * Any other names are ignored. -# as_api_contact() errors informatively for bad classes +# as_contact() errors informatively for bad classes Code - as_api_contact(1:2) + as_contact(1:2) Condition Error: - ! Can't coerce `x` to . + ! Can't coerce `x` to . --- Code - as_api_contact(mean) + as_contact(mean) Condition Error: - ! Can't coerce `x` to . + ! Can't coerce `x` to . --- Code - as_api_contact(TRUE) + as_contact(TRUE) Condition Error: - ! Can't coerce `x` to . + ! Can't coerce `x` to . diff --git a/tests/testthat/_snaps/info-01-license.md b/tests/testthat/_snaps/info-01-license.md index 88491a3..d06379c 100644 --- a/tests/testthat/_snaps/info-01-license.md +++ b/tests/testthat/_snaps/info-01-license.md @@ -1,111 +1,111 @@ -# api_license() errors informatively for bad name +# license() errors informatively for bad name Code - api_license(name = mean) + license(name = mean) Condition - Error in `api_license()`: + Error in `license()`: ! Can't coerce `name` to . --- Code - api_license(name = c("A", "B")) + license(name = c("A", "B")) Condition - Error in `api_license()`: + Error in `license()`: ! `name` must be a single . x `name` has 2 values. -# api_license() errors informatively for bad url +# license() errors informatively for bad url Code - api_license(name = "A", url = mean) + license(name = "A", url = mean) Condition - Error in `api_license()`: + Error in `license()`: ! Can't coerce `url` to . --- Code - api_license(name = "A", url = c("A", "B")) + license(name = "A", url = c("A", "B")) Condition - Error in `api_license()`: + Error in `license()`: ! `url` must be a single . x `url` has 2 values. --- Code - api_license(name = "A", url = "not a real url") + license(name = "A", url = "not a real url") Condition - Error in `api_license()`: + Error in `license()`: ! `url` must match the provided regex pattern. x Some values do not match. * Locations: 1 -# api_license() errors informatively for bad identifier +# license() errors informatively for bad identifier Code - api_license(name = "A", identifier = mean) + license(name = "A", identifier = mean) Condition - Error in `api_license()`: + Error in `license()`: ! Can't coerce `identifier` to . --- Code - api_license(name = "A", identifier = c("A", "B")) + license(name = "A", identifier = c("A", "B")) Condition - Error in `api_license()`: + Error in `license()`: ! `identifier` must be a single . x `identifier` has 2 values. -# api_license() errors informatively when both url and identifier are supplied +# license() errors informatively when both url and identifier are supplied Code - api_license(name = "A", identifier = "A", url = "https://example.com") + license(name = "A", identifier = "A", url = "https://example.com") Condition Error: - ! object is invalid: + ! object is invalid: - At most one of @identifier and @url must be supplied. -# api_license() fails when name is missing +# license() fails when name is missing Code - api_license(identifier = "A") + license(identifier = "A") Condition Error: - ! object is invalid: + ! object is invalid: - When `name` is not defined, `identifier` must be empty. - `identifier` has 1 value. --- Code - api_license(url = "https://example.com") + license(url = "https://example.com") Condition Error: - ! object is invalid: + ! object is invalid: - When `name` is not defined, `url` must be empty. - `url` has 1 value. -# api_license() doesn't match identifier by position +# license() doesn't match identifier by position Code - api_license(name = "A", "https://example.com") + license(name = "A", "https://example.com") Condition - Error in `api_license()`: + Error in `license()`: ! `...` must be empty. x Problematic argument: * ..1 = "https://example.com" i Did you forget to name an argument? -# api_license() returns a license when everything is ok +# license() returns a license when everything is ok Code - test_result <- api_license(name = "A", url = "https://example.com") + test_result <- license(name = "A", url = "https://example.com") test_result Output - + @ name : chr "A" @ identifier: chr(0) @ url : chr "https://example.com" @@ -113,10 +113,10 @@ --- Code - test_result <- api_license(name = "A", identifier = "technically these have a fancy required format") + test_result <- license(name = "A", identifier = "technically these have a fancy required format") test_result Output - + @ name : chr "A" @ identifier: chr "technically these have a fancy required format" @ url : chr(0) diff --git a/tests/testthat/_snaps/info-zz-info.md b/tests/testthat/_snaps/info-zz-info.md index e9ff83e..c6b3ca7 100644 --- a/tests/testthat/_snaps/info-zz-info.md +++ b/tests/testthat/_snaps/info-zz-info.md @@ -1,43 +1,43 @@ -# api_info() requires URLs for TOS +# info() requires URLs for TOS Code - api_info(terms_of_service = mean) + info(terms_of_service = mean) Condition - Error in `api_info()`: + Error in `info()`: ! Can't coerce `terms_of_service` to . --- Code - api_info(terms_of_service = c("A", "B")) + info(terms_of_service = c("A", "B")) Condition - Error in `api_info()`: + Error in `info()`: ! `terms_of_service` must be a single . x `terms_of_service` has 2 values. --- Code - api_info(terms_of_service = "not a real url") + info(terms_of_service = "not a real url") Condition - Error in `api_info()`: + Error in `info()`: ! `terms_of_service` must match the provided regex pattern. x Some values do not match. * Locations: 1 -# api_info() returns an empty api_info +# info() returns an empty info Code - test_result <- api_info() + test_result <- info() test_result Output - - @ contact : + + @ contact : .. @ name : chr(0) .. @ email: chr(0) .. @ url : chr(0) @ description : chr(0) - @ license : + @ license : .. @ name : chr(0) .. @ identifier: chr(0) .. @ url : chr(0) @@ -46,19 +46,19 @@ @ title : chr(0) @ version : chr(0) -# Can construct an api_contact from an api spec +# Can construct an contact from an api spec Code - test_result <- api_info(apid_list = apid_list_guru) + test_result <- info(apid_list = apid_list_guru) test_result Output - - @ contact : + + @ contact : .. @ name : chr "APIs.guru" .. @ email: chr "mike.ralphson@gmail.com" .. @ url : chr "https://APIs.guru" @ description : chr "Wikipedia for Web APIs. Repository of API definitions in OpenAPI format.\n**Warning**: If you want to be notifi"| __truncated__ - @ license : + @ license : .. @ name : chr "CC0 1.0" .. @ identifier: chr(0) .. @ url : chr "https://github.com/APIs-guru/openapi-directory#licenses" @@ -70,16 +70,16 @@ --- Code - test_result <- api_info(apid_list = apid_list_awsmh) + test_result <- info(apid_list = apid_list_awsmh) test_result Output - - @ contact : + + @ contact : .. @ name : chr "Mike Ralphson" .. @ email: chr "mike.ralphson@gmail.com" .. @ url : chr "https://github.com/mermade/aws2openapi" @ description : chr "

The AWS Migration Hub API methods help to obtain server and application migration status and integrate your "| __truncated__ - @ license : + @ license : .. @ name : chr "Apache 2.0 License" .. @ identifier: chr(0) .. @ url : chr "http://www.apache.org/licenses/" diff --git a/tests/testthat/_snaps/zz-rapid.md b/tests/testthat/_snaps/zz-rapid.md index 51ccf6a..cf74465 100644 --- a/tests/testthat/_snaps/zz-rapid.md +++ b/tests/testthat/_snaps/zz-rapid.md @@ -1,11 +1,11 @@ -# rapid() requires api_info objects for info +# rapid() requires info objects for info Code rapid(info = mean) Condition Error: ! object properties are invalid: - - @info must be , not + - @info must be , not # rapid() requires info when anything is defined @@ -27,13 +27,13 @@ test_result Output - @ info : - .. @ contact : + @ info : + .. @ contact : .. .. @ name : chr(0) .. .. @ email: chr(0) .. .. @ url : chr(0) .. @ description : chr(0) - .. @ license : + .. @ license : .. .. @ name : chr(0) .. .. @ identifier: chr(0) .. .. @ url : chr(0) @@ -53,13 +53,13 @@ test_result Output - @ info : - .. @ contact : + @ info : + .. @ contact : .. .. @ name : chr "APIs.guru" .. .. @ email: chr "mike.ralphson@gmail.com" .. .. @ url : chr "https://APIs.guru" .. @ description : chr "Wikipedia for Web APIs. Repository of API definitions in OpenAPI format.\n**Warning**: If you want to be notifi"| __truncated__ - .. @ license : + .. @ license : .. .. @ name : chr "CC0 1.0" .. .. @ identifier: chr(0) .. .. @ url : chr "https://github.com/APIs-guru/openapi-directory#licenses" @@ -84,13 +84,13 @@ test_result Output - @ info : - .. @ contact : + @ info : + .. @ contact : .. .. @ name : chr "Mike Ralphson" .. .. @ email: chr "mike.ralphson@gmail.com" .. .. @ url : chr "https://github.com/mermade/aws2openapi" .. @ description : chr "

The AWS Migration Hub API methods help to obtain server and application migration status and integrate your "| __truncated__ - .. @ license : + .. @ license : .. .. @ name : chr "Apache 2.0 License" .. .. @ identifier: chr(0) .. .. @ url : chr "http://www.apache.org/licenses/" @@ -134,13 +134,13 @@ test_result Output - @ info : - .. @ contact : + @ info : + .. @ contact : .. .. @ name : chr "APIs.guru" .. .. @ email: chr "mike.ralphson@gmail.com" .. .. @ url : chr "https://APIs.guru" .. @ description : chr "Wikipedia for Web APIs. Repository of API definitions in OpenAPI format.\n**Warning**: If you want to be notifi"| __truncated__ - .. @ license : + .. @ license : .. .. @ name : chr "CC0 1.0" .. .. @ identifier: chr(0) .. .. @ url : chr "https://github.com/APIs-guru/openapi-directory#licenses" @@ -165,13 +165,13 @@ test_result Output - @ info : - .. @ contact : + @ info : + .. @ contact : .. .. @ name : chr "Mike Ralphson" .. .. @ email: chr "mike.ralphson@gmail.com" .. .. @ url : chr "https://github.com/mermade/aws2openapi" .. @ description : chr "

The AWS Migration Hub API methods help to obtain server and application migration status and integrate your "| __truncated__ - .. @ license : + .. @ license : .. .. @ name : chr "Apache 2.0 License" .. .. @ identifier: chr(0) .. .. @ url : chr "http://www.apache.org/licenses/" diff --git a/tests/testthat/test-info-01-contact.R b/tests/testthat/test-info-01-contact.R index 43f9a92..28ff7ef 100644 --- a/tests/testthat/test-info-01-contact.R +++ b/tests/testthat/test-info-01-contact.R @@ -1,47 +1,47 @@ -test_that("api_contact() errors informatively for bad name", { +test_that("contact() errors informatively for bad name", { expect_snapshot( - api_contact(name = mean), + contact(name = mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_contact(name = c("A", "B")), + contact(name = c("A", "B")), error = TRUE, cnd_class = TRUE ) }) -test_that("api_contact() errors informatively for bad url", { +test_that("contact() errors informatively for bad url", { expect_snapshot( - api_contact(name = "A", url = mean), + contact(name = "A", url = mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_contact(name = "A", url = c("A", "B")), + contact(name = "A", url = c("A", "B")), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_contact(name = "A", url = "not a real url"), + contact(name = "A", url = "not a real url"), error = TRUE, cnd_class = TRUE ) }) -test_that("api_contact() errors informatively for bad email", { +test_that("contact() errors informatively for bad email", { expect_snapshot( - api_contact(name = "A", url = "https://example.com", email = mean), + contact(name = "A", url = "https://example.com", email = mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_contact(name = "A", url = "https://example.com", email = c("A", "B")), + contact(name = "A", url = "https://example.com", email = c("A", "B")), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_contact( + contact( name = "A", url = "https://example.com", email = "not a real email" @@ -51,9 +51,9 @@ test_that("api_contact() errors informatively for bad email", { ) }) -test_that("api_contact() returns a contact when everything is ok", { +test_that("contact() returns a contact when everything is ok", { expect_snapshot({ - test_result <- api_contact( + test_result <- contact( name = "A", url = "https://example.com", email = "real.email@address.place" @@ -62,7 +62,7 @@ test_that("api_contact() returns a contact when everything is ok", { }) expect_s3_class( test_result, - class = c("rapid::api_contact", "S7_object"), + class = c("rapid::contact", "S7_object"), exact = TRUE ) expect_identical( @@ -71,14 +71,14 @@ test_that("api_contact() returns a contact when everything is ok", { ) }) -test_that("api_contact() without args returns an empty api_contact", { +test_that("contact() without args returns an empty contact", { expect_snapshot({ - test_result <- api_contact() + test_result <- contact() test_result }) expect_s3_class( test_result, - class = c("rapid::api_contact", "S7_object"), + class = c("rapid::contact", "S7_object"), exact = TRUE ) expect_identical( @@ -87,103 +87,103 @@ test_that("api_contact() without args returns an empty api_contact", { ) }) -test_that("length() of an api_contact reports the overall length", { - expect_equal(length(api_contact()), 0) - expect_equal(length(api_contact(name = "A")), 1) +test_that("length() of an contact reports the overall length", { + expect_equal(length(contact()), 0) + expect_equal(length(contact(name = "A")), 1) }) -test_that("as_api_contact() errors informatively for unnamed or misnamed input", { +test_that("as_contact() errors informatively for unnamed or misnamed input", { expect_snapshot( - as_api_contact(letters), + as_contact(letters), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_api_contact(list(a = "Jon", b = "jonthegeek@gmail.com")), + as_contact(list(a = "Jon", b = "jonthegeek@gmail.com")), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_api_contact(c(a = "Jon", b = "jonthegeek@gmail.com")), + as_contact(c(a = "Jon", b = "jonthegeek@gmail.com")), error = TRUE, cnd_class = TRUE ) }) -test_that("as_api_contact() errors informatively for bad classes", { +test_that("as_contact() errors informatively for bad classes", { expect_snapshot( - as_api_contact(1:2), + as_contact(1:2), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_api_contact(mean), + as_contact(mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_api_contact(TRUE), + as_contact(TRUE), error = TRUE, cnd_class = TRUE ) }) -test_that("as_api_contact() returns expected objects", { +test_that("as_contact() returns expected objects", { expect_identical( - as_api_contact( + as_contact( c( name = "Jon", email = "jonthegeek@gmail.com", url = "https://jonthegeek.com" ) ), - api_contact( + contact( name = "Jon", email = "jonthegeek@gmail.com", url = "https://jonthegeek.com" ) ) expect_identical( - as_api_contact( + as_contact( c( name = "Jon", email = "jonthegeek@gmail.com", x = "https://jonthegeek.com" ) ), - api_contact( + contact( name = "Jon", email = "jonthegeek@gmail.com" ) ) expect_identical( - as_api_contact( + as_contact( c( email = "jonthegeek@gmail.com", name = "Jon", x = "https://jonthegeek.com" ) ), - api_contact( + contact( name = "Jon", email = "jonthegeek@gmail.com" ) ) expect_identical( - as_api_contact( + as_contact( list( name = "Jon", email = "jonthegeek@gmail.com", x = "https://jonthegeek.com" ) ), - api_contact( + contact( name = "Jon", email = "jonthegeek@gmail.com" ) ) expect_identical( - as_api_contact(list()), - api_contact() + as_contact(list()), + contact() ) }) diff --git a/tests/testthat/test-info-01-license.R b/tests/testthat/test-info-01-license.R index 7aa66af..9627279 100644 --- a/tests/testthat/test-info-01-license.R +++ b/tests/testthat/test-info-01-license.R @@ -1,78 +1,78 @@ -test_that("api_license() errors informatively for bad name", { +test_that("license() errors informatively for bad name", { expect_snapshot( - api_license(name = mean), + license(name = mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_license(name = c("A", "B")), + license(name = c("A", "B")), error = TRUE, cnd_class = TRUE ) }) -test_that("api_license() errors informatively for bad url", { +test_that("license() errors informatively for bad url", { expect_snapshot( - api_license(name = "A", url = mean), + license(name = "A", url = mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_license(name = "A", url = c("A", "B")), + license(name = "A", url = c("A", "B")), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_license(name = "A", url = "not a real url"), + license(name = "A", url = "not a real url"), error = TRUE, cnd_class = TRUE ) }) -test_that("api_license() errors informatively for bad identifier", { +test_that("license() errors informatively for bad identifier", { expect_snapshot( - api_license(name = "A", identifier = mean), + license(name = "A", identifier = mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_license(name = "A", identifier = c("A", "B")), + license(name = "A", identifier = c("A", "B")), error = TRUE, cnd_class = TRUE ) }) -test_that("api_license() errors informatively when both url and identifier are supplied", { +test_that("license() errors informatively when both url and identifier are supplied", { expect_snapshot( - api_license(name = "A", identifier = "A", url = "https://example.com"), + license(name = "A", identifier = "A", url = "https://example.com"), error = TRUE, cnd_class = TRUE ) }) -test_that("api_license() fails when name is missing", { +test_that("license() fails when name is missing", { expect_snapshot( - api_license(identifier = "A"), + license(identifier = "A"), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_license(url = "https://example.com"), + license(url = "https://example.com"), error = TRUE, cnd_class = TRUE ) }) -test_that("api_license() doesn't match identifier by position", { +test_that("license() doesn't match identifier by position", { expect_snapshot( - api_license(name = "A", "https://example.com"), + license(name = "A", "https://example.com"), error = TRUE, cnd_class = TRUE ) }) -test_that("api_license() returns a license when everything is ok", { +test_that("license() returns a license when everything is ok", { expect_snapshot({ - test_result <- api_license( + test_result <- license( name = "A", url = "https://example.com" ) @@ -80,7 +80,7 @@ test_that("api_license() returns a license when everything is ok", { }) expect_s3_class( test_result, - class = c("rapid::api_license", "S7_object"), + class = c("rapid::license", "S7_object"), exact = TRUE ) expect_identical( @@ -89,7 +89,7 @@ test_that("api_license() returns a license when everything is ok", { ) expect_snapshot({ - test_result <- api_license( + test_result <- license( name = "A", identifier = "technically these have a fancy required format" ) @@ -97,7 +97,7 @@ test_that("api_license() returns a license when everything is ok", { }) expect_s3_class( test_result, - class = c("rapid::api_license", "S7_object"), + class = c("rapid::license", "S7_object"), exact = TRUE ) expect_identical( @@ -106,7 +106,20 @@ test_that("api_license() returns a license when everything is ok", { ) }) -test_that("length() of an api_license reports the overall length", { - expect_equal(length(api_license()), 0) - expect_equal(length(api_license(name = "A")), 1) +test_that("length() of an license reports the overall length", { + expect_equal(length(license()), 0) + expect_equal(length(license(name = "A")), 1) }) + +# TODO: Copy/adapt tests from test-info-01-contact.R for as_license (and +# as_* throughout these). + +# TODO: Implement as_*. +# +# TODO: Get rid of apid_list args (and maybe apid_url). Maybe as_* should figure +# out if it's a url? +# +# TODO: Prettier printing. +# +# TODO: After all that, I think I want to implement components$securitySchemas +# (etc) to have enough to hit checkpoint 1 for {beekeeper}. diff --git a/tests/testthat/test-info-zz-info.R b/tests/testthat/test-info-zz-info.R index a97c0c6..45c2e37 100644 --- a/tests/testthat/test-info-zz-info.R +++ b/tests/testthat/test-info-zz-info.R @@ -3,32 +3,32 @@ # object should allow issues, and then we can check what's missing that should # be there and report on it, likely via a subclass. -test_that("api_info() requires URLs for TOS", { +test_that("info() requires URLs for TOS", { expect_snapshot( - api_info(terms_of_service = mean), + info(terms_of_service = mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_info(terms_of_service = c("A", "B")), + info(terms_of_service = c("A", "B")), error = TRUE, cnd_class = TRUE ) expect_snapshot( - api_info(terms_of_service = "not a real url"), + info(terms_of_service = "not a real url"), error = TRUE, cnd_class = TRUE ) }) -test_that("api_info() returns an empty api_info", { +test_that("info() returns an empty info", { expect_snapshot({ - test_result <- api_info() + test_result <- info() test_result }) expect_s3_class( test_result, - class = c("rapid::api_info", "S7_object"), + class = c("rapid::info", "S7_object"), exact = TRUE ) expect_identical( @@ -45,13 +45,13 @@ test_that("api_info() returns an empty api_info", { ) }) -test_that("length() of an api_info reports the overall length", { - expect_equal(length(api_info()), 0) +test_that("length() of an info reports the overall length", { + expect_equal(length(info()), 0) expect_equal( length( - api_info( + info( title = "My Cool API", - license = api_license( + license = license( name = "Apache 2.0", url = "https://opensource.org/license/apache-2-0/" ) @@ -61,17 +61,17 @@ test_that("length() of an api_info reports the overall length", { ) }) -test_that("Can construct an api_contact from an api spec", { +test_that("Can construct an contact from an api spec", { # apid_list_guru <- yaml::read_yaml("https://api.apis.guru/v2/openapi.yaml") # saveRDS(apid_list_guru, test_path("fixtures", "apid_list_guru.rds")) apid_list_guru <- readRDS(test_path("fixtures", "apid_list_guru.rds")) expect_snapshot({ - test_result <- api_info(apid_list = apid_list_guru) + test_result <- info(apid_list = apid_list_guru) test_result }) expect_s3_class( test_result, - class = c("rapid::api_info", "S7_object"), + class = c("rapid::info", "S7_object"), exact = TRUE ) @@ -79,12 +79,12 @@ test_that("Can construct an api_contact from an api spec", { # saveRDS(apid_list_awsmh, test_path("fixtures", "apid_list_awsmh.rds")) apid_list_awsmh <- readRDS(test_path("fixtures", "apid_list_awsmh.rds")) expect_snapshot({ - test_result <- api_info(apid_list = apid_list_awsmh) + test_result <- info(apid_list = apid_list_awsmh) test_result }) expect_s3_class( test_result, - class = c("rapid::api_info", "S7_object"), + class = c("rapid::info", "S7_object"), exact = TRUE ) }) diff --git a/tests/testthat/test-zz-rapid.R b/tests/testthat/test-zz-rapid.R index 1652edd..49eed62 100644 --- a/tests/testthat/test-zz-rapid.R +++ b/tests/testthat/test-zz-rapid.R @@ -1,7 +1,7 @@ # I'm building this as I have pieces ready, so the tests will change as I add # more sub-objects. -test_that("rapid() requires api_info objects for info", { +test_that("rapid() requires info objects for info", { expect_snapshot( rapid(info = mean), error = TRUE, @@ -53,7 +53,7 @@ test_that("length() of a rapid reports the overall length", { expect_equal( length( rapid( - info = api_info(title = "A", version = "1"), + info = info(title = "A", version = "1"), servers( url = "https://development.gigantic-server.com/v1" ) @@ -64,7 +64,7 @@ test_that("length() of a rapid reports the overall length", { expect_equal( length( rapid( - info = api_info(title = "A", version = "1"), + info = info(title = "A", version = "1"), servers( url = c( "https://development.gigantic-server.com/v1", From e45103a703c39aeda1819c0e3df4a43deb9a3134 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Wed, 6 Sep 2023 15:33:31 -0500 Subject: [PATCH 04/19] Remove noisy TODOs. --- R/00-properties.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/00-properties.R b/R/00-properties.R index c1b2e9d..26d0a2b 100644 --- a/R/00-properties.R +++ b/R/00-properties.R @@ -4,7 +4,6 @@ character_scalar_property <- function(x_arg, ...) { S7::new_property( class = class_character, setter = function(self, value) { - # TODO: Watch S7 dev to see if this can be less hacky. call <- rlang::caller_env(3) value <- value %||% character() value <- stbl::stabilize_chr_scalar( @@ -24,7 +23,6 @@ character_property <- function(x_arg, ...) { S7::new_property( class = class_character, setter = function(self, value) { - # TODO: Watch S7 dev to see if this can be less hacky. call <- rlang::caller_env(3) value <- value %||% character() value <- stbl::stabilize_chr( From f83057edb44069c0e4d262716741643c985d5641 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Thu, 7 Sep 2023 10:28:11 -0500 Subject: [PATCH 05/19] Return *all* the length issues, not just the first one. Closes #33. --- R/info-01-license.R | 2 +- R/servers-01-server_variable.R | 2 +- R/validate_lengths.R | 129 +++++++++++++++++---------------- R/validate_parallel.R | 4 +- R/zz-rapid.R | 5 +- 5 files changed, 70 insertions(+), 72 deletions(-) diff --git a/R/info-01-license.R b/R/info-01-license.R index 9c3a456..0022a8b 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -45,7 +45,7 @@ license <- S7::new_class( if (length(self@identifier) && length(self@url)) { return("At most one of @identifier and @url must be supplied.") } - validate_parallel(self, key = "name", optional = c("identifier", "url")) + validate_parallel(self, "name", optional = c("identifier", "url")) } ) diff --git a/R/servers-01-server_variable.R b/R/servers-01-server_variable.R index f2f78cb..de7f098 100644 --- a/R/servers-01-server_variable.R +++ b/R/servers-01-server_variable.R @@ -55,7 +55,7 @@ server_variable <- S7::new_class( validator = function(self) { validate_parallel( self, - key = "name", + "name", required = "default", optional = c("enum", "description") ) %||% validate_in_enum( diff --git a/R/validate_lengths.R b/R/validate_lengths.R index 816d13b..8725a5a 100644 --- a/R/validate_lengths.R +++ b/R/validate_lengths.R @@ -1,97 +1,98 @@ validate_lengths <- function(obj, - key, - key_max_length = NULL, + key_name, required_same = NULL, required_any = NULL, optional_same = NULL, optional_any = NULL) { - key_len <- .prop_lengths(obj, key) + key_length <- .prop_lengths(obj, key_name) - if (!is.null(key_max_length) && key_len > key_max_length) { - return( - c( - cli::format_inline( - "{.arg {key}} must have at most {key_max_length) value{?s}." - ), - .msg_sizes(key, key_len) - ) - ) + if (!key_length) { + all_others <- c(required_same, required_any, optional_same, optional_any) + return(.msg_empty(key_name, all_others, .prop_lengths(obj, all_others))) } - if (!key_len) { - return(.msg_empty( - key, - c(required_same, required_any, optional_same, optional_any), - .prop_lengths( - obj, - c(required_same, required_any, optional_same, optional_any) - ) - )) - } + issues <- character() if (!is.null(required_same)) { - required_same_lens <- .prop_lengths(obj, required_same) - if (!all(required_same_lens == key_len)) { - return(.msg_same(key, key_len, required_same, required_same_lens)) - } + issues <- c(issues, .check_same(obj, key_name, key_length, required_same)) } if (!is.null(required_any)) { - required_any_lens <- .prop_lengths(obj, required_any) - if (!all(required_any_lens)) { - return(.msg_non_empty(key, required_any, required_any_lens)) - } + issues <- c(issues, .check_non_empty(obj, key_name, required_any)) } if (!is.null(optional_same)) { - optional_same_lens <- .prop_lengths(obj, optional_same) - if (any(optional_same_lens & optional_same_lens != key_len)) { - return( - .msg_same_or_empty(key, key_len, optional_same, optional_same_lens) - ) - } + issues <- c( + issues, + .check_same_or_empty(obj, key_name, key_length, optional_same) + ) + } + + if (!length(issues)) { + return(NULL) } + return(unique(issues)) } -.msg_same <- function(key_name, key_length, prop_names, prop_lengths) { - bad_lengths <- prop_lengths != key_length - not_same <- prop_names[bad_lengths] - return( - c( - cli::format_inline( - "{.arg {not_same}} must have the same length as {.arg {key_name}}" - ), - .msg_sizes(key_name, key_length), - .msg_sizes(not_same, prop_lengths[bad_lengths]) - ) +.check_same <- function(obj, key_name, key_length, prop_names) { + prop_lengths <- .prop_lengths(obj, prop_names) + have_bad_lengths <- prop_lengths != key_length + if (any(have_bad_lengths)) { + not_same <- prop_names[have_bad_lengths] + bad_lengths <- prop_lengths[have_bad_lengths] + return(.msg_must_have_same(key_name, key_length, not_same, bad_lengths)) + } + return(character()) +} +.msg_must_have_same <- function(key_name, key_length, not_same, bad_lengths) { + c( + cli::format_inline( + "{.arg {not_same}} must have the same length as {.arg {key_name}}" + ), + .msg_sizes(key_name, key_length), + .msg_sizes(not_same, bad_lengths) ) } -.msg_non_empty <- function(key_name, prop_names, prop_lengths) { - bad_lengths <- !prop_lengths - if (any(bad_lengths)) { - empty <- prop_names[bad_lengths] - return(cli::format_inline( - "When {.arg {key_name}} is defined, {.arg {empty}} must not be empty." - )) +.check_non_empty <- function(obj, key_name, prop_names) { + prop_lengths <- .prop_lengths(obj, prop_names) + empty <- prop_names[prop_lengths == 0] + if (any(empty)) { + return(.msg_non_empty(key_name, empty)) } } +.msg_non_empty <- function(key_name, empty) { + cli::format_inline( + "When {.arg {key_name}} is defined, {.arg {empty}} must not be empty." + ) +} -.msg_same_or_empty <- function(key_name, key_length, prop_names, prop_lengths) { - bad_lengths <- prop_lengths & prop_lengths != key_length - if (any(bad_lengths)) { - bad_size <- prop_names[bad_lengths] +.check_same_or_empty <- function(obj, key_name, key_length, prop_names) { + prop_lengths <- .prop_lengths(obj, prop_names) + have_bad_lengths <- prop_lengths & prop_lengths != key_length + if (any(have_bad_lengths)) { return( - c( - cli::format_inline( - "{.arg {bad_size}} must be empty or have the same length as {.arg {key_name}}" - ), - .msg_sizes(key_name, key_length), - .msg_sizes(bad_size, prop_lengths[bad_lengths]) + .msg_not_same_or_empty( + key_name, + key_length, + prop_names[have_bad_lengths], + prop_lengths[have_bad_lengths] ) ) } } +.msg_not_same_or_empty <- function(key_name, + key_length, + bad_props, + bad_lengths) { + c( + cli::format_inline( + "{.arg {bad_props}} must be empty or have the same length as {.arg {key_name}}" + ), + .msg_sizes(key_name, key_length), + .msg_sizes(bad_props, bad_lengths) + ) +} .msg_empty <- function(key_name, prop_names, prop_lengths = NULL) { bad_lengths <- prop_lengths > 0 diff --git a/R/validate_parallel.R b/R/validate_parallel.R index 0e00034..00b339d 100644 --- a/R/validate_parallel.R +++ b/R/validate_parallel.R @@ -1,10 +1,10 @@ validate_parallel <- function(obj, - key, + key_name, required = NULL, optional = NULL) { validate_lengths( obj = obj, - key = key, + key_name = key_name, required_same = required, optional_same = optional ) diff --git a/R/zz-rapid.R b/R/zz-rapid.R index b091121..1c14197 100644 --- a/R/zz-rapid.R +++ b/R/zz-rapid.R @@ -60,10 +60,7 @@ rapid <- S7::new_class( validator = function(self) { validate_lengths( self, - key = "info", - # In this case the max length is redundant, since info can only have - # length 0 or 1. - key_max_length = 1, + key_name = "info", optional_any = "servers" ) } From 6a9a0002d8380f517560f19526f857a6a7cf720a Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Thu, 7 Sep 2023 12:58:20 -0500 Subject: [PATCH 06/19] Implement as_license. --- NAMESPACE | 1 + R/as.R | 18 +++++ R/info-01-contact.R | 19 ++--- R/info-01-license.R | 34 ++++++++- man/as_contact.Rd | 6 +- man/as_license.Rd | 23 ++++++ man/contact.Rd | 2 +- man/license.Rd | 3 +- tests/testthat/_snaps/info-01-contact.md | 6 +- tests/testthat/_snaps/info-01-license.md | 51 +++++++++++++ tests/testthat/_snaps/info-zz-info.md | 2 +- tests/testthat/test-info-01-contact.R | 2 +- tests/testthat/test-info-01-license.R | 96 +++++++++++++++++++++++- tests/testthat/test-info-zz-info.R | 2 +- 14 files changed, 234 insertions(+), 31 deletions(-) create mode 100644 R/as.R create mode 100644 man/as_license.Rd diff --git a/NAMESPACE b/NAMESPACE index 3a0fbda..641aae6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ S3method(length,"rapid::rapid") S3method(length,"rapid::server_variable") S3method(length,"rapid::servers") export(as_contact) +export(as_license) export(contact) export(info) export(license) diff --git a/R/as.R b/R/as.R new file mode 100644 index 0000000..9cc1620 --- /dev/null +++ b/R/as.R @@ -0,0 +1,18 @@ +.validate_named_list <- function(x, + valid_names, + x_arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if ( + length(x) && + (!rlang::is_named(x) || !any(names(x) %in% valid_names)) + ) { + cli::cli_abort( + c( + "{.arg {x_arg}} must have names {.or {.val {valid_names}}}.", + "*" = "Any other names are ignored." + ), + call = call + ) + } + return(as.list(x)) +} diff --git a/R/info-01-contact.R b/R/info-01-contact.R index e98a85c..7bdba0e 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -9,7 +9,7 @@ #' @param email The email address of the contact person/organization. This #' *must* be in the form of an email address. #' -#' @return An `contact` S7 object, with fields `name`, `email`, and `url`. +#' @return A `contact` S7 object, with fields `name`, `email`, and `url`. #' @export #' #' @examples @@ -44,14 +44,14 @@ contact <- S7::new_class( #' Coerce lists and character vectors to contacts #' -#' `as_contact()` turns an existing object into an `contact`. This is in -#' contrast with [contact()], which builds an `contact` from individual +#' `as_contact()` turns an existing object into a `contact`. This is in +#' contrast with [contact()], which builds a `contact` from individual #' properties. #' #' @param x The object to coerce. Must be empty or have names "name", "email", #' and/or "url". Extra names are ignored. #' -#' @return An `contact` as returned by [contact()]. +#' @return A `contact` as returned by [contact()]. #' @export #' #' @examples @@ -60,16 +60,7 @@ contact <- S7::new_class( as_contact <- S7::new_generic("as_contact", dispatch_args = "x") S7::method(as_contact, class_list | class_character) <- function(x) { - if ( - length(x) && - (!rlang::is_named(x) || !any(names(x) %in% c("name", "email", "url"))) - ) { - cli::cli_abort(c( - "{.arg x} must have names {.val name}, {.val email}, and/or {.val url}.", - "*" = "Any other names are ignored." - )) - } - x <- as.list(x) + x <- .validate_named_list(x, c("name", "email", "url")) contact(name = x[["name"]], email = x[["email"]], url = x[["url"]]) } diff --git a/R/info-01-license.R b/R/info-01-license.R index 0022a8b..626994b 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -13,8 +13,7 @@ #' @param url A URL to the license used for the API. This *must* be in the form #' of a URL. The `url` field is mutually exclusive of the `identifier` field. #' -#' @return An `license` S7 object, with fields `name`, `identifier`, and -#' `url`. +#' @return A `license` S7 object, with fields `name`, `identifier`, and `url`. #' @export #' #' @examples @@ -53,3 +52,34 @@ license <- S7::new_class( `length.rapid::license` <- function(x) { length(x@name) } + +#' Coerce lists and character vectors to licenses +#' +#' `as_license()` turns an existing object into a `license`. This is in contrast +#' with [license()], which builds a `license` from individual properties. +#' +#' @param x The object to coerce. Must be empty or have names "name", +#' "identifier", and/or "url". Extra names are ignored. +#' +#' @return A `license` as returned by [license()]. +#' @export +#' +#' @examples +#' as_license() +#' as_license(list(name = "Apache 2.0", identifier = "Apache-2.0")) +as_license <- S7::new_generic("as_license", dispatch_args = "x") + +S7::method(as_license, class_list | class_character) <- function(x) { + x <- .validate_named_list(x, c("name", "identifier", "url")) + license(name = x[["name"]], identifier = x[["identifier"]], url = x[["url"]]) +} + +S7::method(as_license, class_missing) <- function(x) { + license() +} + +S7::method(as_license, class_any) <- function(x) { + cli::cli_abort( + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls license}." + ) +} diff --git a/man/as_contact.Rd b/man/as_contact.Rd index aebe69f..74c27a4 100644 --- a/man/as_contact.Rd +++ b/man/as_contact.Rd @@ -11,11 +11,11 @@ as_contact(x, ...) and/or "url". Extra names are ignored.} } \value{ -An \code{contact} as returned by \code{\link[=contact]{contact()}}. +A \code{contact} as returned by \code{\link[=contact]{contact()}}. } \description{ -\code{as_contact()} turns an existing object into an \code{contact}. This is in -contrast with \code{\link[=contact]{contact()}}, which builds an \code{contact} from individual +\code{as_contact()} turns an existing object into a \code{contact}. This is in +contrast with \code{\link[=contact]{contact()}}, which builds a \code{contact} from individual properties. } \examples{ diff --git a/man/as_license.Rd b/man/as_license.Rd new file mode 100644 index 0000000..69a383f --- /dev/null +++ b/man/as_license.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/info-01-license.R +\name{as_license} +\alias{as_license} +\title{Coerce lists and character vectors to licenses} +\usage{ +as_license(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or have names "name", +"identifier", and/or "url". Extra names are ignored.} +} +\value{ +A \code{license} as returned by \code{\link[=license]{license()}}. +} +\description{ +\code{as_license()} turns an existing object into a \code{license}. This is in contrast +with \code{\link[=license]{license()}}, which builds a \code{license} from individual properties. +} +\examples{ +as_license() +as_license(list(name = "Apache 2.0", identifier = "Apache-2.0")) +} diff --git a/man/contact.Rd b/man/contact.Rd index 28bdf23..0cd5851 100644 --- a/man/contact.Rd +++ b/man/contact.Rd @@ -18,7 +18,7 @@ form of a URL.} \item{...}{Catch-all for unimplemented properties.} } \value{ -An \code{contact} S7 object, with fields \code{name}, \code{email}, and \code{url}. +A \code{contact} S7 object, with fields \code{name}, \code{email}, and \code{url}. } \description{ Validate the contact information for an API. diff --git a/man/license.Rd b/man/license.Rd index 9d7eb17..25539df 100644 --- a/man/license.Rd +++ b/man/license.Rd @@ -20,8 +20,7 @@ exclusive of the \code{url} field.} of a URL. The \code{url} field is mutually exclusive of the \code{identifier} field.} } \value{ -An \code{license} S7 object, with fields \code{name}, \code{identifier}, and -\code{url}. +A \code{license} S7 object, with fields \code{name}, \code{identifier}, and \code{url}. } \description{ Validate the license information for an API. diff --git a/tests/testthat/_snaps/info-01-contact.md b/tests/testthat/_snaps/info-01-contact.md index 4443f1d..e194e60 100644 --- a/tests/testthat/_snaps/info-01-contact.md +++ b/tests/testthat/_snaps/info-01-contact.md @@ -97,7 +97,7 @@ as_contact(letters) Condition Error: - ! `x` must have names "name", "email", and/or "url". + ! `x` must have names "name", "email", or "url". * Any other names are ignored. --- @@ -106,7 +106,7 @@ as_contact(list(a = "Jon", b = "jonthegeek@gmail.com")) Condition Error: - ! `x` must have names "name", "email", and/or "url". + ! `x` must have names "name", "email", or "url". * Any other names are ignored. --- @@ -115,7 +115,7 @@ as_contact(c(a = "Jon", b = "jonthegeek@gmail.com")) Condition Error: - ! `x` must have names "name", "email", and/or "url". + ! `x` must have names "name", "email", or "url". * Any other names are ignored. # as_contact() errors informatively for bad classes diff --git a/tests/testthat/_snaps/info-01-license.md b/tests/testthat/_snaps/info-01-license.md index d06379c..5f2b594 100644 --- a/tests/testthat/_snaps/info-01-license.md +++ b/tests/testthat/_snaps/info-01-license.md @@ -121,3 +121,54 @@ @ identifier: chr "technically these have a fancy required format" @ url : chr(0) +# as_license() errors informatively for unnamed or misnamed input + + Code + as_license(letters) + Condition + Error: + ! `x` must have names "name", "identifier", or "url". + * Any other names are ignored. + +--- + + Code + as_license(list(a = "Apache 2.0", b = "https://opensource.org/license/apache-2-0/")) + Condition + Error: + ! `x` must have names "name", "identifier", or "url". + * Any other names are ignored. + +--- + + Code + as_license(c(a = "Apache 2.0", b = "https://opensource.org/license/apache-2-0/")) + Condition + Error: + ! `x` must have names "name", "identifier", or "url". + * Any other names are ignored. + +# as_license() errors informatively for bad classes + + Code + as_license(1:2) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_license(mean) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_license(TRUE) + Condition + Error: + ! Can't coerce `x` to . + diff --git a/tests/testthat/_snaps/info-zz-info.md b/tests/testthat/_snaps/info-zz-info.md index c6b3ca7..154b08f 100644 --- a/tests/testthat/_snaps/info-zz-info.md +++ b/tests/testthat/_snaps/info-zz-info.md @@ -46,7 +46,7 @@ @ title : chr(0) @ version : chr(0) -# Can construct an contact from an api spec +# Can construct a contact from an api spec Code test_result <- info(apid_list = apid_list_guru) diff --git a/tests/testthat/test-info-01-contact.R b/tests/testthat/test-info-01-contact.R index 28ff7ef..272e3bb 100644 --- a/tests/testthat/test-info-01-contact.R +++ b/tests/testthat/test-info-01-contact.R @@ -87,7 +87,7 @@ test_that("contact() without args returns an empty contact", { ) }) -test_that("length() of an contact reports the overall length", { +test_that("length() of a contact reports the overall length", { expect_equal(length(contact()), 0) expect_equal(length(contact(name = "A")), 1) }) diff --git a/tests/testthat/test-info-01-license.R b/tests/testthat/test-info-01-license.R index 9627279..e36820f 100644 --- a/tests/testthat/test-info-01-license.R +++ b/tests/testthat/test-info-01-license.R @@ -106,13 +106,103 @@ test_that("license() returns a license when everything is ok", { ) }) -test_that("length() of an license reports the overall length", { +test_that("length() of a license reports the overall length", { expect_equal(length(license()), 0) expect_equal(length(license(name = "A")), 1) }) -# TODO: Copy/adapt tests from test-info-01-contact.R for as_license (and -# as_* throughout these). +test_that("as_license() errors informatively for unnamed or misnamed input", { + expect_snapshot( + as_license(letters), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_license(list(a = "Apache 2.0", b = "https://opensource.org/license/apache-2-0/")), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_license(c(a = "Apache 2.0", b = "https://opensource.org/license/apache-2-0/")), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_license() errors informatively for bad classes", { + expect_snapshot( + as_license(1:2), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_license(mean), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_license(TRUE), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_license() returns expected objects", { + expect_identical( + as_license(c( + name = "Apache 2.0", + identifier = "Apache-2.0" + )), + license( + name = "Apache 2.0", + identifier = "Apache-2.0" + ) + ) + expect_identical( + as_license(c( + name = "Apache 2.0", + identifier = "Apache-2.0", + x = "https://jonthegeek.com" + )), + license( + name = "Apache 2.0", + identifier = "Apache-2.0" + ) + ) + expect_identical( + as_license( + c( + identifier = "Apache-2.0", + name = "Apache 2.0", + x = "https://jonthegeek.com" + ) + ), + license( + name = "Apache 2.0", + identifier = "Apache-2.0" + ) + ) + expect_identical( + as_license( + list( + name = "Apache 2.0", + identifier = "Apache-2.0", + x = "https://jonthegeek.com" + ) + ), + license( + name = "Apache 2.0", + identifier = "Apache-2.0" + ) + ) + expect_identical( + as_license(list()), + license() + ) +}) + +# TODO: Reconsider server format. Closer mirroring of OAS seems appropriate. Or +# maybe a tribble equivalent. # TODO: Implement as_*. # diff --git a/tests/testthat/test-info-zz-info.R b/tests/testthat/test-info-zz-info.R index 45c2e37..e16369f 100644 --- a/tests/testthat/test-info-zz-info.R +++ b/tests/testthat/test-info-zz-info.R @@ -61,7 +61,7 @@ test_that("length() of an info reports the overall length", { ) }) -test_that("Can construct an contact from an api spec", { +test_that("Can construct a contact from an api spec", { # apid_list_guru <- yaml::read_yaml("https://api.apis.guru/v2/openapi.yaml") # saveRDS(apid_list_guru, test_path("fixtures", "apid_list_guru.rds")) apid_list_guru <- readRDS(test_path("fixtures", "apid_list_guru.rds")) From 0f34f25ccb528ec0f60a253efe84c100ecb6cbe6 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Thu, 7 Sep 2023 15:40:11 -0500 Subject: [PATCH 07/19] Don't check urls. The regex doesn't actually work, and these urls can be non-standard. We don't really care about these until we're using them, let's let people do weird things here. --- R/00-properties.R | 29 ---- R/00-shared-params.R | 3 - R/info-01-contact.R | 14 +- R/info-01-license.R | 2 +- R/info-zz-info.R | 37 +---- R/servers-01-server_variable.R | 6 +- R/servers-zz-servers.R | 11 +- man/contact.Rd | 7 +- man/dot-shared-parameters.Rd | 5 - man/info.Rd | 12 +- man/rapid.Rd | 5 - man/server_variable_list.Rd | 3 - man/servers.Rd | 10 +- tests/testthat/_snaps/info-01-contact.md | 27 ---- tests/testthat/_snaps/info-01-license.md | 10 -- tests/testthat/_snaps/info-zz-info.md | 69 --------- tests/testthat/_snaps/servers-zz-servers.md | 28 ---- tests/testthat/_snaps/zz-rapid.md | 162 -------------------- tests/testthat/test-info-01-contact.R | 18 --- tests/testthat/test-info-01-license.R | 5 - tests/testthat/test-info-zz-info.R | 46 ------ tests/testthat/test-servers-zz-servers.R | 18 --- tests/testthat/test-zz-rapid.R | 12 +- 23 files changed, 30 insertions(+), 509 deletions(-) diff --git a/R/00-properties.R b/R/00-properties.R index 26d0a2b..12fb8f5 100644 --- a/R/00-properties.R +++ b/R/00-properties.R @@ -19,35 +19,6 @@ character_scalar_property <- function(x_arg, ...) { ) } -character_property <- function(x_arg, ...) { - S7::new_property( - class = class_character, - setter = function(self, value) { - call <- rlang::caller_env(3) - value <- value %||% character() - value <- stbl::stabilize_chr( - value, - allow_null = FALSE, - x_arg = x_arg, - call = call, - ... - ) - S7::prop(self, x_arg, check = FALSE) <- value - self - } - ) -} - -.url_regex <- "http[s]?://(?:[a-zA-Z]|[0-9]|[$-_@.&+]|[!*\\(\\),{}]|(?:%[0-9a-fA-F][0-9a-fA-F]))+" - -url_scalar_property <- function(x_arg) { - character_scalar_property(x_arg, regex = .url_regex) -} - -url_property <- function(x_arg) { - character_property(x_arg, regex = .url_regex) -} - enum_property <- function(x_arg) { S7::new_property( class = class_list, diff --git a/R/00-shared-params.R b/R/00-shared-params.R index 34a9126..3847833 100644 --- a/R/00-shared-params.R +++ b/R/00-shared-params.R @@ -2,9 +2,6 @@ #' #' Reused parameter definitions are gathered here for easier editing. #' -#' @param apid_list An API document as a list, such as that obtained by reading -#' an OAS document with [yaml::read_yaml()]. -#' @param apid_url The url for an API document. #' @param ... Catch-all for unimplemented properties. #' @name .shared-parameters #' @keywords internal diff --git a/R/info-01-contact.R b/R/info-01-contact.R index 7bdba0e..c0496c0 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -2,10 +2,8 @@ #' #' Validate the contact information for an API. #' -#' @inheritParams .shared-parameters #' @param name The identifying name of the contact person/organization. -#' @param url The URL pointing to the contact information. This *must* be in the -#' form of a URL. +#' @param url The URL pointing to the contact information. #' @param email The email address of the contact person/organization. This #' *must* be in the form of an email address. #' @@ -27,14 +25,8 @@ contact <- S7::new_class( "email", regex = "^[^@]+@[^@]+$" ), - url = url_scalar_property("url") - ), - constructor = function(name = class_missing, - email = class_missing, - url = class_missing, - ...) { - S7::new_object(NULL, name = name, email = email, url = url) - } + url = character_scalar_property("url") + ) ) #' @export diff --git a/R/info-01-license.R b/R/info-01-license.R index 626994b..4be7b5c 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -31,7 +31,7 @@ license <- S7::new_class( properties = list( name = character_scalar_property("name"), identifier = character_scalar_property("identifier"), - url = url_scalar_property("url") + url = character_scalar_property("url") ), constructor = function(name = character(), ..., diff --git a/R/info-zz-info.R b/R/info-zz-info.R index 25cc971..dd2a589 100644 --- a/R/info-zz-info.R +++ b/R/info-zz-info.R @@ -4,7 +4,6 @@ #' clients if needed, and *may* be presented in editing or documentation #' generation tools for convenience. #' -#' @inheritParams .shared-parameters #' @param contact The contact information for the exposed API, generated via #' [contact()]. #' @param description A description of the API. [CommonMark @@ -13,8 +12,7 @@ #' @param license The license information for the exposed API, generated via #' [license()]. #' @param summary A short summary of the API. -#' @param terms_of_service A URL to the Terms of Service for the API. This -#' *must* be in the form of a URL when provided. +#' @param terms_of_service A URL to the Terms of Service for the API. #' @param title The title of the API. #' @param version The version of the API document (which is distinct from the #' OpenAPI Specification version or the API implementation version). @@ -41,39 +39,10 @@ info <- S7::new_class( description = character_scalar_property("description"), license = license, summary = character_scalar_property("summary"), - terms_of_service = url_scalar_property("terms_of_service"), + terms_of_service = character_scalar_property("terms_of_service"), title = character_scalar_property("title"), version = character_scalar_property("version") - ), - constructor = function(contact = class_missing, - description = class_missing, - license = class_missing, - summary = class_missing, - terms_of_service = class_missing, - title = class_missing, - version = class_missing, - ..., - apid_list = NULL) { - if (!is.null(apid_list)) { - contact <- rlang::inject(contact(!!!apid_list$info$contact)) - description <- apid_list$info$description - license <- rlang::inject(license(!!!apid_list$info$license)) - summary <- apid_list$info$summary - terms_of_service <- apid_list$info$terms_of_service - title <- apid_list$info$title - version <- apid_list$info$version - } - S7::new_object( - NULL, - contact = contact, - description = description, - license = license, - summary = summary, - terms_of_service = terms_of_service, - title = title, - version = version - ) - } + ) ) #' @export diff --git a/R/servers-01-server_variable.R b/R/servers-01-server_variable.R index de7f098..b4d6838 100644 --- a/R/servers-01-server_variable.R +++ b/R/servers-01-server_variable.R @@ -33,10 +33,10 @@ server_variable <- S7::new_class( "server_variable", package = "rapid", properties = list( - name = character_property("name"), - default = character_property("default"), + name = S7::class_character, + default = S7::class_character, enum = enum_property("enum"), - description = character_property("description") + description = S7::class_character ), constructor = function(name = character(), default = character(), diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index a8d8ee0..28fbbc5 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -3,9 +3,10 @@ #' Connectivity information for an API. #' #' @inheritParams .shared-parameters -#' @param url A list of [server_variable()] objects. -#' @param description A list of [server_variable()] objects. -#' @param variables [server_variable_list()] object. +#' @param url A character vector of urls. +#' @param description A character vector of (usually brief) descriptions of +#' those urls. +#' @param variables A [server_variable_list()] object. #' #' @return A `servers` S7 object, with properties `url`, `description`, and #' `variables`. @@ -45,8 +46,8 @@ servers <- S7::new_class( "servers", package = "rapid", properties = list( - url = url_property("url"), - description = character_property("description"), + url = S7::class_character, + description = S7::class_character, variables = server_variable_list ), constructor = function(url = class_missing, diff --git a/man/contact.Rd b/man/contact.Rd index 0cd5851..ce4b810 100644 --- a/man/contact.Rd +++ b/man/contact.Rd @@ -4,7 +4,7 @@ \alias{contact} \title{Contact information for the API} \usage{ -contact(name = class_missing, email = class_missing, url = class_missing, ...) +contact(name = class_missing, email = class_missing, url = class_missing) } \arguments{ \item{name}{The identifying name of the contact person/organization.} @@ -12,10 +12,7 @@ contact(name = class_missing, email = class_missing, url = class_missing, ...) \item{email}{The email address of the contact person/organization. This \emph{must} be in the form of an email address.} -\item{url}{The URL pointing to the contact information. This \emph{must} be in the -form of a URL.} - -\item{...}{Catch-all for unimplemented properties.} +\item{url}{The URL pointing to the contact information.} } \value{ A \code{contact} S7 object, with fields \code{name}, \code{email}, and \code{url}. diff --git a/man/dot-shared-parameters.Rd b/man/dot-shared-parameters.Rd index 2178c17..2009387 100644 --- a/man/dot-shared-parameters.Rd +++ b/man/dot-shared-parameters.Rd @@ -4,11 +4,6 @@ \alias{.shared-parameters} \title{Parameters used in multiple functions} \arguments{ -\item{apid_list}{An API document as a list, such as that obtained by reading -an OAS document with \code{\link[yaml:read_yaml]{yaml::read_yaml()}}.} - -\item{apid_url}{The url for an API document.} - \item{...}{Catch-all for unimplemented properties.} } \description{ diff --git a/man/info.Rd b/man/info.Rd index 6516bae..10d83e0 100644 --- a/man/info.Rd +++ b/man/info.Rd @@ -11,9 +11,7 @@ info( summary = class_missing, terms_of_service = class_missing, title = class_missing, - version = class_missing, - ..., - apid_list = NULL + version = class_missing ) } \arguments{ @@ -28,18 +26,12 @@ representation.} \item{summary}{A short summary of the API.} -\item{terms_of_service}{A URL to the Terms of Service for the API. This -\emph{must} be in the form of a URL when provided.} +\item{terms_of_service}{A URL to the Terms of Service for the API.} \item{title}{The title of the API.} \item{version}{The version of the API document (which is distinct from the OpenAPI Specification version or the API implementation version).} - -\item{...}{Catch-all for unimplemented properties.} - -\item{apid_list}{An API document as a list, such as that obtained by reading -an OAS document with \code{\link[yaml:read_yaml]{yaml::read_yaml()}}.} } \value{ An \code{info} S7 object. diff --git a/man/rapid.Rd b/man/rapid.Rd index 7bbb6c2..de7263a 100644 --- a/man/rapid.Rd +++ b/man/rapid.Rd @@ -18,11 +18,6 @@ rapid( \item{servers}{A \code{servers} object defined by \code{\link[=servers]{servers()}}.} \item{...}{Catch-all for unimplemented properties.} - -\item{apid_url}{The url for an API document.} - -\item{apid_list}{An API document as a list, such as that obtained by reading -an OAS document with \code{\link[yaml:read_yaml]{yaml::read_yaml()}}.} } \value{ A \code{rapid} S7 object, with properties \code{info} and \code{servers}. diff --git a/man/server_variable_list.Rd b/man/server_variable_list.Rd index f3cd33f..2ed07f2 100644 --- a/man/server_variable_list.Rd +++ b/man/server_variable_list.Rd @@ -9,9 +9,6 @@ server_variable_list(..., apid_list = NULL) \arguments{ \item{...}{One or more \code{\link[=server_variable]{server_variable()}} objects, or a list of \code{\link[=server_variable]{server_variable()}} objects.} - -\item{apid_list}{An API document as a list, such as that obtained by reading -an OAS document with \code{\link[yaml:read_yaml]{yaml::read_yaml()}}.} } \value{ A \code{server_variable_list} S7 object, which is a validated list of diff --git a/man/servers.Rd b/man/servers.Rd index 45b2993..a76581c 100644 --- a/man/servers.Rd +++ b/man/servers.Rd @@ -13,16 +13,14 @@ servers( ) } \arguments{ -\item{url}{A list of \code{\link[=server_variable]{server_variable()}} objects.} +\item{url}{A character vector of urls.} -\item{description}{A list of \code{\link[=server_variable]{server_variable()}} objects.} +\item{description}{A character vector of (usually brief) descriptions of +those urls.} -\item{variables}{\code{\link[=server_variable_list]{server_variable_list()}} object.} +\item{variables}{A \code{\link[=server_variable_list]{server_variable_list()}} object.} \item{...}{Catch-all for unimplemented properties.} - -\item{apid_list}{An API document as a list, such as that obtained by reading -an OAS document with \code{\link[yaml:read_yaml]{yaml::read_yaml()}}.} } \value{ A \code{servers} S7 object, with properties \code{url}, \code{description}, and diff --git a/tests/testthat/_snaps/info-01-contact.md b/tests/testthat/_snaps/info-01-contact.md index e194e60..e27d376 100644 --- a/tests/testthat/_snaps/info-01-contact.md +++ b/tests/testthat/_snaps/info-01-contact.md @@ -15,33 +15,6 @@ ! `name` must be a single . x `name` has 2 values. -# contact() errors informatively for bad url - - Code - contact(name = "A", url = mean) - Condition - Error in `contact()`: - ! Can't coerce `url` to . - ---- - - Code - contact(name = "A", url = c("A", "B")) - Condition - Error in `contact()`: - ! `url` must be a single . - x `url` has 2 values. - ---- - - Code - contact(name = "A", url = "not a real url") - Condition - Error in `contact()`: - ! `url` must match the provided regex pattern. - x Some values do not match. - * Locations: 1 - # contact() errors informatively for bad email Code diff --git a/tests/testthat/_snaps/info-01-license.md b/tests/testthat/_snaps/info-01-license.md index 5f2b594..67c6b64 100644 --- a/tests/testthat/_snaps/info-01-license.md +++ b/tests/testthat/_snaps/info-01-license.md @@ -32,16 +32,6 @@ ! `url` must be a single . x `url` has 2 values. ---- - - Code - license(name = "A", url = "not a real url") - Condition - Error in `license()`: - ! `url` must match the provided regex pattern. - x Some values do not match. - * Locations: 1 - # license() errors informatively for bad identifier Code diff --git a/tests/testthat/_snaps/info-zz-info.md b/tests/testthat/_snaps/info-zz-info.md index 154b08f..cccd9d0 100644 --- a/tests/testthat/_snaps/info-zz-info.md +++ b/tests/testthat/_snaps/info-zz-info.md @@ -1,30 +1,3 @@ -# info() requires URLs for TOS - - Code - info(terms_of_service = mean) - Condition - Error in `info()`: - ! Can't coerce `terms_of_service` to . - ---- - - Code - info(terms_of_service = c("A", "B")) - Condition - Error in `info()`: - ! `terms_of_service` must be a single . - x `terms_of_service` has 2 values. - ---- - - Code - info(terms_of_service = "not a real url") - Condition - Error in `info()`: - ! `terms_of_service` must match the provided regex pattern. - x Some values do not match. - * Locations: 1 - # info() returns an empty info Code @@ -46,45 +19,3 @@ @ title : chr(0) @ version : chr(0) -# Can construct a contact from an api spec - - Code - test_result <- info(apid_list = apid_list_guru) - test_result - Output - - @ contact : - .. @ name : chr "APIs.guru" - .. @ email: chr "mike.ralphson@gmail.com" - .. @ url : chr "https://APIs.guru" - @ description : chr "Wikipedia for Web APIs. Repository of API definitions in OpenAPI format.\n**Warning**: If you want to be notifi"| __truncated__ - @ license : - .. @ name : chr "CC0 1.0" - .. @ identifier: chr(0) - .. @ url : chr "https://github.com/APIs-guru/openapi-directory#licenses" - @ summary : chr(0) - @ terms_of_service: chr(0) - @ title : chr "APIs.guru" - @ version : chr "2.2.0" - ---- - - Code - test_result <- info(apid_list = apid_list_awsmh) - test_result - Output - - @ contact : - .. @ name : chr "Mike Ralphson" - .. @ email: chr "mike.ralphson@gmail.com" - .. @ url : chr "https://github.com/mermade/aws2openapi" - @ description : chr "

The AWS Migration Hub API methods help to obtain server and application migration status and integrate your "| __truncated__ - @ license : - .. @ name : chr "Apache 2.0 License" - .. @ identifier: chr(0) - .. @ url : chr "http://www.apache.org/licenses/" - @ summary : chr(0) - @ terms_of_service: chr(0) - @ title : chr "AWS Migration Hub" - @ version : chr "2017-05-31" - diff --git a/tests/testthat/_snaps/servers-zz-servers.md b/tests/testthat/_snaps/servers-zz-servers.md index f98137b..2ae38a2 100644 --- a/tests/testthat/_snaps/servers-zz-servers.md +++ b/tests/testthat/_snaps/servers-zz-servers.md @@ -1,31 +1,3 @@ -# servers() requires URLs for urls - - Code - servers(url = mean) - Condition - Error in `servers()`: - ! Can't coerce `url` to . - ---- - - Code - servers(url = c("A", "B")) - Condition - Error in `servers()`: - ! `url` must match the provided regex pattern. - x Some values do not match. - * Locations: 1 and 2 - ---- - - Code - servers(url = "not a real url") - Condition - Error in `servers()`: - ! `url` must match the provided regex pattern. - x Some values do not match. - * Locations: 1 - # servers() returns an empty server Code diff --git a/tests/testthat/_snaps/zz-rapid.md b/tests/testthat/_snaps/zz-rapid.md index cf74465..401e30e 100644 --- a/tests/testthat/_snaps/zz-rapid.md +++ b/tests/testthat/_snaps/zz-rapid.md @@ -46,165 +46,3 @@ .. @ description: chr(0) .. @ variables : list() -# Can construct a rapid from an apid_list - - Code - test_result <- rapid(apid_list = apid_list_guru) - test_result - Output - - @ info : - .. @ contact : - .. .. @ name : chr "APIs.guru" - .. .. @ email: chr "mike.ralphson@gmail.com" - .. .. @ url : chr "https://APIs.guru" - .. @ description : chr "Wikipedia for Web APIs. Repository of API definitions in OpenAPI format.\n**Warning**: If you want to be notifi"| __truncated__ - .. @ license : - .. .. @ name : chr "CC0 1.0" - .. .. @ identifier: chr(0) - .. .. @ url : chr "https://github.com/APIs-guru/openapi-directory#licenses" - .. @ summary : chr(0) - .. @ terms_of_service: chr(0) - .. @ title : chr "APIs.guru" - .. @ version : chr "2.2.0" - @ servers: - .. @ url : chr "https://api.apis.guru/v2" - .. @ description: chr(0) - .. @ variables : List of 1 - .. .. $ : - .. .. ..@ name : chr(0) - .. .. ..@ default : chr(0) - .. .. ..@ enum : list() - .. .. ..@ description: chr(0) - ---- - - Code - test_result <- rapid(apid_list = apid_list_awsmh) - test_result - Output - - @ info : - .. @ contact : - .. .. @ name : chr "Mike Ralphson" - .. .. @ email: chr "mike.ralphson@gmail.com" - .. .. @ url : chr "https://github.com/mermade/aws2openapi" - .. @ description : chr "

The AWS Migration Hub API methods help to obtain server and application migration status and integrate your "| __truncated__ - .. @ license : - .. .. @ name : chr "Apache 2.0 License" - .. .. @ identifier: chr(0) - .. .. @ url : chr "http://www.apache.org/licenses/" - .. @ summary : chr(0) - .. @ terms_of_service: chr(0) - .. @ title : chr "AWS Migration Hub" - .. @ version : chr "2017-05-31" - @ servers: - .. @ url : chr [1:4] "http://mgh.{region}.amazonaws.com" ... - .. @ description: chr [1:4] "The AWS Migration Hub multi-region endpoint" ... - .. @ variables : List of 4 - .. .. $ : - .. .. ..@ name : chr "region" - .. .. ..@ default : chr "us-east-1" - .. .. ..@ enum :List of 1 - .. .. .. .. $ : chr [1:23] "us-east-1" "us-east-2" "us-west-1" "us-west-2" ... - .. .. ..@ description: chr(0) - .. .. $ : - .. .. ..@ name : chr "region" - .. .. ..@ default : chr "us-east-1" - .. .. ..@ enum :List of 1 - .. .. .. .. $ : chr [1:23] "us-east-1" "us-east-2" "us-west-1" "us-west-2" ... - .. .. ..@ description: chr(0) - .. .. $ : - .. .. ..@ name : chr "region" - .. .. ..@ default : chr "cn-north-1" - .. .. ..@ enum :List of 1 - .. .. .. .. $ : chr [1:2] "cn-north-1" "cn-northwest-1" - .. .. ..@ description: chr(0) - .. .. $ : - .. .. ..@ name : chr "region" - .. .. ..@ default : chr "cn-north-1" - .. .. ..@ enum :List of 1 - .. .. .. .. $ : chr [1:2] "cn-north-1" "cn-northwest-1" - .. .. ..@ description: chr(0) - -# Can construct a rapid from an apid_url - - Code - test_result <- rapid(apid_url = "https://api.apis.guru/v2/openapi.yaml") - test_result - Output - - @ info : - .. @ contact : - .. .. @ name : chr "APIs.guru" - .. .. @ email: chr "mike.ralphson@gmail.com" - .. .. @ url : chr "https://APIs.guru" - .. @ description : chr "Wikipedia for Web APIs. Repository of API definitions in OpenAPI format.\n**Warning**: If you want to be notifi"| __truncated__ - .. @ license : - .. .. @ name : chr "CC0 1.0" - .. .. @ identifier: chr(0) - .. .. @ url : chr "https://github.com/APIs-guru/openapi-directory#licenses" - .. @ summary : chr(0) - .. @ terms_of_service: chr(0) - .. @ title : chr "APIs.guru" - .. @ version : chr "2.2.0" - @ servers: - .. @ url : chr "https://api.apis.guru/v2" - .. @ description: chr(0) - .. @ variables : List of 1 - .. .. $ : - .. .. ..@ name : chr(0) - .. .. ..@ default : chr(0) - .. .. ..@ enum : list() - .. .. ..@ description: chr(0) - ---- - - Code - test_result <- rapid(apid_url = "https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml") - test_result - Output - - @ info : - .. @ contact : - .. .. @ name : chr "Mike Ralphson" - .. .. @ email: chr "mike.ralphson@gmail.com" - .. .. @ url : chr "https://github.com/mermade/aws2openapi" - .. @ description : chr "

The AWS Migration Hub API methods help to obtain server and application migration status and integrate your "| __truncated__ - .. @ license : - .. .. @ name : chr "Apache 2.0 License" - .. .. @ identifier: chr(0) - .. .. @ url : chr "http://www.apache.org/licenses/" - .. @ summary : chr(0) - .. @ terms_of_service: chr(0) - .. @ title : chr "AWS Migration Hub" - .. @ version : chr "2017-05-31" - @ servers: - .. @ url : chr [1:4] "http://mgh.{region}.amazonaws.com" ... - .. @ description: chr [1:4] "The AWS Migration Hub multi-region endpoint" ... - .. @ variables : List of 4 - .. .. $ : - .. .. ..@ name : chr "region" - .. .. ..@ default : chr "us-east-1" - .. .. ..@ enum :List of 1 - .. .. .. .. $ : chr [1:23] "us-east-1" "us-east-2" "us-west-1" "us-west-2" ... - .. .. ..@ description: chr(0) - .. .. $ : - .. .. ..@ name : chr "region" - .. .. ..@ default : chr "us-east-1" - .. .. ..@ enum :List of 1 - .. .. .. .. $ : chr [1:23] "us-east-1" "us-east-2" "us-west-1" "us-west-2" ... - .. .. ..@ description: chr(0) - .. .. $ : - .. .. ..@ name : chr "region" - .. .. ..@ default : chr "cn-north-1" - .. .. ..@ enum :List of 1 - .. .. .. .. $ : chr [1:2] "cn-north-1" "cn-northwest-1" - .. .. ..@ description: chr(0) - .. .. $ : - .. .. ..@ name : chr "region" - .. .. ..@ default : chr "cn-north-1" - .. .. ..@ enum :List of 1 - .. .. .. .. $ : chr [1:2] "cn-north-1" "cn-northwest-1" - .. .. ..@ description: chr(0) - diff --git a/tests/testthat/test-info-01-contact.R b/tests/testthat/test-info-01-contact.R index 272e3bb..90ef2c8 100644 --- a/tests/testthat/test-info-01-contact.R +++ b/tests/testthat/test-info-01-contact.R @@ -11,24 +11,6 @@ test_that("contact() errors informatively for bad name", { ) }) -test_that("contact() errors informatively for bad url", { - expect_snapshot( - contact(name = "A", url = mean), - error = TRUE, - cnd_class = TRUE - ) - expect_snapshot( - contact(name = "A", url = c("A", "B")), - error = TRUE, - cnd_class = TRUE - ) - expect_snapshot( - contact(name = "A", url = "not a real url"), - error = TRUE, - cnd_class = TRUE - ) -}) - test_that("contact() errors informatively for bad email", { expect_snapshot( contact(name = "A", url = "https://example.com", email = mean), diff --git a/tests/testthat/test-info-01-license.R b/tests/testthat/test-info-01-license.R index e36820f..1969995 100644 --- a/tests/testthat/test-info-01-license.R +++ b/tests/testthat/test-info-01-license.R @@ -22,11 +22,6 @@ test_that("license() errors informatively for bad url", { error = TRUE, cnd_class = TRUE ) - expect_snapshot( - license(name = "A", url = "not a real url"), - error = TRUE, - cnd_class = TRUE - ) }) test_that("license() errors informatively for bad identifier", { expect_snapshot( diff --git a/tests/testthat/test-info-zz-info.R b/tests/testthat/test-info-zz-info.R index e16369f..a0eb09a 100644 --- a/tests/testthat/test-info-zz-info.R +++ b/tests/testthat/test-info-zz-info.R @@ -3,24 +3,6 @@ # object should allow issues, and then we can check what's missing that should # be there and report on it, likely via a subclass. -test_that("info() requires URLs for TOS", { - expect_snapshot( - info(terms_of_service = mean), - error = TRUE, - cnd_class = TRUE - ) - expect_snapshot( - info(terms_of_service = c("A", "B")), - error = TRUE, - cnd_class = TRUE - ) - expect_snapshot( - info(terms_of_service = "not a real url"), - error = TRUE, - cnd_class = TRUE - ) -}) - test_that("info() returns an empty info", { expect_snapshot({ test_result <- info() @@ -60,31 +42,3 @@ test_that("length() of an info reports the overall length", { 1 ) }) - -test_that("Can construct a contact from an api spec", { - # apid_list_guru <- yaml::read_yaml("https://api.apis.guru/v2/openapi.yaml") - # saveRDS(apid_list_guru, test_path("fixtures", "apid_list_guru.rds")) - apid_list_guru <- readRDS(test_path("fixtures", "apid_list_guru.rds")) - expect_snapshot({ - test_result <- info(apid_list = apid_list_guru) - test_result - }) - expect_s3_class( - test_result, - class = c("rapid::info", "S7_object"), - exact = TRUE - ) - - # apid_list_awsmh <- yaml::read_yaml("https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml") - # saveRDS(apid_list_awsmh, test_path("fixtures", "apid_list_awsmh.rds")) - apid_list_awsmh <- readRDS(test_path("fixtures", "apid_list_awsmh.rds")) - expect_snapshot({ - test_result <- info(apid_list = apid_list_awsmh) - test_result - }) - expect_s3_class( - test_result, - class = c("rapid::info", "S7_object"), - exact = TRUE - ) -}) diff --git a/tests/testthat/test-servers-zz-servers.R b/tests/testthat/test-servers-zz-servers.R index 6d6cec4..16979fa 100644 --- a/tests/testthat/test-servers-zz-servers.R +++ b/tests/testthat/test-servers-zz-servers.R @@ -1,21 +1,3 @@ -test_that("servers() requires URLs for urls", { - expect_snapshot( - servers(url = mean), - error = TRUE, - cnd_class = TRUE - ) - expect_snapshot( - servers(url = c("A", "B")), - error = TRUE, - cnd_class = TRUE - ) - expect_snapshot( - servers(url = "not a real url"), - error = TRUE, - cnd_class = TRUE - ) -}) - test_that("servers() returns an empty server", { expect_snapshot({ test_result <- servers() diff --git a/tests/testthat/test-zz-rapid.R b/tests/testthat/test-zz-rapid.R index 49eed62..eb6e6fa 100644 --- a/tests/testthat/test-zz-rapid.R +++ b/tests/testthat/test-zz-rapid.R @@ -83,12 +83,12 @@ test_that("length() of a rapid reports the overall length", { ) }) -test_that("Can construct a rapid from an apid_list", { +test_that("Can construct a rapid from an apid list", { # apid_list_guru <- yaml::read_yaml("https://api.apis.guru/v2/openapi.yaml") # saveRDS(apid_list_guru, test_path("fixtures", "apid_list_guru.rds")) apid_list_guru <- readRDS(test_path("fixtures", "apid_list_guru.rds")) expect_snapshot({ - test_result <- rapid(apid_list = apid_list_guru) + test_result <- as_rapid(apid_list_guru) test_result }) expect_s3_class( @@ -101,7 +101,7 @@ test_that("Can construct a rapid from an apid_list", { # saveRDS(apid_list_awsmh, test_path("fixtures", "apid_list_awsmh.rds")) apid_list_awsmh <- readRDS(test_path("fixtures", "apid_list_awsmh.rds")) expect_snapshot({ - test_result <- rapid(apid_list = apid_list_awsmh) + test_result <- as_rapid(apid_list_awsmh) test_result }) expect_s3_class( @@ -111,10 +111,10 @@ test_that("Can construct a rapid from an apid_list", { ) }) -test_that("Can construct a rapid from an apid_url", { +test_that("Can construct a rapid from an apid url", { skip_if_not(Sys.getenv("RAPID_TEST_DL") == "true") expect_snapshot({ - test_result <- rapid(apid_url = "https://api.apis.guru/v2/openapi.yaml") + test_result <- as_rapid("https://api.apis.guru/v2/openapi.yaml") test_result }) expect_s3_class( @@ -123,7 +123,7 @@ test_that("Can construct a rapid from an apid_url", { exact = TRUE ) expect_snapshot({ - test_result <- rapid(apid_url = "https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml") + test_result <- as_rapid("https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml") test_result }) expect_s3_class( From 04d316e0a632ffcfa5ffa0477be1c41e2d4dd8dc Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Thu, 7 Sep 2023 15:53:25 -0500 Subject: [PATCH 08/19] Scrub out apid_list. And distribute TODOs. --- R/info-01-license.R | 2 -- R/servers-01-server_variable.R | 2 ++ R/servers-02-server_variable_list.R | 21 +++------------------ R/servers-zz-servers.R | 20 ++------------------ R/zz-rapid.R | 20 ++------------------ man/server_variable_list.Rd | 2 +- tests/testthat/test-info-01-license.R | 8 -------- tests/testthat/test-info-zz-info.R | 5 +---- tests/testthat/test-servers-zz-servers.R | 3 +++ 9 files changed, 14 insertions(+), 69 deletions(-) diff --git a/R/info-01-license.R b/R/info-01-license.R index 4be7b5c..8cb6664 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -1,5 +1,3 @@ -# Anything at 01 can only have dependencies at 00. - #' License information for the API #' #' Validate the license information for an API. diff --git a/R/servers-01-server_variable.R b/R/servers-01-server_variable.R index b4d6838..56fef07 100644 --- a/R/servers-01-server_variable.R +++ b/R/servers-01-server_variable.R @@ -1,3 +1,5 @@ +# TODO: Implement as_*. + #' A server variable for server URL template substitution #' #' Server variable properties used for substitution in the server’s URL diff --git a/R/servers-02-server_variable_list.R b/R/servers-02-server_variable_list.R index 5db6596..25480bb 100644 --- a/R/servers-02-server_variable_list.R +++ b/R/servers-02-server_variable_list.R @@ -1,9 +1,10 @@ +# TODO: Implement as_*. + #' A collection of server variables for multiple servers #' #' A list of server variable objects, each of which is constructed with #' [server_variable()]. #' -#' @inheritParams .shared-parameters #' @param ... One or more [server_variable()] objects, or a list of #' [server_variable()] objects. #' @@ -19,23 +20,7 @@ server_variable_list <- S7::new_class( "server_variable_list", package = "rapid", parent = class_list, - constructor = function(..., apid_list = NULL) { - if (!is.null(apid_list)) { - return(S7::new_object( - purrr::map( - apid_list$servers, - \(this_server) { - these_names <- names(this_server$variables) - vars <- unname(this_server$variables) - server_variable( - name = these_names, - default = purrr::map_chr(vars, "default"), - enum = purrr::map(vars, "enum") - ) - } - ) - )) - } + constructor = function(...) { if (...length() == 1 && is.list(..1)) { return(S7::new_object(..1)) } diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index 28fbbc5..7dd18da 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -1,8 +1,9 @@ +# TODO: Implement as_*. + #' A collection of server variables for multiple servers #' #' Connectivity information for an API. #' -#' @inheritParams .shared-parameters #' @param url A character vector of urls. #' @param description A character vector of (usually brief) descriptions of #' those urls. @@ -50,23 +51,6 @@ servers <- S7::new_class( description = S7::class_character, variables = server_variable_list ), - constructor = function(url = class_missing, - description = class_missing, - variables = class_missing, - ..., - apid_list = NULL) { - if (!is.null(apid_list) && !is.null(apid_list$servers)) { - url <- .extract_along_chr(apid_list$servers, "url") - description <- .extract_along_chr(apid_list$servers, "description") - variables <- server_variable_list(apid_list = apid_list) - } - S7::new_object( - NULL, - url = url, - description = description, - variables = variables - ) - }, validator = function(self) { validate_parallel( self, diff --git a/R/zz-rapid.R b/R/zz-rapid.R index 1c14197..9a85287 100644 --- a/R/zz-rapid.R +++ b/R/zz-rapid.R @@ -1,3 +1,5 @@ +# TODO: Implement as_*. + #' R API definition object #' #' An object that represents an API. @@ -39,24 +41,6 @@ rapid <- S7::new_class( info = info, servers = servers ), - constructor = function(info = class_missing, - servers = class_missing, - ..., - apid_url = NULL, - apid_list = NULL) { - if (!is.null(apid_url)) { - apid_url <- stbl::stabilize_chr_scalar( - apid_url, - regex = .url_regex - ) - apid_list <- yaml::read_yaml(apid_url) - } - if (!is.null(apid_list)) { - info <- info(apid_list = apid_list) - servers <- servers(apid_list = apid_list) - } - S7::new_object(NULL, info = info, servers = servers) - }, validator = function(self) { validate_lengths( self, diff --git a/man/server_variable_list.Rd b/man/server_variable_list.Rd index 2ed07f2..e5e5d0c 100644 --- a/man/server_variable_list.Rd +++ b/man/server_variable_list.Rd @@ -4,7 +4,7 @@ \alias{server_variable_list} \title{A collection of server variables for multiple servers} \usage{ -server_variable_list(..., apid_list = NULL) +server_variable_list(...) } \arguments{ \item{...}{One or more \code{\link[=server_variable]{server_variable()}} objects, or a list of diff --git a/tests/testthat/test-info-01-license.R b/tests/testthat/test-info-01-license.R index 1969995..0d1bed8 100644 --- a/tests/testthat/test-info-01-license.R +++ b/tests/testthat/test-info-01-license.R @@ -196,14 +196,6 @@ test_that("as_license() returns expected objects", { ) }) -# TODO: Reconsider server format. Closer mirroring of OAS seems appropriate. Or -# maybe a tribble equivalent. - -# TODO: Implement as_*. -# -# TODO: Get rid of apid_list args (and maybe apid_url). Maybe as_* should figure -# out if it's a url? -# # TODO: Prettier printing. # # TODO: After all that, I think I want to implement components$securitySchemas diff --git a/tests/testthat/test-info-zz-info.R b/tests/testthat/test-info-zz-info.R index a0eb09a..cb9626c 100644 --- a/tests/testthat/test-info-zz-info.R +++ b/tests/testthat/test-info-zz-info.R @@ -1,7 +1,4 @@ -# It was tempting to try to check requirements in this (and presumably both -# above and below here), but many APIDs fail to properly follow specs. This -# object should allow issues, and then we can check what's missing that should -# be there and report on it, likely via a subclass. +# TODO: Implement as_*. test_that("info() returns an empty info", { expect_snapshot({ diff --git a/tests/testthat/test-servers-zz-servers.R b/tests/testthat/test-servers-zz-servers.R index 16979fa..37c1958 100644 --- a/tests/testthat/test-servers-zz-servers.R +++ b/tests/testthat/test-servers-zz-servers.R @@ -1,3 +1,6 @@ +# TODO: Reconsider server format. Closer mirroring of OAS seems appropriate. Or +# maybe a tribble equivalent. + test_that("servers() returns an empty server", { expect_snapshot({ test_result <- servers() From ce364a85dfb2476c9605a73a26a50d1255446533 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Thu, 7 Sep 2023 16:20:51 -0500 Subject: [PATCH 09/19] Implement as_info() --- NAMESPACE | 1 + R/as.R | 11 +-- R/info-01-contact.R | 5 +- R/info-01-license.R | 5 +- R/info-zz-info.R | 77 ++++++++++++++++--- R/servers-01-server_variable.R | 6 +- R/servers-zz-servers.R | 4 +- R/zz-rapid.R | 1 - man/as_info.Rd | 24 ++++++ man/info.Rd | 18 +++-- man/rapid.Rd | 10 +-- man/servers.Rd | 6 +- tests/testthat/_snaps/info-01-license.md | 9 --- tests/testthat/_snaps/info-zz-info.md | 77 ++++++++++++++++++- tests/testthat/_snaps/zz-rapid.md | 4 +- tests/testthat/test-info-01-license.R | 5 -- tests/testthat/test-info-zz-info.R | 96 ++++++++++++++++++++++- tests/testthat/test-zz-rapid.R | 98 ++++++++++++------------ 18 files changed, 341 insertions(+), 116 deletions(-) create mode 100644 man/as_info.Rd diff --git a/NAMESPACE b/NAMESPACE index 641aae6..8f542b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ S3method(length,"rapid::rapid") S3method(length,"rapid::server_variable") S3method(length,"rapid::servers") export(as_contact) +export(as_info) export(as_license) export(contact) export(info) diff --git a/R/as.R b/R/as.R index 9cc1620..e4c45b4 100644 --- a/R/as.R +++ b/R/as.R @@ -1,7 +1,8 @@ -.validate_named_list <- function(x, - valid_names, - x_arg = rlang::caller_arg(x), - call = rlang::caller_env()) { +.validate_for_as_class <- function(x, + target_S7_class, + x_arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + valid_names <- S7::prop_names(target_S7_class()) if ( length(x) && (!rlang::is_named(x) || !any(names(x) %in% valid_names)) @@ -14,5 +15,5 @@ call = call ) } - return(as.list(x)) + return(as.list(x)[names(x) %in% valid_names]) } diff --git a/R/info-01-contact.R b/R/info-01-contact.R index c0496c0..01bb175 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -52,7 +52,7 @@ contact <- S7::new_class( as_contact <- S7::new_generic("as_contact", dispatch_args = "x") S7::method(as_contact, class_list | class_character) <- function(x) { - x <- .validate_named_list(x, c("name", "email", "url")) + x <- .validate_for_as_class(x, contact) contact(name = x[["name"]], email = x[["email"]], url = x[["url"]]) } @@ -61,6 +61,9 @@ S7::method(as_contact, class_missing) <- function(x) { } S7::method(as_contact, class_any) <- function(x) { + if (is.null(x)) { + return(contact()) + } cli::cli_abort( "Can't coerce {.arg x} {.cls {class(x)}} to {.cls contact}." ) diff --git a/R/info-01-license.R b/R/info-01-license.R index 8cb6664..ec4fcde 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -68,7 +68,7 @@ license <- S7::new_class( as_license <- S7::new_generic("as_license", dispatch_args = "x") S7::method(as_license, class_list | class_character) <- function(x) { - x <- .validate_named_list(x, c("name", "identifier", "url")) + x <- .validate_for_as_class(x, license) license(name = x[["name"]], identifier = x[["identifier"]], url = x[["url"]]) } @@ -77,6 +77,9 @@ S7::method(as_license, class_missing) <- function(x) { } S7::method(as_license, class_any) <- function(x) { + if (is.null(x)) { + return(license()) + } cli::cli_abort( "Can't coerce {.arg x} {.cls {class(x)}} to {.cls license}." ) diff --git a/R/info-zz-info.R b/R/info-zz-info.R index dd2a589..e431414 100644 --- a/R/info-zz-info.R +++ b/R/info-zz-info.R @@ -4,6 +4,10 @@ #' clients if needed, and *may* be presented in editing or documentation #' generation tools for convenience. #' +#' @param title The title of the API. Required when the object is not empty. +#' @param version The version of the API document (which is distinct from the +#' OpenAPI Specification version or the API implementation version). Required +#' when the object is not empty. #' @param contact The contact information for the exposed API, generated via #' [contact()]. #' @param description A description of the API. [CommonMark @@ -13,9 +17,6 @@ #' [license()]. #' @param summary A short summary of the API. #' @param terms_of_service A URL to the Terms of Service for the API. -#' @param title The title of the API. -#' @param version The version of the API document (which is distinct from the -#' OpenAPI Specification version or the API implementation version). #' #' @return An `info` S7 object. #' @export @@ -23,6 +24,7 @@ #' info() #' info( #' title = "My Cool API", +#' version = "1.0.2", #' license = license( #' name = "Apache 2.0", #' url = "https://opensource.org/license/apache-2-0/" @@ -31,21 +33,76 @@ info <- S7::new_class( "info", package = "rapid", - # Design choice: These are strictly alphabetized, since we allow any to be - # empty. May later want to order them to match the validated version, where - # required parameters will come first (before ... during construction). properties = list( + title = character_scalar_property("title"), + version = character_scalar_property("version"), contact = contact, description = character_scalar_property("description"), license = license, summary = character_scalar_property("summary"), - terms_of_service = character_scalar_property("terms_of_service"), - title = character_scalar_property("title"), - version = character_scalar_property("version") - ) + terms_of_service = character_scalar_property("terms_of_service") + ), + validator = function(self) { + validate_lengths( + self, + "title", + required_same = "version", + optional_any = c( + "contact", + "description", + "license", + "summary", + "terms_of_service" + ) + ) + } ) #' @export `length.rapid::info` <- function(x) { .prop_length_max(x) } + +#' Coerce lists and character vectors to info objects +#' +#' `as_info()` turns an existing object into an `info`. This is in contrast with +#' [info()], which builds an `info` from individual properties. +#' +#' @param x The object to coerce. Must be empty or have names "title", +#' "version", "contact", "description", "license", "summary", and/or +#' "terms_of_service". Extra names are ignored. +#' +#' @return An `info` as returned by [info()]. +#' @export +#' +#' @examples +#' as_info() +#' as_info(list(title = "My Cool API", version = "1.0.0")) +as_info <- S7::new_generic("as_info", dispatch_args = "x") + +S7::method(as_info, class_list | class_character) <- function(x) { + x <- .validate_for_as_class(x, info) + + info( + title = x[["title"]], + version = x[["version"]], + contact = as_contact(x[["contact"]]), + description = x[["description"]], + license = as_license(x[["license"]]), + summary = x[["summary"]], + terms_of_service = x[["terms_of_service"]] + ) +} + +S7::method(as_info, class_missing) <- function(x) { + info() +} + +S7::method(as_info, class_any) <- function(x) { + if (is.null(x)) { + return(info()) + } + cli::cli_abort( + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls info}." + ) +} diff --git a/R/servers-01-server_variable.R b/R/servers-01-server_variable.R index 56fef07..505b0b9 100644 --- a/R/servers-01-server_variable.R +++ b/R/servers-01-server_variable.R @@ -35,10 +35,10 @@ server_variable <- S7::new_class( "server_variable", package = "rapid", properties = list( - name = S7::class_character, - default = S7::class_character, + name = class_character, + default = class_character, enum = enum_property("enum"), - description = S7::class_character + description = class_character ), constructor = function(name = character(), default = character(), diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index 7dd18da..85a6838 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -47,8 +47,8 @@ servers <- S7::new_class( "servers", package = "rapid", properties = list( - url = S7::class_character, - description = S7::class_character, + url = class_character, + description = class_character, variables = server_variable_list ), validator = function(self) { diff --git a/R/zz-rapid.R b/R/zz-rapid.R index 9a85287..69b8e85 100644 --- a/R/zz-rapid.R +++ b/R/zz-rapid.R @@ -4,7 +4,6 @@ #' #' An object that represents an API. #' -#' @inheritParams .shared-parameters #' @param info An `info` object defined by [info()]. #' @param servers A `servers` object defined by [servers()]. #' diff --git a/man/as_info.Rd b/man/as_info.Rd new file mode 100644 index 0000000..44ba70c --- /dev/null +++ b/man/as_info.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/info-zz-info.R +\name{as_info} +\alias{as_info} +\title{Coerce lists and character vectors to info objects} +\usage{ +as_info(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or have names "title", +"version", "contact", "description", "license", "summary", and/or +"terms_of_service". Extra names are ignored.} +} +\value{ +An \code{info} as returned by \code{\link[=info]{info()}}. +} +\description{ +\code{as_info()} turns an existing object into an \code{info}. This is in contrast with +\code{\link[=info]{info()}}, which builds an \code{info} from individual properties. +} +\examples{ +as_info() +as_info(list(title = "My Cool API", version = "1.0.0")) +} diff --git a/man/info.Rd b/man/info.Rd index 10d83e0..ee4160d 100644 --- a/man/info.Rd +++ b/man/info.Rd @@ -5,16 +5,22 @@ \title{Information about the API} \usage{ info( + title = class_missing, + version = class_missing, contact = class_missing, description = class_missing, license = class_missing, summary = class_missing, - terms_of_service = class_missing, - title = class_missing, - version = class_missing + terms_of_service = class_missing ) } \arguments{ +\item{title}{The title of the API. Required when the object is not empty.} + +\item{version}{The version of the API document (which is distinct from the +OpenAPI Specification version or the API implementation version). Required +when the object is not empty.} + \item{contact}{The contact information for the exposed API, generated via \code{\link[=contact]{contact()}}.} @@ -27,11 +33,6 @@ representation.} \item{summary}{A short summary of the API.} \item{terms_of_service}{A URL to the Terms of Service for the API.} - -\item{title}{The title of the API.} - -\item{version}{The version of the API document (which is distinct from the -OpenAPI Specification version or the API implementation version).} } \value{ An \code{info} S7 object. @@ -45,6 +46,7 @@ generation tools for convenience. info() info( title = "My Cool API", + version = "1.0.2", license = license( name = "Apache 2.0", url = "https://opensource.org/license/apache-2-0/" diff --git a/man/rapid.Rd b/man/rapid.Rd index de7263a..cd70341 100644 --- a/man/rapid.Rd +++ b/man/rapid.Rd @@ -4,20 +4,12 @@ \alias{rapid} \title{R API definition object} \usage{ -rapid( - info = class_missing, - servers = class_missing, - ..., - apid_url = NULL, - apid_list = NULL -) +rapid(info = class_missing, servers = class_missing) } \arguments{ \item{info}{An \code{info} object defined by \code{\link[=info]{info()}}.} \item{servers}{A \code{servers} object defined by \code{\link[=servers]{servers()}}.} - -\item{...}{Catch-all for unimplemented properties.} } \value{ A \code{rapid} S7 object, with properties \code{info} and \code{servers}. diff --git a/man/servers.Rd b/man/servers.Rd index a76581c..2a96cce 100644 --- a/man/servers.Rd +++ b/man/servers.Rd @@ -7,9 +7,7 @@ servers( url = class_missing, description = class_missing, - variables = class_missing, - ..., - apid_list = NULL + variables = class_missing ) } \arguments{ @@ -19,8 +17,6 @@ servers( those urls.} \item{variables}{A \code{\link[=server_variable_list]{server_variable_list()}} object.} - -\item{...}{Catch-all for unimplemented properties.} } \value{ A \code{servers} S7 object, with properties \code{url}, \code{description}, and diff --git a/tests/testthat/_snaps/info-01-license.md b/tests/testthat/_snaps/info-01-license.md index 67c6b64..6448290 100644 --- a/tests/testthat/_snaps/info-01-license.md +++ b/tests/testthat/_snaps/info-01-license.md @@ -129,15 +129,6 @@ ! `x` must have names "name", "identifier", or "url". * Any other names are ignored. ---- - - Code - as_license(c(a = "Apache 2.0", b = "https://opensource.org/license/apache-2-0/")) - Condition - Error: - ! `x` must have names "name", "identifier", or "url". - * Any other names are ignored. - # as_license() errors informatively for bad classes Code diff --git a/tests/testthat/_snaps/info-zz-info.md b/tests/testthat/_snaps/info-zz-info.md index cccd9d0..25d5b36 100644 --- a/tests/testthat/_snaps/info-zz-info.md +++ b/tests/testthat/_snaps/info-zz-info.md @@ -1,3 +1,34 @@ +# info() validates property length. + + Code + info(title = "My API") + Condition + Error: + ! object is invalid: + - `version` must have the same length as `title` + - `title` has 1 value. + - `version` has no values. + +--- + + Code + info(version = "My API") + Condition + Error: + ! object is invalid: + - When `title` is not defined, `version` must be empty. + - `version` has 1 value. + +--- + + Code + info(summary = "My API") + Condition + Error: + ! object is invalid: + - When `title` is not defined, `summary` must be empty. + - `summary` has 1 value. + # info() returns an empty info Code @@ -5,6 +36,8 @@ test_result Output + @ title : chr(0) + @ version : chr(0) @ contact : .. @ name : chr(0) .. @ email: chr(0) @@ -16,6 +49,46 @@ .. @ url : chr(0) @ summary : chr(0) @ terms_of_service: chr(0) - @ title : chr(0) - @ version : chr(0) + +# as_info() errors informatively for unnamed or misnamed input + + Code + as_info(letters) + Condition + Error: + ! `x` must have names "title", "version", "contact", "description", "license", "summary", or "terms_of_service". + * Any other names are ignored. + +--- + + Code + as_info(list(a = "My Cool API")) + Condition + Error: + ! `x` must have names "title", "version", "contact", "description", "license", "summary", or "terms_of_service". + * Any other names are ignored. + +# as_info() errors informatively for bad classes + + Code + as_info(1:2) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_info(mean) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_info(TRUE) + Condition + Error: + ! Can't coerce `x` to . diff --git a/tests/testthat/_snaps/zz-rapid.md b/tests/testthat/_snaps/zz-rapid.md index 401e30e..5513c31 100644 --- a/tests/testthat/_snaps/zz-rapid.md +++ b/tests/testthat/_snaps/zz-rapid.md @@ -28,6 +28,8 @@ Output @ info : + .. @ title : chr(0) + .. @ version : chr(0) .. @ contact : .. .. @ name : chr(0) .. .. @ email: chr(0) @@ -39,8 +41,6 @@ .. .. @ url : chr(0) .. @ summary : chr(0) .. @ terms_of_service: chr(0) - .. @ title : chr(0) - .. @ version : chr(0) @ servers: .. @ url : chr(0) .. @ description: chr(0) diff --git a/tests/testthat/test-info-01-license.R b/tests/testthat/test-info-01-license.R index 0d1bed8..6dd9732 100644 --- a/tests/testthat/test-info-01-license.R +++ b/tests/testthat/test-info-01-license.R @@ -117,11 +117,6 @@ test_that("as_license() errors informatively for unnamed or misnamed input", { error = TRUE, cnd_class = TRUE ) - expect_snapshot( - as_license(c(a = "Apache 2.0", b = "https://opensource.org/license/apache-2-0/")), - error = TRUE, - cnd_class = TRUE - ) }) test_that("as_license() errors informatively for bad classes", { diff --git a/tests/testthat/test-info-zz-info.R b/tests/testthat/test-info-zz-info.R index cb9626c..000ddaf 100644 --- a/tests/testthat/test-info-zz-info.R +++ b/tests/testthat/test-info-zz-info.R @@ -1,4 +1,17 @@ -# TODO: Implement as_*. +test_that("info() validates property length.", { + expect_snapshot( + info(title = "My API"), + error = TRUE + ) + expect_snapshot( + info(version = "My API"), + error = TRUE + ) + expect_snapshot( + info(summary = "My API"), + error = TRUE + ) +}) test_that("info() returns an empty info", { expect_snapshot({ @@ -13,13 +26,13 @@ test_that("info() returns an empty info", { expect_identical( S7::prop_names(test_result), c( + "title", + "version", "contact", "description", "license", "summary", - "terms_of_service", - "title", - "version" + "terms_of_service" ) ) }) @@ -30,6 +43,7 @@ test_that("length() of an info reports the overall length", { length( info( title = "My Cool API", + version = "one", license = license( name = "Apache 2.0", url = "https://opensource.org/license/apache-2-0/" @@ -39,3 +53,77 @@ test_that("length() of an info reports the overall length", { 1 ) }) + +test_that("as_info() errors informatively for unnamed or misnamed input", { + expect_snapshot( + as_info(letters), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_info(list(a = "My Cool API")), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_info() errors informatively for bad classes", { + expect_snapshot( + as_info(1:2), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_info(mean), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_info(TRUE), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_info() returns expected objects", { + expect_identical( + as_info(c( + title = "My API", + version = "1" + )), + info( + title = "My API", + version = "1" + ) + ) + expect_identical( + as_info(list( + title = "My API", + version = "1", + contact = c( + name = "Jon", + email = "jonthegeek@gmail.com" + ), + license = c( + name = "Apache 2.0", + identifier = "Apache-2.0" + ) + )), + info( + title = "My API", + version = "1", + contact = contact( + name = "Jon", + email = "jonthegeek@gmail.com" + ), + license = license( + name = "Apache 2.0", + identifier = "Apache-2.0" + ) + ) + ) + expect_identical( + as_info(list()), + info() + ) +}) diff --git a/tests/testthat/test-zz-rapid.R b/tests/testthat/test-zz-rapid.R index eb6e6fa..953eef1 100644 --- a/tests/testthat/test-zz-rapid.R +++ b/tests/testthat/test-zz-rapid.R @@ -83,52 +83,52 @@ test_that("length() of a rapid reports the overall length", { ) }) -test_that("Can construct a rapid from an apid list", { - # apid_list_guru <- yaml::read_yaml("https://api.apis.guru/v2/openapi.yaml") - # saveRDS(apid_list_guru, test_path("fixtures", "apid_list_guru.rds")) - apid_list_guru <- readRDS(test_path("fixtures", "apid_list_guru.rds")) - expect_snapshot({ - test_result <- as_rapid(apid_list_guru) - test_result - }) - expect_s3_class( - test_result, - class = c("rapid::rapid", "S7_object"), - exact = TRUE - ) - - # apid_list_awsmh <- yaml::read_yaml("https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml") - # saveRDS(apid_list_awsmh, test_path("fixtures", "apid_list_awsmh.rds")) - apid_list_awsmh <- readRDS(test_path("fixtures", "apid_list_awsmh.rds")) - expect_snapshot({ - test_result <- as_rapid(apid_list_awsmh) - test_result - }) - expect_s3_class( - test_result, - class = c("rapid::rapid", "S7_object"), - exact = TRUE - ) -}) - -test_that("Can construct a rapid from an apid url", { - skip_if_not(Sys.getenv("RAPID_TEST_DL") == "true") - expect_snapshot({ - test_result <- as_rapid("https://api.apis.guru/v2/openapi.yaml") - test_result - }) - expect_s3_class( - test_result, - class = c("rapid::rapid", "S7_object"), - exact = TRUE - ) - expect_snapshot({ - test_result <- as_rapid("https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml") - test_result - }) - expect_s3_class( - test_result, - class = c("rapid::rapid", "S7_object"), - exact = TRUE - ) -}) +# test_that("Can construct a rapid from an apid list", { +# # apid_list_guru <- yaml::read_yaml("https://api.apis.guru/v2/openapi.yaml") +# # saveRDS(apid_list_guru, test_path("fixtures", "apid_list_guru.rds")) +# apid_list_guru <- readRDS(test_path("fixtures", "apid_list_guru.rds")) +# expect_snapshot({ +# test_result <- as_rapid(apid_list_guru) +# test_result +# }) +# expect_s3_class( +# test_result, +# class = c("rapid::rapid", "S7_object"), +# exact = TRUE +# ) +# +# # apid_list_awsmh <- yaml::read_yaml("https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml") +# # saveRDS(apid_list_awsmh, test_path("fixtures", "apid_list_awsmh.rds")) +# apid_list_awsmh <- readRDS(test_path("fixtures", "apid_list_awsmh.rds")) +# expect_snapshot({ +# test_result <- as_rapid(apid_list_awsmh) +# test_result +# }) +# expect_s3_class( +# test_result, +# class = c("rapid::rapid", "S7_object"), +# exact = TRUE +# ) +# }) +# +# test_that("Can construct a rapid from an apid url", { +# skip_if_not(Sys.getenv("RAPID_TEST_DL") == "true") +# expect_snapshot({ +# test_result <- as_rapid("https://api.apis.guru/v2/openapi.yaml") +# test_result +# }) +# expect_s3_class( +# test_result, +# class = c("rapid::rapid", "S7_object"), +# exact = TRUE +# ) +# expect_snapshot({ +# test_result <- as_rapid("https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml") +# test_result +# }) +# expect_s3_class( +# test_result, +# class = c("rapid::rapid", "S7_object"), +# exact = TRUE +# ) +# }) From 3eb2c12158c45b6104d50f42e85b3f18f7e1fb78 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 07:32:35 -0500 Subject: [PATCH 10/19] Standardize server_variable_list() to variables() Closes #30. This is the only place that variables() appears in the definition, and there's really no reason that it would have to be server-specific anyway. --- NAMESPACE | 2 +- ...variable_list.R => servers-02-variables.R} | 8 ++-- R/servers-zz-servers.R | 6 +-- man/servers.Rd | 4 +- man/{server_variable_list.Rd => variables.Rd} | 12 +++--- ...riable_list.md => servers-02-variables.md} | 40 +++++++++---------- tests/testthat/_snaps/servers-zz-servers.md | 2 +- tests/testthat/_snaps/zz-rapid.md | 2 +- .../test-servers-02-server_variable_list.R | 35 ---------------- tests/testthat/test-servers-02-variables.R | 35 ++++++++++++++++ tests/testthat/test-servers-zz-servers.R | 2 +- 11 files changed, 74 insertions(+), 74 deletions(-) rename R/{servers-02-server_variable_list.R => servers-02-variables.R} (85%) rename man/{server_variable_list.Rd => variables.Rd} (69%) rename tests/testthat/_snaps/{servers-02-server_variable_list.md => servers-02-variables.md} (58%) delete mode 100644 tests/testthat/test-servers-02-server_variable_list.R create mode 100644 tests/testthat/test-servers-02-variables.R diff --git a/NAMESPACE b/NAMESPACE index 8f542b8..953c4c3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,8 +14,8 @@ export(info) export(license) export(rapid) export(server_variable) -export(server_variable_list) export(servers) +export(variables) if (getRversion() < "4.3.0") importFrom("S7", "@") importFrom(S7,class_any) importFrom(S7,class_character) diff --git a/R/servers-02-server_variable_list.R b/R/servers-02-variables.R similarity index 85% rename from R/servers-02-server_variable_list.R rename to R/servers-02-variables.R index 25480bb..196fe04 100644 --- a/R/servers-02-server_variable_list.R +++ b/R/servers-02-variables.R @@ -8,16 +8,16 @@ #' @param ... One or more [server_variable()] objects, or a list of #' [server_variable()] objects. #' -#' @return A `server_variable_list` S7 object, which is a validated list of +#' @return A `variables` S7 object, which is a validated list of #' [server_variable()] objects. #' @export #' #' @examples -#' server_variable_list( +#' variables( #' list(server_variable(), server_variable()) #' ) -server_variable_list <- S7::new_class( - "server_variable_list", +variables <- S7::new_class( + "variables", package = "rapid", parent = class_list, constructor = function(...) { diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index 85a6838..6072721 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -7,7 +7,7 @@ #' @param url A character vector of urls. #' @param description A character vector of (usually brief) descriptions of #' those urls. -#' @param variables A [server_variable_list()] object. +#' @param variables A [variables()] object. #' #' @return A `servers` S7 object, with properties `url`, `description`, and #' `variables`. @@ -29,7 +29,7 @@ #' servers( #' url = "https://{username}.gigantic-server.com:{port}/{basePath}", #' description = "The production API server", -#' variables = server_variable_list(server_variable( +#' variables = variables(server_variable( #' name = c("username", "port", "basePath"), #' default = c("demo", "8443", "v2"), #' description = c( @@ -49,7 +49,7 @@ servers <- S7::new_class( properties = list( url = class_character, description = class_character, - variables = server_variable_list + variables = variables ), validator = function(self) { validate_parallel( diff --git a/man/servers.Rd b/man/servers.Rd index 2a96cce..aedd08f 100644 --- a/man/servers.Rd +++ b/man/servers.Rd @@ -16,7 +16,7 @@ servers( \item{description}{A character vector of (usually brief) descriptions of those urls.} -\item{variables}{A \code{\link[=server_variable_list]{server_variable_list()}} object.} +\item{variables}{A \code{\link[=variables]{variables()}} object.} } \value{ A \code{servers} S7 object, with properties \code{url}, \code{description}, and @@ -41,7 +41,7 @@ servers( servers( url = "https://{username}.gigantic-server.com:{port}/{basePath}", description = "The production API server", - variables = server_variable_list(server_variable( + variables = variables(server_variable( name = c("username", "port", "basePath"), default = c("demo", "8443", "v2"), description = c( diff --git a/man/server_variable_list.Rd b/man/variables.Rd similarity index 69% rename from man/server_variable_list.Rd rename to man/variables.Rd index e5e5d0c..f2960de 100644 --- a/man/server_variable_list.Rd +++ b/man/variables.Rd @@ -1,17 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/servers-02-server_variable_list.R -\name{server_variable_list} -\alias{server_variable_list} +% Please edit documentation in R/servers-02-variables.R +\name{variables} +\alias{variables} \title{A collection of server variables for multiple servers} \usage{ -server_variable_list(...) +variables(...) } \arguments{ \item{...}{One or more \code{\link[=server_variable]{server_variable()}} objects, or a list of \code{\link[=server_variable]{server_variable()}} objects.} } \value{ -A \code{server_variable_list} S7 object, which is a validated list of +A \code{variables} S7 object, which is a validated list of \code{\link[=server_variable]{server_variable()}} objects. } \description{ @@ -19,7 +19,7 @@ A list of server variable objects, each of which is constructed with \code{\link[=server_variable]{server_variable()}}. } \examples{ -server_variable_list( +variables( list(server_variable(), server_variable()) ) } diff --git a/tests/testthat/_snaps/servers-02-server_variable_list.md b/tests/testthat/_snaps/servers-02-variables.md similarity index 58% rename from tests/testthat/_snaps/servers-02-server_variable_list.md rename to tests/testthat/_snaps/servers-02-variables.md index 3941513..e7889d6 100644 --- a/tests/testthat/_snaps/servers-02-server_variable_list.md +++ b/tests/testthat/_snaps/servers-02-variables.md @@ -1,46 +1,46 @@ -# server_variable_list() errors informatively for bad contents +# variables() errors informatively for bad contents Code - server_variable_list(letters) + variables(letters) Condition Error: - ! object is invalid: + ! object is invalid: - All values must be objects. - Bad values at 1. --- Code - server_variable_list(list(letters, letters)) + variables(list(letters, letters)) Condition Error: - ! object is invalid: + ! object is invalid: - All values must be objects. - Bad values at 1 and 2. --- Code - server_variable_list(server_variable(), letters, server_variable(), letters) + variables(server_variable(), letters, server_variable(), letters) Condition Error: - ! object is invalid: + ! object is invalid: - All values must be objects. - Bad values at 2 and 4. -# server_variable_list() returns an empty server_variable_list +# variables() returns an empty variables Code - server_variable_list() + variables() Output - list() + list() -# server_variable_list() accepts bare server_variables +# variables() accepts bare server_variables Code - server_variable_list(server_variable()) + variables(server_variable()) Output - List of 1 + List of 1 $ : ..@ name : chr(0) ..@ default : chr(0) @@ -50,9 +50,9 @@ --- Code - server_variable_list(server_variable(), server_variable()) + variables(server_variable(), server_variable()) Output - List of 2 + List of 2 $ : ..@ name : chr(0) ..@ default : chr(0) @@ -64,12 +64,12 @@ ..@ enum : list() ..@ description: chr(0) -# server_variable_list() accepts lists of server_variables +# variables() accepts lists of server_variables Code - server_variable_list(list(server_variable())) + variables(list(server_variable())) Output - List of 1 + List of 1 $ : ..@ name : chr(0) ..@ default : chr(0) @@ -79,9 +79,9 @@ --- Code - server_variable_list(list(server_variable(), server_variable())) + variables(list(server_variable(), server_variable())) Output - List of 2 + List of 2 $ : ..@ name : chr(0) ..@ default : chr(0) diff --git a/tests/testthat/_snaps/servers-zz-servers.md b/tests/testthat/_snaps/servers-zz-servers.md index 2ae38a2..cbe6efc 100644 --- a/tests/testthat/_snaps/servers-zz-servers.md +++ b/tests/testthat/_snaps/servers-zz-servers.md @@ -7,5 +7,5 @@ @ url : chr(0) @ description: chr(0) - @ variables : list() + @ variables : list() diff --git a/tests/testthat/_snaps/zz-rapid.md b/tests/testthat/_snaps/zz-rapid.md index 5513c31..700a786 100644 --- a/tests/testthat/_snaps/zz-rapid.md +++ b/tests/testthat/_snaps/zz-rapid.md @@ -44,5 +44,5 @@ @ servers: .. @ url : chr(0) .. @ description: chr(0) - .. @ variables : list() + .. @ variables : list() diff --git a/tests/testthat/test-servers-02-server_variable_list.R b/tests/testthat/test-servers-02-server_variable_list.R deleted file mode 100644 index d8344c8..0000000 --- a/tests/testthat/test-servers-02-server_variable_list.R +++ /dev/null @@ -1,35 +0,0 @@ -test_that("server_variable_list() errors informatively for bad contents", { - expect_snapshot( - server_variable_list(letters), - error = TRUE - ) - expect_snapshot( - server_variable_list(list(letters, letters)), - error = TRUE - ) - expect_snapshot( - server_variable_list( - server_variable(), - letters, - server_variable(), - letters - ), - error = TRUE - ) -}) - -test_that("server_variable_list() returns an empty server_variable_list", { - expect_snapshot(server_variable_list()) -}) - -test_that("server_variable_list() accepts bare server_variables", { - expect_snapshot(server_variable_list(server_variable())) - expect_snapshot(server_variable_list(server_variable(), server_variable())) -}) - -test_that("server_variable_list() accepts lists of server_variables", { - expect_snapshot(server_variable_list(list(server_variable()))) - expect_snapshot( - server_variable_list(list(server_variable(), server_variable())) - ) -}) diff --git a/tests/testthat/test-servers-02-variables.R b/tests/testthat/test-servers-02-variables.R new file mode 100644 index 0000000..0fd6167 --- /dev/null +++ b/tests/testthat/test-servers-02-variables.R @@ -0,0 +1,35 @@ +test_that("variables() errors informatively for bad contents", { + expect_snapshot( + variables(letters), + error = TRUE + ) + expect_snapshot( + variables(list(letters, letters)), + error = TRUE + ) + expect_snapshot( + variables( + server_variable(), + letters, + server_variable(), + letters + ), + error = TRUE + ) +}) + +test_that("variables() returns an empty variables", { + expect_snapshot(variables()) +}) + +test_that("variables() accepts bare server_variables", { + expect_snapshot(variables(server_variable())) + expect_snapshot(variables(server_variable(), server_variable())) +}) + +test_that("variables() accepts lists of server_variables", { + expect_snapshot(variables(list(server_variable()))) + expect_snapshot( + variables(list(server_variable(), server_variable())) + ) +}) diff --git a/tests/testthat/test-servers-zz-servers.R b/tests/testthat/test-servers-zz-servers.R index 37c1958..ebf4946 100644 --- a/tests/testthat/test-servers-zz-servers.R +++ b/tests/testthat/test-servers-zz-servers.R @@ -45,7 +45,7 @@ test_that("length() of a servers reports the overall length", { servers( url = "https://{username}.gigantic-server.com:{port}/{basePath}", description = "The production API server", - variables = server_variable_list(server_variable( + variables = variables(server_variable( name = c("username", "port", "basePath"), default = c("demo", "8443", "v2"), description = c( From 71256a852bb747ecc513598ccbda72739eb4c693 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 10:15:17 -0500 Subject: [PATCH 11/19] Implement as_*(). --- NAMESPACE | 2 + R/00-properties.R | 3 + R/as.R | 9 +- R/info-01-contact.R | 4 + R/info-01-license.R | 4 + R/info-zz-info.R | 4 + R/servers-01-server_variable.R | 55 +++++++++- R/servers-02-variables.R | 40 +++++++ R/servers-zz-servers.R | 57 +++++++--- R/utils.R | 24 ++++ R/validate_lengths.R | 3 - man/as_server_variable.Rd | 24 ++++ man/as_variables.Rd | 24 ++++ man/server_variable.Rd | 6 +- .../_snaps/servers-01-server_variable.md | 51 +++++++++ tests/testthat/_snaps/servers-02-variables.md | 24 ++++ tests/testthat/_snaps/servers-zz-servers.md | 27 +++++ tests/testthat/test-info-01-contact.R | 7 ++ tests/testthat/test-info-01-license.R | 7 ++ tests/testthat/test-info-zz-info.R | 7 ++ .../test-servers-01-server_variable.R | 103 ++++++++++++++++++ tests/testthat/test-servers-02-variables.R | 81 ++++++++++++++ tests/testthat/test-servers-zz-servers.R | 18 +++ 23 files changed, 553 insertions(+), 31 deletions(-) create mode 100644 man/as_server_variable.Rd create mode 100644 man/as_variables.Rd diff --git a/NAMESPACE b/NAMESPACE index 953c4c3..4f443f2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,8 @@ S3method(length,"rapid::servers") export(as_contact) export(as_info) export(as_license) +export(as_server_variable) +export(as_variables) export(contact) export(info) export(license) diff --git a/R/00-properties.R b/R/00-properties.R index 12fb8f5..0d41713 100644 --- a/R/00-properties.R +++ b/R/00-properties.R @@ -39,6 +39,9 @@ enum_property <- function(x_arg) { enumerations } ) + if (!any(lengths(value))) { + value <- NULL + } S7::prop(self, x_arg, check = FALSE) <- value self } diff --git a/R/as.R b/R/as.R index e4c45b4..247ba32 100644 --- a/R/as.R +++ b/R/as.R @@ -2,11 +2,12 @@ target_S7_class, x_arg = rlang::caller_arg(x), call = rlang::caller_env()) { + if (!length(x)) { + return(NULL) + } + valid_names <- S7::prop_names(target_S7_class()) - if ( - length(x) && - (!rlang::is_named(x) || !any(names(x) %in% valid_names)) - ) { + if (!rlang::is_named(x) || !any(names(x) %in% valid_names)) { cli::cli_abort( c( "{.arg {x_arg}} must have names {.or {.val {valid_names}}}.", diff --git a/R/info-01-contact.R b/R/info-01-contact.R index 01bb175..77200d6 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -51,6 +51,10 @@ contact <- S7::new_class( #' as_contact(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) as_contact <- S7::new_generic("as_contact", dispatch_args = "x") +S7::method(as_contact, contact) <- function(x) { + x +} + S7::method(as_contact, class_list | class_character) <- function(x) { x <- .validate_for_as_class(x, contact) contact(name = x[["name"]], email = x[["email"]], url = x[["url"]]) diff --git a/R/info-01-license.R b/R/info-01-license.R index ec4fcde..ba754ea 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -67,6 +67,10 @@ license <- S7::new_class( #' as_license(list(name = "Apache 2.0", identifier = "Apache-2.0")) as_license <- S7::new_generic("as_license", dispatch_args = "x") +S7::method(as_license, license) <- function(x) { + x +} + S7::method(as_license, class_list | class_character) <- function(x) { x <- .validate_for_as_class(x, license) license(name = x[["name"]], identifier = x[["identifier"]], url = x[["url"]]) diff --git a/R/info-zz-info.R b/R/info-zz-info.R index e431414..ba3a797 100644 --- a/R/info-zz-info.R +++ b/R/info-zz-info.R @@ -80,6 +80,10 @@ info <- S7::new_class( #' as_info(list(title = "My Cool API", version = "1.0.0")) as_info <- S7::new_generic("as_info", dispatch_args = "x") +S7::method(as_info, info) <- function(x) { + x +} + S7::method(as_info, class_list | class_character) <- function(x) { x <- .validate_for_as_class(x, info) diff --git a/R/servers-01-server_variable.R b/R/servers-01-server_variable.R index 505b0b9..e541e3d 100644 --- a/R/servers-01-server_variable.R +++ b/R/servers-01-server_variable.R @@ -40,12 +40,15 @@ server_variable <- S7::new_class( enum = enum_property("enum"), description = class_character ), - constructor = function(name = character(), - default = character(), + constructor = function(name = S7::class_missing, + default = S7::class_missing, ..., enum = NULL, - description = character()) { + description = S7::class_missing) { check_dots_empty() + name <- name %||% character() + default <- default %||% character() + description <- description %||% character() S7::new_object( NULL, name = name, @@ -60,7 +63,7 @@ server_variable <- S7::new_class( "name", required = "default", optional = c("enum", "description") - ) %||% validate_in_enum( + ) %|0|% validate_in_enum( self, value_name = "default", enum_name = "enum" @@ -72,3 +75,47 @@ server_variable <- S7::new_class( `length.rapid::server_variable` <- function(x) { length(x@name) } + +#' Coerce lists and character vectors to server_variables +#' +#' `as_server_variable()` turns an existing object into a `server_variable`. +#' This is in contrast with [server_variable()], which builds a +#' `server_variable` from individual properties. +#' +#' @param x The object to coerce. Must be empty or have names "name", "email", +#' and/or "url". Extra names are ignored. +#' +#' @return A `server_variable` as returned by [server_variable()]. +#' @export +#' +#' @examples +#' as_server_variable() +#' as_server_variable(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +as_server_variable <- S7::new_generic("as_server_variable", dispatch_args = "x") + +S7::method(as_server_variable, server_variable) <- function(x) { + x +} + +S7::method(as_server_variable, class_list) <- function(x) { + nameless <- unname(x) + server_variable( + name = names(x), + default = purrr::map_chr(nameless, "default"), + enum = purrr::map(nameless, "enum"), + description = .extract_along_chr(nameless, "description") + ) +} + +S7::method(as_server_variable, class_missing) <- function(x) { + server_variable() +} + +S7::method(as_server_variable, class_any) <- function(x) { + if (is.null(x)) { + return(server_variable()) + } + cli::cli_abort( + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls server_variable}." + ) +} diff --git a/R/servers-02-variables.R b/R/servers-02-variables.R index 196fe04..558dadb 100644 --- a/R/servers-02-variables.R +++ b/R/servers-02-variables.R @@ -42,3 +42,43 @@ variables <- S7::new_class( } } ) + +#' Coerce lists and character vectors to variables +#' +#' `as_variables()` turns an existing object into a `variables`. This is in +#' contrast with [variables()], which builds a `variables` from individual +#' properties. +#' +#' @param x The object to coerce. Must be empty or have names "name", "email", +#' and/or "url". Extra names are ignored. +#' +#' @return A `variables` as returned by [variables()]. +#' @export +#' +#' @examples +#' as_variables() +#' as_variables(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +as_variables <- S7::new_generic("as_variables", dispatch_args = "x") + +S7::method(as_variables, variables) <- function(x) { + x +} + +S7::method(as_variables, class_list) <- function(x) { + variables( + purrr::map(x, as_server_variable) + ) +} + +S7::method(as_variables, class_missing) <- function(x) { + variables() +} + +S7::method(as_variables, class_any) <- function(x) { + if (is.null(x)) { + return(variables()) + } + cli::cli_abort( + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls variables}." + ) +} diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index 6072721..f5c84e2 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -1,5 +1,3 @@ -# TODO: Implement as_*. - #' A collection of server variables for multiple servers #' #' Connectivity information for an API. @@ -60,24 +58,49 @@ servers <- S7::new_class( } ) -.extract_along_chr <- function(x, el) { - y <- purrr::map(x, el) - if (purrr::every(y, is.null)) { - return(NULL) - } - purrr::map_chr( - y, - \(this) { - this %||% NA - } +#' @export +`length.rapid::servers` <- function(x) { + length(x@url) +} + +#' Coerce lists and character vectors to servers +#' +#' `as_servers()` turns an existing object into a `servers`. This is in +#' contrast with [servers()], which builds a `servers` from individual +#' properties. +#' +#' @param x The object to coerce. Must be empty or have names "name", "email", +#' and/or "url". Extra names are ignored. +#' +#' @return A `servers` as returned by [servers()]. +#' @export +#' +#' @examples +#' as_servers() +#' as_servers(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +as_servers <- S7::new_generic("as_servers", dispatch_args = "x") + +S7::method(as_servers, servers) <- function(x) { + x +} + +S7::method(as_servers, class_list | class_character) <- function(x) { + servers( + url = purrr::map_chr(x, "url"), + description = purrr::map_chr(x, "description"), + variables = as_variables(purrr::map(x, "variables")) ) } -.extract <- function(x, el) { - x$el %||% NA +S7::method(as_servers, class_missing) <- function(x) { + servers() } -#' @export -`length.rapid::servers` <- function(x) { - length(x@url) +S7::method(as_servers, class_any) <- function(x) { + if (is.null(x)) { + return(servers()) + } + cli::cli_abort( + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls servers}." + ) } diff --git a/R/utils.R b/R/utils.R index 8740d9e..85f2ed1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -6,3 +6,27 @@ } ) } + +# I was about to write this when I discovered it unexported in rlang. I used +# their name in case it ever becomes standard. +`%|0|%` <- function(x, y) { + if (!length(x)) y + else x +} + +.extract_along_chr <- function(x, el) { + y <- purrr::map(x, el) + if (purrr::every(y, is.null)) { + return(NULL) + } + purrr::map_chr( + y, + \(this) { + this %||% NA + } + ) +} + +.extract <- function(x, el) { + x$el %||% NA +} diff --git a/R/validate_lengths.R b/R/validate_lengths.R index 8725a5a..b13bf7c 100644 --- a/R/validate_lengths.R +++ b/R/validate_lengths.R @@ -28,9 +28,6 @@ validate_lengths <- function(obj, ) } - if (!length(issues)) { - return(NULL) - } return(unique(issues)) } diff --git a/man/as_server_variable.Rd b/man/as_server_variable.Rd new file mode 100644 index 0000000..eec98e8 --- /dev/null +++ b/man/as_server_variable.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/servers-01-server_variable.R +\name{as_server_variable} +\alias{as_server_variable} +\title{Coerce lists and character vectors to server_variables} +\usage{ +as_server_variable(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or have names "name", "email", +and/or "url". Extra names are ignored.} +} +\value{ +A \code{server_variable} as returned by \code{\link[=server_variable]{server_variable()}}. +} +\description{ +\code{as_server_variable()} turns an existing object into a \code{server_variable}. +This is in contrast with \code{\link[=server_variable]{server_variable()}}, which builds a +\code{server_variable} from individual properties. +} +\examples{ +as_server_variable() +as_server_variable(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +} diff --git a/man/as_variables.Rd b/man/as_variables.Rd new file mode 100644 index 0000000..8c297b4 --- /dev/null +++ b/man/as_variables.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/servers-02-variables.R +\name{as_variables} +\alias{as_variables} +\title{Coerce lists and character vectors to variables} +\usage{ +as_variables(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or have names "name", "email", +and/or "url". Extra names are ignored.} +} +\value{ +A \code{variables} as returned by \code{\link[=variables]{variables()}}. +} +\description{ +\code{as_variables()} turns an existing object into a \code{variables}. This is in +contrast with \code{\link[=variables]{variables()}}, which builds a \code{variables} from individual +properties. +} +\examples{ +as_variables() +as_variables(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +} diff --git a/man/server_variable.Rd b/man/server_variable.Rd index 2d77093..c53e544 100644 --- a/man/server_variable.Rd +++ b/man/server_variable.Rd @@ -5,11 +5,11 @@ \title{A server variable for server URL template substitution} \usage{ server_variable( - name = character(), - default = character(), + name = S7::class_missing, + default = S7::class_missing, ..., enum = NULL, - description = character() + description = S7::class_missing ) } \arguments{ diff --git a/tests/testthat/_snaps/servers-01-server_variable.md b/tests/testthat/_snaps/servers-01-server_variable.md index f45917e..dbba8ec 100644 --- a/tests/testthat/_snaps/servers-01-server_variable.md +++ b/tests/testthat/_snaps/servers-01-server_variable.md @@ -123,3 +123,54 @@ .. $ : NULL @ description: chr [1:3] "The active user's folder." NA NA +# as_server_variable() errors informatively for unnamed or misnamed input + + Code + as_server_variable(letters) + Condition + Error: + ! `x` must have names "name", "default", "enum", or "description". + * Any other names are ignored. + +--- + + Code + as_server_variable(list(a = "Jon", b = "jonthegeek@gmail.com")) + Condition + Error: + ! `x` must have names "name", "default", "enum", or "description". + * Any other names are ignored. + +--- + + Code + as_server_variable(c(a = "Jon", b = "jonthegeek@gmail.com")) + Condition + Error: + ! `x` must have names "name", "default", "enum", or "description". + * Any other names are ignored. + +# as_server_variable() errors informatively for bad classes + + Code + as_server_variable(1:2) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_server_variable(mean) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_server_variable(TRUE) + Condition + Error: + ! Can't coerce `x` to . + diff --git a/tests/testthat/_snaps/servers-02-variables.md b/tests/testthat/_snaps/servers-02-variables.md index e7889d6..a21cd00 100644 --- a/tests/testthat/_snaps/servers-02-variables.md +++ b/tests/testthat/_snaps/servers-02-variables.md @@ -93,3 +93,27 @@ ..@ enum : list() ..@ description: chr(0) +# as_variables() errors informatively for bad classes + + Code + as_variables(1:2) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_variables(mean) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_variables(TRUE) + Condition + Error: + ! Can't coerce `x` to . + diff --git a/tests/testthat/_snaps/servers-zz-servers.md b/tests/testthat/_snaps/servers-zz-servers.md index cbe6efc..ef09a00 100644 --- a/tests/testthat/_snaps/servers-zz-servers.md +++ b/tests/testthat/_snaps/servers-zz-servers.md @@ -9,3 +9,30 @@ @ description: chr(0) @ variables : list() +# as_servers() errors informatively for unnamed or misnamed input + + Code + as_servers(letters) + Condition + Error: + ! `x` must have names "url", "description", or "variables". + * Any other names are ignored. + +--- + + Code + as_servers(list(a = "https://example.com", b = "A cool server.")) + Condition + Error: + ! `x` must have names "url", "description", or "variables". + * Any other names are ignored. + +--- + + Code + as_servers(c(a = "https://example.com", b = "A cool server.")) + Condition + Error: + ! `x` must have names "url", "description", or "variables". + * Any other names are ignored. + diff --git a/tests/testthat/test-info-01-contact.R b/tests/testthat/test-info-01-contact.R index 90ef2c8..7a979fd 100644 --- a/tests/testthat/test-info-01-contact.R +++ b/tests/testthat/test-info-01-contact.R @@ -169,3 +169,10 @@ test_that("as_contact() returns expected objects", { contact() ) }) + +test_that("as_contact() works for contacts", { + expect_identical( + as_contact(contact()), + contact() + ) +}) diff --git a/tests/testthat/test-info-01-license.R b/tests/testthat/test-info-01-license.R index 6dd9732..ace4c4f 100644 --- a/tests/testthat/test-info-01-license.R +++ b/tests/testthat/test-info-01-license.R @@ -191,6 +191,13 @@ test_that("as_license() returns expected objects", { ) }) +test_that("as_license() works for licenses", { + expect_identical( + as_license(license()), + license() + ) +}) + # TODO: Prettier printing. # # TODO: After all that, I think I want to implement components$securitySchemas diff --git a/tests/testthat/test-info-zz-info.R b/tests/testthat/test-info-zz-info.R index 000ddaf..d00a0b8 100644 --- a/tests/testthat/test-info-zz-info.R +++ b/tests/testthat/test-info-zz-info.R @@ -127,3 +127,10 @@ test_that("as_info() returns expected objects", { info() ) }) + +test_that("as_info() works for infos", { + expect_identical( + as_info(info()), + info() + ) +}) diff --git a/tests/testthat/test-servers-01-server_variable.R b/tests/testthat/test-servers-01-server_variable.R index 4603482..ddc8f50 100644 --- a/tests/testthat/test-servers-01-server_variable.R +++ b/tests/testthat/test-servers-01-server_variable.R @@ -98,3 +98,106 @@ test_that("length() of a server_variable reports the overall length", { expect_equal(length(server_variable()), 0) expect_equal(length(server_variable(name = "A", default = "A")), 1) }) + +test_that("as_server_variable() errors informatively for unnamed or misnamed input", { + expect_snapshot( + as_server_variable(letters), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_server_variable(list(a = "Jon", b = "jonthegeek@gmail.com")), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_server_variable(c(a = "Jon", b = "jonthegeek@gmail.com")), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_server_variable() errors informatively for bad classes", { + expect_snapshot( + as_server_variable(1:2), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_server_variable(mean), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_server_variable(TRUE), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_server_variable() returns expected objects", { + expect_identical( + as_server_variable( + list( + username = c( + default = "demo", + description = "Name of the user." + ) + ) + ), + server_variable( + name = "username", + default = "demo", + description = "Name of the user." + ) + ) + expect_identical( + as_server_variable( + list( + username = c( + default = "demo", + description = "Name of the user.", + x = "https://jonthegeek.com" + ) + ) + ), + server_variable( + name = "username", + default = "demo", + description = "Name of the user." + ) + ) + expect_identical( + as_server_variable( + list( + username = c( + default = "demo", + description = "Name of the user.", + x = "https://jonthegeek.com" + ), + port = list( + default = "8443", + enum = c("8443", "443") + ) + ) + ), + server_variable( + name = c("username", "port"), + default = c("demo", 8443), + enum = list(NULL, c(8443, 443)), + description = c("Name of the user.", NA) + ) + ) + + expect_identical( + as_server_variable(list()), + server_variable() + ) +}) + +test_that("as_server_variable() works for server_variables", { + expect_identical( + as_server_variable(server_variable()), + server_variable() + ) +}) diff --git a/tests/testthat/test-servers-02-variables.R b/tests/testthat/test-servers-02-variables.R index 0fd6167..7f43778 100644 --- a/tests/testthat/test-servers-02-variables.R +++ b/tests/testthat/test-servers-02-variables.R @@ -33,3 +33,84 @@ test_that("variables() accepts lists of server_variables", { variables(list(server_variable(), server_variable())) ) }) + +test_that("as_variables() errors informatively for bad classes", { + expect_snapshot( + as_variables(1:2), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_variables(mean), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_variables(TRUE), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_variables() returns expected objects", { + expect_identical( + as_variables( + list( + list( + username = c(default = "demo", description = "Name of the user.") + ) + ) + ), + variables( + server_variable( + name = "username", + default = "demo", + description = "Name of the user." + ) + ) + ) + expect_identical( + as_variables( + list( + list( + username = c(default = "demo", description = "Name of the user.") + ), + list( + username = c( + default = "demo", + description = "Name of the user.", + x = "https://jonthegeek.com" + ), + port = list( + default = "8443", + enum = c("8443", "443") + ) + ) + ) + ), + variables( + server_variable( + name = "username", + default = "demo", + description = "Name of the user." + ), + server_variable( + name = c("username", "port"), + default = c("demo", 8443), + description = c("Name of the user.", NA), + enum = list(NULL, c(8443, 443)) + ) + ) + ) + expect_identical( + as_variables(list()), + variables() + ) +}) + +test_that("as_variables() works for variables", { + expect_identical( + as_variables(variables()), + variables() + ) +}) diff --git a/tests/testthat/test-servers-zz-servers.R b/tests/testthat/test-servers-zz-servers.R index ebf4946..2f3d330 100644 --- a/tests/testthat/test-servers-zz-servers.R +++ b/tests/testthat/test-servers-zz-servers.R @@ -63,3 +63,21 @@ test_that("length() of a servers reports the overall length", { 1 ) }) + +test_that("as_servers() errors informatively for unnamed or misnamed input", { + expect_snapshot( + as_servers(letters), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_servers(list(a = "https://example.com", b = "A cool server.")), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_servers(c(a = "https://example.com", b = "A cool server.")), + error = TRUE, + cnd_class = TRUE + ) +}) From c8e37913358bdbe209a96804ca1916f3eeba0cdc Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 10:16:50 -0500 Subject: [PATCH 12/19] Rename server_variable to string_replacements. I couldn't stick with the OpenAPI names. This makes much more sense to me. More to come in this area. --- ...ble.R => servers-01-string_replacements.R} | 64 ++++++++------ R/servers-02-variables.R | 16 ++-- R/servers-zz-servers.R | 2 +- ...e.md => servers-01-string_replacements.md} | 0 ... => test-servers-01-string_replacements.R} | 84 +++++++++---------- tests/testthat/test-servers-02-variables.R | 22 ++--- tests/testthat/test-servers-zz-servers.R | 2 +- 7 files changed, 100 insertions(+), 90 deletions(-) rename R/{servers-01-server_variable.R => servers-01-string_replacements.R} (60%) rename tests/testthat/_snaps/{servers-01-server_variable.md => servers-01-string_replacements.md} (100%) rename tests/testthat/{test-servers-01-server_variable.R => test-servers-01-string_replacements.R} (54%) diff --git a/R/servers-01-server_variable.R b/R/servers-01-string_replacements.R similarity index 60% rename from R/servers-01-server_variable.R rename to R/servers-01-string_replacements.R index e541e3d..44a86a1 100644 --- a/R/servers-01-server_variable.R +++ b/R/servers-01-string_replacements.R @@ -1,6 +1,4 @@ -# TODO: Implement as_*. - -#' A server variable for server URL template substitution +#' A set of variables for server URL template substitution #' #' Server variable properties used for substitution in the server’s URL #' template. @@ -20,19 +18,19 @@ #' each server variable. [CommonMark syntax](https://spec.commonmark.org/) #' *may* be used for rich text representation. #' -#' @return A `server_variable` S7 object, with fields `name`, `default`, `enum`, -#' and `description`. +#' @return A `string_replacements` S7 object, with fields `name`, `default`, +#' `enum`, and `description`. #' @export #' #' @examples -#' server_variable( +#' string_replacements( #' "username", #' "demo", #' enum = c("demo", "other"), #' description = "The active user's folder." #' ) -server_variable <- S7::new_class( - "server_variable", +string_replacements <- S7::new_class( + "string_replacements", package = "rapid", properties = list( name = class_character, @@ -72,34 +70,46 @@ server_variable <- S7::new_class( ) #' @export -`length.rapid::server_variable` <- function(x) { +`length.rapid::string_replacements` <- function(x) { length(x@name) } -#' Coerce lists and character vectors to server_variables +#' Coerce lists vectors to string_replacements #' -#' `as_server_variable()` turns an existing object into a `server_variable`. -#' This is in contrast with [server_variable()], which builds a -#' `server_variable` from individual properties. +#' `as_string_replacements()` turns an existing object into a +#' `string_replacements`. This is in contrast with [string_replacements()], +#' which builds a `string_replacements` from individual properties. #' -#' @param x The object to coerce. Must be empty or have names "name", "email", -#' and/or "url". Extra names are ignored. +#' @param x The object to coerce. Must be empty or be a list of named lists, +#' each with names "enum", "default", or "description". Additional names are +#' ignored. #' -#' @return A `server_variable` as returned by [server_variable()]. +#' @return A `string_replacements` as returned by [string_replacements()]. #' @export #' #' @examples -#' as_server_variable() -#' as_server_variable(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) -as_server_variable <- S7::new_generic("as_server_variable", dispatch_args = "x") +#' as_string_replacements() +#' as_string_replacements( +#' list( +#' username = c( +#' default = "demo", +#' description = "Name of the user." +#' ), +#' port = list( +#' default = "8443", +#' enum = c("8443", "443") +#' ) +#' ) +#' ) +as_string_replacements <- S7::new_generic("as_string_replacements", dispatch_args = "x") -S7::method(as_server_variable, server_variable) <- function(x) { +S7::method(as_string_replacements, string_replacements) <- function(x) { x } -S7::method(as_server_variable, class_list) <- function(x) { +S7::method(as_string_replacements, class_list) <- function(x) { nameless <- unname(x) - server_variable( + string_replacements( name = names(x), default = purrr::map_chr(nameless, "default"), enum = purrr::map(nameless, "enum"), @@ -107,15 +117,15 @@ S7::method(as_server_variable, class_list) <- function(x) { ) } -S7::method(as_server_variable, class_missing) <- function(x) { - server_variable() +S7::method(as_string_replacements, class_missing) <- function(x) { + string_replacements() } -S7::method(as_server_variable, class_any) <- function(x) { +S7::method(as_string_replacements, class_any) <- function(x) { if (is.null(x)) { - return(server_variable()) + return(string_replacements()) } cli::cli_abort( - "Can't coerce {.arg x} {.cls {class(x)}} to {.cls server_variable}." + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls string_replacements}." ) } diff --git a/R/servers-02-variables.R b/R/servers-02-variables.R index 558dadb..b009e71 100644 --- a/R/servers-02-variables.R +++ b/R/servers-02-variables.R @@ -3,18 +3,18 @@ #' A collection of server variables for multiple servers #' #' A list of server variable objects, each of which is constructed with -#' [server_variable()]. +#' [string_replacements()]. #' -#' @param ... One or more [server_variable()] objects, or a list of -#' [server_variable()] objects. +#' @param ... One or more [string_replacements()] objects, or a list of +#' [string_replacements()] objects. #' #' @return A `variables` S7 object, which is a validated list of -#' [server_variable()] objects. +#' [string_replacements()] objects. #' @export #' #' @examples #' variables( -#' list(server_variable(), server_variable()) +#' list(string_replacements(), string_replacements()) #' ) variables <- S7::new_class( "variables", @@ -29,13 +29,13 @@ variables <- S7::new_class( validator = function(self) { bad_server_vars <- !purrr::map_lgl( S7::S7_data(self), - ~ S7::S7_inherits(.x, server_variable) + ~ S7::S7_inherits(.x, string_replacements) ) if (any(bad_server_vars)) { bad_locations <- which(bad_server_vars) c( cli::format_inline( - "All values must be {.cls server_variable} objects." + "All values must be {.cls string_replacements} objects." ), cli::format_inline("Bad values at {bad_locations}.") ) @@ -66,7 +66,7 @@ S7::method(as_variables, variables) <- function(x) { S7::method(as_variables, class_list) <- function(x) { variables( - purrr::map(x, as_server_variable) + purrr::map(x, as_string_replacements) ) } diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index f5c84e2..9b2061e 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -27,7 +27,7 @@ #' servers( #' url = "https://{username}.gigantic-server.com:{port}/{basePath}", #' description = "The production API server", -#' variables = variables(server_variable( +#' variables = variables(string_replacements( #' name = c("username", "port", "basePath"), #' default = c("demo", "8443", "v2"), #' description = c( diff --git a/tests/testthat/_snaps/servers-01-server_variable.md b/tests/testthat/_snaps/servers-01-string_replacements.md similarity index 100% rename from tests/testthat/_snaps/servers-01-server_variable.md rename to tests/testthat/_snaps/servers-01-string_replacements.md diff --git a/tests/testthat/test-servers-01-server_variable.R b/tests/testthat/test-servers-01-string_replacements.R similarity index 54% rename from tests/testthat/test-servers-01-server_variable.R rename to tests/testthat/test-servers-01-string_replacements.R index ddc8f50..5f313d0 100644 --- a/tests/testthat/test-servers-01-server_variable.R +++ b/tests/testthat/test-servers-01-string_replacements.R @@ -1,37 +1,37 @@ -test_that("server_variable() requires names for optional args", { +test_that("string_replacements() requires names for optional args", { expect_snapshot( - server_variable("a", "b", "c"), + string_replacements("a", "b", "c"), error = TRUE ) }) -test_that("server_variable() requires that default matches name", { +test_that("string_replacements() requires that default matches name", { expect_snapshot( - server_variable("a"), + string_replacements("a"), error = TRUE ) expect_snapshot( - server_variable("a", letters), + string_replacements("a", letters), error = TRUE ) expect_snapshot( - server_variable(letters, "a"), + string_replacements(letters, "a"), error = TRUE ) expect_snapshot( - server_variable(character(), "a"), + string_replacements(character(), "a"), error = TRUE ) }) -test_that("server_variable() works with equal-length name/default", { +test_that("string_replacements() works with equal-length name/default", { expect_snapshot({ - test_result <- server_variable("a", "b") + test_result <- string_replacements("a", "b") test_result }) expect_s3_class( test_result, - class = c("rapid::server_variable", "S7_object"), + class = c("rapid::string_replacements", "S7_object"), exact = TRUE ) expect_identical( @@ -40,24 +40,24 @@ test_that("server_variable() works with equal-length name/default", { ) }) -test_that("server_variable() requires that optional args are empty or match", { +test_that("string_replacements() requires that optional args are empty or match", { expect_snapshot( - server_variable("a", "b", enum = list("a", "b")), + string_replacements("a", "b", enum = list("a", "b")), error = TRUE ) expect_snapshot( - server_variable("a", "b", description = c("a", "b")), + string_replacements("a", "b", description = c("a", "b")), error = TRUE ) }) -test_that("server_variable() requires that the default is in enum when given", { +test_that("string_replacements() requires that the default is in enum when given", { expect_snapshot( - server_variable(name = "a", default = "b", enum = "a"), + string_replacements(name = "a", default = "b", enum = "a"), error = TRUE ) expect_snapshot( - server_variable( + string_replacements( name = c("a", "b"), default = c("b", "a"), enum = list("a", "a") @@ -66,9 +66,9 @@ test_that("server_variable() requires that the default is in enum when given", { ) }) -test_that("server_variable() works for a full object", { +test_that("string_replacements() works for a full object", { expect_snapshot({ - test_result <- server_variable( + test_result <- string_replacements( name = c("username", "port", "basePath"), default = c("demo", "8443", "v2"), description = c( @@ -85,7 +85,7 @@ test_that("server_variable() works for a full object", { }) expect_s3_class( test_result, - class = c("rapid::server_variable", "S7_object"), + class = c("rapid::string_replacements", "S7_object"), exact = TRUE ) expect_identical( @@ -94,50 +94,50 @@ test_that("server_variable() works for a full object", { ) }) -test_that("length() of a server_variable reports the overall length", { - expect_equal(length(server_variable()), 0) - expect_equal(length(server_variable(name = "A", default = "A")), 1) +test_that("length() of a string_replacements reports the overall length", { + expect_equal(length(string_replacements()), 0) + expect_equal(length(string_replacements(name = "A", default = "A")), 1) }) -test_that("as_server_variable() errors informatively for unnamed or misnamed input", { +test_that("as_string_replacements() errors informatively for unnamed or misnamed input", { expect_snapshot( - as_server_variable(letters), + as_string_replacements(letters), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_server_variable(list(a = "Jon", b = "jonthegeek@gmail.com")), + as_string_replacements(list(a = "Jon", b = "jonthegeek@gmail.com")), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_server_variable(c(a = "Jon", b = "jonthegeek@gmail.com")), + as_string_replacements(c(a = "Jon", b = "jonthegeek@gmail.com")), error = TRUE, cnd_class = TRUE ) }) -test_that("as_server_variable() errors informatively for bad classes", { +test_that("as_string_replacements() errors informatively for bad classes", { expect_snapshot( - as_server_variable(1:2), + as_string_replacements(1:2), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_server_variable(mean), + as_string_replacements(mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_server_variable(TRUE), + as_string_replacements(TRUE), error = TRUE, cnd_class = TRUE ) }) -test_that("as_server_variable() returns expected objects", { +test_that("as_string_replacements() returns expected objects", { expect_identical( - as_server_variable( + as_string_replacements( list( username = c( default = "demo", @@ -145,14 +145,14 @@ test_that("as_server_variable() returns expected objects", { ) ) ), - server_variable( + string_replacements( name = "username", default = "demo", description = "Name of the user." ) ) expect_identical( - as_server_variable( + as_string_replacements( list( username = c( default = "demo", @@ -161,14 +161,14 @@ test_that("as_server_variable() returns expected objects", { ) ) ), - server_variable( + string_replacements( name = "username", default = "demo", description = "Name of the user." ) ) expect_identical( - as_server_variable( + as_string_replacements( list( username = c( default = "demo", @@ -181,7 +181,7 @@ test_that("as_server_variable() returns expected objects", { ) ) ), - server_variable( + string_replacements( name = c("username", "port"), default = c("demo", 8443), enum = list(NULL, c(8443, 443)), @@ -190,14 +190,14 @@ test_that("as_server_variable() returns expected objects", { ) expect_identical( - as_server_variable(list()), - server_variable() + as_string_replacements(list()), + string_replacements() ) }) -test_that("as_server_variable() works for server_variables", { +test_that("as_string_replacements() works for string_replacements", { expect_identical( - as_server_variable(server_variable()), - server_variable() + as_string_replacements(string_replacements()), + string_replacements() ) }) diff --git a/tests/testthat/test-servers-02-variables.R b/tests/testthat/test-servers-02-variables.R index 7f43778..7cebe9a 100644 --- a/tests/testthat/test-servers-02-variables.R +++ b/tests/testthat/test-servers-02-variables.R @@ -9,9 +9,9 @@ test_that("variables() errors informatively for bad contents", { ) expect_snapshot( variables( - server_variable(), + string_replacements(), letters, - server_variable(), + string_replacements(), letters ), error = TRUE @@ -22,15 +22,15 @@ test_that("variables() returns an empty variables", { expect_snapshot(variables()) }) -test_that("variables() accepts bare server_variables", { - expect_snapshot(variables(server_variable())) - expect_snapshot(variables(server_variable(), server_variable())) +test_that("variables() accepts bare string_replacements", { + expect_snapshot(variables(string_replacements())) + expect_snapshot(variables(string_replacements(), string_replacements())) }) -test_that("variables() accepts lists of server_variables", { - expect_snapshot(variables(list(server_variable()))) +test_that("variables() accepts lists of string_replacements", { + expect_snapshot(variables(list(string_replacements()))) expect_snapshot( - variables(list(server_variable(), server_variable())) + variables(list(string_replacements(), string_replacements())) ) }) @@ -62,7 +62,7 @@ test_that("as_variables() returns expected objects", { ) ), variables( - server_variable( + string_replacements( name = "username", default = "demo", description = "Name of the user." @@ -89,12 +89,12 @@ test_that("as_variables() returns expected objects", { ) ), variables( - server_variable( + string_replacements( name = "username", default = "demo", description = "Name of the user." ), - server_variable( + string_replacements( name = c("username", "port"), default = c("demo", 8443), description = c("Name of the user.", NA), diff --git a/tests/testthat/test-servers-zz-servers.R b/tests/testthat/test-servers-zz-servers.R index 2f3d330..d7fdadb 100644 --- a/tests/testthat/test-servers-zz-servers.R +++ b/tests/testthat/test-servers-zz-servers.R @@ -45,7 +45,7 @@ test_that("length() of a servers reports the overall length", { servers( url = "https://{username}.gigantic-server.com:{port}/{basePath}", description = "The production API server", - variables = variables(server_variable( + variables = variables(string_replacements( name = c("username", "port", "basePath"), default = c("demo", "8443", "v2"), description = c( From 2b83f319fbd3e9fbe2c0f9f94d3dd345b881e835 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 10:26:14 -0500 Subject: [PATCH 13/19] Rename "variables" to "server_variables". This is a list of "string_replacements" objects, which are themselves lists. I want to make sure these stand out as special for a multi-server-with-different-variables situation. --- NAMESPACE | 11 +- R/servers-02-server_variables.R | 83 ++++++++++++ R/servers-02-variables.R | 84 ------------- R/servers-zz-servers.R | 10 +- man/as_server_variable.Rd | 24 ---- man/as_server_variables.Rd | 23 ++++ man/as_servers.Rd | 24 ++++ man/as_string_replacements.Rd | 36 ++++++ man/as_variables.Rd | 24 ---- man/server_variables.Rd | 25 ++++ man/servers.Rd | 6 +- ...ver_variable.Rd => string_replacements.Rd} | 16 +-- man/variables.Rd | 25 ---- .../_snaps/servers-01-string_replacements.md | 96 +++++++------- .../_snaps/servers-02-server_variables.md | 119 ++++++++++++++++++ tests/testthat/_snaps/servers-02-variables.md | 119 ------------------ tests/testthat/_snaps/servers-zz-servers.md | 31 +++-- tests/testthat/_snaps/zz-rapid.new.md | 48 +++++++ ...s.R => test-servers-02-server_variables.R} | 52 ++++---- 19 files changed, 472 insertions(+), 384 deletions(-) create mode 100644 R/servers-02-server_variables.R delete mode 100644 R/servers-02-variables.R delete mode 100644 man/as_server_variable.Rd create mode 100644 man/as_server_variables.Rd create mode 100644 man/as_servers.Rd create mode 100644 man/as_string_replacements.Rd delete mode 100644 man/as_variables.Rd create mode 100644 man/server_variables.Rd rename man/{server_variable.Rd => string_replacements.Rd} (79%) delete mode 100644 man/variables.Rd create mode 100644 tests/testthat/_snaps/servers-02-server_variables.md delete mode 100644 tests/testthat/_snaps/servers-02-variables.md create mode 100644 tests/testthat/_snaps/zz-rapid.new.md rename tests/testthat/{test-servers-02-variables.R => test-servers-02-server_variables.R} (56%) diff --git a/NAMESPACE b/NAMESPACE index 4f443f2..cc67a41 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,20 +4,21 @@ S3method(length,"rapid::contact") S3method(length,"rapid::info") S3method(length,"rapid::license") S3method(length,"rapid::rapid") -S3method(length,"rapid::server_variable") S3method(length,"rapid::servers") +S3method(length,"rapid::string_replacements") export(as_contact) export(as_info) export(as_license) -export(as_server_variable) -export(as_variables) +export(as_server_variables) +export(as_servers) +export(as_string_replacements) export(contact) export(info) export(license) export(rapid) -export(server_variable) +export(server_variables) export(servers) -export(variables) +export(string_replacements) if (getRversion() < "4.3.0") importFrom("S7", "@") importFrom(S7,class_any) importFrom(S7,class_character) diff --git a/R/servers-02-server_variables.R b/R/servers-02-server_variables.R new file mode 100644 index 0000000..7fcabcf --- /dev/null +++ b/R/servers-02-server_variables.R @@ -0,0 +1,83 @@ +# TODO: Implement as_*. + +#' A collection of string replacements for multiple servers +#' +#' A list of string replacements objects, each of which is constructed with +#' [string_replacements()]. +#' +#' @param ... One or more [string_replacements()] objects, or a list of +#' [string_replacements()] objects. +#' +#' @return A `server_variables` S7 object, which is a validated list of +#' [string_replacements()] objects. +#' @export +#' +#' @examples +#' server_variables( +#' list(string_replacements(), string_replacements()) +#' ) +server_variables <- S7::new_class( + "server_variables", + package = "rapid", + parent = class_list, + constructor = function(...) { + if (...length() == 1 && is.list(..1)) { + return(S7::new_object(..1)) + } + S7::new_object(list(...)) + }, + validator = function(self) { + bad_string_replacements <- !purrr::map_lgl( + S7::S7_data(self), + ~ S7::S7_inherits(.x, string_replacements) + ) + if (any(bad_string_replacements)) { + bad_locations <- which(bad_string_replacements) + c( + cli::format_inline( + "All values must be {.cls string_replacements} objects." + ), + cli::format_inline("Bad values at {bad_locations}.") + ) + } + } +) + +#' Coerce lists and character vectors to server_variables +#' +#' `as_server_variables()` turns an existing object into a `server_variables` +#' object. This is in contrast with [server_variables()], which builds a +#' `server_variables` object from individual properties. +#' +#' @param x The object to coerce. Must be empty or be a list of objects that can +#' be coerced to `string_replacements` objects via [as_string_replacements()]. +#' +#' @return A `server_variables` object as returned by [server_variables()]. +#' @export +#' +#' @examples +#' as_server_variables() +as_server_variables <- S7::new_generic("as_server_variables", dispatch_args = "x") + +S7::method(as_server_variables, server_variables) <- function(x) { + x +} + +S7::method(as_server_variables, class_list) <- function(x) { + server_variables( + purrr::map(x, as_string_replacements) + ) +} + +S7::method(as_server_variables, class_missing) <- function(x) { + server_variables() +} + +S7::method(as_server_variables, class_any) <- function(x) { + if (is.null(x)) { + return(server_variables()) + } + cli::cli_abort( + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls server_variables}." + ) +} diff --git a/R/servers-02-variables.R b/R/servers-02-variables.R deleted file mode 100644 index b009e71..0000000 --- a/R/servers-02-variables.R +++ /dev/null @@ -1,84 +0,0 @@ -# TODO: Implement as_*. - -#' A collection of server variables for multiple servers -#' -#' A list of server variable objects, each of which is constructed with -#' [string_replacements()]. -#' -#' @param ... One or more [string_replacements()] objects, or a list of -#' [string_replacements()] objects. -#' -#' @return A `variables` S7 object, which is a validated list of -#' [string_replacements()] objects. -#' @export -#' -#' @examples -#' variables( -#' list(string_replacements(), string_replacements()) -#' ) -variables <- S7::new_class( - "variables", - package = "rapid", - parent = class_list, - constructor = function(...) { - if (...length() == 1 && is.list(..1)) { - return(S7::new_object(..1)) - } - S7::new_object(list(...)) - }, - validator = function(self) { - bad_server_vars <- !purrr::map_lgl( - S7::S7_data(self), - ~ S7::S7_inherits(.x, string_replacements) - ) - if (any(bad_server_vars)) { - bad_locations <- which(bad_server_vars) - c( - cli::format_inline( - "All values must be {.cls string_replacements} objects." - ), - cli::format_inline("Bad values at {bad_locations}.") - ) - } - } -) - -#' Coerce lists and character vectors to variables -#' -#' `as_variables()` turns an existing object into a `variables`. This is in -#' contrast with [variables()], which builds a `variables` from individual -#' properties. -#' -#' @param x The object to coerce. Must be empty or have names "name", "email", -#' and/or "url". Extra names are ignored. -#' -#' @return A `variables` as returned by [variables()]. -#' @export -#' -#' @examples -#' as_variables() -#' as_variables(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) -as_variables <- S7::new_generic("as_variables", dispatch_args = "x") - -S7::method(as_variables, variables) <- function(x) { - x -} - -S7::method(as_variables, class_list) <- function(x) { - variables( - purrr::map(x, as_string_replacements) - ) -} - -S7::method(as_variables, class_missing) <- function(x) { - variables() -} - -S7::method(as_variables, class_any) <- function(x) { - if (is.null(x)) { - return(variables()) - } - cli::cli_abort( - "Can't coerce {.arg x} {.cls {class(x)}} to {.cls variables}." - ) -} diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index 9b2061e..e845fe0 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -1,11 +1,11 @@ -#' A collection of server variables for multiple servers +#' An object representing a collection of servers #' #' Connectivity information for an API. #' #' @param url A character vector of urls. #' @param description A character vector of (usually brief) descriptions of #' those urls. -#' @param variables A [variables()] object. +#' @param variables A [server_variables()] object. #' #' @return A `servers` S7 object, with properties `url`, `description`, and #' `variables`. @@ -27,7 +27,7 @@ #' servers( #' url = "https://{username}.gigantic-server.com:{port}/{basePath}", #' description = "The production API server", -#' variables = variables(string_replacements( +#' variables = server_variables(string_replacements( #' name = c("username", "port", "basePath"), #' default = c("demo", "8443", "v2"), #' description = c( @@ -47,7 +47,7 @@ servers <- S7::new_class( properties = list( url = class_character, description = class_character, - variables = variables + variables = server_variables ), validator = function(self) { validate_parallel( @@ -88,7 +88,7 @@ S7::method(as_servers, class_list | class_character) <- function(x) { servers( url = purrr::map_chr(x, "url"), description = purrr::map_chr(x, "description"), - variables = as_variables(purrr::map(x, "variables")) + variables = as_server_variables(purrr::map(x, "variables")) ) } diff --git a/man/as_server_variable.Rd b/man/as_server_variable.Rd deleted file mode 100644 index eec98e8..0000000 --- a/man/as_server_variable.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/servers-01-server_variable.R -\name{as_server_variable} -\alias{as_server_variable} -\title{Coerce lists and character vectors to server_variables} -\usage{ -as_server_variable(x, ...) -} -\arguments{ -\item{x}{The object to coerce. Must be empty or have names "name", "email", -and/or "url". Extra names are ignored.} -} -\value{ -A \code{server_variable} as returned by \code{\link[=server_variable]{server_variable()}}. -} -\description{ -\code{as_server_variable()} turns an existing object into a \code{server_variable}. -This is in contrast with \code{\link[=server_variable]{server_variable()}}, which builds a -\code{server_variable} from individual properties. -} -\examples{ -as_server_variable() -as_server_variable(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) -} diff --git a/man/as_server_variables.Rd b/man/as_server_variables.Rd new file mode 100644 index 0000000..56fa808 --- /dev/null +++ b/man/as_server_variables.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/servers-02-server_variables.R +\name{as_server_variables} +\alias{as_server_variables} +\title{Coerce lists and character vectors to server_variables} +\usage{ +as_server_variables(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or be a list of objects that can +be coerced to \code{string_replacements} objects via \code{\link[=as_string_replacements]{as_string_replacements()}}.} +} +\value{ +A \code{server_variables} object as returned by \code{\link[=server_variables]{server_variables()}}. +} +\description{ +\code{as_server_variables()} turns an existing object into a \code{server_variables} +object. This is in contrast with \code{\link[=server_variables]{server_variables()}}, which builds a +\code{server_variables} object from individual properties. +} +\examples{ +as_server_variables() +} diff --git a/man/as_servers.Rd b/man/as_servers.Rd new file mode 100644 index 0000000..48f8e61 --- /dev/null +++ b/man/as_servers.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/servers-zz-servers.R +\name{as_servers} +\alias{as_servers} +\title{Coerce lists and character vectors to servers} +\usage{ +as_servers(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or have names "name", "email", +and/or "url". Extra names are ignored.} +} +\value{ +A \code{servers} as returned by \code{\link[=servers]{servers()}}. +} +\description{ +\code{as_servers()} turns an existing object into a \code{servers}. This is in +contrast with \code{\link[=servers]{servers()}}, which builds a \code{servers} from individual +properties. +} +\examples{ +as_servers() +as_servers(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +} diff --git a/man/as_string_replacements.Rd b/man/as_string_replacements.Rd new file mode 100644 index 0000000..60e2d52 --- /dev/null +++ b/man/as_string_replacements.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/servers-01-string_replacements.R +\name{as_string_replacements} +\alias{as_string_replacements} +\title{Coerce lists vectors to string_replacements} +\usage{ +as_string_replacements(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or be a list of named lists, +each with names "enum", "default", or "description". Additional names are +ignored.} +} +\value{ +A \code{string_replacements} as returned by \code{\link[=string_replacements]{string_replacements()}}. +} +\description{ +\code{as_string_replacements()} turns an existing object into a +\code{string_replacements}. This is in contrast with \code{\link[=string_replacements]{string_replacements()}}, +which builds a \code{string_replacements} from individual properties. +} +\examples{ +as_string_replacements() +as_string_replacements( + list( + username = c( + default = "demo", + description = "Name of the user." + ), + port = list( + default = "8443", + enum = c("8443", "443") + ) + ) +) +} diff --git a/man/as_variables.Rd b/man/as_variables.Rd deleted file mode 100644 index 8c297b4..0000000 --- a/man/as_variables.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/servers-02-variables.R -\name{as_variables} -\alias{as_variables} -\title{Coerce lists and character vectors to variables} -\usage{ -as_variables(x, ...) -} -\arguments{ -\item{x}{The object to coerce. Must be empty or have names "name", "email", -and/or "url". Extra names are ignored.} -} -\value{ -A \code{variables} as returned by \code{\link[=variables]{variables()}}. -} -\description{ -\code{as_variables()} turns an existing object into a \code{variables}. This is in -contrast with \code{\link[=variables]{variables()}}, which builds a \code{variables} from individual -properties. -} -\examples{ -as_variables() -as_variables(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) -} diff --git a/man/server_variables.Rd b/man/server_variables.Rd new file mode 100644 index 0000000..f8cc233 --- /dev/null +++ b/man/server_variables.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/servers-02-server_variables.R +\name{server_variables} +\alias{server_variables} +\title{A collection of string replacements for multiple servers} +\usage{ +server_variables(...) +} +\arguments{ +\item{...}{One or more \code{\link[=string_replacements]{string_replacements()}} objects, or a list of +\code{\link[=string_replacements]{string_replacements()}} objects.} +} +\value{ +A \code{server_variables} S7 object, which is a validated list of +\code{\link[=string_replacements]{string_replacements()}} objects. +} +\description{ +A list of string replacements objects, each of which is constructed with +\code{\link[=string_replacements]{string_replacements()}}. +} +\examples{ +server_variables( + list(string_replacements(), string_replacements()) +) +} diff --git a/man/servers.Rd b/man/servers.Rd index aedd08f..bef9e68 100644 --- a/man/servers.Rd +++ b/man/servers.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/servers-zz-servers.R \name{servers} \alias{servers} -\title{A collection of server variables for multiple servers} +\title{An object representing a collection of servers} \usage{ servers( url = class_missing, @@ -16,7 +16,7 @@ servers( \item{description}{A character vector of (usually brief) descriptions of those urls.} -\item{variables}{A \code{\link[=variables]{variables()}} object.} +\item{variables}{A \code{\link[=server_variables]{server_variables()}} object.} } \value{ A \code{servers} S7 object, with properties \code{url}, \code{description}, and @@ -41,7 +41,7 @@ servers( servers( url = "https://{username}.gigantic-server.com:{port}/{basePath}", description = "The production API server", - variables = variables(server_variable( + variables = server_variables(string_replacements( name = c("username", "port", "basePath"), default = c("demo", "8443", "v2"), description = c( diff --git a/man/server_variable.Rd b/man/string_replacements.Rd similarity index 79% rename from man/server_variable.Rd rename to man/string_replacements.Rd index c53e544..e411031 100644 --- a/man/server_variable.Rd +++ b/man/string_replacements.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/servers-01-server_variable.R -\name{server_variable} -\alias{server_variable} -\title{A server variable for server URL template substitution} +% Please edit documentation in R/servers-01-string_replacements.R +\name{string_replacements} +\alias{string_replacements} +\title{A set of variables for server URL template substitution} \usage{ -server_variable( +string_replacements( name = S7::class_missing, default = S7::class_missing, ..., @@ -33,15 +33,15 @@ each server variable. \href{https://spec.commonmark.org/}{CommonMark syntax} \emph{may} be used for rich text representation.} } \value{ -A \code{server_variable} S7 object, with fields \code{name}, \code{default}, \code{enum}, -and \code{description}. +A \code{string_replacements} S7 object, with fields \code{name}, \code{default}, +\code{enum}, and \code{description}. } \description{ Server variable properties used for substitution in the server’s URL template. } \examples{ -server_variable( +string_replacements( "username", "demo", enum = c("demo", "other"), diff --git a/man/variables.Rd b/man/variables.Rd deleted file mode 100644 index f2960de..0000000 --- a/man/variables.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/servers-02-variables.R -\name{variables} -\alias{variables} -\title{A collection of server variables for multiple servers} -\usage{ -variables(...) -} -\arguments{ -\item{...}{One or more \code{\link[=server_variable]{server_variable()}} objects, or a list of -\code{\link[=server_variable]{server_variable()}} objects.} -} -\value{ -A \code{variables} S7 object, which is a validated list of -\code{\link[=server_variable]{server_variable()}} objects. -} -\description{ -A list of server variable objects, each of which is constructed with -\code{\link[=server_variable]{server_variable()}}. -} -\examples{ -variables( - list(server_variable(), server_variable()) -) -} diff --git a/tests/testthat/_snaps/servers-01-string_replacements.md b/tests/testthat/_snaps/servers-01-string_replacements.md index dbba8ec..08af5f6 100644 --- a/tests/testthat/_snaps/servers-01-string_replacements.md +++ b/tests/testthat/_snaps/servers-01-string_replacements.md @@ -1,21 +1,21 @@ -# server_variable() requires names for optional args +# string_replacements() requires names for optional args Code - server_variable("a", "b", "c") + string_replacements("a", "b", "c") Condition - Error in `server_variable()`: + Error in `string_replacements()`: ! `...` must be empty. x Problematic argument: * ..1 = "c" i Did you forget to name an argument? -# server_variable() requires that default matches name +# string_replacements() requires that default matches name Code - server_variable("a") + string_replacements("a") Condition Error: - ! object is invalid: + ! object is invalid: - `default` must have the same length as `name` - `name` has 1 value. - `default` has no values. @@ -23,10 +23,10 @@ --- Code - server_variable("a", letters) + string_replacements("a", letters) Condition Error: - ! object is invalid: + ! object is invalid: - `default` must have the same length as `name` - `name` has 1 value. - `default` has 26 values. @@ -34,10 +34,10 @@ --- Code - server_variable(letters, "a") + string_replacements(letters, "a") Condition Error: - ! object is invalid: + ! object is invalid: - `default` must have the same length as `name` - `name` has 26 values. - `default` has 1 value. @@ -45,32 +45,32 @@ --- Code - server_variable(character(), "a") + string_replacements(character(), "a") Condition Error: - ! object is invalid: + ! object is invalid: - When `name` is not defined, `default` must be empty. - `default` has 1 value. -# server_variable() works with equal-length name/default +# string_replacements() works with equal-length name/default Code - test_result <- server_variable("a", "b") + test_result <- string_replacements("a", "b") test_result Output - + @ name : chr "a" @ default : chr "b" - @ enum : list() + @ enum : NULL @ description: chr(0) -# server_variable() requires that optional args are empty or match +# string_replacements() requires that optional args are empty or match Code - server_variable("a", "b", enum = list("a", "b")) + string_replacements("a", "b", enum = list("a", "b")) Condition Error: - ! object is invalid: + ! object is invalid: - `enum` must be empty or have the same length as `name` - `name` has 1 value. - `enum` has 2 values. @@ -78,43 +78,44 @@ --- Code - server_variable("a", "b", description = c("a", "b")) + string_replacements("a", "b", description = c("a", "b")) Condition Error: - ! object is invalid: + ! object is invalid: - `description` must be empty or have the same length as `name` - `name` has 1 value. - `description` has 2 values. -# server_variable() requires that the default is in enum when given +# string_replacements() requires that the default is in enum when given Code - server_variable(name = "a", default = "b", enum = "a") + string_replacements(name = "a", default = "b", enum = "a") Condition Error: - ! object is invalid: + ! object is invalid: - `default` must be in `enum`. - "b" is not in "a". --- Code - server_variable(name = c("a", "b"), default = c("b", "a"), enum = list("a", "a")) + string_replacements(name = c("a", "b"), default = c("b", "a"), enum = list("a", + "a")) Condition Error: - ! object is invalid: + ! object is invalid: - `default` must be in `enum`. - "b" is not in "a". -# server_variable() works for a full object +# string_replacements() works for a full object Code - test_result <- server_variable(name = c("username", "port", "basePath"), + test_result <- string_replacements(name = c("username", "port", "basePath"), default = c("demo", "8443", "v2"), description = c("The active user's folder.", NA, NA), enum = list(NULL, c("8443", "443"), NULL)) test_result Output - + @ name : chr [1:3] "username" "port" "basePath" @ default : chr [1:3] "demo" "8443" "v2" @ enum :List of 3 @@ -123,54 +124,53 @@ .. $ : NULL @ description: chr [1:3] "The active user's folder." NA NA -# as_server_variable() errors informatively for unnamed or misnamed input +# as_string_replacements() errors informatively for unnamed or misnamed input Code - as_server_variable(letters) + as_string_replacements(letters) Condition Error: - ! `x` must have names "name", "default", "enum", or "description". - * Any other names are ignored. + ! Can't coerce `x` to . --- Code - as_server_variable(list(a = "Jon", b = "jonthegeek@gmail.com")) - Condition - Error: - ! `x` must have names "name", "default", "enum", or "description". - * Any other names are ignored. + as_string_replacements(list(a = "Jon", b = "jonthegeek@gmail.com")) + Condition + Error in `purrr::map_chr()`: + i In index: 1. + Caused by error: + ! Result must be length 1, not 0. --- Code - as_server_variable(c(a = "Jon", b = "jonthegeek@gmail.com")) + as_string_replacements(c(a = "Jon", b = "jonthegeek@gmail.com")) Condition Error: - ! `x` must have names "name", "default", "enum", or "description". - * Any other names are ignored. + ! Can't coerce `x` to . -# as_server_variable() errors informatively for bad classes +# as_string_replacements() errors informatively for bad classes Code - as_server_variable(1:2) + as_string_replacements(1:2) Condition Error: - ! Can't coerce `x` to . + ! Can't coerce `x` to . --- Code - as_server_variable(mean) + as_string_replacements(mean) Condition Error: - ! Can't coerce `x` to . + ! Can't coerce `x` to . --- Code - as_server_variable(TRUE) + as_string_replacements(TRUE) Condition Error: - ! Can't coerce `x` to . + ! Can't coerce `x` to . diff --git a/tests/testthat/_snaps/servers-02-server_variables.md b/tests/testthat/_snaps/servers-02-server_variables.md new file mode 100644 index 0000000..fb54787 --- /dev/null +++ b/tests/testthat/_snaps/servers-02-server_variables.md @@ -0,0 +1,119 @@ +# server_variables() errors informatively for bad contents + + Code + server_variables(letters) + Condition + Error: + ! object is invalid: + - All values must be objects. + - Bad values at 1. + +--- + + Code + server_variables(list(letters, letters)) + Condition + Error: + ! object is invalid: + - All values must be objects. + - Bad values at 1 and 2. + +--- + + Code + server_variables(string_replacements(), letters, string_replacements(), letters) + Condition + Error: + ! object is invalid: + - All values must be objects. + - Bad values at 2 and 4. + +# server_variables() returns an empty server_variables + + Code + server_variables() + Output + list() + +# server_variables() accepts bare string_replacements + + Code + server_variables(string_replacements()) + Output + List of 1 + $ : + ..@ name : chr(0) + ..@ default : chr(0) + ..@ enum : NULL + ..@ description: chr(0) + +--- + + Code + server_variables(string_replacements(), string_replacements()) + Output + List of 2 + $ : + ..@ name : chr(0) + ..@ default : chr(0) + ..@ enum : NULL + ..@ description: chr(0) + $ : + ..@ name : chr(0) + ..@ default : chr(0) + ..@ enum : NULL + ..@ description: chr(0) + +# server_variables() accepts lists of string_replacements + + Code + server_variables(list(string_replacements())) + Output + List of 1 + $ : + ..@ name : chr(0) + ..@ default : chr(0) + ..@ enum : NULL + ..@ description: chr(0) + +--- + + Code + server_variables(list(string_replacements(), string_replacements())) + Output + List of 2 + $ : + ..@ name : chr(0) + ..@ default : chr(0) + ..@ enum : NULL + ..@ description: chr(0) + $ : + ..@ name : chr(0) + ..@ default : chr(0) + ..@ enum : NULL + ..@ description: chr(0) + +# as_server_variables() errors informatively for bad classes + + Code + as_server_variables(1:2) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_server_variables(mean) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_server_variables(TRUE) + Condition + Error: + ! Can't coerce `x` to . + diff --git a/tests/testthat/_snaps/servers-02-variables.md b/tests/testthat/_snaps/servers-02-variables.md deleted file mode 100644 index a21cd00..0000000 --- a/tests/testthat/_snaps/servers-02-variables.md +++ /dev/null @@ -1,119 +0,0 @@ -# variables() errors informatively for bad contents - - Code - variables(letters) - Condition - Error: - ! object is invalid: - - All values must be objects. - - Bad values at 1. - ---- - - Code - variables(list(letters, letters)) - Condition - Error: - ! object is invalid: - - All values must be objects. - - Bad values at 1 and 2. - ---- - - Code - variables(server_variable(), letters, server_variable(), letters) - Condition - Error: - ! object is invalid: - - All values must be objects. - - Bad values at 2 and 4. - -# variables() returns an empty variables - - Code - variables() - Output - list() - -# variables() accepts bare server_variables - - Code - variables(server_variable()) - Output - List of 1 - $ : - ..@ name : chr(0) - ..@ default : chr(0) - ..@ enum : list() - ..@ description: chr(0) - ---- - - Code - variables(server_variable(), server_variable()) - Output - List of 2 - $ : - ..@ name : chr(0) - ..@ default : chr(0) - ..@ enum : list() - ..@ description: chr(0) - $ : - ..@ name : chr(0) - ..@ default : chr(0) - ..@ enum : list() - ..@ description: chr(0) - -# variables() accepts lists of server_variables - - Code - variables(list(server_variable())) - Output - List of 1 - $ : - ..@ name : chr(0) - ..@ default : chr(0) - ..@ enum : list() - ..@ description: chr(0) - ---- - - Code - variables(list(server_variable(), server_variable())) - Output - List of 2 - $ : - ..@ name : chr(0) - ..@ default : chr(0) - ..@ enum : list() - ..@ description: chr(0) - $ : - ..@ name : chr(0) - ..@ default : chr(0) - ..@ enum : list() - ..@ description: chr(0) - -# as_variables() errors informatively for bad classes - - Code - as_variables(1:2) - Condition - Error: - ! Can't coerce `x` to . - ---- - - Code - as_variables(mean) - Condition - Error: - ! Can't coerce `x` to . - ---- - - Code - as_variables(TRUE) - Condition - Error: - ! Can't coerce `x` to . - diff --git a/tests/testthat/_snaps/servers-zz-servers.md b/tests/testthat/_snaps/servers-zz-servers.md index ef09a00..af262da 100644 --- a/tests/testthat/_snaps/servers-zz-servers.md +++ b/tests/testthat/_snaps/servers-zz-servers.md @@ -7,32 +7,37 @@ @ url : chr(0) @ description: chr(0) - @ variables : list() + @ variables : list() # as_servers() errors informatively for unnamed or misnamed input Code as_servers(letters) - Condition - Error: - ! `x` must have names "url", "description", or "variables". - * Any other names are ignored. + Condition + Error in `purrr::map_chr()`: + i In index: 1. + Caused by error: + ! Result must be length 1, not 0. --- Code as_servers(list(a = "https://example.com", b = "A cool server.")) - Condition - Error: - ! `x` must have names "url", "description", or "variables". - * Any other names are ignored. + Condition + Error in `purrr::map_chr()`: + i In index: 1. + i With name: a. + Caused by error: + ! Result must be length 1, not 0. --- Code as_servers(c(a = "https://example.com", b = "A cool server.")) - Condition - Error: - ! `x` must have names "url", "description", or "variables". - * Any other names are ignored. + Condition + Error in `purrr::map_chr()`: + i In index: 1. + i With name: a. + Caused by error: + ! Result must be length 1, not 0. diff --git a/tests/testthat/_snaps/zz-rapid.new.md b/tests/testthat/_snaps/zz-rapid.new.md new file mode 100644 index 0000000..b5f64d9 --- /dev/null +++ b/tests/testthat/_snaps/zz-rapid.new.md @@ -0,0 +1,48 @@ +# rapid() requires info objects for info + + Code + rapid(info = mean) + Condition + Error: + ! object properties are invalid: + - @info must be , not + +# rapid() requires info when anything is defined + + Code + rapid(servers = servers(url = c("https://development.gigantic-server.com/v1", + "https://staging.gigantic-server.com/v1", + "https://api.gigantic-server.com/v1"), description = c("Development server", + "Staging server", "Production server"))) + Condition + Error: + ! object is invalid: + - When `info` is not defined, `servers` must be empty. + - `servers` has 3 values. + +# rapid() returns an empty rapid + + Code + test_result <- rapid() + test_result + Output + + @ info : + .. @ title : chr(0) + .. @ version : chr(0) + .. @ contact : + .. .. @ name : chr(0) + .. .. @ email: chr(0) + .. .. @ url : chr(0) + .. @ description : chr(0) + .. @ license : + .. .. @ name : chr(0) + .. .. @ identifier: chr(0) + .. .. @ url : chr(0) + .. @ summary : chr(0) + .. @ terms_of_service: chr(0) + @ servers: + .. @ url : chr(0) + .. @ description: chr(0) + .. @ variables : list() + diff --git a/tests/testthat/test-servers-02-variables.R b/tests/testthat/test-servers-02-server_variables.R similarity index 56% rename from tests/testthat/test-servers-02-variables.R rename to tests/testthat/test-servers-02-server_variables.R index 7cebe9a..0607be3 100644 --- a/tests/testthat/test-servers-02-variables.R +++ b/tests/testthat/test-servers-02-server_variables.R @@ -1,14 +1,14 @@ -test_that("variables() errors informatively for bad contents", { +test_that("server_variables() errors informatively for bad contents", { expect_snapshot( - variables(letters), + server_variables(letters), error = TRUE ) expect_snapshot( - variables(list(letters, letters)), + server_variables(list(letters, letters)), error = TRUE ) expect_snapshot( - variables( + server_variables( string_replacements(), letters, string_replacements(), @@ -18,50 +18,50 @@ test_that("variables() errors informatively for bad contents", { ) }) -test_that("variables() returns an empty variables", { - expect_snapshot(variables()) +test_that("server_variables() returns an empty server_variables", { + expect_snapshot(server_variables()) }) -test_that("variables() accepts bare string_replacements", { - expect_snapshot(variables(string_replacements())) - expect_snapshot(variables(string_replacements(), string_replacements())) +test_that("server_variables() accepts bare string_replacements", { + expect_snapshot(server_variables(string_replacements())) + expect_snapshot(server_variables(string_replacements(), string_replacements())) }) -test_that("variables() accepts lists of string_replacements", { - expect_snapshot(variables(list(string_replacements()))) +test_that("server_variables() accepts lists of string_replacements", { + expect_snapshot(server_variables(list(string_replacements()))) expect_snapshot( - variables(list(string_replacements(), string_replacements())) + server_variables(list(string_replacements(), string_replacements())) ) }) -test_that("as_variables() errors informatively for bad classes", { +test_that("as_server_variables() errors informatively for bad classes", { expect_snapshot( - as_variables(1:2), + as_server_variables(1:2), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_variables(mean), + as_server_variables(mean), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_variables(TRUE), + as_server_variables(TRUE), error = TRUE, cnd_class = TRUE ) }) -test_that("as_variables() returns expected objects", { +test_that("as_server_variables() returns expected objects", { expect_identical( - as_variables( + as_server_variables( list( list( username = c(default = "demo", description = "Name of the user.") ) ) ), - variables( + server_variables( string_replacements( name = "username", default = "demo", @@ -70,7 +70,7 @@ test_that("as_variables() returns expected objects", { ) ) expect_identical( - as_variables( + as_server_variables( list( list( username = c(default = "demo", description = "Name of the user.") @@ -88,7 +88,7 @@ test_that("as_variables() returns expected objects", { ) ) ), - variables( + server_variables( string_replacements( name = "username", default = "demo", @@ -103,14 +103,14 @@ test_that("as_variables() returns expected objects", { ) ) expect_identical( - as_variables(list()), - variables() + as_server_variables(list()), + server_variables() ) }) -test_that("as_variables() works for variables", { +test_that("as_server_variables() works for server_variables", { expect_identical( - as_variables(variables()), - variables() + as_server_variables(server_variables()), + server_variables() ) }) From 71707d83eff8956486629c71cb9a813c326f5fbe Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 13:44:11 -0500 Subject: [PATCH 14/19] Finish as_server() implementation. --- R/servers-02-server_variables.R | 5 +- R/servers-zz-servers.R | 13 ++++ tests/testthat/_snaps/servers-zz-servers.md | 45 ++++++++--- tests/testthat/_snaps/zz-rapid.md | 2 +- tests/testthat/_snaps/zz-rapid.new.md | 48 ------------ tests/testthat/test-servers-zz-servers.R | 84 ++++++++++++++++++++- 6 files changed, 133 insertions(+), 64 deletions(-) delete mode 100644 tests/testthat/_snaps/zz-rapid.new.md diff --git a/R/servers-02-server_variables.R b/R/servers-02-server_variables.R index 7fcabcf..59bb91c 100644 --- a/R/servers-02-server_variables.R +++ b/R/servers-02-server_variables.R @@ -1,5 +1,3 @@ -# TODO: Implement as_*. - #' A collection of string replacements for multiple servers #' #' A list of string replacements objects, each of which is constructed with @@ -64,6 +62,9 @@ S7::method(as_server_variables, server_variables) <- function(x) { } S7::method(as_server_variables, class_list) <- function(x) { + if (!length(x) || !any(lengths(x))) { + return(server_variables()) + } server_variables( purrr::map(x, as_string_replacements) ) diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index e845fe0..bfa0a76 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -85,6 +85,19 @@ S7::method(as_servers, servers) <- function(x) { } S7::method(as_servers, class_list | class_character) <- function(x) { + call <- rlang::caller_env() + x <- purrr::map( + x, + \(x) { + .validate_for_as_class( + x, + servers, + x_arg = "x[[i]]", + call = call + ) + } + ) + servers( url = purrr::map_chr(x, "url"), description = purrr::map_chr(x, "description"), diff --git a/tests/testthat/_snaps/servers-zz-servers.md b/tests/testthat/_snaps/servers-zz-servers.md index af262da..c1a83bf 100644 --- a/tests/testthat/_snaps/servers-zz-servers.md +++ b/tests/testthat/_snaps/servers-zz-servers.md @@ -14,30 +14,57 @@ Code as_servers(letters) Condition - Error in `purrr::map_chr()`: + Error in `purrr::map()`: i In index: 1. - Caused by error: - ! Result must be length 1, not 0. + Caused by error in `as_servers()`: + ! `x[[i]]` must have names "url", "description", or "variables". + * Any other names are ignored. --- Code as_servers(list(a = "https://example.com", b = "A cool server.")) Condition - Error in `purrr::map_chr()`: + Error in `purrr::map()`: i In index: 1. i With name: a. - Caused by error: - ! Result must be length 1, not 0. + Caused by error in `as_servers()`: + ! `x[[i]]` must have names "url", "description", or "variables". + * Any other names are ignored. --- Code as_servers(c(a = "https://example.com", b = "A cool server.")) Condition - Error in `purrr::map_chr()`: + Error in `purrr::map()`: i In index: 1. i With name: a. - Caused by error: - ! Result must be length 1, not 0. + Caused by error in `as_servers()`: + ! `x[[i]]` must have names "url", "description", or "variables". + * Any other names are ignored. + +# as_servers() errors informatively for bad classes + + Code + as_servers(1:2) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_servers(mean) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_servers(TRUE) + Condition + Error: + ! Can't coerce `x` to . diff --git a/tests/testthat/_snaps/zz-rapid.md b/tests/testthat/_snaps/zz-rapid.md index 700a786..b5f64d9 100644 --- a/tests/testthat/_snaps/zz-rapid.md +++ b/tests/testthat/_snaps/zz-rapid.md @@ -44,5 +44,5 @@ @ servers: .. @ url : chr(0) .. @ description: chr(0) - .. @ variables : list() + .. @ variables : list() diff --git a/tests/testthat/_snaps/zz-rapid.new.md b/tests/testthat/_snaps/zz-rapid.new.md deleted file mode 100644 index b5f64d9..0000000 --- a/tests/testthat/_snaps/zz-rapid.new.md +++ /dev/null @@ -1,48 +0,0 @@ -# rapid() requires info objects for info - - Code - rapid(info = mean) - Condition - Error: - ! object properties are invalid: - - @info must be , not - -# rapid() requires info when anything is defined - - Code - rapid(servers = servers(url = c("https://development.gigantic-server.com/v1", - "https://staging.gigantic-server.com/v1", - "https://api.gigantic-server.com/v1"), description = c("Development server", - "Staging server", "Production server"))) - Condition - Error: - ! object is invalid: - - When `info` is not defined, `servers` must be empty. - - `servers` has 3 values. - -# rapid() returns an empty rapid - - Code - test_result <- rapid() - test_result - Output - - @ info : - .. @ title : chr(0) - .. @ version : chr(0) - .. @ contact : - .. .. @ name : chr(0) - .. .. @ email: chr(0) - .. .. @ url : chr(0) - .. @ description : chr(0) - .. @ license : - .. .. @ name : chr(0) - .. .. @ identifier: chr(0) - .. .. @ url : chr(0) - .. @ summary : chr(0) - .. @ terms_of_service: chr(0) - @ servers: - .. @ url : chr(0) - .. @ description: chr(0) - .. @ variables : list() - diff --git a/tests/testthat/test-servers-zz-servers.R b/tests/testthat/test-servers-zz-servers.R index d7fdadb..89c3a9e 100644 --- a/tests/testthat/test-servers-zz-servers.R +++ b/tests/testthat/test-servers-zz-servers.R @@ -1,6 +1,3 @@ -# TODO: Reconsider server format. Closer mirroring of OAS seems appropriate. Or -# maybe a tribble equivalent. - test_that("servers() returns an empty server", { expect_snapshot({ test_result <- servers() @@ -45,7 +42,7 @@ test_that("length() of a servers reports the overall length", { servers( url = "https://{username}.gigantic-server.com:{port}/{basePath}", description = "The production API server", - variables = variables(string_replacements( + variables = server_variables(string_replacements( name = c("username", "port", "basePath"), default = c("demo", "8443", "v2"), description = c( @@ -81,3 +78,82 @@ test_that("as_servers() errors informatively for unnamed or misnamed input", { cnd_class = TRUE ) }) + +test_that("as_servers() errors informatively for bad classes", { + expect_snapshot( + as_servers(1:2), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_servers(mean), + error = TRUE, + cnd_class = TRUE + ) + expect_snapshot( + as_servers(TRUE), + error = TRUE, + cnd_class = TRUE + ) +}) + +test_that("as_servers() returns expected objects", { + expect_identical( + as_servers( + list( + list( + url = "https://example.com", + description = "The only server." + ) + ) + ), + servers( + url = "https://example.com", + description = "The only server." + ) + ) + expect_identical( + as_server_variables( + list( + list( + username = c(default = "demo", description = "Name of the user.") + ), + list( + username = c( + default = "demo", + description = "Name of the user.", + x = "https://jonthegeek.com" + ), + port = list( + default = "8443", + enum = c("8443", "443") + ) + ) + ) + ), + server_variables( + string_replacements( + name = "username", + default = "demo", + description = "Name of the user." + ), + string_replacements( + name = c("username", "port"), + default = c("demo", 8443), + description = c("Name of the user.", NA), + enum = list(NULL, c(8443, 443)) + ) + ) + ) + expect_identical( + as_server_variables(list()), + server_variables() + ) +}) + +test_that("as_servers() works for servers", { + expect_identical( + as_servers(servers()), + servers() + ) +}) From 73869b897591a068d9ea11c8b3c7ef78250ff26b Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 14:16:30 -0500 Subject: [PATCH 15/19] Clean docs. --- R/info-01-contact.R | 9 ++-- R/info-01-license.R | 9 ++-- R/info-zz-info.R | 27 ++++++++-- R/servers-02-server_variables.R | 17 ++++++ R/servers-zz-servers.R | 28 ++++++++-- R/zz-rapid.R | 7 ++- man/as_info.Rd | 6 +-- man/as_server_variables.Rd | 17 ++++++ man/as_servers.Rd | 17 +++++- man/contact.Rd | 9 ++-- man/info.Rd | 3 ++ man/license.Rd | 9 ++-- man/rapid.Rd | 4 +- man/servers.Rd | 9 ++-- tests/testthat/_snaps/servers-zz-servers.md | 17 +----- tests/testthat/test-servers-zz-servers.R | 59 ++++++++++----------- 16 files changed, 168 insertions(+), 79 deletions(-) diff --git a/R/info-01-contact.R b/R/info-01-contact.R index 77200d6..bedd5df 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -2,9 +2,12 @@ #' #' Validate the contact information for an API. #' -#' @param name The identifying name of the contact person/organization. -#' @param url The URL pointing to the contact information. -#' @param email The email address of the contact person/organization. This +#' @param name Character scalar (optional). The identifying name of the contact +#' person/organization. +#' @param url Character scalar (optional). The URL pointing to the contact +#' information. +#' @param email Character scalar (optional). The email address of the contact +#' person/organization. This #' *must* be in the form of an email address. #' #' @return A `contact` S7 object, with fields `name`, `email`, and `url`. diff --git a/R/info-01-license.R b/R/info-01-license.R index ba754ea..586a6ec 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -3,13 +3,14 @@ #' Validate the license information for an API. #' #' @inheritParams rlang::args_dots_empty -#' @param name The license name used for the API. -#' @param identifier An +#' @param name Character scalar (optional). The license name used for the API. +#' @param identifier Character scalar (optional). An #' [SPDX](https://spdx.org/spdx-specification-21-web-version#h.jxpfx0ykyb60) #' license expression for the API. The `identifier` field is mutually #' exclusive of the `url` field. -#' @param url A URL to the license used for the API. This *must* be in the form -#' of a URL. The `url` field is mutually exclusive of the `identifier` field. +#' @param url Character scalar (optional). A URL to the license used for the +#' API. This *must* be in the form of a URL. The `url` field is mutually +#' exclusive of the `identifier` field. #' #' @return A `license` S7 object, with fields `name`, `identifier`, and `url`. #' @export diff --git a/R/info-zz-info.R b/R/info-zz-info.R index ba3a797..8cf19aa 100644 --- a/R/info-zz-info.R +++ b/R/info-zz-info.R @@ -4,6 +4,7 @@ #' clients if needed, and *may* be presented in editing or documentation #' generation tools for convenience. #' +#' @inheritParams rlang::args_dots_empty #' @param title The title of the API. Required when the object is not empty. #' @param version The version of the API document (which is distinct from the #' OpenAPI Specification version or the API implementation version). Required @@ -42,6 +43,26 @@ info <- S7::new_class( summary = character_scalar_property("summary"), terms_of_service = character_scalar_property("terms_of_service") ), + constructor = function(title = class_missing, + version = class_missing, + ..., + contact = class_missing, + description = class_missing, + license = class_missing, + summary = class_missing, + terms_of_service = class_missing) { + check_dots_empty() + S7::new_object( + NULL, + title = title, + version = version, + contact = contact, + description = description, + license = license, + summary = summary, + terms_of_service = terms_of_service + ) + }, validator = function(self) { validate_lengths( self, @@ -65,14 +86,14 @@ info <- S7::new_class( #' Coerce lists and character vectors to info objects #' -#' `as_info()` turns an existing object into an `info`. This is in contrast with -#' [info()], which builds an `info` from individual properties. +#' `as_info()` turns an existing object into an `info` object. This is in +#' contrast with [info()], which builds an `info` from individual properties. #' #' @param x The object to coerce. Must be empty or have names "title", #' "version", "contact", "description", "license", "summary", and/or #' "terms_of_service". Extra names are ignored. #' -#' @return An `info` as returned by [info()]. +#' @return An `info` object as returned by [info()]. #' @export #' #' @examples diff --git a/R/servers-02-server_variables.R b/R/servers-02-server_variables.R index 59bb91c..1260013 100644 --- a/R/servers-02-server_variables.R +++ b/R/servers-02-server_variables.R @@ -55,6 +55,23 @@ server_variables <- S7::new_class( #' #' @examples #' as_server_variables() +#' as_server_variables( +#' list( +#' list( +#' username = c(default = "demo", description = "Name of the user.") +#' ), +#' list( +#' username = c( +#' default = "demo", +#' description = "Name of the user." +#' ), +#' port = list( +#' default = "8443", +#' enum = c("8443", "443") +#' ) +#' ) +#' ) +#' ) as_server_variables <- S7::new_generic("as_server_variables", dispatch_args = "x") S7::method(as_server_variables, server_variables) <- function(x) { diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index bfa0a76..4ca2139 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -2,9 +2,12 @@ #' #' Connectivity information for an API. #' -#' @param url A character vector of urls. -#' @param description A character vector of (usually brief) descriptions of -#' those urls. +#' @param url Character vector (required). The urls of the target hosts. These +#' urls support [string_replacements()]. Variable substitutions will be made +#' when a variable is named in \{brackets\}. +#' @param description Character vector (optional). Strings describing the hosts +#' designated by `url`. [CommonMark syntax](https://spec.commonmark.org/) +#' *may* be used for rich text representation. #' @param variables A [server_variables()] object. #' #' @return A `servers` S7 object, with properties `url`, `description`, and @@ -77,14 +80,29 @@ servers <- S7::new_class( #' #' @examples #' as_servers() -#' as_servers(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +#' as_servers( +#' list( +#' list( +#' url = "https://development.gigantic-server.com/v1", +#' description = "Development server" +#' ), +#' list( +#' url = "https://staging.gigantic-server.com/v1", +#' description = "Staging server" +#' ), +#' list( +#' url = "https://api.gigantic-server.com/v1", +#' description = "Production server" +#' ) +#' ) +#' ) as_servers <- S7::new_generic("as_servers", dispatch_args = "x") S7::method(as_servers, servers) <- function(x) { x } -S7::method(as_servers, class_list | class_character) <- function(x) { +S7::method(as_servers, class_list) <- function(x) { call <- rlang::caller_env() x <- purrr::map( x, diff --git a/R/zz-rapid.R b/R/zz-rapid.R index 69b8e85..eb452f4 100644 --- a/R/zz-rapid.R +++ b/R/zz-rapid.R @@ -1,9 +1,8 @@ -# TODO: Implement as_*. - #' R API definition object #' #' An object that represents an API. #' +#' @inheritParams rlang::args_dots_empty #' @param info An `info` object defined by [info()]. #' @param servers A `servers` object defined by [servers()]. #' @@ -40,6 +39,10 @@ rapid <- S7::new_class( info = info, servers = servers ), + constructor = function(info = class_missing, ..., servers = class_missing) { + check_dots_empty() + S7::new_object(NULL, info = info, servers = servers) + }, validator = function(self) { validate_lengths( self, diff --git a/man/as_info.Rd b/man/as_info.Rd index 44ba70c..6f2b1cb 100644 --- a/man/as_info.Rd +++ b/man/as_info.Rd @@ -12,11 +12,11 @@ as_info(x, ...) "terms_of_service". Extra names are ignored.} } \value{ -An \code{info} as returned by \code{\link[=info]{info()}}. +An \code{info} object as returned by \code{\link[=info]{info()}}. } \description{ -\code{as_info()} turns an existing object into an \code{info}. This is in contrast with -\code{\link[=info]{info()}}, which builds an \code{info} from individual properties. +\code{as_info()} turns an existing object into an \code{info} object. This is in +contrast with \code{\link[=info]{info()}}, which builds an \code{info} from individual properties. } \examples{ as_info() diff --git a/man/as_server_variables.Rd b/man/as_server_variables.Rd index 56fa808..3e14a68 100644 --- a/man/as_server_variables.Rd +++ b/man/as_server_variables.Rd @@ -20,4 +20,21 @@ object. This is in contrast with \code{\link[=server_variables]{server_variables } \examples{ as_server_variables() +as_server_variables( + list( + list( + username = c(default = "demo", description = "Name of the user.") + ), + list( + username = c( + default = "demo", + description = "Name of the user." + ), + port = list( + default = "8443", + enum = c("8443", "443") + ) + ) + ) +) } diff --git a/man/as_servers.Rd b/man/as_servers.Rd index 48f8e61..bf2b065 100644 --- a/man/as_servers.Rd +++ b/man/as_servers.Rd @@ -20,5 +20,20 @@ properties. } \examples{ as_servers() -as_servers(list(name = "Jon Harmon", email = "jonthegeek@gmail.com")) +as_servers( + list( + list( + url = "https://development.gigantic-server.com/v1", + description = "Development server" + ), + list( + url = "https://staging.gigantic-server.com/v1", + description = "Staging server" + ), + list( + url = "https://api.gigantic-server.com/v1", + description = "Production server" + ) + ) +) } diff --git a/man/contact.Rd b/man/contact.Rd index ce4b810..12473b2 100644 --- a/man/contact.Rd +++ b/man/contact.Rd @@ -7,12 +7,15 @@ contact(name = class_missing, email = class_missing, url = class_missing) } \arguments{ -\item{name}{The identifying name of the contact person/organization.} +\item{name}{Character scalar (optional). The identifying name of the contact +person/organization.} -\item{email}{The email address of the contact person/organization. This +\item{email}{Character scalar (optional). The email address of the contact +person/organization. This \emph{must} be in the form of an email address.} -\item{url}{The URL pointing to the contact information.} +\item{url}{Character scalar (optional). The URL pointing to the contact +information.} } \value{ A \code{contact} S7 object, with fields \code{name}, \code{email}, and \code{url}. diff --git a/man/info.Rd b/man/info.Rd index ee4160d..03425ad 100644 --- a/man/info.Rd +++ b/man/info.Rd @@ -7,6 +7,7 @@ info( title = class_missing, version = class_missing, + ..., contact = class_missing, description = class_missing, license = class_missing, @@ -21,6 +22,8 @@ info( OpenAPI Specification version or the API implementation version). Required when the object is not empty.} +\item{...}{These dots are for future extensions and must be empty.} + \item{contact}{The contact information for the exposed API, generated via \code{\link[=contact]{contact()}}.} diff --git a/man/license.Rd b/man/license.Rd index 25539df..98b65b4 100644 --- a/man/license.Rd +++ b/man/license.Rd @@ -7,17 +7,18 @@ license(name = character(), ..., identifier = character(), url = character()) } \arguments{ -\item{name}{The license name used for the API.} +\item{name}{Character scalar (optional). The license name used for the API.} \item{...}{These dots are for future extensions and must be empty.} -\item{identifier}{An +\item{identifier}{Character scalar (optional). An \href{https://spdx.org/spdx-specification-21-web-version#h.jxpfx0ykyb60}{SPDX} license expression for the API. The \code{identifier} field is mutually exclusive of the \code{url} field.} -\item{url}{A URL to the license used for the API. This \emph{must} be in the form -of a URL. The \code{url} field is mutually exclusive of the \code{identifier} field.} +\item{url}{Character scalar (optional). A URL to the license used for the +API. This \emph{must} be in the form of a URL. The \code{url} field is mutually +exclusive of the \code{identifier} field.} } \value{ A \code{license} S7 object, with fields \code{name}, \code{identifier}, and \code{url}. diff --git a/man/rapid.Rd b/man/rapid.Rd index cd70341..84cf876 100644 --- a/man/rapid.Rd +++ b/man/rapid.Rd @@ -4,11 +4,13 @@ \alias{rapid} \title{R API definition object} \usage{ -rapid(info = class_missing, servers = class_missing) +rapid(info = class_missing, ..., servers = class_missing) } \arguments{ \item{info}{An \code{info} object defined by \code{\link[=info]{info()}}.} +\item{...}{These dots are for future extensions and must be empty.} + \item{servers}{A \code{servers} object defined by \code{\link[=servers]{servers()}}.} } \value{ diff --git a/man/servers.Rd b/man/servers.Rd index bef9e68..9a09657 100644 --- a/man/servers.Rd +++ b/man/servers.Rd @@ -11,10 +11,13 @@ servers( ) } \arguments{ -\item{url}{A character vector of urls.} +\item{url}{Character vector (required). The urls of the target hosts. These +urls support \code{\link[=string_replacements]{string_replacements()}}. Variable substitutions will be made +when a variable is named in \{brackets\}.} -\item{description}{A character vector of (usually brief) descriptions of -those urls.} +\item{description}{Character vector (optional). Strings describing the hosts +designated by \code{url}. \href{https://spec.commonmark.org/}{CommonMark syntax} +\emph{may} be used for rich text representation.} \item{variables}{A \code{\link[=server_variables]{server_variables()}} object.} } diff --git a/tests/testthat/_snaps/servers-zz-servers.md b/tests/testthat/_snaps/servers-zz-servers.md index c1a83bf..cc56483 100644 --- a/tests/testthat/_snaps/servers-zz-servers.md +++ b/tests/testthat/_snaps/servers-zz-servers.md @@ -12,7 +12,7 @@ # as_servers() errors informatively for unnamed or misnamed input Code - as_servers(letters) + as_servers(list(letters)) Condition Error in `purrr::map()`: i In index: 1. @@ -23,23 +23,10 @@ --- Code - as_servers(list(a = "https://example.com", b = "A cool server.")) + as_servers(list(list(a = "https://example.com", b = "A cool server."))) Condition Error in `purrr::map()`: i In index: 1. - i With name: a. - Caused by error in `as_servers()`: - ! `x[[i]]` must have names "url", "description", or "variables". - * Any other names are ignored. - ---- - - Code - as_servers(c(a = "https://example.com", b = "A cool server.")) - Condition - Error in `purrr::map()`: - i In index: 1. - i With name: a. Caused by error in `as_servers()`: ! `x[[i]]` must have names "url", "description", or "variables". * Any other names are ignored. diff --git a/tests/testthat/test-servers-zz-servers.R b/tests/testthat/test-servers-zz-servers.R index 89c3a9e..cddde5f 100644 --- a/tests/testthat/test-servers-zz-servers.R +++ b/tests/testthat/test-servers-zz-servers.R @@ -63,17 +63,12 @@ test_that("length() of a servers reports the overall length", { test_that("as_servers() errors informatively for unnamed or misnamed input", { expect_snapshot( - as_servers(letters), + as_servers(list(letters)), error = TRUE, cnd_class = TRUE ) expect_snapshot( - as_servers(list(a = "https://example.com", b = "A cool server.")), - error = TRUE, - cnd_class = TRUE - ) - expect_snapshot( - as_servers(c(a = "https://example.com", b = "A cool server.")), + as_servers(list(list(a = "https://example.com", b = "A cool server."))), error = TRUE, cnd_class = TRUE ) @@ -113,41 +108,41 @@ test_that("as_servers() returns expected objects", { ) ) expect_identical( - as_server_variables( + as_servers( list( list( - username = c(default = "demo", description = "Name of the user.") - ), - list( - username = c( - default = "demo", - description = "Name of the user.", - x = "https://jonthegeek.com" - ), - port = list( - default = "8443", - enum = c("8443", "443") + url = "https://{username}.gigantic-server.com:{port}/{basePath}", + description = "The production API server", + variables = list( + username = list( + default = "demo", + description = "this value is assigned by the service provider, in this example `gigantic-server.com`" + ), + port = list(enum = c("8443", "443"), default = "8443"), + basePath = list(default = "v2") ) ) ) ), - server_variables( - string_replacements( - name = "username", - default = "demo", - description = "Name of the user." - ), - string_replacements( - name = c("username", "port"), - default = c("demo", 8443), - description = c("Name of the user.", NA), - enum = list(NULL, c(8443, 443)) + servers( + url = "https://{username}.gigantic-server.com:{port}/{basePath}", + description = "The production API server", + variables = server_variables( + string_replacements( + name = c("username", "port", "basePath"), + description = c( + "this value is assigned by the service provider, in this example `gigantic-server.com`", + NA, NA + ), + default = c("demo", "8443", "v2"), + enum = list(NULL, c("8443", "443"), NULL) + ) ) ) ) expect_identical( - as_server_variables(list()), - server_variables() + as_servers(list()), + servers() ) }) From ea6c43801d13415c0b52ede3faf31e88d1d7a3fa Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 15:04:23 -0500 Subject: [PATCH 16/19] Implement as_rapid(). --- DESCRIPTION | 1 + NAMESPACE | 1 + R/00-properties.R | 2 + R/as.R | 24 ++- R/info-01-contact.R | 5 +- R/info-01-license.R | 5 +- R/info-zz-info.R | 5 +- R/servers-01-string_replacements.R | 5 +- R/servers-02-server_variables.R | 5 +- R/servers-zz-servers.R | 13 +- R/utils.R | 2 +- R/zz-rapid.R | 44 +++++ man/as_rapid.Rd | 23 +++ man/as_servers.Rd | 6 +- tests/testthat/_snaps/zz-rapid.md | 117 ++++++++++++ tests/testthat/fixtures/apid_list_awsmh.rds | Bin 10941 -> 0 bytes tests/testthat/fixtures/apid_list_guru.rds | Bin 3289 -> 0 bytes tests/testthat/test-info-01-license.R | 4 +- tests/testthat/test-zz-rapid.R | 187 ++++++++++++++------ 19 files changed, 356 insertions(+), 93 deletions(-) create mode 100644 man/as_rapid.Rd delete mode 100644 tests/testthat/fixtures/apid_list_awsmh.rds delete mode 100644 tests/testthat/fixtures/apid_list_guru.rds diff --git a/DESCRIPTION b/DESCRIPTION index 43ee8af..29581b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,6 +21,7 @@ Imports: purrr, rlang (>= 1.1.0), S7, + snakecase, stbl, yaml Suggests: diff --git a/NAMESPACE b/NAMESPACE index cc67a41..77db63d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ S3method(length,"rapid::string_replacements") export(as_contact) export(as_info) export(as_license) +export(as_rapid) export(as_server_variables) export(as_servers) export(as_string_replacements) diff --git a/R/00-properties.R b/R/00-properties.R index 0d41713..a7099c8 100644 --- a/R/00-properties.R +++ b/R/00-properties.R @@ -47,3 +47,5 @@ enum_property <- function(x_arg) { } ) } + +class_null <- S7::new_S3_class("NULL") diff --git a/R/as.R b/R/as.R index 247ba32..785dcff 100644 --- a/R/as.R +++ b/R/as.R @@ -7,14 +7,20 @@ } valid_names <- S7::prop_names(target_S7_class()) - if (!rlang::is_named(x) || !any(names(x) %in% valid_names)) { - cli::cli_abort( - c( - "{.arg {x_arg}} must have names {.or {.val {valid_names}}}.", - "*" = "Any other names are ignored." - ), - call = call - ) + + if (rlang::is_named2(x)) { + force(x_arg) + x <- rlang::set_names(x, snakecase::to_snake_case) + if (any(names(x) %in% valid_names)) { + return(as.list(x)[names(x) %in% valid_names]) + } } - return(as.list(x)[names(x) %in% valid_names]) + + cli::cli_abort( + c( + "{.arg {x_arg}} must have names {.or {.val {valid_names}}}.", + "*" = "Any other names are ignored." + ), + call = call + ) } diff --git a/R/info-01-contact.R b/R/info-01-contact.R index bedd5df..42ce9cb 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -63,14 +63,11 @@ S7::method(as_contact, class_list | class_character) <- function(x) { contact(name = x[["name"]], email = x[["email"]], url = x[["url"]]) } -S7::method(as_contact, class_missing) <- function(x) { +S7::method(as_contact, class_missing | class_null) <- function(x) { contact() } S7::method(as_contact, class_any) <- function(x) { - if (is.null(x)) { - return(contact()) - } cli::cli_abort( "Can't coerce {.arg x} {.cls {class(x)}} to {.cls contact}." ) diff --git a/R/info-01-license.R b/R/info-01-license.R index 586a6ec..a1bbd93 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -77,14 +77,11 @@ S7::method(as_license, class_list | class_character) <- function(x) { license(name = x[["name"]], identifier = x[["identifier"]], url = x[["url"]]) } -S7::method(as_license, class_missing) <- function(x) { +S7::method(as_license, class_missing | class_null) <- function(x) { license() } S7::method(as_license, class_any) <- function(x) { - if (is.null(x)) { - return(license()) - } cli::cli_abort( "Can't coerce {.arg x} {.cls {class(x)}} to {.cls license}." ) diff --git a/R/info-zz-info.R b/R/info-zz-info.R index 8cf19aa..6717438 100644 --- a/R/info-zz-info.R +++ b/R/info-zz-info.R @@ -119,14 +119,11 @@ S7::method(as_info, class_list | class_character) <- function(x) { ) } -S7::method(as_info, class_missing) <- function(x) { +S7::method(as_info, class_missing | class_null) <- function(x) { info() } S7::method(as_info, class_any) <- function(x) { - if (is.null(x)) { - return(info()) - } cli::cli_abort( "Can't coerce {.arg x} {.cls {class(x)}} to {.cls info}." ) diff --git a/R/servers-01-string_replacements.R b/R/servers-01-string_replacements.R index 44a86a1..8707883 100644 --- a/R/servers-01-string_replacements.R +++ b/R/servers-01-string_replacements.R @@ -117,14 +117,11 @@ S7::method(as_string_replacements, class_list) <- function(x) { ) } -S7::method(as_string_replacements, class_missing) <- function(x) { +S7::method(as_string_replacements, class_missing | class_null) <- function(x) { string_replacements() } S7::method(as_string_replacements, class_any) <- function(x) { - if (is.null(x)) { - return(string_replacements()) - } cli::cli_abort( "Can't coerce {.arg x} {.cls {class(x)}} to {.cls string_replacements}." ) diff --git a/R/servers-02-server_variables.R b/R/servers-02-server_variables.R index 1260013..4e7eebd 100644 --- a/R/servers-02-server_variables.R +++ b/R/servers-02-server_variables.R @@ -87,14 +87,11 @@ S7::method(as_server_variables, class_list) <- function(x) { ) } -S7::method(as_server_variables, class_missing) <- function(x) { +S7::method(as_server_variables, class_missing | class_null) <- function(x) { server_variables() } S7::method(as_server_variables, class_any) <- function(x) { - if (is.null(x)) { - return(server_variables()) - } cli::cli_abort( "Can't coerce {.arg x} {.cls {class(x)}} to {.cls server_variables}." ) diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index 4ca2139..1dbcc10 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -68,14 +68,14 @@ servers <- S7::new_class( #' Coerce lists and character vectors to servers #' -#' `as_servers()` turns an existing object into a `servers`. This is in -#' contrast with [servers()], which builds a `servers` from individual +#' `as_servers()` turns an existing object into a `servers` object. This is in +#' contrast with [servers()], which builds a `servers` object from individual #' properties. #' #' @param x The object to coerce. Must be empty or have names "name", "email", #' and/or "url". Extra names are ignored. #' -#' @return A `servers` as returned by [servers()]. +#' @return A `servers` object as returned by [servers()]. #' @export #' #' @examples @@ -118,19 +118,16 @@ S7::method(as_servers, class_list) <- function(x) { servers( url = purrr::map_chr(x, "url"), - description = purrr::map_chr(x, "description"), + description = .extract_along_chr(x, "description"), variables = as_server_variables(purrr::map(x, "variables")) ) } -S7::method(as_servers, class_missing) <- function(x) { +S7::method(as_servers, class_missing | class_null) <- function(x) { servers() } S7::method(as_servers, class_any) <- function(x) { - if (is.null(x)) { - return(servers()) - } cli::cli_abort( "Can't coerce {.arg x} {.cls {class(x)}} to {.cls servers}." ) diff --git a/R/utils.R b/R/utils.R index 85f2ed1..1bbe5ae 100644 --- a/R/utils.R +++ b/R/utils.R @@ -17,7 +17,7 @@ .extract_along_chr <- function(x, el) { y <- purrr::map(x, el) if (purrr::every(y, is.null)) { - return(NULL) + return(character()) } purrr::map_chr( y, diff --git a/R/zz-rapid.R b/R/zz-rapid.R index eb452f4..7936861 100644 --- a/R/zz-rapid.R +++ b/R/zz-rapid.R @@ -56,3 +56,47 @@ rapid <- S7::new_class( `length.rapid::rapid` <- function(x) { length(x@info) } + +#' Coerce lists and urls to rapid objects +#' +#' `as_rapid()` turns an existing object into a `rapid` object. This is in +#' contrast with [rapid()], which builds a `rapid` object from individual +#' properties. +#' +#' @param x The object to coerce. Must be empty or have names "info" and/or +#' "servers". Extra names are ignored. +#' +#' @return A `rapid` object as returned by [rapid()]. +#' @export +#' +#' @examples +#' as_rapid() +as_rapid <- S7::new_generic("as_rapid", dispatch_args = "x") + +S7::method(as_rapid, rapid) <- function(x) { + x +} + +S7::method(as_rapid, class_list) <- function(x) { + x <- .validate_for_as_class(x, rapid) + + rapid( + info = as_info(x[["info"]]), + servers = as_servers(x[["servers"]]) + ) +} + +S7::method(as_rapid, S7::new_S3_class("url")) <- function(x) { + x <- yaml::read_yaml(x) + as_rapid(x) +} + +S7::method(as_rapid, class_missing | class_null) <- function(x) { + rapid() +} + +S7::method(as_rapid, class_any) <- function(x) { + cli::cli_abort( + "Can't coerce {.arg x} {.cls {class(x)}} to {.cls rapid}." + ) +} diff --git a/man/as_rapid.Rd b/man/as_rapid.Rd new file mode 100644 index 0000000..94e2be1 --- /dev/null +++ b/man/as_rapid.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/zz-rapid.R +\name{as_rapid} +\alias{as_rapid} +\title{Coerce lists and urls to rapid objects} +\usage{ +as_rapid(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Must be empty or have names "info" and/or +"servers". Extra names are ignored.} +} +\value{ +A \code{rapid} object as returned by \code{\link[=rapid]{rapid()}}. +} +\description{ +\code{as_rapid()} turns an existing object into a \code{rapid} object. This is in +contrast with \code{\link[=rapid]{rapid()}}, which builds a \code{rapid} object from individual +properties. +} +\examples{ +as_rapid() +} diff --git a/man/as_servers.Rd b/man/as_servers.Rd index bf2b065..242841f 100644 --- a/man/as_servers.Rd +++ b/man/as_servers.Rd @@ -11,11 +11,11 @@ as_servers(x, ...) and/or "url". Extra names are ignored.} } \value{ -A \code{servers} as returned by \code{\link[=servers]{servers()}}. +A \code{servers} object as returned by \code{\link[=servers]{servers()}}. } \description{ -\code{as_servers()} turns an existing object into a \code{servers}. This is in -contrast with \code{\link[=servers]{servers()}}, which builds a \code{servers} from individual +\code{as_servers()} turns an existing object into a \code{servers} object. This is in +contrast with \code{\link[=servers]{servers()}}, which builds a \code{servers} object from individual properties. } \examples{ diff --git a/tests/testthat/_snaps/zz-rapid.md b/tests/testthat/_snaps/zz-rapid.md index b5f64d9..4f6cb5e 100644 --- a/tests/testthat/_snaps/zz-rapid.md +++ b/tests/testthat/_snaps/zz-rapid.md @@ -46,3 +46,120 @@ .. @ description: chr(0) .. @ variables : list() +# as_rapid() errors informatively for bad classes + + Code + as_rapid(1:2) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_rapid(mean) + Condition + Error: + ! Can't coerce `x` to . + +--- + + Code + as_rapid(TRUE) + Condition + Error: + ! Can't coerce `x` to . + +# as_rapid() errors informatively for unnamed or misnamed input + + Code + as_rapid(list(letters)) + Condition + Error: + ! `x` must have names "info" or "servers". + * Any other names are ignored. + +--- + + Code + as_rapid(list(list(a = "https://example.com", b = "A cool server."))) + Condition + Error: + ! `x` must have names "info" or "servers". + * Any other names are ignored. + +# as_rapid() works for urls + + Code + as_rapid(url("https://api.apis.guru/v2/openapi.yaml")) + Output + + @ info : + .. @ title : chr "APIs.guru" + .. @ version : chr "2.2.0" + .. @ contact : + .. .. @ name : chr "APIs.guru" + .. .. @ email: chr "mike.ralphson@gmail.com" + .. .. @ url : chr "https://APIs.guru" + .. @ description : chr "Wikipedia for Web APIs. Repository of API definitions in OpenAPI format.\n**Warning**: If you want to be notifi"| __truncated__ + .. @ license : + .. .. @ name : chr "CC0 1.0" + .. .. @ identifier: chr(0) + .. .. @ url : chr "https://github.com/APIs-guru/openapi-directory#licenses" + .. @ summary : chr(0) + .. @ terms_of_service: chr(0) + @ servers: + .. @ url : chr "https://api.apis.guru/v2" + .. @ description: chr(0) + .. @ variables : list() + +--- + + Code + as_rapid(url( + "https://api.apis.guru/v2/specs/amazonaws.com/AWSMigrationHub/2017-05-31/openapi.yaml")) + Output + + @ info : + .. @ title : chr "AWS Migration Hub" + .. @ version : chr "2017-05-31" + .. @ contact : + .. .. @ name : chr "Mike Ralphson" + .. .. @ email: chr "mike.ralphson@gmail.com" + .. .. @ url : chr "https://github.com/mermade/aws2openapi" + .. @ description : chr "

The AWS Migration Hub API methods help to obtain server and application migration status and integrate your "| __truncated__ + .. @ license : + .. .. @ name : chr "Apache 2.0 License" + .. .. @ identifier: chr(0) + .. .. @ url : chr "http://www.apache.org/licenses/" + .. @ summary : chr(0) + .. @ terms_of_service: chr "https://aws.amazon.com/service-terms/" + @ servers: + .. @ url : chr [1:4] "http://mgh.{region}.amazonaws.com" ... + .. @ description: chr [1:4] "The AWS Migration Hub multi-region endpoint" ... + .. @ variables : List of 4 + .. .. $ : + .. .. ..@ name : chr "region" + .. .. ..@ default : chr "us-east-1" + .. .. ..@ enum :List of 1 + .. .. .. .. $ : chr [1:23] "us-east-1" "us-east-2" "us-west-1" "us-west-2" ... + .. .. ..@ description: chr "The AWS region" + .. .. $ : + .. .. ..@ name : chr "region" + .. .. ..@ default : chr "us-east-1" + .. .. ..@ enum :List of 1 + .. .. .. .. $ : chr [1:23] "us-east-1" "us-east-2" "us-west-1" "us-west-2" ... + .. .. ..@ description: chr "The AWS region" + .. .. $ : + .. .. ..@ name : chr "region" + .. .. ..@ default : chr "cn-north-1" + .. .. ..@ enum :List of 1 + .. .. .. .. $ : chr [1:2] "cn-north-1" "cn-northwest-1" + .. .. ..@ description: chr "The AWS region" + .. .. $ : + .. .. ..@ name : chr "region" + .. .. ..@ default : chr "cn-north-1" + .. .. ..@ enum :List of 1 + .. .. .. .. $ : chr [1:2] "cn-north-1" "cn-northwest-1" + .. .. ..@ description: chr "The AWS region" + diff --git a/tests/testthat/fixtures/apid_list_awsmh.rds b/tests/testthat/fixtures/apid_list_awsmh.rds deleted file mode 100644 index 94bf3c37e2cdf25566a3632defc048e4b38aef80..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10941 zcmV;uDnivCiwFP!000002JL-YcN<5x9(9-K``DiGWzM)P-y|Csin>^)Y5Bk;HD-=T zaY)*p6<@dtjRMf4MmJ7(gCy+nOY)GXWMw5QFK3|Ise z=&r7AfB->(RM|@sy1TBscJ12xt6jVPJU=%#cVX`0g>!QkF2T>aOW*81EZ?7-JO3&? zT!lX`!=H0=7w4|w$J>>K%7Xm(qVjQmapBgd<%PTD+qaZ2=lAa@Z(gZ=w?j7UmQO?5 zbII4edOE?m|GeCNu-j%NlaAE3)=7tjZLblKHgmcp^oUmvsqK=0`TNW#)NK&j?K-w4 za&_YTK}f@1z!TVR$nZ5IeXr*ep9S!b#mYgKS$5O561hUpb4a~Uy1ut>H*B{>DE@}e zoere1cv*gvS`6EgYHek?+I>KvFWaocI(2AV*rp*?NjkkCgcgUQ{%k+nUWY-mTKHUN zP0!~oB^GrY=s=%%O(=^63<(mHhzI>9%a+$*559(++dSi@7w)id?a*RfEO)uezZ2&B zko>@glImDT*z;Z1sF0cyc%?z(I`j#{IylL(-hdpmZHGaBMWYi<dE~RxN6^S=I4cUX`cW3lHoNXj!qm&K^AoEXV6L_JGz+sCLip z&=#w7-Ih}RmG>U<|K{c{o=-BXOFJx(Y0t}-7ka)Uf4)?w){~a+_1wma=XgH6`oBua zAH*#`2r9Hge};}i)2hg5HZTh`wG&ijw=XK0U)ZpLe%sXPwgb;qKK`x)A1l86__wVN zwH+*4N%mpXfR-J$ft|4O4pd4T4BNEmb(sqkRdPMQ1xb*QjUCStR5|zmWSWaI%|)b6 zL@9>VXDM{;uq+2e&_+ADzo~U`6v<*`fjk1DxB*jAyn~&9J{%kz!0=<@is!egj!2C3 zOSSO4riHvw+3|Tnj0uiTmUb_}oQkKEkT9?E&-&qdIUzEtf60!R6%BIi>E$ zQK!3}9|C=pDcI_AayQsMbD;lz73EM63JOB6~U&bq`! z5B!*yO*^OLe^I4gJY{_5FdD>jE3`u=dU&qE0?W6#FqW?_AC^)6$)^{&M0woY5dtQv z1IbLG3-VFUoG8y>S*%RV-yF=C7Y@r(N+n)iJuG{^-Lj*~f5!)8#j#-ww-fY}pI=Xm z7fcM+g3KUMWnZvb)`Yc$H44PTyEQ&$L{?|8}4}yDSw$<~F(>sGm8_ zOA6zC>f5yL4CZgL>4W*J^7i#;I-1#GW`~&_N-N$Ux^z@5cdYplEo<|Zt8nLw(HqI4 ziWQznfAXX9P(LcsKoBrv$x7RHDY@|#v;P9N^i6J!%Xgdb;?Slyr#E093>Rl+#GclO zC6#SX_*Vu>CI9!5()c%OLEu?7sHQ7EgTEU!KeU^uDW}q%|L@D)2XWGXP-2PXgv#`Y zrcjsDfh+zo9#rB0NJ#w_3*n{3?0p1)@MR1Tl?WKg?esgy5FYI4oK@!9tPw+_Bhu<)J+1U5o>~&Uy4&`>Fmyl=9hE>g zv;@+YcY4XQ?g~_FhwnG6A(}oBd9>x7TJpRtVV-YXx=(Efm;9r0(Snvth2@@Fa=oUMBHI7Ogy_n7^@$`~t-QA~--B@?Kz3_Ne zvYZl6Es5TYG|Ejce26=JM)_k@ighsPn&j@@!;*z?C7flr1P&l+Fz`5YWkX2sL7>jhyR za~HynZ^sjV)ebBVY&O=2R01XGk15!(5howuMC+@h>3bbgOL(kB#rC5u^BnL^w(q&) z0fO!oFBsXr8Z5|QK?MXdSdhVj3>IXtpoz(1upom4O-`cMwmhhy&qeA{DRfgyA$@_T zmOut9Gho^Afo0E~FjyA<{7f0QqvB?t9^DKw(Af~^?2}yROlLtG^vs}V20c5g=-FEW zE#JZulq?9o={DeLCxn;E39fU#NEt-uEg?1O@#G}n>7{EJ`l-2T@2g(G8r%hpay*7R zj`^NLXh05_!~dn+CoSmWxlK%|`0nwK;pOdzCz(7)#FjvEa zB(4_{mx;F2nXFVezR}2+PqYj^TNJ916@tj^ifobFTGRtMX4j4fQM{{NO7q9x0Ez}s zEFh2p6b+zg07U~RPD~a9C>lU1LSu6L1+YS5k`XwSzg+EZll z8L-EIJqGMKvtZ9EbJ!?g&&B_}+qmvI71qLEDeT%hOmazdm+A5Pf7;bZmc(x^@sEc0(EwWNgPZxvB7b&j@@d9kP>?m zw7mo1CxT~2B`qJ>L8zl-kR+w938RihNhVzHU>Ku#QQQT}C@DbMvzz@?ik%ROi<3ok zj<-&}|M*89{0&IyaH>f>kCPn;;dpL~^Q@O77a!CR2K0bj*J|X~iJhXaJlx9JkaHx$ zp)P+HF$yH9GptIIUPrOVt~DClP(Lw*qq01o#OgwCi@%Iu9R?bLc-Ja8s#owIr@m)Q}nlEY$#%eIu0sKA-#AGoTtHD?&Cz0_!$h1MG4KjUJ zk?A*9`3$PF#KBt*xT)jtM-~Q(`<}ckV7MZAH`F4u|EDT^_0E@EN)+=Hq7=2lBo(hHccyMM5N8iDo> z!bT!Pf*weKD5HpxZf+l(`t5_;t2>Do)4zQ%$H_6Dg$y)gprHZ+8ED8rLk1c$=a(iX zi#fk!K*h;PWI#m&DjpxGc)HFn=>w@3s`dtO90E9I0;v~54+eHLu%m$;&noQrhveKJ zdK2NFS5qjPJLJMa-BpEp4DNXGpwEUb8s;8C0|^;ONF|SfgbXBfY~(VKkb#5@BxE3= zr%oyZ37suSXlX3%-k?H5P@zf@Dr9ch(=eg|h6;)|z|iRihF;Y~n@%S=_tA3q0WN_7 z7KvBku>;k)OgKLItP7J5dx_`7xG`8F4I0uq4WxrmNd|uw`9&ORbVkznq)BHY^wN^P zXSRs;&bZ_V?2rfXMu#%)h8Fvj4T+A;i=t|n9_|Ily}p{Z4}bfz!)h|#TXe9C%O@yA zv8~4oZt2w#&1e}!%OF|>1Tu)0L9`5_We}~2$zl*KgJ?}oB7=)Yj1fJDa*)xgXw;OFo9pgkm`GY1v2 z-o&?fa#7sU#V0CtB*>JgcD)fFRg9Zo5*Pdx)ChVnl$@+GzFbUPw#OP3+3zbklJQt# zDrsqGFeQU26%fc^N(NIhn36#TjJbQV=I)i_HFqboX7$m5a@2`aWzSy7(KqKe=%LVz zR3-Bg^w00-5Gpoc^}XlTsHi;Er!CsDU7>oHz3J?Bh!Gaj1iSuJgF@w)GzQ2pK!yP_&MJ`c8qRt({82j1x&O4>eITF=U7(%- zgEmu`yxgOPl9s*CT-9&IcJVA%k6&CTZyX;lvQvD`RTMQ^-=u@K?IiIJs3@dQu;i{o zEv5@pwA1zuMA3s{qJrxxo|2ASl?YWWQ%a;J=g4cq9jHPyO%cS-_6n&;x?+XmfuUfK zo7f$a6aDCzLSpN84|JSk&>Mr^6cEUuHwL{i=#4>dju*W#ejNtrnuJuTT(cSxJAVr; ztAiQH%RpWR^2$P9@9QA1tnq6QFN1g)#OtggUcbXhpFM4=E;3sJgwX^T%3e)|h>w81 z1n!e^1&m^2A1@@cn5zzGx@J%rgUS>T$e=O?l`*J{L1hdoV^EpdA=RlsWo{o$4Ku)u z0cH#^lLclz(g8DC8_i%d2AeV1%vr@|euMKqg`TLsNdFMK$56-NSAjKcC*=4{y+4Qn zjg!2jI3ekA8-6_;wJcC3L(&mGLLoXPVRWDIe3VwGOM z3@c2xQ0JFaP};EmMb20n5KC8+psQMFuG3MD&(XEx0l3P!npK)V47O#ktpWlWY|CI< z2HP^&*0GZ4wJi@S=<|tjR0`eHQb=FmsU?sB|3)X30sl0lO69s1;dRptwKEwGs2>EK zwrU_i0|6QcFbe@**Fk_P6kyOlgZ>%x@2sMKZ{n2S^1T*Jo8TLMR&a+O70mI?>dK_) zbA{u;e6m5u6z%9vt}>wQoI$V*f>l5ugJ2m1%OF?=!7`}B$)XN374hiqQB?{9GZ>h` zzzkWK;ie8|$gw#L+F;NIgEpL1wBfhnvMx2^Svu9ZYdcZEp>!~1hW@3fXm52=u5b>Kaj8VWs^m-DI2QLpxK{x}* zEL@CyCMyUAMepzeWSL9Rb!Crt_jYz`+q-M4c6Q)t>~1Jn}4{Q-$Y7T|P-*??V;X%QNo{s%KC=gX*1CRPPNj z?Ng3}8eH%EmF4aOp44UmiBl609C1+bp6}xkJpsLyVs9gU=+J`{K54KJtU}_m7WEql z!BOS(+<4~)H&S87<>hQvbd8*Z?sB@B2rZ7_U(lw$xJ1su+Z@7y&lGhVvTM4dfVx0d zn=lGd@zALrLYH`*9BnkPMC_74B{}TKN$3Fytq@3o0>7Xh-3E-dDvo*)TycEQ;eCLr zpildDg8}tXG6!91F`k-HtF6Rr&pWg@e>|wBJ{&~eSQ%W?;F<*lGPtI}H4Uz5aLtLy zVsK4^Yferg1KSzc?)YH4`4fiiCd2CVCpz-=dV|&tLF;bl(K?;kZtyyT*BQL-tm1XA zZ}q}R1*nA}D(byZjm3WPKQ4C>B0`WSh@9#Ah&KrUE{GtzIQ&tMH>U?5#BHuClx-7?2vZ44l5D6i8O=mHf=u;)eK^bZPZpG?5{*1H-{Mg zlFR`^h0>LKAleTg-EtK=0@PpM8svhcylpT5d{`oxjJY`A$rC_rP(xmS%r$ab$@6-aEg*Q(aG*7vj{R%wSF=e=aE zvNl~=t}W%vCvJ^HuMzt#SLp*1&slPSL%};MrWkemKi%LzalIm62C^KKq5gsjJFw4-nE zV}l z92?}=AjhW|IZowxMW*_+`d(7De4z@1S_JJX7yHWWOQUAbqCc{P&xVvB>eab4j#$7d zb68;k!$`2oWlNo9oZm(EJ0oUK?Z%BrKA;*c9)K^7P(tn)EDkATonw)@4h-u&0)Hyq zB7uB+guI#Sq(#IsM@4x}zY6MA6|H<6J=#uQG@W8iBOOg=l+Zcz$yN7M_vEF_Du1fG^Kw?J zIMw}mO|QkA>OQ@c(V9+mcV5+MX{V)2sdBEQxlR$;S<#mxLh`0!5liQ=Mj?q4`n1;R z;WF*of5-aD+ZSpQ5|vket#}Y?IFtm#E`BR$Ecj?GLrx&JM|VeQtf@+AtV{0A9Xuy@6by zrn?qXLxYJ!f6MlRRSz8#go6zMwhKI$Is^zsg~Ji|sbNl|!d+TUm}vS9s|>r2MY4L$ zCAIC%h)FjE+q1J;DBs5Sfy1dk=n+3iL9+Gaz7jj3$4n{lcv_& z1>1XL66s$)=B)&dsC%Bns7sm-Z6RH3w}F-vOZdI?32Qd-7-i7*dJa&JJ^_|;@Cruq zjf@}1&vx4K;3|4)`TW2sFkZ(F0?wHphP`KTipud(QM=?HkI0llIU;sGQkxL;Dn5HD zv_q$O6`0enDbK{WGqT$LMuQb8NOb|UH=}Fr2P3VyXKKm)0lS=7Z$&gsxniU$nf-P4 zBmK&uVbrlm_0D5Hd(b%6A94 z^EYkMOT+nDSsK0@%^aI`5ov_RQG~|%p=^CZQs5NN^!(jbGt90UnZL{BjCFqvPOxlyXCDoj@OEZr`*C5SCrq=yF~K=#_fw; zdu;3JbCeY!59W#DoNyB0(dIQp}_C*DuHQp@+;ZVmY~lgXocu~Lv(%Wi^U76 zn--Lh@8r49q}PXYBaZgFe-KOVv#8}e0*9&zU z4$~eXrF&DGo>4hRw29M2{$A_8Hlw=Tv$&~tN)SFRhaZ_U&%FIL5orIavfrbb&esb( zN@ou%8x{;ftXJ05I+su#yDw>;w^nJwF%Dd|F`ufq0wzV>@ehI zML`*Hb52A-6nA{nIBKVin23`HArg=`C{%nN3NRpXI4&L%5lZlFwl8Ld3w4k#ZE>+J z)0fhdhR_xT!uNtG=w;l55F3YsqHpiC_YPmvGN1T%EpALf0mIk$3wcu~y}6)09zNbe zt=|St?S_rJA>PvL48j`Ydz}#!`P>b{KIr$!ox#9N!ZSJvM;eWH^x76Z6mdz%<=sUn z!S3`r#O-zJu+R?(B`wRC9x#bHEvLQKzo^W~jNFlOCE4}d!jh8c#8&jx9}dQ*3>z7N7xjyE<7yM?B#QGiaL0`zaQ3Q*b_JL9@fdANAr>2;vN z{Ry<6|ABdRrtU`p2}J2Y3)^agD6yO#bahEelnfI~$x@0gtdkR9i@~&Z!7gVM zC%od9lwVrM$bC#CPDQ%G4 z{}ylH_c|P6q+1en|UvRCH^OLVyyV1r*R~9c%Aj4|SLyxDoH#GX7)C1(chK&~_o&KF@ zjlvYsBiaButqPNN?R;k#b7dyh^w(jM8xDWGA~FXd_kv&XSJb~t2TmL~)G zH*H%sSJ8b6ZVGcsC36$a<d5>erjmM(pcU8pPR7}6NrKcZE}kT`kp2%_pSi07n=^LeP{A@uMR7sOW0u- zS6TQaV4n&Bn>L-S;lXsnN#!$(*izcO|`Sl{~g&R%VGb$e}Rhy0bm**oDluE4_tqNv7$uWj3{@i7Vq9e z(8Q+}UR^E8UX^sWd0YqThVZ-Rz+aBdM+1R;SdOoMyKy~^;Uy{oVg@Yabfm+EMvP>M z*r6B$u@DKi6IoNV8~9`34p7H-5u`3*R_YwkKChVTWBGY8F`x7-l1Yh{j}c|yv1MuCp5#Z43Fr^+w4O1JJUEd2UDJiZ`@_uSz3<-Z-FeOJ0PgxL^n z)?EV`{fN1(upPgkhw?>!3or4NeVQ9oy8g|n`E>oeWQQ!iUH&TcZawu(55;qVsg$CA zWWGGN`FMA4XScS!yS5s=THoB;+J5{;R3#$ftvue?dbEaVhFen?ncM4(+>q$)HRS4Y zm<5@1Ra_RjW1^B=KZPT?0ZwlZ($eigP8wGN~2_P(rS;FmH%b~s<_ED7KBbv4T0A-xEBizM=LGj$GT4t&&Hydx=a=c!` zr#z&7i$(iWSn9fo|KgYhg6@EZA{$OvF60C-9wH)^b$2hPxg!|#P=WuaIpI$q zTA^>@ed@bQ-_!EXw>ihNv}l?~#Rn%Eu|8++-6VV}7T&yTc* zguVz%t`q^d+c6sehuJ+oS;x6gFmJT;n!e+YZ*e6q`a45#(9F8bEol4vh;RBGqmRJc zKhCm)z?3wrDf?UJdL5}c+QN3EoCO*C9ce`s89i0->~yOIAB|{mOhYpm?Y!5;-9!=m zg!~b$&=LKGcs1k6f>$uFJPY_#%tn1cwoDf#^~UPs+afrD)PV+K4thRyfJegts!TY) zwA_6VcQg|hZXipgt3mg{rWeZHanFa3K)eP@Y9Z7I9yfTL6FbQdcjEC|^zK*^g*4Dn zp%HS=r{!t`J%Jhx;kh9^Bn~V5|HvmIsv4Cf;f-|2U36UT=-d)MFr2)2P>X!OP+Giu z_eZWJNe2mDyr}V>w#GhLBDsI^+tKIkAZ>O?8_cph=&8WM0|u-50{8NH2>(^EMf{hx zO$iS#ZPR|bf%aUj{E(KLKmM}#>-S6LA8-D0_gCfh&G*yIjLS!#F@3?`|MZ~~evbFj z{POD$@L%=I(icDc(EVk_4SnZVupohs_kPuuTZJ(^Nvpk380!`K%rqWvuVp&B_@k|c zZ~ug*eXab@VWfYk{_x2UU;GHGBYD5*9rGsg;<%qa zM$Qe0Sv)_k54j{7zsjNbF$wTrMQ%X>?7j5ipxhZ)oWkM}M-+>S)CBqkuiGJaa~R<+G?F~o6$N6b7E5qn;^QRnJKt9W`o#dPA`OPS7RO!f&-vSZc9ikOecjdq2w`#lV^E;uNUu6{;0O6y7a4UZm)U-p!R?1B=rFHlbr`cGo)PtI zUF1&bPCTq%a&w^p^(N2HBXWy^LaJ6zMM*kiTTiJ36P;d9Yf~A`DPPG__e`=n)<5aY z(l|o&Qw$J2c5vv4HfmH=Pp?xARn=lWYE-@C+^py&-;H+W{V6V)+5~UtnmLHAn@U@c zxIE#}IZO?UZB4s_+o^U4T9{+IPsA=PzY7(MflOZSX*%8?KN|d$&vea4(k*#XJn`Q;V$I8dB@XDY*Jh2iLyL*oA(hzOw(o@@ z%)?gZ(>g{00)e!{4??dY@)M1=^nLiojYHk4xnB~eNFT%eq>0zBLzZ6H_I&$i*2sKZ zclW7dH`Xx%wOZhtaky_UdB_Bw2vwcrgT*nt0oHOXfAsgi}g9VJU? zI;oO=pOYk6%)3BxItuq+FHD#$^8IAWAw&Pcu(Zj7-(2TM&hk6_mNr3(YB~3xC#hC= zMY^m=f4^#?l)@WWMUubCy@f1M&akV>q%NVmfFn^#!37}ekcWmdL&eVH`y_`92D8-)oJ`p}( zEbHtg)gf9g)G`!-c>0aTJu1qsJ#wJll$@yWt%8$Y`pk(gzL4rh#6HERMMR>!`w1m^ zvPxz&c?aHJ?N@D7!4LQSeulJEtV6^K9lHQ49o9M4;_k|@* z^J3DyU9>|h^^qciXFn#~rGA^|1D3nnGam2xl;v}`*+>xTbY}J#AM^0S% zdu-XVH|PWO0s0*Mzi-etX|uQk?gPY8v?I#)R5NjW#4Uiu zV)wU;U7Vj(E0xMjWp-w&GBXE{mAOYd-|3etmFf542YY!2{!CS7D@*L_E&ea*bQ zhE~_FSSH$lF$k?S>+M^+FCO)}^a`a<@9w`?-q%fO*1vo+)_C9jxPI%=O7q~(_PsT7 zbG`Za(f2ELzPfpNbq%92w7R8h_qVChiGry3V#?Yj`^3iI;&v`w+SIn&+Q5sn1LTHU=xHsi zxn4-x1X~(vc~PjDUF3FfJP@*a$ThL%+Za)-{op~H7X{k0hc+_zV@em>&o77#Vgv?d z@8azVYYqkuEL@{q6kw}K+#U&W?Z;5>Y+UYa^hu!Kx&3W(YiG-RvSqbzwr{L#-NaX3 zT)Svgw`_ueMT#7leN%h(>^gS5=h<9rBV)1EC}AXeL@ojq6Hbn*L&9#o2dM-JJ?Mu2R;OFj3Sj)REJrms|Hr}L`dA_r66cZN64vPS+q69u-Q z#cU9G_%G*nTAFiVYpbp;4{6rMNFjKjBp^fGA^|p;GM%@HiCxOLVysU6j}JFp#$CqH zlr-~K!<*C!kZXYo)@-liHG4P!8%DN4dmU-Isi7$fujj>@VF(HeFJu&w&=%aiV_|9r z#1FIg3#R9W$PC3#zE=KozOOU3My%-C%gM6Vvb|Q#K{Uhxqca@q&}CNmyvq4M&PmkB zq}pqYH*7^3Ue=&lwic=F(ls+dlmOd+ux^LJ1*2og5O%R#^^}Yp%87S7vFk(adLGEYe#bEB3*dGFf_qp4i_!Seft{WU1~@#{u5ee(bc?Qu4Mcrx z!qM3*jOfOM2VERs)(!qoD4enLXkc*bo}RpQ7v6tbHZGhfj?F=ST;?E8{Nrn~qf?oG z9M7Dtj%!ZZ0UVd1Rnqef;5^9Pd=$H>Y9)11%I?Z@UivIE zGuH`_-<3F>9qlSb1L_wV7H~gKv?-J+9WZyApC&>x7X$nvf|$mtD6H`Wgib)H420xN z&!P=svjS^W_;ado1TDUtYL7mj8tNmc$eHI;>G>0=Vw~+H`HuT+K6vd!c1Xa61XNLN z&j+o+0a(Xg3}%2*xX-kJg!VuKY42mps6O-@thEpYkRxu})7pXOl<>qxFo7d%0VxHX zO884caHG1@WjJWt-T{r1{IIqTcG<22kg{2l%(vDf7$_JvvxL8kvBlGSZ5+aIC3DLM z@{cbG#rWjlNC1`fGqI!c1S<#d-*#A?Dc2m}PSk~f%}5f};$BbU{p zG&gcuEb$6z=Ytl4f+42*ZU`|%2ZNKhG{ihR6SV~j??(Z)lfYot+tqNp4dZH?7v&lv z2aF@q&T~rbOvUwoq@af@WnP6}Qb7x^7x?Snq|q2PVj*zh)P54}Kj+)e=GtpK4l8s# zS7Xs6&6E8EK}TVbFBLR=ECqG7#=KU(zkarPm2>*_^Sz52qS`(lP(!wlp@hv*1xERpb!0N= z<3@dXO|LifMq{T@->la+SJ#Ysz5cyyrM(qNc(Tw&j1+hWF0gV<+K>n$huEMh*`k^l_CA*nBygzCMaxLKj?trx>04ccUHDn&m_H{2Ho%ERWPG3)BLBS?#$}+wJ zKl*y^7|U0h=YOkIZxY~=H$`j#JwTlf4g@S6<&Xp9*b2j3*X!&0^2QEWWn+1Bb(I^Y z(%;M>%St6P%feuRuzZq7sTQ2(El*+AtaTysEwBVDr_pM#SZ=_7F;8oo%PX${7Aq%U zF-fpknJieyl05;7Var}Qdazh|gTX=>RkNTVXYoUHGb&z|RY%?*m{cKCdJDepZI!`r;6GsIi#(QzGXlaNa?2a)Q|!%LOD?1&6c6X>j>! zLK5Jj1euK;;s7)Nvn=)NrU~N%h;-W|U`Zb~jmYSv2Tz&BG{>56U1AEMhs2SseP%qd z3mhuHrT6{=4BP7@huI9Al&p<=&`UTdPe*?t4iz-=eJ=>JnJH`K5-i(8r7QZQ`heh* z$6`q@b52lZnvYJykH~KGq2{aDq?{zr7l=o#seEILb~dkCR0?u0hm8e1)`b1 zwL7=p6i)Tq#N9vi@>$5T=?Zu}c6N;|&yVl=?=jol(`a(*HYpSgOS=>*4!a<82%{=& zRr0%@@{9X$-T+Ly?wRz><6HL7+dB*ikR4&+9QQZ??rES8dmJzKG!EYbK}NkOF!6|` z{0hIWK6)Gl(6joN0`%X_Z<@*xjP!`A^7F5EfAWom4@F!vsyLyJMHk)3dB{#GLVEB! zt{Cvu!_RMB%l8O`H+=TfC3^nd-MECI{tCymqqwSOkv4=D>{Avw@}h8NQ{c-2t9W!` zLH|m{UjW4?PUMU*)eo~JL@s#|VMRstcsZ)?cp*TsoAQOlZitd6EA8fFeVok7i1FvV z_ySfOMJ*d^7gnD<`D*RS6OH9zB6@MOP+v9Jmzg=2G2`L`djRqRFeBFS%zid63a{NJ zCPAwD`~;@fWtC}@K8Bc+)zH{yZD!z6T5?@r0_9dDPtrcQa z(Cnp?-DGB_BLZ=5q5=T3Z_9g!x)8ILqsti7zrAgNWuDM*P+P8!H|qwq$Bl5LX%b0xvP7 zmXcjU9_~~Xop`=NSYuz0|IrXVD-WL$O@Icjg#uMMQI!daFZgG8ut>2P1tc7#QqQiy X&9O~S`Ob Date: Fri, 8 Sep 2023 15:18:24 -0500 Subject: [PATCH 17/19] Delete unused test. --- tests/testthat/dont-test-spec_version.R | 34 ------------------------- 1 file changed, 34 deletions(-) delete mode 100644 tests/testthat/dont-test-spec_version.R diff --git a/tests/testthat/dont-test-spec_version.R b/tests/testthat/dont-test-spec_version.R deleted file mode 100644 index 927e572..0000000 --- a/tests/testthat/dont-test-spec_version.R +++ /dev/null @@ -1,34 +0,0 @@ -test_that("rapid_spec_version() builds empty spec versions", { - expect_null(rapid_spec_version()) -}) - -test_that("rapid_spec_version() builds openapi spec versions", { - expect_snapshot(rapid_spec_version("openapi", 3)) - expect_snapshot(rapid_spec_version("openapi", 3.1)) - expect_snapshot(rapid_spec_version("openapi", "3.0.3")) -}) -test_that("rapid_spec_version() errors for bad openapi spec versions", { - expect_snapshot(rapid_spec_version("openapi", "a"), error = TRUE) - expect_snapshot(rapid_spec_version("openapi", 1:3), error = TRUE) -}) - -test_that("rapid_spec_version() builds swagger spec versions", { - expect_snapshot(rapid_spec_version("swagger", 2)) - expect_snapshot(rapid_spec_version("openapi", "2.0")) -}) -test_that("rapid_spec_version() errors for bad swagger spec versions", { - expect_snapshot(rapid_spec_version("swagger", 1), error = TRUE) - expect_snapshot(rapid_spec_version("swagger", 2.1), error = TRUE) - expect_snapshot(rapid_spec_version("swagger", "a"), error = TRUE) - expect_snapshot(rapid_spec_version("swagger", 1:3), error = TRUE) -}) - -test_that("rapid_spec_version() builds new spec versions", { - expect_snapshot(rapid_spec_version("new", 2)) - expect_snapshot(rapid_spec_version("new", "a")) - expect_snapshot(rapid_spec_version("new", 2, new_type = TRUE)) - expect_snapshot(rapid_spec_version("new", "a", new_type = TRUE)) -}) -test_that("rapid_spec_version() errors for bad new spec versions", { - expect_snapshot(rapid_spec_version("new", 1:3), error = TRUE) -}) From 2c1ba16059b8ae56a8904c0dd38ff642269c9d53 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 15:19:03 -0500 Subject: [PATCH 18/19] Styler --- R/utils.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 1bbe5ae..4e24f91 100644 --- a/R/utils.R +++ b/R/utils.R @@ -10,8 +10,11 @@ # I was about to write this when I discovered it unexported in rlang. I used # their name in case it ever becomes standard. `%|0|%` <- function(x, y) { - if (!length(x)) y - else x + if (!length(x)) { + y + } else { + x + } } .extract_along_chr <- function(x, el) { From a4c67d5aa19f53f2bdb46140adde4edbbec46a76 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Fri, 8 Sep 2023 15:56:05 -0500 Subject: [PATCH 19/19] Add missing dot help. --- NAMESPACE | 1 + R/info-01-contact.R | 1 + R/info-01-license.R | 1 + R/info-zz-info.R | 1 + R/rapid-package.R | 1 + R/servers-01-string_replacements.R | 6 +++++- R/servers-02-server_variables.R | 6 +++++- R/servers-zz-servers.R | 1 + R/zz-rapid.R | 5 +++-- man/as_contact.Rd | 2 ++ man/as_info.Rd | 2 ++ man/as_license.Rd | 2 ++ man/as_rapid.Rd | 2 ++ man/as_server_variables.Rd | 2 ++ man/as_servers.Rd | 2 ++ man/as_string_replacements.Rd | 2 ++ man/rapid.Rd | 4 ++-- tests/testthat/test-servers-02-server_variables.R | 4 +++- 18 files changed, 38 insertions(+), 7 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 77db63d..1541a23 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -31,3 +31,4 @@ importFrom(rlang,check_dots_empty) importFrom(rlang,check_dots_used) importFrom(stbl,stabilize_chr_scalar) importFrom(stbl,to_chr_scalar) +importFrom(yaml,read_yaml) diff --git a/R/info-01-contact.R b/R/info-01-contact.R index 42ce9cb..59ada15 100644 --- a/R/info-01-contact.R +++ b/R/info-01-contact.R @@ -43,6 +43,7 @@ contact <- S7::new_class( #' contrast with [contact()], which builds a `contact` from individual #' properties. #' +#' @inheritParams rlang::args_dots_empty #' @param x The object to coerce. Must be empty or have names "name", "email", #' and/or "url". Extra names are ignored. #' diff --git a/R/info-01-license.R b/R/info-01-license.R index a1bbd93..cdc4900 100644 --- a/R/info-01-license.R +++ b/R/info-01-license.R @@ -57,6 +57,7 @@ license <- S7::new_class( #' `as_license()` turns an existing object into a `license`. This is in contrast #' with [license()], which builds a `license` from individual properties. #' +#' @inheritParams rlang::args_dots_empty #' @param x The object to coerce. Must be empty or have names "name", #' "identifier", and/or "url". Extra names are ignored. #' diff --git a/R/info-zz-info.R b/R/info-zz-info.R index 6717438..789d9ec 100644 --- a/R/info-zz-info.R +++ b/R/info-zz-info.R @@ -89,6 +89,7 @@ info <- S7::new_class( #' `as_info()` turns an existing object into an `info` object. This is in #' contrast with [info()], which builds an `info` from individual properties. #' +#' @inheritParams rlang::args_dots_empty #' @param x The object to coerce. Must be empty or have names "title", #' "version", "contact", "description", "license", "summary", and/or #' "terms_of_service". Extra names are ignored. diff --git a/R/rapid-package.R b/R/rapid-package.R index b6528a5..9f85d50 100644 --- a/R/rapid-package.R +++ b/R/rapid-package.R @@ -9,5 +9,6 @@ #' @importFrom S7 class_missing #' @importFrom stbl stabilize_chr_scalar #' @importFrom stbl to_chr_scalar +#' @importFrom yaml read_yaml ## usethis namespace: end NULL diff --git a/R/servers-01-string_replacements.R b/R/servers-01-string_replacements.R index 8707883..be87d8d 100644 --- a/R/servers-01-string_replacements.R +++ b/R/servers-01-string_replacements.R @@ -80,6 +80,7 @@ string_replacements <- S7::new_class( #' `string_replacements`. This is in contrast with [string_replacements()], #' which builds a `string_replacements` from individual properties. #' +#' @inheritParams rlang::args_dots_empty #' @param x The object to coerce. Must be empty or be a list of named lists, #' each with names "enum", "default", or "description". Additional names are #' ignored. @@ -101,7 +102,10 @@ string_replacements <- S7::new_class( #' ) #' ) #' ) -as_string_replacements <- S7::new_generic("as_string_replacements", dispatch_args = "x") +as_string_replacements <- S7::new_generic( + "as_string_replacements", + dispatch_args = "x" +) S7::method(as_string_replacements, string_replacements) <- function(x) { x diff --git a/R/servers-02-server_variables.R b/R/servers-02-server_variables.R index 4e7eebd..07b99b3 100644 --- a/R/servers-02-server_variables.R +++ b/R/servers-02-server_variables.R @@ -47,6 +47,7 @@ server_variables <- S7::new_class( #' object. This is in contrast with [server_variables()], which builds a #' `server_variables` object from individual properties. #' +#' @inheritParams rlang::args_dots_empty #' @param x The object to coerce. Must be empty or be a list of objects that can #' be coerced to `string_replacements` objects via [as_string_replacements()]. #' @@ -72,7 +73,10 @@ server_variables <- S7::new_class( #' ) #' ) #' ) -as_server_variables <- S7::new_generic("as_server_variables", dispatch_args = "x") +as_server_variables <- S7::new_generic( + "as_server_variables", + dispatch_args = "x" +) S7::method(as_server_variables, server_variables) <- function(x) { x diff --git a/R/servers-zz-servers.R b/R/servers-zz-servers.R index 1dbcc10..c7f10b8 100644 --- a/R/servers-zz-servers.R +++ b/R/servers-zz-servers.R @@ -72,6 +72,7 @@ servers <- S7::new_class( #' contrast with [servers()], which builds a `servers` object from individual #' properties. #' +#' @inheritParams rlang::args_dots_empty #' @param x The object to coerce. Must be empty or have names "name", "email", #' and/or "url". Extra names are ignored. #' diff --git a/R/zz-rapid.R b/R/zz-rapid.R index 7936861..3b97a4e 100644 --- a/R/zz-rapid.R +++ b/R/zz-rapid.R @@ -13,13 +13,13 @@ #' rapid() #' rapid( #' info = info(title = "A", version = "1"), -#' servers( +#' servers = servers( #' url = "https://development.gigantic-server.com/v1" #' ) #' ) #' rapid( #' info = info(title = "A", version = "1"), -#' servers( +#' servers = servers( #' url = c( #' "https://development.gigantic-server.com/v1", #' "https://staging.gigantic-server.com/v1", @@ -63,6 +63,7 @@ rapid <- S7::new_class( #' contrast with [rapid()], which builds a `rapid` object from individual #' properties. #' +#' @inheritParams rlang::args_dots_empty #' @param x The object to coerce. Must be empty or have names "info" and/or #' "servers". Extra names are ignored. #' diff --git a/man/as_contact.Rd b/man/as_contact.Rd index 74c27a4..0682746 100644 --- a/man/as_contact.Rd +++ b/man/as_contact.Rd @@ -9,6 +9,8 @@ as_contact(x, ...) \arguments{ \item{x}{The object to coerce. Must be empty or have names "name", "email", and/or "url". Extra names are ignored.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ A \code{contact} as returned by \code{\link[=contact]{contact()}}. diff --git a/man/as_info.Rd b/man/as_info.Rd index 6f2b1cb..f732011 100644 --- a/man/as_info.Rd +++ b/man/as_info.Rd @@ -10,6 +10,8 @@ as_info(x, ...) \item{x}{The object to coerce. Must be empty or have names "title", "version", "contact", "description", "license", "summary", and/or "terms_of_service". Extra names are ignored.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ An \code{info} object as returned by \code{\link[=info]{info()}}. diff --git a/man/as_license.Rd b/man/as_license.Rd index 69a383f..b4e92c4 100644 --- a/man/as_license.Rd +++ b/man/as_license.Rd @@ -9,6 +9,8 @@ as_license(x, ...) \arguments{ \item{x}{The object to coerce. Must be empty or have names "name", "identifier", and/or "url". Extra names are ignored.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ A \code{license} as returned by \code{\link[=license]{license()}}. diff --git a/man/as_rapid.Rd b/man/as_rapid.Rd index 94e2be1..f95e394 100644 --- a/man/as_rapid.Rd +++ b/man/as_rapid.Rd @@ -9,6 +9,8 @@ as_rapid(x, ...) \arguments{ \item{x}{The object to coerce. Must be empty or have names "info" and/or "servers". Extra names are ignored.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ A \code{rapid} object as returned by \code{\link[=rapid]{rapid()}}. diff --git a/man/as_server_variables.Rd b/man/as_server_variables.Rd index 3e14a68..91bc9c3 100644 --- a/man/as_server_variables.Rd +++ b/man/as_server_variables.Rd @@ -9,6 +9,8 @@ as_server_variables(x, ...) \arguments{ \item{x}{The object to coerce. Must be empty or be a list of objects that can be coerced to \code{string_replacements} objects via \code{\link[=as_string_replacements]{as_string_replacements()}}.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ A \code{server_variables} object as returned by \code{\link[=server_variables]{server_variables()}}. diff --git a/man/as_servers.Rd b/man/as_servers.Rd index 242841f..c9b9828 100644 --- a/man/as_servers.Rd +++ b/man/as_servers.Rd @@ -9,6 +9,8 @@ as_servers(x, ...) \arguments{ \item{x}{The object to coerce. Must be empty or have names "name", "email", and/or "url". Extra names are ignored.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ A \code{servers} object as returned by \code{\link[=servers]{servers()}}. diff --git a/man/as_string_replacements.Rd b/man/as_string_replacements.Rd index 60e2d52..d62fe17 100644 --- a/man/as_string_replacements.Rd +++ b/man/as_string_replacements.Rd @@ -10,6 +10,8 @@ as_string_replacements(x, ...) \item{x}{The object to coerce. Must be empty or be a list of named lists, each with names "enum", "default", or "description". Additional names are ignored.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ A \code{string_replacements} as returned by \code{\link[=string_replacements]{string_replacements()}}. diff --git a/man/rapid.Rd b/man/rapid.Rd index 84cf876..c532073 100644 --- a/man/rapid.Rd +++ b/man/rapid.Rd @@ -23,13 +23,13 @@ An object that represents an API. rapid() rapid( info = info(title = "A", version = "1"), - servers( + servers = servers( url = "https://development.gigantic-server.com/v1" ) ) rapid( info = info(title = "A", version = "1"), - servers( + servers = servers( url = c( "https://development.gigantic-server.com/v1", "https://staging.gigantic-server.com/v1", diff --git a/tests/testthat/test-servers-02-server_variables.R b/tests/testthat/test-servers-02-server_variables.R index 0607be3..7d09224 100644 --- a/tests/testthat/test-servers-02-server_variables.R +++ b/tests/testthat/test-servers-02-server_variables.R @@ -24,7 +24,9 @@ test_that("server_variables() returns an empty server_variables", { test_that("server_variables() accepts bare string_replacements", { expect_snapshot(server_variables(string_replacements())) - expect_snapshot(server_variables(string_replacements(), string_replacements())) + expect_snapshot( + server_variables(string_replacements(), string_replacements()) + ) }) test_that("server_variables() accepts lists of string_replacements", {