Paths for FEC (#47)

* Update FEC rapid.

* Generalize paths for FEC.

Security + missing data.

NAMESPACE

@@ -10,6 +10,7 @@ importFrom(S7,class_list)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_warn)
 importFrom(desc,desc)
+importFrom(dplyr,coalesce)
 importFrom(dplyr,filter)
 importFrom(fs,file_delete)
 importFrom(fs,file_exists)
@@ -25,7 +26,8 @@ importFrom(lubridate,now)
 importFrom(lubridate,parse_date_time)
 importFrom(nectar,call_api)
 importFrom(nectar,stabilize_string)
-importFrom(purrr,imap_chr)
+importFrom(purrr,discard)
+importFrom(purrr,imap)
 importFrom(purrr,list_rbind)
 importFrom(purrr,map)
 importFrom(purrr,map2)
@@ -44,7 +46,9 @@ importFrom(rlang,try_fetch)
 importFrom(rprojroot,find_package_root_file)
 importFrom(snakecase,to_snake_case)
 importFrom(stringr,str_remove)
+importFrom(stringr,str_replace_all)
 importFrom(stringr,str_squish)
+importFrom(stringr,str_to_sentence)
 importFrom(styler,style_file)
 importFrom(testthat,test_that)
 importFrom(tibble,as_tibble)

R/beekeeper-package.R

@@ -5,6 +5,7 @@
 #' @importFrom cli cli_abort
 #' @importFrom cli cli_warn
 #' @importFrom desc desc
+#' @importFrom dplyr coalesce
 #' @importFrom dplyr filter
 #' @importFrom fs file_delete
 #' @importFrom fs file_exists
@@ -20,7 +21,8 @@
 #' @importFrom lubridate parse_date_time
 #' @importFrom nectar call_api
 #' @importFrom nectar stabilize_string
-#' @importFrom purrr imap_chr
+#' @importFrom purrr discard
+#' @importFrom purrr imap
 #' @importFrom purrr list_rbind
 #' @importFrom purrr map
 #' @importFrom purrr map_chr
@@ -42,7 +44,9 @@
 #' @importFrom S7 class_list
 #' @importFrom snakecase to_snake_case
 #' @importFrom stringr str_remove
+#' @importFrom stringr str_replace_all
 #' @importFrom stringr str_squish
+#' @importFrom stringr str_to_sentence
 #' @importFrom styler style_file
 #' @importFrom testthat test_that
 #' @importFrom tibble as_tibble

R/generate_pkg-paths.R

@@ -19,49 +19,7 @@
   return(paths_file_paths)
 }
 
