Merge pull request #363 from frictionlessdata/339-Create-upgrade_schema()

Create `upgrade_schema()`

Author: peterdesmet

R/upgrade_descriptor.R

@@ -19,6 +19,7 @@ upgrade_descriptor <- function(package) {
     "https://datapackage.org/profiles/2.0/datapackage.json"
 
   # Set $schema to profile if URL (to custom profile)
+  # https://datapackage.org/standard/data-package/#dollar-schema
   profile <- package$profile %||% "undefined"
   if (is_url(profile)) {
     purrr::pluck(package, "$schema") <- profile
@@ -34,23 +35,16 @@ upgrade_descriptor <- function(package) {
   package$profile <- NULL
 
   # Update contributor "role" = "value" to "roles" = ["value"]
-  contributors <- package$contributors
-  if (!is.null(contributors)) {
-    package$contributors <- purrr::map(
-      contributors,
-      function(contributor) {
-        if ("role" %in% names(contributor)) {
-          purrr::list_modify(
-            contributor,
-            roles = as.list(contributor$role), # Make array
-            role = purrr::zap()
-          )
-        } else {
-          contributor # Return as if contributor does not have role
-        }
-      }
+  # https://datapackage.org/overview/changelog/#packagecontributors-updated
+  package$contributors <- purrr::modify_if(
+    package$contributors,
+    function(x) "role" %in% names(x),
+    function(x) purrr::list_modify(
+      x,
+      roles = character_to_list(x$role),
+      role = purrr::zap()
     )
-  }
+  )
 
   return(package)
 }

R/upgrade_resource.R

@@ -16,7 +16,7 @@ upgrade_resource <- function(resource) {
   purrr::pluck(resource, "$schema") <-
     "https://datapackage.org/profiles/2.0/dataresource.json"
 
-  # Set type to table if resource is tabular, see
+  # Set type to table if resource is tabular
   # https://datapackage.org/standard/data-resource/#type
   profile <- resource$profile %||% "undefined"
   if (profile %in% c(

R/upgrade_schema.R

@@ -0,0 +1,47 @@
+#' Upgrade a Table Schema object from v1 to v2
+#'
+#' @param schema List describing a Table Schema, as returned by [schema()].
+#' @param resource_name Name of the Data Resource, needed for updating
+#'   `foreignKeys`.
+#' @returns Upgraded `schema`.
+#' @family upgrade functions
+#' @noRd
+upgrade_schema <- function(schema, resource_name) {
+  version <- version(schema)
+
+  # Leave schema as is if already 2.0 or higher
+  if (version != "1.0") {
+    return(schema)
+  }
+
+  # Set $schema
+  purrr::pluck(schema, "$schema") <-
+    "https://datapackage.org/profiles/2.0/tableschema.json"
+
+  # Update primaryKey to array
+  # https://datapackage.org/overview/changelog/#schemaprimarykey-updated
+  schema$primaryKey <- character_to_list(schema$primaryKey)
+
+  # Update foreignKeys fields to array and remove self-referential resource
+  # https://datapackage.org/overview/changelog/#schemaforeignkeys-updated
+  schema$foreignKeys <- purrr::modify_if(
+    schema$foreignKeys,
+    is.list,
+    function(x) {
+      if (!is.null(purrr::pluck(x, "fields"))) {
+        x$fields <- character_to_list(x$fields)
+      }
+      if (!is.null(purrr::pluck(x, "reference", "fields"))) {
+        x$reference$fields <- character_to_list(x$reference$fields)
+      }
+      if (!is.null(purrr::pluck(x, "reference", "resource"))) {
+        if (x$reference$resource == resource_name) {
+          x$reference$resource <- NULL
+        }
+      }
+      x
+    }
+  )
+
+  return(schema)
+}

R/utils.R

@@ -43,6 +43,16 @@ clean_list <- function(x, fun = is.null, recursive = FALSE) {
   "[<-"(x, vapply(x, fun, logical(1L)), NULL)
 }
 
+#' Convert character to list
+#'
+#' @param x Value, e.g `"a"`.
+#' @returns List containing value (`list("a")`) if character, otherwise value.
+#' @family helper functions
+#' @noRd
+character_to_list <- function(x) {
+  if (is.character(x)) as.list(x) else x
+}
+
 #' Check if path is URL
 #'
 #' @param path Path.

tests/testthat/test-upgrade_descriptor.R

@@ -30,19 +30,19 @@ test_that("upgrade_descriptor() sets $schema to default v2 value or custom
   p_v1 <- example_package(version = "1.0")
   v2_profile <- "https://datapackage.org/profiles/2.0/datapackage.json"
 
-  # Ignore undefined
+  # Ignore undefined profile
   p_v1$profile <- NULL
   expect_identical(upgrade_descriptor(p_v1)$`$schema`, v2_profile)
 
-  # Ignore default value
+  # Ignore default value profile
   p_v1$profile <- "data-package"
   expect_identical(upgrade_descriptor(p_v1)$`$schema`, v2_profile)
 
-  # Ignore tabular-data-package (deprecated)
+  # Ignore tabular-data-package profile (deprecated)
   p_v1$profile <- "tabular-data-package"
   expect_identical(upgrade_descriptor(p_v1)$`$schema`, v2_profile)
 
-  # Keep fiscal-data-package (but set to URL)
+  # Keep fiscal-data-package profile (but set to URL)
   p_v1$profile <- "fiscal-data-package"
   expect_identical(
     upgrade_descriptor(p_v1)$`$schema`,
@@ -54,7 +54,7 @@ test_that("upgrade_descriptor() sets $schema to default v2 value or custom
   p_v1$profile <- custom_profile_url
   expect_identical(upgrade_descriptor(p_v1)$`$schema`, custom_profile_url)
 
-  # Ignore unregistered value
+  # Ignore unregistered value in profile
   p_v1$profile <- "unregistered-package"
   expect_identical(upgrade_descriptor(p_v1)$`$schema`, v2_profile)
 })
@@ -64,13 +64,14 @@ test_that("upgrade_descriptor() updates contributor role to roles", {
 
   # Defined
   p_v1$contributors <- list(
-    list(title = "First author", role = "author"),
-    list(title = "No role", custom_property = "custom"),
+    list(title = "First author", role = "author", custom = "custom"),
+    list(title = "No role", custom = "custom"),
     list(title = "Jack of all trades", roles = list("a", "b"))
   )
   p_upgraded <- upgrade_descriptor(p_v1)
   expect_identical(p_upgraded$contributors[[1]][["roles"]], list("author")) # Added
   expect_null(p_upgraded$contributors[[1]][["role"]]) # Removed
+  expect_identical(p_upgraded$contributors[[1]][["custom"]], "custom") # Kept
   expect_null(p_upgraded$contributors[[2]][["roles"]]) # Not added
   expect_identical(p_upgraded$contributors[[3]][["roles"]], list("a", "b")) # Kept
 

tests/testthat/test-upgrade_resource.R

@@ -1,5 +1,5 @@
 # Return ----
-test_that("upgrade_descriptor() returns resource object", {
+test_that("upgrade_descriptor() returns a resource object", {
   resource_v1 <- resource(example_package(version = "1.0"), "deployments")
   # Resource object has "data_location" attribute that should be kept
   expect_identical(
@@ -33,23 +33,23 @@ test_that("upgrade_resource() sets $schema to default v2 value", {
   resource_v1 <- resource(example_package(version = "1.0"), "deployments")
   v2_profile <- "https://datapackage.org/profiles/2.0/dataresource.json"
 
-  # Ignore undefined
+  # Ignore undefined profile
   resource_v1$profile <- NULL
   expect_identical(upgrade_resource(resource_v1)$`$schema`, v2_profile)
 
-  # Ignore default value
+  # Ignore default value profile
   resource_v1$profile <- "data-resource"
   expect_identical(upgrade_resource(resource_v1)$`$schema`, v2_profile)
 
-  # Ignore tabular-data-resource (retained in type: table)
+  # Ignore tabular-data-resource profile (retained in type: table)
   resource_v1$profile <- "tabular-data-resource"
   expect_identical(upgrade_resource(resource_v1)$`$schema`, v2_profile)
 
   # Ignore URL to custom profile (hardly used)
   resource_v1$profile <- "http://example.com/my-profiles-json-schema.json"
   expect_identical(upgrade_resource(resource_v1)$`$schema`, v2_profile)
 
-  # Ignore unregistered value
+  # Ignore unregistered value profile
   resource_v1$profile <- "unregistered-resource"
   expect_identical(upgrade_resource(resource_v1)$`$schema`, v2_profile)
 })

tests/testthat/test-upgrade_schema.R

@@ -0,0 +1,99 @@
+# Return ----
+test_that("upgrade_schema() returns a valid schema", {
+  schema_v1 <- schema(example_package(version = "1.0"), "deployments")
+  expect_no_error(check_schema(upgrade_schema(schema_v1, "deployments")))
+})
+
+# Functionality ----
+test_that("upgrade_schema() upgrades a v1 schema to v2", {
+  schema_v1 <- schema(example_package(version = "1.0"), "deployments")
+  expect_identical(version(upgrade_schema(schema_v1, "deployments")), "2.0")
+})
+
+test_that("upgrade_schema() leaves a v2 schema as is", {
+  schema_v2 <- schema(example_package(version = "2.0"), "deployments")
+  expect_identical(upgrade_schema(schema_v2, "deployments"), schema_v2)
+})
+
+test_that("upgrade_schema() sets $schema to default v2 value", {
+  schema_v1 <- schema(example_package(version = "1.0"), "deployments")
+  expect_identical(
+    upgrade_schema(schema_v1, "deployments")$`$schema`,
+    "https://datapackage.org/profiles/2.0/tableschema.json"
+    )
+})
+
+test_that("upgrade_schema() updates primaryKey", {
+  schema_v1 <- schema(example_package(version = "1.0"), "deployments")
+
+  # Update character
+  schema_v1$primaryKey <- "deployment_id"
+  expect_identical(
+    upgrade_schema(schema_v1, "deployments")$primaryKey,
+    list("deployment_id")
+  )
+
+  # Leave undefined
+  schema_v1$primaryKey <- NULL
+  expect_null(upgrade_schema(schema_v1, "deployments")$primaryKey)
+
+  # Leave list
+  schema_v1$primaryKey <- list("deployment_id", "other_id")
+  expect_identical(
+    upgrade_schema(schema_v1, "deployments")$primaryKey,
+    list("deployment_id", "other_id")
+  )
+})
+
+test_that("upgrade_schema() updates foreignKeys", {
+  schema_v1 <- schema(example_package(version = "1.0"), "media")
+  # Media has fk to deployment.deployment_id and observations.observation_id
+
+  # v1 foreignKeys become v2
+  expect_identical(
+    upgrade_schema(schema_v1, "media")$foreignKeys,
+    schema(example_package(version = "2.0"), "media")$foreignKeys,
+  )
+
+  # Leave undefined
+  schema_v1$foreignKeys <- NULL
+  expect_null(upgrade_schema(schema_v1, "media")$foreignKeys)
+
+  # Extensive example
+  provided_keys <- list(
+    fields = "not_in_list", # Ignore
+    list(
+      fields = "media_id", # Update to list
+      custom = "custom", # Ignore
+      reference = list(
+        resource = "media", # Self-referential, remove
+        fields = "media_id", # Update to list
+        custom = "custom" # Ignore
+      )
+    ),
+    list(
+      custom = "custom", # Ignore
+      reference = list(custom = "custom") # Ignore
+    )
+  )
+  expected_keys <- list(
+    fields = "not_in_list",
+    list(
+      fields = list("media_id"),
+      custom = "custom",
+      reference = list(
+        fields = list("media_id"),
+        custom = "custom"
+      )
+    ),
+    list(
+      custom = "custom",
+      reference = list(custom = "custom")
+    )
+  )
+  schema_v1$foreignKeys <- provided_keys
+  expect_identical(
+    upgrade_schema(schema_v1, "media")$foreignKeys,
+    expected_keys
+  )
+})

tests/testthat/test-utils.R

@@ -48,6 +48,15 @@ test_that("clean_list() removes elements from list that match condition", {
   )
 })
 
+# character_to_list() ----
+test_that("character_to_list() converts character to list", {
+  expect_identical(character_to_list("a"), list("a")) # Update
+  expect_identical(character_to_list(c("a", "b")), list("a", "b")) # Update
+  expect_identical(character_to_list(list("a", "b")), list("a", "b")) # Keep
+  expect_identical(character_to_list(1), 1) # Keep
+  expect_null(character_to_list(NULL)) # Keep
+})
+
 # is_url() ----
 test_that("is_url() tests whether path is URL", {
   expect_true(is_url("http://example.com"))