R/mod_app_reserving.R

In MehdiChelh/triangle.tlbx: An Amazing Shiny App

# Module UI
  
#' @title   mod_app_reserving_ui and mod_app_reserving_server
#' @description  A shiny Module.
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_app_reserving
#'
#' @keywords internal
#' @include mod_chainladder.R mod_bootstrap.R
#' @export 
#' @importFrom shiny NS tagList 
mod_app_reserving_ui <- function(id){
  ns <- NS(id)
  # little hack to fix to have better margins
  navBarPageWrapper <- function(el){tags$div(style="margin-top:-15px; margin-left:-30px; margin-right:-30px", el)}
  
  fluidPage(
    navBarPageWrapper(
      customNavbarPage(title = "", id = ns(NULL), selected = "chainladder",
                       mod_chainladder_ui(ns("chainladder")),
                       mod_bootstrap_ui(ns("bootstrap"))
      )
    )
  )
}

# Module Server

#' @rdname mod_app_reserving
#' @export
#' @keywords internal
#' @importFrom golem get_golem_options
#' @import shiny
mod_app_reserving_server <- function(input, output, session){
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #             Initialisation du module      
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  ns <- NS("app") # shiny.router doesn't pass id to callModule
  # TODO: fix this when writing the custom router
  # MVC - Getter et Setter :
  # -----------------
  mvc <- mvc_init_mod(session)
  get <- mvc$get
  setInput <- mvc$setInput
  getInput <- mvc$getInput
  # Local variables :
  # -----------------
  local <- reactiveValues()
  # session$userData
  #   - MZ
  #     - state
  #       - val
  #       - react
  #       - mod_1
  #         - val
  #         - input
  #         - compute
  #
  #       ...
  #
  #       - mod_n
  #         - val
  #         - input
  #         - compute
  #     - bookmarks
  #
  DEV_or_TEST <- isTruthy(get_golem_options("test_mode")) || isTruthy(get_golem_options("dev_mode")) || getOption("shiny.testmode", FALSE)
  path <- system.file("app", package = "triangle.tlbx")
  
  # Le if ci-dessous est juste un petit hack temporaire pour éviter de casser la reactivité si on ne change pas de session.
  # TODO: il faudra changer cette partie là lorsque l'outil pourra ouvrir différents projets
  if (is.null(session$userData$state$data)) {
    session$userData$state <- list("data"=reactiveValues("raw" = if (!DEV_or_TEST) NULL else as.matrix(read.csv(file.path(path, "./data/RAA.CSV"), row.names = 1))),
                                   # (deprecated) line "data" above to be removed
                                   "imported_data" = if (!DEV_or_TEST) reactiveValues() else do.call(reactiveValues, readRDS(file.path(path, "./data/imported_data"))),
                                   "val" = list(),
                                   "global_params"=reactiveValues(),
                                   "react"=reactiveValues(),
                                   "chainladder"=list("compute"=reactiveValues(),
                                                      "input"=reactiveValues()),
                                   "bootstrap"=list("compute"=reactiveValues(),
                                                    "input"=reactiveValues()),
                                   "nav_params"=list("chainladder"=reactiveValues("id"=NULL,
                                                                                  "name"=NULL,
                                                                                  "params"=NULL),
                                                     "bootstrap"=reactiveValues("id"=NULL,
                                                                                "name"=NULL,
                                                                                "params"=NULL)))
    
    session$userData$state$num_files= if (!DEV_or_TEST) 0 else length(session$userData$state$imported_data$ids)
    
    setInput("chainladder", "data-raw_triangle", {
      if (!DEV_or_TEST) NULL else as.matrix(read.csv(file.path(path, "./data/RAA.CSV"), row.names = 1))
    })
    setInput("bootstrap", "data-raw_triangle", {
      if (!DEV_or_TEST) NULL else as.matrix(read.csv(file.path(path, "./data/RAA.CSV"), row.names = 1))
    })
    
    
  }
  
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #                 Sous-modules
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  callModule(mod_chainladder_server, ns("chainladder"))
  callModule(mod_bootstrap_server, ns("bootstrap"))
  
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #                     Observers
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  
  # Import data modal
  # -----------------------------------------------------------------------------------------------------------------
  # Data can be imported through a modal which help the user to see 
  # if the data has been correctly imported.
  
  
  observeEvent(input[[ns("import-data")]], {
    # Open modal
    showModal(mod_import_data_ui(ns("import-data")))
    catch <- callModule(mod_import_data_server, ns("import-data"))
    
    # User validation
    #   - store data
    #   - close modal
    observeEvent(catch$trigger(), {
      req(length(catch$data()) > 0)
      # > imported_data (ReactiveValues)
      #   - indices 1:n (n le nombre de fichiers) liste contenant : 
      #     * Name (character)
      #     * Data (matrix)
      #     * Datapath (character)
      #   - names (list of character)
      #   - ids (list of numeric)
      
      for (e in catch$data()){
        
        session$userData$state$num_files=session$userData$state$num_files+1
        
        session$userData$state$imported_data[[ as.character(session$userData$state$num_files) ]] <- list("name" = e$name(),
                                                                              "data" = e$data(),
                                                                              "datapath" = e$datapath)
         
         session$userData$state$imported_data$names[[session$userData$state$num_files]] <- e$name()
         session$userData$state$imported_data$ids[[ e$name() ]] <- session$userData$state$num_files 
      }
      
      removeModal()
    })
  })
  
  
  # Save project.
  # TODO : implémenter la fonctionnalité
  # -----------------------------------------------------------------------------------------------------------------
  observeEvent(input[[ns("project-save")]], {
    print("Saving project...")
    message("Project saved...")
  })
  
  
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #               Compléments de UI
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  
  # # Bouton de sauvegarde du projet
  # insertUI(selector = ".navbar>.container-fluid",
  #          ui = tags$ul(shinyjs::disabled(tags$li(actionLink(ns("project-save"), " Save project", icon("save")))), class="nav navbar-nav", style="float:right"),
  #          where = "beforeEnd")
  
  
  # # Bouton d'import de données
  # insertUI(selector = ".container-fluid ul.nav.navbar-nav:first",
  #          ui = tags$li(tags$a(tagList("Import data", 
  #                                      tags$i(class="fa fa-file-upload")), 
  #                              id="app-import-data", 
  #                              href="#", 
  #                              class="action-button shiny-bound-input", 
  #                              style="color:#777; font-size:14px")),
  #          where = "afterBegin")
  # 
  # 
  # # Menu "Project"
  # insertUI(selector = ".container-fluid ul.nav.navbar-nav:first",
  #          ui = tags$li(
  #            tags$a(
  #              "Project",
  #              tags$b(class="caret"),
  #              class="dropdown-toggle", `data-toggle`="dropdown", `data-value`="More", `aria-expanded`="false"
  #            ),
  #            tags$ul(
  #              tags$li(
  #                tags$a(
  #                  "Export Project",
  #                  href="#", id=ns("project-export-shiny"), class="action-button"
  #                )
  #              ),
  #              tags$li(
  #                tags$a(
  #                  "Export Excel Template",
  #                  href="#", id=ns("project-export-excel"), class="action-button"
  #                )
  #              ),
  #              class="dropdown-menu", style=""
  #            )
  #          ),
  #          where = "afterBegin")
  
}