diff --git a/R/shiny.R b/R/shiny.R index 444d9eddc..580b24529 100644 --- a/R/shiny.R +++ b/R/shiny.R @@ -1,7 +1,9 @@ -library(websockets) -library(RJSONIO) -library(caTools) -library(xtable) +suppressPackageStartupMessages({ + library(websockets) + library(RJSONIO) + library(caTools) + library(xtable) +}) ShinyApp <- setRefClass( 'ShinyApp', @@ -36,6 +38,12 @@ ShinyApp <- setRefClass( return(paste("data:image/png;base64,", b64, sep='')) }) }, + define.table.output = function(name, func) { + .outputs$set(name, function() { + data <- func() + return(paste(capture.output(print(xtable(data), type='html')), collapse="\n")) + }) + }, instantiate.outputs = function() { lapply(.outputs$keys(), function(key) { @@ -52,14 +60,30 @@ ShinyApp <- setRefClass( data <- .invalidated.output.values .invalidated.output.values <<- Map$new() - cat(c("SEND", toJSON(as.list(data)), "\n")) + # cat(c("SEND", toJSON(as.list(data)), "\n")) websocket_write(toJSON(as.list(data)), .websocket) } ) ) -statics <- function(root) { +statics <- function(root, sys.root=NULL) { root <- normalizePath(root, mustWork=T) + if (!is.null(sys.root)) + sys.root <- normalizePath(sys.root, mustWork=T) + + resolve <- function(dir, relpath) { + abs.path <- file.path(dir, relpath) + if (!file.exists(abs.path)) + return(NULL) + abs.path <- normalizePath(abs.path, mustWork=T) + if (nchar(abs.path) <= nchar(dir) + 1) + return(NULL) + if (substr(abs.path, 1, nchar(dir)) != dir || + !(substr(abs.path, nchar(dir)+1, nchar(dir)+1) %in% c('/', '\\'))) { + return(NULL) + } + return(abs.path) + } return(function(ws, header) { # TODO: Stop using websockets' internal methods @@ -71,23 +95,11 @@ statics <- function(root) { if (path == '/') path <- '/index.html' - abs.path <- file.path(root, path) - - if (!file.exists(abs.path)) { - # TODO: This should be 404, not 400 + abs.path <- resolve(root, path) + if (is.null(abs.path) && !is.null(sys.root)) + abs.path <- resolve(sys.root, path) + if (is.null(abs.path)) return(websockets:::.http_400(ws)) - } - - abs.path <- normalizePath(abs.path, mustWork=T) - - if (nchar(abs.path) <= nchar(root) + 1) { - return(websockets:::.http_400(ws)) - } - - if (substr(abs.path, 1, nchar(root)) != root || - !(substr(abs.path, nchar(root)+1, nchar(root)+1) %in% c('/', '\\'))) { - return(websockets:::.http_400(ws)) - } ext <- tools::file_ext(abs.path) content.type <- switch(ext, @@ -105,51 +117,19 @@ statics <- function(root) { }) } -start.app <- function(port = 8101L) { +start.app <- function(app, www.root, sys.www.root=NULL, port=8101L) { - ws_env <- create_server(port=port, webpage=statics('./www')) + ws_env <- create_server(port=port, webpage=statics(www.root, sys.www.root)) set_callback('established', function(WS, ...) { shinyapp <<- ShinyApp$new(WS) - - input <- Observable$new(function() { - str <- shinyapp$session$get('input1') - if (shinyapp$session$get('addnewline')) - str <- paste(str, "\n", sep='') - return(str) - }) - input.df <- Observable$new(function() { - varname <- shinyapp$session$get('input1') - if (nchar(varname) > 0 && exists(varname, where=.GlobalEnv)) { - df <- get(varname, pos=.GlobalEnv) - if (is.data.frame(df)) { - return(df) - } - } - return(NULL) - }) - shinyapp$define.output('md5_hash', function() { - digest(input$get.value(), algo='md5', serialize=F) - }) - shinyapp$define.output('sha1_hash', function() { - digest(input$get.value(), algo='sha1', serialize=F) - }) - shinyapp$define.output('table1', function() { - if (!is.null(input.df$get.value())) - print(xtable(input.df$get.value()), type='html') - }) - shinyapp$define.plot.output('plot1', function() { - if (!is.null(input.df$get.value())) - plot(input.df$get.value()) - }, width=800, height=600) - }, ws_env) set_callback('closed', function(WS, ...) { }, ws_env) set_callback('receive', function(DATA, WS, ...) { - cat(c("RECV", rawToChar(DATA), "\n")) + # cat(c("RECV", rawToChar(DATA), "\n")) if (identical(charToRaw("\003\xe9"), DATA)) return() @@ -160,6 +140,27 @@ start.app <- function(port = 8101L) { init = { shinyapp$session$mset(msg$data) flush.react() + local({ + define.shiny.output <- function(name, func) { + shinyapp$define.output(name, func) + } + define.shiny.plot <- function(name, func, ...) { + shinyapp$define.plot.output(name, func, ...) + } + define.shiny.table <- function(name, func) { + shinyapp$define.table.output(name, func) + } + get.shiny.input <- function(name) { + shinyapp$session$get(name) + } + + if (is.function(app)) + app() + else if (is.character(app)) + source(app, local=T) + else + warning("Don't know how to configure app; it's neither a function or filename!") + }) shinyapp$instantiate.outputs() }, update = { @@ -169,6 +170,8 @@ start.app <- function(port = 8101L) { shinyapp$flush.output() }, ws_env) + cat(paste('Listening on http://0.0.0.0:', port, "\n", sep='')) + return(ws_env) } diff --git a/examples/02_hash/app.R b/examples/02_hash/app.R new file mode 100644 index 000000000..939badf9f --- /dev/null +++ b/examples/02_hash/app.R @@ -0,0 +1,15 @@ +library(digest) + +input <- Observable$new(function() { + str <- get.shiny.input('input1') + if (get.shiny.input('addnewline')) + str <- paste(str, "\n", sep='') + return(str) +}) + +define.shiny.output('md5_hash', function() { + digest(input$get.value(), algo='md5', serialize=F) +}) +define.shiny.output('sha1_hash', function() { + digest(input$get.value(), algo='sha1', serialize=F) +}) \ No newline at end of file diff --git a/www/index.html b/examples/02_hash/www/index.html similarity index 50% rename from www/index.html rename to examples/02_hash/www/index.html index aa0100435..296953976 100644 --- a/www/index.html +++ b/examples/02_hash/www/index.html @@ -1,15 +1,15 @@ - - - + + + -

Example 1: Hash Calculation

+

Example 2: Hash Calculation


- + Append newline

@@ -22,9 +22,5 @@

   

- -
- -
diff --git a/examples/03_distributions/app.R b/examples/03_distributions/app.R new file mode 100644 index 000000000..776cc5404 --- /dev/null +++ b/examples/03_distributions/app.R @@ -0,0 +1,24 @@ +data <- Observable$new(function() { + # Choose a distribution function + dist <- switch(get.shiny.input('dist'), + norm = rnorm, + unif = runif, + lnorm = rlnorm, + exp = rexp, + rnorm) + + # Generate n values from the distribution function + dist(max(1, get.shiny.input('n'))) +}) + +define.shiny.plot('plot1', function() { + dist <- get.shiny.input('dist') + n <- get.shiny.input('n') + + hist(data$get.value(), + main=paste('r', dist, '(', n, ')', sep='')) +}, width=600, height=300) + +define.shiny.table('table1', function() { + data.frame(x=data$get.value()) +}) diff --git a/examples/03_distributions/www/index.html b/examples/03_distributions/www/index.html new file mode 100644 index 000000000..39b76c530 --- /dev/null +++ b/examples/03_distributions/www/index.html @@ -0,0 +1,30 @@ + + + + + + + +

Example 3: Distributions

+ +

+
+ +

+ +

+
+ +

+ +
+ +
+ + + diff --git a/run.R b/run.R new file mode 100644 index 000000000..fe43d0a20 --- /dev/null +++ b/run.R @@ -0,0 +1,15 @@ +source('R/react.R'); +source('R/shiny.R'); + +args <- commandArgs(trailingOnly=T) + +if (length(args) == 0) { + stop("Usage: shiny.sh ") +} + +app.path <- args[1] + +app <- start.app(app=file.path(app.path, 'app.R'), + www.root=file.path(app.path, 'www'), + sys.www.root='./www') +run.app(app) diff --git a/shiny.sh b/shiny.sh new file mode 100755 index 000000000..33aa29c9c --- /dev/null +++ b/shiny.sh @@ -0,0 +1,3 @@ +#!/bin/sh + +R --slave --args $1 < run.R diff --git a/www/jquery-1.7.2.js b/www/shared/jquery-1.7.2.js similarity index 100% rename from www/jquery-1.7.2.js rename to www/shared/jquery-1.7.2.js diff --git a/www/shiny.css b/www/shared/shiny.css similarity index 100% rename from www/shiny.css rename to www/shared/shiny.css diff --git a/www/shiny.js b/www/shared/shiny.js similarity index 98% rename from www/shiny.js rename to www/shared/shiny.js index 5a39bface..f16ef3aa8 100644 --- a/www/shiny.js +++ b/www/shared/shiny.js @@ -143,7 +143,7 @@ } var initialValues = {}; - $('input').each(function() { + $('input, select').each(function() { var input = this; var name = input.name; var value = elementToValue(input);