rshinyr-leafletshinymodules

Is it possible to refer to namespace from another module?


I want to refer to the namespace ns("map") from second server module mod_btn_server2. This module is nested in first server module mod_btn_server1. When I click 'Button 2' points should show up on a map but they didn't. Is it possible at all to refer to "map" from nested module?

Here's working example:

library(shiny)
library(mapboxer)
library(dplyr)
library(sf)
library(leaflet)


moduleServer <- function(id, module) {
    callModule(module, id)
}

# UI 1 #
mod_btn_UI1 <- function(id) {
    
    ns <- NS(id)
    tagList(
        actionButton(ns("btn1"), "Button 1"),
        mod_btn_UI2(ns("moduleServer2")),
        leafletOutput(ns("map"))
    )
}

# Server 1 #
mod_btn_server1 <- function(id){
    moduleServer(id, function(input, output, session) {
        
      ns <- NS(id)
      
      coords <- quakes %>%
        sf::st_as_sf(coords = c("long","lat"), crs = 4326)
            
      mod_btn_server2("moduleServer2", coords) # here is nested module2
         
        output$map <- leaflet::renderLeaflet({
          leaflet::leaflet() %>% 
            leaflet::addTiles() %>% 
            leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
            leaflet::addCircleMarkers(
              data = coords,
              stroke = FALSE,
              radius = 6)
        })

        observeEvent(input$btn1, {
            leaflet::leafletProxy("map", data = coords) %>%
                leaflet::addCircles()
        })
             
    })
}

# Module 2 - UI #
mod_btn_UI2 <- function(id){
  ns <- NS(id)
    actionButton(ns("btn2"), "Button 2"),
}

# Module 2 - server #
mod_btn_server2 <- function(id, dataMod){
  moduleServer(id, function(input, output, session) {
    
    ns <- NS(id)
    
    output$map <- leaflet::renderLeaflet({
      leaflet::leaflet() %>% 
        leaflet::addTiles() %>% 
        leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
        leaflet::addCircleMarkers(
          data = dataMod,
          stroke = TRUE,
          color = "red",
          radius = 6)
    })
    
# and here I refer to 'map' located in the first module
    observeEvent(input$btn2, {
      leaflet::leafletProxy("map", data = dataMod) %>%
        leaflet::addCircles()
    })
    
  })
}


# App #

ui <- fluidPage(
    
    tagList(
        mod_btn_UI1("test-btn"))

)

server <- function(input, output, session) {
    
    mod_btn_server1("test-btn")
    
}

shinyApp(ui = ui, server = server)

Solution

  • As I mentioned in my comment above, the canonical way would be to capture the button push as an output of module moduleServer2 and use this as an input for test-btn where you perform the action.

    However, if you want to mess around with the namespaces by yourself (not recommended), you can use the following solution. I had to adapt the leafletProxy function, because the normal implementation automatically adds the namespace of the calling module. This is what you don't want, because you want to use the namespace of a different module.

    Now with code adapted to the edit:

    library(shiny)
    library(mapboxer)
    library(dplyr)
    library(sf)
    library(leaflet)
    
    leafletProxy2 <- function (mapId, session = shiny::getDefaultReactiveDomain(), 
                               data = NULL, deferUntilFlush = TRUE) 
    {
      if (is.null(session)) {
        stop("leafletProxy must be called from the server function of a Shiny app")
      }
      structure(list(session = session, id = mapId, x = structure(list(), 
                                                                  leafletData = data), deferUntilFlush = deferUntilFlush, 
                     dependencies = NULL), class = "leaflet_proxy")
    }
    
    # UI 1 #
    mod_btn_UI1 <- function(id) {
      
      ns <- NS(id)
      tagList(
        actionButton(ns("btn1"), "Button 1"),
        mod_btn_UI2(ns("moduleServer2")),
        leafletOutput(ns("map"))
      )
    }
    
    # Server 1 #
    mod_btn_server1 <- function(id){
      moduleServer(id, function(input, output, session) {
        
        coords <- quakes %>%
          sf::st_as_sf(coords = c("long","lat"), crs = 4326)
        
           mod_btn_server2("moduleServer2", coords) # here is nested module2
        
        output$map <- leaflet::renderLeaflet({
          leaflet::leaflet() %>% 
            leaflet::addTiles() %>% 
            leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
            leaflet::addCircleMarkers(
              data = coords,
              stroke = FALSE,
              radius = 6)
        })
        
        observeEvent(input$btn1, {
          leaflet::leafletProxy("map", data = coords) %>%
            leaflet::addCircles()
        })
        
      })
    }
    
    # Module 2 - UI #
    mod_btn_UI2 <- function(id){
      ns <- NS(id)
      actionButton(ns("btn2"), "Button 2")
    }
    
    # Module 2 - server #
    mod_btn_server2 <- function(id, dataMod, btn){
      moduleServer(id, function(input, output, session) {
        
        # and here I refer to 'map' located in the first module
        observeEvent(input$btn2, {
          leafletProxy2("test-btn-map", data = dataMod) %>%
            leaflet::addCircles(stroke = TRUE,
                                color = "red")
        })
        
      })
    }
    
    
    # App #
    
    ui <- fluidPage(
      
      tagList(
        mod_btn_UI1("test-btn"))
      
    )
    
    server <- function(input, output, session) {
      
      mod_btn_server1("test-btn")
      
    }
    
    shinyApp(ui = ui, server = server)
    

    Here is a more canonical form that works with the correct input/output of modules and doesn't mess with namespaces:

    library(shiny)
    library(mapboxer)
    library(dplyr)
    library(sf)
    library(leaflet)
    
    # UI 1 #
    mod_btn_UI1 <- function(id) {
      
      ns <- NS(id)
      tagList(
        actionButton(ns("btn1"), "Button 1"),
        mod_btn_UI2(ns("moduleServer2")),
        leafletOutput(ns("map"))
      )
    }
    
    # Server 1 #
    mod_btn_server1 <- function(id){
      moduleServer(id, function(input, output, session) {
        
        ns <- NS(id)
        
        coords <- quakes %>%
          sf::st_as_sf(coords = c("long","lat"), crs = 4326)
        
        external_btn <- mod_btn_server2("moduleServer2", coords) # here is nested module2
        
        output$map <- leaflet::renderLeaflet({
          leaflet::leaflet() %>% 
            leaflet::addTiles() %>% 
            leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
            leaflet::addCircleMarkers(
              data = coords,
              stroke = FALSE,
              radius = 6)
        })
        
        observeEvent(input$btn1, {
          leaflet::leafletProxy("map", data = coords) %>%
            leaflet::addCircles()
        })
        
        observeEvent(external_btn(), {
          leaflet::leafletProxy("map", data = coords) %>%
            leaflet::addCircles(stroke = TRUE,
                                color = "red")
        })
        
      })
    }
    
    # Module 2 - UI #
    mod_btn_UI2 <- function(id){
      ns <- NS(id)
      actionButton(ns("btn2"), "Button 2")
    }
    
    # Module 2 - server #
    mod_btn_server2 <- function(id, dataMod){
      moduleServer(id, function(input, output, session) {
        
        return(reactive(input$btn2))
        
      })
    }
    
    
    # App #
    
    ui <- fluidPage(
      
      tagList(
        mod_btn_UI1("test-btn"))
      
    )
    
    server <- function(input, output, session) {
      
      mod_btn_server1("test-btn")
      
    }
    
    shinyApp(ui = ui, server = server)