1.0.5dev

DESCRIPTION

@@ -1,10 +1,10 @@
 Package: Rapi
 Type: Package
 Title: Interface for Multiple Data Providers 'EDDS' and 'FRED'
-Version: 1.0.4
-Date: 2024-02-19
+Version: 1.0.5
+Date: 2024-04-06
 Authors@R: c(
-    person("Sermet", "Pekin", , "sermetpekin@gmail.com", role = c("aut", "cre" , "cph"))
+    person("Sermet", "Pekin", , "sermet.pekin@gmail.com", role = c("aut", "cre" , "cph"))
   )
 Maintainer: Sermet Pekin <[email protected]>
 URL: https://github.com/DataRapi/Rapi, https://DataRapi.github.io/Rapi/

NEWS.md

@@ -1,3 +1,6 @@
+# Rapi 1.0.5
+* Moved key parameter to the header for the source `EVDS`.
+
 # Rapi 1.0.4
 * Deleted a few development related verbose functions.
 

R/01_sp_utils.R

@@ -1,4 +1,3 @@
-
 get_hash <- function(n = 50) {
   a <- do.call(paste0, replicate(3, sample(LETTERS, n, TRUE), FALSE))
   paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
@@ -59,7 +58,6 @@ assign_ <- function(name, data) {
 hash_func <- function(v) {
   g <- paste0(v, collapse = "_")
   digest::digest(g)
-
 }
 
 g <- glue::glue

R/RcppExports.R

@@ -2,18 +2,17 @@
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
 as_tibblex <- function(df) {
-    .Call(`_Rapi_as_tibblex`, df)
+  .Call(`_Rapi_as_tibblex`, df)
 }
 
 lag_df_c <- function(df2, lag_list) {
-    .Call(`_Rapi_lag_df_c`, df2, lag_list)
+  .Call(`_Rapi_lag_df_c`, df2, lag_list)
 }
 
 lag_df2_c <- function(df2, lag_list) {
-    .Call(`_Rapi_lag_df2_c`, df2, lag_list)
+  .Call(`_Rapi_lag_df2_c`, df2, lag_list)
 }
 
 remove_column_cpp <- function(df, column) {
-    .Call(`_Rapi_remove_column_cpp`, df, column)
+  .Call(`_Rapi_remove_column_cpp`, df, column)
 }
-

R/evds_forward.R

@@ -14,18 +14,26 @@ create_evds_url <- function(type = c(
     api_key_evds <- get_api_key("evds")
   }
   g <- glue::glue
+
+  # liste <- list(
+  #   subject = g("{domain}/categories/key={api_key_evds}&type=json"),
+  #   datagroups = g("{domain}/datagroups/key={api_key_evds}&mode=2&code={subject_num}&type=json"),
+  #   info_api = g("{domain}/serieList/key={api_key_evds}&type=json&code={table_name}")
+  # )
+
   liste <- list(
-    subject = g("{domain}/categories/key={api_key_evds}&type=json"),
-    datagroups = g("{domain}/datagroups/key={api_key_evds}&mode=2&code={subject_num}&type=json"),
-    info_api = g("{domain}/serieList/key={api_key_evds}&type=json&code={table_name}")
+    subject = g("{domain}/categories/type=json"),
+    datagroups = g("{domain}/datagroups/mode=2&code={subject_num}&type=json"),
+    info_api = g("{domain}/serieList/type=json&code={table_name}")
   )
+
   liste[[type]]
 }
 
 get_evds_table_names_with_subject_num <- function(subject_num = 5,
                                                   cache = F) {
   url <- create_evds_url("datagroups", subject_num)
-  response <- request_httr2_helper(url, cache)
+  response <- request_httr2_helper_evds(url, cache)
   if (!is_response(response)) {
     return(false)
   }
@@ -38,7 +46,7 @@ get_evds_table_names_with_subject_num <- function(subject_num = 5,
 # ....................................................... get_evds_table_info_api
 get_evds_subject_list_api <- function(cache = T) {
   url <- create_evds_url("subject")
-  response <- request_httr2_helper(url, cache)
+  response <- request_httr2_helper_evds(url, cache)
   if (!is_response(response)) {
     return(false)
   }

R/evds_table_api.R

@@ -86,7 +86,7 @@ get_evds_table_info_api <- function(table_name = "bie_altingr", cache = T) {
   url <- create_evds_url("info_api",
     table_name = table_name
   )
-  gelen <- request_httr2_helper(url, cache)
+  gelen <- request_httr2_helper_evds(url, cache)
   if (!is_response(gelen)) {
     return(false)
   }

R/excel_internal.R

@@ -43,12 +43,10 @@ excel_internal <- function(
     return(invisible(1))
   }
   if (!inherits(dfs, "list") && !inherits(dfs, "data.frame")) {
-
     message_func("excel function requires data.frame or list of data.frames(1)")
     return(invisible(1))
   }
   if (!len(dfs)) {
-
     message_func("excel function requires data.frame or list of data.frames(2)")
     return(invisible(2))
   }

R/generics.R

@@ -55,6 +55,7 @@ combine_df <- function(x, ...) {
   df
 }
 combine_dfs_by_date2 <- function(liste) {
+
   combined <- NULL
   for (item in liste) {
     item2 <- item
@@ -116,7 +117,7 @@ get_data_all <- function(x) {
 
       DATA <- post_process_data_main(DATA, x)
 
-      if (is.null(DATA)) {
+      if (is.null(DATA) || isFALSE(DATA)) {
         data.[[row]] <- "null"
       } else {
         data.[[row]] <- DATA

R/internal_evds.R

@@ -1,6 +1,6 @@
 quick_check_evds <- function(key = "..") {
   url <- create_evds_url("subject", key = key)
-  gelen <- request_httr2_helper(url, cache = F)
+  gelen <- request_httr2_helper_evds(url, cache = F)
   if (!is_response(gelen)) {
     return(false)
   }

R/post_process_data.R

@@ -1,5 +1,5 @@
 limit_years_of_data <- function(.data, dots_params) {
-  if (is.null(.data)) {
+  if (is.null(.data)|| isFALSE(.data)) {
     return(null)
   }
 

R/request_funcs.R

@@ -12,8 +12,9 @@ request_httr <- function(currentObj) {
 }
 request_httr2 <- function(currentObj) {
   # evds
+  Rapi_env$currentObj <- currentObj
   url <- createUrlForSeries(currentObj)
-  request_httr2_helper(url, currentObj$cache)
+  request_httr2_helper_evds(url, currentObj$cache)
 }
 seriesCollapse <- function(liste) {
   names_ <- names(liste)
@@ -86,7 +87,7 @@ get_freq_number_evds <- function(freq) {
       m = "month",
       y = "year",
       q = "quarter",
-      w = "week" ,
+      w = "week",
       "null" = "day"
     ) # series will default to most freq possible so
     # null should be the most frequent
@@ -107,7 +108,6 @@ get_freq_number_evds <- function(freq) {
   freq_u
 }
 check_freq_only_evds_series <- function(currentObj, urlParts) {
-
   .base <- toString(attr(urlParts$series, "base"))
   .source <- toString(attr(urlParts$series, "source"))
   if (!(is_(.base, "series") && is_(.source, "evds"))) {
@@ -137,23 +137,25 @@ createUrlForSeries <- function(currentObj) {
   urlParts <- currentObj$series_fnc(prop_value)
   # freq is not needed in table ones only series of evds
   urlParts <- check_freq_only_evds_series(currentObj, urlParts) # side effect start date will be checked
+
+
+  Rapi_env$urlParts <- urlParts
+
   urlParts <- check_series_ID_for_dots(currentObj, urlParts) # replace '_' , '.'
+
+  urlParts$key <- null
   paste0(
     currentObj$url,
     currentObj$observations_url,
     seriesCollapse(urlParts)
   )
 }
-# ...................................................... request_httr2_helper
-request_httr2_helper <- function(url, cache = TRUE) {
 
-  cache_name <- cache_name_format("request_httr2_helper", url)
-  check <- check_cache_comp(cache_name, cache)
-  if (check) {
-    return(load_cache(cache_name))
-  }
-  # check if vector
-  check_url_for_request(url)
+
+
+
+
+req_version_1_no_header <- function(url) {
   # ..................... 1
   req <- try_or_default(
     {
@@ -168,6 +170,75 @@ request_httr2_helper <- function(url, cache = TRUE) {
     },
     .default = null
   )
+  return(inv(resp))
+}
+
+req_version_2_w_header <- function(url) {
+  # currently only EVDS request uses this version due to header policy change
+  # TODO generalize if new source being added
+  api_key <- get_api_key("evds")
+
+  req <- httr2::request(url)
+  req <- req |> httr2::req_headers(key = api_key)
+
+  # req |> httr2::req_dry_run()
+    suppressWarnings({
+        resp <- try_or_default(
+            {
+                req |> httr2::req_perform()
+            },
+            .default = null
+        )
+
+    })
+
+  return(inv(resp))
+}
+# request_with_param <- function(url) {
+#   api_key <- get_api_key("evds")
+#   req <- httr2::request(url)
+#   req <- req |> httr2::req_headers(Bearer = api_key)
+#
+#   req |> httr2::req_dry_run()
+#   response <- req |> httr2::req_perform()
+#
+#   return(response)
+# }
+
+# ...................................................... request_httr2_helper
+request_httr2_helper_evds <- function(url, cache = TRUE) {
+  cache_name <- cache_name_format("request_httr2_helper_evds", url)
+  check <- check_cache_comp(cache_name, cache)
+  if (check) {
+    return(load_cache(cache_name))
+  }
+  # check if vector
+  check_url_for_request(url)
+  Rapi_env$last_req_url <- url
+
+  # resp <- req_version_1_no_header(url) # with no Param
+  resp <- req_version_2_w_header(url) # with PARAM
+
+  if (is_response(resp)) {
+    save_cache(cache_name, resp)
+  }
+  inv(resp)
+}
+
+# ...................................................... request_httr2_helper
+request_httr2_helper <- function(url, cache = TRUE) {
+  cache_name <- cache_name_format("request_httr2_helper", url)
+  check <- check_cache_comp(cache_name, cache)
+  if (check) {
+    return(load_cache(cache_name))
+  }
+  # check if vector
+  check_url_for_request(url)
+  Rapi_env$last_req_url <- url
+
+  resp <- req_version_1_no_header(url)
+
+
   if (is_response(resp)) {
     save_cache(cache_name, resp)
   }

R/response_evds.R

@@ -10,7 +10,6 @@ getLineEvdsResponse <- function(item) {
   list(date = unix_time, value = value)
 }
 getLineEvdsResponse_patch_week <- function(item) {
-
   # $Tarih
   # [1] "06-01-1950"
   #
@@ -48,7 +47,6 @@ getLineEvdsResponse2 <- function(item) {
   new_list
 }
 getLineEvdsResponse3 <- function(item) {
-
   # snames<- names_[ names_[c("Tarih" , "UNIXTIME")]  ]
   names_ <- names(item)
   yliste <- list()
@@ -79,8 +77,6 @@ getLineEvdsResponse3 <- function(item) {
 }
 #
 convert_list_df_evds <- function(items, strategy = getLineEvdsResponse) {
-
-
   lines_ <- null
 
   make_df_local <- function(line) {

R/response_funcs.R

@@ -8,7 +8,6 @@ response_fnc_fred <- function(gelen, currentObj) {
   structure(result, series_code = currentObj$seriesID)
 }
 response_fnc_evds <- function(gelen, currentObj) {
-
   contentList <- gelen %>% httr2::resp_body_json()
   convert_list_df_evds(contentList$items)
 }
@@ -19,9 +18,8 @@ convert_list_df_general <- function(response_list) {
     if (is.null(lines_)) {
       lines_ <- as.data.frame(line)
     } else {
-
       try({
-        lines_ <- rbind_safe(lines_,  as.data.frame(line) )
+        lines_ <- rbind_safe(lines_, as.data.frame(line))
       })
     }
   }

R/sp_df_utils.R

@@ -108,6 +108,8 @@ safe_remove_col <- function(df, colname) {
   df %>% dplyr::select(-c(!!colname))
 }
 df_check_remove <- function(df, verbose = FALSE) {
+
+ if(!is.data.frame(df )) return (df )
   first_row <- first_row_that_ok(df)
   last_row <- last_row_that_ok(df)
   if (any(purrr::map_vec(c(first_row, last_row), is.na))) {