server.R

# Define server logic
server <- function(input, output, session) {

  ################################################################################################
  # RELOAD
  observeEvent(input$reload_btn, {
    session$reload()
  })
  ################################################################################################
  
  layers <- callModule(reactiveLayersModule, id = "reactiveLayersModule")

  # tab and module-level reactives
  module <- reactive({
    input$tabs
  })

  reactiveValsList <- list(
    insertedTabs = reactiveVal(c()),
    subunit_names = reactiveVal(NULL),
    selected_subunits = reactiveValues(selected = character()),
    mapCache = reactiveVal(0),
    sppListCache = reactiveVal(NULL),
    sppDisplay = reactiveVal(NULL),
    sppSelectCache = reactiveVal(NULL),
    bcrCache = reactiveVal(NULL),
    bcrPred =  reactiveVal(NULL),
    inserted_ids = reactiveVal(character()),
    data_ready = reactiveVal(FALSE),
    pop_module_out = reactiveVal(NULL),
    band = reactiveVal(NULL),
    sppOnMap = reactiveVal(NULL)
  )
  
  ######################## #
  ### GUIDANCE TEXT ####
  ######################## #
  # UI for component guidance text
  output$gtext_module <- renderUI({
    req(input$tabs)
    file <- file.path('Rmd', glue("gtext_{input$tabs}.Rmd"))
    if (!file.exists(file)) return()
    includeMarkdown(file)
  })

  # Control right Panel
  output$rightPanel <- renderUI({
    if (input$tabs == "data") {
      tabsetPanel(
        tabPanel("Download",
                 bandUI("explore_module"),
                 sppUI("explore_module"),
                 dwdUI("explore_module")
        )
      )
    } else if(input$tabs == "popstats"){
      tabsetPanel(
        tabPanel("Download",
                 br(),
                 br(),
                 sppUI("explore_module"),
                 dwdUI("explore_module")
        )
      )
    }
  })
  
  observe({
    if (input$tabs == "data") {
      shinyjs::show("explore_module-band")
      shinyjs::show("explore_module-bandDef")
      shinyjs::show("explore_module-dwdNMoutput")
      shinyjs::show("explore_module-speciesboxes")
    } else if (input$tabs == "popstats") {
      shinyjs::hide("explore_module-band")
      shinyjs::show("explore_module-speciesboxes")
      shinyjs::show("explore_module-dwdNMoutput")
      shinyjs::show("explore_module-bandDef")
    }
  })
  # Help Component
 # help_modules <- c("data", "dist")
  #lapply(help_modules, function(module) {
  #  btn_id <- paste0(module, "Help")
  #  observeEvent(input[[btn_id]], updateTabsetPanel(session, "main", "Module Guidance"))
  #})

  ######################## #
  ### MAPPING LOGIC ####
  ######################## #
  # Initialize Leaflet map centered on Canada
  output$myMap <- renderLeaflet({
    
    leaflet() %>%
      addMapPane(name = "ground", zIndex=380) %>%
      addMapPane(name = "overlay", zIndex=420) %>%
      #add listener
      htmlwidgets::onRender("
      function(el, x) {
        var map = this;
        map.on('baselayerchange', function(e) {
          Shiny.setInputValue('active_raster', e.name, {priority: 'event'});
        });
      }
    ") %>%
      addProviderTiles("CartoDB.Positron", group="baseMap") %>%
      leafem::addMouseCoordinates() %>%
      # Fit bounds to Canada's extent
      fitBounds(lng1 = -141.0, lat1 = 42, lng2 = -52.0, lat2 = 70) %>%
      addLayersControl(position = "topright",
                       options = layersControlOptions(collapsed = FALSE))
  })

  # Create map proxy for updates
  myMap <- leafletProxy("myMap", session)

  ########################## #
  ########################## #
  ### ACCESS THE DATA   ###
  ########################## #
  ########################## #
  # Provide species UI
  observeEvent(input$tabs, {
    req(input$tabs == "data")
    
    callModule(
      exploreSERVER, "explore_module",
      spp_list = spp_tbl,
      layers = layers,
      myMap = myMap,
      reactiveVals = reactiveValsList  # Pass the entire list
    )
    
  })
  
  #build legend on selected species
  #observeEvent(input$active_raster, {
  observe({
    req(input$active_raster, reactiveValsList$band())
    selected <- input$active_raster
    req(selected)
    #browser()
    r_bird <- reactiveValsList$sppSelectCache()[[selected]]
    band_index <- as.numeric(reactiveValsList$band())
    r <- r_bird[[band_index]]
    req(r)
    
    # Dynamically set legend title
    legend_title <- switch(reactiveValsList$band(),
      "1" = "Mean Density (males/ha)",
      "Variation in density")
    
    #pal <- colorNumeric("YlGnBu", values(r), na.color = "transparent")
    #rng <- range(values(r), na.rm = TRUE)
    #breaks <- seq(rng[1], rng[2], length.out = 6)
    
    
    
    # Option 1
    #vals <- values(r)
    #vals <- vals[!is.na(vals)]
    #
    # Define your custom palette
    #my_colors <- c(
    #  '#f9ffaf', '#edef5c', '#bbdf5f', '#61c074', 
    #  '#34af7c', '#008c80', '#007a7c', '#255668'
    #)
    
    ## Compute range and breaks
    #rng <- range(vals, na.rm = TRUE)
    #breaks <- seq(rng[1], rng[2], length.out = length(my_colors) + 1)
    
    #leafletProxy("myMap") %>%
    #  clearControls() %>%
    #  addLegend(
    #    colors = my_colors,
    #    labels = sprintf("%.4f", breaks[-1]),
    #    title = legend_title,
     #   position = "bottomright",
    #    opacity = 1
    #  )
    
    # Option2
    r[r ==0] <- NA
    vals <- values(r)
    rng_trim <- quantile(vals, probs = c(0.0025, 0.9975), na.rm = TRUE)
    
    my_colors <- c(
      '#f9ffaf', '#edef5c', '#bbdf5f', '#61c074', 
      '#34af7c', '#008c80', '#007a7c', '#255668'
    )
    pal <- colorBin(
      palette = my_colors,
      domain = vals,
      bins = seq(rng_trim[1], rng_trim[2], length.out = length(my_colors) + 1),
      na.color = "transparent"
    )
    
    leafletProxy("myMap") %>%
        clearControls() %>%
        addLegend(
          pal = pal,
          values = vals,
          title = legend_title,
         position = "bottomright",
          opacity = 1,
         labFormat = labelFormat(
           digits = 4
         )
        )
  })
  
  
  ################################################################################################
  # Observe on tabs
  ################################################################################################
  observe({
    req(input$`pop_module-popAnalysis`)
    if (input$`pop_module-popAnalysis` == "popArea") {
      # switch away if user tries to view Population table
      updateTabsetPanel(session, "centerPanel", selected = "Species occurrence")
    }else{
      updateTabsetPanel(session, "centerPanel", selected = "Map View")
    }
  })
  
  ########################### #
  ########################### #
  ### POPULATION ESTIMATES  ###
  ########################### #
  ########################### #
  
  observeEvent(input$tabs, {
    req(input$tabs == "popstats")
    
    # Need to run getLayerNM first
    if (!isTRUE(reactiveValsList$data_ready())) {
      showModal(modalDialog(
        title = "Data not ready",
        "Please run the Model Access tool before using the Population Distribution tool",
        easyClose = TRUE,
        footer = modalButton("OK")
      ))
      return(NULL)  # stop here
    }
    
    callModule(
      popSERVER, "pop_module",
      layers = layers,
      myMap = myMap,
      reactiveVals = reactiveValsList  # Pass the entire list
    )
    
  })
  
  ############################ #
  ############################ #
  ### PREDICTORS IMPORTANCE  ###
  ############################ #
  ############################ #
  observeEvent(input$tabs, {
    req(input$tabs == "pred")
    
    callModule(
      predSERVER, "pred_module",
      layers = layers,
      reactiveVals = reactiveValsList  # Pass the entire list
    )
    
  })
}