Generate request-argument validation and casting from OAS format mappings in path templates, with conditional stbl imports

R/generate_pkg-paths.R

@@ -120,6 +120,7 @@ S7::method(as_bk_data, class_paths) <- function(x) {
       params_df$allowEmptyValue,
       params_df$required
     )
+    params_df$to_r <- .param_schema_to_r(params_df$schema)
     params_df$description <- .paths_fill_descriptions(
       params_df$description,
       params_df$schema$description
@@ -146,10 +147,11 @@ S7::method(as_bk_data, class_paths) <- function(x) {
     list(
       name = params_df$name,
       class = params_df$class,
-      description = params_df$description
+      description = params_df$description,
+      to_r = params_df$to_r
     ),
-    function(name, class, description) {
-      list(name = name, class = class, description = description)
+    function(name, class, description, to_r) {
+      list(name = name, class = class, description = description, to_r = to_r)
     }
   )
 }
@@ -182,6 +184,15 @@ S7::method(as_bk_data, class_paths) <- function(x) {
   return(.compile_param_class_descriptions(type, allow_empty, required))
 }
 
+.param_schema_to_r <- function(params_schema) {
+  type <- dplyr::left_join(
+    dplyr::select(params_schema, "type", "format"),
+    dplyr::select(oas_format_registry, "type", "format", "to_r"),
+    by = c("type", "format")
+  )
+  type$to_r
+}
+
 .compile_param_class_descriptions <- function(type, allow_empty, required) {
   r_class_descriptions <- glue::glue("length-1 `{type$r_class_name}`") |>
     .paste0_if(
@@ -227,6 +238,7 @@ S7::method(as_bk_data, class_paths) <- function(x) {
     params_cookie <- .prep_param_args(op$params_cookie_raw, security_arg_names)
     args <- .params_to_args(params)
     args_named <- .params_to_named_args(params)
+    validations <- .params_to_validations(params)
     c(
       op,
       list(
@@ -236,7 +248,8 @@ S7::method(as_bk_data, class_paths) <- function(x) {
         params_cookie = params_cookie,
         args = args,
         args_named = args_named,
-        test_args = args
+        test_args = args,
+        validations = validations
       )
     )
   })
@@ -279,6 +292,34 @@ S7::method(as_bk_data, class_paths) <- function(x) {
   .collapse_comma_self_equal(setdiff(params, security_args)) %|"|% character()
 }
 
+.params_to_validations <- function(params) {
+  checks <- purrr::keep(
+    params,
+    function(param) {
+      !is.null(param$to_r) &&
+        !is.na(param$to_r) &&
+        !startsWith(param$to_r, "todo_")
+    }
+  )
+  purrr::map(
+    checks,
+    function(param) {
+      list(name = param$name, to_r = param$to_r)
+    }
+  )
+}
+
+.paths_need_stbl <- function(paths, security_arg_names = character()) {
+  ops <- as_bk_data(paths)
+  if (!length(ops)) {
+    return(FALSE)
+  }
+  any(purrr::map_lgl(ops, function(op) {
+    params <- .remove_security_args(op$params, security_arg_names)
+    length(.params_to_validations(params)) > 0
+  }))
+}
+
 .generate_paths_file <- function(
   path_operation,
   operation_id,

R/generate_pkg-setup.R

@@ -54,13 +54,16 @@
   )
 }
 
-.setup_r <- function(pkg_dir) {
+.setup_r <- function(pkg_dir, include_stbl = FALSE) {
   if (as.character(pkg_dir) != ".") {
     usethis::local_project(pkg_dir, quiet = TRUE) # nocov
   }
   use_directory("R")
   use_testthat()
   purrr::quietly(use_httptest2)()
   use_package("nectar")
+  if (include_stbl) {
+    use_package("stbl")
+  }
   use_package("beekeeper", type = "Suggests")
 }

R/generate_pkg.R

@@ -23,16 +23,23 @@ generate_pkg <- function(
   .assert_is_pkg(pkg_dir)
   config <- .read_config(config_file)
   api_definition <- .read_api_definition(pkg_dir, config$rapid_file)
-  .setup_r(pkg_dir)
-  touched_files <- .generate_pkg_impl(config, api_definition)
-  return(invisible(touched_files))
-}
-
-.generate_pkg_impl <- function(config, api_definition) {
   security_data <- .generate_security(
     config$api_abbr,
     api_definition@components@security_schemes
   )
+  security_arg_names <- security_data$security_arg_names %|0|% character()
+  .setup_r(
+    pkg_dir,
+    include_stbl = .paths_need_stbl(
+      api_definition@paths,
+      security_arg_names
+    )
+  )
+  touched_files <- .generate_pkg_impl(config, api_definition, security_data)
+  return(invisible(touched_files))
+}
+
+.generate_pkg_impl <- function(config, api_definition, security_data) {
   prep_files <- .generate_prepare(config, api_definition, security_data)
   pagination_data <- .generate_pagination()
   path_files <- .generate_paths(

inst/templates/paths.R

@@ -24,6 +24,9 @@
 #' @rdname {{api_abbr}}_{{operation_id}}
 #' @returns `req_{{api_abbr}}_{{operation_id}}()`: A `httr2_request` request object.
 req_{{api_abbr}}_{{operation_id}} <- function({{#args}}{{{args}}}{{/args}}{{#has_security}}{{#args}}, {{/args}}{{{security_signature}}}{{/has_security}}) {
+{{#validations}}
+  {{name}} <- stbl::{{to_r}}({{name}})
+{{/validations}}
   {{api_abbr}}_req_prepare(
     path = {{{path}}},
     method = "{{method}}"{{#has_security}},

tests/testthat/_fixtures/guru/paths-apis-get_api.R

@@ -25,6 +25,8 @@ guru_get_api <- function(provider, api, max_reqs = Inf, max_tries_per_req = 3) {
 #' @rdname guru_get_api
 #' @returns `req_guru_get_api()`: A `httr2_request` request object.
 req_guru_get_api <- function(provider, api) {
+  provider <- stbl::to_chr_scalar(provider)
+  api <- stbl::to_chr_scalar(api)
   guru_req_prepare(
     path = c("/specs/{provider}/{api}.json", provider = provider, api = api),
     method = "get"

tests/testthat/_fixtures/guru/paths-apis-get_provider.R

@@ -24,6 +24,7 @@ guru_get_provider <- function(provider, max_reqs = Inf, max_tries_per_req = 3) {
 #' @rdname guru_get_provider
 #' @returns `req_guru_get_provider()`: A `httr2_request` request object.
 req_guru_get_provider <- function(provider) {
+  provider <- stbl::to_chr_scalar(provider)
   guru_req_prepare(
     path = c("/{provider}.json", provider = provider),
     method = "get"

tests/testthat/_fixtures/guru/paths-apis-get_service_api.R

@@ -26,6 +26,9 @@ guru_get_service_api <- function(provider, service, api, max_reqs = Inf, max_tri
 #' @rdname guru_get_service_api
 #' @returns `req_guru_get_service_api()`: A `httr2_request` request object.
 req_guru_get_service_api <- function(provider, service, api) {
+  provider <- stbl::to_chr_scalar(provider)
+  service <- stbl::to_chr_scalar(service)
+  api <- stbl::to_chr_scalar(api)
   guru_req_prepare(
     path = c("/specs/{provider}/{service}/{api}.json", provider = provider, service = service, api = api),
     method = "get"

tests/testthat/_fixtures/guru/paths-apis-get_services.R

@@ -24,6 +24,7 @@ guru_get_services <- function(provider, max_reqs = Inf, max_tries_per_req = 3) {
 #' @rdname guru_get_services
 #' @returns `req_guru_get_services()`: A `httr2_request` request object.
 req_guru_get_services <- function(provider) {
+  provider <- stbl::to_chr_scalar(provider)
   guru_req_prepare(
     path = c("/{provider}/services.json", provider = provider),
     method = "get"

tests/testthat/_fixtures/header_cookie/paths-things-search_things.R

@@ -26,6 +26,9 @@ test_search_things <- function(x_auth_token, session_id, q, max_reqs = Inf, max_
 #' @rdname test_search_things
 #' @returns `req_test_search_things()`: A `httr2_request` request object.
 req_test_search_things <- function(x_auth_token, session_id, q) {
+  x_auth_token <- stbl::to_chr_scalar(x_auth_token)
+  session_id <- stbl::to_chr_scalar(session_id)
+  q <- stbl::to_chr_scalar(q)
   test_req_prepare(
     path = "/things",
     method = "get",

tests/testthat/test-generate_pkg-paths.R

@@ -258,7 +258,39 @@ test_that(".compile_param_class_descriptions() uses class names (#85)", {
   )
 })
 
-test_that(".generate_paths_file() renders header and cookie params correctly (#84)", {
+test_that(".params_to_validations() only includes supported checks (#69)", {
+  params <- list(
+    list(name = "q", to_r = "to_chr_scalar"),
+    list(name = "from", to_r = "todo_to_date_scalar"),
+    list(name = "x", to_r = NA_character_)
+  )
+
+  expect_identical(
+    .params_to_validations(params),
+    list(list(name = "q", to_r = "to_chr_scalar"))
+  )
+})
+
+test_that(".paths_need_stbl() flags actionable validations (#69)", {
+  api_definition_true <- readRDS(test_path(
+    "_fixtures",
+    "guru",
+    "_beekeeper_rapid.rds"
+  ))
+
+  expect_true(
+    .paths_need_stbl(
+      api_definition_true@paths,
+      character()
+    )
+  )
+})
+
+test_that(".paths_need_stbl() returns FALSE for empty paths (#69)", {
+  expect_false(.paths_need_stbl(rapid::class_paths(), character()))
+})
+
+test_that(".generate_paths_file() renders header and cookie params correctly (#84, #69)", {
   skip_on_cran()
   expected_content <- readLines(
     test_path("_fixtures", "header_cookie", "paths-things-search_things.R")
@@ -278,24 +310,32 @@ test_that(".generate_paths_file() renders header and cookie params correctly (#8
       list(
         name = "x_auth_token",
         class = "length-1 `character`",
-        description = "Authentication token"
+        description = "Authentication token",
+        to_r = "to_chr_scalar"
       ),
       list(
         name = "session_id",
         class = "length-1 `character`",
-        description = "Session identifier"
+        description = "Session identifier",
+        to_r = "to_chr_scalar"
       ),
       list(
         name = "q",
         class = "length-1 `character`",
-        description = "Search query"
+        description = "Search query",
+        to_r = "to_chr_scalar"
       )
     ),
     params_query = "q = q",
     params_header = "x_auth_token = x_auth_token",
     params_cookie = "session_id = session_id",
     args = "x_auth_token, session_id, q",
     args_named = "x_auth_token = x_auth_token, session_id = session_id, q = q",
+    validations = list(
+      list(name = "x_auth_token", to_r = "to_chr_scalar"),
+      list(name = "session_id", to_r = "to_chr_scalar"),
+      list(name = "q", to_r = "to_chr_scalar")
+    ),
     test_args = "x_auth_token, session_id, q",
     pagination = FALSE,
     pagination_fn = ""

tests/testthat/test-generate_pkg-setup.R

@@ -53,3 +53,15 @@ test_that(".setup_r() sets up dependencies", {
     "testthat"
   )
 })
+
+test_that(".setup_r() can include stbl in imports (#69)", {
+  skip_on_cran()
+
+  create_local_package()
+  .setup_r(".", include_stbl = TRUE)
+
+  dependencies <- desc::desc()$get_deps()
+  imports <- dependencies$package[dependencies$type == "Imports"]
+  expect_contains(imports, "nectar")
+  expect_contains(imports, "stbl")
+})