Merge pull request #343 from bcgov/update-catalogue

Update catalogue. Closes #342

.github/workflows/R-CMD-check.yaml

@@ -29,7 +29,7 @@ jobs:
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
-      BCDC_KEY: ${{ secrets.BCDC_KEY }}
+      # BCDC_KEY: ${{ secrets.BCDC_KEY }}
       BCDC_TEST_RECORD: ${{ secrets.BCDC_TEST_RECORD }}
 
     steps:

DESCRIPTION

@@ -62,7 +62,7 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1.9000
+RoxygenNote: 7.3.2
 Collate: 
     'bcdata-package.R'
     'bcdc-get-citation.R'

NEWS.md

@@ -5,6 +5,7 @@
   `local()` for local functions more restrictive; updated tests
   and examples (#341).
 * Deprecate the `bcdata.single_download_limit` option, as it was mostly redundant with `bcdata.chunk_limit`, and should always be set by the server. Please set the page size limit for paginated requests via the `bcdata.chunk_limit` option (#332)
+* Updated internals to adapt to changes in B.C. Data Catalogue (#342m, #343)
 
 # bcdata 0.4.1
 

R/bcdc-get-citation.R

@@ -93,8 +93,8 @@ bcdc_get_citation.bcdc_record <- function(record) {
 }
 
 clean_org_name <- function(rec) {
-  name <- jsonlite::fromJSON(rec$contacts)$name
+  name <- vapply(rec$contacts, function(x) x$name, FUN.VALUE = character(1))
   name <- trimws(name)
   name <- paste0(name, collapse = ", ")
-  sub(",([^,]*)$", " &\\1", name)
+  gsub(",([^,]*)$", " &\\1", name)
 }

R/bcdc_search.R

@@ -14,7 +14,7 @@
 #'
 #' @param facet the facet(s) for which to retrieve valid values. Can be one or
 #' more of:
-#'  `"license_id", "download_audience", "res_format", "sector", "organization", "groups"`
+#'  `"license_id", "download_audience", "res_format", "publish_state", "organization", "groups"`
 #'
 #' @return A data frame of values for the selected facet
 #' @export
@@ -30,7 +30,7 @@
 #' )
 #' }
 bcdc_search_facets <- function(facet = c("license_id", "download_audience",
-                                  "res_format", "sector",
+                                  "res_format", "publish_state",
                                   "organization", "groups")) {
   if(!has_internet()) stop("No access to internet", call. = FALSE) # nocov
 

R/describe-feature.R

@@ -125,14 +125,14 @@ feature_helper <- function(whse_name){
   xml_df
 }
 
-
-
 obj_desc_join <- function(record) {
   stopifnot(inherits(record, "bcdc_record"))
 
   wfs_resource <- get_wfs_resource_from_record(record)
   whse_name <- wfs_resource$object_name
-  wfs_df <- jsonlite::fromJSON(wfs_resource$details)
+  wfs_df <- purrr::list_rbind(
+    purrr::map(wfs_resource$details, as.data.frame)
+  )
 
   dplyr::left_join(
     feature_helper(whse_name),

R/utils.R

@@ -148,8 +148,10 @@ bcdc_auth <- function() {
 ## Check if there is internet
 ## h/t to https://github.com/ropensci/handlr/blob/pluralize/tests/testthat/helper-handlr.R
 has_internet <- function() {
-  z <- try(suppressWarnings(readLines('https://www.google.com', n = 1)),
-           silent = TRUE)
+  z <- try(
+    suppressWarnings(readLines('https://www.google.com', n = 1)),
+    silent = TRUE
+  )
   !inherits(z, "try-error")
 }
 
@@ -285,13 +287,15 @@ read_from_url <- function(resource, ...){
           fun$package, " package.")
   handle_excel(tmp, ...)
 
-  tryCatch(do.call(fun$fun, list(tmp, ...)),
-           error = function(e) {
-             stop("Reading the data set failed with the following error message:\n\n  ", e,
-                  "\nThe file can be found here:\n  '",
-                  tmp, "'\nif you would like to try to read it manually.\n",
-                  call. = FALSE)
-           })
+tryCatch(
+  do.call(fun$fun, list(tmp, ...)),
+  error = function(e) {
+    stop("Reading the data set failed with the following error message:\n\n  ", e,
+    "\nThe file can be found here:\n  '",
+    tmp, "'\nif you would like to try to read it manually.\n",
+    call. = FALSE)
+  }
+)
 }
 
 
@@ -305,11 +309,11 @@ resource_to_tibble <- function(x){
     package_id = safe_map_chr(x, "package_id"),
     location = simplify_string(safe_map_chr(x, "resource_storage_location"))
   )
-
-  mutate(res_df,
-         wfs_available = wfs_available(res_df),
-         bcdata_available = wfs_available | other_format_available(res_df))
-}
+  
+  dplyr::mutate(res_df,
+    wfs_available = wfs_available(res_df),
+    bcdata_available = wfs_available | other_format_available(res_df))
+  }
 
 #' @importFrom rlang "%||%"
 safe_map_chr <- function(x, name) {
@@ -329,10 +333,13 @@ pagination_sort_col <- function(cols_df) {
     if (idcol %in% cols) return(idcol)
   }
   #Otherwise use the first column - this is likely pretty fragile
-  warning("Unable to find a suitable column to sort on for pagination. Using",
-          " the first column (", cols[1],
-          "). Please check your data for obvious duplicated or missing rows.",
-          call. = FALSE)
+  warning(
+    "Unable to find a suitable column to sort on for pagination. Using",
+    " the first column (",
+    cols[1],
+    "). Please check your data for obvious duplicated or missing rows.",
+    call. = FALSE
+  )
   cols[1]
 }
 
@@ -348,11 +355,15 @@ handle_zip <- function(x) {
   files <- list_supported_files(dir)
   # check if it's a shapefile
 
-  if (length(files) > 1L) {
-    stop("More than one supported file in zip file. It has been downloaded and ",
-         "extracted to '", dir, "', where you can access its contents manually.",
-         call. = FALSE)
-  }
+if (length(files) > 1L) {
+  stop(
+    "More than one supported file in zip file. It has been downloaded and ",
+    "extracted to '",
+    dir,
+    "', where you can access its contents manually.",
+    call. = FALSE
+  )
+}
 
   files
 }

tests/testthat/test-bcdc-get-citation.R

@@ -16,6 +16,6 @@ test_that("bcdc_get_citation take a character and returns a bibentry",{
   rec <- bcdc_get_record(point_record)
   expect_s3_class(bcdc_get_citation(rec), c("citation", "bibentry"))
   expect_s3_class(bcdc_get_citation(point_record), c("citation", "bibentry"))
-  test_url <- paste0("https://catalogue.data.gov.bc.ca/dataset/", point_record)
+  test_url <- glue::glue("{catalogue_base_url()}/dataset/{point_record}")
   expect_s3_class(bcdc_get_citation(test_url), c("citation", "bibentry"))
 })