Construct (part of) a rapid from an OAS doc. (#31)

DESCRIPTION

@@ -21,7 +21,8 @@ Imports:
     purrr,
     rlang (>= 1.1.0),
     S7,
-    stbl
+    stbl,
+    yaml
 Suggests: 
     testthat (>= 3.0.0)
 Remotes:

R/00-properties.R

@@ -6,6 +6,7 @@ character_scalar_property <- function(x_arg, ...) {
     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(
         value,
         allow_null = FALSE,
@@ -25,6 +26,7 @@ character_property <- function(x_arg, ...) {
     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(
         value,
         allow_null = FALSE,

R/00-shared-params.R

@@ -0,0 +1,11 @@
+#' Parameters used in multiple functions
+#'
+#' 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
+NULL

R/01-info_contact.R

@@ -2,6 +2,7 @@
 #'
 #' 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.
@@ -27,7 +28,13 @@ api_contact <- S7::new_class(
       regex = "^[^@]+@[^@]+$"
     ),
     url = url_scalar_property("url")
-  )
+  ),
+  constructor = function(name = S7::class_missing,
+                         email = S7::class_missing,
+                         url = S7::class_missing,
+                         ...) {
+    S7::new_object(NULL, name = name, email = email, url = url)
+  }
 )
 
 #' @export

R/02-info.R

@@ -4,6 +4,7 @@
 #' 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
 #'   [api_contact()].
 #' @param description A description of the API. [CommonMark
@@ -43,7 +44,36 @@ api_info <- S7::new_class(
     terms_of_service = url_scalar_property("terms_of_service"),
     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,
+                         ...,
+                         apid_list = NULL) {
+    if (!is.null(apid_list)) {
+      contact <- rlang::inject(api_contact(!!!apid_list$info$contact))
+      description <- apid_list$info$description
+      license <- rlang::inject(api_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

R/02_server_variable_list.R

@@ -3,6 +3,7 @@
 #' 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.
 #'
@@ -18,7 +19,23 @@ server_variable_list <- S7::new_class(
   "server_variable_list",
   package = "rapid",
   parent = S7::class_list,
-  constructor = function(...) {
+  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")
+            )
+          }
+        )
+      ))
+    }
     if (...length() == 1 && is.list(..1)) {
       return(S7::new_object(..1))
     }

R/03-servers.R

@@ -2,6 +2,7 @@
 #'
 #' 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.
@@ -48,6 +49,23 @@ 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,
+                         ...,
+                         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,
@@ -57,6 +75,23 @@ 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
+    }
+  )
+}
+
+.extract <- function(x, el) {
+  x$el %||% NA
+}
+
 #' @export
 `length.rapid::servers` <- function(x) {
   length(x@url)

R/99-rapid.R

@@ -2,6 +2,7 @@
 #'
 #' An object that represents an API.
 #'
+#' @inheritParams .shared-parameters
 #' @param info An `api_info` object defined by [api_info()].
 #' @param servers A `servers` object defined by [servers()].
 #'
@@ -38,6 +39,24 @@ rapid <- S7::new_class(
     info = api_info,
     servers = servers
   ),
+  constructor = function(info = S7::class_missing,
+                         servers = S7::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 <- api_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,

principles.md

@@ -10,3 +10,9 @@ This rule still might change.
 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.
+
+## Specification extensions
+
+OAS allows for [Specification Extensions](https://spec.openapis.org/oas/v3.1.0#specificationExtensions), which are extra fields that begin with "x-".
+I do not yet support these anywhere, and capture them in `...` in order to throw them away without errors.
+Later I should at least check these, and ideally deal with them.