feat: initial implementation of R package with encoders

.travis.yml

@@ -4,7 +4,6 @@ matrix:
   include:
 
     # Typescript latest LTS
-
     - language: node_js
       node_js: 10
 
@@ -44,7 +43,6 @@ matrix:
             branch: master
 
     # Typescript previous LTS
-
     - language: node_js
       node_js: 8
 
@@ -53,7 +51,6 @@ matrix:
         - make test-ts
 
     # Python latest
-
     - language: python
       python: "3.7-dev"
 
@@ -71,7 +68,6 @@ matrix:
         - bash <(curl -s https://codecov.io/bash) -cF py
 
     # Python previous
-
     - language: python
       python: 3.6
 
@@ -82,3 +78,32 @@ matrix:
       # Just do testing
       script:
         - make test-py
+
+    # R latest
+    - language: r
+      r: release
+
+      # Packages to install from github using devtools
+      r_github_packages:
+        - jimhester/lintr
+        - klutometis/roxygen2
+        - r-lib/covr
+        - r-lib/testthat
+
+      # Do linting and coverage
+      script:
+        - make lint-r
+        - make cover-r
+
+    # R previous
+    - language: r
+      r: oldrel
+
+      # Packages to install from github using devtools
+      # Just testing
+      r_github_packages:
+        - r-lib/testthat
+
+      # Just do testing
+      script:
+        - make test-r

Makefile

@@ -19,7 +19,7 @@ hooks:
 
 # Lint code
 
-lint: lint-ts lint-py
+lint: lint-ts lint-py lint-r
 
 lint-ts:
 	npm run lint
@@ -32,6 +32,8 @@ lint-py-code:
 lint-py-types:
 	mypy src
 
+lint-r:
+	cd r && Rscript -e 'lintr::lint_package()'
 
 # Run tests
 
@@ -43,6 +45,8 @@ test-ts:
 test-py:
 	tox
 
+test-r:
+	cd r && Rscript -e 'devtools::test()'
 
 # Run tests with coverage
 
@@ -54,13 +58,19 @@ cover-ts:
 cover-py:
 	tox -e cover
 
+cover-r:
+	cd r && Rscript -e 'covr::package_coverage()'
+
 # Run benchmarks
 
 bench: bench-py
 
 bench-py:
 	tox -e bench -- tests/bench
 
+bench-r: install-r
+	cd r/tests/bench && Rscript encoders.R
+
 
 # Run integration tests
 
@@ -98,6 +108,13 @@ docs-ts:
 docs-py:
 	echo "To do!"
 
+docs-r:
+	cd r && Rscript -e 'devtools::document()'
+
+# Install a package
+
+install-r: docs-r # Documentation generation required for NAMESPACE amongst other things
+	cd r && Rscript -e 'devtools::install()'
 
 # Clean up local development environment
 

r/.lintr

@@ -0,0 +1 @@
+linters: with_defaults(object_name_linter(c("snake_case", "UpperCamelCase")))

r/DESCRIPTION

@@ -0,0 +1,25 @@
+Package: stencilaschema
+Type: Package
+Title: Stencila schemas, protocols and other specs
+Description: Schemas, protocols and other specifications used in Stencila.
+Authors@R: c(person("Nokome", "Bentley", email = "nokome@stenci.la", role = c("aut", "cre")))
+URL: https://github.com/stencila/schema#readme
+BugReports: https://github.com/stencila/schema/issues
+License: Apache-2.0
+Version: 0.0.1
+Imports:
+    jsonlite,
+    R6
+Suggests:
+    bench,
+    covr,
+    devtools,
+    lintr,
+    roxygen2,
+    testthat
+RoxygenNote: 6.0.1.9000
+Collate: 
+    'Encoder.R'
+    'JsonEncoder.R'
+    'JsonGzipEncoder.R'
+    'jsonRpc.R'

r/NAMESPACE

@@ -0,0 +1,6 @@
+# Generated by roxygen2: do not edit by hand
+
+export(JsonEncoder)
+export(JsonGzipEncoder)
+export(Request)
+export(Response)

r/R/Encoder.R

@@ -0,0 +1,17 @@
+Encoder <- R6::R6Class("Encoder",
+  public = list(
+    # nocov start
+    name  = function() {
+      stop("Not implemented")
+    },
+
+    decode  = function() {
+      stop("Not implemented")
+    },
+
+    encode  = function() {
+      stop("Not implemented")
+    }
+    # nocov end
+  )
+)

r/R/JsonEncoder.R

@@ -0,0 +1,37 @@
+#' @include Encoder.R
+
+#' @export
+JsonEncoder <- R6::R6Class("JsonEncoder",
+  inherit = Encoder,
+
+  public = list(
+    name = function() {
+      "json"
+    },
+
+    encode = function(instance) {
+      members <- list()
+      for (name in ls(instance, sorted = FALSE)) {
+        if (!is.function(instance[[name]])) members[[name]] <- instance[[name]]
+      }
+      toString(jsonlite::toJSON(
+        members,
+        null = "null",
+        na = "null",
+        dataframe = "columns",
+        digits = NA,
+        auto_unbox = TRUE,
+        force = TRUE
+      ))
+    },
+
+    decode = function(message, cls) {
+      instance <- cls$new()
+      members <- jsonlite::fromJSON(message, simplifyDataFrame = FALSE)
+      for (name in ls(members)) {
+        instance[[name]] <- members[[name]]
+      }
+      instance
+    }
+  )
+)

r/R/JsonGzipEncoder.R

@@ -0,0 +1,20 @@
+#' @include JsonEncoder.R
+
+#' @export
+JsonGzipEncoder <- R6::R6Class("JsonGzipEncoder",
+  inherit = JsonEncoder,
+
+  public = list(
+    name = function() {
+      "json+gzip"
+    },
+
+    encode = function(instance) {
+      memCompress(super$encode(instance))
+    },
+
+    decode = function(message, cls) {
+      super$decode(memDecompress(message, "gzip", asChar = TRUE), cls)
+    }
+  )
+)

r/R/jsonRpc.R

@@ -0,0 +1,33 @@
+#' @export
+Request <- R6::R6Class("Request",
+  public = list(
+    jsonrpc = NULL,
+    id = NULL,
+    method = NULL,
+    params = NULL,
+
+    initialize = function(id=NULL, method=NULL, params=NULL) {
+        self$jsonrpc <- "2.0"
+        self$id <- id
+        self$method <- method
+        self$params <- params
+    }
+  )
+)
+
+#' @export
+Response <- R6::R6Class("Response",
+  public = list(
+    jsonrpc = NULL,
+    id = NULL,
+    result = NULL,
+    error = NULL,
+
+    initialize = function(id=NULL, result=NULL, error=NULL) {
+        self$jsonrpc <- "2.0"
+        self$id <- id
+        self$result <- result
+        self$error <- error
+    }
+  )
+)

r/tests/bench/encoders.R

@@ -0,0 +1,22 @@
+library(bench)
+library(stencilaschema)
+
+source(file.path("..", "fixtures", "requests.R"))
+
+roundtrip <- function(encoder, request) {
+  message <- encoder$encode(request)
+  encoder$decode(message, Request)
+}
+
+results <- bench::press(
+  encoder = c("JsonEncoder", "JsonGzipEncoder"),
+  request = names(requests), {
+    encoder_instance <- get(encoder)$new()
+    request_instance <- requests[[request]]
+    bench::mark(
+      roundtrip(encoder_instance, request_instance)
+    )
+  }
+)
+
+results

r/tests/fixtures/requests.R

@@ -0,0 +1,73 @@
+# Example requests
+requests <- list(
+
+  # Import a 100k Markdown document
+  import_text = Request$new(
+    id = 1,
+    method = "import",
+    params = list(
+      thing = sample(LETTERS, 100000, TRUE),
+      format = "text/markdown"
+    )
+  ),
+
+  # Execute a simple code cell
+  execute_cell_simple = Request$new(
+    id = 2,
+    method = "execute",
+    params = list(
+      thing = list(
+        type = "Cell",
+        programmingLanguage = "R",
+        text = "x + y",
+        inputs = list(
+          list(
+            type = "Var",
+            name = "x",
+            value = 6
+          ),
+          list(
+            type = "Var",
+            name = "y",
+            value = 7
+          )
+        )
+      )
+    )
+  ),
+
+  # Execute a call with a data table arg
+  execute_call = Request$new(
+    id = 3,
+    method = "execute",
+    params = list(
+      thing = list(
+        type = "Call",
+        func = "http://example.org/functions/filter",
+        args = list(
+          list(
+            type = "Datatable",
+            columns = list(
+                list(
+                    type = "Column",
+                    name = "col1",
+                    data = list(
+                        type = "Array",
+                        values = runif(10000)
+                    )
+                ),
+                list(
+                    type = "Column",
+                    name = "col2",
+                    data = list(
+                        type = "Array",
+                        values = sample(LETTERS, 10000, TRUE)
+                    )
+                )
+            )
+          )
+        )
+      )
+    )
+  )
+)

r/tests/fixtures/responses.R

@@ -0,0 +1,14 @@
+responses <- list(
+    cell = Response$new(
+        id = 1,
+        result = list(
+            type = "Cell"
+        )
+    ),
+    error = Response$new(
+        id = 1,
+        error = list(
+            message = "An error happened"
+        )
+    )
+)

r/tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(stencilaschema)
+
+test_check("stencilaschema")