Adds ability to update rank_list labels and exports update_rank_list

NAMESPACE

@@ -19,6 +19,7 @@ export(sortable_js_capture_input)
 export(sortable_options)
 export(sortable_output)
 export(update_bucket_list)
+export(update_rank_list)
 importFrom(assertthat,"on_failure<-")
 importFrom(assertthat,assert_that)
 importFrom(assertthat,is.string)

NEWS.md

@@ -1,13 +1,22 @@
 # sortable 0.5
 
+## Breaking changes
+
+* `id` values being used for the `bucket_list()` container or `rank_list()`
+  container have been altered. Previously, the `id` was set to
+  `bucket-list-{css_id}` and `rank-list-{css_id}`. Now, the `id` is set to
+  `{css_id}-bucket-list` and `{css_id}-rank-list`. This change allows for
+  `{sortable}` to work within Shiny modules. (#95 @yogat3ch)
+
 ## Enhancements
 
-* Add support for `update_rank_list()` and `update_bucket_list()`
-* Add ability to switch the orientation of `rank_list()` items to horizontal. #92
+* Add support for updating `rank_list()` labels and export `update_rank_list()` (#95 @yogat3ch)
+* Add support for `update_rank_list()` and `update_bucket_list()` (#93)
+* Add ability to switch the orientation of `rank_list()` items to horizontal. (#92)
 
 ## Changes
 
-* A `rank_list` now has a unique CSS id, to allow updating the `text` of the 
+* A `rank_list` now has a unique CSS id, to allow updating the `text` of the
 container.
 
 # sortable 0.4.6

R/bucket_list.R

@@ -152,7 +152,7 @@ bucket_list <- function(
   z <- tagList(
     tags$div(
       class = paste("bucket-list-container", class),
-      id = paste0("bucket-list-", css_id),
+      id = bucket_list_id(css_id),
       title_tag,
       tags$div(
         class = paste(class, "bucket-list",

R/ids.R

@@ -0,0 +1,8 @@
+# The names must be suffix values to allow for modules which use prefix values
+# https://github.com/rstudio/sortable/issues/100
+bucket_list_id <- function(id) {
+    paste0(id, "-bucket-list")
+}
+rank_list_id <- function(id) {
+    paste0(id, "-rank-list")
+}

R/rank_list.R

@@ -109,7 +109,7 @@ rank_list <- function(
   rank_list_tags <- tagList(
     tags$div(
       class = paste("rank-list-container", paste(class, collapse = " ")),
-      id = paste0("rank-list-", css_id),
+      id = rank_list_id(css_id),
       title_tag,
       tags$div(
         class = "rank-list",
@@ -144,6 +144,8 @@ dropNulls <- function(x) {
 #'   `shinyServer`.
 #' @seealso [rank_list]
 #' @export
+#' @examples
+#'
 #' ## Example of a shiny app that updates a bucket list and rank list
 #' if (interactive()) {
 #'   app <- system.file(
@@ -152,10 +154,14 @@ dropNulls <- function(x) {
 #'   )
 #'   shiny::runApp(app)
 #' }
-update_rank_list <- function(css_id, text = NULL,
+
+update_rank_list <- function(css_id,
+                             text = NULL,
+                             labels = NULL,
                              session = shiny::getDefaultReactiveDomain()) {
-  inputId <- paste0("rank-list-", css_id)
-  message <- dropNulls(list(id = inputId, text = text))
+
+  inputId <- rank_list_id(css_id)
+  message <- dropNulls(list(id = session$ns(css_id), text = text, labels = labels))
   session$sendInputMessage(inputId, message)
 }
 
@@ -166,6 +172,7 @@ update_rank_list <- function(css_id, text = NULL,
 #' labels.
 #'
 #' @inheritParams bucket_list
+#' @inheritParams update_rank_list
 #' @param session The `session` object passed to function given to
 #'   `shinyServer`.
 #' @seealso [bucket_list]
@@ -179,9 +186,11 @@ update_rank_list <- function(css_id, text = NULL,
 #'   )
 #'   shiny::runApp(app)
 #' }
-update_bucket_list <- function(css_id, header = NULL,
-                             session = shiny::getDefaultReactiveDomain()) {
-  inputId <- paste0("bucket-list-", css_id)
-  message <- dropNulls(list(id = inputId, header = header))
+update_bucket_list <- function(css_id,
+                               header = NULL,
+                               labels = NULL,
+                               session = shiny::getDefaultReactiveDomain()) {
+  inputId <- bucket_list_id(css_id)
+  message <- dropNulls(list(id = session$ns(css_id), header = header, labels = labels))
   session$sendInputMessage(inputId, message)
 }

README.md

@@ -108,7 +108,6 @@ ui <- fluidPage(
         tabPanel(
           "Default",
             tags$b("Exercise"),
-            actionButton("btnUpdate", label = "Update rank list title"),
             rank_list_basic,
             tags$b("Result"),
             verbatimTextOutput("results_basic")
@@ -142,15 +141,6 @@ server <- function(input, output, session) {
   output$results_swap <- renderPrint({
     input$rank_list_swap # This matches the input_id of the rank list
   })
-  # test updating the rank list label
-  observe({
-    update_rank_list(
-      "rank_list_basic",
-      text = paste("You pressed the button at", as.character(Sys.time())),
-      session = session
-    )
-  }) %>%
-    bindEvent(input$btnUpdate)
 }
 
 shinyApp(ui, server)
@@ -172,16 +162,13 @@ students to classify objects into multiple categories.
 library(shiny)
 library(sortable)
 
-
 ui <- fluidPage(
   tags$head(
     tags$style(HTML(".bucket-list-container {min-height: 350px;}"))
   ),
   fluidRow(
     column(
       tags$b("Exercise"),
-      actionButton("btnUpdateBucket", label = "Update bucket list title"),
-      actionButton("btnUpdateRank", label = "Update rank list title"),
       width = 12,
       bucket_list(
         header = "Drag the items in any desired bucket",
@@ -244,29 +231,6 @@ server <- function(input, output, session) {
       input$bucket_list_group # Matches the group_name of the bucket list
     )
 
-  # test updating the bucket list label
-  counter_bucket <- reactiveVal(1)
-  observe({
-    update_bucket_list(
-      "bucket_list_group",
-      text = paste("You pressed the button", counter_bucket(), "times"),
-      session = session
-    )
-    counter_bucket(counter_bucket() + 1)
-  }) %>%
-    bindEvent(input$btnUpdateBucket)
-
-  # test updating the rank list label
-  counter_rank <- reactiveVal(1)
-  observe({
-    update_rank_list(
-      "rank_list_1",
-      text = paste("You pressed the button", counter_rank(), "times"),
-      session = session
-    )
-    counter_rank(counter_rank() + 1)
-  }) %>%
-    bindEvent(input$btnUpdateRank)
 }
 
 

inst/htmlwidgets/plugins/sortable-rstudio/rank_list_binding.js

@@ -20,13 +20,29 @@ $.extend(ranklistBinding, {
   getValue: function(el) {
 
   },
+  setValue: function (el, data) {
+    if (data.header) {
+      $(el).find(".rank-list-title").text(data.text);
+    }
+
+    if (data.labels) {
+      let labels = [].concat(data.labels)
+      let html = labels.map((v) => {
+        let el = document.createElement("div");
+        el.classList.add("rank-list-item");
+        el.innerHTML = v;
+        return el;
+      })
+      $('#' + data.id).html(html)
+      Shiny.setInputValue(data.id, labels, {priority: 'event'})
+    }
 
+  },
   subscribe: function(el, callback) {
 
   },
-
   receiveMessage: function(el, data) {
-    $(el).find(".rank-list-title").text(data.text);
+    this.setValue(el, data)
   }
 
 });
@@ -67,9 +83,25 @@ $.extend(bucketlistBinding, {
 
 
   },
-
+  setValue: function (el, data) {
+    if (data.header) {
+      $(el).find(".bucket-list-header").text(data.header);
+    }
+
+    if (data.labels) {
+      let labels = [].concat(data.labels)
+      let html = labels.map((v) => {
+        let el = document.createElement("div");
+        el.classList.add("rank-list-item");
+        el.innerHTML = v;
+        return el;
+      })
+      $('#' + data.id).html(html)
+      Shiny.setInputValue(data.id, data.labels, {priority: 'event'})
+    }
+  },
   receiveMessage: function(el, data) {
-    $(el).find(".bucket-list-header").text(data.header);
+    this.setValue(el, data)
   }
 
 });

inst/shiny-examples/update/R/mod.R

@@ -0,0 +1,107 @@
+#' sortable UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd
+#'
+#' @importFrom shiny NS tagList
+mod_sortable_ui <- function(id){
+  ns <- NS(id)
+  tagList(
+    fluidRow(
+      column(
+        width = 12,
+        h2("Update:", tags$code(id)),
+        actionButton(ns("btnUpdateBucket"), label = "Update bucket list title"),
+        actionButton(ns("btnUpdateLabels"), label = "Update bucket list labels")
+      )
+    ),
+    fluidRow(
+      column(
+        h2("Exercise"),
+        width = 12,
+        bucket_list(
+          header = "Drag the items in any desired bucket",
+          group_name = ns("bucket_list_group"),
+          css_id=ns("bucket_list_group"),
+          orientation = "horizontal",
+          add_rank_list(
+            text = "Drag from here",
+            labels = list(
+              "1"
+            ),
+            input_id = ns("rank_list_1")
+          ),
+          add_rank_list(
+            text = "to here",
+            labels = NULL,
+            input_id = ns("rank_list_2")
+          )
+        )
+      )
+    )
+  )
+}
+
+#' sortable Server Functions
+#'
+#' @noRd
+mod_sortable_server <- function(id){
+  moduleServer( id, function(input, output, session){
+    ns <- session$ns
+
+    # test updating the bucket list label
+    counter_bucket <- reactiveVal(1)
+    label_counter <- reactiveVal(1)
+    observe({
+      update_bucket_list(
+        "bucket_list_group",
+        header = paste("You pressed the update button", counter_bucket(), "times"),
+        session = session
+      )
+      counter_bucket(counter_bucket() + 1)
+    }) %>%
+      bindEvent(input$btnUpdateBucket)
+
+    observeEvent(
+      input$btnUpdateLabels, {
+        label_counter(label_counter() + 1)
+        update_rank_list(
+          "rank_list_1",
+          labels = c(input$rank_list_1, label_counter())
+        )
+      })
+
+    observe({
+      len <- length(input$rank_list_1)
+      count_word <- if(len == 0) "" else glue::glue("({len})")
+      update_rank_list(
+        "rank_list_1",
+        text = paste0("From here ", count_word),
+        session = session
+      )
+    }) %>%
+      bindEvent(input$rank_list_1)
+
+
+    observe({
+      len <- length(input$rank_list_2)
+      count_word <- if(len == 0) "" else glue::glue("({len})")
+      update_rank_list(
+        "rank_list_2",
+        text = paste0("To here ", count_word),
+        session = session
+      )
+    }) %>%
+      bindEvent(input$rank_list_2)
+
+  })
+}
+
+## To be copied in the UI
+# mod_sortable_ui("sortable_1")
+
+## To be copied in the server
+# mod_sortable_server("sortable_1")