How to fix a (lack of) reactivity problem with modules?

[Sebastien Bihorel]

Hi,

I have this app in which I allow users to upload up to 3 dataset files using 3 different panel with fileInput widgets. The 2nd and 3rd panels only appear when users have uploaded a 1st and 2nd data. Given the repetitive design, modules have been created to shorten the code. Things works well except for one little reactivity problem.
This is illustrated by execution of the code below and by following this scenario (let's assume that all selected datasets can be successfully uploaded):

1. the 1st panel for upload is displayed
   
2. the debugging area at the top reports that all dataset reactive objects (named dataDf#) have NA is the $name slot
   
3. the user uploads a 1st file in the 1st panel
   
4. the 2nd panel appears
5. the debugging area reports the name of the 1st uploaded file
   
6. the user uploads a 2nd file in the 2nd panel
7. the 3rd panel appears
8. the debugging area reports the name of the 1st and 2nd uploaded files
9. the user modify the file selected in the 1st panel
10. the 2nd panel is reset, the 3rd panel disappear
11. the debugging area reports the name of the new file uploaded in the 1st panel BUT still reports the name of the file previously uploaded in the second panel
    

Obviously, this illustrates that with my current code, the reactivity implemented with the UI part of my module works fine, but not for the server side. I would appreciate any suggestion to make my module calls reactive (ie, callModule(inModule...)).

Thanks in advance for your time

require(shiny)
require(shinydashboard)

inModule <- function(input, output, session) {
  data <- reactive({
   
    inFile <- input$datafile
   
    if (is.null(inFile)){
      list(name = NA, data = NA)
    } else {
      data <- read.table(
        inFile$datapath,
        header=as.logical(input$dataHeader),
        sep=input$dataSep)
      return(list(name = input$datafile$name, data = data))
    }
  })
 
  return(data)
}

inModuleUI <- function(id, show=FALSE, n=1){
 
  ns <- NS(id)
 
  if (show){
    box(
      h4('Select data file to upload (<30MB)'),
      fileInput(inputId = ns('datafile'),
        label = NULL,
        multiple = FALSE
      ),
      radioButtons(inputId = ns('dataSep'),
        label = 'Separator',
        choices = c('Comma' = ',', 'Semi-colon' = ';', 'One space' = ' ',
          'One tab' = '\t', 'Any white space' = ''),
        selected = ',',
        inline = TRUE
      ),
      radioButtons(inputId = ns('dataHeader'),
        label = 'Does the file contain headers?',
        choices = c('Yes' = TRUE, 'No' = FALSE),
        selected = TRUE,
        inline = TRUE
      ),
      title = ifelse(is.null(n), 'Dataset', sprintf('Dataset %d', n)),
      collapsible = FALSE,
      width = 4,
      status = 'primary',
      solidHeader = TRUE
    )
  }
}

outModule <- function(input, output, session){
 
  ns <- session$ns
 
  output$dataLoadUI1 <- renderUI(
    inModuleUI(ns('datafile1'), show = TRUE, n = 1)
  )
 
  dataDf1 <- callModule(inModule, 'datafile1')
 
  output$dataLoadUI2 <- renderUI({
    inModuleUI(ns('datafile2'), show = !is.na(dataDf1()$name), n = 2)
  })
 
  dataDf2 <- callModule(inModule, 'datafile2')
 
  output$dataLoadUI3 <- renderUI({
    inModuleUI(ns('datafile3'), show = !is.na(dataDf2()$name), n = 3)
  })
 
  dataDf3 <- callModule(inModule, 'datafile3')
 
  output$dataDfFilenames <- renderPrint({
    cat('Content of dataDf1()$name\n')
    print(dataDf1()$name)
    cat('Content of dataDf2()$name\n')
    print(dataDf2()$name)
    cat('Content of dataDf3()$name\n')
    print(dataDf3()$name)
  })
 
  output$dataTabBox <- renderUI({
    fluidRow(
      verbatimTextOutput(ns('dataDfFilenames')),
      uiOutput(ns('dataLoadUI1')),
      uiOutput(ns('dataLoadUI2')),
      uiOutput(ns('dataLoadUI3'))
    )
  })
}

outModuleUI <- function(id){
  ns <- NS(id)
 
  fluidRow(
    uiOutput(ns('dataTabBox'))
  )
}

server <- function(input, output, session){
  dataInfo <- callModule(outModule, 'getData')
}

ui <- dashboardPage(
  header=dashboardHeader(
    title='Dummy'
  ),
  sidebar=dashboardSidebar(
    sidebarMenu(
      menuItem('Data', tabName = 'dataTab', icon = icon('table'), selected = TRUE)
    )
  ),
  body=dashboardBody(
    tabItems(
      tabItem(tabName = 'dataTab',
        outModuleUI('getData')
      )
    )
  ),
  title='Explore',
  skin='blue'
)

shinyApp(ui = ui, server = server)