Best practices for returning a server-side generated value from a Shiny module?

Question

Consider the following example application:

library(shiny)
library(shinyWidgets)


module_UI <- function(id){
    tagList(
        div(
            uiOutput(
                outputId = NS(id, "selection")
            ),
            shinyWidgets::dropdown(
                uiOutput(outputId = NS(id, "new_option")),
                style = "unite",
                label = "New",
                color = "primary",
                animate = animateOptions(
                    enter = animations$fading_entrances$fadeInLeftBig,
                    exit = animations$fading_exits$fadeOutRightBig
                ),
                up = F,
                width = "600px",
                inline = T
            )
        )
    )
}

module_server <- function(id){
    moduleServer(id, function(input, output, session){
        ns <- session$ns
        return_values <- reactiveValues(selection=NULL)
        
        output$selection <- renderUI({
            selectInput(inputId = ns("selection"), label = "Select:", choices = 1:5)
            
        })
        
        output$new_option <- renderUI({
            div(
                numericInput(ns("new_option_input"), label = "Add a new option:"),
                shinyWidgets::actionBttn(
                    inputId = ns("submit_new_option"),
                    label = "Submit",
                    icon = icon("paper-plane"))
            )
            
        })
        
        observeEvent(input$submit_new_option, {
            
            #does not work as intended
            updateSelectInput(session = session, inputId = "selection", selected = input$new_option_input)
        })
        
        
        observe({
            return_values$selection <- input$selection
        })
        
        return(return_values)
    })
}


# Define UI for application that draws a histogram
ui <- fluidPage(
    title = "Test App",
    module_UI("test"),
    verbatimTextOutput(outputId = "selection_chosen")
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    
    picker <- module_server("test")

    output$selection_chosen <- renderText({
        picker$selection
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

Basically, the module should do two things:

1. Allow user to select a pre-existing option --> return that value from module
2. Allow user to create their own, new option --> return that value from module

I have #1 working, but am struggling on #2. Specifically, where I have the "does not work" comment. How can I achieve this functionality? What are/is the best practice(s) for returning server-side created values from a Shiny module? This is an example app; the real one involves reading the selectInput options from a database, as well as saving the newly created options in the database. Appreciate any help on this! A lot of SO answers regarding Shiny modules have the older callModule(...) syntax, which makes researching this topic a bit more confusing.

Answer 1

You just need to provide the default value in numericInput. Perhaps you are looking for this.

library(shiny)
library(shinyWidgets)

module_UI <- function(id){
  ns <- NS(id)
  tagList(
    div(
      uiOutput(
        outputId = NS(id, "selection")
      ),
      shinyWidgets::dropdown(
        uiOutput(outputId = NS(id, "new_option")),
        style = "unite",
        label = "New",
        color = "primary",
        animate = animateOptions(
          enter = animations$fading_entrances$fadeInLeftBig,
          exit = animations$fading_exits$fadeOutRightBig
        ),
        up = F,
        width = "600px",
        inline = T
      ),
      DTOutput(ns("t1"))
    )
  )
}

module_server <- function(id){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    return_values <- reactiveValues(selection=NULL,myiris = iris)
    
    output$selection <- renderUI({
      selectInput(inputId = ns("selection"), label = "Select:", choices = 1:5)
    })
    
    output$new_option <- renderUI({
      tagList(
        numericInput(ns("new_option_input"), label = "Add a new option:",10, min = 1, max = 100),
        shinyWidgets::actionBttn(
          inputId = ns("submit_new_option"),
          label = "Submit",
          icon = icon("paper-plane"))
      )
      
    })
    
    observeEvent(input$submit_new_option, {
      return_values$myiris <- iris[1:input$new_option_input,]
      #does work as intended
      updateSelectInput(session = session, inputId = "selection", choices= c(1:input$new_option_input), selected = input$new_option_input)
      
    })
    
    output$t1 <- renderDT({return_values$myiris})
    
    observe({
      
      return_values$selection <- input$selection
    })
    
    return(return_values)
  })
}


# Define UI for application that draws a histogram
ui <- fluidPage(
  title = "Test App",
  module_UI("test"),
  verbatimTextOutput(outputId = "selection_chosen"),
  DTOutput("t2")
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  picker <- module_server("test")
  
  output$selection_chosen <- renderText({
    picker$selection
  })
  
  output$t2 <- renderDT({picker$myiris[,c(3:5)]})
}

# Run the application 
shinyApp(ui = ui, server = server)