Skip to content

Commit 6ac51de

Browse files
pre-init shinyproxy
1 parent 99d9058 commit 6ac51de

File tree

12 files changed

+227
-64
lines changed

12 files changed

+227
-64
lines changed

Dockerfile

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -88,9 +88,6 @@ RUN R -e "install.packages(repos=NULL, '.')" && \
8888
#-----------
8989
from common AS production
9090

91-
# add runner
92-
COPY inst/run.R .
93-
9491
# ----------
9592
# TESTING
9693
#-----------

NAMESPACE

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,20 +5,25 @@ export(bulkPage)
55
export(bulkPageUI)
66
export(check_has_scseq)
77
export(clean_kb_scseq)
8+
export(dir_exists)
89
export(download_kb_index)
910
export(drugsPage)
1011
export(drugsPageUI)
12+
export(file_exists)
1113
export(from_crossmeta)
1214
export(getDeleteRowButtons)
1315
export(get_expression_colors)
1416
export(get_palette)
1517
export(get_presto_markers)
1618
export(get_species)
1719
export(init_dseqr)
20+
export(isTruthy)
1821
export(load_scseq_qs)
22+
export(make_unique)
1923
export(navbar2UI)
2024
export(navbarUI)
2125
export(qread.safe)
26+
export(req)
2227
export(run_dseqr)
2328
export(run_kb_scseq)
2429
export(scPage)

R/modules-sc-utils.R

Lines changed: 40 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2538,17 +2538,38 @@ get_expression_colors <- function(ft.scaled) {
25382538
return(colors)
25392539
}
25402540

2541+
#' Safe file.exists
2542+
#'
2543+
#' @param x file path
2544+
#'
2545+
#' @return a logical vector of TRUE or FALSE values
2546+
#' @export
2547+
#'
25412548
file_exists <- function(x) {
25422549
if (!length(x)) return(FALSE)
25432550
file.exists(x)
25442551
}
25452552

2553+
#' Safe dir.exists
2554+
#'
2555+
#' @param x directory path
2556+
#'
2557+
#' @return a logical vector of TRUE or FALSE values
2558+
#' @export
2559+
#'
25462560
dir_exists <- function(x) {
25472561
if (!length(x)) return(FALSE)
25482562
dir.exists(x)
25492563
}
25502564

25512565

