Merge pull request #26 from coderaanalytics/structures

Structures

DESCRIPTION

@@ -1,11 +1,11 @@
 Package: econdatar
-Title: Automation of time series uploads and downloads from Codera Analytic's econometric data service
-Version: 2.1.0
-Date: 2024-01-18
+Title: Automation of data tasks to and from Codera Analytics' econometric data service
+Version: 3.0.0
+Date: 2024-03-01
 Authors@R: c(person("Byron", "Botha", role = c("aut", "cre"), email = "[email protected]"),
              person("Sebastian", "Krantz", role = "ctb"))
-Description: Automation of time series uploads and downloads to and from www.econdata.co.za.
-Imports: httr, jsonlite, collapse, data.table
+Description: Automation of data tasks to and from Codera Analytics' econometric data service.
+Imports: httr, jsonlite, readODS, collapse, data.table
 Suggests: tcltk
 URL: https://www.econdata.co.za/
 BugReports: https://github.com/coderaanalytics/econdatar/issues

NAMESPACE

@@ -1,14 +1,24 @@
 importFrom("httr", "POST", "GET", "PUT", "accept", "accept_json", "authenticate",
            "content", "content_type", "cookies", "set_cookies", "upload_file")
 importFrom("jsonlite", "fromJSON", "toJSON", "unbox")
+importFrom("readODS", "write_ods", "read_ods")
 importFrom("collapse", "add_vars<-", "ckmatch", "dapply", "fmutate", "fnobs",
            "frename", "get_vars<-", "qDT", "qF", "ss", "unlist2d", "vlabels",
            "vlabels<-")
 importFrom("data.table", "dcast", "rbindlist", "setcolorder")
 importFrom("utils", "sessionInfo")
 
+export(read_dataset)
+export(read_database)
 export(read_econdata)
+export(read_registry)
 export(read_release)
+export(write_dataset)
+export(write_database)
 export(write_econdata)
+export(write_registry)
 export(write_release)
-export(econdata_tidy)
+export(tidy_data)
+S3method(tidy_data,eds_database)
+S3method(tidy_data,eds_dataset)
+S3method(tidy_data,eds_release)

R/get_metadata.R

@@ -1,84 +1,66 @@
 get_metadata <- function(x) {
-
   env <- fromJSON(system.file("settings.json", package = "econdatar"))
 
-
-
   # Fetch data structure definition (metadata) ---
 
-
   attrs <- attr(x, "metadata")
-
   provision_agreement_ref <- paste(attrs[["provision-agreement"]][[2]]$agencyid,
                                    attrs[["provision-agreement"]][[2]]$id,
                                    attrs[["provision-agreement"]][[2]]$version,
                                    sep = "-")
-
   response <- GET(env$registry$url,
                   path = paste(c(env$registry$path,
                                  "provisionagreements",
                                  provision_agreement_ref), collapse = "/"),
                   set_cookies(.cookies = get("econdata_session", envir = .pkgenv)),
                   accept("application/vnd.sdmx-codera.data+json"))
-
-  if (response$status_code != 200)
+  if (response$status_code != 200) {
     stop(content(response, type = "application/json", encoding = "UTF-8"))
-
+  }
   data_message <- content(response, type = "application/json", encoding = "UTF-8")
-
   provision_agreement <- data_message[[2]]$structures[["provision-agreements"]][[1]]
-
   dataflow_ref <- paste(provision_agreement[[2]][["dataflow"]][[2]]$agencyid,
                         provision_agreement[[2]][["dataflow"]][[2]]$id,
                         provision_agreement[[2]][["dataflow"]][[2]]$version,
                         sep = "-") 
-
   response <- GET(env$registry$url,
                   path = paste(c(env$registry$path,
                                  "dataflows",
                                  dataflow_ref), collapse = "/"),
                   set_cookies(.cookies = get("econdata_session", envir = .pkgenv)),
                   accept("application/vnd.sdmx-codera.data+json"))
-
-  if (response$status_code != 200)
+  if (response$status_code != 200) {
     stop(content(response, type = "application/json", encoding = "UTF-8"))
-
+  }
   data_message <- content(response, type = "application/json", encoding = "UTF-8")
-
   dataflow <- data_message[[2]]$structures[["dataflows"]][[1]]
-
   data_structure_ref <- paste(dataflow[[2]][["data-structure"]][[2]]$agencyid,
                               dataflow[[2]][["data-structure"]][[2]]$id,
                               dataflow[[2]][["data-structure"]][[2]]$version,
                               sep = "-") 
-
   response <- GET(env$registry$url,
                   path = paste(c(env$registry$path,
                                  "datastructures",
-                                 dataflow_ref), collapse = "/"),
+                                 data_structure_ref), collapse = "/"),
                   query = list(relations = "references"),
                   set_cookies(.cookies = get("econdata_session", envir = .pkgenv)),
                   accept("application/vnd.sdmx-codera.data+json"))
-
-  if (response$status_code != 200)
+  if (response$status_code != 200) {
     stop(content(response, type = "application/json", encoding = "UTF-8"))
-
+  }
   data_message <- content(response, type = "application/json", encoding = "UTF-8")
-
   data_structure <- data_message[[2]]$structures[["data-structures"]][[1]][[2]]
   concept_schemes <- data_message[[2]]$structures[["concept-schemes"]]
   codelists <- data_message[[2]]$structures[["codelists"]]
 
 
-
   # Compile metadata ---
 
-  metadata <- list()
-
+  concepts <- list()
   for (component in data_structure$components) {
     id <- component[[2]][["concept-identity"]][[2]]
     repr <- component[[2]][["local-representation"]]
-    metadata[[id$id]] <- list(type = component[[1]],
+    concepts[[id$id]] <- list(type = component[[1]],
                               concept = NULL,
                               codelist = NULL)
     for (concept_scheme in concept_schemes) {
@@ -87,7 +69,7 @@ get_metadata <- function(x) {
           id$parentversion == concept_scheme[[2]]$version) {
         for (concept in concept_scheme[[2]]$concepts) {
           if (id$id == concept[[2]]$id) {
-            metadata[[id$id]]$concept <- concept[[2]]
+            concepts[[id$id]]$concept <- concept[[2]]
           }
         }
       }
@@ -97,11 +79,20 @@ get_metadata <- function(x) {
         if (repr[[2]]$agencyid == codelist[[2]]$agencyid &&
             repr[[2]]$id == codelist[[2]]$id &&
             repr[[2]]$version == codelist[[2]]$version) {
-          metadata[[id$id]]$codelist <- codelist[[2]]
+          concepts[[id$id]]$codelist <- codelist[[2]]
         }
       }
     }
   }
-
+  data_provider_ref <- provision_agreement[[2]][["data-provider"]][[2]] |>
+    (function(x) do.call(sprintf, c("%s:%s(%s):%s", x)))(x = _)
+  dataflow_ref <- provision_agreement[[2]][["dataflow"]][[2]] |>
+    (function(x) do.call(sprintf, c("%s:%s(%s)", x)))(x = _)
+  data_structure_ref <- dataflow[[2]][["data-structure"]][[2]] |>
+    (function(x) do.call(sprintf, c("%s:%s(%s)", x)))(x = _)
+  metadata <- list(data_provider_ref = data_provider_ref,
+                   dataflow_ref= dataflow_ref,
+                   data_structure_ref = data_structure_ref,
+                   concepts = concepts)
   return(metadata)
 }