Fixes the long-standing shiny modules problem

DESCRIPTION

@@ -1,58 +1,51 @@
 Type: Package
 Package: sortable
 Title: Drag-and-Drop in 'shiny' Apps with 'SortableJS'
-Version: 0.5.0.9000
-Authors@R: 
-    c(person(given = "Andrie",
-             family = "de Vries",
-             role = c("cre", "aut"),
-             email = "apdevries@gmail.com"),
-      person(given = "Barret",
-             family = "Schloerke",
-             role = "aut",
-             email = "barret@rstudio.com"),
-      person(given = "Kenton",
-             family = "Russell",
-             role = c("aut", "ccp"),
-             email = "kent.russell@timelyportfolio.com",
-             comment = "Original author"),
-      person("RStudio", role = c("cph", "fnd")),
-      person(given = "Lebedev",
-             family = "Konstantin",
-             role = "cph",
-             comment = "'SortableJS', https://sortablejs.github.io/Sortable/"))
-Description: Enables drag-and-drop behaviour in Shiny apps, by exposing the 
-    functionality of the 'SortableJS' <https://sortablejs.github.io/Sortable/> 
-    JavaScript library as an 'htmlwidget'. 
-    You can use this in Shiny apps and widgets, 'learnr' tutorials as well as 
-    R Markdown. In addition, provides a custom 'learnr' question type - 
-    'question_rank()' - that allows ranking questions with drag-and-drop.
+Version: 0.6.0
+Authors@R: c(
+    person("Andrie", "de Vries", , "apdevries@gmail.com", role = c("cre", "aut")),
+    person("Barret", "Schloerke", , "barret@posit.co", role = "aut"),
+    person("Kenton", "Russell", , "kent.russell@timelyportfolio.com", role = c("aut", "ccp"),
+           comment = "Original author"),
+    person("Posit", role = c("cph", "fnd")),
+    person("Lebedev", "Konstantin", role = "cph",
+           comment = "'SortableJS', https://sortablejs.github.io/Sortable/")
+  )
+Description: Enables drag-and-drop behaviour in Shiny apps, by exposing
+    the functionality of the 'SortableJS'
+    <https://sortablejs.github.io/Sortable/> JavaScript library as an
+    'htmlwidget'.  You can use this in Shiny apps and widgets, 'learnr'
+    tutorials as well as R Markdown. In addition, provides a custom
+    'learnr' question type - 'question_rank()' - that allows ranking
+    questions with drag-and-drop.
 License: MIT + file LICENSE
 URL: https://rstudio.github.io/sortable/
 BugReports: https://github.com/rstudio/sortable/issues
 Imports:
+    assertthat,
+    cli,
     htmltools,
     htmlwidgets,
+    jsonlite,
     learnr (>= 0.10.0),
+    rlang (>= 1.0.0),
     shiny (>= 1.9.0),
-    assertthat,
-    jsonlite,
-    utils,
-    rlang (>= 1.0.0)
+    utils
 Suggests:
     base64enc,
+    covr,
     knitr,
-    testthat (>= 2.1.0),
-    withr,
-    rmarkdown,
     magrittr,
-    webshot,
+    rmarkdown,
+    shinytest2,
     spelling,
-    covr
+    testthat (>= 2.1.0),
+    webshot,
+    withr
 VignetteBuilder: 
     knitr
+Config/testthat/edition: 3
 Encoding: UTF-8
-Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
 Language: en-US
-Config/testthat/edition: 3
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.3.3

NAMESPACE

@@ -9,6 +9,8 @@ S3method(question_ui_try_again,sortable_rank)
 export(add_rank_list)
 export(bucket_list)
 export(chain_js_events)
+export(enable_modules)
+export(is_modules_enabled)
 export(is_sortable_options)
 export(question_rank)
 export(rank_list)

R/methods.R

