Implement as_info()

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)

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])
 }

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}."
   )

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}."
   )

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,16 +17,14 @@
 #'   [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
 #' @examples
 #' 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}."
+  )
+}

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(),

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) {

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()].
 #'

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 <rlang_error>
-      Error:
-      ! `x` must have names "name", "identifier", or "url".
-      * Any other names are ignored.
-
 # as_license() errors informatively for bad classes
 
     Code