Skip to content

Commit

Permalink
yolo'ing the sets of changes done to have the runr up n running - so …
Browse files Browse the repository at this point in the history
…far uses a propagation of a parameter
  • Loading branch information
federicomarini committed Oct 2, 2024
1 parent 373b2ca commit 193d0b6
Show file tree
Hide file tree
Showing 8 changed files with 451 additions and 354 deletions.
349 changes: 200 additions & 149 deletions R/iSEEindex.R

Large diffs are not rendered by default.

32 changes: 12 additions & 20 deletions R/iSEEindexResource-class.R
Original file line number Diff line number Diff line change
Expand Up @@ -376,29 +376,21 @@ iSEEindexRunrResource <- function(x) {

#' @export
setMethod("precache", "iSEEindexRunrResource",
function(x, bfc, id, ...)
{
# Trim 'runr://' from the original URI and evaluate the R call,
# check that the value is an existing filepath and pass to BiocFileCache,
# which will manage the caching.
# Use action="copy" to leave the original file untouched.
call_string <- sub("runr://", "", x@uri)
env <- new.env()

# fpath not needed per se, we should have a "valid r call and that is it"

object_path <- eval(parse(text = call_string))


# fpath <- eval(parse(text = call_string), envir = env)
# stopifnot(file.exists(fpath))
# object_path <- bfcadd(x = bfc, rname = id, fpath = fpath, action = "copy", ...)

function(x, bfc, id, ...)
{
# Trim 'runr://' from the original URI and evaluate the R call,
# We expect already that an SE object will be returned
call_string <- sub("runr://", "", x@uri)

# fpath not needed per se, we should have a "valid r call and that is it"
# this time it is called object, as it is already returning that
object <- eval(parse(text = call_string))

## "we have to believe" that this is already somehow cached e.g. via
## Bioc data packages using the cache, and many times it is so

return(object_path)
})
return(object)
})