@@ -24,14 +24,19 @@ print.bucket_list <- function(x, ...){
 
 # The names must be suffix values to allow for modules which use prefix values
 # https://github.com/rstudio/sortable/issues/100
-as_rank_list_id <- function(id) {
-  paste0("rank-list-", id)
+as_rank_list_id <- function(id, use_module = is_modules_enabled()) {
+  if (use_module){
+    paste0(id, "-rank-list")
+  } else {
+    paste0("rank-list-", id)
+  }
 }
-# TODO: in future, change the order of paste, to enable shiny modules
-# paste0(id, "-rank-list")
 
-as_bucket_list_id <- function(id) {
-  paste0("bucket-list-", id)
+as_bucket_list_id <- function(id, use_module = is_modules_enabled()) {
+  if (use_module){
+    paste0(id, "-bucket-list")
+  } else {
+    paste0("bucket-list-", id)
+  }
 }
-# TODO: in future, change the order of paste, to enable shiny modules
-# paste0(id, "-bucket-list")
+

R/modules.R

@@ -0,0 +1,29 @@
+# TODO: Create demo app with modules
+# TODO: Ensure module settings for id gets passed to JavaScript binding
+
+# create environment for storing shiny module status
+sortable_env = new.env()
+sortable_env$modules = FALSE
+
+#' Check if shiny modules are enabled for `sortable`.
+#'
+#' Due to an early (regrettable) design decision, `sortable` in versions <= 0.5.0
+#' did not support shiny modules.
+#' To use `sortable` with shiny modules, you have to opt in to different
+#' behaviour, by calling `enable_modules()`.
+#'
+#' @rdname modules
+#' @return Logical value indicating whether shiny modules are enabled or not.
+#' @export
+is_modules_enabled <- function(){
+  isTRUE(sortable_env$modules)
+}
+
+#' @rdname modules
+#' @param enable If `TRUE`, enables modules. If `FALSE` disables them.
+#' @export
+enable_modules <- function(enable = TRUE){
+  assertthat::assert_that(is.logical(enable))
+  sortable_env$modules = enable
+  is_modules_enabled()
+}

R/zzz.R

@@ -2,6 +2,18 @@
 
 .onLoad <- function(...) {
 
+
+  # use the `cli` package to send a message on startup to use `enable_modules()`
+  msg <- c("")
+  packageStartupMessage(
+    # rlang::inform("This message will appear only once per session.", .frequency = "once", .frequency_id = "sortable"),
+    rlang::inform(
+      cli::cli_text("To use sortable with shiny modules, run {.run sortable::enable_modules()} to opt into the new standard."),
+    .frequency = "once",
+    .frequency_id = "sortable"
+    )
+  )
+
   as_character_vector <- function(x) {
     # works for both x = NULL and x = list()
     if (length(x) == 0) {

README.md

@@ -1,5 +1,4 @@
 
-
 <!-- README.md is generated from README.Rmd. Please edit that file -->
 
 # sortable <img src='man/figures/logo.png' align="right" height="139" />

_pkgdown.yml

@@ -28,12 +28,14 @@ reference:
   - sortable_output
   - update_rank_list
   - update_bucket_list
+  - is_modules_enabled
 - title: Package documentation
   desc: ~
   contents:
   - sortable
 
 tutorials:
+
 - name: tutorial_question_rank
   title: Using ranking questions in learnr
   url: https://andrie-de-vries.shinyapps.io/sortable_tutorial_question_rank/
@@ -52,3 +54,7 @@ articles:
   - novel_solutions
   - cloning
   - updating_rank_list
+
+- title: Using `sortable` with `shiny` modules
+  contents:
+  - shiny_modules

inst/shiny/modules/app.R

@@ -0,0 +1,108 @@
+## ---- modules-app -----------------------------------------------------
+## Example shiny app that dynamically updates a rank list
+
+library(shiny)
+library(sortable)
+library(magrittr)
+
+# shiny module ui ----
+mod_rank_list_ui <- function(id, text, labels) {
+  ns <- NS(id)
+  fluidRow(
+  rank_list(text, labels, input_id = ns("rank_list_1")),
+  verbatimTextOutput(ns("results"))
+  )
+}
+
+# shiny module serevr ----
+mod_rank_list_server <- function(id) {
+  moduleServer(id, function(input, output, session) {
+    counter_bucket <- reactiveVal(1)
+
+    output$results <- renderPrint({
+      input$rank_list_1 # This matches the input_id of the rank list
+    })
+
+    observe({
+      update_rank_list(
+        "rank_list_1",
+        text = paste("You pressed the update button", counter_bucket(), "times"),
+      )
+      counter_bucket(counter_bucket() + 1)
+    }) %>%
+      bindEvent(input$btnUpdateRank)
+
+
+    observe({
+      update_rank_list(
+        "rank_list_1",
+        labels = sample(LETTERS, 5)
+      )
+    }) %>%
+      bindEvent(input$btnChangeLabels)
+
+    observe({
+      update_rank_list(
+        "rank_list_1",
+        labels = list()
+      )
+    }) %>%
+      bindEvent(input$btnEmptyLabels)
+
+    observe({
+      update_rank_list(
+        "rank_list_1",
+        labels = sort(input$rank_list_1)
+      )
+    }) %>%
+      bindEvent(input$btnSortLabels)
+
+  })
+}
+
+
+# shiny ui ----
+ui <- fluidPage(
+  tags$head(
+    tags$style(HTML(".bucket-list-container {min-height: 350px;}"))
+  ),
+  fluidRow(
+    column(
+      width = 12,
+      h2("Modify a rank list"),
+      actionButton("btnUpdateRank", label = "Update rank list title"),
+      actionButton("btnChangeLabels", label = "Change labels"),
+      actionButton("btnSortLabels", label = "Sort labels"),
+      actionButton("btnEmptyLabels", label = "Empty labels")
+    )
+  ),
+  fluidRow(
+    column(
+      width = 6,
+        h2("Rank list A"),
+        mod_rank_list_ui(
+          id = "rl1",
+          text = "Change the order",
+          labels = letters[1:5]
+      )
+    ),
+    column(
+      width = 6,
+      h2("Rank list B"),
+      mod_rank_list_ui(
+        id = "rl2",
+        text = "Second order",
+        labels = LETTERS[6:10]
+      )
+    )
+  ),
+)
+
+
+# shiny server ----
+server <- function(input, output, session) {
+  mod_rank_list_server("rl1")
+  results_2 <- mod_rank_list_server("rl2")
+}
+
+shinyApp(ui, server)

sortable.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: f5b175a3-1218-4e55-8f73-192b92827f27
 
 RestoreWorkspace: Default
 SaveWorkspace: Default

tests/testthat/_snaps/shinytest2/test_change_labels-001.json

@@ -0,0 +1,5 @@
+{
+  "output": {
+    "results": "[1] \"a\" \"b\" \"c\" \"d\" \"e\""
+  }
+}

tests/testthat/_snaps/shinytest2/test_change_labels-002.json

@@ -0,0 +1,5 @@
+{
+  "output": {
+    "results": "[1] \"W\" \"C\" \"R\" \"F\" \"I\""
+  }
+}

tests/testthat/_snaps/shinytest2/test_empty_labels-001.json

@@ -0,0 +1,5 @@
+{
+  "output": {
+    "results": "[1] \"a\" \"b\" \"c\" \"d\" \"e\""
+  }
+}

tests/testthat/_snaps/shinytest2/test_empty_labels-002.json

@@ -0,0 +1,5 @@
+{
+  "output": {
+    "results": "NULL"
+  }
+}

tests/testthat/_snaps/shinytest2/test_empty_labels-003.json

@@ -0,0 +1,5 @@
+{
+  "output": {
+    "results": "[1] \"M\" \"I\" \"Z\" \"W\" \"Q\""
+  }
+}