CODEWITHSUNDEEP
javascriptrshiny
thothal
thothal

Reputation: 20399

Communicate from JS to Shiny in a module

I want to set an input element from the JS side and react upon it from the Shiny side. Shiny.setInputValue(<name>, <val>) does that for me. However, I want to listen to that element from within a module, which makes that I have to namespace <name>, which makes it a bit difficult.

I found the following solution, but I am not very happy with this choice:

  1. I have to store the namespace in the HTML.
  2. If I have nested modules and I want to listen to the element from the parent module, I have to provide another argument to the child module with the parent's module to make this work.
  3. The whole construction feels very un-shiny-like.

Question

Which design pattern can I use to listen to a message from JS in a shiny module?

library(shiny)

js_handler <- HTML("$(function() {
  $(document).on('click', '.my-button', function() {
                  $me = $(this);
                  var ns = $me.data('namespace');
                  var id = Math.random();
                  if (ns) {
                     Shiny.setInputValue(ns + 'trigger', id);
                  } else {
                     Shiny.setInputValue('trigger', id);
                  }
               });
})")

my_button <- function(id, label, ns) {
   tagList(
      tags$button(id = id,
                  type = "button", 
                  class = "btn btn-default my-button", 
                  `data-namespace` = if (!is.null(ns)) ns,
                  label),
      tags$head(singleton(tags$script(js_handler)))
   )
}

test_ui <- function(id) {
   ns <- NS(id)
   tagList(
      my_button(ns("btn1"), "Send To R (readable only from module)", ns("")),
      my_button(ns("btn2"), "Send To R (readable only at main)", NULL),
      verbatimTextOutput(ns("output"))
   )
}

test_server <- function(id) {
   moduleServer(id, function(input, output, session) {
      output$output <- renderPrint(req(input$trigger))
   })}

shinyApp(ui = fluidPage(h4("Module"), test_ui("test"), 
                        h4("Main"), verbatimTextOutput("output")), 
         server = function(input, output, session) {
            test_server("test")
            output$output <- renderPrint(req(input$trigger))
         })

Why not relying simply on Shiny to do the work?

In my real case scenario, the JS code is part of a small input group and should delete the whole group. I could implement that by shiny means only, but the advantage of the JS solution is that my UI generating function is self-containing, that is it bundles the necessary JS with the UI. That is, potential users, do not need to implement a listener for deleteUI.

Upvotes: 1

Views: 755

Answers (1)

starja
starja

Reputation: 10375

I have to admit that I don't fully get the scope of your question, so please tell me if I misunderstood your intentions/reasons. I think what in your design makes problems is that you try to define a button that is the main server scope but is defined from within a module; this is not how the shiny module system is designed (additionally, the button ui has a different id than the shiny input).

If you respect the namespaces of the module system and use the same id for the button ui & shiny input, you can simplify your my_button function because the namespace is automatically added to the id:

library(shiny)

js_handler <- HTML("$(function() {
  $(document).on('click', '.my-button', function() {
                  $me = $(this);
                  var bttn_id = $me.attr('id');
                  var id = Math.random();
                  Shiny.setInputValue(bttn_id, id);
               });
})")

my_button <- function(id, label) {
  tagList(
    tags$button(id = id,
                type = "button", 
                class = "btn btn-default my-button",
                label),
    tags$head(singleton(tags$script(js_handler)))
  )
}

test_ui <- function(id) {
  ns <- NS(id)
  tagList(
    my_button(ns("btn1"), "Send To R (readable only from module)"),
    verbatimTextOutput(ns("output"))
  )
}

test_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    output$output <- renderPrint(req(input$btn1))
  })}

shinyApp(ui = fluidPage(h4("Module"), test_ui("test"),
                        h4("Main"),
                        my_button("btn2", "Send To R (readable only at main)"),
                        verbatimTextOutput("output")), 
         server = function(input, output, session) {
           test_server("test")
           output$output <- renderPrint(req(input$btn2))
         })

Would that work for you?

Upvotes: 1

Related Questions