-.generate_paths_files <- function(paths_by_tag, api_abbr, security_data) {
-  paths_file_paths <- imap_chr(
-    paths_by_tag,
-    function(path_tag, path_tag_name) {
-      .generate_paths_file(path_tag, path_tag_name, api_abbr, security_data)
-    }
-  )
-  paths_test_paths <- imap_chr(
-    paths_by_tag,
-    function(path_tag, path_tag_name) {
-      .generate_paths_test_file(path_tag, path_tag_name, api_abbr)
-    }
-  )
-  return(c(unname(paths_file_paths), unname(paths_test_paths)))
-}
-
-.generate_paths_file <- function(path_tag,
-                                 path_tag_name,
-                                 api_abbr,
-                                 security_data) {
-  .bk_use_template(
-    template = "paths.R",
-    data = list(
-      paths = path_tag,
-      api_abbr = api_abbr,
-      security_data = security_data
-    ),
-    target = glue("paths-{path_tag_name}.R")
-  )
-}
-
-.generate_paths_test_file <- function(path_tag, path_tag_name, api_abbr) {
-  .bk_use_template(
-    template = "test-paths.R",
-    data = list(
-      paths = path_tag,
-      tag = path_tag_name,
-      api_abbr = api_abbr
-    ),
-    dir = "tests/testthat",
-    target = glue("test-paths-{path_tag_name}.R")
-  )
-}
+# reshape data -----------------------------------------------------------------
 
 S7::method(as_bk_data, class_paths) <- function(x) {
   if (!length(x)) {
@@ -81,6 +39,7 @@ S7::method(as_bk_data, class_paths) <- function(x) {
   )
 }
 
+## to tag list -----------------------------------------------------------------
 .paths_to_tag_list <- function(paths_tags_df) {
   set_names(
     map(
@@ -94,50 +53,91 @@ S7::method(as_bk_data, class_paths) <- function(x) {
 .paths_endpoints_to_lists <- function(endpoints) {
   pmap(
     list(
-      operation_id = endpoints$operation_id,
+      operation_id = .paths_fill_operation_id(
+        endpoints$operation_id,
+        endpoints$endpoint,
+        endpoints$operation
+      ),
       path = endpoints$endpoint,
-      summary = endpoints$summary,
-      description = endpoints$description,
-      params = endpoints$parameters
+      summary = .paths_fill_summary(
+        endpoints$summary,
+        endpoints$endpoint,
+        endpoints$operation
+      ),
+      description = str_squish(endpoints$description),
+      params_df = endpoints$parameters
     ),
     .paths_endpoint_to_list
   )
 }
 
+### fill data ------------------------------------------------------------------
+
+.paths_fill_operation_id <- function(operation_id, endpoint, method) {
+  coalesce(.to_snake(operation_id), glue("{method}_{.to_snake(endpoint)}"))
+}
+
+.paths_fill_summary <- function(summary, endpoint, method) {
+  endpoint_spaced <- str_replace_all(.to_snake(endpoint), "_", " ")
+  coalesce(
+    str_squish(summary),
+    str_to_sentence(glue("{method} {endpoint_spaced}"))
+  )
+}
+
+### create whisker data --------------------------------------------------------
+
 .paths_endpoint_to_list <- function(operation_id,
                                     path,
                                     summary,
                                     description,
-                                    params) {
-  params_df <- .flatten_df(params)
-  params <- .paths_params_to_list(params_df)
-  endpoint_list <- list(
-    operation_id = .to_snake(operation_id),
-    path = .path_as_arg(path, params_df),
-    summary = str_squish(summary),
-    description = str_squish(description),
-    params = params
+                                    params_df) {
+  params_df <- .prepare_paths_df(params_df)
+  return(
+    list(
+      operation_id = operation_id,
+      path = .path_as_arg(path, params_df),
+      summary = summary,
+      description = description,
+      params = .params_to_list(params_df),
+      params_query = .extract_params_type(params_df, "query"),
+      params_header = .extract_params_type(params_df, "header"),
+      params_cookie = .extract_params_type(params_df, "cookie")
+    )
   )
-  endpoint_list$args <- .collapse_comma(params_df$name)
-  endpoint_list$test_args <- endpoint_list$args
-  return(endpoint_list)
 }
 
-.paths_params_to_list <- function(params) {
-  if (!nrow(params)) {
+.prepare_paths_df <- function(params_df) {
+  params_df <- .flatten_df(params_df)
+  if (nrow(params_df)) {
+    params_df <- filter(params_df, !.data$deprecated)
+    params_df$description <- .paths_fill_descriptions(params_df$description)
+  }
+  return(params_df)
+}
+
+.params_to_list <- function(params_df) {
+  if (!nrow(params_df)) {
     return(list())
   }
   # TODO: Deal with all the available data.
   params <- pmap(
     list(
-      name = params$name,
-      description = .paths_fill_descriptions(params$description)
+      name = params_df$name,
+      description = params_df$description
     ),
     .paths_param_to_list
   )
   return(params)
 }
 
+.extract_params_type <- function(params_df, filter_in) {
+  if (!nrow(params_df)) {
+    return(character())
+  }
+  return(params_df$name[params_df$`in` == filter_in])
+}
+
 .paths_fill_descriptions <- function(descriptions) {
   descriptions[is.na(descriptions)] <- "BKTODO: No description provided."
   return(str_squish(descriptions))
@@ -154,7 +154,103 @@ S7::method(as_bk_data, class_paths) <- function(x) {
   if (!nrow(params_df) || !any(params_df$`in` == "path")) {
     return(glue('"{path}"'))
   }
-  params_in <- params_df$name[params_df$`in` == "path"]
-  params <- .collapse_comma(glue("{params_in} = {params_in}"))
+  params_path <- params_df$name[params_df$`in` == "path"]
+  params <- .collapse_comma_self_equal(params_path)
   return(glue('c("{path}", {params})'))
 }
+
+.collapse_comma_self_equal <- function(x) {
+  .collapse_comma(glue("{x} = {x}"))
+}
+
+# generate files ----------------------------------------------------------
+
+.generate_paths_files <- function(paths_by_tag, api_abbr, security_data) {
+  unlist(imap(
+    paths_by_tag,
+    function(path_tag, path_tag_name) {
+      .generate_paths_tag_files(
+        path_tag,
+        path_tag_name,
+        api_abbr,
+        security_data
+      )
+    }
+  ))
+}
+
+.generate_paths_tag_files <- function(path_tag,
+                                      path_tag_name,
+                                      api_abbr,
+                                      security_data) {
+  path_tag <- .prepare_path_tag(
+    path_tag,
+    security_data$security_arg_names
+  )
+  file_path <- .generate_paths_file(
+    path_tag,
+    path_tag_name,
+    api_abbr,
+    security_data
+  )
+  test_path <- .generate_paths_test_file(path_tag, path_tag_name, api_abbr)
+  return(c(unname(file_path), unname(test_path)))
+}
+
+.prepare_path_tag <- function(path_tag, security_args) {
+  path_tag <- map(
+    path_tag,
+    function(path) {
+      path$params <- .remove_security_args(path$params, security_args)
+      path$params_cookie <- .prep_param_args(path$params_cookie, security_args)
+      path$params_header <- .prep_param_args(path$params_header, security_args)
+      path$params_query <- .prep_param_args(path$params_query, security_args)
+      path$args <- .collapse_comma(map_chr(path$params, "name"))
+      path$test_args <- path$args
+      return(path)
+    }
+  )
+}
+
+.remove_security_args <- function(params, security_args) {
+  discard(
+    params,
+    function(param) {
+      param$name %in% security_args
+    }
+  )
+}
+
+.prep_param_args <- function(params, security_args) {
+  .collapse_comma_self_equal(setdiff(params, security_args)) %|"|% character()
+}
+
+.generate_paths_file <- function(path_tag,
+                                 path_tag_name,
+                                 api_abbr,
+                                 security_data) {
+  .bk_use_template(
+    template = "paths.R",
+    data = list(
+      paths = path_tag,
+      api_abbr = api_abbr,
+      has_security = security_data$has_security,
+      security_signature = security_data$security_signature,
+      security_arg_list = security_data$security_arg_list
+    ),
+    target = glue("paths-{path_tag_name}.R")
+  )
+}
+
+.generate_paths_test_file <- function(path_tag, path_tag_name, api_abbr) {
+  .bk_use_template(
+    template = "test-paths.R",
+    data = list(
+      paths = path_tag,
+      tag = path_tag_name,
+      api_abbr = api_abbr
+    ),
+    dir = "tests/testthat",
+    target = glue("test-paths-{path_tag_name}.R")
+  )
+}

R/utils.R

@@ -6,6 +6,14 @@
   }
 }
 
+`%|"|%` <- function(x, y) {
+  if (!nzchar(x)) {
+    y
+  } else {
+    x
+  }
+}
+
 .collapse_comma <- function(x) {
   glue_collapse(x, sep = ", ")
 }

inst/templates/paths.R

@@ -14,7 +14,10 @@
 #' @export
 {{api_abbr}}_{{operation_id}} <- function({{{args}}}{{{security_signature}}}) {
   {{api_abbr}}_call_api(
-    path = {{{path}}}
+    path = {{{path}}}{{#has_security}},
+    {{security_arg_list}}{{/has_security}}{{#params_query}},
+    query = list({{params_query}}){{/params_query}}{{#params_header}},
+    body = list({{params_header}}){{/params_header}}
   )
 }