Merge pull request #244 from rOpenGov/development

Development
rOpenGov · Jul 1, 2022 · 12bea91 · 12bea91
2 parents 5f6aefd + f400487
commit 12bea91
Show file tree

Hide file tree

Showing 19 changed files with 568 additions and 214 deletions.
diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
@@ -0,0 +1,32 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master, development]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr
+          needs: coverage
+
+      - name: Test coverage
+        run: covr::codecov(token = Sys.getenv("CODECOV_TOKEN"), quiet = FALSE)
+        shell: Rscript {0}
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,10 +1,11 @@
 Type: Package
 Package: pxweb
 Title: R Interface to PXWEB APIs
-Version: 0.13.1
-Date: 2022-03-10
+Version: 0.15.0
+Date: 2022-07-01
 Authors@R: c(
-    person("Mans", "Magnusson", , "[email protected]", role = c("aut", "cre")),
+    person("Mans", "Magnusson", , "[email protected]", role = c("aut", "cre"),
+           comment = c(ORCID = "0000-0002-0296-2719")),
     person("Markus", "Kainu", role = "aut"),
     person("Janne", "Huovari", role = "aut"),
     person("Leo", "Lahti", role = "aut",
@@ -38,13 +39,14 @@ Imports:
     jsonlite
 Suggests:
     knitr,
+    digest,
     remotes,
     rmarkdown,
     testthat (>= 0.11),
     xml2
 VignetteBuilder: 
     knitr
 Encoding: UTF-8
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.0
 X-schema.org-isPartOf: http://ropengov.org/
 X-schema.org-keywords: ropengov
diff --git a/NAMESPACE b/NAMESPACE
@@ -20,6 +20,7 @@ S3method(pxweb_query,json)
 S3method(pxweb_query,list)
 S3method(pxweb_query,pxweb_explorer)
 S3method(pxweb_query,pxweb_query)
+S3method(pxweb_query,response)
 export(api_catalogue)
 export(api_parameters)
 export(base_url)
@@ -42,6 +43,7 @@ export(pxweb_get_data)
 export(pxweb_interactive)
 export(pxweb_query)
 export(pxweb_query_as_json)
+export(pxweb_query_as_rcode)
 export(pxweb_test_api)
 export(pxweb_validate_query_with_metadata)
 export(update_pxweb_apis)
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,14 @@
+# Version 0.15.0
+
+- Added possibility to download px and sdmx response formats as files
+- Added StatSI API
+- Added codecov code coverage stats
+- Fixed some minor API configs
+
+# Version 0.14.0
+
+- Added feature to print pxweb_query objects to R code
+
 # Version 0.10.4
 
 - Bug fixes

diff --git a/R/pxweb_c.R b/R/pxweb_c.R
@@ -17,6 +17,17 @@ pxweb_c <- function(x){
     return(x)
   }
 
+  if(inherits(x[[1]], "character")) {
+    fp <- unlist(x)
+    fe <- file.exists(fp)
+    if(all(fe)){
+      message("PXWEB API did not return JSON. Files has been stored locally (tempdir) and paths has been returned.")
+      return(x)
+    } else {
+      stop("Files doesn't exist:\n", paste(fp[!fe], collapse = "\n"), call. = FALSE)
+    }
+  }
+
   stop("pxweb_c() not implemented for class '", class(x[[1]])[1], "'.", call. = FALSE)
 }
 

diff --git a/R/pxweb_interactive.R b/R/pxweb_interactive.R
@@ -985,7 +985,7 @@ pxe_print_download_code <- function(pxe, as){
   if(as == "r"){
     cat("# PXWEB query \n")
     q_path <- "pxweb_query_list"
-    cat(pxweb_query_as_rcode(q), sep ="\n")
+    pxweb_query_as_rcode(q)
     cat("\n")
   }
   cat("# Download data \n",

diff --git a/R/pxweb_parse_response.R b/R/pxweb_parse_response.R
@@ -6,7 +6,15 @@
 pxweb_parse_response <- function(x){
   checkmate::assert_class(x, "response")
 
-  obj <- suppressWarnings(httr::content(x, as = "parsed"))
+  pxq <- pxweb_query(x)
+  if(is.null(pxq) || pxq$response %in% c("json", "json-stat")){
+    obj <- suppressWarnings(httr::content(x, as = "parsed"))
+  } else if (pxq$response %in% pxweb_file_response_formats()){
+    obj <- suppressWarnings(httr::content(x, as = "raw"))
+    obj_path <- file.path(tempdir(), paste0(digest::sha1(obj), ".", pxq$response))
+    writeBin(con = obj_path, object = obj)
+    return(obj_path)
+  }
 
   try_obj <- try(pxweb_database_list(obj), silent = TRUE)
   if(!inherits(try_obj, "try-error")) {

diff --git a/R/pxweb_query.R b/R/pxweb_query.R
@@ -6,16 +6,20 @@
 #'
 #' @param x an object to cast as a pxweb_query object.
 #' 
+#' @seealso \code{\link{pxweb_query_as_json}}, \code{\link{pxweb_query_as_rcode}}
+#' 
 #' @examples 
 #' dims <- list(Alue = c("*"),
 #'              "Asuntokunnan koko" = c("*"),
 #'              Talotyyppi = c("S"),
 #'              Vuosi = c("*"))
 #' pxq1 <- pxweb_query(dims)
+#' 
 #' json_query <- file.path(system.file(package = "pxweb"), 
 #'                         "extdata", "examples", "json_query_example.json")
 #' pxq2 <- pxweb_query(json_query)
 #' 
+#' 
 #' @export
 pxweb_query <- function(x){
   UseMethod("pxweb_query")
@@ -31,15 +35,22 @@ pxweb_query.character <- function(x){
   }
   class(obj) <- c("pxweb_query", "list")
   assert_pxweb_query(obj, check_response_format = FALSE)
-  if(tolower(obj$response$format) %in% c("json-stat", "jsonstat")){
-    obj$response$format <- "json-stat"
+  if(tolower(obj$response$format) == "json"){
+    obj$response$format <- "json"
+  } else if (tolower(obj$response$format) %in% c("json-stat", "jsonstat")){
+    obj$response$format <- "json-stat"    
+  } else if (tolower(obj$response$format) %in% pxweb_file_response_formats()){
+
   } else {
-    obj$response$format <- "json"    
+    warning(paste0("'", obj$response$format, "' is not a valid query response format, set to 'json'."))
+    obj$response$format <- "json"
   }
   assert_pxweb_query(obj)
   obj
 }
 
+pxweb_file_response_formats <- function() c("px", "sdmx")
+
 #' @rdname pxweb_query
 #' @keywords internal
 #' @export
@@ -74,6 +85,15 @@ pxweb_query.list <- function(x){
   obj
 }
 
+#' @rdname pxweb_query
+#' @keywords internal
+#' @export
+pxweb_query.response <- function(x){
+  if(is.null(x$request$options$postfields)) return(NULL)
+  pxweb_query(x = readBin(x$request$options$postfields, what = "character"))
+}
+
+
 #' @rdname pxweb_query
 #' @keywords internal
 #' @export
@@ -106,9 +126,9 @@ assert_pxweb_query <- function(x, check_response_format = TRUE){
   checkmate::assert_names(names(x), must.include = c("query", "response"), .var.name = "names(pxweb_query)")
   checkmate::assert_names(names(x$response), must.include = c("format"))
   if(check_response_format){
-    checkmate::assert_choice(x$response$format, c("json", "json-stat"))
+    checkmate::assert_choice(x$response$format, c("json", "json-stat", pxweb_file_response_formats()))
   }
-
+  
 
   checkmate::assert_named(x$query, "unnamed")
   for(i in seq_along(x$query)){
@@ -318,6 +338,8 @@ pxweb_query_filter <- function(pxq){
 #' @param pxq a \code{pxweb_query} object.
 #' @param ... further argument to \code{jsonlite::toJSON()}.
 #' 
+#' @seealso \code{\link{pxweb_query}}, \code{\link{pxweb_query_as_rcode}}
+#' 
 #' @examples 
 #' json_query <- file.path(system.file(package = "pxweb"), 
 #'                         "extdata", "examples", "json_query_example.json")
@@ -335,10 +357,13 @@ pxweb_query_as_json <- function(pxq, ...){
   jsonlite::toJSON(pxq, ...)
 }
 
-#' Convert a \code{pxweb_query} object to R code
-#' @details One element per row is returned.
+#' Print a \code{pxweb_query} object as R code
+#' 
 #' @param pxq a \code{pxweb_query} object.
-#' @keywords internal
+#' 
+#' @seealso \code{\link{pxweb_query_as_json}}, \code{\link{pxweb_query}}
+#' 
+#' @export
 pxweb_query_as_rcode <- function(pxq){
   checkmate::assert_class(pxq, "pxweb_query")
 
@@ -356,6 +381,6 @@ pxweb_query_as_rcode <- function(pxq){
     res[-length(res)] <- paste0(res[-length(res)], ",")
   }
   res <- c("pxweb_query_list <- ", res)
-
-  res
+  cat(res, sep ="\n")
+  invisible(res)
 }
diff --git a/README.Rmd b/README.Rmd
@@ -15,7 +15,7 @@ knitr::opts_chunk$set(
 <!-- badges: start -->
 [![rOG-badge](https://ropengov.github.io/rogtemplate/reference/figures/ropengov-badge.svg)](http://ropengov.org/)
   [![R build status](https://github.com/rOpenGov/pxweb/workflows/R-CMD-check/badge.svg)](https://github.com/rOpenGov/pxweb/actions)
-[![Coverage Status](https://coveralls.io/repos/github/rOpenGov/pxweb/badge.svg?branch=master)](https://coveralls.io/github/rOpenGov/pxweb?branch=master)
+[![codecov](https://codecov.io/gh/rOpenGov/pxweb/branch/master/graph/badge.svg?token=zYtxsus27g)](https://codecov.io/gh/rOpenGov/pxweb)
 [![Downloads](http://cranlogs.r-pkg.org/badges/grand-total/pxweb)](https://cran.r-project.org/package=pxweb)
 [![Downloads](http://cranlogs.r-pkg.org/badges/pxweb)](https://cran.r-project.org/package=pxweb)
 [![Gitter](https://badges.gitter.im/rOpenGov/pxweb.svg)](https://gitter.im/rOpenGov/pxweb?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge)

diff --git a/README.md b/README.md
@@ -3,8 +3,7 @@
 [![rOG-badge](https://ropengov.github.io/rogtemplate/reference/figures/ropengov-badge.svg)](http://ropengov.org/)
 [![R build
 status](https://github.com/rOpenGov/pxweb/workflows/R-CMD-check/badge.svg)](https://github.com/rOpenGov/pxweb/actions)
-[![Coverage
-Status](https://coveralls.io/repos/github/rOpenGov/pxweb/badge.svg?branch=master)](https://coveralls.io/github/rOpenGov/pxweb?branch=master)
+[![codecov](https://codecov.io/gh/rOpenGov/pxweb/branch/master/graph/badge.svg?token=zYtxsus27g)](https://codecov.io/gh/rOpenGov/pxweb)
 [![Downloads](http://cranlogs.r-pkg.org/badges/grand-total/pxweb)](https://cran.r-project.org/package=pxweb)
 [![Downloads](http://cranlogs.r-pkg.org/badges/pxweb)](https://cran.r-project.org/package=pxweb)
 [![Gitter](https://badges.gitter.im/rOpenGov/pxweb.svg)](https://gitter.im/rOpenGov/pxweb?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge)

diff --git a/inst/extdata/api.json b/inst/extdata/api.json
@@ -26,7 +26,7 @@
         "lang": ["en","fi","sv"],
         "calls_per_period": 20,
         "period_in_seconds": 10,
-        "max_values_to_download" : 100000
+        "max_values_to_download" : 120000
               },
 
     "pxwebapi2.stat.fi": {
@@ -400,6 +400,20 @@
         "lang": ["en"],
         "calls_per_period": 100,
         "period_in_seconds": 10,
+        "max_values_to_download" : 1000
+    },
+
+    "pxweb.stat.si": {
+        "description" : "SiStat Database",
+        "citation" : {
+          "organization" : "Statistical Office of the Republic of Slovenia",
+          "address" : "Ljubljana, Slovenia"
+          },
+        "url" : "https://pxweb.stat.si/SiStatData/api/[version]/[lang]/Data",
+        "version": ["v1"],
+        "lang": ["sl"],
+        "calls_per_period": 10,
+        "period_in_seconds": 10,
         "max_values_to_download" : 1000000
     }
   },

diff --git a/man/pxweb_query.Rd b/man/pxweb_query.Rd
diff --git a/man/pxweb_query_as_json.Rd b/man/pxweb_query_as_json.Rd
diff --git a/man/pxweb_query_as_rcode.Rd b/man/pxweb_query_as_rcode.Rd