fix(R): Fix checking of property types

Also removes unused functions

r/R/typing.R

@@ -63,7 +63,6 @@ print.Union <- function(x) { # nolint
   print(format(x)) # nocov
 }
 
-
 #' An enumeration
 #' @export
 Enum <- function(...) {
@@ -92,17 +91,6 @@ is_class <- function(value, clas) {
   last_class(value) == clas
 }
 
-#' Get the type of a node
-node_type <- function(node) {
-  if (inherits(node, "Entity")) node$type
-  else last_class(node)
-}
-
-#' Is the node an `Entity`?
-is_entity <- function(node) {
-  inherits(node, "Entity")
-}
-
 #' Does a value conform to the type?
 is_type <- function(value, type) { # nolint
   type_class <- last_class(type)
@@ -116,7 +104,7 @@ is_type <- function(value, type) { # nolint
   } else if (type_class == "Any") {
     TRUE
   } else if (type_class == "Array") {
-    if (is.null(value) || is_entity(value)) {
+    if (is.null(value) || inherits(value, "Entity")) {
       # Not array-like
       FALSE
     } else if (is.list(value)) {
@@ -134,7 +122,7 @@ is_type <- function(value, type) { # nolint
       # Factors are valid Array("character")
       is_type(character(), type$items)
     } else {
-      stop(paste("Unhandled value type", class(value)))
+      FALSE
     }
   } else if (type_class == "Union") {
     for (subtype in type$types) {
@@ -148,42 +136,6 @@ is_type <- function(value, type) { # nolint
   }
 }
 
-#' Assert that a value conforms to a type.
-assert_type <- function(value, type) {
-  if (!is_type(value, type)) {
-    stop(
-      paste0(
-        "value is type ", node_type(value),
-        ", expected type ", format(type)
-      ),
-      call. = FALSE
-    )
-  }
-  value
-}
-
-#' Convert between R \code{mode} and JSON primitive type name.
-mode_to_schema_type <- function(mode) {
-  switch(
-    mode,
-    logical = "boolean",
-    numeric = "number",
-    character = "string",
-    list = "object"
-  )
-}
-
-#' Convert between JSON primitive type name and R \code{mode}.
-schema_type_to_mode <- function(mode) {
-  switch(
-    mode,
-    boolean = "logical",
-    number = "numeric",
-    string = "character",
-    object = "list"
-  )
-}
-
 #' Declare that a node is scalar
 as_scalar <- function(node) {
   # Make other values "scalar" so that they are "unboxed"
@@ -206,13 +158,16 @@ check_property <- function(type_name, property_name, is_required, is_missing, ty
 
   if (is_class(type, "Array")) {
     # Flatten lists to vectors where possible
-    if (is.list(value) && type$items %in% c("logical", "numeric", "character")) {
+    if (is.list(value) && is.character(type$items) && type$items %in% c("logical", "numeric", "character")) {
       value <- unlist(value)
     }
   } else {
     value <- as_scalar(value)
   }
 
+  # Convert functions to function names before passing to is_type
+  if (is.function(type)) type <- deparse(substitute(type))
+
   if (!is_type(value, type)) {
     stop(
       paste0(

r/tests/testthat/test-types.R

@@ -1,15 +1,80 @@
 context("types")
 
-test_that("Entity", {
+test_that("core typing functions work", {
   expect_equal(last_class(Entity()), "Entity")
   expect_true(inherits(Entity(), "Entity"))
 })
 
-test_that("Person", {
+test_that("can construct a simple node", {
   jane <- Person(
     honorificPrefix = "Dr",
     givenNames = c("Jane"),
     familyNames = list("Jones", "Jamieson")
   )
   expect_equal(jane$familyNames, c("Jones", "Jamieson"))
 })
+
+test_that("arguments to constructor functions are checked", {
+  expect_error(
+    Datatable(),
+    "Datatable\\$columns is required"
+  )
+
+  expect_error(
+    Datatable(
+      columns = list(
+        Person()
+      )
+    ),
+    "Datatable\\$columns is type list, expected type Array\\(DatatableColumn\\)"
+  )
+
+  expect_error(
+    Datatable(
+      columns = list(
+        DatatableColumn(
+          name = "A"
+        )
+      )
+    ),
+    "DatatableColumn\\$values is required"
+  )
+
+  expect_error(
+    Datatable(
+      columns = list(
+        DatatableColumn(
+          name = "A",
+          values = matrix()
+        )
+      )
+    ),
+    "DatatableColumn\\$values is type matrix, expected type Array\\(Any\\(\\)\\)"
+  )
+
+  expect_error(
+    Datatable(
+      columns = list(
+        DatatableColumn(
+          name = "A",
+          values = 1,
+          validator = NumberValidator()
+        )
+      )
+    ),
+    "DatatableColumn\\$validator is type NumberValidator, expected type ArrayValidator$"
+  )
+
+  expect_equal(
+    Datatable(
+      columns = list(
+        DatatableColumn(
+          name = "A",
+          values = 1:10,
+          validator = ArrayValidator(items = NumberValidator())
+        )
+      )
+    )$columns[[1]]$values,
+    1:10
+  )
+})

r/tests/testthat/test-typing.R

@@ -50,7 +50,6 @@ test_that("Union", {
   expect_false(is_type(Person(), Union(numeric)))
 })
 
-
 test_that("Enum", {
   enum <- Enum("a", "b", "c")
 
@@ -67,20 +66,6 @@ test_that("Enum", {
   expect_false(is_type(Person(), enum))
 })
 
-test_that("mode_to_schema_type", {
-  expect_equal(mode_to_schema_type("logical"), "boolean")
-  expect_equal(mode_to_schema_type("numeric"), "number")
-  expect_equal(mode_to_schema_type("character"), "string")
-  expect_equal(mode_to_schema_type("list"), "object")
-})
-
-test_that("schema_type_to_mode", {
-  expect_equal(schema_type_to_mode("boolean"), "logical")
-  expect_equal(schema_type_to_mode("number"), "numeric")
-  expect_equal(schema_type_to_mode("string"), "character")
-  expect_equal(schema_type_to_mode("object"), "list")
-})
-
 test_that("is_type", {
   expect_false(is_type(list(1, 2, 3), Array("character")))
   expect_true(is_type(list(1, 2, 3), Array("numeric")))
@@ -97,15 +82,6 @@ test_that("is_type", {
   expect_true(is_type(p, Union(InlineContent, BlockContent)))
 })
 
-test_that("assert_type", {
-  assert_type(NULL, "NULL")
-  assert_type(1, "numeric")
-  assert_type("string", "character")
-  assert_type(Person(), "Person")
-
-  expect_error(assert_type(Person(), "numeric"), "value is type Person, expected type numeric")
-})
-
 test_that("check_property", {
   expect_equal(
     check_property(