Skip to content
Browse files

Generalize app serving

- Separate generic server code from app logic
- Refactor folder layout to put examples in separate folders
- Separate shared client assets from app-specific stuff
- Introduce friendly functions for interacting with framework from app logic
  • Loading branch information...
1 parent 141c57a commit 6955573dd00167ee49263ed90b39fe1a54122efb @jcheng5 jcheng5 committed Jun 26, 2012
View
117 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)
}
View
15 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)
+})
View
14 www/index.html → examples/02_hash/www/index.html
@@ -1,15 +1,15 @@
<html>
<head>
- <script src="jquery-1.7.2.js" type="text/javascript"></script>
- <script src="shiny.js" type="text/javascript"></script>
- <link rel="stylesheet" type="text/css" href="shiny.css"/>
+ <script src="shared/jquery-1.7.2.js" type="text/javascript"></script>
+ <script src="shared/shiny.js" type="text/javascript"></script>
+ <link rel="stylesheet" type="text/css" href="shared/shiny.css"/>
</head>
<body>
- <h1>Example 1: Hash Calculation</h1>
+ <h1>Example 2: Hash Calculation</h1>
<p>
<label>Input:</label><br />
- <input name="input1" value="cars"/>
+ <input name="input1" value="Hello World!"/>
<input type="checkbox" name="addnewline" checked="checked"/> Append newline
</p>
@@ -22,9 +22,5 @@
<label>SHA-1:</label><br />
<pre id="sha1_hash" class="live-text"></pre>
</p>
-
- <div id="table1" class="live-html"></div>
-
- <div id="plot1" class="live-plot"></div>
</body>
</html>
View
24 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())
+})
View
30 examples/03_distributions/www/index.html
@@ -0,0 +1,30 @@
+<html>
+<head>
+ <script src="shared/jquery-1.7.2.js" type="text/javascript"></script>
+ <script src="shared/shiny.js" type="text/javascript"></script>
+ <link rel="stylesheet" type="text/css" href="shared/shiny.css"/>
+</head>
+<body>
+ <h1>Example 3: Distributions</h1>
+
+ <p>
+ <label>Distribution type:</label><br />
+ <select name="dist">
+ <option value="norm">Normal</option>
+ <option value="unif">Uniform</option>
+ <option value="lnorm">Log-normal</option>
+ <option value="exp">Exponential</option>
+ </select>
+ </p>
+
+ <p>
+ <label>Number of observations:</label><br />
+ <input type="numeric" name="n" value="500" />
+ </p>
+
+ <div id="plot1" class="live-plot"></div>
+
+ <div id="table1" class="live-html"></div>
+
+</body>
+</html>
View
15 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_dir>")
+}
+
+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)
View
3 shiny.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+R --slave --args $1 < run.R
View
0 www/jquery-1.7.2.js → www/shared/jquery-1.7.2.js
File renamed without changes.
View
0 www/shiny.css → www/shared/shiny.css
File renamed without changes.
View
2 www/shiny.js → 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);

0 comments on commit 6955573

Please sign in to comment.
Something went wrong with that request. Please try again.