Refactor and clean (#83)

* Implement components/parameters.

* Working tests after a long break.

* Update docs.

* Cleanup.

* Roll back parameter work.

* Don't call as_security_scheme() without args

as_security_scheme() doesn't make sense without args, since it needs to know what sort of empty security scheme to build.

* Style.

* Avoid long lines

And mention everything in _pkgdown.yml.

* Test as_security_scheme() with missing arg.

DESCRIPTION

@@ -34,7 +34,7 @@ Config/testthat/edition: 3
 Config/testthat/parallel: true
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Collate: 
     'properties.R'
     'security.R'
@@ -51,6 +51,8 @@ Collate:
     'zz-rapid.R'
     'absolute_paths.R'
     'as.R'
+    'components-reference.R'
+    'components-schema.R'
     'components-security_scheme.R'
     'components-security_scheme-api_key.R'
     'components-security_scheme-oauth2-scopes.R'

NAMESPACE

@@ -12,6 +12,8 @@ export(as_oauth2_security_scheme)
 export(as_oauth2_token_flow)
 export(as_origin)
 export(as_rapid)
+export(as_reference)
+export(as_schema)
 export(as_scopes)
 export(as_security)
 export(as_security_scheme)
@@ -33,6 +35,8 @@ export(class_oauth2_security_scheme)
 export(class_oauth2_token_flow)
 export(class_origin)
 export(class_rapid)
+export(class_reference)
+export(class_schema)
 export(class_scopes)
 export(class_security)
 export(class_security_scheme_details)
@@ -43,17 +47,23 @@ export(class_string_replacements)
 export(expand_servers)
 if (getRversion() < "4.3.0") importFrom("S7", "@")
 importFrom(S7,"prop<-")
+importFrom(S7,S7_inherits)
 importFrom(S7,class_any)
 importFrom(S7,class_character)
+importFrom(S7,class_factor)
 importFrom(S7,class_list)
-importFrom(S7,class_missing)
+importFrom(S7,class_logical)
 importFrom(S7,prop)
+importFrom(S7,validate)
+importFrom(cli,format_inline)
 importFrom(glue,glue)
 importFrom(rlang,"%||%")
 importFrom(rlang,caller_arg)
 importFrom(rlang,caller_env)
 importFrom(rlang,check_dots_empty)
 importFrom(stbl,stabilize_chr)
 importFrom(stbl,stabilize_chr_scalar)
+importFrom(stbl,stabilize_fct)
+importFrom(stbl,stabilize_lgl_scalar)
 importFrom(xml2,url_absolute)
 importFrom(yaml,read_yaml)

R/as.R

@@ -28,7 +28,7 @@ as_api_object <- S7::new_generic(
     }
     force(arg)
     rlang::check_dots_empty(call = call)
-    if (S7::S7_inherits(x, target_class)) {
+    if (S7_inherits(x, target_class)) {
       return(x)
     }
     S7::S7_dispatch()

R/components-reference.R

@@ -0,0 +1,79 @@
+#' @include properties.R
+NULL
+
+#' A simple object for referencing other components in the API description
+#'
+#' The `reference` object allows for reuse of components between different parts
+#' of the API description. These objects are currently simple character
+#' references, but may change structure in the future to automatically resolve
+#' references.
+#'
+#' @param ref_uri Character scalar. The reference identifier. This must be in
+#'   the form of a URI.
+#' @param summary Character scalar (optional). A short summary which by default
+#'   should override that of the referenced component. If the referenced
+#'   object-type does not allow a summary field, then this field has no effect.
+#' @param description Character scalar (optional). A description which by
+#'   default should override that of the referenced component. [CommonMark
+#'   syntax](https://spec.commonmark.org/) may be used for rich text
+#'   representation. If the referenced object-type does not allow a description
+#'   field, then this field has no effect.
+#'
+#' @return A `reference` S7 object pointing (by name) to another part of the
+#'   `rapid` object.
+#' @export
+#'
+#' @seealso [as_reference()] for coercing objects to `reference`.
+#'
+#' @examples
+#' class_reference("#/components/schemas/Pet")
+class_reference <- S7::new_class(
+  name = "reference",
+  package = "rapid",
+  properties = list(
+    ref_uri = character_scalar_property("ref_uri"),
+    summary = character_scalar_property("summary"),
+    description = character_scalar_property("description")
+  ),
+  validator = function(self) {
+    validate_parallel(
+      self,
+      "ref_uri",
+      optional = c("summary", "description")
+    )
+  }
+)
+
+S7::method(length, class_reference) <- function(x) {
+  length(x@ref_uri)
+}
+
+#' Coerce lists and character vectors to references
+#'
+#' `as_reference()` turns an existing object into a `reference`. This is in
+#' contrast with [class_reference()], which builds a `reference` from individual
+#' properties.
+#'
+#' @inheritParams rlang::args_dots_empty
+#' @inheritParams rlang::args_error_context
+#' @param x The object to coerce. Must be empty or have names "type",
+#'   "nullable", "description", and/or "format", or names that can be coerced to
+#'   those names via [snakecase::to_snake_case()]. Extra names are ignored. This
+#'   object should describe a single reference.
+#'
+#' @return A `reference` as returned by [class_reference()].
+#' @export
+#'
+#' @examples
+#' as_reference()
+#' as_reference(list(`$ref` = "#/components/schemas/Pet"))
+as_reference <- function(x, ..., arg = caller_arg(x), call = caller_env()) {
+  as_api_object(
+    x,
+    class_reference,
+    ...,
+    alternate_names = c("$ref" = "ref_uri"),
+    arg = arg,
+    call = call
+  )
+}

R/components-schema.R

@@ -0,0 +1,105 @@
+#' @include properties.R
+NULL
+
+#' Reusable input and output data type definitions
+#'
+#' The `schema` object allows the definition of input and output data types.
+#' These types can be objects, but also primitives and arrays. This object is a
+#' superset of the [JSON Schema Specification Draft
+#' 2020-12](https://datatracker.ietf.org/doc/html/draft-bhutton-json-schema-00).
+#'
+#' @inheritParams rlang::args_dots_empty
+#' @param type Factor (or coercible to factor). The type of object being
+#'   defined. Currently must be one of "string", "number", "integer", "boolean",
+#'   "array", or "object".
+#' @param nullable Logical scalar (default `FALSE`). Whether the parameter can
+#'   be set to `NULL`.
+#' @param description Character scalar (optional). A description of the object
+#'   defined by the schema.
+#' @param format Character scalar (optional). The format of the object.
+#'   Essentially a sub-type.
+#'
+#' @return A `schema` S7 object describing the data type, with fields `type`,
+#'   `nullable`, `description`, and `format`.
+#' @export
+#'
+#' @seealso [as_schema()] for coercing objects to `schema`.
+#'
+#' @examples
+#' class_schema("string")
+#' class_schema("string", nullable = TRUE, description = "A nullable string.")
+class_schema <- S7::new_class(
+  name = "schema",
+  package = "rapid",
+  properties = list(
+    type = factor_property(
+      "type",
+      c("string", "number", "integer", "boolean", "array", "object"),
+      max_size = 1
+    ),
+    nullable = logical_scalar_property("nullable"),
+    description = character_scalar_property("description"),
+    format = character_scalar_property("format")
+  ),
+  constructor = function(type = c(
+                           "string", "number", "integer",
+                           "boolean", "array", "object"
+                         ),
+                         ...,
+                         nullable = FALSE,
+                         description = character(),
+                         format = character()) {
+    check_dots_empty()
+    if (missing(type)) {
+      type <- character()
+      nullable <- logical()
+    }
+    S7::new_object(
+      S7::S7_object(),
+      type = type,
+      nullable = nullable,
+      description = description,
+      format = format
+    )
+  },
+  validator = function(self) {
+    validate_parallel(
+      self,
+      "type",
+      required = "nullable",
+      optional = c("description", "format")
+    )
+  }
+)
+
+S7::method(length, class_schema) <- function(x) {
+  length(x@type)
+}
+
+#' Coerce lists to schemas
+#'
+#' `as_schema()` turns an existing object into a `schema`. This is in contrast
+#' with [class_schema()], which builds a `schema` from individual properties.
+#'
+#' @inheritParams rlang::args_dots_empty
+#' @inheritParams rlang::args_error_context
+#' @param x The object to coerce. Must be empty or have names "type",
+#'   "nullable", "description", and/or "format", or names that can be coerced to
+#'   those names via [snakecase::to_snake_case()]. Extra names are ignored. This
+#'   object should describe a single schema.
+#'
+#' @return A `schema` as returned by [class_schema()].
+#' @export
+#'
+#' @examples
+#' as_schema()
+#' as_schema(
+#'   list(
+#'     type = "string",
+#'     format = "date-time",
+#'     description = "Timestamp when the event will occur."
+#'   )
+#' )
+as_schema <- function(x, ..., arg = caller_arg(x), call = caller_env()) {
+  as_api_object(x, class_schema, ..., arg = arg, call = call)
+}

R/components-security_scheme-api_key.R

@@ -29,7 +29,12 @@ class_api_key_security_scheme <- S7::new_class(
     location = character_scalar_property("location")
   ),
   constructor = function(parameter_name = character(),
-                         location = character()) {
+                         location = c("query", "header", "cookie")) {
+    if (length(parameter_name)) {
+      location <- rlang::arg_match(location)
+    } else {
+      location <- character()
+    }
     S7::new_object(
       S7::S7_object(),
       parameter_name = parameter_name,
@@ -41,10 +46,6 @@ class_api_key_security_scheme <- S7::new_class(
       self,
       "parameter_name",
       required = "location"
-    ) %|0|% validate_in_fixed(
-      self,
-      "location",
-      c("query", "header", "cookie")
     )
   }
 )

R/components-security_scheme-oauth2-authorization_code_flow.R

@@ -81,5 +81,11 @@ as_oauth2_authorization_code_flow <- function(x,
                                               ...,
                                               arg = caller_arg(x),
                                               call = caller_env()) {
-  as_api_object(x, class_oauth2_authorization_code_flow, ..., arg = arg, call = call)
+  as_api_object(
+    x,
+    class_oauth2_authorization_code_flow,
+    ...,
+    arg = arg,
+    call = call
+  )
 }

R/components-security_scheme-oauth2-implicit_flow.R

@@ -54,8 +54,9 @@ S7::method(length, class_oauth2_implicit_flow) <- function(x) {
 #' Coerce lists and character vectors to OAuth2 implicit flows
 #'
 #' `as_oauth2_implicit_flow()` turns an existing object into an
-#' `oauth2_implicit_flow`. This is in contrast with [class_oauth2_implicit_flow()],
-#' which builds an `oauth2_implicit_flow` from individual properties.
+#' `oauth2_implicit_flow`. This is in contrast with
+#' [class_oauth2_implicit_flow()], which builds an `oauth2_implicit_flow` from
+#' individual properties.
 #'
 #' @inheritParams rlang::args_dots_empty
 #' @inheritParams rlang::args_error_context
@@ -64,7 +65,8 @@ S7::method(length, class_oauth2_implicit_flow) <- function(x) {
 #'   names that can be coerced to those names via [snakecase::to_snake_case()].
 #'   Additional names are ignored.
 #'
-#' @return An `oauth2_implicit_flow` as returned by [class_oauth2_implicit_flow()].
+#' @return An `oauth2_implicit_flow` as returned by
+#'   [class_oauth2_implicit_flow()].
 #' @export
 as_oauth2_implicit_flow <- function(x,
                                     ...,

R/components-security_scheme-oauth2-token_flow.R

@@ -61,8 +61,8 @@ S7::method(length, class_oauth2_token_flow) <- function(x) {
 #' Coerce lists and character vectors to OAuth2 token flows
 #'
 #' `as_oauth2_token_flow()` turns an existing object into an
-#' `oauth2_token_flow`. This is in contrast with [class_oauth2_token_flow()], which
-#' builds an `oauth2_token_flow` from individual properties.
+#' `oauth2_token_flow`. This is in contrast with [class_oauth2_token_flow()],
+#' which builds an `oauth2_token_flow` from individual properties.
 #'
 #' @inheritParams rlang::args_dots_empty
 #' @inheritParams rlang::args_error_context

R/components-security_scheme-oauth2.R

@@ -11,8 +11,8 @@ NULL
 #' @inheritParams rlang::args_dots_empty
 #' @param implicit_flow An `oauth2_implicit_flow` object created with
 #'   [class_oauth2_implicit_flow()].
-#' @param password_flow,client_credentials_flow An `oauth2_token_flow` object created with
-#'   [class_oauth2_token_flow()].
+#' @param password_flow,client_credentials_flow An `oauth2_token_flow` object
+#'   created with [class_oauth2_token_flow()].
 #' @param authorization_code_flow An `oauth2_authorization_code_flow` object
 #'   created with [class_oauth2_authorization_code_flow()].
 #'

R/components-security_scheme.R

@@ -29,7 +29,6 @@ abstract_security_scheme <- S7::new_class(
 #' @export
 #'
 #' @examples
-#' as_security_scheme()
 #' as_security_scheme(
 #'   list(
 #'     description = "Account JWT token",
@@ -90,19 +89,26 @@ S7::method(as_security_scheme, class_list) <- function(x,
   )
 }
 
-S7::method(
-  as_security_scheme,
-  class_missing | NULL
-) <- function(x, ..., arg = caller_arg(x), call = caller_env()) {
+S7::method(as_security_scheme, NULL) <- function(x,
+                                                 ...,
+                                                 arg = caller_arg(x),
+                                                 call = caller_env()) {
   NULL
 }
 
 S7::method(as_security_scheme, class_any) <- function(x,
                                                       ...,
                                                       arg = caller_arg(x),
                                                       call = caller_env()) {
+  msg <- "Can't coerce {.arg {arg}} {.cls {class(x)}} to {.cls rapid::security_scheme}."
+  if (missing(x)) {
+    msg <- c(
+      "Can't coerce {.arg {arg}} to {.cls rapid::security_scheme}.",
+      x = "{.arg {arg}} is missing."
+    )
+  }
   cli::cli_abort(
-    "Can't coerce {.arg {arg}} {.cls {class(x)}} to {.cls rapid::security_scheme}.",
+    msg,
     call = call
   )
 }

R/components-security_scheme_details.R

@@ -1,7 +1,7 @@
 #' Details of API security schemes
 #'
 #' The object provides a list of details of security schemes for the API. Each
-#' element within the list is a [abstract_security_scheme()] object.
+#' element within the list is an [abstract_security_scheme()] object.
 #'
 #' @param ... One or more [abstract_security_scheme()] objects or a list of such
 #'   objects. These objects must be generated by
@@ -60,7 +60,7 @@ class_security_scheme_details <- S7::new_class(
   validator = function(self) {
     bad_security_schemes <- !purrr::map_lgl(
       S7::S7_data(self),
-      ~ S7::S7_inherits(.x, abstract_security_scheme) || is.null(.x)
+      ~ S7_inherits(.x, abstract_security_scheme) || is.null(.x)
     )
     if (any(bad_security_schemes)) {
       bad_locations <- which(bad_security_schemes)