HTMLWidget and Shiny input integration helpers

DESCRIPTION

@@ -24,6 +24,7 @@ URL: https://github.com/timelyportfolio/reactR
 BugReports: https://github.com/timelyportfolio/reactR/issues
 License: MIT + file LICENSE
 LazyData: TRUE
+Encoding: UTF-8
 Imports:
     htmltools
 Suggests:
@@ -32,5 +33,5 @@ Suggests:
     shiny,
     V8,
     knitr
-RoxygenNote: 6.0.1
+RoxygenNote: 6.1.1
 VignetteBuilder: knitr

NAMESPACE

@@ -1,6 +1,13 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("$",react_component_builder)
+S3method("$<-",react_component_builder)
+S3method("[[",react_component_builder)
+S3method("[[<-",react_component_builder)
+export(React)
 export(babel_transform)
+export(component)
 export(html_dependency_corejs)
 export(html_dependency_react)
+export(html_dependency_reacttools)
 importFrom(htmltools,htmlDependency)

R/dependencies.R

@@ -70,3 +70,19 @@ html_dependency_corejs <- function() {
     script = "shim.min.js"
   )
 }
+
+#' Adds window.reactR.exposeComponents and window.reactR.hydrate
+#'
+#' @return
+#' @export
+#'
+#' @examples
+html_dependency_reacttools <- function(){
+  htmltools::htmlDependency(
+    name = "reactwidget",
+    src = "www/react-tools",
+    version = "1.0.0",
+    package = "reactR",
+    script = c("react-tools.js")
+  )
+}

R/reacttools.R

@@ -0,0 +1,46 @@
+isUpper <- function(s) {
+  grepl("^[[:upper:]]+$", s)
+}
+
+#' Create a React component
+#'
+#' @param name Name of the React component, which must start with an upper-case character.
+#' @param ... Attributes and children of the element to pass along to \code{\link[htmltools]{tag}} as varArgs.
+#'
+#' @return An htmltools \code{\link[htmltools]{tag}} object
+#' @export
+#'
+#' @examples
+#' component("ParentComponent",
+#'   x = 1,
+#'   y = 2,
+#'   component("ChildComponent"),
+#'   component("OtherChildComponent")
+#' )
+component <- function(name, varArgs = list()) {
+  if (length(name) == 0 || !isUpper(substring(name, 1, 1))) {
+    stop("Component name must be specified and start with an upper case character")
+  }
+  htmltools::tag(name, varArgs)
+}
+
+#' @export
+React <- structure(list(), class = "react_component_builder")
+
+#' @export
+`$.react_component_builder` <- function(x, name) {
+  function(...) {
+    component(name, list(...))
+  }
+}
+
+#' @export
+`[[.react_component_builder` <- `$.react_component_builder`
+
+#' @export
+`$<-.react_component_builder` <- function(x, name, value) {
+  stop("Assigning to a component constructor is not allowed")
+}
+
+#' @export
+`[[<-.react_component_builder` <- `$<-.react_component_builder`

examples/sparklineswidget/.Rbuildignore

@@ -0,0 +1,2 @@
+^sparklineswidget\.Rproj$
+^\.Rproj\.user$

examples/sparklineswidget/.gitignore

@@ -0,0 +1,5 @@
+.Rproj.user
+.Rhistory
+.RData
+build/
+node_modules/

examples/sparklineswidget/.vscode/tasks.json

@@ -0,0 +1,16 @@
+{
+    // See https://go.microsoft.com/fwlink/?LinkId=733558
+    // for the documentation about the tasks.json format
+    "version": "2.0.0",
+    "tasks": [
+        {
+            "label": "Build",
+            "type": "shell",
+            "command": "yarn run webpack --mode=development",
+            "group": {
+                "kind": "build",
+                "isDefault": true
+            }
+        }
+    ]
+}

examples/sparklineswidget/DESCRIPTION

@@ -0,0 +1,12 @@
+Package: sparklineswidget
+Title: What the Package Does (one line, title case)
+Version: 0.0.0.9000
+Authors@R: person("First", "Last", email = "[email protected]", role = c("aut", "cre"))
+Description: What the package does (one paragraph).
+Depends: R (>= 3.5.1)
+License: What license is it under?
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 6.1.1
+Imports: 
+    reactR

examples/sparklineswidget/NAMESPACE

@@ -0,0 +1,9 @@
+# Generated by roxygen2: do not edit by hand
+
+export(curve)
+export(reference_line)
+export(renderSparklineswidget)
+export(sparklineswidget)
+export(sparklineswidgetOutput)
+export(spots)
+import(htmlwidgets)

examples/sparklineswidget/R/sparklineswidget.R