Expand Down
180 changes: 93 additions & 87 deletions R/landing_page.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
#' in the Shiny `selectizeInput()`.
#' @param body.header UI element to display \emph{above} the main landing page body.
#' @param body.footer UI element to display \emph{below} the main landing page body.
#' @param already_se_object TODO to be propagated
#'
#' @return A `function` that defines UI elements and observers for the
#' landing page of the app.
Expand All @@ -24,7 +25,14 @@
#' @importFrom shinyjs disable
#'
#' @rdname INTERNAL_landing_page
.landing_page <- function(bfc, FUN.datasets, FUN.initial, default.add = TRUE, default.position = c("first", "last"), body.header = NULL, body.footer = NULL) {
.landing_page <- function(bfc,
FUN.datasets,
FUN.initial,
default.add = TRUE,
default.position = c("first", "last"),
body.header = NULL,
body.footer = NULL,
already_se_object) {
default.position <- match.arg(default.position)
# datasets
datasets_available_list <- FUN.datasets()
Expand Down Expand Up @@ -95,7 +103,7 @@

.create_observers(input, session, pObjects, rObjects, FUN.initial, default.add, default.position)

.create_launch_observers(FUN, bfc, input, session, pObjects)
.create_launch_observers(FUN, bfc, input, session, pObjects, already_se_object = already_se_object)

.render_datasets_table(output, pObjects, rObjects)

Expand All @@ -110,91 +118,89 @@





.landing_page_runr <- function(bfc, FUN.datasets, FUN.initial, default.add = TRUE, default.position = c("first", "last"), body.header = NULL, body.footer = NULL) {
default.position <- match.arg(default.position)
# datasets
datasets_available_list <- FUN.datasets()
.check_datasets_list(datasets_available_list)
datasets_available_table <- .datasets_to_dataframe(datasets_available_list)
# initial configurations
initial_available_list <- FUN.initial()
.check_initial_list(initial_available_list)
initial_available_table <- .initial_to_dataframe(initial_available_list, datasets_available_table[[.datasets_id]])
# landing page function (return value)
function (FUN, input, output, session) {
# nocov start
output$allPanels <- renderUI({
tagList(
body.header,
fluidRow(
column(width = 7L,
shinydashboard::box(title = "Available Data Sets",
collapsible = FALSE, width = NULL,
selectizeInput(.ui_dataset_columns, label = "Show columns:",
choices = setdiff(colnames(datasets_available_table), c(.datasets_id, .datasets_uri, .datasets_description)),
selected = c(.datasets_title),
multiple = TRUE,
options = list(plugins=list('remove_button', 'drag_drop'))),
DTOutput(.ui_dataset_table)
)),
column(width = 5L,
shinydashboard::tabBox(id = .ui_box_dataset, title = "Selected dataset",
side = "left",
width = NULL,
tabPanel("Info",
uiOutput(.ui_markdown_overview)),
tabPanel("Configure and launch",
fluidRow(
column(width = 10L,
selectizeInput(.ui_initial, label = "Initial settings:",
choices = character(0))),
column(width = 2L,
br(),
actionButton(.ui_launch_button, label="Launch!",
style="color: #ffffff; background-color: #0092AC; border-color: #2e6da4"))
),
uiOutput(.ui_initial_overview))
)
)
),
body.footer
) # tagList
}) # renderUI

## Disable navbar buttons that are not linked to any observer yet
shinyjs::disable(iSEE:::.generalOrganizePanels) # organize panels
shinyjs::disable(iSEE:::.generalLinkGraph) # link graph
shinyjs::disable(iSEE:::.generalExportOutput) # export content
shinyjs::disable(iSEE:::.generalCodeTracker) # tracked code
shinyjs::disable(iSEE:::.generalPanelSettings) # panel settings
shinyjs::disable(iSEE:::.generalVignetteOpen) # open vignette
shinyjs::disable(iSEE:::.generalSessionInfo) # session info
shinyjs::disable(iSEE:::.generalCitationInfo) # citation info

pObjects <- .create_persistent_objects(
datasets_available_table,
initial_available_table)
rObjects <- reactiveValues(
rerender_datasets=1L,
rerender_overview=1L,
rerender_initial=1L)

.create_observers(input, session, pObjects, rObjects, FUN.initial, default.add, default.position)

.create_launch_observers_runr(FUN, bfc, input, session, pObjects)

.render_datasets_table(output, pObjects, rObjects)

.render_markdown_overview(output, pObjects, rObjects)

.render_initial_overview(output, pObjects, rObjects)

invisible(NULL)
# nocov end
}
}
# .landing_page_runr <- function(bfc, FUN.datasets, FUN.initial, default.add = TRUE, default.position = c("first", "last"), body.header = NULL, body.footer = NULL) {
# default.position <- match.arg(default.position)
# # datasets
# datasets_available_list <- FUN.datasets()
# .check_datasets_list(datasets_available_list)
# datasets_available_table <- .datasets_to_dataframe(datasets_available_list)
# # initial configurations
# initial_available_list <- FUN.initial()
# .check_initial_list(initial_available_list)
# initial_available_table <- .initial_to_dataframe(initial_available_list, datasets_available_table[[.datasets_id]])
# # landing page function (return value)
# function (FUN, input, output, session) {
# # nocov start
# output$allPanels <- renderUI({
# tagList(
# body.header,
# fluidRow(
# column(width = 7L,
# shinydashboard::box(title = "Available Data Sets",
# collapsible = FALSE, width = NULL,
# selectizeInput(.ui_dataset_columns, label = "Show columns:",
# choices = setdiff(colnames(datasets_available_table), c(.datasets_id, .datasets_uri, .datasets_description)),
# selected = c(.datasets_title),
# multiple = TRUE,
# options = list(plugins=list('remove_button', 'drag_drop'))),
# DTOutput(.ui_dataset_table)
# )),
# column(width = 5L,
# shinydashboard::tabBox(id = .ui_box_dataset, title = "Selected dataset",
# side = "left",
# width = NULL,
# tabPanel("Info",
# uiOutput(.ui_markdown_overview)),
# tabPanel("Configure and launch",
# fluidRow(
# column(width = 10L,
# selectizeInput(.ui_initial, label = "Initial settings:",
# choices = character(0))),
# column(width = 2L,
# br(),
# actionButton(.ui_launch_button, label="Launch!",
# style="color: #ffffff; background-color: #0092AC; border-color: #2e6da4"))
# ),
# uiOutput(.ui_initial_overview))
# )
# )
# ),
# body.footer
# ) # tagList
# }) # renderUI
#
# ## Disable navbar buttons that are not linked to any observer yet
# shinyjs::disable(iSEE:::.generalOrganizePanels) # organize panels
# shinyjs::disable(iSEE:::.generalLinkGraph) # link graph
# shinyjs::disable(iSEE:::.generalExportOutput) # export content
# shinyjs::disable(iSEE:::.generalCodeTracker) # tracked code
# shinyjs::disable(iSEE:::.generalPanelSettings) # panel settings
# shinyjs::disable(iSEE:::.generalVignetteOpen) # open vignette
# shinyjs::disable(iSEE:::.generalSessionInfo) # session info
# shinyjs::disable(iSEE:::.generalCitationInfo) # citation info
#
# pObjects <- .create_persistent_objects(
# datasets_available_table,
# initial_available_table)
# rObjects <- reactiveValues(
# rerender_datasets=1L,
# rerender_overview=1L,
# rerender_initial=1L)
#
# .create_observers(input, session, pObjects, rObjects, FUN.initial, default.add, default.position)
#
# .create_launch_observers(FUN, bfc, input, session, pObjects, already_se_object = TRUE)
#
# .render_datasets_table(output, pObjects, rObjects)
#
# .render_markdown_overview(output, pObjects, rObjects)
#
# .render_initial_overview(output, pObjects, rObjects)
#
# invisible(NULL)
# # nocov end
# }
# }



Expand Down
31 changes: 18 additions & 13 deletions R/observers.R
Original file line number Diff line number Diff line change
Expand Up @@ -65,33 +65,38 @@

#' @param FUN A function to initialize the \pkg{iSEE} observer
#' architecture. Refer to [iSEE::createLandingPage()] for more details.
#'
#' @param bfc A [BiocFileCache()] object.
#' landing page.
#' @param input TODO
#' @param session TODO
#' @param pObjects TODO
#' @param already_se_object TODO
#'
#' @importFrom shiny observeEvent
#'
#' @rdname INTERNAL_create_observers
.create_launch_observers <- function(FUN, bfc, input, session, pObjects) {
.create_launch_observers <- function(FUN, bfc, input, session, pObjects, already_se_object) {

# nocov start
observeEvent(input[[.ui_launch_button]], {
.launch_isee(FUN, bfc, session, pObjects)
.launch_isee(FUN, bfc, session, pObjects, already_se_object = already_se_object)
}, ignoreNULL=TRUE, ignoreInit=TRUE)
# nocov end

invisible(NULL)
}



.create_launch_observers_runr <- function(FUN, bfc, input, session, pObjects) {

# nocov start
observeEvent(input[[.ui_launch_button]], {
.launch_isee_runr(FUN, bfc, session, pObjects)
}, ignoreNULL=TRUE, ignoreInit=TRUE)
# nocov end

invisible(NULL)
}
#
# .create_launch_observers_runr <- function(FUN, bfc, input, session, pObjects) {
#
# # nocov start
# observeEvent(input[[.ui_launch_button]], {
# .launch_isee(FUN, bfc, session, pObjects, already_se_object = TRUE)
# }, ignoreNULL=TRUE, ignoreInit=TRUE)
# # nocov end
#
# invisible(NULL)
# }

Loading

0 comments on commit 193d0b6

Please sign in to comment.