inst/shiny/modules/core_load.R

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

core_load_module_ui <- function(id) {
  ns <- shiny::NS(id)
  tagList(
  h4("Load session"),
  includeMarkdown("Rmd/text_loadsesh.Rmd"),
  fileInput(ns("load_session"), "", accept = ".rds"),
  actionButton(ns("goLoad_session"), "Load RDS")
  )
  }

core_load_module_server <- function(id, common, modules, map, COMPONENT_MODULES, parent_session) {
  moduleServer(id, function(input, output, session) {

    observe({
      shinyjs::toggleState("goLoad_session", !is.null(input$load_session$datapath))
    })

    load_session <- function(temp){

      if (!inherits(temp, "common") || temp$state$main$app != "shinyscholar"){
        close_loading_modal()
        common$logger |> writeLog(type = "error", "That is not a valid Shinyscholar save file")
        return()
      }

      # reload old logs, minus header. if required for testing
      if ("logger" %in% names(temp)){
        common$logger |> writeLog(temp$logger)
      }

      if (temp$state$main$version != as.character(packageVersion("shinyscholar"))){
        current_version <- as.character(packageVersion("shinyscholar"))
        common$logger |> writeLog(type = "warning",
                      glue::glue("The save file was created using shinyscholar v{temp$state$main$version},
                                 but you are using shinyscholar v{current_version}"))
      }

      temp_names <- names(temp)
      # exclude the logger
      temp_names <- temp_names[temp_names != "logger"]
      common_names <- names(common)
      for (name in temp_names){
        if (name %in% common_names){
          common[[name]] <- temp[[name]]
        }
      }

      # Ask each module to load its own data
      for (module_id in names(common$state)) {
        if (module_id != "main"){
          modules[[module_id]]$load(common$state[[module_id]])
        }}

      for (component in names(common$state$main$selected_module)) {
        value <- common$state$main$selected_module[[component]]
        updateRadioButtons(parent_session, glue("{component}Sel"), selected = value)
      }

      #required due to terra objects being pointers to c++ objects
      common$raster <- terra::unwrap(common$raster)

      #restore map and results for used modules
      for (used_module in names(common$meta)){
        trigger(used_module) # to replot results
        component <- strsplit(used_module, "_")[[1]][1]
        map_fx <- COMPONENT_MODULES[[component]][[used_module]]$map_function
        if (!is.null(map_fx)) {
          do.call(map_fx, list(map, common = common))
        }
      }
    }

    observeEvent(input$goLoad_session, {
      temp <- readRDS(input$load_session$datapath)
      load_session(temp)
      common$logger |> writeLog(type="info", "The previous session has been loaded successfully")
    })

    # load file if run_shinyscholar has a load_file parameter
    load_file_path <- reactive({if (exists("load_file_path", envir = .GlobalEnv)) {
      get("load_file_path", envir = .GlobalEnv)
    } else {
      NULL
    }})

    load_on_start <- observe({
      req(load_file_path())
      if (!file.exists(load_file_path())){
        common$logger |> writeLog(type = "error", "The specified load file cannot be found - please check the path")
        load_on_start$destroy()
        return()
      }
      show_loading_modal("Loading previous session")
      load_session(readRDS(load_file_path()))
      close_loading_modal()
      common$logger |> writeLog(type = "info", "The previous session has been loaded successfully")
      load_on_start$destroy()
    })



  }
)}