Skip to content

Commit 6955573

Browse files
jcheng5jcheng5
committed
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
1 parent 141c57a commit 6955573

File tree

10 files changed

+153
-67
lines changed

10 files changed

+153
-67
lines changed

‎R/shiny.R

Lines changed: 60 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
1-
library(websockets)
2-
library(RJSONIO)
3-
library(caTools)
4-
library(xtable)
1+
suppressPackageStartupMessages({
2+
library(websockets)
3+
library(RJSONIO)
4+
library(caTools)
5+
library(xtable)
6+
})
57

68
ShinyApp <- setRefClass(
79
'ShinyApp',
@@ -36,6 +38,12 @@ ShinyApp <- setRefClass(
3638
return(paste("data:image/png;base64,", b64, sep=''))
3739
})
3840
},
41+
define.table.output = function(name, func) {
42+
.outputs$set(name, function() {
43+
data <- func()
44+
return(paste(capture.output(print(xtable(data), type='html')), collapse="\n"))
45+
})
46+
},
3947
instantiate.outputs = function() {
4048
lapply(.outputs$keys(),
4149
function(key) {
@@ -52,14 +60,30 @@ ShinyApp <- setRefClass(
5260

5361
data <- .invalidated.output.values
5462
.invalidated.output.values <<- Map$new()
55-
cat(c("SEND", toJSON(as.list(data)), "\n"))
63+
# cat(c("SEND", toJSON(as.list(data)), "\n"))
5664
websocket_write(toJSON(as.list(data)), .websocket)
5765
}
5866
)
5967
)
6068

61-
statics <- function(root) {
69+
statics <- function(root, sys.root=NULL) {
6270
root <- normalizePath(root, mustWork=T)
71+
if (!is.null(sys.root))
72+
sys.root <- normalizePath(sys.root, mustWork=T)
73+
74+
resolve <- function(dir, relpath) {
75+
abs.path <- file.path(dir, relpath)
76+
if (!file.exists(abs.path))
77+
return(NULL)
78+
abs.path <- normalizePath(abs.path, mustWork=T)
79+
if (nchar(abs.path) <= nchar(dir) + 1)
80+
return(NULL)
81+
if (substr(abs.path, 1, nchar(dir)) != dir ||
82+
!(substr(abs.path, nchar(dir)+1, nchar(dir)+1) %in% c('/', '\\'))) {
83+
return(NULL)
84+
}
85+
return(abs.path)
86+
}
6387

6488
return(function(ws, header) {
6589
# TODO: Stop using websockets' internal methods
@@ -71,23 +95,11 @@ statics <- function(root) {
7195
if (path == '/')
7296
path <- '/index.html'
7397

74-
abs.path <- file.path(root, path)
75-
76-
if (!file.exists(abs.path)) {
77-
# TODO: This should be 404, not 400
98+
abs.path <- resolve(root, path)
99+
if (is.null(abs.path) && !is.null(sys.root))
100+
abs.path <- resolve(sys.root, path)
101+
if (is.null(abs.path))
78102
return(websockets:::.http_400(ws))
79-
}
80-
81-
abs.path <- normalizePath(abs.path, mustWork=T)
82-
83-
if (nchar(abs.path) <= nchar(root) + 1) {
84-
return(websockets:::.http_400(ws))
85-
}
86-
87-
if (substr(abs.path, 1, nchar(root)) != root ||
88-
!(substr(abs.path, nchar(root)+1, nchar(root)+1) %in% c('/', '\\'))) {
89-
return(websockets:::.http_400(ws))
90-
}
91103

92104
ext <- tools::file_ext(abs.path)
93105
content.type <- switch(ext,
@@ -105,51 +117,19 @@ statics <- function(root) {
105117
})
106118
}
107119

108-
start.app <- function(port = 8101L) {
120+
start.app <- function(app, www.root, sys.www.root=NULL, port=8101L) {
109121

110-
ws_env <- create_server(port=port, webpage=statics('./www'))
122+
ws_env <- create_server(port=port, webpage=statics(www.root, sys.www.root))
111123

112124
set_callback('established', function(WS, ...) {
113125
shinyapp <<- ShinyApp$new(WS)
114-
115-
input <- Observable$new(function() {
116-
str <- shinyapp$session$get('input1')
117-
if (shinyapp$session$get('addnewline'))
118-
str <- paste(str, "\n", sep='')
119-
return(str)
120-
})
121-
input.df <- Observable$new(function() {
122-
varname <- shinyapp$session$get('input1')
123-
if (nchar(varname) > 0 && exists(varname, where=.GlobalEnv)) {
124-
df <- get(varname, pos=.GlobalEnv)
125-
if (is.data.frame(df)) {
126-
return(df)
127-
}
128-
}
129-
return(NULL)
130-
})
131-
shinyapp$define.output('md5_hash', function() {
132-
digest(input$get.value(), algo='md5', serialize=F)
133-
})
134-
shinyapp$define.output('sha1_hash', function() {
135-
digest(input$get.value(), algo='sha1', serialize=F)
136-
})
137-
shinyapp$define.output('table1', function() {
138-
if (!is.null(input.df$get.value()))
139-
print(xtable(input.df$get.value()), type='html')
140-
})
141-
shinyapp$define.plot.output('plot1', function() {
142-
if (!is.null(input.df$get.value()))
143-
plot(input.df$get.value())
144-
}, width=800, height=600)
145-
146126
}, ws_env)
147127

148128
set_callback('closed', function(WS, ...) {
149129
}, ws_env)
150130

151131
set_callback('receive', function(DATA, WS, ...) {
152-
cat(c("RECV", rawToChar(DATA), "\n"))
132+
# cat(c("RECV", rawToChar(DATA), "\n"))
153133

154134
if (identical(charToRaw("\003\xe9"), DATA))
155135
return()
@@ -160,6 +140,27 @@ start.app <- function(port = 8101L) {
160140
init = {
161141
shinyapp$session$mset(msg$data)
162142
flush.react()
143+
local({
144+
define.shiny.output <- function(name, func) {
145+
shinyapp$define.output(name, func)
146+
}
147+
define.shiny.plot <- function(name, func, ...) {
148+
shinyapp$define.plot.output(name, func, ...)
149+
}
150+
define.shiny.table <- function(name, func) {
151+
shinyapp$define.table.output(name, func)
152+
}
153+
get.shiny.input <- function(name) {
154+
shinyapp$session$get(name)
155+
}
156+
157+
if (is.function(app))
158+
app()
159+
else if (is.character(app))
160+
source(app, local=T)
161+
else
162+
warning("Don't know how to configure app; it's neither a function or filename!")
163+
})
163164
shinyapp$instantiate.outputs()
164165
},
165166
update = {
@@ -169,6 +170,8 @@ start.app <- function(port = 8101L) {
169170
shinyapp$flush.output()
170171
}, ws_env)
171172

173+
cat(paste('Listening on http://0.0.0.0:', port, "\n", sep=''))
174+
172175
return(ws_env)
173176
}
174177

‎examples/02_hash/app.R

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
library(digest)
2+
3+
input <- Observable$new(function() {
4+
str <- get.shiny.input('input1')
5+
if (get.shiny.input('addnewline'))
6+
str <- paste(str, "\n", sep='')
7+
return(str)
8+
})
9+
10+
define.shiny.output('md5_hash', function() {
11+
digest(input$get.value(), algo='md5', serialize=F)
12+
})
13+
define.shiny.output('sha1_hash', function() {
14+
digest(input$get.value(), algo='sha1', serialize=F)
15+
})

‎www/index.html renamed to ‎examples/02_hash/www/index.html

Lines changed: 5 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,15 @@
11
<html>
22
<head>
3-
<script src="jquery-1.7.2.js" type="text/javascript"></script>
4-
<script src="shiny.js" type="text/javascript"></script>
5-
<link rel="stylesheet" type="text/css" href="shiny.css"/>
3+
<script src="shared/jquery-1.7.2.js" type="text/javascript"></script>
4+
<script src="shared/shiny.js" type="text/javascript"></script>
5+
<link rel="stylesheet" type="text/css" href="shared/shiny.css"/>
66
</head>
77
<body>
8-
<h1>Example 1: Hash Calculation</h1>
8+
<h1>Example 2: Hash Calculation</h1>
99

1010
<p>
1111
<label>Input:</label><br />
12-
<input name="input1" value="cars"/>
12+
<input name="input1" value="Hello World!"/>
1313
<input type="checkbox" name="addnewline" checked="checked"/> Append newline
1414
</p>
1515

@@ -22,9 +22,5 @@ <h1>Example 1: Hash Calculation</h1>
2222
<label>SHA-1:</label><br />
2323
<pre id="sha1_hash" class="live-text"></pre>
2424
</p>
25-
26-
<div id="table1" class="live-html"></div>
27-
28-
<div id="plot1" class="live-plot"></div>
2925
</body>
3026
</html>

‎examples/03_distributions/app.R

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
data <- Observable$new(function() {
2+
# Choose a distribution function
3+
dist <- switch(get.shiny.input('dist'),
4+
norm = rnorm,
5+
unif = runif,
6+
lnorm = rlnorm,
7+
exp = rexp,
8+
rnorm)
9+
10+
# Generate n values from the distribution function
11+
dist(max(1, get.shiny.input('n')))
12+
})
13+
14+
define.shiny.plot('plot1', function() {
15+
dist <- get.shiny.input('dist')
16+
n <- get.shiny.input('n')
17+
18+
hist(data$get.value(),
19+
main=paste('r', dist, '(', n, ')', sep=''))
20+
}, width=600, height=300)
21+
22+
define.shiny.table('table1', function() {
23+
data.frame(x=data$get.value())
24+
})

‎examples/03_distributions/www/index.html

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
<html>
2+
<head>
3+
<script src="shared/jquery-1.7.2.js" type="text/javascript"></script>
4+
<script src="shared/shiny.js" type="text/javascript"></script>
5+
<link rel="stylesheet" type="text/css" href="shared/shiny.css"/>
6+
</head>
7+
<body>
8+
<h1>Example 3: Distributions</h1>
9+
10+
<p>
11+
<label>Distribution type:</label><br />
12+
<select name="dist">
13+
<option value="norm">Normal</option>
14+
<option value="unif">Uniform</option>
15+
<option value="lnorm">Log-normal</option>
16+
<option value="exp">Exponential</option>
17+
</select>
18+
</p>
19+
20+
<p>
21+
<label>Number of observations:</label><br />
22+
<input type="numeric" name="n" value="500" />
23+
</p>
24+
25+
<div id="plot1" class="live-plot"></div>
26+
27+
<div id="table1" class="live-html"></div>
28+
29+
</body>
30+
</html>

‎run.R

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
source('R/react.R');
2+
source('R/shiny.R');
3+
4+
args <- commandArgs(trailingOnly=T)
5+
6+
if (length(args) == 0) {
7+
stop("Usage: shiny.sh <app_dir>")
8+
}
9+
10+
app.path <- args[1]
11+
12+
app <- start.app(app=file.path(app.path, 'app.R'),
13+
www.root=file.path(app.path, 'www'),
14+
sys.www.root='./www')
15+
run.app(app)

‎shiny.sh

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
#!/bin/sh
2+
3+
R --slave --args $1 < run.R

‎www/jquery-1.7.2.js renamed to ‎www/shared/jquery-1.7.2.js

File renamed without changes.

‎www/shiny.css renamed to ‎www/shared/shiny.css

File renamed without changes.

‎www/shiny.js renamed to ‎www/shared/shiny.js

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -143,7 +143,7 @@
143143
}
144144

145145
var initialValues = {};
146-
$('input').each(function() {
146+
$('input, select').each(function() {
147147
var input = this;
148148
var name = input.name;
149149
var value = elementToValue(input);

0 commit comments

Comments
 (0)