diff --git a/NAMESPACE b/NAMESPACE index 30de273..da9e7bc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,4 @@ importFrom(golem,bundle_resources) importFrom(golem,favicon) importFrom(golem,with_golem_options) importFrom(magrittr,"%>%") -importFrom(shiny,NS) importFrom(shiny,shinyApp) -importFrom(shiny,tagList) diff --git a/R/app_server.R b/R/app_server.R index f42c5a5..b9b1a3c 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -35,32 +35,61 @@ app_server <- function( input, output, session ) { session$userData$access_token <- access_token - # SET UP + # SET UP REACTIVE VALUES ################################################### - # manifest + # reactive dash config + dash_config_react <- reactiveVal(NULL) + # reactive data flow manifest + df_manifest_react <- reactiveVal(NULL) + # reactive filtered manifest + filtered_manifest_react <- reactiveVal(NULL) + + # capture selected dcc configuration in a list + selected_dcc_config_list <- list( + project_name = reactiveVal(NULL), + synapse_asset_view = reactiveVal(NULL), + manifest_dataset_id = reactiveVal(NULL), + schema_url = reactiveVal(NULL), + icon = reactiveVal(NULL) + ) + # SELECT A DCC ############################################################# mod_select_dcc_out <- dfamodules::mod_select_dcc_server("select_dcc", dcc_config, access_token) - # on button click (submit in dcc selection module) - # update current tab to be dashboard tab + # CONFIGURE APP ############################################################ + # select a dcc + # show waiter + # generate config + # get manifest + # update reactive values observeEvent(mod_select_dcc_out()$btn_click, { + + # move to dashboard page shinydashboard::updateTabItems(session = session, inputId = "tabs", selected = "tab_dashboard") - }) - - # GENERATE DASHBOARD ON CLICK ############################################## - dash_config_react <- reactive({ + # show waiter on button click + waiter::waiter_show( + html = shiny::tagList( + shiny::img(src = "www/loading.gif"), + shiny::h3("Configuring", style = "color:white;")), + color="#424874" + ) - req(mod_select_dcc_out()) + # update reactiveVals + selected_dcc_config_list$synapse_asset_view(mod_select_dcc_out()$selected_dcc_config$synapse_asset_view) + selected_dcc_config_list$manifest_dataset_id(mod_select_dcc_out()$selected_dcc_config$manifest_dataset_id) + selected_dcc_config_list$project_name(mod_select_dcc_out()$selected_dcc_config$project_name) + selected_dcc_config_list$schema_url(mod_select_dcc_out()$selected_dcc_config$schema_url) + selected_dcc_config_list$icon(mod_select_dcc_out()$selected_dcc_config$icon) - dfamodules::generate_dashboard_config( - schema_url = mod_select_dcc_out()$selected_dcc_config$schema_url, + dash_config <- dfamodules::generate_dashboard_config( + schema_url = selected_dcc_config_list$schema_url(), # display_names = list(contributor = "Contributor", # entityId = "Synapse ID", # dataset = "Data Type", @@ -73,258 +102,178 @@ app_server <- function( input, output, session ) { # released = "Released", # data_portal = "Data Portal", # Component = NA), - icon = mod_select_dcc_out()$selected_dcc_config$icon, + icon = selected_dcc_config_list$icon(), na_replace = list(num_items = "No Manifest", scheduled_release_date = "Not Scheduled", dataset_type = "No Manifest"), base_url = schematic_api_url) - }) - - - # reactive data flow status manifest object - df_manifest_obj_react <- reactive({ - req(mod_select_dcc_out()) - # download data flow manifest - dfamodules::dataset_manifest_download( - asset_view = mod_select_dcc_out()$selected_dcc_config$synapse_asset_view, - dataset_id = mod_select_dcc_out()$selected_dcc_config$manifest_dataset_id, - access_token = access_token, - base_url = schematic_api_url) -}) - - # reactive data flow manifest - df_manifest_react <- reactive({ - req(df_manifest_obj_react()) - req(dash_config_react()) + # download manifest + manifest_obj <- dfamodules::dataset_manifest_download( + asset_view = selected_dcc_config_list$synapse_asset_view(), + dataset_id = selected_dcc_config_list$manifest_dataset_id(), + access_token = access_token, + base_url = schematic_api_url + ) + + # prep manifest for app + prepped_manifest <- dfamodules::prep_manifest_dfa( + manifest = manifest_obj$content, + config = dash_config + ) - dfamodules::prep_manifest_dfa(manifest = df_manifest_obj_react()$content, - config = dash_config_react()) - }) - - # FILTER MANIFEST FOR DASH UI ########################################################### - - # prepare inputs for filter module - filter_inputs <- shiny::reactive({ - - contributor_choices <- unique(df_manifest_react()$contributor) - dataset_choices <- unique(df_manifest_react()$dataset_type) - release_daterange_start <- min(df_manifest_react()$scheduled_release_date, na.rm = TRUE) - release_daterange_end <- max(df_manifest_react()$scheduled_release_date, na.rm = TRUE) - status_choices <- unique(df_manifest_react()$status) - - list(contributor_choices, - dataset_choices, - release_daterange_start, - release_daterange_end, - status_choices) - }) - - output$filter_module <- shiny::renderUI({ - filters <- filter_inputs() - dfamodules::mod_datatable_filters_ui("datatable_filters_1", - contributor_choices = filters[[1]], - dataset_choices = filters[[2]], - release_daterange = c(filters[[3]], filters[[4]]), - status_choices = filters[[5]]) + # update reactiveVals + df_manifest_react(prepped_manifest) + dash_config_react(dash_config) + + # FILTER MANIFEST FOR DASH UI ############################################# + # prepare inputs for filter module + + contributor_choices <- unique(prepped_manifest$contributor) + dataset_choices <- unique(prepped_manifest$dataset_type) + release_daterange_start <- min(prepped_manifest$scheduled_release_date, na.rm = TRUE) + release_daterange_end <- max(prepped_manifest$scheduled_release_date, na.rm = TRUE) + status_choices <- unique(prepped_manifest$status) + + filter_inputs <- list( + contributor_choices, + dataset_choices, + release_daterange_start, + release_daterange_end, + status_choices) + + # FILTER MANIFEST FOR DASH SERVER ######################################## + + output$filter_module <- shiny::renderUI({ + filters <- filter_inputs + dfamodules::mod_datatable_filters_ui( + "datatable_filters_1", + contributor_choices = filters[[1]], + dataset_choices = filters[[2]], + release_daterange = c(filters[[3]], filters[[4]]), + status_choices = filters[[5]]) }) - # FILTER MANIFEST FOR DASH SERVER #################################################### - filtered_manifest <- dfamodules::mod_datatable_filters_server("datatable_filters_1", - df_manifest_react) + filtered_manifest <- dfamodules::mod_datatable_filters_server("datatable_filters_1", + df_manifest_react) + + # DATASET DASH ########################################################### - # DATASET DASH ####################################################################### + dfamodules::mod_datatable_dashboard_server("dashboard_1", + filtered_manifest, + dash_config_react) + + # DATASET DASH VIZ : DISTRIBUTIONS ######################################## + + dfamodules::mod_distribution_server(id = "distribution_contributor", + df = filtered_manifest, + group_by_var = "contributor", + title = NULL, + x_lab = "Contributor", + y_lab = "Number of Datasets", + fill = "#0d1c38") + + dfamodules::mod_distribution_server(id = "distribution_datatype", + df = filtered_manifest, + group_by_var = "dataset_type", + title = NULL, + x_lab = "Type of dataset", + y_lab = "Number of Datasets", + fill = "#0d1c38") + + # hide waiter + waiter::waiter_hide() - dfamodules::mod_datatable_dashboard_server("dashboard_1", - filtered_manifest, - dash_config_react) + }) + - # DATASET DASH VIZ : DISTRIBUTIONS #################################################### - dfamodules::mod_distribution_server(id = "distribution_contributor", - df = filtered_manifest, - group_by_var = "contributor", - title = NULL, - x_lab = "Contributor", - y_lab = "Number of Datasets", - fill = "#0d1c38") + - dfamodules::mod_distribution_server(id = "distribution_datatype", - df = filtered_manifest, - group_by_var = "dataset_type", - title = NULL, - x_lab = "Type of dataset", - y_lab = "Number of Datasets", - fill = "#0d1c38") - # # PREPARE DATA FOR STACKED BAR PLOTS ################################################## - # # specifically stacked bar plots that show data flow status grouped by contributor - # - # stacked_bar_data <- shiny::reactive({ - # - # release_status_data <- filtered_manifest() %>% - # dplyr::group_by(contributor) %>% - # dplyr::group_by(dataset, .add = TRUE) %>% - # dplyr::group_by(data_flow_status, .add = TRUE) %>% - # dplyr::tally() - # - # # reorder factors - # release_status_data$data_flow_status <- factor(release_status_data$data_flow_status, - # levels = c("released", "quarantine (ready for release)", "quarantine", "not scheduled")) - # - # release_status_data - # }) - # - # dfamodules::mod_stacked_bar_server(id = "stacked_bar_release_status", - # df = stacked_bar_data, - # x_var = "contributor", - # y_var = "n", - # fill_var = "data_flow_status", - # title = NULL, - # x_lab = "Contributors", - # y_lab = NULL, - # colors = c("#085631", "#ffa500", "#a72a1e", "#3d3d3d"), - # coord_flip = TRUE) - # - # # drop down for runners plot - # output$select_project_ui <- shiny::renderUI({ - # - # contributors <- unique(filtered_manifest()$contributor) - # - # shiny::selectInput(inputId = "select_project_input", - # label = NULL, - # choices = contributors, - # selectize = FALSE) - # }) - # - # # wrangle data for stacked bar plot (runners) - # - # release_data_runners <- shiny::reactive({ - # - # shiny::req(input$select_project_input) - # - # release_status_data <- filtered_manifest() %>% - # dplyr::filter(!is.na(release_scheduled)) %>% - # dplyr::filter(contributor == input$select_project_input) %>% - # dplyr::group_by(contributor) %>% - # dplyr::group_by(release_scheduled, .add = TRUE) %>% - # dplyr::group_by(data_flow_status, .add = TRUE) %>% - # dplyr::tally() - # - # release_status_data$data_flow_status <- factor(release_status_data$data_flow_status, - # levels = c("released", "quarantine (ready for release)", "quarantine")) - # - # release_status_data - # }) - # - # - # dfamodules::mod_stacked_bar_server(id = "stacked_runners", - # df = release_data_runners, - # x_var = "release_scheduled", - # y_var = "n", - # fill_var = "data_flow_status", - # title = NULL, - # x_lab = "Release Dates", - # y_lab = NULL, - # x_line = Sys.Date(), - # colors = c("#085631", "#ffa500", "#a72a1e"), - # width = 10, - # date_breaks = "1 month", - # coord_flip = FALSE) + # SELECT STORAGE PROJECT ################################################### + + selected_project_id <- reactiveVal(NULL) - # ADMINISTRATOR ####################################################################### - rv_manifest <- reactiveVal() - # reactive value that holds manifest_dfa observe({ - rv_manifest(df_manifest_react()) - }) - - # STORAGE PROJECT SELECTION - - # have to capture in a reactive or else it will not work in select storage module - # FIXME: Convert to reactive value? - reactive_asset_view <- reactive({ - mod_select_dcc_out()$selected_dcc_config$synapse_asset_view - }) - - reactive_manifest_id <- reactive({ - mod_select_dcc_out()$selected_dcc_config$manifest_dataset_id - }) - - reactive_schema_url <- reactive({ - mod_select_dcc_out()$selected_dcc_config$schema_url - }) - - mod_select_storage_project_out <- dfamodules::mod_select_storage_project_server( - id = "select_storage_project_1", - asset_view = reactive_asset_view, - access_token = access_token, - base_url = schematic_api_url) - - # DATASET SELECTION - reactive_project_id <- reactive({ - mod_select_storage_project_out() + + if (input$tabs == "tab_administrator") { + + mod_select_storage_project_out <- dfamodules::mod_select_storage_project_server( + id = "select_storage_project_1", + asset_view = selected_dcc_config_list$synapse_asset_view, + access_token = access_token, + base_url = schematic_api_url) + + selected_project_id(mod_select_storage_project_out()) + } }) - - dataset_selection <- dfamodules::mod_dataset_selection_server( + + mod_dataset_selection_out <- dfamodules::mod_dataset_selection_server( id = "dataset_selection_1", - storage_project_id = reactive_project_id, - asset_view = reactive_asset_view, + storage_project_id = selected_project_id, + asset_view = selected_dcc_config_list$synapse_asset_view, access_token = access_token, base_url = schematic_api_url ) - # UPDATE DATA FLOW STATUS SELECTIONS - updated_data_flow_status <- dfamodules::mod_update_data_flow_status_server("update_data_flow_status_1") - - - # MODIFY MANIFEST - modified_manifest <- shiny::reactive({ - shiny::req(updated_data_flow_status()) - - dfamodules::update_dfs_manifest(dfs_manifest = rv_manifest(), - dfs_updates = updated_data_flow_status(), - selected_datasets_df = dataset_selection()) - }) - - # BUTTON CLICK UPDATE MANIFEST - shiny::observeEvent(input$save_update, { - rv_manifest(modified_manifest()) - }) - - shiny::observeEvent(input$clear_update, { - rv_manifest(manifest_dfa) - }) - - # PREP MANIFEST FOR SYNAPSE SUBMISSION - - manifest_submit <- shiny::reactive({ - dfamodules::prep_manifest_submit(modified_manifest(), - dash_config_react()) - }) - - # get names of selected datasets - selected_row_names <- shiny::reactive({ - dataset_selection()$id - - }) + # ADMINISTRATOR ####################################################################### - dfamodules::mod_highlight_datatable_server("highlight_datatable_1", - manifest_submit, - selected_row_names, - "dataset_id") - # SUBMIT MODEL TO SYNAPSE - # make sure to submit using a manifest that has been run through date to string - dfamodules::mod_submit_model_server(id = "submit_model_1", - dfs_manifest = manifest_submit, - data_type = NULL, - asset_view = reactive_asset_view, - dataset_id = reactive_manifest_id, - manifest_dir = "./manifest", - access_token = access_token, - base_url = schematic_api_url, - schema_url = reactive_schema_url) + # # UPDATE DATA FLOW STATUS SELECTIONS + # updated_data_flow_status <- dfamodules::mod_update_data_flow_status_server("update_data_flow_status_1") + # + # + # # MODIFY MANIFEST + # modified_manifest <- shiny::reactive({ + # shiny::req(updated_data_flow_status()) + # + # dfamodules::update_dfs_manifest( + # dfs_manifest = df_manifest_react(), + # dfs_updates = updated_data_flow_status(), + # selected_datasets_df = mod_dataset_selection_out()$selected_datasets) + # }) + # + # # BUTTON CLICK UPDATE MANIFEST + # # shiny::observeEvent(input$save_update, { + # # rv_manifest(modified_manifest()) + # # }) + # # + # # shiny::observeEvent(input$clear_update, { + # # rv_manifest(manifest_dfa) + # # }) + # + # + # # + # # # PREP MANIFEST FOR SYNAPSE SUBMISSION + # # + # manifest_submit <- shiny::reactive({ + # dfamodules::prep_manifest_submit(modified_manifest(), + # dash_config_react()) + # }) + # + # # get names of selected datasets + # selected_row_names <- shiny::reactive({ + # mod_dataset_selection_out()$selected_datasets()$id + # + # }) + # + # dfamodules::mod_highlight_datatable_server("highlight_datatable_1", + # manifest_submit, + # selected_row_names, + # "dataset_id") + # # + # # SUBMIT MODEL TO SYNAPSE + # # make sure to submit using a manifest that has been run through date to string + # dfamodules::mod_submit_model_server(id = "submit_model_1", + # dfs_manifest = manifest_submit, + # data_type = NULL, + # asset_view = reactive_asset_view, + # dataset_id = reactive_manifest_id, + # manifest_dir = "./manifest", + # access_token = access_token, + # base_url = schematic_api_url, + # schema_url = reactive_schema_url) } diff --git a/R/app_ui.R b/R/app_ui.R index 6616207..aaa4dc4 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -55,13 +55,13 @@ app_ui <- function() { # initialize waiter + use preloader waiter::use_waiter(), - # waiter::waiter_preloader( - # html = shiny::tagList( - # shiny::img(src = "www/loading.gif"), - # shiny::h4("Retrieving Synapse information...", style = "color:white;") - # ), - # color = "#424874" - # ), + waiter::waiter_preloader( + html = shiny::tagList( + shiny::img(src = "www/loading.gif"), + shiny::h4("Retrieving Synapse information...", style = "color:white;") + ), + color = "#424874" + ), # implement dca theme module dcamodules::use_dca(theme = "sage"), @@ -106,21 +106,6 @@ app_ui <- function() { collapsible = TRUE, dfamodules::mod_distribution_ui("distribution_datatype") ) - ), - shiny::fluidRow( - shinydashboard::box( - title = "Release status of all datasets by contributor", - status = "primary", - collapsible = TRUE, - dfamodules::mod_stacked_bar_ui("stacked_bar_release_status") - ), - shinydashboard::box( - title = "Data flow status by release date", - status = "primary", - collapsible = TRUE, - shiny::uiOutput("select_project_ui"), - dfamodules::mod_stacked_bar_ui("stacked_runners") - ) ) ),