Testthat

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: STATcubeR
 Title: R interface for the STATcube REST API and Open Government Data
-Version: 0.5.0
+Version: 0.5.1
 Authors@R: c(
     person("Gregor", "de Cillia", , "[email protected]", role = c("aut", "cre")),
     person("Bernhard", "Meindl", , "[email protected]", role = "ctb"),
@@ -14,17 +14,24 @@ Description: Import data from the STATcube REST API or from the open data
 License: GPL (>= 2)
 URL: https://statistikat.github.io/STATcubeR,
     https://github.com/statistikat/STATcubeR
+BugReports: https://github.com/statistikat/STATcubeR/issues
 Imports: 
     cli (>= 3.4.1),
     httr,
     jsonlite,
-    magrittr
-Suggests: 
+    magrittr,
+    pillar (>= 1.5.0),
+    vctrs
+Suggests:
+    spelling, 
     data.tree,
-    pillar,
     rappdirs,
-    xml2
+    xml2,
+    testthat (>= 3.0.0),
+    httptest
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
+Language: en-US
+Config/testthat/edition: 3

NAMESPACE

@@ -2,16 +2,27 @@
 
 S3method(as.character,od_json)
 S3method(as.character,sc_json)
+S3method(as.character,sc_schema_uri)
 S3method(as.data.frame,sc_data)
+S3method(format,pillar_shaft_ogd_file)
+S3method(format,sc_schema_uri)
+S3method(pillar_shaft,ogd_file)
+S3method(pillar_shaft,sc_dttm)
+S3method(pillar_shaft,sc_schema_type)
+S3method(pillar_shaft,sc_schema_uri)
 S3method(print,od_cache_file)
 S3method(print,od_json)
 S3method(print,od_revisions)
 S3method(print,od_table)
 S3method(print,sc_rate_limit_table)
 S3method(print,sc_schema)
+S3method(print,sc_schema_flatten)
 S3method(print,sc_table)
 S3method(print,sc_tibble_meta)
 S3method(print,sc_url)
+S3method(tbl_format_footer,sc_meta)
+S3method(tbl_sum,sc_meta)
+S3method(tbl_sum,sc_tibble)
 export("%>%")
 export(od_cache_clear)
 export(od_cache_dir)
@@ -53,6 +64,7 @@ export(sc_last_error_parsed)
 export(sc_rate_limit_schema)
 export(sc_rate_limit_table)
 export(sc_rate_limits)
+export(sc_recode)
 export(sc_schema)
 export(sc_schema_catalogue)
 export(sc_schema_db)
@@ -65,3 +77,6 @@ export(sc_tabulate)
 importFrom(magrittr,"%<>%")
 importFrom(magrittr,"%>%")
 importFrom(magrittr,"%T>%")
+importFrom(pillar,pillar_shaft)
+importFrom(pillar,tbl_format_footer)
+importFrom(pillar,tbl_sum)

NEWS.md

@@ -1,3 +1,12 @@
+# STATcubeR 0.6.0
+
+* Update print methods with the `{tibble}` package (#32)
+* Add filters and other recodes to `sc_table_custom()` (#33)
+* Add global option `STATcubeR.language` to override the default language
+* `od_table()`: Add descriptions to `x$header` and `x$field(i)`
+* Depend on cli >= 3.4.1 (@matmo, #35)
+* Allow json strings in `sc_table()` (@matmo, #36)
+
 # STATcubeR 0.5.0
 
 * adapt `od_list()` to data.statistik.at update ([`2249b66`](https://github.com/statistikat/STATcubeR/commit/2249b6607cb822a4aac56c6258cbe967832171f1))
@@ -38,7 +47,7 @@
 * Allow recodes of `sc_data` objects (#17)
 * Better parsing of time variables (#15, #16)
 * Use bootstrap 5  and `{pkgdown}` 2.0.0 for the website
-* Allow export and import of open data using tar archves (#20)
+* Allow export and import of open data using tar archives (#20)
 
 # STATcubeR 0.2.4
 
@@ -85,7 +94,7 @@ This version finalizes #11
 https://data.statistik.gv.at/
 
 * new class `od_table` to get OGD data
-* methods to tabulate reponses
+* methods to tabulate responses
 * caching
 * four new pkgdown articles for `od_table()`, `od_list()`, `od_resource()` and `sc_data`
 

R/browse.R

@@ -14,7 +14,7 @@ sc_browse <- function(server = "ext") {
   sc_url(sc_url_gui(server), "home")
 }
 
-#' @describeIn sc_browse opens the preference menu with the api key
+#' @describeIn sc_browse opens the preference menu with the API key
 #' @examples
 #' sc_browse_preferences()
 #' @export
@@ -75,7 +75,7 @@ in_stat <- function() {
 }
 
 sc_url_gui <- function(server = "ext") {
-  if (server == "ext" && !in_stat())
+  if (server == "ext" && (!in_stat() || Sys.getenv("NOT_CRAN") != ""))
     return("https://portal.statistik.at/statistik.at/ext/statcube/")
   if (server == "test")
     return("http://sdbtest:8081/statistik.at/wdev/statcube/")

R/cache.R

@@ -10,7 +10,7 @@
 #' Caching can be set up using environment variables. To set up a persistent cache
 #' for both Open Data and the REST API, the following lines in `.Renviron` can
 #' be used.
-#' The paths in this example are only applicalble for UNIX-based operating systems.
+#' The paths in this example are only applicable for UNIX-based operating systems.
 #'
 #' ```sh
 #' STATCUBE_KEY_EXT   = YOUR_API_KEY_GOES_HERE
@@ -23,7 +23,7 @@
 #' Caching is not implemented for the
 #' endpoints [sc_info()] and [sc_rate_limit_table()].
 #' @rdname sc_cache
-#' @param verbose print instuctions on how to set up caching persistently
+#' @param verbose print instructions on how to set up caching persistently
 #'   via environment variables?
 #' @name sc_cache
 NULL
@@ -49,14 +49,14 @@ sc_cache_disable <- function() {
   Sys.unsetenv("STATCUBE_CACHE")
 }
 
-#' @describeIn sc_cache informs wether the cache is currently enabled
+#' @describeIn sc_cache informs whether the cache is currently enabled
 #' @export
 sc_cache_enabled <- function() {
   Sys.getenv("STATCUBE_CACHE") != ""
 }
 
 #' @export
-#' @param dir a chace directory
+#' @param dir a cache directory
 #' @describeIn sc_cache get/set the directory used for caching
 sc_cache_dir <- function(dir = NULL) {
   if (is.null(dir))

R/error.R

@@ -1,15 +1,15 @@
 #' Error handling for the STATcube REST API
 #'
 #' @description
-#' In case API requests are unsuccessfull, `STATcubeR` will throw errors
+#' In case API requests are unsuccessful, `STATcubeR` will throw errors
 #' to summarize the httr error type and its meaning.
-#' Requests are considered unsuccessfull if one of the following applies
+#' Requests are considered unsuccessful if one of the following applies
 #' * The response returns `TRUE` for `httr::http_error()`.
 #' * The response is not of type `"application/json"`
 #'
 #' In some cases it is useful to get direct access to a faulty response object.
 #' For that purpose, it is possible to use [sc_last_error()] which will provide
-#' the httr response object for the last unsuccessfull request.
+#' the httr response object for the last unsuccessful request.
 #' @return The return value from `httr::GET()` or `httr::POST()`.
 #' @examplesIf sc_key_exists()
 #' try(sc_table_saved("invalid_id"))

R/key.R

@@ -48,7 +48,7 @@ sc_key_set <- function(key, server = "ext", test = TRUE) {
 #'   an error is thrown.
 #' @export
 sc_key_get <- function(server = "ext") {
-  if (!sc_key_exists())
+  if (!sc_key_exists(server))
     stop("No STATcube key available. Set key with sc_key_set()")
   invisible(Sys.getenv(sc_key_env_var(server)))
 }

R/od_cache.R

@@ -15,7 +15,7 @@
 #' od_downloads()
 #' @details
 #' [od_cache_summary()] provides an overview of all contents of the cache through
-#' a data.frame. It hasone row for each dataset and the following columns.
+#' a data.frame. It has one row for each dataset and the following columns.
 #' All file sizes are given in bytes
 #' - **`id`** the dataset id
 #' - **`updated`** the last modified time for `${id}.json`
@@ -39,7 +39,7 @@ od_cache_summary <- function(server = "ext") {
   field <- substr(files[is_field], 1 + pos_underscore[is_field], nchar(files[is_field]) - 4)
   id <- substr(files[is_field], 1, pos_underscore[is_field] - 1)
   sizes_fields <- file.size(file.path(od_cache_dir(), files[is_field])) %>% split(id) %>% sapply(sum)
-  fields <- data.frame(id, field, stringsAsFactors = FALSE)
+  fields <- list(id = id, field = field)
 
   files <- files[!is_field]
   pos_underscore <- as.integer(gregexpr("_HEADER", files))
@@ -48,17 +48,18 @@ od_cache_summary <- function(server = "ext") {
   files <- files[!is_header]
   id_data <- substr(files, 1, nchar(files) - 4)
   all_ids <- unique(c(id_data, id_header, fields$id))
-  data.frame(
-    id = all_ids,
+  res <- data_frame(
+    id = all_ids %>% `class<-`(c("ogd_id", "character")),
     updated = file.mtime(paste0(cache_dir, all_ids, ".json")),
     json = file.size(paste0(cache_dir, all_ids, ".json")),
     data = file.size(paste0(cache_dir, all_ids, ".csv")),
     header = file.size(paste0(cache_dir, all_ids, "_HEADER.csv")),
     fields = sizes_fields[match(unique(fields$id), all_ids)],
     n_fields = match(fields$id, all_ids) %>% factor(seq_along(all_ids)) %>%
-      table() %>% as.integer(),
-    row.names = NULL, stringsAsFactors = FALSE
-  ) %>% `class<-`(c("tbl", "data.frame"))
+      table() %>% as.integer()
+  )
+  class(res$updated) <- c("sc_dttm", class(res$updated))
+  res
 }
 
 

R/od_list.R

@@ -3,7 +3,7 @@
 #' [od_list()] returns a `data.frame ` containing all datasets published at
 #' [data.statistik.gv.at](https://data.statistik.gv.at)
 #'
-#' @param unique some datasets are pulbished under multiple groups.
+#' @param unique some datasets are published under multiple groups.
 #'   They will only be listed once with the first group they appear in unless
 #'   this parameter is set to `FALSE`.
 #' @param server the open data server to use. Either `ext` for the external
@@ -43,11 +43,10 @@ od_list <- function(unique = TRUE, server = c("ext", "red")) {
     xml2::xml_find_all(".//a")
 
   # ids
-  df <- data.frame(
-    category = "NA",
+  df <- data_frame(
+    category = rep("NA", length(el)),
     id = el %>% xml2::xml_attr("aria-label"),
-    label = el %>% xml2::xml_text(),
-    stringsAsFactors = FALSE
+    label = el %>% xml2::xml_text()
   )
 
   ignored_labels <- c("[Alle \u00f6ffnen]", "[Alle schlie\u00dfen]",
@@ -67,7 +66,9 @@ od_list <- function(unique = TRUE, server = c("ext", "red")) {
   df <- df[!(df$id %in% od_resource_blacklist), ]
   rownames(df) <- NULL
   attr(df, "od") <- r$times[["total"]]
-  df %>% `class<-`(c("tbl", "data.frame"))
+  class(df$id) <- c("ogd_id", "character")
+  class(df) <- c("tbl_df", class(df))
+  df
 }
 
 #' Get a catalogue for OGD datasets
@@ -95,7 +96,7 @@ od_list <- function(unique = TRUE, server = c("ext", "red")) {
 #' |json      |`list<od_json>`| Full json metadata
 #'
 #' The type `datetime` refers to the `POSIXct` format as returned by [Sys.time()].
-#' The last column `"json"` containes the full json metadata as returned by
+#' The last column `"json"` contains the full json metadata as returned by
 #' [od_json()].
 #'
 #' @inheritParams od_table
@@ -120,7 +121,15 @@ od_catalogue <- function(server = "ext", local = TRUE) {
     ids <- od_revisions(server = server)
   }
   timestamp <- switch(as.character(local), "TRUE" = NULL, "FALSE" = Sys.time())
-  jsons <- lapply(ids, od_json, timestamp, server)
+  jsons <- lapply(
+    cli::cli_progress_along(
+      ids, type = "tasks", "downloading json metadata files"),
+    function(i) {
+      od_json(ids[i], timestamp, server)
+    }
+  )
+  if (!local)
+    cli::cli_text("\rDownloaded {.field {length(ids)}} metadata files with {.fn od_json}")
   as_df_jsons(jsons)
 }
 
@@ -130,7 +139,7 @@ as_df_jsons <- function(jsons) {
   }
 
   descs <- sapply(jsons, function(x) x$extras$attribute_description) %>% paste0(";", .)
-  out <- data.frame(
+  out <- data_frame(
     title = sapply(jsons, function(x) x$title),
     measures = gregexpr(";F-", descs) %>% sapply(length),
     fields = gregexpr(";C-", descs) %>% sapply(length),
@@ -145,12 +154,11 @@ as_df_jsons <- function(jsons) {
     update_frequency = sapply(jsons, function(x) x$extras$update_frequency),
     tags = I(lapply(jsons, function(x) unlist(x$tags))),
     categorization = sapply(jsons, function(x) unlist(x$extras$categorization[1])),
-    json = I(jsons),
-    stringsAsFactors = FALSE
+    json = I(jsons)
   )
   out$modified <- parse_time(out$modified)
   out$created <- parse_time(out$created)
-  class(out) <- c("tbl", class(out))
+  class(out$id) <- c("ogd_id", "character")
   out
 }
 

R/od_resource.R

@@ -141,15 +141,14 @@ od_resource_parse_all <- function(resources, server = "ext") {
   })
   od <- lapply(parsed, attr, "od")
 
-  data.frame(
+  data_frame(
     name = sapply(resources, function(x) x$name),
     last_modified = lapply(od, function(x) x$last_modified) %>% do.call(c, .),
     cached = lapply(od, function(x) x$cached) %>% do.call(c, .),
     size = sapply(od, function(x) x$size),
     download = vapply(od, function(x) x$download, 1.0),
     parsed = sapply(od, function(x) x$parsed),
-    data = I(parsed %>% lapply(`attr<-`, "od", NULL)),
-    stringsAsFactors = FALSE
+    data = I(parsed %>% lapply(`attr<-`, "od", NULL))
   )
 }
 
@@ -171,9 +170,9 @@ od_resources_check <- function(json) {
 
 od_normalize_columns <- function(x, suffix) {
   if (!is.null(suffix)) {
-    col_indices <- c(1, 2, 2, switch(suffix, HEADER = 3, c(4, 3)))
+    col_indices <- c(1, 2, 2, switch(suffix, HEADER = 3, c(4, 3)), 5, 7)
     col_names <- c("code", "label", "label_de", "label_en",
-                   switch(suffix, HEADER = NULL, "parent"))
+                   switch(suffix, HEADER = NULL, "parent"), "de_desc", "en_desc")
     x <- x[, col_indices] %>% `names<-`(col_names)
     x$label <- NA_character_
     x$label_en <- as.character(x$label_en)
@@ -224,5 +223,8 @@ od_resource_all <- function(id, json = od_json(id), server = "ext") {
   check_header(out$data[[2]])
   out$data[[2]] %<>% od_normalize_columns("HEADER")
   out$data[seq(3, nrow(out))] %<>% lapply(od_normalize_columns, "FIELD")
-  out %>% `class<-`(c("tbl", "data.frame"))
+  class(out$name) <- c("ogd_file", "character")
+  class(out$last_modified) <- c("sc_dttm", class(out$last_modified))
+  class(out$cached) <- c("sc_dttm", class(out$cached))
+  out
 }

R/od_revisions.R

@@ -3,15 +3,15 @@
 #' Use the `/revision` endpoint of the OGD server to get a list
 #' of all datasets that have changed since a certain timestamp.
 #' @param since (optional) A timestamp. If supplied, only datasets updated
-#'   later will be returned. Otherwise, all datasets are retured.
+#'   later will be returned. Otherwise, all datasets are returned.
 #'   Can be in either one of the following formats
 #'   * a native R time type that is compatible with `strftime()`
 #'     such as the return values of `Sys.Date()`, `Sys.time()` and `file.mtime()`.
 #'   * a string of the form `YYYY-MM-DD` to specify a day.
 #'   * a string of the form `YYYY-MM-DDThh:mm:ss` to specify a day and a time.
 #' @param exclude_ext If `TRUE` (default) exclude all results that have
 #'   `OGDEXT_` as a prefix
-#' @return a character verctor with dataset ids
+#' @return a character vector with dataset ids
 #' @inheritParams od_list
 #' @examples
 #' # get all datasets (including OGDEXT_*)
@@ -41,15 +41,15 @@ print.od_revisions <- function(x, ...) {
   since <- attr(x, "since")
   response <- attr(x, "response")
   if (!is.null(since))
-    cli::cli_text("{.strong {length(x)}} changes between
+    cli::format_inline("{.strong {length(x)}} changes between
                 {.timestamp {attr(x, 'since')}} and
-                {.timestamp {response$date}}")
+                {.timestamp {response$date}}") %>% cat()
   else
-    cli::cli_text("{.strong {length(x)}} datasets are available
-                ({.timestamp {response$date}})")
+    cli::format_inline("{.strong {length(x)}} datasets are available ",
+                "({.timestamp {response$date}})\n") %>% cat()
   if (length(x) > 0) {
     y <- cli::cli_vec(x, list("vec-trunc" = 3))
-    cli::cli_text("{.strong ids}: {.emph {y}}")
+    cli::format_inline("{.strong ids}: {.emph {y}}") %>% cat()
   }
   invisible(x)
 }