Search code examples
rshinyshiny-servershinybs

shinyBS modal not working with Shiny Server PRO


I have the following sample application which presents a modal with datatable output.

This works in RStudio, works locally within any browser, works on an EC2 Linux instance with Shiny Server (Free version). But, DOES NOT work with Shiny Server PRO. Any ideas as to limitations? I tried to debug all the ways I know, and can't see a problem.

library(shiny)
library(DT)
library(shinyBS)
library(dplyr)

mtcarsSummary <- mtcars %>%
  group_by(am) %>%
  summarise(numCars = n())

makeSummaryLinked <- function(df, linkName1, modalName1)
{
  on_click_js1 = paste(
    'Shiny.onInputChange(&#39;', linkName1, '&#39;, &#39;%s&#39;); $(&#39;',
    modalName1, '&#39;).modal(&#39;show&#39;)', sep = ''
    )

  dfLinked <- df
  tagList1 <- tags$a(
    href = "#",
    onclick = sprintf(on_click_js1, df$am),
    df$am
    )
  tagList1 <- data.frame(V1 = tagList1$attribs$onclick, V2 = tagList1$children)
  colnames(tagList1) <- c('V1', 'V2')

  dfLinked$am_linked <- paste(
    '<a href="#" onclick="', tagList1$V1, '">', tagList1$V2, '</a>', sep = ''
    )

  dfLinked <- select(
    dfLinked, am_linked, everything()
    )

  return(dfLinked)
  }

mtcarsLinked <- makeSummaryLinked(mtcarsSummary, 'myAm', paste0('#', 'amModal'))

ui <- fluidPage(
    fluidRow(
      mainPanel(
        DT::dataTableOutput('myData'),
        bsModal(
          id = 'amModal',
          title = 'What is this?',
          trigger = '',
          size = 'large',
          mainPanel(
            DT::dataTableOutput('amData'),
            width = 12
            )
          ),
          width = 12
        )
      )
    )

server <- function(input, output, session) {
  amData <- reactive({
    mtcars %>% filter(am == input$myAm)
    })
  output$myData <- DT::renderDataTable({
    mtcarsLinked %>%
      DT::datatable(
        escape = FALSE, class = 'compact', rownames = '', filter = 'none',
        options = list(dom = 'Bfrtrip')
        )
    })
  output$amData <- DT::renderDataTable({
    amData() %>%
      DT::datatable(
        escape = FALSE, class = 'compact', rownames = '', filter = 'none'
        )
    })
  }

shinyApp(ui, server)

Rest of the shiny stuff works fine. R works fine. All packages are properly installed.

version
               _
platform       x86_64-pc-linux-gnu
arch           x86_64
os             linux-gnu
system         x86_64, linux-gnu
status
major          3
minor          4.1
year           2017
month          06
day            30
svn rev        72865
language       R
version.string R version 3.4.1 (2017-06-30)
nickname       Single Candle

Package versions as follows:

packageVersion('shiny')
[1] ‘1.2.0’
packageVersion('DT')
[1] ‘0.5’
packageVersion('shinyBS')
[1] ‘0.61’
packageVersion('dplyr')
[1] ‘0.7.8’

Solution

  • I bet it's Shiny Server's use of <base> tags, which messes with relative hrefs like #. If you click the link, it'll probably navigate you to somewhere like /_w_ad877768/#. You can prevent the navigation by using href="javascript:void(0)" instead of href="#", or adding an event.preventDefault() in the anchor's click handler.