fix(R bindings): Improve type specs and checking

.gitignore

@@ -7,3 +7,4 @@
 /public
 /ts/types.ts
 engine/node_modules
+.Rproj.user

r/NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(Any)
+export(Array)
 export(ArraySchema)
 export(Article)
 export(AudioObject)
@@ -25,6 +27,7 @@ export(Date)
 export(Delete)
 export(Emphasis)
 export(Entity)
+export(Enum)
 export(EnumSchema)
 export(Figure)
 export(Function)
@@ -65,6 +68,7 @@ export(TableRow)
 export(ThematicBreak)
 export(Thing)
 export(TupleSchema)
+export(Union)
 export(Variable)
 export(VideoObject)
 export(VolumeMount)

r/R/typing.R

@@ -3,6 +3,7 @@
 # not available natively in R.
 
 #' Any type
+#' @export
 Any <- function() {
   self <- list()
   class(self) <- "Any"
@@ -21,14 +22,17 @@ print.Any <- function(x) { # nolint
 #' Array type
 #'
 #' @param items The type that items in the array should be
+#' @export
 Array <- function(items) {
-  self <- list(items = items)
+  self <- list(
+    items = if (is.function(items)) deparse(substitute(items)) else items
+  )
   class(self) <- "Array"
   self
 }
 
 format.Array <- function(type) { # nolint
-  paste0("Array(", paste(format(type$items), collapse = ", "), ")")
+  paste0("Array(", format(type$items), ")")
 }
 
 print.Array <- function(x) { # nolint
@@ -38,14 +42,21 @@ print.Array <- function(x) { # nolint
 #' Union type
 #'
 #' @param ... The types in the union
+#' @export
 Union <- function(...) {
-  self <- list(types = as.character(c(...)))
+  args <- as.list(match.call())[-1]
+  types <- lapply(args, function(arg) {
+    # For functions, get the function name, otherwise return the value e.g. a Union
+    value <- eval(arg)
+    if (is.function(value)) as.character(arg) else value
+  })
+  self <- list(types = types)
   class(self) <- "Union"
   self
 }
 
 format.Union <- function(type) { # nolint
-  paste0("Union(", paste(sapply(type$types, format), collapse = ", "), ")")
+  paste0("Union(", paste(lapply(type$types, format), collapse = ", "), ")")
 }
 
 print.Union <- function(x) { # nolint
@@ -54,6 +65,7 @@ print.Union <- function(x) { # nolint
 
 
 #' An enumeration
+#' @export
 Enum <- function(...) {
   self <- list(values = c(...))
   class(self) <- "Enum"
@@ -92,19 +104,23 @@ is_entity <- function(node) {
 }
 
 #' Does a value conform to the type?
-is_type <- function(value, type) { # nolint TODO: Reduce cyclometric complexity of this function
+is_type <- function(value, type) { # nolint
   type_class <- last_class(type)
-  if (type_class == "Any") {
-    TRUE
+  if (type_class == "function") {
+    # Capture the function name and call this function with that
+    func_name <- deparse(substitute(type))
+    is_type(value, func_name)
   } else if (type_class == "character") {
     if (type == "NULL") return(is.null(value))
-    type_obj <- get(type)
-    if (last_class(type_obj) %in% c("Any", "Array", "Union")) is_type(value, type_obj)
-    else node_type(value) == type
+    else inherits(value, type)
+  } else if (type_class == "Any") {
+    TRUE
   } else if (type_class == "Array") {
     if (is.null(value) || is_entity(value)) {
+      # Not array-like
       FALSE
     } else if (is.list(value)) {
+      # Check all items in list are of type
       for (item in value) {
         if (!is_type(item, type$items)) return(FALSE)
       }
@@ -121,7 +137,10 @@ is_type <- function(value, type) { # nolint TODO: Reduce cyclometric complexity
       stop(paste("Unhandled value type", class(value)))
     }
   } else if (type_class == "Union") {
-    node_type(value) %in% type$types
+    for (subtype in type$types) {
+      if (is_type(value, subtype)) return(TRUE)
+    }
+    FALSE
   } else if (type_class == "Enum") {
     mode(value) == mode(type$values) && value %in% type$values
   } else {

r/README.md

@@ -4,14 +4,75 @@ This package provides R bindings for [Stencila Schema](https://stencila.github.i
 
 ## Install
 
-This package isn't on CRAN yet, but you can install it from this repository using the [`devtools`](https://github.com/hadley/devtools) package,
+This package isn't on CRAN yet, but you can install it directly from this repository using the [`devtools`](https://github.com/hadley/devtools) package,
 
 ```r
 devtools::install_github("stencila/schema", subdir = "r", upgrade = "ask")
 ```
 
+## Use
+
+This package is primarily aimed at R developers wanting to programmatically generate, or modify, executable documents. It exports a constructor function for each type of document node in the Stencila Schema e.g. `Article`, `Paragraph`, `CodeChunk`.
+
+For example,
+
+```r
+chunk <- CodeChunk(
+  text = "SELECT * FROM data",
+  programmingLanguage = "sql"
+)
+> names(chunk)
+[1] "type"                "text"                "programmingLanguage"
+> chunk$type
+[1] "CodeChunk"
+attr(,"class")
+[1] "scalar"    "character"
+```
+
+Note that the `type` property is set automatically. The `class` of the node also includes the full hierarchy of ancestor types, so you can use the `inherits` function as needed:
+
+```r
+> class(chunk)
+[1] "list"      "Entity"    "Code"      "CodeBlock" "CodeChunk"
+> inherits(chunk, "CodeChunk")
+[1] TRUE
+> inherits(chunk, "Code")
+[1] TRUE
+> inherits(chunk, "Pizza")
+[1] FALSE
+```
+
+Each constructor function checks that the arguments provided conform to the Schema. For example,
+
+```r
+# Wrong type for a property supplied
+Article(
+  authors = Paragraph('My article title')
+)
+Error: CreativeWork$authors is type Paragraph, expected type Array(Union(Person, Organization))
+
+# Required property not supplied
+Article(
+  authors = list(Person(givenNames = 'John',  familyNames = 'Smith'))
+)
+Error: Article$title is required
+
+# Success!
+Article(
+  authors = list(Person(givenNames = 'John',  familyNames = 'Smith')),
+  title = 'My article title'
+)
+```
+
 ## Develop
 
+Get started by cloning this repository,
+
+```bash
+git clone git@github.com:stencila/schema
+cd schema/r
+```
+
 Most development tasks can be run from R, using `make` shortcuts, or RStudio keyboard shortcuts.
 
 | Task                             | `make`          | R/RStudio                             |
@@ -27,10 +88,14 @@ Most development tasks can be run from R, using `make` shortcuts, or RStudio key
 | Build the package                | `make build`    | `devtools::build()` or `Ctrl+Shift+B` |
 | Clean                            | `make clean`    |
 
-Unit tests live in the `tests` folder and are written using the `testthat` package. To run test files individually, in R use the `test_file` function:
+### Testing
 
-```r
-testthat::test_file(system.file("tests/testthat/test-types.R", package = "stencila"))
-```
+Unit tests live in the `tests` folder and are written using `testthat`.
+
+### Documentation
+
+Documentation is written using `roxygen2` and the documentation site is generated by `pkgdown` into the [`docs`](docs) folder and published on Github pages.
+
+### Continuous integration
 
-The tests are run on [Travis](https://travis-ci.org/stencila/schema) and code coverage tracked at [Codecov](https://codecov.io/gh/stencila/schema).
+Tests are run on [Travis](https://travis-ci.org/stencila/schema) and code coverage tracked at [Codecov](https://codecov.io/gh/stencila/schema).

r/tests/testthat/test-typing.R

@@ -13,39 +13,41 @@ test_that("Any", {
 })
 
 test_that("Array", {
-  expect_equal(class(Array("character")), "Array")
-
-  expect_equal(format(Array("numeric")), "Array(numeric)")
-  expect_equal(format(Array(Union("string", "Person"))), "Array(Union(string, Person))")
-
-  expect_true(is_type(vector("numeric"), Array("numeric")))
-  expect_true(is_type(vector("logical"), Array("logical")))
-  expect_true(is_type(1, Array("numeric")))
-  expect_true(is_type(1:10, Array("numeric")))
-  expect_true(is_type(list(1), Array("numeric")))
-  expect_true(is_type(list(1, 2, 3), Array("numeric")))
-  expect_true(is_type(list(Person(), Person()), Array("Person")))
-  expect_true(is_type(list("abc", Person()), Array(Union("character", "Person"))))
-
-  expect_false(is_type(NULL, Array("numeric")))
-  expect_false(is_type(NA, Array("numeric")))
-  expect_false(is_type(Thing(), Array("numeric")))
-  expect_false(is_type(Person(), Array("numeric")))
+  expect_equal(class(Array(character)), "Array")
+
+  expect_equal(format(Array(numeric)), "Array(numeric)")
+  expect_equal(format(Array(Union(character, Person))), "Array(Union(character, Person))")
+
+  expect_true(is_type(vector("numeric"), Array(numeric)))
+  expect_true(is_type(vector("numeric"), Array("numeric"))) #Alternative syntax
+  expect_true(is_type(vector("logical"), Array(logical)))
+  expect_true(is_type(1, Array(numeric)))
+  expect_true(is_type(1:10, Array(numeric)))
+  expect_true(is_type(list(1), Array(numeric)))
+  expect_true(is_type(list(1, 2, 3), Array(numeric)))
+  expect_true(is_type(list(Person(), Person()), Array(Person)))
+  expect_true(is_type(list("abc", Person()), Array(Union(character, Person))))
+
+  expect_false(is_type(NULL, Array(numeric)))
+  expect_false(is_type(NA, Array(numeric)))
+  expect_false(is_type(Thing(), Array(numeric)))
+  expect_false(is_type(Person(), Array(numeric)))
 })
 
 test_that("Union", {
-  expect_equal(class(Union("character")), "Union")
+  expect_equal(class(Union(character)), "Union")
 
-  expect_equal(format(Union("numeric", "character")), "Union(numeric, character)")
-  expect_equal(format(Union("character", "Person")), "Union(character, Person)")
+  expect_equal(format(Union(numeric, character)), "Union(numeric, character)")
+  expect_equal(format(Union("numeric", "character")), "Union(numeric, character)") # Alternative syntax
+  expect_equal(format(Union(character, Person)), "Union(character, Person)")
 
-  expect_true(is_type(1, Union("numeric", "character")))
-  expect_true(is_type("string", Union("numeric", "character")))
-  expect_true(is_type(Person(), Union("string", "Person")))
+  expect_true(is_type(1, Union(numeric, character)))
+  expect_true(is_type("string", Union(numeric, character)))
+  expect_true(is_type(Person(), Union(character, Person)))
 
-  expect_false(is_type(NULL, Union("numeric")))
-  expect_false(is_type(NA, Union("numeric")))
-  expect_false(is_type(Person(), Union("numeric")))
+  expect_false(is_type(NULL, Union(numeric)))
+  expect_false(is_type(NA, Union(numeric)))
+  expect_false(is_type(Person(), Union(numeric)))
 })
 
 
@@ -85,6 +87,14 @@ test_that("is_type", {
 
   expect_false(is_type(factor(1:10), Array("numeric")))
   expect_true(is_type(factor(1:10), Array("character")))
+
+  p <- Paragraph(list(""))
+  expect_true(is_type(p, Node))
+  expect_true(is_type(p, Union(numeric, Node)))
+  expect_true(is_type(p, Paragraph))
+  expect_true(is_type(p, BlockContent))
+  expect_false(is_type(p, InlineContent))
+  expect_true(is_type(p, Union(InlineContent, BlockContent)))
 })
 
 test_that("assert_type", {

ts/bindings/r.ts

@@ -91,11 +91,9 @@ export function classGenerator(schema: Schema): string {
     })
     .join('\n')
 
-  // Give the node the class `Entity` to be able to
-  // provide methods like `print.Entity` in R.
-  code += `\n  class(self) <- c("list", "Entity")`
-  code += `\n  self`
+  code += `\n  class(self) <- c(class(self), "${title}")`
 
+  code += `\n  self`
   code += `\n}\n\n`
 
   return code
@@ -107,7 +105,7 @@ export function classGenerator(schema: Schema): string {
 export function unionGenerator(schema: Schema): string {
   const { title = '', description = title } = schema
   let code = docComment(description, ['@export'])
-  code += `${title} = ${schemaToType(schema)}\n\n`
+  code += `${title} <- ${schemaToType(schema)}\n\n`
   return code
 }
 
@@ -132,7 +130,7 @@ function docComment(description: string, tags: string[] = []): string {
 function schemaToType(schema: Schema): string {
   const { type, anyOf, allOf, $ref } = schema
 
-  if ($ref !== undefined) return `"${$ref.replace('.schema.json', '')}"`
+  if ($ref !== undefined) return `${$ref.replace('.schema.json', '')}`
   if (anyOf !== undefined) return anyOfToType(anyOf)
   if (allOf !== undefined) return allOfToType(allOf)
   if (schema.enum !== undefined) return enumToType(schema.enum)