In shinyscholar: A Template for Creating Reproducible 'shiny' Applications

function(input, output, session) {

  ########################## #
  # INTRODUCTION ####
  ########################## #

  core_intro_module_server("core_intro")

  ########################## #
  # LOGGING ####
  ########################## #

  initLogMsg <- function() {
    intro <- "***WELCOME TO {{toupper(app_library)}}***"
    brk <- paste(rep("------", 14), collapse = "")
    expl <- "Please find messages for the user in this log window."
    logInit <- gsub(".{4}$", "", paste(intro, brk, expl, brk, "", sep = "<br>"))
    logInit
  }
  common$logger <- reactiveVal(initLogMsg())

  # Write out logs to the log Window
  observeEvent(common$logger(), {
    shinyjs::html(id = "logHeader", html = common$logger(), add = FALSE)
    shinyjs::js$scrollLogger()
  })

```r}} output$running_tasks <- renderText({ status <- unlist(lapply(common$tasks, function(x){x$status()})) running <- length(status[status == "running"]) if (running == 0){ message <- "There are currently no tasks running" } if (running == 1){ message <- "There is currently 1 task running" } if (running > 1){ message <- glue::glue("There are currently {running} tasks running") } message })

```r
########################## #
  # REACTIVE VALUES LISTS ####
  ########################## #

  # tab and module-level reactives
  component <- reactive({
    input$tabs
  })
  observe({
    if (component() == "_stopapp") {
      shinyjs::runjs("window.close();")
      stopApp()
    }
  })
  module <- reactive({
    if (component() == "intro") "intro"
    else input[[glue("{component()}Sel")]]
  })

  ######################## #
  ### GUIDANCE TEXT ####
  ######################## #

  # UI for component guidance text
  output$gtext_component <- renderUI({
    file <- file.path("Rmd", glue("gtext_{component()}.Rmd"))
    if (!file.exists(file)) return()
    includeMarkdown(file)
  })

  # UI for module guidance text
  output$gtext_module <- renderUI({
    req(module())
    file <- COMPONENT_MODULES[[component()]][[module()]]$instructions
    if (is.null(file)) return()
    includeMarkdown(file)
  })

  # Help Component
  help_components <- COMPONENTS[!COMPONENTS == "rep"]
  lapply(help_components, function(component) {
    btn_id <- paste0(component, "Help")
    observeEvent(input[[btn_id]], updateTabsetPanel(session, "main", "Component Guidance"))
  })

  # Help Module
  lapply(help_components, function(component) {
    lapply(COMPONENT_MODULES[[component]], function(module) {
      btn_id <- paste0(module$id, "Help")
      observeEvent(input[[btn_id]], updateTabsetPanel(session, "main", "Module Guidance"))
      })})

```r}}
######################## # ### MAP TAB #### ######################## #

map <- core_mapping_module_server("core_mapping", common, input, COMPONENT_MODULES)

```r}}
  ############################################# #
  ### TABLE TAB ####
  ############################################# #

  sample_table <- reactive({
  sample_table <- data.frame('a' = c(1:10), b = c(11:20))
  sample_table
  })

  # TABLE
  output$table <- DT::renderDataTable({
    sample_table()
  }, rownames = FALSE, options = list(scrollX = TRUE))

  # DOWNLOAD
  output$dl_table <- downloadHandler(
    filename = function() {
      "{{app_library}}_sample_table.csv"
    },
    content = function(file) {
      write.csv(sample_table(), file, row.names = FALSE)
    }
  )

```r}} ############################################# # ### CODE TAB #### ############################################# # observe({ req(module()) module <- module() core_code_module_server("core_code", common, module) })

```r
  ############################################# #
  ### RUN MODULE ON ENTER ####
  ############################################# #

  observe({
    shinyjs::js$runOnEnter(module())
  })

```r}} #################### ### INITIALISATION #### ###################

# Initialize all modules init("intro") modules <- list() lapply(names(COMPONENT_MODULES), function(component) { lapply(COMPONENT_MODULES[[component]], function(module) { # Initialize event triggers for each module init(module$id) if (module$id == "rep_markdown"){ return <- do.call(get(module$server_function), args = list(id = module$id, common = common, parent_session = session, COMPONENT_MODULES)) } else { return <- do.call(get(module$server_function), args = list(id = module$id, common = common, parent_session = session)) } if (is.list(return) && "save" %in% names(return) && is.function(return$save) && "load" %in% names(return) && is.function(return$load)) { modules[[module$id]] <<- return } }) })

```r}}
  ####################
  ### INITIALISATION ####
  ###################

  # Initialize all modules
  init("intro")
  modules <- list()
  lapply(names(COMPONENT_MODULES), function(component) {
    lapply(COMPONENT_MODULES[[component]], function(module) {
      # Initialize event triggers for each module
      init(module$id)
       if (module$id == "rep_markdown"){
        return <- do.call(get(module$server_function), args = list(id = module$id, common = common, parent_session = session, map = map, COMPONENT_MODULES))
      } else {
      return <- do.call(get(module$server_function), args = list(id = module$id, common = common, parent_session = session, map = map))
      }
      if (is.list(return) &&
          "save" %in% names(return) && is.function(return$save) &&
          "load" %in% names(return) && is.function(return$load)) {
        modules[[module$id]] <<- return
      }
    })
  })

  ################################
  ### SAVE / LOAD FUNCTIONALITY ####
  ################################

  core_save_module_server("core_save", common, modules, COMPONENTS, input)

```r}}
core_load_module_server("core_load", common, modules, map, COMPONENT_MODULES, parent_session = session)

```r}}  
  core_load_module_server("core_load", common, modules, COMPONENT_MODULES, parent_session = session)

  ################################
  ### RESET ####
  ################################

  observeEvent(input$reset, {
    reset_data(common)
  })

  ################################
  ### EXPORT TEST VALUES ####
  ################################
  exportTestValues(common = common,
                   logger = common$logger())
}