Develop

NAMESPACE

@@ -5,6 +5,7 @@ export(build_ont)
 export(extract_list_edges)
 export(extract_restrictions)
 export(extract_schema_owl)
+export(extract_schema_void)
 export(local_name)
 export(make_display_list)
 export(namespace_of)
@@ -19,3 +20,4 @@ importFrom(dplyr,distinct)
 importFrom(dplyr,filter)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
+importFrom(dplyr,transmute)

R/schema_void.R

@@ -0,0 +1,35 @@
+#' @importFrom dplyr %>% filter transmute distinct
+NULL
+
+
+#' Extract a schema from a VoID dataset description,extracted information
+#'
+#' @param source A SPARQL endpoint URL or a parsed rdflib file.
+#' @return A schema list, see `.empty_schema()`; only `classes` and
+#'   `properties` are populated.
+#' @export
+extract_schema_void <- function(source) {
+  schema <- .empty_schema()
+
+  void_classes <- safe_query(source, '
+    PREFIX void: <http://rdfs.org/ns/void#>
+    SELECT DISTINCT ?class WHERE { [] void:class ?class . }', expected_cols = "class")
+
+  void_props <- safe_query(source, '
+    PREFIX void: <http://rdfs.org/ns/void#>
+    SELECT DISTINCT ?prop WHERE {
+      { [] void:property ?prop } UNION { [] void:linkPredicate ?prop }
+    }', expected_cols = "prop")
+
+  schema$classes <- void_classes %>%
+    filter(!is.na(class), nzchar(class)) %>%
+    transmute(uri = class, label = local_name(class)) %>%
+    distinct(uri, .keep_all = TRUE)
+
+  schema$properties <- void_props %>%
+    filter(!is.na(prop), nzchar(prop)) %>%
+    transmute(property = prop, label = local_name(prop)) %>%
+    distinct(property, .keep_all = TRUE)
+
+  schema
+}

R/utils.R

@@ -44,6 +44,7 @@ local_name <- function(uri) {
 normalize_scheme <- function(x) sub("^https://", "http://", x)
 
 
+
 .empty_schema <- function() {
   list(
     classes = data.frame(uri = character(), label = character(), stringsAsFactors = FALSE),

tests/testthat/test-schema_void.R

@@ -0,0 +1,40 @@
+test_that("extract_schema_void reads void:class/property declarations", {
+  fake_sparql <- function(url, query, timeout = 60) {
+    if (grepl("void:class", query, fixed = TRUE)) {
+      data.frame(class = "http://ex.org/Dataset", stringsAsFactors = FALSE)
+    } else {
+      data.frame(prop = "http://purl.org/dc/terms/title", stringsAsFactors = FALSE)
+    }
+  }
+  testthat::local_mocked_bindings(sparql_query = fake_sparql)
+
+  schema <- extract_schema_void("https://example.org/sparql")
+
+  expect_equal(schema$classes$uri, "http://ex.org/Dataset")
+  expect_equal(schema$classes$label, "Dataset")
+  expect_equal(schema$properties$property, "http://purl.org/dc/terms/title")
+  expect_equal(schema$properties$label, "title")
+})
+
+test_that("extract_schema_void returns empty tables when there is no VoID data", {
+  testthat::local_mocked_bindings(
+    sparql_query = function(url, query, timeout = 60) data.frame()
+  )
+
+  schema <- extract_schema_void("https://example.org/sparql")
+
+  expect_equal(nrow(schema$classes), 0)
+  expect_equal(names(schema$classes), c("uri", "label"))
+  expect_equal(nrow(schema$properties), 0)
+})
+
+test_that("extract_schema_void tolerates a failing endpoint", {
+  testthat::local_mocked_bindings(
+    sparql_query = function(url, query, timeout = 60) stop("timeout")
+  )
+
+  schema <- suppressWarnings(extract_schema_void("https://example.org/sparql"))
+
+  expect_equal(nrow(schema$classes), 0)
+  expect_equal(nrow(schema$properties), 0)
+})