Add expand_servers() function. (#68)

Closes #66.

DESCRIPTION

@@ -23,6 +23,7 @@ Imports:
     S7 (>= 0.1.1),
     snakecase,
     stbl,
+    xml2,
     yaml
 Suggests: 
     testthat (>= 3.0.0)
@@ -35,31 +36,32 @@ Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 Collate: 
+    'properties.R'
+    'security_requirements.R'
+    'components-security_scheme_details.R'
+    'components-security_scheme_collection.R'
+    'components.R'
+    'servers-server_variables.R'
+    'servers-string_replacements.R'
+    'servers.R'
+    'info-origin.R'
+    'info-license.R'
+    'info-contact.R'
+    'info.R'
+    'zz-rapid.R'
+    'absolute_paths.R'
     'as.R'
     'components-security_scheme.R'
-    'properties.R'
     'components-security_scheme-api_key.R'
     'components-security_scheme-oauth2-scopes.R'
     'components-security_scheme-oauth2-flow.R'
     'components-security_scheme-oauth2-authorization_code_flow.R'
     'components-security_scheme-oauth2-implicit_flow.R'
     'components-security_scheme-oauth2-token_flow.R'
     'components-security_scheme-oauth2.R'
-    'components-security_scheme_details.R'
-    'components-security_scheme_collection.R'
-    'components.R'
-    'info-contact.R'
-    'info-license.R'
-    'info-origin.R'
-    'info.R'
     'rapid-package.R'
-    'security_requirements.R'
-    'servers-server_variables.R'
-    'servers-string_replacements.R'
-    'servers.R'
     'utils.R'
     'validate_in.R'
     'validate_lengths.R'
     'validate_parallel.R'
-    'zz-rapid.R'
     'zzz.R'

NAMESPACE

@@ -23,6 +23,7 @@ export(as_string_replacements)
 export(class_origin)
 export(component_collection)
 export(contact)
+export(expand_servers)
 export(info)
 export(license)
 export(oauth2_authorization_code_flow)
@@ -49,4 +50,5 @@ importFrom(rlang,"%||%")
 importFrom(rlang,check_dots_empty)
 importFrom(stbl,stabilize_chr_scalar)
 importFrom(stbl,to_chr_scalar)
+importFrom(xml2,url_absolute)
 importFrom(yaml,read_yaml)

R/absolute_paths.R

@@ -0,0 +1,46 @@
+#' @include zz-rapid.R
+NULL
+
+#' Expand server urls to absolute paths
+#'
+#' `expand_servers()` uses the `origin` property of a `rapid` object to expand
+#' the `servers` `url` property to an absolute path.
+#'
+#' @inheritParams rlang::args_error_context
+#' @inheritParams rlang::args_dots_empty
+#' @param x The object to update. Must be a `rapid`.
+#'
+#' @return A `rapid` object as returned by [rapid()], with absolute server
+#'   paths.
+#' @export
+expand_servers <- S7::new_generic("expand_servers", dispatch_args = "x")
+
+S7::method(expand_servers, rapid) <- function(x) {
+  if (length(x@servers@url)) {
+    relative_servers <- .is_relative_url(x@servers@url)
+    origin_url <- x@info@origin@url
+    if (length(origin_url)) {
+      base_url <- url_absolute("..", origin_url)
+      x@servers@url[relative_servers] <- paste0(
+        base_url,
+        x@servers@url[relative_servers]
+      )
+      x@servers@url[relative_servers] <- gsub(
+        pattern = "(?<!\\:)//",
+        replacement = "/",
+        x = x@servers@url[relative_servers],
+        perl = TRUE
+      )
+    }
+  }
+  return(x)
+}
+
+S7::method(expand_servers, class_any) <- function(x,
+                                                  arg = rlang::caller_arg(x),
+                                                  call = rlang::caller_env()) {
+  cli::cli_abort(
+    "{.arg {arg}} {.cls {class(x)}} must be a {.cls rapid}.",
+    call = call
+  )
+}

R/info-origin.R

@@ -114,8 +114,8 @@ S7::method(as_origin, class_missing | NULL) <- function(x) {
 }
 
 S7::method(as_origin, class_any) <- function(x,
-                                              ...,
-                                              arg = rlang::caller_arg(x)) {
+                                             ...,
+                                             arg = rlang::caller_arg(x)) {
   cli::cli_abort(
     "Can't coerce {.arg {arg}} {.cls {class(x)}} to {.cls class_origin}."
   )

R/rapid-package.R

@@ -10,6 +10,7 @@
 #' @importFrom S7 prop<-
 #' @importFrom stbl stabilize_chr_scalar
 #' @importFrom stbl to_chr_scalar
+#' @importFrom xml2 url_absolute
 #' @importFrom yaml read_yaml
 ## usethis namespace: end
 NULL

R/utils.R

@@ -34,3 +34,7 @@
   }
   x
 }
+
+.is_relative_url <- function(x) {
+  grepl("^/", x)
+}

R/zz-rapid.R

@@ -1,5 +1,7 @@
 #' @include info.R
 #' @include servers.R
+#' @include components.R
+#' @include security_requirements.R
 NULL
 
 #' R API description object
@@ -121,7 +123,8 @@ S7::method(as_rapid, rapid) <- function(x) {
 S7::method(as_rapid, class_list) <- function(x) {
   rlang::try_fetch(
     {
-      .as_class(x, rapid)
+      x <- .as_class(x, rapid)
+      expand_servers(x)
     },
     rapid_error_missing_names = function(cnd) {
       cli::cli_abort(

_pkgdown.yml

@@ -6,6 +6,7 @@ reference:
     contents:
     - rapid
     - as_rapid
+    - expand_servers
   - title: info class
     contents:
     - info

tests/testthat/_snaps/zz-rapid.md

@@ -251,7 +251,7 @@
        .. .. @ format : chr "openapi"
        .. .. @ version: chr "3.0"
        @ servers   : <rapid::servers>
-       .. @ url        : chr "/v1"
+       .. @ url        : chr "https://api.open.fec.gov/v1"
        .. @ description: chr(0) 
        .. @ variables  : <rapid::server_variables>  list()
        @ components: <rapid::component_collection>

tests/testthat/test-absolute_paths.R

@@ -0,0 +1,14 @@
+test_that("expand_servers can expand servers", {
+  # test_url <- "https://api.apis.guru/v2/specs/fec.gov/1.0/openapi.yaml"
+  # input_rapid <- suppressWarnings(as_rapid(url(test_url)))
+  # input_rapid@servers <- servers(
+  #   url = c(input_rapid@servers@url, "https://example.com")
+  # )
+  # saveRDS(input_rapid, test_path("fixtures", "fec_guru_rapid.rds"))
+  input_rapid <- readRDS(test_path("fixtures", "fec_guru_rapid.rds"))
+  output_rapid <- expand_servers(input_rapid)
+  expect_identical(
+    output_rapid@servers@url,
+    c("https://api.open.fec.gov/v1", "https://example.com")
+  )
+})