2566+
#' Truthy and falsy values
2567+
#'
2568+
#' @param x An expression whose truthiness value we want to determine
2569+
#'
2570+
#' @return a logical vector of TRUE or FALSE values
2571+
#' @export
2572+
#'
25522573
isTruthy <- function(x) {
25532574
if (inherits(x, 'try-error'))
25542575
return(FALSE)
@@ -2571,6 +2592,14 @@ isTruthy <- function(x) {
25712592
return(TRUE)
25722593
}
25732594

2595+
#' Check for required values
2596+
#'
2597+
#' @param ... Values to check for truthiness.
2598+
#' @param cancelOutput
2599+
#'
2600+
#' @return The first value that was passed in.
2601+
#' @export
2602+
#'
25742603
req <- function(..., cancelOutput = FALSE) {
25752604
shiny:::dotloop(function(item) {
25762605
if (!isTruthy(item)) {
@@ -2588,8 +2617,16 @@ req <- function(..., cancelOutput = FALSE) {
25882617
invisible()
25892618
}
25902619

2591-
make_unique <- function(x, sep = ".") {
2592-
x <- as.character(x)
2593-
make.unique(x, sep = sep)
2620+
#' Make Character Strings Unique
2621+
#'
2622+
#' @param names a character vector.
2623+
#' @param sep a character string used to separate a duplicate name from its sequence number.
2624+
#'
2625+
#' @return A character vector of same length as names with duplicates changed, in the current locale's encoding.
2626+
#' @export
2627+
#'
2628+
make_unique <- function(names, sep = ".") {
2629+
names <- as.character(names)
2630+
make.unique(names, sep = sep)
25942631
}
25952632

R/run_dseqr.R

Lines changed: 27 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -36,11 +36,11 @@
3636
#' if (interactive()) {
3737
#'
3838
#' data_dir <- tempdir()
39-
#' user_name <- 'example'
40-
#' run_dseqr(user_name, data_dir)
39+
#' app_name <- 'example'
40+
#' run_dseqr(app_name, data_dir)
4141
#' }
4242
#'
43-
run_dseqr <- function(user_name,
43+
run_dseqr <- function(app_name,
4444
data_dir,
4545
tabs = c('Single Cell', 'Bulk Data', 'Drugs'),
4646
pert_query_dir = file.path(data_dir, '.pert_query_dir'),
@@ -66,7 +66,7 @@ run_dseqr <- function(user_name,
6666
opts <- list()
6767

6868
# on remote: send errors to slack
69-
if (!is_local) opts$shiny.error <- function() send_slack_error(user_name)
69+
if (!is_local) opts$shiny.error <- function() send_slack_error(app_name)
7070

7171
# allow up to 30GB uploads
7272
opts$shiny.maxRequestSize <- 30*1024*1024^2
@@ -91,8 +91,8 @@ run_dseqr <- function(user_name,
9191

9292
if (missing(data_dir)) stop('data_dir not specified.')
9393

94-
user_dir <- file.path(data_dir, user_name)
95-
if (!dir_exists(user_dir)) init_dseqr(user_name, data_dir)
94+
# user_dir <- file.path(data_dir, app_name)
95+
# if (!dir_exists(user_dir)) init_dseqr(app_name, data_dir)
9696

9797
# ensure various directories exist
9898
# duplicated in server.R for tests
@@ -101,7 +101,8 @@ run_dseqr <- function(user_name,
101101

102102
# pass arguments to app through options then run
103103
shiny::shinyOptions(
104-
user_dir = normalizePath(user_dir),
104+
data_dir = normalizePath(data_dir),
105+
app_name = app_name,
105106
pert_query_dir = normalizePath(pert_query_dir),
106107
pert_signature_dir = normalizePath(pert_signature_dir),
107108
gs_dir = normalizePath(gs_dir),
@@ -153,3 +154,22 @@ init_dseqr <- function(user_name, data_dir = '/srv/dseqr') {
153154
dir.create(file.path(default_dir, 'custom_queries'))
154155

155156
}
157+
158+
run_dseqr_shinyproxy <- function(project_name, host_url) {
159+
160+
is_example <- project_name == 'example'
161+
162+
logout_url <- sprintf('https://%s/logout', host_url)
163+
164+
message('project_name: ', project_name)
165+
message('is_example: ', is_example)
166+
message('logout_url: ', logout_url)
167+
168+
# where to download/load drug and reference data from dseqr.data
169+
Sys.setenv('DSEQR_DATA_PATH' = '/srv/dseqr/.data')
170+
171+
run_dseqr(project_name,
172+
logout_url = logout_url,
173+
is_example = is_example)
174+
175+
}

inst/app/server.R

Lines changed: 61 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -71,8 +71,8 @@ server <- function(input, output, session) {
7171
# shiny::shinyOptions don't make it through
7272

7373
# base directory contains data_dir folder
74-
user_dir <- getShinyOption('user_dir', 'tests/testthat/test_data_dir/test_user')
75-
data_dir <- dirname(user_dir)
74+
app_name <- getShinyOption('app_name', 'test_app')
75+
data_dir <- getShinyOption('data_dir', 'tests/testthat/test_data_dir/')
7676

7777
# path where pert queries will be stored
7878
pert_query_dir <- getShinyOption('pert_query_dir', file.path(data_dir, '.pert_query_dir'))
@@ -92,13 +92,6 @@ server <- function(input, output, session) {
9292
is_example <- getShinyOption('is_example', FALSE)
9393
is_local <- getShinyOption('is_local', TRUE)
9494

95-
# reset testing data
96-
if (isTRUE(getOption('shiny.testmode'))) {
97-
unlink(data_dir, recursive = TRUE)
98-
user_name <- basename(user_dir)
99-
dseqr::init_dseqr(user_name, data_dir)
100-
}
101-
10295
# ensure various directories exist
10396
# duplicated here and in run_dseqr for tests
10497
app_dirs <- c(pert_query_dir, pert_signature_dir, indices_dir, tx2gene_dir, gs_dir)
@@ -108,6 +101,29 @@ server <- function(input, output, session) {
108101
# hide tour button for docs page
109102
observe(shinyjs::toggleClass('start_tour', 'invisible', condition = input$tab == 'Docs'))
110103

104+
user_name <- reactive({
105+
if (app_name == 'example' || is_local) return(app_name)
106+
107+
# app_name is 'private'
108+
user_name <- session$request$HTTP_X_SP_USERID
109+
print('user_name!!!!')
110+
print(user_name)
111+
return(user_name)
112+
})
113+
114+
user_dir <- reactive({
115+
user_name <- user_name()
116+
user_dir <- file.path(data_dir, user_name)
117+
118+
# reset testing data
119+
if (isTRUE(getOption('shiny.testmode')))
120+
unlink(data_dir, recursive = TRUE)
121+
122+
if (!dir_exists(user_dir))
123+
init_dseqr(user_name, data_dir)
124+
125+
return(user_dir)
126+
})
111127

112128
# rintrojs
113129
observeEvent(input$start_tour, {
@@ -164,9 +180,12 @@ server <- function(input, output, session) {
164180
}
165181

166182
# selecting the project
167-
project_choices <- reactiveVal(
168-
list.dirs(user_dir, recursive = FALSE, full.names = FALSE)
169-
)
183+
project_choices <- reactiveVal()
184+
185+
observe({
186+
choices <- list.dirs(user_dir(), recursive = FALSE, full.names = FALSE)
187+
project_choices(choices)
188+
})
170189

171190
observeEvent(input$select_project, {
172191
req(!is_example)
@@ -176,16 +195,18 @@ server <- function(input, output, session) {
176195

177196
projects_table <- reactive({
178197
projects <- project_choices()
198+
project <- project()
199+
req(project)
179200

180-
nsc <- sapply(projects, get_num_sc_datasets, user_dir)
181-
nbulk <- sapply(projects, get_num_bulk_datasets, user_dir)
201+
nsc <- sapply(projects, get_num_sc_datasets, user_dir())
202+
nbulk <- sapply(projects, get_num_bulk_datasets, user_dir())
182203

183204
df <- data.frame(
184205
` ` = getDeleteRowButtons(session, length(projects), title = 'Delete project'),
185206
'Project' = projects,
186207
'Single Cell Datasets' = nsc,
187208
'Bulk Datasets' = nbulk,
188-
selected = ifelse(projects == project(), 'hl', 'other'),
209+
selected = ifelse(projects == project, 'hl', 'other'),
189210
check.names = FALSE,
190211
row.names = NULL
191212
)
@@ -322,7 +343,7 @@ server <- function(input, output, session) {
322343
}
323344

324345
# remove data
325-
unlink(file.path(user_dir, del), recursive = TRUE)
346+
unlink(file.path(user_dir(), del), recursive = TRUE)
326347
removeModal()
327348
})
328349

@@ -344,14 +365,14 @@ server <- function(input, output, session) {
344365
choices[info$row] <- new
345366
project_choices(choices)
346367

347-
new_dir <- file.path(user_dir, new)
368+
new_dir <- file.path(user_dir(), new)
348369

349370
if (prev == "") {
350371
dir.create(new_dir, showWarnings = FALSE)
351372
return(NULL)
352373
}
353374

354-
prev_dir <- file.path(user_dir, prev)
375+
prev_dir <- file.path(user_dir(), prev)
355376

356377
if (dir_exists(prev_dir))
357378
file.rename(prev_dir, new_dir)
@@ -360,21 +381,36 @@ server <- function(input, output, session) {
360381

361382
})
362383

363-
observe(qs::qsave(project(), prev_path))
384+
observe({
385+
project <- project()
386+
req(project)
387+
qs::qsave(project, prev_path())
388+
})
389+
364390

391+
project_dir <- reactive(file.path(user_dir(), project()))
392+
prev_path <- reactive(file.path(user_dir(), 'prev_project.qs'))
365393

366-
prev_path <- file.path(user_dir, 'prev_project.qs')
367-
project <- reactiveVal(qread.safe(prev_path, .nofile = 'default'))
368-
project_dir <- reactive(file.path(user_dir, project()))
394+
project <- reactiveVal()
395+
396+
observe({
397+
project(qread.safe(prev_path(), .nofile = 'default'))
398+
})
369399

370400
sc_dir <- reactive({
371-
sc_dir <- file.path(user_dir, project(), 'single-cell')
401+
project <- project()
402+
req(project)
403+
404+
sc_dir <- file.path(user_dir(), project, 'single-cell')
372405
dir.create(sc_dir, showWarnings = FALSE)
373406
return(sc_dir)
374407
})
375408

376409
bulk_dir <- reactive({
377-
bulk_dir <- file.path(user_dir, project(), 'bulk')
410+
project <- project()
411+
req(project)
412+
413+
bulk_dir <- file.path(user_dir(), project, 'bulk')
378414
dir.create(bulk_dir, showWarnings = FALSE)
379415
return(bulk_dir)
380416
})
@@ -411,7 +447,7 @@ server <- function(input, output, session) {
411447
project <- project()
412448
slack <- readRDS(system.file('extdata/slack.rds', package = 'dseqr'))
413449

414-
workspace <- basename(user_dir)
450+
workspace <- basename(user_dir())
415451
workspace <- ifelse(workspace == user, 'private', workspace)
416452

417453
httr::POST(

inst/run.R

Lines changed: 0 additions & 21 deletions
This file was deleted.

man/dir_exists.Rd

Lines changed: 17 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)