@@ -0,0 +1,70 @@
+#' @export
+curve <- function(...) {
+  reactR::React$SparklinesCurve(...)
+}
+
+#' @export
+spots <- function(...) {
+  reactR::React$SparklinesSpots(...)
+}
+
+#' @export
+reference_line <- function(...) {
+  reactR::React$SparklinesReferenceLine(...)
+}
+
+#' <Add Title>
+#'
+#' <Add Description>
+#'
+#' @import htmlwidgets
+#'
+#' @export
+sparklineswidget <- function(data, ...) {
+  htmlwidgets::createWidget(
+    name = 'sparklineswidget',
+    list(tag = reactR::component("Sparklines", c(list(data = data, ...)))),
+    width = NULL,
+    height = NULL,
+    package = 'sparklineswidget',
+    elementId = NULL
+  )
+}
+
+#' Shiny bindings for sparklineswidget
+#'
+#' Output and render functions for using sparklineswidget within Shiny
+#' applications and interactive Rmd documents.
+#'
+#' @param outputId output variable to read from
+#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
+#'   \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
+#'   string and have \code{'px'} appended.
+#' @param expr An expression that generates a sparklineswidget
+#' @param env The environment in which to evaluate \code{expr}.
+#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
+#'   is useful if you want to save an expression in a variable.
+#'
+#' @name sparklineswidget-shiny
+#'
+#' @export
+sparklineswidgetOutput <- function(outputId, width = '100%', height = '400px'){
+  htmlwidgets::shinyWidgetOutput(outputId, 'sparklineswidget', width, height, package = 'sparklineswidget')
+}
+
+#' @rdname sparklineswidget-shiny
+#' @export
+renderSparklineswidget <- function(expr, env = parent.frame(), quoted = FALSE) {
+  if (!quoted) { expr <- substitute(expr) } # force quoted
+  htmlwidgets::shinyRenderWidget(expr, sparklineswidgetOutput, env, quoted = TRUE)
+}
+
+# Magical
+sparklineswidget_html <- function(id, style, class, ...) {
+  tagList(
+    reactR::html_dependency_corejs(),
+    reactR::html_dependency_react(),
+    reactR::html_dependency_reacttools(),
+    tags$div(id = id, class = class)
+  )
+}

examples/sparklineswidget/README.md

@@ -0,0 +1,43 @@
+# react-sparklines HTMLWidget
+
+This example demonstrates creating an [htmlwidget](https://www.htmlwidgets.org/) wrapper around the [react-sparklines](http://borisyankov.github.io/react-sparklines/) library.
+
+# Building
+
+Because this package includes Javascript source code that requires a compilation step, package installation is in two phases: Javascript tools build the Javascript, and R tools build and install the package. The R package includes the built Javascript files in the `inst/` directory.
+
+## Javascript Build Requirements
+
+Building Javascript should work on macOS, Linux, and Windows. The following tools are necessary regardless of your platform:
+
+- [Node.js](https://nodejs.org/en/)
+- [Yarn](https://yarnpkg.com/en/)
+
+## R Build Requirements
+
+You should install the parent `reactR` package if you haven't, as this widget depends on it.
+
+## Development Workflow
+
+After you've installed Node.js and Yarn, run the following command to resolve and download dependencies:
+
+```
+yarn install
+```
+
+Now, run `yarn` to build `inst/htmlwidgets/sparklineswidget.js`:
+
+```
+yarn run webpack --mode=development
+```
+
+> To run `yarn webpack` automatically whenever sources change, use the command `yarn run webpack --mode=development --watch`
+
+Now that the Javascript is built, you can install the R package:
+
+```
+devtools::document()
+devtools::install()
+```
+
+Finally you can try the example app by running [app.R](app.R).

examples/sparklineswidget/app.R

@@ -0,0 +1,33 @@
+library(shiny)
+library(sparklineswidget)
+library(colourpicker)
+# devtools::install_github("hadley/shinySignals")
+library(shinySignals)
+
+ui <- fluidPage(
+  titlePanel("React Sparklines"),
+  sparklineswidgetOutput('sparklines'),
+  colourInput("color_curve", "Curve color", "#253e56"),
+  colourInput("color_spots", "Spots color", "#56b45d")
+)
+
+nextWindow <- function(prev = round(runif(100, 0, 10)), t = NULL) {
+  c(prev[-1], round(runif(1, 0, 10)))
+}
+
+server <- function(input, output, session) {
+
+  data <- reducePast(fps(1), nextWindow, nextWindow())
+
+  output$sparklines <- renderSparklineswidget(
+    sparklineswidget(data = data(),
+      curve(color = input$color_curve),
+      spots(style = list(fill = input$color_spots)),
+      reference_line(type = "avg")
+    )
+  )
+}
+
+options(shiny.port = 4343)
+
+shinyApp(ui, server)